ibm:vm370-lib:cms:dmslib.assemble_src
Table of Contents
DMSLIB Source
References
- Fixes Applied : 5
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC006DS]
Source Listing
- DMSLIB.ASSEMBLE.txt
- LIB TITLE 'DMSLIB (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00004000
- * 00005000
- * 00006000
- * 00007000
- * MODULE NAME: 00008000
- * 00009000
- * DMSLIB 00010000
- * 00011000
- * 00012000
- * FUNCTION: 00013000
- * 00014000
- * TO SEARCH TEXT LIBRARIES FOR UNDEFINED SYMBOLS, AND TO 00015000
- * CLOSE LIBRARIES. 00016000
- * 00017000
- * ATTRIBUTES: 00018000
- * 00019000
- * REENTRANT, NUCLEUS RESIDENT 00020000
- * 00021000
- * ENTRY POINTS: 00022000
- * 00023000
- * DMSLIB 00024000
- * 00025000
- * ENTRY CONDITIONS: 00026000
- * 00027000
- * R3 - RETURN ADDRESS IF AN UNDEFINED NAME IS FOUND IN A 00028000
- * TXTLIB DICTIONARY 00029000
- * R14 - RETURN IF NO UNDEFINED NAMES RESOLVED 00030000
- * R13 - ADDRESS OF FREEST 00031000
- * 00032000
- * EXIT CONDITIONS: 00033000
- * 00034000
- * NORMAL - 00035000
- * BR TO R3 IF AN UNDEFINED NAME IS ASSOCIATED WITH EITHER 00036000
- * A TEXT FILE OR A TXTLIB, BR TO R14 OTHERWISE. 00037000
- * 00038000
- * ERROR - 00039000
- * BALR TO DMSLIO IF ERROR OCCURS DURING POINT FUNCTION 00040000
- * THEN RETURN TO CALLER VIA R14 00041000
- * 00042000
- * CALLS TO OTHER ROUTINES: 00043000
- * 00044000
- * DMSSTT - TO FIND TEXT FILE WITH SAME NAME AS UNDEFINED 00045000
- * DMSPNT - TO PUT READ POINTER AT PROPER ITEM IN TXTLIB 00046000
- * FOR DMSLDR 00047000
- * DMSLIO - TO PUT OUT ERROR MESSAGES 00048000
- * DMSFREE, DMSFRET, DMSFNS 00049000
- * 00050000
- * EXTERNAL REFERENCES: 00051000
- * 00052000
- * LDRST, LOADER TABLE, NUCON, TXTLIB LIST 00053000
- * 00054000
- * TABLES/WORKAREAS: 00055000
- * 00056000
- * MYFREE 00057000
- * 00058000
- * REGISTER USAGE: 00059000
- * 00060000
- * R13 - FREEST 00061000
- * R12 - MYFREE 00062000
- * R14 - RETURN 00063000
- * R11 - BASE 00064000
- * OTHERS - WORK 00065000
- * 00066000
- * OPERATION: 00067000
- * 00068000
- * 1. SAVE REGISTERS 14-12, SET UP MYFREE IF NOT PREVIOUSLY 00069000
- * DONE. 00070000
- * 00071000
- * 2. IF CALLED TO CLOSE TXTLIBS FREE 'MYFREE' WORKAREA, 00072000
- * RESET LIBE FLAGS IN FREEST. 00073000
- * 00074000
- * 3. SCAN LOADER TABLE FOR AN UNDEFINED ENTRY, IF NONE BR 00075000
- * 14. 00076000
- * 00077000
- * 4. STATE FOR A TEXT FILE WITH THE SAME NAME AS THE 00078000
- * UNDEFINED ENTRY UNLESS NOAUTO SPECIFIED. IF A DECK IS 00079000
- * FOUND RETURN VIA R3 WITH PLIST IN FREEST SET UP FOR 00080000
- * DMSLDR, OTHERWISE CONTINUE. 00081000
- * 00082000
- * 5. SCAN ALL TXTLIB DICTIONARIES FOR A MATCH ON THE 00083000
- * UNDEFINED NAME UNLESS NOLIBE SPECIFIED. IF NO MATCH GO 00084000
- * TO STEP 3. IF NOLIBE SPECIFIED OR NO TXTLIBS DEFINED 00085000
- * GO TO STEP 3. V0217 00086100
- * 00087000
- * 6. MATCH FOUND-ISSUE POINT ON THE TXTLIB TO SET READ 00088000
- * POINTER FOR DMSLDR, RETURN TO DMSLDR VIA R3. 00089000
- * IF THE NAME IS AS ALIAS CREATE AN ENTRY IN THE LOADER 00090000
- * TABLE FOR IT. IF NOT AN ALIAS TURN ON MNSD FLAG TO 00091000
- * INDICATE TO DMSSLN THAT STRTADDR MUST BE USED AS THE 00092000
- * ENTRY LOCATION TO THIS ROUTINE. 00093000
- * 00094000
- * 7. FOR A POINT ERROR BALR TO DMSLIO FOR POINT ERROR 00095000
- * MESSAGE AND RETURN VIA R14. 00096000
- *. 00097000
- EJECT 00098000
- DMSLIB START 00099000
- BALR 11,0 GET BASE 00100000
- SPACE 00101000
- USING *,11 SETUP ADDRESSING 00102000
- USING LDRST,R13 00103000
- USING MYFREE,12 ... 00104000
- USING NUCON,R0 00105000
- SPACE 2 00106000
- B LIBSTR 00107000
- DC X'CCCC' 00108000
- DC C'DMSLIB' 00109000
- DC X'CCCC' 00110000
- LIBSTR STM 14,12,APSV SAVE REGISTERS 00111000
- TM FLAGS,SETLIB TEST FOR SETUP 00112000
- BZ SETUP GO SETUP IF NOT DONE 00113000
- L 12,FLAGS GET BASE FOR MYFREE 00114000
- LA 12,0(0,12) ... 00115000
- LTR 12,12 IS IT ZERO? 00116000
- BZ RETURN YES, SETUP NOT CALLED RETURN 00117000
- TM FLAGS,CLOSELIB CLOSE CALLED? 00118000
- BO CLOSE ... 00119000
- BZ SRCHSET NO, GO SEARCH 00120000
- SPACE 2 00121000
- RETURN LM 14,12,APSV RESTORE REGISTERS 00122000
- LA 11,1 RESET REG 11 00123000
- BR 14 BACK TO CALLER 00124000
- EJECT 00125000
- SETUP L PTR,FLAGS SEE IF FREE STORAGE HAS BEEN SE 00126000
- LA 12,0(0,PTR) ... 00127000
- TM FLAGS,CLOSELIB CALL TO CLOSE? 00128000
- BO RETURN YES - RETURN 00129000
- LTR 12,12 ZERO? 00130000
- BNZ SYSCHK NO, PROCEED WITH SETUP 00131000
- SPACE 2 00132000
- DMSFREE DWORDS=MYFREESZ,TYPCALL=BALR @VA14153 00133000
- LR 12,1 ... 00134000
- AR PTR,12 FORM COMPLETE FLAGS BWORD 00135000
- ST PTR,FLAGS STORE BASE IN FLAGS 00136000
- XC LIBCNT(12),LIBCNT SET LIBCNT,OLDTBLNG,& LDRCNT 00137000
- MVC LDRPTR(4),TBLREF SET LOCATION OF TAB ENTRYS 00138000
- SPACE 2 00139000
- SYSCHK MVC LIBSAV(60),APSV SAVE REGS IN MY FREE 00140000
- LA PLISTR,TXTLIBS ADDRESS OF TXTLIB LIST 00141000
- OI FLAGS,SETLIB INDICATE SETUP DONE 00142000
- SPACE 2 00143000
- LISTLOOK LA CNT,LIBS MAX NUMBER OF LIBRARIES 00144000
- LA INC,1 SETUP FOR LIBCNT 00145000
- LA INDEX,LIB1NAM INSERT NAMES IN SEQUENCE 00146000
- LISTLOOP CLI 0(PLISTR),X'FF' END OF LIST? 00147000
- BE ENDLOOK YES, QUIT LOOKING 00148000
- LA INC,1(0,INC) UPDATE CNT 00149000
- MVC 0(8,INDEX),0(PLISTR) PUT LIBE NAME IN LIST 00150000
- LA INDEX,24(0,INDEX) UPDATE LIBE LIST PTR 00151000
- LA PLISTR,8(0,PLISTR) UPDATE P LIST PTR 00152000
- BCT CNT,LISTLOOP BACK FOR ANOTHER 00153000
- SPACE 2 00154000
- ENDLOOK BCTR INC,0 COUNT MINUS 1 00155000
- ST INC,LIBCNT SAVE NO. OF LIBRARIES 00156000
- LTR INC,INC IS IT ZERO? 00157000
- BZ SRCHSET+4 NO LIBS GIVEN 00158000
- EJECT 00159000
- DICTSET EQU * 00160000
- L CNT,LIBCNT GET NUM OF LIBES TO READ 00161000
- LA INDEX,LIB1NAM START WITH FIRST 00162000
- MVC FILE(8),FNAME SAVE PRESENT FILE NAME 00163000
- LA R1,TXTDIRC-12 SET R1 FOR DIRECTORY SET 00164000
- SETLOOP L R1,12(R1) ADDR OF NEXT TXTLIB DIR BLK 00165000
- MVC 8(16,INDEX),16(R1) MOVE ESSENTIAL INFO. 00166000
- LA INDEX,24(0,INDEX) UPDATE PTR TO LIBE NAMES IN LIS 00167000
- BCT CNT,SETLOOP PROCESS ANOTHER LIBE FILE 00168000
- B SRCHSET+4 NOW GO SEARCH LIBRARIES 00169000
- SPACE 00170000
- EJECT 00177000
- *********************************************************************** 00178000
- * 00179000
- * SEARCH CORE-RESIDENT LIBRARY DIRECTORIES 00180000
- * 00181000
- *********************************************************************** 00182000
- SRCHSET STM 14,12,LIBSAV SAVE REGISTERS IN MY FREE 00183000
- LM TEMP,PTR,OLDTBLCT GET PREVIOUS TABLE PARAMS 00184000
- AH CNT,TBLCT CORRECT NUM LEFT IN TAB 00185000
- SR CNT,TEMP ... 00186000
- LH TEMP,TBLCT GET NEW TBLCT 00187000
- STM TEMP,PTR,OLDTBLCT SAVE FOR NEXT TIME 00188000
- LA DEC,20 SET FOR LOOKING AT LDRTBL 00189000
- SPACE 00190000
- LDRGO LM CNT,PTR,LDRCNT GET PRESENT LDRTBL PARAMS 00191000
- LTR CNT,CNT ANY MORE ENTRYS? 00192000
- BZ RETURN NO, RETURN TO CALLER @VM08899 00193000
- LDRLOOK SR PTR,DEC UPDATE PTR 00194000
- CLI 8(PTR),X'80' UNDEFINED? 00195000
- BE UNDEF YES, LOOK IN LIBE @VA14274 00195700
- CLI 8(PTR),X'83' WXTRN? @VA14274 00195800
- BNE NXTENTRY NO,GO TO NEXT ENTRY IN LDR TABLE @VA14274 00195900
- CLC CMNDLIST(8),INCLUDE INCLUDE COMMAND ??? @VA14274 00196000
- BNE NXTENTRY @VA14274 00196100
- LA R15,CMNDLIST+8 POINT TO COMMAND PARAMETERS @VA14274 00196200
- LA R4,8 LOAD INCREMENT @VA14274 00196300
- L R5,PARMLIST POINT TO OPTIONS IN COMMAND @VA14274 00196400
- SR R5,R4 ...AND SET A FENCE FOR BXLE @VA14274 00196500
- NEXTPARM CLC 0(8,PTR),0(R15) DO NAMES MATCH? @VA14274 00196600
- BE UNDEF YES, OVERRIDE WXTRN @VA14274 00196700
- BXLE R15,R4,NEXTPARM LOOK NEXT PARAM. IN COMMAND @VA14274 00196800
- NXTENTRY EQU * @VA14274 00196900
- BCT CNT,LDRLOOK LOOK AT NEXT ENTRY @VA14274 00197000
- B RETURN NO MORE ENTRY'S, RETURN @VM08899 00198000
- SPACE 00199000
- UNDEF BCTR CNT,0 DECREASE CNT BY ONE 00200000
- STM CNT,PTR,LDRCNT SAVE PRESENT LDRTBL PARAMS 00201000
- LM NAMA,NAMB,0(PTR) GET UNDEFINED NAME 00202000
- SPACE 00203000
- TM FLAG2,NOAUTO HAS AUTO TEXT LOAD BEEN SUPPRESSED 00204000
- BO LIBSERCH YES, GO TO LIBRARY SEARCH 00205000
- MVI FMODE,X'00' SEE IF 'TEXT' FILE EXISTS 00206000
- STM NAMA,NAMB,FNAME ... 00207000
- STM NAMA,NAMB,FINIS+8 ... 00208000
- MVC FTYPE(8),=CL8'TEXT' ... 00209000
- MVC RDISK(8),STATESET SET PLIST FOR STATE 00210000
- LA 1,RDISK ... 00211000
- L R15,ASTATE CHECK FOR TEXT V0217 00212100
- BALR R14,R15 V0217 00212200
- BNZ LIBSERCH BRANCH IF NOT FOUND V0217 00212300
- B RETN FOUND, RETURN TO LOADER TO PROCESS 00214000
- SPACE 00215000
- LIBSERCH EQU * 00216000
- TM FLAG2,NOLIBE HAS LIBRARY SEARCH BEEN SUPPRESSED 00217000
- BO LDRGO YES, CHECK NEXT LDR TBL NAME V0217 00218100
- L CNT,LIBCNT GET NO OF LIBES 00219000
- LTR CNT,CNT IS NUM ZERO? 00220000
- BZ LDRGO YES, TRY NEXT V0217 00221100
- LA INDEX,LIB1NAM START WITH FIRST 00222000
- SPACE 00223000
- AGAIN LM PTR,COMP,12(INDEX) SETUP BXLE FOR CURRENT LIBE DIC 00224000
- SR COMP,INC POINT TO LAST ENTRY @VA01364 00224100
- SEARCH CL NAMB,4(0,PTR) DOES SECOND HALF MATCH? 00225000
- BNE NOTYET NO - TRY NEXT ENTRY 00226000
- CL NAMA,0(0,PTR) DOES FIRST HALF MATCH? 00227000
- BE FND YES - TERMINATE 00228000
- NOTYET BXLE PTR,INC,SEARCH KEEP LOOKING 00229000
- LA INDEX,24(0,INDEX) UPDATE LIBE PTR 00230000
- BCT CNT,AGAIN TRY ANOTHER LIBRARY 00231000
- B LDRGO NOT IN ANY LIBE, GET NEXT ENTR 00232000
- SPACE 2 00233000
- FND MVC FNAME(8),0(INDEX) PUT LIBE NAME IN P LIST 00234000
- MVC FTYPE(8),RDSET SET TYPE TO 'TXTLIB' 00235000
- L R1,LDRCNT+4 GET LDR TBL PTR 00237000
- OI 16(R1),X'04' INDICATE NAME FOUND IN TXTLIB 00238000
- TM 11(R7),X'80' IS THIS AN ALIAS 00239000
- BO FND1 YES 00240000
- OI OSSFLAGS,DYMBRNM NO, TELL DMSSLN TO USE STRTADDR 00241000
- FND1 LH PTR,8(0,PTR) GET THIRD WORD OF DICTIONARY ENTRY 00242000
- STH PTR,RADD ... 00243000
- MVI FMODE,X'00' ... 00244000
- LA 1,RDISK ... 00245000
- L R15,APOINT SET READ POINTER TO MEMBER V0217 00246100
- BALR R14,R15 V0217 00246200
- BNZ PTERR BRANCH IF ERROR V0217 00246300
- RETN EQU * 00248000
- MVC RDISK(8),RDBUFSET RESET CALL TO RDBUF 00249000
- BAL 2,SETLIST PUT LIST BACK FOR LDR 00250000
- LM 14,12,LIBSAV RESTORE REGISTERS 00251000
- LA 11,1 RESET REG 11 00252000
- BR 3 RETURN TO CALLER 00253000
- EJECT 00254000
- CLOSE LA R1,RDISK SET TO CLOSE ALL TXTLIBS P3063 00255000
- L R0,LIBCNT TXTLIB COUNT P3063 00256000
- LTR R0,R0 IS IT ZERO P3063 00257000
- BZ FREEWK YES, DON'T ISSUE ANY FINIS' P3063 00258000
- LA INDEX,LIB1NAM POINT LIBRARY LIST @VA05578 00259100
- MVC RDISK(8),FINISET SET FUNCTION CODE @V305665 00260100
- MVC RDISK+16(10),RDSET SET FTYPE AND MODE P3063 00261000
- FINISLP MVC FNAME(8),0(INDEX) FIRST (NEXT) NAME TO PLIST @VA05578 00262100
- L R15,AFINIS GET ADDRESS OF FINIS ROUTINE @V305665 00263100
- BALR R14,R15 AND CLOSE THE FILE @V305665 00263200
- LA INDEX,24(INDEX) POINT TO NEXT LIBRARY NAME @VA05578 00265100
- BCT R0,FINISLP CLOSE ALL LIBS P3063 00266000
- FREEWK LA R0,MYFREESZ FREEE DMSLIB WORK AREA P3063 00267000
- LR 1,12 ... 00268000
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00269000
- SR 0,0 GET A ZERO 00270000
- ST 0,FLAGS KILL THE FLAG INDICATORS 00271000
- B RETURN BACK TO CALLER 00272000
- SPACE 00273000
- RDERR LA 5,RDERRN GET READ ERR MESS NUM 00274000
- B PANIC GO TAKE CARE OF MESSAGE 00275000
- PTERR LA 5,PTERRN GET POINT ERR MESS NUM 00276000
- PANIC MVC OUTBUF(18),FNAME PUT FILENAME IN MSG BUFFER 00277000
- LR R12,R5 SAVE CODE P3063 00278000
- LM R14,R11,APSV RESTORE REGS P3063 00279000
- LR R5,R12 RESTORE CODE REG P3063 00280000
- L R15,=V(DMSLDRD) 00281000
- BR R15 FATAL ERROR 00282000
- EJECT 00283000
- SPACE 2 00284000
- SETLIST LA 1,SPEC RESET BUFF ADDRESS 00285000
- ST 1,RADD ... 00286000
- SR 0,0 GET A ZERO 00287000
- STH 0,RITEM RESET ITEMNUM 00288000
- LA 0,10 GET 10 00289000
- STH 0,RNUM RESET NUM OF ITEMS 00290000
- LA 0,800 RESET BUFF LENGTH 00291000
- ST 0,RLENG ... 00292000
- MVI FMODE,C' ' RESET FMODE TO ' ' 00293000
- BR 2 BACK TO CALLER (INTERNAL) 00294000
- EJECT 00295000
- DS 0D @VA14274 00296000
- INCLUDE DC CL8'INCLUDE' INCLUDE COMMAND @VA14274 00296500
- FINISET DC CL8'FINIS' @VA14274 00297000
- STATESET DC CL8'STATE' 00299000
- RDBUFSET DC CL8'RDBUF' 00300000
- SPACE 00301000
- RDSET DC CL8'TXTLIB' 00302000
- DC CL2' ' 00303000
- DC H'0' 00304000
- DC A(0) 00305000
- DC A(800) ,00 BYTE BUFF (TEN CARDS) 00306000
- DC CL2'F' 00307000
- DC H'1' 00308000
- SPACE 2 00309000
- LTORG 00309100
- EJECT 00312000
- LIBS EQU 8 MAXIMUM NUMBER OF LIBRARIES 00313000
- SPACE 2 00314000
- MYFREE DSECT 00315000
- LIBCNT DS F 00316000
- OLDTBLCT DS F 00317000
- LDRCNT DS F 00318000
- LDRPTR DS F 00319000
- LIB1NAM DS 2F 00320000
- LIB1FNUM DS F 00321000
- LIB1BXLE DS 3F 00322000
- MORELIBS DS (LIBS*6-6)F 00323000
- LIBSAV DS 16F 00324000
- MYFREEND DS 0D 00325000
- SPACE 00326000
- MYFREESZ EQU (MYFREEND-MYFREE)/8 00327000
- SPACE 00328000
- DEC EQU 2 00329000
- ITEM EQU 2 00330000
- ADD EQU 3 00331000
- NAMA EQU 4 00332000
- NAMB EQU 5 00333000
- PLISTR EQU 5 00334000
- TEMP EQU 5 00335000
- CNT EQU 6 00336000
- PTR EQU 7 00337000
- INC EQU 8 00338000
- COMP EQU 9 00339000
- INDEX EQU 10 00340000
- SPACE 00341000
- NOERRN EQU 56 IO INDEX 00342000
- RDERRN EQU 62 IO INDEX 00343000
- PTERRN EQU 66 IO INDEX 00344000
- EJECT 00345000
- LDRST 00346000
- EJECT 00347000
- NUCON 00348000
- RDISK EQU READBUF 00349000
- HITEM EQU SPEC+16*4 00350000
- HLST EQU SPEC+17*4 00351000
- NUMITEM EQU SPEC+18*4 00352000
- NUMFREE EQU SPEC+19*4 00353000
- RREAD EQU NUMBYTE 00354000
- FSTB 00355000
- REGEQU 00356000
- EJECT 00357000
- END 00358000
ibm/vm370-lib/cms/dmslib.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator