LGT TITLE 'DMSLGT (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* 00004000
* 00005000
* MODULE NAME: 00006000
* 00007000
* DMSLGT 00008000
* 00009000
* FUNCTION: 00010000
* 00011000
* CONSISTS OF TWO SUBROUTINES: DMSLGTA, DMSLGTB 00012000
* 00013000
* 00014000
* SUBROUTINE NAME: 00015000
* 00016000
* DMSLGTA 00017000
* 00018000
* FUNCTION: 00019000
* 00020000
* FREE ALL TXTLIB DIRECTORY BLOCKS ON TXTLIB CHAIN. 00021000
* 00022000
* ATTRIBUTES: 00023000
* 00024000
* REENTRANT, NUCLEUS RESIDENT 00025000
* 00026000
* ENTRY POINTS: 00027000
* 00028000
* DMSLGTA - ENTERED FROM DMSLDRB IF NOT A DYNAMIC LOAD. 00029000
* 00030000
* ENTRY CONDITIONS: 00031000
* 00032000
* R14 RETURN ADDRESS 00033000
* R13 CONTAINS ADDRESS OF LDRST WORK AREA 00034000
* R15 CONTAINS ADDRESS OF DMSLGTA 00035000
* 00036000
* EXIT CONDITIONS: 00037000
* 00038000
* NORMAL - RETURN VIA R14 00039000
* ERROR - NONE 00040000
* 00041000
* CALLS TO OTHER ROUTINES: 00042000
* 00043000
* DMSFREB 00044000
* 00045000
* EXTERNAL REFERENCES: 00046000
* 00047000
* TXTLIB - LIST ANCHOR IN NUSECT. 00048000
* 00049000
* REGISTER USAGE: 00050000
* 00051000
* R10 - BASE 00052000
* R13 - LDRST 00053000
* R14 - RETURN 00054000
* R0, 1, 15 - WORK 00055000
* 00056000
* OPERATION: 00057000
* 00058000
* PICK UP ANCHOR TO TXTLIB CHAIN. ZERO THE ANCHOR IN 00059000
* NUSECT. CALL DMSFREE FOR EACH BLOCK OF FREE STORAGE 00060000
* OCCUPIED BY A TXTLIB DIRECTORY. RETURN TO DMSLDRB VIA 00061000
* R14. 00062000
* 00063000
* SUBROUTINE NAME: 00064000
* 00065000
* DMSLGTB 00066000
* 00067000
* FUNCTION: 00068000
* 00069000
* TO READ TXTLIB DIRECTORIES INTO A CHAIN OF FREE STORAGE 00070000
* DIRECTORY BLOCKS. 00071000
* 00072000
* ATTRIBUTES: 00073000
* 00074000
* REENTRANT, NUCLEUS RESIDENT 00075000
* 00076000
* ENTRY POINTS: 00077000
* 00078000
* DMSLGTB - FROM DMSLDRB 00079000
* 00080000
* ENTRY CONDITIONS: 00081000
* 00082000
* R13 ADDRESS OF LDRST WORK AREA 00083000
* R14 RETURN ADDRESS 00084000
* R15 ADDRESSABILITY 00085000
* 00086000
* EXIT CONDITIONS: 00087000
* 00088000
* NORMAL - RETURN VIA R14 00089000
* 00090000
* ERROR - EXIT TO DMSLDRD IF TXTLIB NOT FOUND 00091000
* OR INVALID TXTLIB 00092000
* 00093000
* CALLS TO OTHER ROUTINES: 00094000
* 00095000
* DMSBRD - TO READ TXTLIB RECORDS 00096000
* DMSFREB - TO AQUIRE DIRECTORY BLOCKS 00097000
* 00098000
* EXTERNAL REFERENCES: 00099000
* 00100000
* TXTLIB LIST IN NUCON 00101000
* 00102000
* TABLES/WORKAREAS: 00103000
* 00104000
* NONE. 00105000
* 00106000
* REGISTER USAGE: 00107000
* 00108000
* R10 - BASE 00109000
* R13 - LDRST 00110000
* R14 - RETURN 00111000
* R0, 1, 15 - WORK 00112000
* 00113000
* OPERATION: 00114000
* 00115000
* READ IN FIRST RECORD OF THE TXTLIB. FROM IT CALCULATE 00116000
* SIZE AND LOCATION OF ITS DICTIONARY. CALL DMSFREB FOR A 00117000
* FREE STORAGE REGION. READ THE DIRECTORY INTO IT. 00118000
* CHAIN THE BLOCK FROM THE TXTLIB ANCHOR IN NUSECT. SAVE 00119000
* THE SIZE OF THE BLOCK IN THE BLOCK HEADER. DO THE 00120000
* ABOVE FOR EACH TXTLIB IN THE LIST BEGINNING AT 'TXTLIB' 00121000
* IN NUSECT. IF AN ERROR OCCURS WHIL PROCESSING A 00122000
* TXTLIB, EXIT TO DMSLDRD, OTHERWISE RETURN TO DMSLDRB. 00123000
*. 00124000
EJECT 00125000
DMSLGT START 0 @V305665 00126100
ENTRY DMSLGTA @V305665 00126200
ENTRY DMSLGTB 00127000
DMSLGTA EQU * @V305665 00127100
LR R10,R15 00128000
USING DMSLGTA,R10 00129000
USING LDRST,R13 00130000
USING NUCON,R0 00131000
LR R5,R14 PROTECT RETURN REG 00132000
SR R8,R8 GET ZERO 00133000
L R1,TXTDIRC POINT TO TXTLIB FREE STOR CHN 00134000
ST R8,TXTDIRC CLEAR TXTLIB ANCHOR WORD 00135000
SPACE 00136000
GLFRETLP EQU * FREE OLD TXTLIB DIRECTORY BLOCKS 00137000
LTR R1,R1 END OF CHAIN? 00138000
BCR 8,R14 IF SO RETURN 00139000
L R0,8(R1) NO. OF DBL-WDS TO FREE 00140000
L R7,12(R1) ADDRESS OF NEXT BLOCK TO FREE 00141000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR FREE THE BLOCK 00142000
LR R14,R5 RESTORE RETURN REG 00143000
LR R1,R7 00144000
B GLFRETLP LOOP 00145000
SPACE 00146000
DROP R10 00147000
USING *,R12 00148000
DMSLGTB ST R14,APSV+56 SAVE R14 00149000
LR R12,R15 MAKE A NEW TXTLIB DIRECTORY BLOCK CHAIN 00150000
LA R3,TXTLIBS ADDR OF TXTLIB LIST 00151000
LA R6,TXTDIRC-12 SET FOR CREATING CHAIN 00152000
MVC READBUF(8),=CL8'RDBUF' SET FOR READING 00153000
MVC FTYPE(8),=CL8'TXTLIB' FILETYPE TXTLIB 00154000
MVC FMODE(2),=CL2'*' WITH ANY MODE 00155000
MVC RFIX(2),=CL2'F' AND F FORMAT 00156000
SPACE 00157000
GLNEWLP EQU * 00158000
CLI 0(R3),X'FF' END OF NEW TXTLIB CHAIN? 00159000
BE GLOBRET BRANCH IF SO 00160000
MVC FNAME(8),0(R3) MOVE IN THE LIBNAME 00161000
LA R1,1 00162000
STH R1,RITEM SET TO READ ITEM 1 00163000
STH R1,RNUM (1 ITEM) 00164000
LA R1,SPEC 00165000
ST R1,RADD INTO SPEC 00166000
LA R1,80 00167000
ST R1,RLENG UP TO 80 BYTES 00168000
LA R1,READBUF DO IT 00169000
L R15,ARDBUF ADR OF RDBUF V0304 00170100
BALR R14,R15 V0304 00170200
BNZ GLRD1ERR BRANCH IF ERROR V0304 00170300
CLC SPEC+3(3),=CL3'LIB' VALID TXTLIB ? 00172000
BE GLTXTOK YES, CONTINUE 00173000
LA R5,54 ERROR 056E 00174000
B GLRDFERR 00175000
GLTXTOK L R1,SPEC+8 NO. OF DBL-WDS NEEDED FOR DIRECTORY 00176000
LA R1,SEVEN(,R1) ROUND UP TO NEXT DLB-WD @VA05939 00176500
SRL R1,3 00177000
LA R0,12(R1) ADD 12 FOR HEADING @VA07654 00178500
DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR GET FREE STORAGE 00179000
ABOVE ST R1,12(R6) NEW BLK IN OLD LINK @VM08822 00180000
MVC 0(8,R1),0(R3) MOVE LIBNAME INTO HEAD OF BLOCK 00181000
ST R0,8(R1) AND SAVE LENGTH IN 3RD WORD 00182000
SR R8,R8 GET A ZERO 00183000
ST R8,12(R1) AND ZERO CHAIN POINTER IN 4TH 00184000
LR R14,R6 SAVE R6 00185000
LR R6,R1 00186000
LA R1,12 ALLOW 12 FOR HEADING @VA08674 00187100
SR R0,R1 RESTORE R0 00188000
ST R0,16(R6) STORE IN HEADER 00189000
LA R1,32(R6) ADDRESS OF DIRECTORY (AFTER HEADER) 00190000
ST R1,20(R6) STORE IT IN HEADER 00191000
CH R0,=H'-5' SETTING UP DUMMY DIRECTORY? @VA08674 00191110
BE ENDPTR YES @VM08822 00191200
A R1,SPEC+8 ADD SOME MAGIC NUMBER 00192000
STORIT ST R1,28(,R6) STORE IT IN HDR TOO. @VM08822 00193000
LA R1,12 GET 12 00194000
ST R1,24(R6) AND STORE THIS TOO 00195000
CH R0,=H'-5' SETTING UP DUMMY DIRECTORY? @VA08674 00195110
BE GLNXTLIB @VM08822 00195200
LH R4,SPEC+6 PICK UP ITEM NO. FROM SPEC 00196000
LA R7,32(R6) POINT TO SPACE FOR PUTTING DIRECTORY 00197000
L R9,SPEC+8 NO. OF BYTES IN DICT. 00198000
LA R9,0(R7,R9) END OF DICTIONARY ADDR. 00199000
LA R8,72 BXLE INCREMENT 00200000
LR R5,R9 POINT TO END @VA05939 00200300
SR R5,R8 ADDRESS OF LAST RECORD @VA05939 00200700
LA R1,READBUF READ TXTLIB DIRECTORY INTO FREE STRO 00201000
READIN STH R4,RITEM SET READ ITEM NO. 00202000
L R15,ARDBUF V0304 00203100
BALR R14,R15 V0304 00203200
BNZ GLRDZERR BRANCH IF ERROR V0304 00203300
CR R7,R5 WITHIN LAST RECORD AREA? @VA05939 00203500
BL MOVEIN BRANCH IF NOT @VA05939 00203700
SR R9,R7 COMPUTE LENGTH OF LAST MOVE @VA05939 00203900
BCTR R9,0 LESS ONE FOR EX @VA05939 00204100
EX R9,MVC MOVE IN LAST PART OF DICT @VA05939 00204300
B GLNXTLIB FINISHED WITH THIS DICT @VA05939 00204500
MOVEIN EQU * @VA05939 00204700
MVC 0(72,R7),SPEC MOVE DICT. RECORD TO BUFFER 00205000
LA R4,1(0,R4) BUMP ITEM NO. 00206000
BXLE R7,R8,READIN READ IN ALL DICT. ITEMS 00207000
SPACE 00208000
GLNXTLIB EQU * PROCEED TO NEXT LIBRARY 00209000
LA R3,8(R3) POINT TO NEXT LIBNAME 00210000
B GLNEWLP AND LOOP 00211000
ENDPTR XC 32(24,R6),32(R6) FILL ENTRIES ZEROS @VM08822 00211100
LA R1,44(,R6) 2 TEXT ENTRIES @VM08822 00211200
B STORIT STORE ENDPTR DIR @VM08822 00211300
SPACE 00212000
GLRD1ERR CH R15,=H'1' FILE NOT FOUND V0314 00213100
BE NOTFD YES @VM08822 00213200
RDERR LA R5,62 CODE FOR READ ERR @VM08822 00213300
GLRDFERR LM R8,R9,APSV+32 GET DMSLDR BASE REGS 00215000
MVC OUTBUF(18),FNAME SET MSG SUBSITUTIONS V0314 00216100
L R12,=V(DMSLDRD) GET TERMINAL ERROR ENTRY TO LDRV0314 00217100
BR R12 V0314 00217200
SPACE 00219000
*SET UP DUMMY DIRECTORY @VM08822 00220000
NOTFD DMSERR TEXT='FILE ''........ TXTLIB'' NOT FOUND', @VM08822X00220100
SUB=(CHARA,(R3)),NUM=2,LET=I @VM08929 00220200
LA R0,7 DEF DBL-WDS TO 7 @VM08822 00220300
DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR @VM08822 00220400
B ABOVE BR TO CREATE DIR @VM08822 00220500
SPACE 00222000
GLRDZERR EQU * READ ERROR FOR DIRECTORY 00223000
CH R15,=H'12' END OF FILE 00224000
BE GLNXTLIB YES, DO NEXT LIBRARY 00225000
LR R1,R6 SET UP TO FREE THE BLOCK 00226000
L R0,8(R1) 00227000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00228000
LR R6,R14 RESTORE R9 00229000
XC 12(4,R6),12(R6) CLEAR CHAIN POINTER 00230000
B RDERR TERMINATE THE COMMAND 00231000
SPACE 00232000
GLOBRET EQU * 00233000
LM R0,R15,APSV RESTORE ALL REGISTERS 00234000
BR R14 AND RETURN 00235000
MVC MVC 0(0,R7),SPEC @VA05939 00235200
FOUR EQU 4 @VA05939 00235400
SEVEN EQU 7 @VA05939 00235600
LTORG 00235800
EJECT 00236000
LDRST 00237000
EJECT 00238000
REGEQU 00239000
SPACE 2 00240000
NUCON 00241000
END 00242000