ibm:vm370-lib:cms:dmsldr.assemble_src
Table of Contents
DMSLDR Source
References
- Fixes Applied : 15
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC309DS]
Source Listing
- DMSLDR.ASSEMBLE.txt
- LDR TITLE 'DMSLDR (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * 00004000
- * 00005000
- * 00006000
- * MODULE NAME: 00007000
- * 00008000
- * DMSLDR (LDR) 00009000
- * 00010000
- * FUNCTION: 00011000
- * 00012000
- * THIS MODULE CONSISTS OF THE FOLLOWING LOADER ROUTINES: 00013000
- * DMSLDRA, DMSLDRB 00014000
- * 00015000
- * SUBROUTINE NAME: 00016000
- * 00017000
- * DMSLDRA 00018000
- * 00019000
- * FUNCTION: 00020000
- * 00021000
- * TO BEGIN EXECUTION OF A GROUP OF PROGRAMS LOADED INTO 00022000
- * CORE. DEFINITION OF ALL UNDEFINED PROGRAMS IN 00023000
- * ESTABLISHED AS AT LOCATION ZERO. 00024000
- * 00025000
- * ATTRIBUTES: 00026000
- * 00027000
- * REENTRANT, NUCLEUS RESIDENT 00028000
- * 00029000
- * ENTRY POINTS: 00030000
- * 00031000
- * DMSLDRA - FROM START COMMAND OR INTERNALLY FROM DMSLDRB LDT 00032000
- * ROUTINE IF START SPECIFIED 00033000
- * 00034000
- * ENTRY CONDITIONS: 00035000
- * 00036000
- * R1 - PLIST 00037000
- * 00038000
- * EXIT CONDITIONS: 00039000
- * 00040000
- * NORMAL - 00041000
- * EXIT BACK TO DMSLDRB TO BEGIN EXECUTION OF 00042000
- * LOADED PROGRAM 00043000
- * 00044000
- * ERROR - 00045000
- * RETURN TO CALLER FOR 00046000
- * FOLLOWING ERRORS: MEMORY EXCEEDED, STARTING NAME 00047000
- * ILLEGAL 00048000
- * 00049000
- * CALLS TO OTHER ROUTINES: 00050000
- * 00051000
- * DMSLIO - TO PRINT MESSAGES 00052000
- * DMSLSBC - TO DEFINE UNDEFINED ENTRIES AT ZERO 00053000
- * SERCH1 - IN DMSLDRB TO FIND STARTING NAME'S LOCATION 00054000
- * 00055000
- * EXTERNAL REFERENCES: 00056000
- * 00057000
- * NUCON, REFTBL 00058000
- * 00059000
- * TABLES/WORKAREAS: 00060000
- * 00061000
- * NONE 00062000
- * 00063000
- * REGISTER USAGE: 00064000
- * 00065000
- * | R8,R9 BASE 00066000
- * R13 - LDRST 00067000
- * | REST WORK 00068000
- * 00069000
- * OPERATION: 00070000
- * 00071000
- * THE START EXECUTION ROUTINE RECEIVES CONTROL FROM THE 00072000
- * START COMMAND OR THE LDT CARD ROUTINE IF THE START OPTION 00073000
- * WAS SPECIFIED. THE START EXECUTION ROUTINE: 00074000
- * 00075000
- * 1. INITIALIZES FREE STORAGE. 00076000
- * 00077000
- * 2. CALLS THE DISK AND TYPE OUTPUT PROGRAM (DMSLIO) TO 00078000
- * PRINT A STORAGE MAP HEADER FOR COMMON, IF THE 00079000
- * REFTBL CONTAINS ANY COMMON ENTRIES. 00080000
- * 00081000
- * 3. SEARCHES THE REFTBL FOR ENTRIES WITH A NONZERO 00082000
- * FLAG (COMMON, CXD, PR, AND REFERENCES TO UNDEFINED 00083000
- * SYMBOLS). 00084000
- * 00085000
- * A. A POINTER TO PR ENTRY IS PLACED IN A SEPARATE 00086000
- * TABLE DEPENDING UPON PR ALIGNMENT: BYTE, 00087000
- * HALFWORD, FULLWORD, OR DOUBLEWORD. 00088000
- * 00089000
- * B. A CXD ENTRY IS MARKED "UNDEFINED" FOR LATER 00090000
- * PROCESSING AND A POINTER PLACED IN SPECIAL 00091000
- * CXD TABLE. 00092000
- * 00093000
- * C. A COMMON IS DEFINED AT THE NEXT AVAILABLE 00094000
- * LOAD LOCATION AND THE LOCATION COUNTER 00095000
- * (LOCCNT) IS INCREASED BY THE LENGTH OF THE 00096000
- * COMMON. REFERENCES TO THE COMMON ARE 00097000
- * PROCESSED BY CALLED ADDEF. THE NAME, 00098000
- * ADDRESS, AND LENGTH OF THE COMMON ARE PRINTED 00099000
- * BY CALLING DMSLIO VIA CMVAL. 00100000
- * 00101000
- * D. A REFERENCE TO AN UNDEFINED SYMBOL IS 00102000
- * REPLACED BY A VALUE OF ZERO BY CALLING ADDEF. 00103000
- * 00104000
- * 4. AFTER SCANNING ENTIRE REFTBL, THE DISK AND TYPE 00105000
- * OUTPUT PROGRAM (DMSLIO) IS CALLED TO PRINT A 00106000
- * STORAGE MAP HEADER FOR PR'S, IF THERE ARE ANY 00107000
- * PSEUDO-REGISTER ENTRIES IN THE REFTBL. THE NAME, 00108000
- * VALUE, AND LENGTH OF EACH PR (THEY WERE DEFINED 00109000
- * EARLIER WHEN ESD WAS FIRST ENCOUNTERED) ARE 00110000
- * PRINTED AS WELL AS THE CXD REQUEST, WHICH CAN ONLY 00111000
- * BE DETERMINED AFTER ALL PR'S HAVE BEEN ASSIGNED. 00112000
- * 00113000
- * 5. THE STARTING ADDRESS FOR EXECUTION IS THEN 00114000
- * DETERMINED: BY ENTRY-POINT NAME IS SUPPLIED, BY 00115000
- * START COMMAND OR BY THE START EXECUTION ADDRESS 00116000
- * (IN BRAD) SET BY FIRST PROGRAM LOADED, END CARD, 00117000
- * LDT CARD, OR ENTRY CONTROL CARD. 00118000
- * 00119000
- * 6. A. IF ACTUAL EXECUTION IS SUPPRESSED, FOR 00120000
- * EXAMPLE, BY SPECIFYING START (NO) COMMAND, 00121000
- * 00122000
- * THE LIBRARY IS CLOSED, LOAD MAP CLOSED, FREE 00123000
- * STORAGE RELEASED, AND CONTROL RETURNED TO 00124000
- * CALLER. OTHERWISE, EXECUTION IS PERFORMED BY 00125000
- * SETP 6B. 00126000
- * 00127000
- * B. THE MESSAGE "EXECUTION BEGINS" IS PRINTED, 00128000
- * IF THE CMS/DOS ENVIRONMENT IS NOT ACTIVE 00129000
- * ( DOSCOMP+DOSSVC ). THE GETMAIN/FREEMAIN 00130000
- * STORAGE IS INITIALIZED (STRINIT). IF THE 00131000
- * CMS/DOS ENVIRONMENT IS ACTIVE ( DOSSVC), 00132000
- * A CALL IS MADE TO DMSSMNAT TO INITIALIZE 00133000
- * THE CMS/DOS PARTITION. 00134000
- * THE SAVE AREA ADDRESS IS SET IN REGISTER 00135000
- * 13, THE ENTRY POINT OF THE PROGRAM IS SET 00136000
- * IN REGISTER 15, THE RETURN ADDRESS IS SET 00137000
- * IN REGISTER 14, AND THE ADDRESS TO THE 00138000
- * PROGRAM'S PLIST IS SET IN REGISTER 1. 00139000
- * An extended PLIST is supplied in R0. HRC309DS 00139200
- * IF THE CMS/DOS ENVIRONMENT IS ACTIVE 00140000
- * ( DOSCOMP+DOSSVC ), REGISTER 1 WILL THEN 00141000
- * CONTAIN THE ENTRY POINT ADDRESS OF THE 00142000
- * PROGRAM TO BE EXECUTED. 00143000
- * CONTROL IS THEN TRANSFERRED TO THE LOADED 00144000
- * PROGRAM VIA 'LPSW' INSTRUCTION. 00145000
- * @VA04695 00146000
- * NOTE: ANY CHANGES MADE TO THIS MODULE SHOULD ALSO @VA04695 00147000
- * BE CONSIDERED FOR DMSOLD. @VA04695 00148000
- *. 00149000
- EJECT 00150000
- DMSLDRA START 00151000
- * 00152000
- ENTRY DMSLDRB,DMSLDRC,DMSLDRD 00153000
- EXTRN DMSLIO 00154000
- EXTRN DMSLSBA,DMSLSBC,DMSLSBB 00155000
- USING LDRST,R13 00156000
- * 00157000
- RELDR EQU * 00158000
- BALR R8,0 00159000
- BCTR R8,0 00160000
- BCTR R8,0 00161000
- USING RELDR,R8,R9 00162000
- B LDRSTA 00163000
- DC X'CCCC' 00164000
- DC C'DMSLDR' 00165000
- DC X'CCCC' 00166000
- EJECT 00167000
- REGEQU 00168000
- LDRSTA LA R9,4095(0,R8) SET SECOND BASE REG 00169000
- LA R9,1(0,R9) 00170000
- BAL R4,INIT GET AND INITIALIZE WORK AREA 00171000
- USING XPRTAB,10 FREE TABLES 00172000
- USING NUCON,R0 00173000
- OI FLAGS,START INDICATE START REQUESTED 00174000
- SPACE 2 00175000
- LDXEQ EQU * 00176000
- LA 10,SPEC USE SPEC & ESIDTB FOR FREE 00177000
- SR 6,6 GET 0 00178000
- ST 6,HALFAD CLEAR SOME OF FREE 00179000
- ST 6,BYTEAD ... 00180000
- ST 6,FULLAD ... 00181000
- ST 6,DBLAD ... 00182000
- ST 6,CXDAD ... 00183000
- MVC COMMON(4),LOCCNT 00184000
- L 12,TBLREF POINT TO FIRST ITEM IN REFERENC 00185000
- LH 4,TBLCT 00186000
- LTR R4,R4 ANY LOADER TABLE ENTRIES 00187000
- BZ XREST NO, OMIT LOAD COMPLETION 00188000
- LA 3,20 00189000
- L 7,AADDEF TR 00190000
- SPACE 2 00191000
- TM FLAG1,COMMONEX DO COMMON ENTRIES EXIST 00192000
- BZ S1 NO, DON'T PRINT HEADER 00193000
- NI LDRFLAGS,255-COMMONEX RESET COMMON BIT @VA14133 00194000
- LA 5,CMDEF GET IO INDEX FOR HEADER 00195000
- L 11,ALDRIO GET LINKAGE 00196000
- BALR 14,11 GO PRINT HEADING 00197000
- EJECT 00198000
- S1 SR 12,3 NEXT ENTRY IN REFTBL 00199000
- CLI 8(12),X'00' IS ENTRY DEFINED 00200000
- BE N1 YES LOOK AT NEXT 00201000
- TR 8(1,R12),TRANPR TRANSLATE FLAG TO INDEX @VA08891 00201500
- SR 6,6 GET 0 00203000
- LR 1,6 DEFINE UNDEFS AT 0 00204000
- IC 6,8(0,12) GET ENTRYS FLAG BYTE 00205000
- SLL 6,1 MULTIPLY BY 2 00206000
- LH 6,XTRATBL(6) INDEX TRANSFER TABLE 00207000
- B 0(6,R8) GO TO APPROPRIATE ROUTINE 00208000
- N1 BCT 4,S1 BACK FOR MORE ENTRIES 00209000
- SPACE 2 00210000
- TM FLAG1,PREXIST ARE THERE ANY PR ENTRIES 00211000
- BZ XREST NO, SKIP PR EVALS 00212000
- NI LDRFLAGS,255-PREXIST RESET PR PENDING BIT @VA14133 00213000
- LA 5,PRDEF IO INDEX FOR P-R HEADER 00214000
- L 11,ALDRIO PRINT HEADING 00215000
- BALR 14,11 ... 00216000
- SPACE 3 00217000
- LA 3,DBLAD ADDRESS OF DBL PR TBL 00218000
- BAL R15,XPRPRT PRINT OUT DOUBLE AL PR 00219000
- LA 3,FULLAD ADDRESS OF FULL PR TBL 00220000
- BAL R15,XPRPRT PRINT FULL AL PR 00221000
- LA 3,HALFAD ADDRESS OF HALF PR TBL 00222000
- BAL R15,XPRPRT PRINT HALF AL PR 00223000
- LA 3,BYTEAD ADDRESS OF BYTE PR TBL 00224000
- BAL R15,XPRPRT PRINT BYTE AL PR 00225000
- LA 3,CXDAD ADDRESS OF CXD TBL 00226000
- BAL R15,XPRPRT PRINT CXD LENGTH 00227000
- SPACE 1 00228000
- XREST L R1,PARMLIST CHECK FOR STARTING NAME 00229000
- CLI 0(1),X'FF' IS THERE A NAME 00230000
- BE XREST1 NO, USE DEFAULT START @VA00857 00231000
- CLI 0(R1),C'*' IS IT START * @VA00857 00232000
- BE XREST1 YES, DEFAULT START @VA00857 00233000
- CLI 0(R1),C'(' NAME SPECIFIED @VA00857 00234000
- BNE C6AD3 YES, GO LOOK IT UP @VA00857 00235000
- CLC 8(8,R1),=CL8'NO' START (NO) @VA00896 00236000
- BE XREST2 YES @VA00896 00237000
- MVC PARMLIST(4),FRSTSDID SET PARMLIST TO END @VA00896 00238000
- XREST1 L 0,BRAD NO - GET TRANSFER ADDRESS ALREA 00239000
- LTR 0,0 IS THERE ONE 00240000
- BC 8,C6AD4 NO - GO TO FIRST PROG. LOADED 00241000
- B EXEC START EXECUTION 00242000
- SPACE 00243000
- XREST2 EQU * 00244000
- NI FLAGS,255-START RESET START INDICATOR 00245000
- B EXEC2 00246000
- EJECT 00247000
- EXEC L R4,STRTADDR GET 'LOADED' START ADDRESS 00248000
- CLC 4(8,R4),=C'CMS"XEQ"' INITIALIZATION ROUTINE? 00249000
- BNE EXEC1 NO. RESET 'STADDR'. 00250000
- CR R0,R4 SAME POINTER? 00251000
- BE EXEC1 YES. LEAVE ALONE. 00252000
- ST R0,12(,R4) SET USER START POINT INTO "CMSXEQ". 00253000
- LR R0,R4 GET R0= STADDR 00254000
- EXEC1 LTR R4,R0 WAS A STARTING LOCATION FOUND 00255000
- BZ ERR455 NO, ERROR 00256000
- CLC 0(2,R4),=XL2'00' IS THE LOCATION VALID 00257000
- BE ERR455 NO, ERROR 00258000
- LH R6,TBLCT GET LDR TBL COUNT 00259000
- CH R6,=H'2' GREATER THAN TWO 00260000
- BNH ERR455 NO, NOTHING LOADED 00261000
- EXEC2 ST R0,PSW+4 STORE BRANCH ADDR INTO PSW 00262000
- L R4,LOCCNT GET LOCATION COUNTER 00263000
- LA 4,7(0,4) ALIGN TO DBL WRD BOUND 00264000
- N 4,DBLBND ... 00265000
- ST R4,LOCCNT ... 00266000
- C R4,AUSRAREA IS IT LESS THAN 20,000 ? @VA05623 00267000
- BL NOSTOR YES, DONT STORE IN MAINHIGH @VA05623 00268000
- ST R4,MAINHIGH DEFINE AS USER LAST LOC @VA05623 00269000
- NOSTOR DS 0H @VA05623 00270000
- SR R4,R4 NO ERRORS 00271000
- TM FLAGS,START WAS EXECUTION REQUESTED 00272000
- BNO N03 NO, NORMAL RETURN 00273000
- MVI OSSFLAGS,X'00' CLEAR OS FLAGS @VA09702 00273500
- B N023 YES - GO TO XEQ FUDGE 00274000
- ERR455 LA R5,ERRORI MSG CODE FOR DMSLIO 00275000
- B FATERR TERMINATE THIS COMMAND 00276000
- SPACE 3 00277000
- XDBL LA 6,DBLAD ADDRESS OF DBL PR TBL 00278000
- LA R14,HALFAD-DBLAD SIZE OF DOUBLE TABLE 00279000
- B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY 00280000
- XFULL LA 6,FULLAD ADDRESS OF FULL PR TBL 00281000
- LA R14,DBLAD-FULLAD SIZE OF FULL TABLE 00282000
- B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY 00283000
- XHALF LA 6,HALFAD ADDRESS OF HALF PR TBL 00284000
- LA R14,BYTEAD-HALFAD SIZE OF HALF TABLE 00285000
- B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY 00286000
- XBYTE LA 6,BYTEAD LOC OF BYTE PR TBL 00287000
- LA R14,COMMON-BYTEAD SIZE OF BYTE TABLE 00288000
- B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY 00289000
- XCXD LA 6,CXDAD LOC OF PR CUM LENGTH TBL 00290000
- LA R14,8 SIZE OF CXD FIELD 00291000
- OI 8(12),X'80' UNDEFINE IT 00292000
- B PRVSAVE GO SAVE LOC OF PR CUM LENGTH 00293000
- XUNDEF MVI 8(12),X'80' RESET UNDEF BIT 00294000
- XC 0(8,12),0(12) ZERO OUT UNDEFINED ENTRY @VM01416 00295000
- BALR 14,7 DEFINE ENTRY AT 0 00296000
- B N1 RETURN TO LOOK AGAIN 00297000
- SPACE 2 00298000
- XCOMSET L 1,COMMON GET CURRENT LOC OF COMMON 00299000
- L 2,8(,12) GET LENGTH OF CSECT 00300000
- LA R2,0(0,R2) CLEAR HIGH ORDER BYTE 00301000
- LA 1,7(,1) 00302000
- N 1,DBLBND ALIGN TO DOUBLE WRD 00303000
- LR 6,1 SAVE BEGINNING OF THIS COMMON SECT 00304000
- AR 6,2 ADD THE LENGTH 00305000
- ST 6,COMMON RESET COMMON LOCATION COUNTER 00306000
- ST R6,LOCCNT RESET LOCATION COUNTER 00307000
- OI 8(12),X'80' UNDEFINE THE ENTRY 00308000
- BAL 6,XENTDEF NO, GO DEFINE ENTRY 00309000
- LA 5,CMVAL IO INDES FOR COMMON PRINT 00310000
- L 11,ALDRIO PRINT NAME, VAL + LENGTH 00311000
- BALR 14,11 ... 00312000
- CLC COMMON,FREELOWE IS MEMORY EXCEEDED 00313000
- BNL FATERR1 YES, GIVE FATAL ERROR MESSAGE AND GIVE UP 00314000
- B N1 BACK TO LOOK AGAIN 00315000
- PRVSAVE LH 1,0(0,6) GET DISP OF NEXT LOC IN TBL 00316000
- LA 1,2(0,1) ... 00317000
- CR R1,R14 WILL TABLE OVERFLOW 00318000
- BNL PRTBLOVR YES, FATAL ERROR 00319000
- LH 2,TBLCT TOTAL NO OF ENTRIES IN REFTBL 00320000
- SR 2,4 MINUS CNT GIVES INDEX FROM TOP 00321000
- LA 2,1(0,2) OFF BY 1 00322000
- STH 2,0(1,6) PUT INTO TBL 00323000
- STH 1,0(0,6) SAVE TBL INDEX 00324000
- B N1 BACK TO LOOK AGAIN 00325000
- PRTBLOVR LA R5,PROVER DMSLIO CODE 00326000
- B FATERR TERMINATE 00327000
- EJECT 00328000
- XENTDEF EQU * 00329000
- BALR 14,7 GO DEFINE ENTRY 00330000
- ST 1,12(0,12) SET LOCATION IN LOADER TABLE 00331000
- MVI 8(12),X'00' CLEAR FLAG BYTE 00332000
- BR 6 BACK TO CALLER 00333000
- SPACE 2 00334000
- SPACE 2 00335000
- XPRPRT LH 4,0(0,3) GET ENTRY COUNT FROM TABLE 00336000
- LTR 4,4 ANYTHING IN TBL 00337000
- BCR 8,R15 NO BACK TO CALLER 00338000
- XPRSET2 L 12,TBLREF ADDRESS OF REFTBL TOP 00339000
- LA 3,2(0,3) INDEX PTR 00340000
- LH 2,0(0,3) GET REFTBL INDEX 00341000
- MH R2,=H'20' MULTIPLY BY 20 00342000
- SR 12,2 GET ADDRESS OF ENTRY 00343000
- L 1,12(0,12) GET VALUE FROM REFTBL 00344000
- LH R5,PRVCNT GET PRESENT PR COUNT 00345000
- LH 2,10(0,12) GET LENGTH OF PR ENTRY 00346000
- AR 2,1 ADD TO VALUE 00347000
- CLI 8(12),X'84' IS THIS A CXD? 00348000
- BNE XPRCNT NO - PROCEED NORMALLY 00349000
- LR 1,5 YES - GET PRCNT AS VALUE 00350000
- XPRCNT CLR 2,5 PRESENT PR VAL HIGHEST? 00351000
- BNH XPRDEF NO - DON'T REPLACE 00352000
- STH R2,PRVCNT NO, PUT NEW COUNT IN PRVCNT 00353000
- XPRDEF BAL 6,XENTDEF GO DEFINE ENTRY 00354000
- LA 5,PRVAL IO INDEX FOR PR PRINT 00355000
- L 11,ALDRIO PRINT NAME, VAL + LENGTH 00356000
- BALR 14,11 ... 00357000
- XC 0(8,R12),0(R12) CLEAR PR FROM TABLE @V1D1705 00358000
- BCTR 4,0 SUBTRACT 1 00359000
- BCT 4,XPRSET2 BACK FOR ANOTHER ENTRY 00360000
- BR R15 RETURN TO CALLER 00361000
- SPACE 3 00362000
- C6AD3 LA 2,ERLDT GRIPE IF NAME NOT FOUND 00363000
- BAL 3,SERCH1 00364000
- CA6D4 L R0,12(0,R12) PICK UP ABS. ADDR. OF NAME 00365000
- BC 15,EXEC 00366000
- C6AD4 L 12,TBLREF ADDRESS OF REFTBL TOP 00367000
- LA R6,60 3RD ENTRY IN LOADER TABLE 00368000
- SR 12,6 00369000
- BC 15,CA6D4 00370000
- EJECT 00371000
- *. 00372000
- * SUBROUTINE NAME: 00373000
- * 00374000
- * DMSLDRB 00375000
- * 00376000
- * FUNCTION: 00377000
- * 00378000
- * TO INITIALIZE FOR AND TO PERFORM EACH LOADING OPERATION 00379000
- * BY PROCESSING TEXT FILES WHICH MAY CONTAIN THE 00380000
- * FOLLOWING CARDS: SLC, ICS, ESD, TXT, REP, RLD, END, 00381000
- * LDT, LIBRARY, AND ENTRY. 00382000
- * 00383000
- * ATTRIBUTES: 00384000
- * 00385000
- * REENTRANT, NUCLEUS RESIDENT 00386000
- * 00387000
- * ENTRY POINTS: 00388000
- * 00389000
- * DMSLDRB - ENTERED FROM DMSLDP WHEN LOAD FUNCTION IS REQUESTE 00390000
- * DMSLDRC - ENTERED BY VARIOUS LOADER ROUTINES WHEN AN INVALID 00391000
- * CARD IS DETECTED IN A TEXT FILE 00392000
- * DMSLDRD - ENTERED WHEN A FATAL ERROR OCCURS DURING LOADING 00393000
- * 00394000
- * ENTRY CONDITIONS: 00395000
- * 00396000
- * DMSLDRB R1=PLIST, R14=RETURN ADDRESS, 00397000
- * SAVES REGISTERS 9-12 00398000
- * PLIST - CL8'LOAD' 00399000
- * CL8'FILENAME1' 00400000
- * . . . . 00401000
- * CL8'FILENAMEN' 00402000
- * CL8'(' 00403000
- * CL8'OPTIONS' 00404000
- * CL8'FFFFFFFF' 00405000
- * 00406000
- * OPTIONS - 00407000
- * CL8'CLEAR' 00408000
- * CL8'START' 00409000
- * CL8'RESET', CL8'ENTRY NAME' 00410000
- * CL8'INV' OR CL8'NOINV' 00411000
- * CL8'REP' OR CL8'NOREP' 00412000
- * CL8'MAP' OR CL8'NOMAP' 00413000
- * CL8'ORIGIN', CL8'HEX LOCATION'|'TRANS' 00414000
- * CL8'NOLIBE' OR CL8'LIBE' 00415000
- * CL8'NOAUTO' OR CL8'AUTO' 00416000
- * CL8'TYPE' OR CL8'NOTYPE' 00417000
- * 00418000
- * DMSLDRC - INVALID CARD IMAGE IS IN SPEC BUFFER 00419000
- * DMSLDRD R5 = ERROR CODE FOR DMSLIO 00420000
- * 00421000
- * EXIT CONDITIONS: 00422000
- * 00423000
- * NORMAL - RETURN ON R14, LOADING COMPLETE OR EXIT TO 00424000
- * DMSLDRA IF START OPTION SPECIFIED. 00425000
- * 00426000
- * ERROR - ERROR MESSAGE TYPED, RETURN TO CALLER. 00427000
- * 00428000
- * CALLS TO OTHER ROUTINES: 00429000
- * 00430000
- * DMSLSBA - FROM VARIOUS ROUTINES FOR HEX TO BINARY CONVERSION 00431000
- * DMSLSBC - FROM ICS ROUTINE TO DEFINE CSECT, FROM ESD 00432000
- * TYPE 1 TO DEFINE ENTRY 00433000
- * DMSLSY - FROM ESD PRIVATE CODE RTN. 00434000
- * DMSLGTB - TO SETUP TEMPORARY TXTLIB DICTIONARIES. 00435000
- * DMSLIO - FOR ERROR MESSAGES AND LOAD MAP PROCESSING 00436000
- * DMSLIB - TO SEARCH TEXT LIBRARIES FOR UNDEFINED ENTRY NAMES 00437000
- * DMSSLNDY - FROM ESD ROUTINE IF OS LINK OR LOAD WAS ISSUED 00438000
- * DMSSCN - FROM CTLCRD1 TO A TEXT FILE CARD 00439000
- * DMSSMNSB - TO INITIALIZE FREE STORAGE IF START. 00440000
- * DMSBRD - TO READ TEXT FILES AND TXTLIBS. 00441000
- * DMSFNS - TO CLOSE READING 00442000
- * DMSLSBB - FROM RLD ROUTINE TO ADD TO UNDEFINED STRINGS 00443000
- * DMSLSBD - TO PROCESS LOADER OPTIONS 00444000
- * DMSLGTA - TO FREE TXTLIB DIRECTIONS 00445000
- * DMSFREB - FOR FREE STORAGE 00446000
- * 00447000
- * REGISTER USAGE: 00448000
- * 00449000
- * R8,R9 BASE 00450000
- * R13 - LDRST 00451000
- * REST - WORK 00452000
- * 00453000
- * OPERATION: DMSLDRB 00454000
- * 00455000
- * 1. ACQUIRE AND INITIALIZE A WORK AREA (LDRST). 00456000
- * 00457000
- * 2. CALL DMSLIO TO SET UP LOADER I/O OPERATIONS. 00458000
- * 00459000
- * 3. IF TXTLIB DIRECTORIES ARE NOT IN FREE STORAGE, 00460000
- * CALL DMSLGTB TO BRING THEM IN. 00461000
- * 00462000
- * 4. CALL DMSLSBD TO PROCESS LOADER OPTION LIST. 00463000
- * 00464000
- * 5. PROCESS EACH TEXT FILE SEQUENTIALLY BY READING TEN 00465000
- * CARDS AT A TIME, THEN ANALYZING EACH OF THE CARDS 00466000
- * TO DETERMINE ITS TYPE. FOR EACH CARD, BRANCH TO 00467000
- * THE APPROPRIATE ROUTINE. 00468000
- * EACH ROUTINE WILL RETURN TO THIS READ 00469000
- * ROUTINE FOR THE NEXT CARD. 00470000
- * 00471000
- * 6. AT END-OF-FILE ON LAST TEXT FILE OR UPON FINDING 00472000
- * AN LDT CARD, BEGIN TXTLIB SEARCHING TO SATISFY ANY 00473000
- * UNDEFINED REFERENCES (DMSLIB). FOR EACH MATCH 00474000
- * DMSLIB WILL RETURN TO THE READ ROUTINE (IN STEP 5) 00475000
- * TO CONTINUE LOADING. 00476000
- * 00477000
- * 7. WHEN NO MORE MATCHES CAN BE MADE, SAVE SPECIFIED 00478000
- * STARTING ADDRESS, SAVE VALUE OF THE LOCATION 00479000
- * COUNTER, AND LIST ANY UNDEFINED ENTRIES AT THE 00480000
- * TERMINAL. 00481000
- * 00482000
- * 8. IF START EXECUTION WAS REQUESTED, BRANCH TO LDXEQ 00483000
- * IN DMSLDRA. IF NOT, CLOSE TXTLIBS AND FREE THE 00484000
- * WORK AREA. 00485000
- * 00486000
- * 9. RETURN TO DMSLOA. 00487000
- * 00488000
- * NOTE: ANY CHANGES MADE TO THIS MODULE SHOULD 00489000
- * ALSO BE CONSIDERED FOR DMSOLD. 00490000
- *. 00491000
- EJECT 00492000
- DMSLDRB EQU * 00493000
- BALR 12,0 00494000
- USING *,12 00495000
- LM R8,R9,BREG1 SET BASE REGS 00496000
- DROP R12 00497000
- LA 4,PERMIT SETUP TO TEST FOR PRINT CONTROL 00498000
- EJECT 00499000
- *********************************************************************** 00500000
- * 00501000
- * COMMON ROUTINE TO GET AND INITIALIZE THE LOADER 00502000
- * WORK AREA AND TO SET UP LOADER I/O 00503000
- * 00504000
- *********************************************************************** 00505000
- * 00506000
- INIT LR 2,1 SAVE ADDRESS OF PARAM LIST 00507000
- LR 3,14 AND ADDRESS OF RETURN LOCATION 00508000
- LR R11,0 save EPLIST pointer HRC309DS 00508200
- LA 0,NEED GET FREE STORAGE 00509000
- DMSFREE DWORDS=(0),TYPCALL=BALR 00510000
- DROP R13 00511000
- USING LDRST,R1 00512000
- ST R13,REG13SAV PROTECT LDRST REGISTER 00513000
- DROP R1 00514000
- USING LDRST,R13 00515000
- LR 13,1 SAVE ADDR. OF SAVE AREA IN REG. 00516000
- ST 3,RETREG SAVE RETURN 00517000
- LR R1,R2 @VA02828 00518000
- LA R2,8(0,R2) GET TO FILENAMES 00519000
- ST R2,PARMLIST 00520000
- SRL R1,24 RESTORE CALL CODE @VA02828 00521000
- STC R1,PARMLIST @VA02828 00522000
- STM R9,R12,GPRSAV 00523000
- CLI PARMLIST,X'01' was an EPLIST passed to us? HRC309DS 00523025
- BE EPTEST yes, proceed HRC309DS 00523050
- CLI PARMLIST,X'0B' was an EPLIST passed to us? HRC309DS 00523075
- BE EPTEST yes, proceed HRC309DS 00523100
- CLI PARMLIST,X'0D' was an EPLIST passed to us? HRC309DS 00523125
- BNE EPSKIP no, so never mind HRC309DS 00523150
- EPTEST EQU * HRC309DS 00523175
- ST R11,EPARMLST yes, save the EPLIST pointer HRC309DS 00523200
- * We need to adjust the EPLIST, since it currently has START HRC309DS 00523225
- * as the command name. So make EPLCMD point to EPLARGBG, scan HRC309DS 00523250
- * for the second argument, and have EPLARGBG point to it. HRC309DS 00523275
- USING EPLIST,R11 HRC309DS 00523300
- STM R4,R6,EPLSAVE save the registers we are using HRC309DS 00523325
- L R6,EPLARGBG start of arguments & scan start HRC309DS 00523350
- ST R6,EPLCMD new pointer to command HRC309DS 00523375
- L R5,EPLARGND end of arguments HRC309DS 00523400
- BCTR R5,0 decrement for BXLE HRC309DS 00523425
- LA R4,1 loop increment HRC309DS 00523450
- EPLOOP1 EQU * scan for blank after command HRC309DS 00523475
- CLI 0(R6),C' ' is it a space yet? HRC309DS 00523500
- BE EPLOOP2 found it HRC309DS 00523525
- BXLE R6,R4,EPLOOP1 keep looping if not HRC309DS 00523550
- B EPSETEM no arguments HRC309DS 00523575
- EPLOOP2 EQU * scan for start of arguments HRC309DS 00523600
- CLI 0(R6),C' ' is it a space yet? HRC309DS 00523625
- BNE EPSETEM found start of arguments HRC309DS 00523650
- BXLE R6,R4,EPLOOP2 keep looping if not HRC309DS 00523675
- EPSETEM EQU * HRC309DS 00523700
- ST R6,EPLARGBG store start of arguments HRC309DS 00523725
- LM R4,R6,EPLSAVE restore the registers HRC309DS 00523750
- DROP R11 HRC309DS 00523775
- EPSKIP EQU * HRC309DS 00523800
- MVC BRAD(4),STRTADDR MOVE IN STARTING ADDRESS 00524000
- MVC TBLREF(4),ALDRTBLS MOVE IN TOP OF LOADER TBL ADDR 00525000
- MVC TBLCT(2),TBENT MOVE IN NUMBER OF LOADER TABLE ENTRIES 00526000
- MVC LOCCT(4),LOCCNT MOVE IN LOCATION COUNTER 00527000
- XC MEMBOUND(4),MEMBOUND 00528000
- XC LDRADDR+4(4),LDRADDR+4 CLEAR ERROR LOCATION 00529000
- SR 5,5 GET ZERO 00530000
- ST 5,FLAGS CLEAR LIBRARY FLAGS 00531000
- STC R5,FLAG3 CLEAR ANOTHER FLAG AREA @VA01699 00532000
- XC ENTADR,ENTADR CLEAR 'ENTRY' CARD POINTER 00533000
- XC ESIDTB(256),ESIDTB CLEAR ESDID TABLE 00534000
- XC ESIDTB+256(256),ESIDTB+256 CLEAR ESID TABLE @VA02083 00535000
- XC ESIDTB+512(256),ESIDTB+512 CLEAR ESDID TABLE HRC006DS 00535300
- XC ESIDTB+768(256),ESIDTB+768 CLEAR ESID TABLE HRC006DS 00535600
- XC ESIDTB+512(256),ESIDTB+512 CLEAR ESDID TABLE 00535010
- XC ESIDTB+768(256),ESIDTB+768 CLEAR ESID TABLE 00535020
- MVC PRVCNT(2),PRHOLD INITIALIZE PR COUNT 00536000
- XC SYSUT1(4),SYSUT1 @V305032 00537000
- MVC FLAG1(2),LDRFLAGS MOVE IN FLAGS FROM NUCON 00538000
- CLI UNRES,X'80' UNRESOLVED BIT ON? @VA02829 00539000
- BNE AWAY NO, CONTINUE NORMALLY @VA02829 00540000
- OI FLAGS,LUNDEF FORCE SEARCH FOR UNRESOLVED @VA02829 00541000
- AWAY LA R5,LDRSET SET UP LOADER I/O @VA02829 00542000
- L R11,ALDRIO ADR OF DMSLIO 00543000
- LR R14,R4 SET RETURN REG 00544000
- BR R11 GO SET I/O 00545000
- BREG1 DC A(RELDR) V0304 00546000
- DC A(RELDR+4096) V0304 00547000
- EJECT 00548000
- *********************************************************************** 00549000
- * 00550000
- * READ IN TEXT LIBRARY DIRECTORIES, PROCESS USER OPTIONS 00551000
- * 00552000
- *********************************************************************** 00553000
- * 00554000
- PERMIT L R5,TXTDIRC GET TXTLIB ANCHOR 00555000
- LTR R5,R5 ARE TXTLIB DIRECTORIES IN STOR. 00556000
- BNZ INIT1 YES, CONTINUE 00557000
- STM R0,R15,APSV SAVE REGS 00558000
- L R15,=V(DMSLGTB) GO READ THEM IN 00559000
- BALR R14,R15 00560000
- OI OSSFLAGS,OSRESET INDICATE CLEAN UP NEEDED 00561000
- INIT1 EQU * 00562000
- SPACE 1 00563000
- STM R0,R15,APSV SAVE REGISTERS 00564000
- L R15,=V(DMSLSBD) GO PROCEES USER OPTIONS 00565000
- BALR R14,R15 00566000
- * WHEN A SYSTEM MODULE IN EITHER THE USER AREA OR THE TRANSIENT AREA 00566025
- * IS TO BE REPLACED, THE ASSOCIATED PROTECTION FLAG MUST BE RESET. 00566050
- CLC FREELOWE+1(3),LOCCT+1 LOADING ABOVE USER AREA? @VA12428 00566075
- BNH TSTRESET YES, DON'T RESET FLAG @VA12428 00566100
- CLC AUSRAREA+1(3),LOCCT+1 LOADING IN USER AREA? @VA11667 00566125
- BH NOTUSER NO, CHECK FOR TRANSIENT @VA12428 00566250
- NI PROTFLAG,X'FF'-PRFUSYS RESET SYSTEM FLAG @VA11667 00566375
- B TSTRESET CONTINUE @VA11667 00566500
- NOTUSER EQU * @VA12428 00566530
- LA R6,X'01E0' LOAD REGISTER FOR TEST @VA12428 00566560
- CLM R6,M2,LOCCT+1 ABOVE TRANSIENT AREA? @VA12428 00566590
- BE TSTRESET DON'T RESET FLAG @VA12428 00566620
- CLM R6,M1,LOCCT+2 IN LOW-CORE FREE STORAGE? @VA12428 00566650
- BH TSTRESET YES, CONTINUE @VA12428 00566680
- NI PROTFLAG,X'FF'-PRFTSYS RESET FLAG FOR TRANSIENT @VA11667 00566750
- TSTRESET EQU * @VA11667 00566875
- TM FLAGS,RESET WAS RESET 'ENTRY' SPECIFIED 00567000
- BNO RDSET NO 00568000
- NI FLAGS,255-RESET TEMPORARILY TURN OFF P3093 00569000
- BAL R6,CTLENT1 YES, SET ENTRY NAME IN LDR TBL 00570000
- OI FLAGS,RESET TURN BACK ON P3093 00571000
- EJECT 00572000
- *********************************************************************** 00573000
- * 00574000
- * INPUT READ ROUTINE 00575000
- * 00576000
- *********************************************************************** 00577000
- * 00578000
- RDSET MVC READBUF(44),RDISK SET PLIST TO READ CARDS 00579000
- MVC FINIS(26),FDISK IMAGES FROM DISK 00580000
- OI FLAG3,CMD PROCESSING COMMAND LINE @VA01699 00581000
- LA 3,SPEC 00582000
- B CHKLST GO READ IN FIRST PARAMETER @V305032 00583000
- ERRDBF LA 5,12 WAS ERROR END OF FILE 00584000
- CR 15,5 00585000
- BC 8,FINISH YES - GO CLOSE OUT FILE 00586000
- MVC OUTBUF(18),8(R1) MOVE NAME TO BUFFER 00587000
- LA R5,RDERR62 SET CODE FOR READ ERROR MSG 00588000
- B FATERR TERMINATE LOADING 00589000
- * FILE NOT FOUND. IF DLYD IS ON, IT MEANS A LIBE ONLY SEARCH. 00590000
- FINISH LA 1,FINIS CLOSE FILE 00591000
- L R15,AFINIS V0304 00592000
- BALR R14,R15 V0304 00593000
- CHKLST L R3,PARMLIST UPDATE PARAMETER LIST POINTER 00594000
- CLI 0(3),X'FF' IS THERE ANOTHER PARAMETER TR 00595000
- BE LIBGO GO TO LIBE SERCH IN LDT 00596000
- CLI 0(R3),C'(' END OF FNAMES @VA00857 00597000
- BE LIBGO YES @VA00857 00598000
- MVC READBUF+8(8),0(R3) GET NEXT FILE FROM DISK 00599000
- MVC FINIS+8(8),0(3) 00600000
- HALF8 LA R3,8(R3,R0) UPDATE PLIST POINTER 00601000
- ST R3,PARMLIST SAVE IT 00602000
- LA R1,READBUF CHECK FOR FILE 00603000
- L R15,ASTATE 00604000
- BALR R14,R15 00605000
- LA R3,SPEC RESTORE BUFFER ADDRESS 00606000
- ST R3,READBUF+28 00607000
- BZ NXTRD FOUND IT OK 00608000
- CH R15,=H'28' WAS IT FILE NOT FOUND 00609000
- BE NTFND YES 00610000
- ST R15,LDRADDR+4 SAVE STATE ERROR CODE @VA02822 00611000
- B N03 TERMINATE LOADING 00612000
- NXTRD LA 1,SPEC PTR TO BUFFER AREA 00613000
- ST 1,CRDPTR SAVE IT 00614000
- LA R1,READBUF READ 10 CARDS 00615000
- L R15,ARDBUF V0304 00616000
- BALR R14,R15 V0304 00617000
- BNZ ERRDBF BRANCH IF ERROR V0304 00618000
- B RDCONT PROCEED 00619000
- NTFND EQU * @V1D1705 00620000
- LA R1,READBUF+8 SET NAME OF LIBE ENTRY NEEDED 00621000
- LA 2,LIB4FND SET NOT FOUND ADDRESS 00622000
- BAL 3,SERCH1 SEARCH LOADER TABLE 00623000
- TM OSSFLAGS,DYLD DYNAMIC LOAD @V1D1705 00624000
- BNO CKUND CHECK COMMD LINE PROC @VA01699 00625000
- MVC BRAD+1(3),13(R12) SET ENTRY ADDRESS FOR DMSSL@V1D1705 00626000
- CKUND TM REFLG1(R12),REFUND IF TXTLIB GLOBALED BETWEEN @VA01699 00627000
- BZ CKLIB LOAD AND INCLUDE, MAY MISS @VA01699 00628000
- B SETUND SEARCHING FOR UNDEFINEDS. @VA01699 00629000
- LIB4FND EQU * 00630000
- OI 8(12),X'80' MAKE UNDEFINED, FORCE LIBE SEARCH 00631000
- SETUND OI FLAGS,LUNDEF AT LEAST 1 UNDEFINED @VA01699 00632000
- CKLIB TM FLAG3,CMD IF PROCESSING COMMAND LINE @VA01699 00633000
- BZ SKPOBLIG NAME, OVERRIDE LIBRARY @VA01699 00634000
- OI REFLG2(R12),REFCMD CARD 'NO SEARCH' OPTION @VA01699 00635000
- NI REFLG1(R12),X'FF'-REFLIB RESET 'LIBE-SUPPRESS' @VA01699 00636000
- SKPOBLIG DS 0H @VA01699 00637000
- B CHKLST PROCESS NEXT FILE 00638000
- RD L 1,CRDPTR GET CURRENT CARD PTR 00639000
- LA 1,80(0,1) ADVANCE PTR 00640000
- LA R3,SPEC GET END OF DATA READ @VA01419 00641000
- A R3,NUMBYTE BY ADDING BYTES READ @VA01419 00642000
- CR 1,3 END OF CARD BUFF REACHED? 00643000
- BL GO STILL SOME LEFT IN BUFFER @VA01419 00644000
- CLC NUMBYTE,SETBYTE ARE WE AT END OF BUFFER ? @VA01419 00645000
- BE NXTRD YES, READ SOME MORE @VA01419 00646000
- B FINISH ELSE ALL DONE @VA01419 00647000
- GO ST R1,CRDPTR SAVE NEW RECORD POINTER @VA01419 00648000
- MVC SPEC(80),0(1) MOVE NEW CARD INTO SPEC 00649000
- RDCONT SR 6,6 ZERO 6 00650000
- LA 11,1 REGISTER 11 ALWAYS SET TO 1 00651000
- L 1,SPEC 00652000
- EJECT 00653000
- * 00654000
- *********************************************************************** 00655000
- * 00656000
- * SET LOCATION COUNTER ROUTINE (SLC) 00657000
- * THIS ROUTINE HAS TWO ENTRIES 00658000
- * (1) AT THE BEGINNING WHEN RESUME FALLLS THRU 00659000
- * (2) ORG2- USED TO OBTAIN THE CURRENT ADDRESS OF A GIVEN 00660000
- * SYMBOLIC LOCATION. 00661000
- * THIS ROUTINE SETS THE LOCATION COUNTER TO THE SLC- 00662000
- * CARD SPECIFIED ADDRESS AND/OR OBTAINS THE CURRENT 00663000
- * ADDRESS OF A GIVEN SYMBOLIC LOC. FROM THE REFTBL TABLE. 00664000
- * NOTE THAT IF NO ABS LOC IS PUNCHED AND THE SYMBOLIC NAME 00665000
- * IS AS YET UNDEFINED, AN ERROR IS CREATED. 00666000
- * 00667000
- *********************************************************************** 00668000
- * 00669000
- C 1,SLC 00670000
- BC 7,C2AE1 00671000
- CLI SPEC+6,C' ' CMP ADDR FOR BLANKS 00672000
- BC 7,C2AD BR- ADDR IN CRD 00673000
- OI FLAGS,NOSLCADR NO ADDR, TURN ON SWITCH 00674000
- BC 15,C2A 00675000
- C2AD LA 4,6(0,0) CONVERT ADDR TO BINARY 00676000
- LA 5,SPEC+6 00677000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00678000
- BALR 0,1 BR TO HEXB ROUTINE 00679000
- LTR R2,R2 BAD CONVERSION? @VA02089 00680000
- BM BADCRD YES, BRANCH TO ERROR @VA02089 00681000
- LR 6,0 SAVE ADDR IN REGISTER 00682000
- C2A CLI SPEC+16,C' ' TEST IMAGE FOR NAME 00683000
- * SYMBOL IS LEFT ADJUSTED 00684000
- BC 7,C2AE3 BR- NAME IN CRD 00685000
- TM FLAGS,NOSLCADR CHECK FOR ADR IN CARD 00686000
- BO BADCRD PRINT INVALID CARD 00687000
- SR 0,0 00688000
- C2B NI FLAGS,255-NOSLCADR RESET SWITCH 00689000
- AR 6,0 ADD CONVERTED ADDR TO ORG2 00690000
- C2BNEWLC ST R6,LOCCT STORE UPDATED LOCATION COUNTER @VM03154 00691000
- B RD AND GO READ THE NEXT CARD-IMAGE. @VM03154 00692000
- C2AE3 LA 2,ERRSLC 00693000
- BAL 3,SERCH 00694000
- LA 14,C2B LINK AGE 00695000
- L R0,12(0,R12) GET ABSOLUTE ADDRESS 00696000
- BCR 15,14 00697000
- ERRSLC LH 3,TBLCT 00698000
- SR 3,11 00699000
- STH 3,TBLCT 00700000
- LA 5,ERRORU 00701000
- LA 14,RD 00702000
- MVC OUTBUF(8),0(12) MOVE NAME TO BUFF 00703000
- L 11,ALDRIO GET LINKAGE TO IO PACK 00704000
- BR 11 GO PRINT 00705000
- EJECT 00706000
- *********************************************************************** 00707000
- * 00708000
- * INCLUDE CONTROL SECTION 00709000
- * ROUTINE (ICS) 00710000
- * 00711000
- *********************************************************************** 00712000
- * 00713000
- C2AE1 C 1,ICS 00714000
- BC 7,C3AA1 BR NO 00715000
- CLI SPEC+24,C' ' TEST FOR HEX ADDR 00716000
- BE BADCRD INVALID CARD 00717000
- LA 4,4 00718000
- LA 5,SPEC+24 TO BINARY 00719000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00720000
- BALR 0,1 BR TO HEXB 00721000
- LTR R2,R2 BAD CONVERSION? @VA02089 00722000
- BM BADCRD YES, BRANCH TO ERROR @VA02089 00723000
- LR 6,0 SAVE LENGTH IN REG 00724000
- LA 14,RD LOAD LINKAGE TO BRANCH TO RD WH 00725000
- LA 3,SYMDEF IF NAME IN REFTBL, IS IT DEFINE 00726000
- BAL 2,SERCH 00727000
- SAVELNTH EQU * RETURN HERE FROM SEARCH IF NAME NOT FOUND @VA11353 00727100
- STCM R6,M7,REFADDR(R12) SAVE CS LENGTH IN REFTBL @VA11353 00727200
- CLI SPEC+15,COMMA REQUEST FOR NEW CSECT? @VA11353 00727300
- BE CSECTDEF YES, SET CSECT FLAG @VA11353 00727400
- OI REFLG2(R12),REFICS ICS CARD WAITING FOR MATCH @VA11353 00727500
- BR R14 READ NEXT RECORD @VA11353 00727600
- CSECTDEF EQU * @VA11353 00727700
- OI REFLG2(R12),REFCSD IDENTIFY CSECT ENTRY @VA11353 00727800
- * ENTERED C2AJ1 FROM ESD00 ROUTINE 00728000
- C2AJ1 L 1,LOCCT LOD PRESENT LOCATION 00729000
- LA 1,7(0,1) ALIGN TO DBL WRD BOUND 00730000
- N 1,DBLBND ... 00731000
- ST 1,LOCCT ... 00732000
- LR 7,14 TEST FOR UNDEFINED BIT 00733000
- L 5,AADDEF AND DEFINE IF NECESSARY 00734000
- BALR 14,5 00735000
- ST R1,12(0,R12) STORE VALUE OF LOCCT IN REFTBL 00736000
- AR 1,6 UPDATE LOCCT 00737000
- ST 1,LOCCT 00738000
- SR 5,5 IO INDEX FOR ENTRY PRINT 00739000
- ST R5,8(0,R12) CLEAR FLAG BYTE OF REFTBL 00740000
- L 11,ALDRIO GET LINKAGE 00741000
- BALR 14,11 GO PRINT NAME 'AT' LOC 00742000
- LR 14,7 00743000
- SR 6,6 00744000
- BCR 15,14 RETURNS TO RD OR C3AD4 (IN ESD 00745000
- SYMDEF EQU * NAME FOUND IN LOADER TABLE @VA11353 00745500
- CLI SPEC+15,COMMA NEW CSECT FOR INSERTION? @VA11353 00746000
- BE BADICS ERROR; MATCHING NAME IN TABLE @VA11353 00746500
- TM 8(R12),X'80' IS SYMBOL UNDEFINED? @VA11353 00747000
- BO SAVELNTH YES, FLAG ICS REQUEST @VA11353 00747500
- TM REFLG2(R12),REFICS IS ICS FOR SAME CSECT? @VA11353 00748000
- BO SAVELNTH GET UPDATED LENGTH @VA11353 00748500
- B BADICS NAME DEFINED; INVALID ICS CARD @VA11353 00749000
- EJECT 00750000
- *********************************************************************** 00751000
- * 00752000
- * DETERMINE IF ESD TYPE CARD 00753000
- * 00754000
- *********************************************************************** 00755000
- * 00756000
- C3AA1 C 1,ESD 00757000
- BC 7,C4AA1 NO- TEST FOR TXT CRD 00758000
- SPACE 1 00759000
- CA3A1 CLI SPEC+24,X'0A' WEAK EXTRN ? 00760000
- BE WEAKEXT YES 00761000
- NI SPEC+24,X'07' MASK ESD TYPE BYTE 00762000
- CLI SPEC+24,X'04' IS THIS A PC 00763000
- BE PC YES 00764000
- CA3A11 EQU * 00765000
- LH 12,SPEC+24 GET ESD NO 00766000
- SRL 12,8 (ISOLATE IT) JS 00767000
- AR 12,12 DOUBLE ESD NO. FOR JUMP-TBL, JS 00768000
- LH 12,ESDANAL(12) GET TBL ADDR FOR BRANCH 00769000
- LA R15,RELDR 00770000
- B 0(12,15) BRANCH TO APPROPRIATE ROUTINE 00771000
- EJECT 00772000
- *********************************************************************** 00773000
- * 00774000
- * ESD TYPE 1 ROUTINE (ENTRY) 00775000
- * 00776000
- *********************************************************************** 00777000
- * 00778000
- ENTESD SR R3,R3 CLEAR R3 00779000
- IC R3,SPEC+31 GET ID OF SECTION DEFINITION 00780000
- BAL 14,REFADR OBTAINS ADDR OF THE ENTRY IN RE 00781000
- LA R10,ESD00 SET PROCESS TO ESD00 00782000
- LATESD L R7,8(0,R12) LOAD RELOCATION FACTOR OF CSECT 00783000
- LA R7,0(0,R7) CLEAR FLAG BYTE 00784000
- STC 6,SPEC+24 (IF CSECT NOT DEFINED, BRANCH HERE) 00785000
- A 7,SPEC+24 FORM ENTRY POINT 00786000
- LA R7,0(0,R7) CLEAR HI BYTE P0966 00787000
- LA 2,C3AD1 NOT FOUND RETURN 00788000
- BAL 3,SERCH SEARCH FOR NAME IN REFTBL 00789000
- L R0,12(0,R12) LOAD ABSOLUTE ADDRESS 00790000
- TM 8(12),X'80' IS ENTRY DEFINED 00791000
- BC 1,C3AD2 NO - DEFINE IT 00792000
- TM FLAG1,NODUP IS MSG TO ISSUED ? @VM08875 00793000
- BO ESD1OK NO, BRANCH @VM08875 00794000
- MVC OUTBUF(8),0(12) MOVE NAME TO BUFF 00795000
- LA 5,ERRORM ERROR 202W 00796000
- L 11,ALDRIO GET LINKAGE 00797000
- BALR 14,11 GO PRINT MESS AND NAME 00798000
- ESD1OK BR R10 GO TO ESD00 OR SDDEF RTN @VM08875 00799000
- C3AD2 LR 1,7 LOAD REG 1 FROM 7 00800000
- L 5,AADDEF 00801000
- BALR 14,5 00802000
- ST R1,12(0,R12) UPDATE REFTBL, STORE ABS. ADDRESS 00803000
- BC 15,PRNT 00804000
- C3AD1 ST R7,12(0,R12) STORE ABS. ADDR. IN REFTBL 00805000
- PRNT SR 5,5 IO INDEX FOR ENTRY PRINT 00806000
- ST R5,8(0,R12) CLEAR FLAG BYTE OF REFTBL 00807000
- L 11,ALDRIO GET LINKAGE 00808000
- BALR 14,11 GO PRINT NAME 'AT' LOC 00809000
- BR R10 GO TO ESD00 OR SDDEF RTN 00810000
- EJECT 00811000
- *********************************************************************** 00812000
- * 00813000
- * ESD TYPE 0 + 4 ROUTINE (SEGMENT NAME + PRIVATE CODE) 00814000
- * 00815000
- *********************************************************************** 00816000
- * 00817000
- C3AA3 EQU * @V1D1705 00818000
- LR R11,R8 INSURE NON-ZERO R11 @VA04910 00819000
- TM FLAGS,ESD1ST IS FIRST ESDID SET YET? @VA04910 00820000
- BO C3AA3A BRANCH IF YES @VA04910 00821000
- SR R11,R11 INDICATE FIRST ESDID @VA04910 00822000
- C3AA3A EQU * @VA04910 00823000
- BAL R3,ESIDINC CHECK AND UPDATE ESDID NO. 00824000
- LA 2,C3AC3 NAME NOT IN TBL RETURN 00825000
- BAL 3,SERCH SEARCH FOR NAME IN REFTBL 00826000
- CLI SPEC+24,PCTYPE IS THIS PC CODE? @VA04910 00827000
- BNE CHKCOM BRANCH IF NOT @VA04910 00828000
- LTR R11,R11 WAS ESDID NUMBER UPDATED? @VA04910 00829000
- BNZ DECESID BRANCH IF YES @VA04910 00830000
- NI FLAGS,255-ESD1ST REMOVE ESD PROCESSED BIT @VA04910 00831000
- B PC GO TRY AGAIN @VA04910 00832000
- DECESID EQU * @VA04910 00833000
- LH R2,SPEC+14 GET ESDID NUMBER @VA04910 00834000
- BCTR R2,0 DECREMENT BY ONE @VA04910 00835000
- STH R2,SPEC+14 AND SAVE IT(KEEP ORIG.NO.) @VA04910 00836000
- B PC GET ANOTHER NUMBER @VA04910 00837000
- CHKCOM EQU * @VA04910 00838000
- CLI 8(12),X'82' WAS THIS NAME DEFINED AS COMMON @VA09317 00839000
- BE COMFIX2 YES IT WAS @VA09317 00840000
- TM REFLG2(R12),REFICS UNMATCHED ICS ENTRY? @VA11353 00840060
- BZ TSTUNDEF OTHERWISE UNDEFINED OR DUPLICATE @VA11353 00840120
- NI REFLG2(R12),255-REFICS RESET UNMATCHED FLAG @VA11353 00840180
- CLC SPEC+28(4),BLANKS LENGTH FIELD IN END CARD? @VA11353 00840240
- BE BADICS CANNOT HANDLE ICS REQUEST @VA11353 00840300
- ICM R6,M7,REFADDR(R12) LOAD NEW LENGTH FOR CSECT @VA11353 00840360
- MVC REFADDR(3,R12),ZEROES CLEAR REFTBL FIELD @VA11353 00840420
- LA R14,C3AD4 SET LINKAGE @VA11353 00840480
- B CSECTDEF GO TO DEFINITION ROUTINE @VA11353 00840540
- BADICS EQU * @VA11353 00840600
- LA R14,N03 SET RETURN ADDRESS FOR LIO @VA11353 00840660
- LA R5,ERRORB SET ERROR FUNCTION FOR LIO @VA11353 00840720
- L R11,ALDRIO TYPE MESSAGE, SET RETURN CODE, @VA11353 00840780
- BR R11 AND EXIT @VA11353 00840840
- TSTUNDEF EQU * @VA11353 00840900
- TM 8(12),X'80' IS ENTRY DEFINED 00841000
- BC 7,C3AC3 NO - GET STARTING LOCATION 00842000
- TM FLAG1,NODUP IS MSG TO BE ISSUED ? @VM08875 00843000
- BO DUPCST NO-NO MSG SET REL-FACT @VA07537 00844100
- LA 5,ERRORM ERROR 202W 00845000
- MVC OUTBUF(8),0(12) MOVE NAME TO BUFF 00846000
- L 11,ALDRIO GET LINKAGE 00847000
- BALR 14,11 GO PRINT MESSAGE AND NAME 00848000
- DUPCST EQU * @VA07537 00848200
- L R2,C12(R12) LOAD ABSOLUTE ADDRESS @VA07537 00848250
- SR R5,R5 CLEAR R5 @VA07537 00848300
- ICM R5,C7,SPEC+C25 GET ASSEMBLED ADDRESS @VA07537 00848350
- CR R2,R5 IS NEG RELOC. NECESSARY @VA07537 00848400
- BL NEGREL YES-GO DO IT @VA07537 00848450
- SR R2,R5 CALC. RELOC. FACTOR @VA07537 00848500
- B SAVEREL GO SAVE REL-FACT @VA07537 00848550
- NEGREL EQU * @VA07537 00848600
- SR R5,R2 CALC. DIFF @VA07537 00848650
- LCR R2,R5 LOAD NEG RELOC FACTOR @VA07537 00848700
- OI C16(R12),NGREL INDICATE NEG REL-FACT @VA07537 00848750
- SAVEREL EQU * @VA07537 00848800
- STCM R2,C7,C9(R12) STORE REL-FACT @VA07537 00848850
- ESD0OK LH R2,SPEC+14 GET ESID TABLE POSITION @VM08875 00849000
- AR R2,R2 TIMES TWO 00850000
- O R4,ESIDDUPF SET DUPLICATE SD FLAG 00851000
- O R4,ESIDSDF SET SD FLAG, TOO @VA05573 00852000
- STH 4,ESIDTB(2) STORE POINTER IN ESID TABLE 00853000
- B ESD00 GET NEXT CARD 00854000
- C3AD4 L R0,12(0,R12) GET ABS. ADDR. TO COMPUTE REL. FACTOR 00855000
- LH 2,SPEC+14 LOD ESID 00856000
- AR R2,R2 TIMES TWO 00857000
- SR R5,R5 CLEAR R5 00858000
- IC R5,ESIDTB(R2) SAVE FLAG FIELD 00859000
- SRL R5,4 ISOLATE 4 FLAG BITS V0308 00860000
- SLL R5,12 V0308 00861000
- OR R4,R5 00862000
- O R4,ESIDSDF SET SD FLAG 00863000
- STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 00864000
- STC 6,SPEC+24 LOD ASSEMBLED ADDR 00865000
- L 2,SPEC+24 00866000
- CR 0,2 00867000
- BC 5,COMP BR- ORG2 LESS THAN ADDR 00868000
- SR 0,2 00869000
- RELF STCM R0,B'0111',9(R12) SAVE RELOCATION FACTOR P0966 00870000
- LH R2,SPEC+14 GET ESID OF SD 00871000
- AR R2,R2 DOUBLE FOR ESIDTB INDEX 00872000
- LA R5,ESIDTB(R2) POINT TO ID TABLE ENTRY 00873000
- TM 0(R5),ESIDLATE ANY WAITING LD'S 00874000
- BO SDDEF YES, RESOLVE THEM 00875000
- BC 15,ESD00 READ ANOTHER CARD 00876000
- COMP SR 2,0 ADDRESS MINUS ORIGIN 00877000
- LCR 0,2 COMPLEMENT (TWOS) 00878000
- OI REFLG2(R12),REFNEG NEGATIVE RELOCATION FACTOR @VA11353 00879000
- BC 15,RELF 00880000
- C3AC3 EQU * @VA11353 00880600
- OI REFLG2(R12),REFCSD INDICATE CSECT @VA11353 00881200
- STC 6,SPEC+28 RETURNED HERE FOR NAME NOT FND 00882000
- L 6,SPEC+28 LOD SEGMENT LENGTH 00883000
- LA 14,C3AD4 00884000
- BC 15,C2AJ1 CK ADDR 00885000
- SPACE 4 00886000
- ESIDINC LH R2,SPEC+14 GET ESDID NUMBER 00887000
- TM FLAGS,ESD1ST IS THIS 1ST ESDID ON CARD 00890000
- BZ FSTESD YES, DON'T INCREMENT 00891000
- LA 2,1(0,2) ADD 1 00892000
- STH 2,SPEC+14 INSERT AS NEW ESID NO 00893000
- FSTESD OI FLAGS,ESD1ST INDICATE FIRST ESD PROCESSED THIS CARD 00894000
- CH R2,HW511 COMPARE WITH 511 HRC006DS 00894490
- BH ESDTBOVR ERROR IF GT 511 HRC006DS 00894680
- BR 3 RETURN TO CALLER 00895000
- COMFIX2 MVI 8(12),X'80' CHANGE IT TO REAL CSECT 00896000
- L 6,8(,12) GET LENGHTH UP UNTIL NOW 00897000
- LA 6,0(,6) CLEAR HIGH ORDER BYTE 00898000
- MVI SPEC+28,0 00899000
- C 6,SPEC+28 WAS PREV LENGTH GTR THAN CSECT 00900000
- BNL COMFIX3 BR YES 00901000
- L 6,SPEC+28 NO USE THIS LENGTH 00902000
- COMFIX3 ST 6,SPEC+28 00903000
- LA 14,C3AD4 GO TO ICS 00904000
- BC 15,C2AJ1 00905000
- ESDTBOVR LA R5,ESDOVER 00906000
- B FATERR TERMINATE 00907000
- EJECT 00908000
- *********************************************************************** 00909000
- * 00910000
- * ESD TYPE 2 ROUTINE (EXTRN) 00911000
- * THIS ROUTINE HAS TWO ENTRY POINTS. LOC C3AH1 AND LOC ESD00 00912000
- * LOCATION C3AH1 IS ENTERED FROM THE ESD CARD ANALYSIS ROUTINE 00913000
- * LOCATION ESD00 IS ENTERED FROM... 00914000
- * 1. THE ESD CARD ANALYSIS ROUTINE WHEN THE CARD BEING 00915000
- * PROCESSED IS A TYPE 1OR 2 , AND AN ABS LOAD IS INDICATED 00916000
- * 2. THE ESD TYPE 0 ROUTINE AND TYPE 1 ENTER AS THE LAST 00917000
- * STEP OF THESE ROUTINES 00918000
- *********************************************************************** 00919000
- * 00920000
- C3AH1 BAL 3,ESIDINC GO CHECK + UPDATE ESID NO 00921000
- LA R2,C3AH2 NOT FOUND RETURN 00922000
- BAL R3,SERCH LOOK FOR NAME IN REFTBL 00923000
- CLI 8(R12),X'83' WEAK EXTRN REFERENCE P3093 00924000
- BNE COM01 NO P3093 00925000
- L R2,12(,R12) GET RELOCATION FACTOR @VM08899 00926000
- ST R2,TEMPST SAVE FOR A WHILE @VM08899 00927000
- XC 0(20,R12),0(R12) ZERO OUT WXTRN ENTRY @VM08899 00928000
- BAL R2,SERCH GO PROMOTE ENTRY IN LDRTBLS @VM08899 00929000
- L R2,TEMPST GET RELOCATION FACTOR @VM08899 00930000
- ST R2,12(,R12) STORE IN NEW LOCATION @VM08899 00931000
- OI 8(R12),X'80' TURN UNDEFINED BIT ON @VM08899 00932000
- OI FLAGS,LUNDEF SHOW UNDEF TO LIBE @VM08899 00933000
- COM01 LH R2,SPEC+14 GET ESID NUMBER 00934000
- SLL 2,1 TIMES TWO 00935000
- STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 00936000
- ESD00 LA 2,16 TEST FOR MULTIPLE ENTRIES IN CA 00937000
- LH 1,SPEC+10 00938000
- SR 1,2 00939000
- BC 3,C3AH5 00940000
- NI FLAGS,255-ESD1ST RESET FIRST ESD FLAG 00941000
- B RD NEXT CARD @V1D1705 00942000
- C3AH5 MVC SPEC+16(32),SPEC+32 00943000
- STH 1,SPEC+10 00944000
- BC 15,CA3A1 00945000
- C3AH2 OI 8(12),X'80' PLACE UNDEFINED BIT ON 00946000
- OI FLAGS,LUNDEF SHOW UNDEFS TO LIBE 00947000
- SR 3,3 CLEAR REGISTER 3 00948000
- ST 3,12(,12) STORE ZERO IN RELOCATION FACTOR 00949000
- B COM01 FINISH 00950000
- EJECT 00951000
- ********************************************************************** 00952000
- * 00953000
- * ESD TYPE A (WEAK EXTRN) 00954000
- * 00955000
- ********************************************************************** 00956000
- SPACE 00957000
- WEAKEXT BAL R3,ESIDINC CHECK ESID 00958000
- LA R2,WEAKEXT1 NOT FOUND RETURN 00959000
- BAL R3,SERCH LOOK FOR NAME IN REFTBL 00960000
- B COM01 FINISH 00961000
- WEAKEXT1 OI 8(R12),WKEXT INDICATE WEAK EXTRN 00962000
- B C3AH2 FINISH 00963000
- SPACE 3 00964000
- *********************************************************************** 00965000
- * 00966000
- * ESD 5 + 6 ROUTINE (COMMON + PSEUDO REGISTER ) 00967000
- * 00968000
- *********************************************************************** 00969000
- SPACE 1 00970000
- COMESD BAL 3,ESIDINC GO CHECK + UPDATE ESID NO 00971000
- LA 2,COM03 00972000
- BAL 3,SERCH 00973000
- TM REFLG2(R12),REFICS ICS FLAG SET ON? @VA11353 00973300
- BO BADICS INVALID MATCH @VA11353 00973600
- TM 8(12),X'80' 00974000
- BZ COM01 00975000
- CLI 8(R12),X'82' PREVIOUSLY DEFINED AS COMMON @V201005 00976000
- BNER R2 TO 'COM04' - SKIP LENGTH CK @VA01759 00977000
- CLC 9(3,12),SPEC+29 GET LONGEST COMMON 00978000
- BNL COM04 KEEP OLD LENGTH 00979000
- COM03 MVC 9(3,12),SPEC+29 MOVE CURRENT LENGTH 00980000
- COM04 MVI 8(R12),X'82' DEFINE AS COMMON @V201005 00981000
- OI FLAG1,COMMONEX INDICATE COMMON EXISTS 00982000
- B COM01 TR 00983000
- EJECT 00984000
- * HANDLE PR (PSEDUO-REGISTER) 00985000
- PRVESD BAL R3,ESIDINC CHECK AND UPDATE ESID NUMBER @V1D1705 00986000
- CLI SPEC+28,C' ' BLANK ALIGNMENT FACTOR @V201005 00987000
- BNE NONBLANK NO @V201005 00988000
- MVI SPEC+28,X'03' REPLACE WITH WORD ALIGN @V201005 00989000
- NONBLANK LA R2,DEFENTRY IN CASE NOT FOUND @V201005 00990000
- BAL 3,PRSERCH LOOK FOR ENTRY IN REFTBL 00991000
- TM REFLG2(R12),REFICS ICS FLAG SET ON? @VA11353 00991300
- BO BADICS INVALID MATCH @VA11353 00991600
- LH 2,SPEC+14 GET ESDID NO. 00992000
- SLL 2,1 TIMES TWO 00993000
- STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 00994000
- CLC 9(3,12),SPEC+29 OLD LENGTH GREATER THAN NEW 00995000
- BNL ALTST YES, CHECK ALIGNMENT 00996000
- MVC 9(3,12),SPEC+29 NO, KEEP GREATER LENGTH 00997000
- ALTST TR SPEC+28(1),PRTRAN ENCODE ALIGNMENT BYTE @V201005 00998000
- CLC 8(1,12),SPEC+28 IS NEW AL MORE RESTRICTIVE 00999000
- BNL ESD00 NO, LOOK FOR MORE ESD'S 01000000
- LA 5,PRERR GET MESS # FOR PR ERR 01001000
- L 11,ALDRIO GO PRINT MESS 01002000
- BALR 14,11 ... 01003000
- B ESD00 BACK FOR MORE ESD'S 01004000
- DEFENTRY LH 2,SPEC+14 GET ESDID NO 01005000
- SLL 2,1 TIMES TWO 01006000
- STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 01007000
- MVC 8(4,12),SPEC+28 PUT LENGTH AND ALIGN IN ENTRY 01008000
- OI FLAG1,PREXIST INDICATE PR EXISTS 01009000
- SR 2,2 GET A ZERO 01010000
- IC 2,SPEC+28 GET FLAG BYTE 01011000
- LCR 4,2 AND ITS COMPLEMENT 01012000
- BCTR 4,0 ... 01013000
- AH R2,PRVCNT ALIGN PR DISPLACEMENT 01014000
- NR 2,4 ... 01015000
- ST 2,12(0,12) STORE IN REFTBL 01016000
- AH 2,10(0,12) ADD LENGTH 01017000
- STH R2,PRVCNT AND STORE AS NEW COUNT 01018000
- TR 8(1,12),PRTRAN CODE ALIGN BYTE 01019000
- B ESD00 BACK FOR MORE ESD'S 01020000
- EJECT 01021000
- ****************************************************************** 01022000
- * 01023000
- * ESD 04 PRIVATE CODE 01024000
- * 01025000
- ****************************************************************** 01026000
- * 01027000
- PC EQU * @V1D1705 01028000
- L R15,=V(DMSLSY) CREATE A UNIQUE SYMBOL 01029000
- BALR R14,R15 01030000
- MVC SPEC+16(8),NXTSYM MOVE SYMBOL TO ESD NAME FIELD 01031000
- MVI SPEC+16,C'.' 01032000
- B CA3A11 01033000
- EJECT 01034000
- *********************************************************************** 01035000
- * 01036000
- * TEXT CARD ROUTINE (TXT) 01037000
- * 01038000
- *********************************************************************** 01039000
- * 01040000
- C4AA1 C 1,TXT 01041000
- BC 7,C4AA3 BR- NOT TEXT CRD 01042000
- STC 6,SPEC+4 01043000
- LH 7,SPEC+10 NUM OF BYTES 01044000
- LTR 7,7 01045000
- BC 8,RD ZERO COUNT - DON'T NOVE ANY DAT 01046000
- LA R15,C4AK2+2 LINKAGE 01047000
- REPENT LH R3,SPEC+14 GET ESDID TO FIND ADDRESS @V1D1705 01048000
- LTR R3,R3 IS ESD ID VALID? @VA09103 01048300
- BNP BADCRD NO, THROW IT OUT @VA09103 01048600
- SLL 3,1 CHECK ESID TABLE 01049000
- LH 12,ESIDTB(3) ... 01050000
- LTR 12,12 IS IT NEGATIVE ENTRY (ALREADY LOADED) 01051000
- BM RD YES, SKIP IT 01052000
- SRL 3,1 NO, RESET CONDITIONS AND CONTINUE 01053000
- BAL 14,REFADR 01054000
- L R10,8(0,R12) LOAD RELOCATION FACTOR 01055000
- C4AC2 A 10,SPEC+4 ADD ADDR TO RELFAC 01056000
- LA R10,0(0,R10) CLEAR HI BYTE P0966 01057000
- ST 10,SPEC+4 01058000
- LR 1,10 01059000
- AR 1,7 01060000
- LA R5,ERRORC ERROR 709S 01061000
- TM BATFLAGS,BATLOAD BATCH BEING LOADED? V0742 01062000
- BO C4AJ2 YES: ALLOW FREE STORAGE LOAD V0742 01063000
- TM MODFLGS,SYSLOAD SYSTEM LOAD ? @VA04666 01064000
- BO C4AJ2 YES, ALLOW FREE STORAGE LOAD @VA04666 01065000
- TM OSSFLAGS,DYLD OS TYPE LOAD ? @V1D1705 01066000
- BNO NONDYNA BR IF NOT @V1D1705 01067000
- C R1,DYNAEND CHECK AGAINST GETMAINED AREA @V1D1705 01068000
- BC 11,FATERR ERROR IF TOO HIGH @V1D1705 01069000
- B NONDY2 @V1D1705 01070000
- NONDYNA EQU * @V1D1705 01071000
- C R1,FREELOWE WOULD WE OVERLAY FREE STOR 01072000
- BL NONDY2 BRANCH IF NOT @V305665 01073000
- CLC AOSMODL(4),ZEROES OS SIM MODULE PRESENT? @VA11353 01074000
- BE FATERR NO,THEN ERROR @VA05525 01075000
- C R1,AOSMODL POSSIBLY IN MODULE AREA? @V305665 01076000
- BL FATERR ERROR IF NOT @V305665 01077000
- L R0,VMSIZE GET MACHINE SIZE @V305665 01078000
- SR R14,R14 CLEAR REGISTER @V305665 01079000
- IC R14,ALDRTBLS GET NUMBER OF LDT PAGES @V305665 01080000
- SLL R14,12 GET SIZE OF LOADER PAGES @V305665 01081000
- SR R0,R14 DETERMINE USABLE SIZE @V305665 01082000
- CR R1,R0 STILL IN MODULE AREA? @V305665 01083000
- BH FATERR BRANCH IF NOT @V305665 01084000
- NONDY2 EQU * @V1D1705 01085000
- C R10,AUSRAREA ARE WE BELOW USER STOR ? 01086000
- BNL C4AJ2 BNL IF NO PROBLEM. JS 01087000
- C R1,=V(TRANSEND) ABOVE TRANS AREA ? 01088000
- BH FATERR YES, OVERLAY ERROR @VA02752 01089000
- C R10,=V(TRANSAR) BELOW TRANS AREA ? 01090000
- BL FATERR YES, OVERLAY ERROR 01091000
- C4AJ2 TM FLAG1,FSTXTADR HAS 1ST TEXT ADDRESS BEEN SAVED ? 01092000
- BO C4AK2 YES DON'T SAVE 01093000
- OI FLAG1,FSTXTADR INDICATE TEXT ADR SAVED 01094000
- ST 10,BRAD SAVE FIRST ADDR LOADED INTO 01095000
- C4AK2 BCR 15,R15 LINKAGE 01096000
- SR 7,11 SUB ONE FROM NUM OF BYTES 01097000
- EX 7,CHAR MOVE TEXT TO STORAGE 01098000
- BC 15,RD AND GO READ A CARD 01099000
- * 01100000
- CHAR MVC 0(1,10),SPEC+16 01101000
- EJECT 01102000
- *********************************************************************** 01103000
- * 01104000
- * REPLACE CARD ROUTINE (REP) 01105000
- * 01106000
- *********************************************************************** 01107000
- * 01108000
- C4AA3 C 1,REP 01109000
- BC 7,C5AA1 BR- NOT REPLACE CARD 01110000
- TM FLAG2,NOREP IS REP CARD PRINTING SUPPRESSED 01111000
- BC 1,C4AA4 YES 01112000
- LA 5,CRDIMJ GO PRINT OUT REP CARD IMAGE 01113000
- MVC OUTBUF(79),SPEC+1 MOVE CRD IMAJE TO BUFF 01114000
- L 11,ALDRIO GET LINKAGE 01115000
- BALR 14,11 GO PRINT REP CARD 01116000
- C4AA4 LA 4,6 CONVERT REP CRD HEX ADDR TO BIN 01117000
- LA 5,SPEC+6 01118000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 01119000
- BALR 0,1 BR TO HEXB 01120000
- LTR R2,R2 BAD CONVERSION? @VA02089 01121000
- BM BADCRD YES, BRANCH TO ERROR @VA02089 01122000
- ST 0,SPEC+4 SAVE ADDR IN CARD IMAGE 01123000
- LA 4,2(0,0) 01124000
- LA 5,SPEC+14 CONVERT REP ESID TO BIN 01125000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 01126000
- BALR 0,1 BR TO HEXB 01127000
- STH 0,SPEC+14 SAVE THE ESID IN CARD IMAGE 01128000
- LA 5,SPEC+16 01129000
- NUM LA 7,2 NUM OF BYTES 01130000
- ST 5,TMPLOC 01131000
- TM FLAG2,APRILB 01132000
- BC 1,APR10 01133000
- BAL R15,REPENT CK ADDR 01134000
- APRIL LA 4,4 CONVERT HALF WORD OF CORRECTION 01135000
- L 5,TMPLOC 01136000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 01137000
- BALR 0,1 BR TO HEXB 01138000
- L R1,SPEC+4 LOD REPLACE ADDR 01139000
- STH 0,0(0,R1) PLACE CORRECTION IN STORAGE 01140000
- NI FLAG2,255-APRILB 01141000
- CLI 0(5),C',' 01142000
- BC 7,RD 01143000
- OI FLAG2,APRILB 01144000
- LA R1,2(R1,0) 01145000
- ST R1,SPEC+4 SAVE REPLACE ADDR 01146000
- AR 5,11 01147000
- BC 15,NUM 01148000
- APR10 LA R15,APRIL 01149000
- SR R10,R10 ZERO RELOCATION FACTOR @V1D1705 01150000
- B C4AC2 @V1D1705 01151000
- EJECT 01152000
- *********************************************************************** 01153000
- * 01154000
- * RELOCATION DICTIONARY CARD (RLD) 01155000
- * REG 6= 0 UPON ENTRY INTO C5AA1 01156000
- * 01157000
- *********************************************************************** 01158000
- SPACE 1 01159000
- C5AA1 C 1,RLD IS IT RLD 01160000
- BNE C6AA1 NO,TEST FOR END 01161000
- * THE FIRST WORD OF WHAT USED TO BE THE RDBUF/WRBUF 01162000
- * PLIST IS USED AS A POINTER TO THE HEAD OF A RLD CARD 01163000
- * INCORE CHAIN. RLD CARDS ARE ADDED AT THE HEAD OF THE 01164000
- * CHAIN SINCE THEY DO NOT DEPEND ON BEING PERFORMED IN 01165000
- * ANY PARTICULAR ORDER, AND THE END OF THE CHAIN IS 01166000
- * MARKED WITH A ZERO. THE FIRST FOUR BYTES OF THE 80 01167000
- * BYTES GOTTEN FROM FREE STORAGE IS USED AS A CHAIN. 01168000
- SPACE 2 01169000
- DMSFREE DWORDS=10,TYPCALL=BALR @V305032 01170000
- MVC 4(76,R1),SPEC+4 MOVE LAST 76 COLS OF RLD TO @V305032 01171000
- L R0,SYSUT1 FREE STORAGE & CHAIN TOGETHER @V305032 01172000
- ST R0,0(,R1) OLD HEAD IS SECOND @V305032 01173000
- ST R1,SYSUT1 NEW BLOCK IS HEAD @V305032 01174000
- B RD PROCESS NEXT CARD 01175000
- SPACE 2 01176000
- PASSTWO EQU * @V305032 01177000
- SR R6,R6 GET A ZERO @V305032 01178000
- NXTRLDCD EQU * @V305032 01179000
- L R1,SYSUT1 SEE IF ANY RLD CARDS @V305032 01180000
- LTR R1,R1 ZERO IF NONE @V305032 01181000
- BZ C6AB6 BRANCH IF NOT @V305032 01182000
- MVC SPEC+4(76),4(R1) MOVE RLD CARD TO WORK AREA @V305032 01183000
- L R10,0(,R1) POINT TO NEXT RLD CARD @V305032 01184000
- DMSFRET DWORDS=10,LOC=(1),TYPCALL=BALR @V305032 01185000
- ST R10,SYSUT1 STORE POINTER TO NEXT CARD @V305032 01186000
- LA 10,SPEC+16 ADDRESS OF DATA FIELD IN 10 01187000
- C5AC1 EQU * @VA10086 01187300
- ST R6,SAV67 INDICATE ESID POINTER NOT SAVED @VA10086 01187600
- LR R6,R10 POINT TO CURRENT DATA FIELD @VA10086 01187900
- LR R11,R10 SAVE PTR TO CURRENT DATA FIELD @VA11838 01188050
- C5AC1A EQU * @VA10086 01188200
- LH R3,0(0,R6) GET RH ESID @VA10086 01188500
- N R3,=X'00007FFF' MASK ID FIELD 01189000
- LTR 3,3 IS IT 0 01190000
- BZ CXDTST YES, CHECK FOR PR CUM LENGTH 01191000
- CXDRET BAL 14,REFADR GET ADDR OF ENTRY IN REFTBLE 01192000
- ST 12,TEMPST SAVE ADDRESS 01193000
- C R12,TBLREF IS THE ADDRESS INVALID @VA06291 01194000
- BE BADRLD YES WE'RE POINTING AT STOR END @VA06291 01195000
- SR R0,R0 GET A ZERO @V201005 01196000
- TM 8(R12),X'80' IS NAME DEFINED @V201005 01197000
- BO PLOAD1 NO @V201005 01198000
- L R0,12(R12) GET NAME'S ADDRESS @V201005 01199000
- TM 4(R10),X'30' NON BRANCH ADCON @V201005 01200000
- BNZ PLOAD1 NO @V201005 01201000
- LH R3,0(0,R6) TEST IF SD ESIDTB @VA10086 01202000
- N R3,=X'00007FFF' MASK ID FIELD @VM08509 01203000
- AR R3,R3 MULT. BY TWO @VM08509 01204000
- LA R3,ESIDTB(R3) GET ADDR OF ESIDTB ENTRY @VM08509 01205000
- TM 0(R3),ESIDSDFB TEST ESID SD BIT @VM08509 01206000
- BNO PLOAD1 NO @V201005 01207000
- L R0,8(R12) YES, USE RELOCATION FACTOR @V201005 01208000
- TM REFLG2(R12),REFNEG NEGATIVE RELOCATION FACTOR? @VA11353 01209000
- BNO PLOAD1 NO @V1D1705 01210000
- ICM R0,B'1000',=X'FF' COMPENSATE FOR 3 BYTE RELOCA@V1D1705 01211000
- PLOAD1 EQU * @VA10086 01211500
- LH R3,2(0,R6) GET PH @VA10086 01212000
- SR R6,R6 RESTORE TO ZERO @VA10086 01212500
- N R3,=X'00007FFF' MASK ID FIELD 01213000
- LTR 3,3 IS IT 0 01214000
- BZ BADCRD2 YES, BAD CARD @VA01260 01215000
- SLL 3,1 CHECK ESID TABLE 01216000
- LH 12,ESIDTB(3) ... 01217000
- LTR 12,12 IS IT NEGATIVE ENTRY (ALREADY LOADED) 01218000
- BM SKIPRLD YES, SKIP THESE ENTRIES 01219000
- SRL 3,1 NO, RESET CONDITIONS AND CONTINUE 01220000
- BAL 14,REFADR GET REFTBL ADDR OF PH 01221000
- L R15,8(0,R12) GET REL. FACTOR OF PH 01222000
- BAL 14,CTR SEE IF END OF CARD 01223000
- SPACE 2 01224000
- C5AA3 AR 10,5 ADDR OF NEXT 4 BYTE DATA FIELD 01225000
- BCTR 5,0 C(REG 5) = 3 01226000
- IC 6,0(0,10) GET FLAG BYTE 01227000
- SRL 6,2 SHIFT OVER LENGTH BITS 01228000
- NR 6,5 MASK OUT ALL BUT LAST 2 BITS 01229000
- LA R5,RLDCONST+3 POINT TO WORK AREA +3 @V201005 01230000
- SR R5,R6 BACK UP ACCORDING TO ADCON LENGTH@V201005 01231000
- L 3,0(0,10) GET ASSIGNED ADDRESS OF (CON) 01232000
- LA 3,0(3,R15) COMPUTE LOADED ADDRESS 01233000
- TM 0(R10),X'30' NONBRANCH ADCON @V201005 01234000
- BNZ ZERO NO @V201005 01235000
- EX R6,MVCFROM MOVE RLD CONSTANT TO WORK AREA @V201005 01236000
- ZERO L R4,RLDCONST GET CONSTANT IN R4 @V201005 01237000
- TM 0(10),X'02' SHOULD WE SUBTRACT 01238000
- BO C5AE4 YES GO DO IT 01239000
- AR 4,R0 VAL=CON+ RH REL FAC 01240000
- EJECT 01241000
- COMPP ST R4,RLDCONST PUT VALUE BACK IN RLD CONST 01242000
- EX R6,MVCTO MOVE CONSTANT TO STOR. @V201005 01243000
- L 12,TEMPST GET ADDRESS OF RH SYMBOL 01244000
- TM 8(12),X'80' IS ENTRY DEFINED? 01245000
- BZ CTEX1 YES, SKIP REMEMBERING RTN. @V201005 01246000
- L 7,APPNT GET ADDRESS OF APOINT 01247000
- BALR 14,7 GO ADD TO STRING OF UNDEF'S 01248000
- CTEX1 SR R6,R6 GET 0 @V201005 01249000
- BAL 14,CTR CHECK FOR END OF CARD 01250000
- TM 0(10),X'01' NEXT RH + PH SAME AS THIS ONE 01251000
- BNO NXTENTRY NO, READ NEW DATA FIELD @VA10086 01251130
- TM 0(R10),X'30' IF SAME, COMPARE FLAGS @VA10086 01251260
- BZ BRTEST1 FIRST ENTRY IS NON-BRANCH @VA10086 01251390
- TM 4(R10),X'30' CHECK SECOND ENTRY @VA10086 01251520
- BNZ C5AA3 BOTH ARE BRANCH ADCONS @VA10086 01251650
- B BRTEST2 MIXED TYPES, REREAD ESID DATA @VA10086 01251780
- BRTEST1 EQU * @VA10086 01251910
- TM 4(R10),X'30' CHECK SECOND ENTRY @VA10086 01252040
- BZ C5AA3 BOTH ARE NON-BRANCH ADCONS @VA10086 01252170
- BRTEST2 EQU * @VA10086 01252300
- LH R4,SPEC+10 GET REMAINING BYTES IN RLD CARD @VA11838 01252430
- AR R4,R5 ADD 4 TO ADJUST FOR REREADING @VA11838 01252560
- STH R4,SPEC+10 STORE ADJUSTED BYTE COUNT @VA10086 01252690
- L R6,SAV67 LOAD REGISTER FOR TEST @VA10086 01252820
- LTR R6,R6 WAS ESID POINTER SAVED? @VA10086 01252950
- BNZ C5AC1A YES, REREAD RH AND PH @VA10086 01253080
- LR R6,R11 POINT BACK TO CURRENT ESID'S @VA11838 01253280
- ST R6,SAV67 SAVE THE POINTER @VA10086 01253470
- B C5AC1A BACK TO REREAD RH AND PH @VA10086 01253600
- NXTENTRY EQU * @VA10086 01253730
- AR R10,R5 GET ADDRESS OF NEXT DATA FIELD @VA10086 01253860
- B C5AC1 BACK TO GET NEW PH + RH 01254000
- C5AE4 SR 4,R0 SUB RH FROM ASSIGNED VAL 01255000
- B COMPP BACK TO ROUTINE 01256000
- MVCFROM MVC 0(*-*,R5),0(R3) EXECUTED MOVE @V201005 01257000
- MVCTO MVC 0(*-*,R3),0(R5) @V201005 01258000
- SPACE 2 01259000
- CTR LA 5,4 4 BYTES PER DATA FIELD 01260000
- ST R6,RLDCONST ZERO CONSTANT FIELD 01261000
- LH 4,SPEC+10 GET BYTE COUNT 01262000
- SR 4,5 SUBTRACT 5 01263000
- BZ NXTRLDCD GET NEXT RLD CARD FROM WORK FILE 01264000
- STH 4,SPEC+10 STORE NEW BYTE COUNT 01265000
- BR 14 BACK TO CALLLER 01266000
- SPACE 2 01267000
- CXDTST EQU * @VA10086 01267600
- TM 4(R6),X'30' IS IT A PR CUM LENGTH CONST? @VA10086 01268200
- BNO BADCRD2 NO, BAD CARD @VA01260 01269000
- LA 1,FAKECXD YES, SET TO DEFINE CXD ENTRY 01270000
- LA 2,NOCXD RETURN IF NOT FOUND 01271000
- BAL 3,PRSERCH1 LOOK FOR ENTRY IN REFTBL 01272000
- TM REFLG2(R12),REFICS ICS FLAG SET ON? @VA11353 01272300
- BO BADICS INVALID MATCH @VA11353 01272600
- NOCXD MVI 8(12),X'81' SET CXD CODE BYTE 01273000
- B CXDRET+4 BACK TO ROUTINE 01274000
- SPACE 2 01275000
- SKIPRLD BAL 14,CTR CHECK FOR END OF CARD 01276000
- SKIPRLD2 AR 10,5 MOVE TO NEXT 4-BYTE FIELD 01277000
- BAL 14,CTR CHECK FOR END OF CARD 01278000
- TM 0(10),X'01' NEXT RH + PH SAME AS THIS ONE ? 01279000
- BO SKIPRLD2 YES 01280000
- AR 10,5 NO, MOVE TO IT 01281000
- B C5AC1 PROCESS IT 01282000
- BADRLD EQU * @VA06291 01283000
- LA R14,N03 SET RET ADDR FOR LIO @VA06291 01284000
- LA R5,ERRORB SET ERROR FUNCTION FOR LIO @VA06291 01285000
- L R11,ALDRIO GO TYPE MSG AND SET RETURN @VA06291 01286000
- BR R11 CODE, EXIT ON RETURN FROM LIO @VA06291 01287000
- EJECT 01288000
- *********************************************************************** 01289000
- * 01290000
- * END CARD ROUTINE (END) 01291000
- * 01292000
- *********************************************************************** 01293000
- * 01294000
- C6AA1 C 1,END 01295000
- BC 7,C6AC1 BR-NOT END CARD 01296000
- CLC SPEC+28(4),BLANKS CHECK FOR CSECT LENGTH IN END 01297000
- BE C6AB5 NO - CONTINUE NORMALLY 01298000
- L 1,LOCCT YES - UPDATE THE LOCATION COUNT 01299000
- LA R1,7(0,R1) ALIGN TO DOUBLEWORD BOUNDARY @VA11353 01299300
- N R1,DBLBND REMOVE EXCESS BITS @VA11353 01299600
- A 1,SPEC+28 ... 01300000
- LA 1,7(0,1) ALIGN TO DBL BOUND 01301000
- N 1,DBLBND ... 01302000
- ST 1,LOCCT ... 01303000
- C6AB5 SR 2,2 ... 01304000
- CLI SPEC+5,C' ' 01305000
- BC 8,C6AB3 BR IF NO ADDR 01306000
- STC 6,SPEC+4 01307000
- TM FLAG1,ENDCDADR END CARD ADR ALLOWED 01308000
- BC 1,C6AB3 BR NO, ADDR SAVED 01309000
- LH 3,SPEC+14 LOD ESID 01310000
- BAL 14,REFADR 01311000
- L R2,8(0,R12) GET RELOCATION FACTOR 01312000
- C6AB4 A 2,SPEC+4 FORM ADDR 01313000
- STCM R2,B'0111',BRAD+1 SET ENTRY ADDRESS P0966 01314000
- OI FLAG1,ENDCDADR INDICATE END CARD ADDRESS SAVED 01315000
- C6AB3 B PASSTWO PROCESS RLDS 01316000
- C6AB6 XC ESIDTB(256),ESIDTB CLEAR ESID TABLE 01317000
- XC ESIDTB+256(256),ESIDTB+256 CLEAR ESID TABLE @VA02083 01318000
- XC ESIDTB+512(256),ESIDTB+512 CLEAR ESID TABLE HRC006DS 01318300
- XC ESIDTB+768(256),ESIDTB+768 CLEAR ESID TABLE HRC006DS 01318600
- XC ESIDTB+512(256),ESIDTB+512 CLEAR ESID TABLE 01318010
- XC ESIDTB+768(256),ESIDTB+768 CLEAR ESID TABLE 01318020
- BC 15,RD TO RD 01319000
- EJECT 01320000
- *********************************************************************** 01321000
- * 01322000
- * LOAD TERMINATE CARD ROUTINE (LDT) 01323000
- * 01324000
- *********************************************************************** 01325000
- * 01326000
- C6AC1 C 1,LDT 01327000
- BNE CHEKSPB NO - MAYBE AN "SPB" CARD. @VM03154 01328000
- C6AC2 CLI SPEC+16,C' ' IS THERE A NAME ? 01329000
- BE CHKTXT CHECK FOR TEXT FILE @VA04695 01330000
- LA 2,ERLDT1 01331000
- BAL 3,SERCH 01332000
- MVC BRAD(4),12(R12) PUT NEW START IN BRAD 01333000
- CHKTXT EQU * @VA04695 01334000
- CLC FTYPE,=CL8'TEXT' IS THIS TEXT FILE? @VA04695 01335000
- BE RD BRANCH IF YES, NO LDT IN TEXT@VA04695 01336000
- SPACE 01337000
- *********************************************************************** 01338000
- * 01339000
- * INVOKE TEXT LIBRARY SEARCHING 01340000
- * 01341000
- *********************************************************************** 01342000
- * 01343000
- LIBGO TM FLAG2,NOAUTO+NOLIBE ARE SEARCHES SUPPRESSED 01344000
- BO C6AD7 YES, DON'T LOOK 01345000
- NI FLAG3,X'FF'-CMD NO LONGER PROC COMMAND LINE @VA01699 01346000
- TM FLAGS,LUNDEF ANY UNDEFINEDS? 01347000
- BZ C6AD7 NO - SKIP LIBE SEARCH 01348000
- LA 3,NXTRD SET FOUND RETURN 01349000
- L 11,ALIBE GO SEARCH LIBE 01350000
- BALR 14,11 ... 01351000
- * CONTINUE TO "C6AD7" ... 01352000
- SPACE 01353000
- *********************************************************************** 01354000
- * 01355000
- * TERMINATE LOADING 01356000
- * 01357000
- *********************************************************************** 01358000
- C6AD7 EQU * 01359000
- NI FLAG1,255-NODUP REMOVE NODUP FLAG @VA05276 01360000
- L 12,ENTADR WAS 'ENTRY' SPECIFIED? 01361000
- LA R12,0(,R12) 01362000
- LTR 12,12 ... 01363000
- BZ NOENTCRD NO 01364000
- TM 8(12),X'80' WAS ENTRY-POINT DEFINED? 01365000
- BO NOENTCRD NO 01366000
- L R3,12(0,R12) GET V(ENTRY POINT) 01367000
- CLC 04(8,R3),=C'CMS"XEQ"' SAVE NORMAL START ADDR? 01368000
- BNE NOENT NO @VA03251 01369000
- TM DOSFLAGS,DOSMODE CMS/DOS ENVIRONMENT ACTIVE? @V305066 01370000
- BO FATERR2 IF SO, OS COMPILERS CANNOT RUN! @V305066 01371000
- CLC 12(4,R3),ZEROES ADDRESS FILLED IN? @VA11353 01372000
- BNE NOENTCRD YES @VA03251 01373000
- MVC 12(4,R3),BRAD SAVE OLD START ADDR 01374000
- NOENT MVC BRAD+1(3),13(R12) SET NEW START ADDRESS @VA03251 01375000
- NOENTCRD EQU * 01376000
- L 0,BRAD LOAD START ADDRESS 01377000
- EX 0,C6AB6 CLEAR ESID TABLE 01378000
- ST R0,STRTADDR SAVE STARTING ADDRESS 01379000
- L R4,FLAG1 GET FLAG1 AND 2 01380000
- ST R4,LDRFLAGS SAVE IN NUCON 01381000
- STH R4,TBENT SAVE LDR TBL COUNT IN NUCON 01382000
- TM BATFLAGS,BATLOAD LOADING ABOVE FREELOWE? @VA04199 01383000
- BO OKLOC YES; SKIP @VA04199 01384000
- TM MODFLGS,SYSLOAD SYSTEM LOAD ? @VA04666 01385000
- BO OKLOC YES, ALLOW LOAD ABOVE FREELOWE @VA04666 01386000
- CLC LOCCT+1(3),FREELOWE+1 NO; LOCCT > FREELOWE? @VA04199 01387000
- BH FATERR1 YES; TERMINATE WITH ERROR @VA04199 01388000
- OKLOC L R4,LOCCT GET CURRENT VALUE OF 'LOCCNT' @VA04199 01389000
- LA R4,0(,R4) CLEAR HIGH BYTE @V305665 01390000
- SR R3,R3 @V305665 01391000
- C R3,AOSMODL IS THERE A SIM. MODULE? @V305665 01392000
- BE NOSIM BRANCH IF NOT @V305665 01393000
- C R4,AOSMODL IS THIS OS SIM. MODULE? @V305665 01394000
- BH TRANOVR BRANCH IF YES @V305665 01395000
- NOSIM EQU * @V305665 01396000
- ST R4,LOCCNT STORE NEW 'LOCCNT' @V305665 01397000
- CLC LOCCNT,AUSRAREA ARE WE BELOW USER STOR? @VA02752 01398000
- BNL TRANOVR NO, PROCEED AS USUAL @VA02752 01399000
- CLC LOCCNT,=V(TRANSEND) ABOVE END OF TRANS AREA? @VA02752 01400000
- BH FATERR1 YES, ERROR @VA02752 01401000
- TRANOVR MVC PRHOLD(2),PRVCNT SAVE PR COUNT @VA02752 01402000
- L 12,TBLREF 01403000
- SR 4,4 SHOW NO ERRORS IF NOT 01404000
- LH R4,TBLCT GET NUMBER OF LDR TBL ENTRIES 01405000
- CH R4,=H'2' WAS ANYTHING LOADED 01406000
- BE N03 NO, BACK TO USER 01407000
- LA 3,20 LDR TBL ENTRY SIZE 01408000
- SR 0,0 01409000
- SUB1 SR 12,3 POINT TI FIRST ENTRY IN REFTBL 01410000
- CLI 8(12),X'80' IS ENTRY DEFINED? 01411000
- BNE NO1 YES - LOOK AT NEXT ENTRY 01412000
- MVI UNRES,X'80' SAVE UNRESOLVED FLAG @VA02829 01413000
- TM REFLG2(R12),REFLBT NAME FOUND IN DMSLIB SEARCH? @VA11353 01414000
- BO NO1 YES, DON'T LIST AS UNDEF. 01415000
- SYMCHK LTR 0,0 TEST FOR PREV UNDEF SYM 01416000
- BC 7,SUB2 IF NONE, PRINT HEADER 01417000
- LA 5,ERRORS PRINT UNDEFINED SYMBOL MESSAGE 01418000
- L 11,ALDRIO GET LINKAGE 01419000
- BALR 14,11 GO PRINT HEADING 01420000
- LA 2,OUTPUT+1 INITIALIZE POINTERS 01421000
- LA 5,OUTPUT+68 01422000
- SUB2 MVC 0(8,2),0(12) MOVE NAME INTO OUTPUT LINE 01423000
- LA 2,9(,2) SPACE UP LINE POINTER 01424000
- CR 2,5 ARE WE AT END OF LINE 01425000
- BC 4,SUB3 NO - CONTINUE 01426000
- LA 5,OUTR YES, PRINT OUT LINE 01427000
- L 11,ALDRIO GET LINKAGE 01428000
- BALR 14,11 GO PRINT 01429000
- LA 2,OUTPUT+1 INITIALIZE POINTERS 01430000
- LA 5,OUTPUT+68 01431000
- SUB3 LA R0,4 ERROR (NON-FATAL) 01432000
- NO1 BCT 4,SUB1 01433000
- LTR 0,0 TEST FOR ERRORS 01434000
- BC 8,NO2 IF SO, FLUSH OUTPUT BUFFER 01435000
- ST R0,LDRADDR+4 SAVE ERROR CODE 01436000
- LA 5,OUTPUT 01437000
- CR 2,5 01438000
- BC 8,NO2 01439000
- LA 5,OUTR 01440000
- L 11,ALDRIO GET LINKAGE 01441000
- BALR 14,11 PRINT LAST LINE 01442000
- NO2 TM FLAGS,START START SPECIFIED ? 01443000
- BNO N03 NO, CLOSE AND LEAVE 01444000
- CLC LDRADDR+6(2),=H'4' CHECK ERROR CODE 01445000
- BNH LDXEQ OK IF NOT > 4 01446000
- B N03 IF > 4 DON'T GO INTO EXECUTION 01447000
- EJECT 01448000
- *********************************************************************** 01449000
- * 01450000
- * "SPB" = SET LOCATION COUNTER TO NEXT PAGE BOUNDARY 01451000
- * 01452000
- *********************************************************************** 01453000
- SPACE 01454000
- CHEKSPB CL R1,SPB IS IT AN "SPB" CARD ? @VM03154 01455000
- BNE CTLCRD1 NO - PROCESS AS A CONTROL CARD. @VM03154 01456000
- L R6,LOCCT PICK UP LOCATION COUNTER @VM03154 01457000
- LA R6,Q4095(,R6) ROUND UP TO NEXT PAGE BOUNDARY @VM03154 01458000
- N R6,PAGBOUND ... @VM03154 01459000
- B C2BNEWLC GO STORE UPDATED LOCATION CNTR. @VM03154 01460000
- EJECT 01461000
- USING XPRTAB,10 01462000
- N023 EQU * 01463000
- L R3,REG13SAV EXECUTION TIME SAVE AREA 01464000
- L R4,ACMSRET SET RETURN TO DMSITS 01465000
- L R5,PSW+4 BRANCH ADDRESS 01466000
- SR 6,6 ZERO FOR 0 01467000
- L R7,PARMLIST PLIST TO R1 01468000
- L R6,EPARMLST setup for restoring EPLIST to R0 01468200
- TM DOSFLAGS,DOSSVC+DOSCOMP DOS SVC+COMP ACTIVE ? @V305001 01469000
- BNO SAVREGS NO, BRANCH @V305001 01470000
- LR R7,R5 ENTRY POINT TO R1 ALSO @V305001 01471000
- SAVREGS STM R3,R7,0(R3) TEMP SAVE IN USER'S SAVE @V305001 01472000
- LR 6,3 REG SAVE OF SAVE AREA PTR 01473000
- SPACE 01474000
- SPACE 01475000
- LA 1,CONWAIT WAIT FOR ANY TYPING TO DIE DOWN 01476000
- SVC X'CA' (NOTE - R15=0 ON RETURN) 01477000
- TM DOSFLAGS,DOSSVC+DOSCOMP DOS SVC+COMP ACTIVE ? @V305001 01478000
- BO NOEXMSG YES, BYPASS NEXT MSG @V305001 01479000
- DMSERR TEXT='Execution begins...',NUM=740,LET=I, HRC309DSX01480000
- CSECT=LIO @V1D1705 01481000
- SPACE 01482000
- NOEXMSG BAL R3,N032 OFF TO INITIALIZE LDR @V305001 01483000
- DROP 10 01484000
- SPACE 01485000
- STRINIT TYPCALL=BALR 01486000
- TM DOSFLAGS,DOSSVC IS DOSSVC MODE ACTIVE ? @V305001 01487000
- BZ STRNTOK NO, DO NOT CALL SMNAT @V305001 01488000
- LR R3,R1 SAVE REG.1 FOR A WHILE @V305001 01489000
- LA R1,=CL8'DMSSMNAT' GET DMSSMNAT NAME @V305001 01490000
- SVC 202 CALL SMNAT TO INITIALIZE @V305001 01491000
- DC AL4(FATERR3) ONLY ERROR IS NO STORAGE @VA06270 01492000
- LR R1,R3 RESTORE REG.1 (USED ABOVE) @V305001 01493000
- XC DOSRC,DOSRC ZERO DOS RETURN CODE @V305001 01494000
- STRNTOK L R15,CURRSAVE GET LOAD OR START SAVE AREA @V305001 01495000
- USING SSAVE,R15 01496000
- OI TYPFLAG,TPFUSR MAKE IT A 'USER' PROGRAM 01497000
- L R14,EGPR1 POINT TO ORIGINAL PARAMETER LIST 01498000
- MVC CALLEE,8(R14) COPY PGM NAME INTO SAVE AREA 01499000
- CLI CALLEE,X'FF' WAS COMMAND 'START' WITH NO ARG? 01500000
- BNE *+10 SKIP IF NOT 01501000
- MVC CALLEE,=CL8'USER PGM' JUST USE 'USER PGM' AS CALLEE 01502000
- DROP R15 01503000
- L R13,PSW+4 GET USER'S START ADDRESS @VA07981 01503080
- LA R13,0(R13) CLEAR HIGH ORDER BYTE @VA07981 01503160
- C R13,=V(USERAREA) LOADED IN USER AREA? @VA07981 01503240
- BL TSYSFLAG NO, TEST FOR SYSTEM TRANSIENT @VA07981 01503320
- TM PROTFLAG,PRFUSYS SYSTEM FLAG SET FOR USER? @VA07981 01503400
- BZ USERKEY NO, SET USER KEY @VA07981 01503480
- B SETMASK YES, KEEP SYSTEM KEY @VA07981 01503560
- TSYSFLAG EQU * @VA07981 01503640
- TM PROTFLAG,PRFTSYS TRANSIENT WITH SYSTEM KEY? @VA07981 01503720
- BO SETREGS MASK AND KEY REMAIN UNCHANGED @VA07981 01503800
- USERKEY EQU * @VA07981 01503880
- DMSKEY USER,NOSTACK SET USER PSW KEY 01504000
- C R13,=V(USERAREA) LOADED IN USER AREA? @VA07981 01504250
- BL SETREGS NO, LEAVE INTERRUPTS DISABLED @VA07981 01504500
- SETMASK EQU * @VA07981 01504750
- SSM =AL1(X'FF') TURN ON SYSTEM MASK 01505000
- SETREGS EQU * @VA07981 01505500
- LM 13,1,0(1) SET GPRS 13 - 1 01506000
- XC 0(18*4,13),0(13) CLEAR SAVE AREA 01507000
- BR R15 BRANCH TO ROUTINE 01508000
- EJECT 01509000
- N03 L 3,RETREG SET TO RETURN TO CALLER 01510000
- N032 OI FLAGS,CLOSELIB SET TO CLOSE LIBRARIES 01511000
- L 11,ALIBE GO TO LIBE ROUTINE 01512000
- BALR 14,11 ... 01513000
- LA 5,LDRFIN IO INDEX FOR LDR FINISH 01514000
- L 11,ALDRIO GET LINKAGE 01515000
- BALR 14,11 GO FINISH 01516000
- TM OSSFLAGS,DYLD IS THIS A DYNAMIC LOAD 01517000
- BO AROUND YES,LEAVE TXTLIB DIRECTORIES IN STOR. 01518000
- STM R0,R15,APSV SAVE REGISTERS 01519000
- L R15,=V(DMSLGTA) FREE THE TXTLIB DIRECTORY BLOCKS 01520000
- BALR R14,R15 01521000
- LM R0,R15,APSV RESTORE REGISTERS 01522000
- AROUND EQU * 01523000
- LM R9,R12,GPRSAV 01525000
- LA R0,NEED RETURN FRRE STORAGE 01526000
- LR 1,13 01527000
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 01528000
- LR 1,6 01529000
- LR 14,3 01530000
- L R15,LDRRTCD GET RETURN CODE P0934 01531000
- BCR 15,14 RETURN 01532000
- SPACE 4 01533000
- ERLDT1 LA 1,SPEC+16 SET POINTER TO NAME 01534000
- ERLDT LA R5,ERROR30 ERROR MSG 209E (NAME NOT FOUND) 01535000
- MVC OUTBUF(8),0(1) MOVE NAME TO BUFF 01536000
- BC 15,FATERR 01537000
- EJECT 01538000
- *********************************************************************** 01539000
- * 01540000
- * ROUTINE TO LOCATE REFTBL ENTRIES 01541000
- * THRU ESID 01542000
- * 01543000
- * LH 3, WITH ESID, RH, OR PH 01544000
- * VALUE BEFORE ENTERING ROUTINE 01545000
- * 01546000
- *********************************************************************** 01547000
- * 01548000
- REFADR L 12,TBLREF 01549000
- SLL 3,1 TIMES TWO 01550000
- LR R5,R3 SAVE TABLE INDEX 01551000
- LH 3,ESIDTB(3) GET INDEX OF ENTRY 01552000
- N R3,ESIDMASK CLEAR OUT FLAG BITS 01553000
- MH R3,=H'20' MULTIPLY BY 20 01554000
- SR 12,3 SIZE-(ESID X 16) 01555000
- C 12,TBLREF SEE IF ESD EXISTS 01556000
- BCR 7,14 YES - BACK TO CALLER 01557000
- L R7,LOCCT ASSUME LOCATION 01558000
- LA R7,7(0,R7) ROUND TO DBL WD BOUNDARY 01559000
- N R7,DBLBND 01560000
- ST R7,LOCCT 01561000
- CLC SPEC(4),ESD ESD CARD ? 01562000
- BNE 4(0,R14) NO, RETURN +4 01563000
- DMSFREE DWORDS=3,TYPCALL=BALR GET WAITING BLK 01564000
- LR R7,R5 SET R7 TO ID TABLE INDEX 01565000
- LA R2,MEMBOUND POINT TO WAITING CHAIN 01566000
- BACK L R3,0(R2) 1ST (NEXT) BLOCK 01567000
- LTR R3,R3 EXIST 01568000
- BZ ENDCHAIN NO, ADD NEW BLOCK 01569000
- LR R2,R3 YES, LOOK FOR NEXT 01570000
- B BACK 01571000
- ENDCHAIN ST R1,0(R2) CHAIN NEW BLOCK 01572000
- MVC 4(16,R1),SPEC+16 SAVE ESD DATA ITEM FOR LD 01573000
- XC 0(4,R1),0(R1) ZERO LASR POINTER 01574000
- LA R1,ESIDTB(R7) GET TO ESIDTB FOR SD 01575000
- OI 0(R1),ESIDLATE INDICATE WAITING LD'S 01576000
- B ESD00 PROCESS NEXT ESD DATA ITEM 01577000
- SDDEF LH R7,SPEC+14 ID OF SD 01578000
- LA R2,MEMBOUND POINT TO WAITING CHAIN 01579000
- LDLOOK L R3,0(R2) R3 = NEXT (1ST) BLOCK 01580000
- LTR R3,R3 EXIST 01581000
- BZ ESD00 NO, DO NEXT ESD DATA ITEM 01582000
- CH R7,18(R3) LD AND SD ID'S MATCH 01583000
- BE LDFND YES, THIS LD IS WAITING 01584000
- LR R2,R3 UPDATE BASE PTR 01585000
- B LDLOOK LOOK AT NEXT BLOCK 01586000
- LDFND STM R0,R15,PLISTSAV PROTECT REGISTERS 01587000
- MVC SPEC+16(16),4(R3) RESTORE ESD DATA ITEM TO SPEC BUFFER 01588000
- BAL R10,LATESD PROCESS LD ITEM 01589000
- LM R0,R15,PLISTSAV RESTORE REGISTERS 01590000
- L R5,0(R3) PTR TO NEXT BLOCK 01591000
- LR R1,R3 SET FREE LOCATION 01592000
- DMSFRET DWORDS=3,LOC=(1),TYPCALL=BALR 01593000
- ST R5,0(R2) ELIMINATE FREED BLOCK FROM CHAIN 01594000
- B LDLOOK LOOK FOR MORE WAITING BLOCKS 01595000
- EJECT 01596000
- *********************************************************************** 01597000
- * 01598000
- * ROUTINE TO SEARCH REFERENCE TABLE 01599000
- * FOR A GIVEN NAME 01600000
- * 01601000
- *********************************************************************** 01602000
- * 01603000
- * CALLING SEQUENCE-- 01604000
- * L(LA) 2,NOT FOUND RETURN 01605000
- * BAL 3,ENTRY FOUND RETURN 01606000
- * REG 12 = ADDR OF ENTRY IN REFTBL.REG 11=1,REG 1= NAME OF PROG 01607000
- * REG. 3 = REFTBL NUMBER (E.G. 1,2,3,...) 01608000
- * THIS ROUTINE COMPARES EACH REFERENCE TABLE ENTRY 01609000
- * WITH THE GIVEN NAME,DETERMINING FIRST WHETHER THERE 01610000
- * IS AN ENTRY FOR THAT NAME AND 2ND WHAT THE 01611000
- * STORAGE ADDRESS OF THAT ENTRY IS. 01612000
- * 01613000
- *********************************************************************** 01614000
- * 01615000
- PRSERCH LA 1,SPEC+16 ADDR OF NAME IN CARD 01616000
- PRSERCH1 LA R15,X'80' PR MASK FOR CHKTYPE 01617000
- B SERCH2 SKIP OVER SERCH INITIALIZATION 01618000
- SERCH LA 1,SPEC+16 ADDR OF NAME IN CARD 01619000
- SERCH1 LA R15,X'70' NON-PR MASK FOR CHKTYPE 01620000
- SERCH2 LH 0,TBLCT NO OF ENTRIES IN REFTBL 01621000
- SR 4,4 01622000
- LA R5,20 LDR TBL ENTRY SIZE 01623000
- L 12,TBLREF LARGEST ADDR IN STORAGE+1 01624000
- LA R12,0(0,R12) CLEAR COUNT BYTE 01625000
- STM R6,R7,SAV67 SAVE 6 + 7 01626000
- LTR 0,0 01627000
- BC 8,NOT 01628000
- LM 6,7,0(1) LOAD WORD FOR SEARCH 01629000
- CMP SR 12,5 01630000
- AH R4,=H'1' TO ACCUMULATE ENTRY POSITION 01631000
- CL 7,4(0,12) SECOND HALF OF ENTRY MATCH? 01632000
- BNE CMPEND NO - TRY ANOTHER 01633000
- CL 6,0(0,12) FIRST HALF OF ENTRY MATCH? 01634000
- BE CHKTYPE YES - CHECK FOR TYPE MATCH 01635000
- CMPEND BCT 0,CMP BACK TO LOOK AGAIN 01636000
- NOT SR 12,5 01637000
- AH R4,=H'1' ADD TO TOTAL ENTRIES 01638000
- SR R0,R0 GET NUMBER OF PAGES OF LOADER-TABLES JS 01639000
- IC R0,TBLREF FROM LEFT-MOST BYTE OF "LDRTBL", JS 01640000
- MH R0,=H'204' X 204 (204 ENTRIES PER PAGE) 01641000
- CR 4,0 01642000
- BC 10,ERREF REFERENCE TABLE OVERFLOW 01643000
- STH 4,TBLCT NO. FO ENTRIES IN TBLREF 01644000
- MVC 0(8,12),0(1) PLACE NAME IN REFTBL 01645000
- XC 8(12,12),8(12) ZERO OTHER PART OF ENTRY 01646000
- LM R6,R7,SAV67 RESTORE 6 + 7 01647000
- BCR 15,2 01648000
- ERREF LA 5,ERRORR GO TO ERPRNT WITH COMMENT OF RE 01649000
- BC 15,FATERR 01650000
- SPACE 01651000
- CHKTYPE CLI 8(R12),X'83' IS THIS A WEAK EXTRN 01652000
- BE NMFND YES, OMIT CHECK 01653000
- TM 8(R12),X'0D' DON'T CHECK FOR COMMON BIT 01654000
- NMFND EX R15,TYPECHK PR BC 8; NON-PR BC 7 @V1D1705 01655000
- LM R6,R7,SAV67 RESTORE REGS @V1D1705 01656000
- BR 3 BACK TO FOUND RETURN 01657000
- SPACE 01658000
- TYPECHK BC 0,CMPEND 01659000
- EJECT 01660000
- *********************************************************************** 01661000
- * 01662000
- * ERROR ROUTINES 01663000
- * 01664000
- *********************************************************************** 01665000
- DMSLDRD EQU * 01666000
- FATERR L 11,ALDRIO GET LINKAGE 01667000
- BALR 14,11 GO DO SOMETHING 01668000
- B N03 GO TO TERMINATE LOADING 01669000
- SPACE 01670000
- FATERR1 EQU * 01671000
- LA 5,ERRORC CORE SIZE EXCEEDED 01672000
- B FATERR GIVE UP 01673000
- SPACE 2 01674000
- FATERR2 EQU * @V305066 01675000
- LA R5,ERRORD CMS/DOS ENVIRON. ACTIVE @V305066 01676000
- B FATERR GIVEUP @V305066 01677000
- SPACE 2 01678000
- FATERR3 EQU * @VA06270 01679000
- LA R5,ERRORC CORE SIZE EXCEEDED @VA06270 01680000
- L R11,ALDRIO GET LINKAGE @VA06270 01681000
- BALR R14,R11 PUT OUT MESSAGE @VA06270 01682000
- LM R13,R1,0(R3) RESTORE REGISTERS @VA06270 01683000
- L R15,LDRRTCD GET RETURN CODE @VA06270 01684000
- BR R14 AND RETURN @VA06270 01685000
- DMSLDRC EQU * 01686000
- BADCRD LA R14,RD RETURN FROM LIO @VA01260 01687000
- B BADCRD3 GO SET ERROR CODE @VA01260 01688000
- BADCRD2 LA R14,NXTRLDCD RETURN FROM LIO @VA01260 01689000
- BADCRD3 LA R5,ERRORA ERROR CODE FOR LIO @VA01260 01690000
- MVC OUTBUF+15(80),SPEC MOVE CRD IMJ TO BUFF 01691000
- L 11,ALDRIO GET LINKAGE 01692000
- BR 11 GO PRINT INV CARD 01693000
- EJECT 01694000
- *********************************************************************** 01695000
- * CONSTANTS AREA 01696000
- *********************************************************************** 01697000
- SPACE 2 01698000
- ALDRIO DC A(DMSLIO) I/O ROUTINE 01699000
- ALIBE DC V(DMSLIB) LIBRARY SEARCH ROUTINE 01700000
- AADDEF DC A(DMSLSBC) LINKAGE DEFINITION ROUTINE 01701000
- APPNT DC A(DMSLSBB) LINKAGE WAITING ROUTINE 01702000
- HEXBB DC A(DMSLSBA) HEX TO BINARY CONVERSION 01703000
- CONWAIT DC CL8'CONWAIT' 01704000
- SPACE 1 01705000
- SLC DC X'02' *** 01706000
- DC C'SLC' 01707000
- ICS DC X'02' *** 01708000
- DC C'ICS' 01709000
- ESD DC X'02' *** 01710000
- DC C'ESD' 01711000
- TXT DC X'02' *** 01712000
- DC C'TXT' 01713000
- REP DC X'02' *** 01714000
- DC C'REP' 01715000
- RLD DC X'02' *** 01716000
- DC C'RLD' 01717000
- END DC X'02' *** 01718000
- DC C'END' 01719000
- LDT DC X'02' *** 01720000
- DC C'LDT' 01721000
- SPB DC X'02' SPB = "SET TO PAGE BOUNDARY" @VM03154 01722000
- DC C'SPB' ... @VM03154 01723000
- SPACE 01724000
- Q4095 EQU 4095 TO ROUND TO NEXT PAGE BOUNDARY @VM03154 01725000
- HW511 DC H'511' HALFWORD '511' HRC006DS 01725440
- SPACE 01726000
- DS 0F @VA13904 01726050
- PAGBOUND DC X'00FFF000' TO TRUNCATE TO PAGE BOUNDARY @VM03154 01726100
- DBLBND DC X'00FFFFF8' MASK FOR DBL WD ALIGN 01726150
- SPACE 1 01727000
- SPACE 1 01728000
- OUTR EQU 2 TYPE OUT MSG BUFFER 01729000
- LDRSET EQU 4 IO INDEX 01730000
- LDRFIN EQU 6 IO INDEX 01731000
- PRDEF EQU 8 IO INDEX 01732000
- CMDEF EQU 12 IO INDEX 01733000
- PRVAL EQU 16 IO INDEX 01734000
- CMVAL EQU 20 IO INDEX 01735000
- ERRORU EQU 28 203W - SLCNAME UNDEFINED 01736000
- ERROR30 EQU 30 209E - ENTRY POINT NOT FOUND 01737000
- ERRORA EQU 32 - INVALID CARD TO LOAD MAP 01738000
- ERRORB EQU 54 ERROR056E- INVALID TEXT DECK @VA06291 01739000
- PROVER EQU 38 168S - PR TABLE OVERFLOW 01740000
- ERRORR EQU 44 716S - LOADER TABLE OVERFLOW 01741000
- WRERR46 EQU 46 705S - WRITE ERROR 01742000
- ERRORM EQU 48 202W - DUPLICATE IDENTIFIER 01743000
- ERRORI EQU 50 455E - ENTRY POINT NOT DEFINED 01744000
- ERRORS EQU 52 201W - THE FOLLOWING NAMES ARE UNDEFINED 01745000
- ESDOVER EQU 56 169S - ESDID TBL OVERFLOW 01746000
- CRDIMJ EQU 60 - CARD IMAGE TO LOAD MAP 01747000
- RDERR62 EQU 62 704S - READ ERROR 01748000
- PRERR EQU 70 206W - PR ALIGNMENT ERROR 01749000
- CTLCRD EQU 78 - CONTROL CARD TO LOAD MAP 01750000
- ERRORC EQU 82 709S - STORAGE EXCEEDED 01751000
- ERRORD EQU 86 099E - CMS/DOS ENVIRON. ACTIVE @V305066 01752000
- EJECT 01753000
- SPACE 1 01754000
- RDISK DC CL8'RDBUF' ROUTINE 01755000
- DS 8C FILE 01756000
- DC CL8'TEXT' TYPE 01757000
- DC CL2' ' MODE 01758000
- DC H'0' ITEM NO. 01759000
- DS 4C 01760000
- SETBYTE DC AL4(800) BUFF SIZE (10 CARDS 01761000
- DS 2C 01762000
- DC H'10' GET 10 80-BYTE ITEMS 01763000
- DC AL4(0) 01764000
- FDISK DC CL8'FINIS' ROUTINE 01765000
- DS 8C FIEL 01766000
- DC CL8'TEXT' TYPE 01767000
- DC AL2(0) 01768000
- SPACE 1 01769000
- SPACE 2 01770000
- DS 0F 01771000
- * FORMAT OF ESIDTB ENTRY IS -- 01772000
- * BIT 0 DUPLICATE SD FLAG 01773000
- * BIT 1 SD-TYPE ESID FLAG 01774000
- * BIT 2 WAITING LD'S EXIST 01775000
- * BIT 3 UNUSED 01776000
- * BIT 4-15 REFTBL ENTRY NUMBER (E.G. 1,2,3,...) 01777000
- ESIDMASK DC X'00001FFF' MASK OUT ESIDTB FLAGS 01778000
- ESIDDUPF DC X'00008000' DUPLICATE SD FLAG 01779000
- ESIDSDF DC X'0000',AL1(ESIDSDFB),X'00' SD-TYPE ESID FLAG 01780000
- ESIDSDFB EQU X'40' SD-TYPE ESID BIT 01781000
- ESIDLATE EQU X'20' WAITNG LABEL DEFINITIONS EXIST 01782000
- SPACE 01783000
- EJECT 01785000
- DROP R8,R9 01786000
- USING RELDR,0 GET HALF-WORD DISP FROM RELDR 01787000
- USING RELDR+4096,1 @VA02616 01788000
- DS 0H 01789000
- XTRATBL EQU * FOR XEQ ENTRY ANALYSIS 01790000
- DC S(XBYTE) 0 01791000
- DC S(XHALF) 01792000
- DC S(XCOMSET) 01793000
- DC S(XFULL) 3 01794000
- DC S(XCXD) 4 01795000
- DC S(XUNDEF) 5 01796000
- DC S(XUNDEF) 6 01797000
- DC S(XDBL) 7 01798000
- SPACE 1 01799000
- ESDANAL EQU * FOR ESD ANALYSIS 01800000
- DC S(C3AA3) 01801000
- DC S(ENTESD) 01802000
- DC S(C3AH1) 01803000
- DC S(BADCRD) 01804000
- DC S(C3AA3) TREAT PC AS CSECT 01805000
- DC S(COMESD) 01806000
- DC S(PRVESD) 01807000
- DC S(BADCRD) 01808000
- DROP 0,R1 @VA02616 01809000
- USING RELDR,R8,R9 01810000
- SPACE 1 01811000
- DS 0F 01812000
- FAKECXD DC X'FF' 01813000
- DC CL7'CXD' 01814000
- BLANKS EQU FAKECXD+4 FIELD OF BLANKS 01815000
- SPACE 1 01816000
- SPACE 2 01817000
- LTORG 01818000
- SPACE 01819000
- PRTRAN DC X'7C7D827E8180807F' 01820000
- DC X'000103070504020500000000000000000000000006' 01821000
- TRANPR EQU *-X'90'-1 01822000
- PCTYPE EQU X'04' PRIVATE CODE INDICATOR @VA04910 01823000
- WKEXT EQU X'03' WEAK EXTERN INDICATOR 01824000
- EJECT 01825000
- ********************************************************************** 01826000
- * 01827000
- * CONTROL CARD PROCESSOR 01828000
- * 01829000
- ********************************************************************** 01830000
- DS F 01831000
- CTLCRD1 EQU * 01832000
- SPACE 01833000
- LA 1,SPEC SET P-LIST FOR 'SCAN' 01834000
- STM R2,R15,APSV+8 SAVE REGS @VA02089 01835000
- LA R0,80 SET COUNT TO 80 BYTES 01836000
- USING NUCON,R0 01837000
- MVC PLISTSAV(256),CMNDLIST SAVE SCAN WORK AREA 01838000
- MVC PLISTSAV+256(256),CMNDLIST+256 01839000
- L R15,ASCANN GET ADDRESS OF SCAN 01840000
- BALR 14,15 AND AWAY WE GO ... 01841000
- LM R2,R15,APSV+8 RESTORE REGS @VA02089 01842000
- CLC 0(8,1),=CL8'ENTRY' IS IT ENTRY 01843000
- BE CTLENT YES 01844000
- CLC 0(8,1),=CL8'LIBRARY' IS IT LIBRARY 01845000
- BE CTLLIB YES 01846000
- MVC CMNDLIST(256),PLISTSAV RESTORE PLIST 01847000
- MVC CMNDLIST+256(256),PLISTSAV+256 01848000
- TM FLAG2,NOINV DO WE PRINT ILLEGAL CARDS ? 01849000
- BC 8,BADCRD YES 01850000
- B RD GET NEXT CARD 01851000
- SPACE 2 01852000
- CTLENT EQU * 01853000
- LA R6,CTLRET RETURN FROM TABLE SEARCHING 01854000
- MVC ENTNAME,8(R1) SAVE ENTRY NAME 01855000
- CTLENT1 EQU * COME HERE IF RESET WAS SPECIFIED 01856000
- LA 1,ENTNAME SET ADDRESS OF ENTRY NAME 01857000
- LA 2,ENTNO SET 'NOT FOUND' ADDRESS 01858000
- BAL 3,SERCH1 SEARCH LOADER TABLES 01859000
- CTLENT2 TM FLAGS,RESET RESET 'NAME' IN EFFECT P3093 01860000
- BCR 1,R6 YES, IGNORE ENTRY FUNCTION P3093 01861000
- ST 12,ENTADR SAVE ADDRESS OF LOADER TABLE ENTRY 01862000
- BR R6 RETURN TO CALLER 01863000
- ENTNO EQU * 01864000
- OI 8(12),X'80' INDICATE ENTRY UNDEFINED 01865000
- OI FLAGS,LUNDEF NOTE THAT THERE ARE UNDEFINES 01866000
- B CTLENT2 P3093 01867000
- CTLRET EQU * 01868000
- LA 5,CTLCRD SET I/O MESSAGE NUMBER 01869000
- MVC OUTBUF+15(80),SPEC CARD IMAGE 01870000
- L 11,ALDRIO LINKAGE ADDRESS 01871000
- BALR R14,R11 PRINT CONTROL CARD 01872000
- CTRESTR MVC CMNDLIST(256),PLISTSAV RESTORE SCAN WORK AREA 01873000
- MVC CMNDLIST+256(256),PLISTSAV+256 01874000
- B RD PROCESS NEXT CARD 01875000
- SPACE 2 01876000
- CTLLIB EQU * 01877000
- CLI 8(1),C'*' IS IT NON-OBLIGATOEY REFERENCE 01878000
- BE NONREF YES 01879000
- CLI 8(1),C'(' IS IT NON-OBLIGATORY REFERENCE 01880000
- BNE BADCRD NO, CONDIDER IT INVALID 01881000
- NONREF EQU * 01882000
- LA 11,1 SET A 1 INTO REG. 11 01883000
- LA 6,SPEC SCAN FOR ( 01884000
- LA R5,SPEC+79 POINT TO END OF CARD P3072 01885000
- NONREF1 EQU * 01886000
- AR 6,11 INCREMENT 01887000
- CR R6,R5 AT END OF CARD P3072 01888000
- BH BADCRD YES, SOMETHING WRONG P3072 01889000
- CLI 0(6),C'(' IS IT ( 01890000
- BNE NONREF1 NO 01891000
- NONREF2 EQU * 01892000
- MVC OUTBUF(8),=CL8' ' SPACE TO FORM NAME @VA09901 01893000
- LA 7,OUTBUF-1 INITIALIZE POINTER 01894000
- NONREF3 LA R5,SPEC+79 SET R5 TO END OF CARD P3089 01895000
- AR 6,11 INCREMENT 01896000
- CR R6,R5 AT END OF CARD P3072 01897000
- BH BADCRD YES, SOMETHING WRONG P3072 01898000
- AR 7,11 INCREMENT 01899000
- CLI 0(6),C',' END OF NAME? 01900000
- BE NONREFM YES 01901000
- CLI 0(6),C')' END OF CONTROL CARD? 01902000
- BE NONREFN YES 01903000
- MVC 0(1,7),0(6) MOVE CHARACTER 01904000
- B NONREF3 GET NEXT CHARACTER 01905000
- SPACE 01906000
- NONREFM EQU * 01907000
- BAL 7,NONREFX MARK ENTRY 01908000
- B NONREF2 GET NEXT ENTRY 01909000
- SPACE 01910000
- NONREFN EQU * 01911000
- BAL 7,NONREFX MARK LAST ENTRY 01912000
- B CTLRET PRINT CONTROL CARD 01913000
- SPACE 01914000
- NONREFX EQU * 01915000
- LA 1,OUTBUF SET ADDR. OF ENTRY NAME 01916000
- LA 2,NONREFNT SET 'NOT FOUND' RETURN 01917000
- BAL 3,SERCH1 SEARCH LOADER TABLE 01918000
- TM 8(12),X'80' IS IT DEFINED ALREADY 01919000
- BZ 0(0,7) YES, TOO LATE TO BOTHER 01920000
- TM REFLG2(R12),REFCMD DEFND BY CMD? @VA01699 01921000
- BCR 7,R7 OVERRIDE LIBE CARD @VA01699 01922000
- OI REFLG1(R12),REFLIB NOTE SKIP LIBE SEARCH @VA01699 01923000
- BCR 15,7 RETURN TO CALLER 01924000
- NONREFNT EQU * 01925000
- OI REFLG1(R12),REFLIB+REFUND 'UNDEFINED' ALSO @VA01699 01926000
- BCR 15,7 BACK TO CALLER 01927000
- SPACE 01928000
- LTORG 01929000
- * 01930000
- C16 EQU 16 @VA07537 01930100
- C25 EQU 25 @VA07537 01930200
- M1 EQU 1 BINARY MASK '0001' @VA12428 01930220
- M2 EQU 2 BINARY MASK '0010' @VA12428 01930240
- NGREL EQU X'01' @VA07537 01930300
- COMMA EQU X'6B' SPECIAL CHARACTER: ',' @VA11353 01930400
- ZEROES DC F'0' FOUR BYTES OF ZEROES @VA11353 01930500
- M7 EQU 7 BINARY MASK '0111' @VA11353 01930600
- EJECT 01931000
- XPRTAB DSECT 01932000
- SPACE 01933000
- FULLAD DS 64D 01934000
- DBLAD DS 32D 01935000
- HALFAD DS 16D 01936000
- BYTEAD DS 8D 01937000
- COMMON DS 1F 01938000
- CXDAD DS 1F 01939000
- EJECT 01940000
- LDRST 01941000
- EPLIST HRC309DS 01941200
- * 01942000
- *********************************************************************** 01943000
- * 01944000
- * NUCLEUS CONSTANT AREA 01945000
- * 01946000
- *********************************************************************** 01947000
- * 01948000
- NUCON 01949000
- SVCSAVE 01950000
- END 01951000
ibm/vm370-lib/cms/dmsldr.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator