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