ibm:vm370-lib:cms:dmslgt.assemble_src
Table of Contents
DMSLGT Source
References
- Fixes Applied : 3
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC006DS]
Source Listing
- DMSLGT.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmslgt.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator