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