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