OLD TITLE 'DMSOLD (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * SUBROUTINE NAME: 00004000 * 00005000 * DMSOLD 00006000 * 00007000 * FUNCTION: 00008000 * 00009000 * TO INITIALIZE FOR AND TO PERFORM EACH LOADING OPERATION 00010000 * BY PROCESSING TEXT FILES WHICH MAY CONTAIN THE 00011000 * FOLLOWING CARDS: SLC, ICS, ESD, TXT, REP, RLD, END, 00012000 * LDT, LIBRARY, AND ENTRY. 00013000 * 00014000 * ATTRIBUTES: 00015000 * 00016000 * REENTRANT, DCSS/MODULE RESIDENT 00017000 * 00018000 * ENTRY POINTS: 00019000 * 00020000 * DMSOLD - ENTERED FROM DMSSLN WHEN LOAD REQUESTED 00021000 * DMSLDRC - ENTERED BY VARIOUS LOADER ROUTINES WHEN AN INVALID 00022000 * CARD IS DETECTED IN A TEXT FILE 00023000 * DMSLDRD - ENTERED WHEN A FATAL ERROR OCCURS DURING LOADING 00024000 * 00025000 * ENTRY CONDITIONS: 00026000 * 00027000 * DMSLDRB R1=PLIST, R14=RETURN ADDRESS, 00028000 * SAVES REGISTERS 9-12 00029000 * PLIST - CL8'LOAD' 00030000 * CL8'FILENAME1' 00031000 * . . . . 00032000 * CL8'FILENAMEN' 00033000 * CL8'(' 00034000 * CL8'OPTIONS' 00035000 * CL8'FFFFFFFF' 00036000 * 00037000 * OPTIONS - 00038000 * CL8'CLEAR' 00039000 * CL8'START' 00040000 * CL8'RESET', CL8'ENTRY NAME' 00041000 * CL8'INV' OR CL8'NOINV' 00042000 * CL8'REP' OR CL8'NOREP' 00043000 * CL8'MAP' OR CL8'NOMAP' 00044000 * CL8'ORIGIN', CL8'HEX LOCATION'|'TRANS' 00045000 * CL8'NOLIBE' OR CL8'LIBE' 00046000 * CL8'NOAUTO' OR CL8'AUTO' 00047000 * CL8'TYPE' OR CL8'NOTYPE' 00048000 * 00049000 * 00050000 * EXIT CONDITIONS: 00051000 * 00052000 * NORMAL - RETURN ON R14, LOADING COMPLETE . 00053000 * 00054000 * ERROR - ERROR MESSAGE TYPED, RETURN TO CALLER. 00055000 * 00056000 * CALLS TO OTHER ROUTINES: 00057000 * 00058000 * DMSLSBA - FROM VARIOUS ROUTINES FOR HEX TO BINARY CONVERSION 00059000 * DMSLSBC - FROM ICS ROUTINE TO DEFINE CSECT, FROM ESD 00060000 * TYPE 1 TO DEFINE ENTRY 00061000 * DMSLSY - FROM ESD PRIVATE CODE RTN. 00062000 * DMSLGTB - TO SETUP TEMPORARY TXTLIB DICTIONARIES. 00063000 * DMSLIO - FOR ERROR MESSAGES AND LOAD MAP PROCESSING 00064000 * DMSLIB - TO SEARCH TEXT LIBRARIES FOR UNDEFINED ENTRY NAMES 00065000 * DMSSLNDY - FROM ESD ROUTINE IF OS LINK OR LOAD WAS ISSUED 00066000 * DMSSCN - FROM CTLCRD1 TO A TEXT FILE CARD 00067000 * DMSSMNSB - TO INITIALIZE FREE STORAGE IF START. 00068000 * DMSBRD - TO READ TEXT FILES AND TXTLIBS. 00069000 * DMSFNS - TO CLOSE READING 00070000 * DMSLSBB - FROM RLD ROUTINE TO ADD TO UNDEFINED STRINGS 00071000 * DMSLSBD - TO PROCESS LOADER OPTIONS 00072000 * DMSLGTA - TO FREE TXTLIB DIRECTIONS 00073000 * DMSFREB - FOR FREE STORAGE 00074000 * 00075000 * REGISTER USAGE: 00076000 * 00077000 * R8,R9 BASE 00078000 * R13 - LDRST 00079000 * REST - WORK 00080000 * 00081000 * OPERATION: DMSOLD 00082000 * 00083000 * 1. ACQUIRE AND INITIALIZE A WORK AREA (LDRST). 00084000 * 00085000 * 2. CALL DMSLIO TO SET UP LOADER I/O OPERATIONS. 00086000 * 00087000 * 3. IF TXTLIB DIRECTORIES ARE NOT IN FREE STORAGE, 00088000 * CALL DMSLGTB TO BRING THEM IN. 00089000 * 00090000 * 4. CALL DMSLSBD TO PROCESS LOADER OPTION LIST. 00091000 * 00092000 * 5. PROCESS EACH TEXT FILE SEQUENTIALLY BY READING TEN 00093000 * CARDS AT A TIME, THEN ANALYZING EACH OF THE CARDS 00094000 * TO DETERMINE ITS TYPE. FOR EACH CARD, BRANCH TO 00095000 * THE APPROPRIATE ROUTINE. 00096000 * EACH ROUTINE WILL RETURN TO THIS READ 00097000 * ROUTINE FOR THE NEXT CARD. 00098000 * 00099000 * 6. AT END-OF-FILE ON LAST TEXT FILE OR UPON FINDING 00100000 * AN LDT CARD, BEGIN TXTLIB SEARCHING TO SATISFY ANY 00101000 * UNDEFINED REFERENCES (DMSLIB). FOR EACH MATCH 00102000 * DMSLIB WILL RETURN TO THE READ ROUTINE (IN STEP 5) 00103000 * TO CONTINUE LOADING. 00104000 * 00105000 * 7. WHEN NO MORE MATCHES CAN BE MADE, SAVE SPECIFIED 00106000 * STARTING ADDRESS, SAVE VALUE OF THE LOCATION 00107000 * COUNTER, AND LIST ANY UNDEFINED ENTRIES AT THE 00108000 * TERMINAL. 00109000 * 00110000 * 8. CLOSE TXTLIBS AND FREE THE WORK AREA 00111000 * 00112000 * 9. RETURN TO DMSSLN. 00113000 * 00114000 * NOTE: ANY CHANGES MADE TO THIS MODULE SHOULD 00115000 * ALSO BE CONSIDERED FOR DMSLDR. 00116000 *. 00117000 EJECT 00118000 DMSOLD START 0 @V305665 00119000 ENTRY DMSLDRC,DMSLDRD @V305665 00120000 EXTRN DMSLSBA,DMSLSBB,DMSLSBC @V305665 00121000 RELDR EQU * @V305665 00122000 BALR R8,0 @V305665 00123000 BCTR R8,0 @V305665 00124000 BCTR R8,0 @V305665 00125000 USING RELDR,R8,R9 @VA05785 00126000 LA R9,4095(0,R8) SET SECOND BASE REGISTER @VA05785 00127000 LA R9,1(,R9) @VA05785 00128000 LA 4,PERMIT SETUP TO TEST FOR PRINT CONTROL @V305665 00129000 EJECT 00130000 *********************************************************************** 00131000 * 00132000 * COMMON ROUTINE TO GET AND INITIALIZE THE LOADER 00133000 * WORK AREA AND TO SET UP LOADER I/O 00134000 * 00135000 *********************************************************************** 00136000 * 00137000 INIT LR 2,1 SAVE ADDRESS OF PARAM LIST 00138000 LR 3,14 AND ADDRESS OF RETURN LOCATION 00139000 LA 0,NEED GET FREE STORAGE 00140000 DMSFREE DWORDS=(0),TYPCALL=BALR 00141000 USING LDRST,R1 00142000 ST R13,REG13SAV PROTECT LDRST REGISTER 00143000 DROP R1 00144000 USING LDRST,R13 00145000 LR 13,1 SAVE ADDR. OF SAVE AREA IN REG. 00146000 ST 3,RETREG SAVE RETURN 00147000 LR R1,R2 @VA02828 00148000 LA R2,8(0,R2) GET TO FILENAMES 00149000 ST R2,PARMLIST 00150000 SRL R1,24 RESTORE CALL CODE @VA02828 00151000 STC R1,PARMLIST @VA02828 00152000 STM R9,R12,GPRSAV 00153000 MVC BRAD(4),STRTADDR MOVE IN STARTING ADDRESS 00154000 MVC TBLREF(4),ALDRTBLS MOVE IN TOP OF LOADER TBL ADDR 00155000 MVC TBLCT(2),TBENT MOVE IN NUMBER OF LOADER TABLE ENTRIES 00156000 MVC LOCCT(4),LOCCNT MOVE IN LOCATION COUNTER 00157000 XC MEMBOUND(4),MEMBOUND 00158000 XC LDRADDR+4(4),LDRADDR+4 CLEAR ERROR LOCATION 00159000 SR 5,5 GET ZERO 00160000 ST 5,FLAGS CLEAR LIBRARY FLAGS 00161000 STC R5,FLAG3 CLEAR ANOTHER FLAG AREA @VA01699 00162000 XC ENTADR,ENTADR CLEAR 'ENTRY' CARD POINTER 00163000 XC ESIDTB(256),ESIDTB CLEAR ESDID TABLE 00164000 XC ESIDTB+256(256),ESIDTB+256 CLEAR ESID TABLE @VA02083 00165000 XC PRVCNT(2),PRVCNT CLEARING FIELD @VA05785 00166000 NI LDRFLAGS,255-WORKFILE TURN RLD FLAG OFF NOW @VA10619 00166700 NI LDRFLAGS+1,255-NOAUTO-NOLIBE ALLOW RESOLUTION @VA10619X00167300 OF UNDEFINED NAMES 00167900 MVC FLAG1(2),LDRFLAGS MOVE IN FLAGS FROM NUCON 00168000 CLI UNRES,X'80' UNRESOLVED BIT ON? @VA02829 00169000 BNE AWAY NO, CONTINUE NORMALLY @VA02829 00170000 OI FLAGS,LUNDEF FORCE SEARCH FOR UNRESOLVED @VA02829 00171000 AWAY LA R5,LDRSET SET UP LOADER I/O @VA02829 00172000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00173000 LR R14,R4 SET RETURN REG 00174000 BR R11 GO SET I/O 00175000 EJECT 00176000 *********************************************************************** 00177000 * 00178000 * READ IN TEXT LIBRARY DIRECTORIES, PROCESS USER OPTIONS 00179000 * 00180000 *********************************************************************** 00181000 * 00182000 PERMIT L R5,TXTDIRC GET TXTLIB ANCHOR 00183000 LTR R5,R5 ARE TXTLIB DIRECTORIES IN STOR. 00184000 BNZ INIT1 YES, CONTINUE 00185000 STM R0,R15,APSV SAVE REGS 00186000 L R15,=V(DMSLGTB) GO READ THEM IN 00187000 BALR R14,R15 00188000 OI OSSFLAGS,OSRESET INDICATE CLEAN UP NEEDED 00189000 INIT1 EQU * 00190000 EJECT 00191000 SPACE 1 00192000 STM R0,R15,APSV SAVE REGISTERS 00193000 L R15,=V(DMSLSBD) GO PROCEES USER OPTIONS 00194000 BALR R14,R15 00195000 * WHEN A SYSTEM MODULE IN EITHER THE USER AREA OR THE TRANSIENT AREA 00195025 * IS TO BE REPLACED, THE ASSOCIATED PROTECTION FLAG MUST BE RESET. 00195050 CLC FREELOWE+1(3),LOCCT+1 LOADING ABOVE USER AREA? @VA12751 00195075 BNH TSTRESET YES, DON'T RESET FLAG @VA12751 00195100 CLC AUSRAREA+1(3),LOCCT+1 LOADING IN USER AREA? @VA11814 00195125 BH NOTUSER NO, CHECK FOR TRANSIENT @VA12751 00195250 NI PROTFLAG,X'FF'-PRFUSYS RESET SYSTEM FLAG @VA11814 00195375 B TSTRESET CONTINUE @VA11814 00195500 NOTUSER EQU * @VA12751 00195530 LA R6,X'01E0' LOAD REGISTER FOR TEST @VA12751 00195560 CLM R6,M2,LOCCT+1 ABOVE TRANSIENT AREA? @VA12751 00195590 BE TSTRESET DON'T RESET FLAG @VA12751 00195620 CLM R6,M1,LOCCT+2 IN LOW-CORE FREE STORAGE? @VA12751 00195650 BH TSTRESET YES, CONTINUE @VA12751 00195680 NI PROTFLAG,X'FF'-PRFTSYS RESET FLAG FOR TRANSIENT @VA11814 00195750 TSTRESET EQU * @VA11814 00195875 TM FLAGS,RESET WAS RESET 'ENTRY' SPECIFIED 00196000 BNO RDSET NO 00197000 NI FLAGS,255-RESET TEMPORARILY TURN OFF P3093 00198000 BAL R6,CTLENT1 YES, SET ENTRY NAME IN LDR TBL 00199000 OI FLAGS,RESET TURN BACK ON P3093 00200000 EJECT 00201000 *********************************************************************** 00202000 * 00203000 * INPUT READ ROUTINE 00204000 * 00205000 *********************************************************************** 00206000 * 00207000 RDSET MVC READBUF(44),RDISK SET PLIST TO READ CARDS 00208000 MVC FINIS(26),FDISK IMAGES FROM DISK 00209000 OI FLAG3,CMD PROCESSING COMMAND LINE @VA01699 00210000 LA 3,SPEC 00211000 ST R3,READBUF+28 BUFFER ADR TO READ PLIST 00212000 MVC SYSUT1(44),WORKSET SET WORK FILE PLIST 00213000 ST R3,SYSUT1+28 BUFFER ADDRESS TO PLIST 00214000 LA R1,SYSUT1 PLIST ADDRESS 00215000 L R15,AERASE ERASE OLD WORK FILE V0304 00216000 BALR R14,R15 V0304 00217000 BC 15,CHKLST GO READ IN FIRST PARAMETER 00218000 ERRDBF LA 5,12 WAS ERROR END OF FILE 00219000 CR 15,5 00220000 BC 8,FINISH YES - GO CLOSE OUT FILE 00221000 MVC OUTBUF(18),8(R1) MOVE NAME TO BUFFER 00222000 LA R5,RDERR62 SET CODE FOR READ ERROR MSG 00223000 B FATERR TERMINATE LOADING 00224000 * FILE NOT FOUND. IF DLYD IS ON, IT MEANS A LIBE ONLY SEARCH. 00225000 FINISH LA 1,FINIS CLOSE FILE 00226000 L R15,AFINIS V0304 00227000 BALR R14,R15 V0304 00228000 CHKLST L R3,PARMLIST UPDATE PARAMETER LIST POINTER 00229000 CLI 0(3),X'FF' IS THERE ANOTHER PARAMETER TR 00230000 BE LIBGO GO TO LIBE SERCH IN LDT 00231000 CLI 0(R3),C'(' END OF FNAMES @VA00857 00232000 BE LIBGO YES @VA00857 00233000 MVC READBUF+8(8),0(R3) GET NEXT FILE FROM DISK 00234000 MVC FINIS+8(8),0(3) 00235000 HALF8 LA R3,8(R3,R0) UPDATE PLIST POINTER 00236000 ST R3,PARMLIST SAVE IT 00237000 LA R1,READBUF CHECK FOR FILE 00238000 L R15,ASTATE 00239000 BALR R14,R15 00240000 LA R3,SPEC RESTORE BUFFER ADDRESS 00241000 ST R3,READBUF+28 00242000 BZ NXTRD FOUND IT OK 00243000 CH R15,=H'28' WAS IT FILE NOT FOUND 00244000 BE NTFND YES 00245000 ST R15,LDRADDR+4 SAVE STATE ERROR CODE @VA02822 00246000 B N03 TERMINATE LOADING 00247000 NXTRD LA 1,SPEC PTR TO BUFFER AREA 00248000 ST 1,CRDPTR SAVE IT 00249000 LA R1,READBUF READ 10 CARDS 00250000 L R15,ARDBUF V0304 00251000 BALR R14,R15 V0304 00252000 BNZ ERRDBF BRANCH IF ERROR V0304 00253000 B RDCONT PROCEED 00254000 NTFND EQU * @V1D1705 00255000 LA R1,READBUF+8 SET NAME OF LIBE ENTRY NEEDED 00256000 LA 2,LIB4FND SET NOT FOUND ADDRESS 00257000 BAL 3,SERCH1 SEARCH LOADER TABLE 00258000 TM OSSFLAGS,DYLD DYNAMIC LOAD @V1D1705 00259000 BNO CKUND CHECK COMMD LINE PROC @VA01699 00260000 MVC BRAD+1(3),13(R12) SET ENTRY ADDRESS FOR DMSSL@V1D1705 00261000 CKUND TM REFLG1(R12),REFUND IF TXTLIB GLOBALED BETWEEN @VA01699 00262000 BZ CKLIB LOAD AND INCLUDE, MAY MISS @VA01699 00263000 B SETUND SEARCHING FOR UNDEFINEDS. @VA01699 00264000 LIB4FND EQU * 00265000 OI 8(12),X'80' MAKE UNDEFINED, FORCE LIBE SEARCH 00266000 SETUND OI FLAGS,LUNDEF AT LEAST 1 UNDEFINED @VA01699 00267000 CKLIB TM FLAG3,CMD IF PROCESSING COMMAND LINE @VA01699 00268000 BZ SKPOBLIG NAME, OVERRIDE LIBRARY @VA01699 00269000 OI REFLG2(R12),REFCMD CARD 'NO SEARCH' OPTION @VA01699 00270000 NI REFLG1(R12),X'FF'-REFLIB RESET 'LIBE-SUPPRESS' @VA01699 00271000 SKPOBLIG DS 0H @VA01699 00272000 B CHKLST PROCESS NEXT FILE 00273000 RD L 1,CRDPTR GET CURRENT CARD PTR 00274000 LA 1,80(0,1) ADVANCE PTR 00275000 LA R3,SPEC GET END OF DATA READ @VA01419 00276000 A R3,NUMBYTE BY ADDING BYTES READ @VA01419 00277000 CR 1,3 END OF CARD BUFF REACHED? 00278000 BL GO STILL SOME LEFT IN BUFFER @VA01419 00279000 CLC NUMBYTE,SETBYTE ARE WE AT END OF BUFFER ? @VA01419 00280000 BE NXTRD YES, READ SOME MORE @VA01419 00281000 B FINISH ELSE ALL DONE @VA01419 00282000 GO ST R1,CRDPTR SAVE NEW RECORD POINTER @VA01419 00283000 MVC SPEC(80),0(1) MOVE NEW CARD INTO SPEC 00284000 RDCONT SR 6,6 ZERO 6 00285000 LA 11,1 REGISTER 11 ALWAYS SET TO 1 00286000 L 1,SPEC 00287000 EJECT 00288000 * 00289000 *********************************************************************** 00290000 * 00291000 * SET LOCATION COUNTER ROUTINE (SLC) 00292000 * THIS ROUTINE HAS TWO ENTRIES 00293000 * (1) AT THE BEGINNING WHEN RESUME FALLLS THRU 00294000 * (2) ORG2- USED TO OBTAIN THE CURRENT ADDRESS OF A GIVEN 00295000 * SYMBOLIC LOCATION. 00296000 * THIS ROUTINE SETS THE LOCATION COUNTER TO THE SLC- 00297000 * CARD SPECIFIED ADDRESS AND/OR OBTAINS THE CURRENT 00298000 * ADDRESS OF A GIVEN SYMBOLIC LOC. FROM THE REFTBL TABLE. 00299000 * NOTE THAT IF NO ABS LOC IS PUNCHED AND THE SYMBOLIC NAME 00300000 * IS AS YET UNDEFINED, AN ERROR IS CREATED. 00301000 * 00302000 *********************************************************************** 00303000 * 00304000 C 1,SLC 00305000 BC 7,C2AE1 00306000 CLI SPEC+6,C' ' CMP ADDR FOR BLANKS 00307000 BC 7,C2AD BR- ADDR IN CRD 00308000 OI FLAGS,NOSLCADR NO ADDR, TURN ON SWITCH 00309000 BC 15,C2A 00310000 C2AD LA 4,6(0,0) CONVERT ADDR TO BINARY 00311000 LA 5,SPEC+6 00312000 L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00313000 BALR 0,1 BR TO HEXB ROUTINE 00314000 LTR R2,R2 BAD CONVERSION? @VA02089 00315000 BM BADCRD YES, BRANCH TO ERROR @VA02089 00316000 LR 6,0 SAVE ADDR IN REGISTER 00317000 C2A CLI SPEC+16,C' ' TEST IMAGE FOR NAME 00318000 * SYMBOL IS LEFT ADJUSTED 00319000 BC 7,C2AE3 BR- NAME IN CRD 00320000 TM FLAGS,NOSLCADR CHECK FOR ADR IN CARD 00321000 BO BADCRD PRINT INVALID CARD 00322000 SR 0,0 00323000 C2B NI FLAGS,255-NOSLCADR RESET SWITCH 00324000 AR 6,0 ADD CONVERTED ADDR TO ORG2 00325000 ST 6,LOCCT SET THE LOCATION COUNTER 00326000 BC 15,RD RETURN TO READ A CARD 00327000 C2AE3 LA 2,ERRSLC 00328000 BAL 3,SERCH 00329000 LA 14,C2B LINK AGE 00330000 L R0,12(0,R12) GET ABSOLUTE ADDRESS 00331000 BCR 15,14 00332000 ERRSLC LH 3,TBLCT 00333000 SR 3,11 00334000 STH 3,TBLCT 00335000 LA 5,ERRORU 00336000 LA 14,RD 00337000 MVC OUTBUF(8),0(12) MOVE NAME TO BUFF 00338000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00339000 BR 11 GO PRINT 00340000 EJECT 00341000 *********************************************************************** 00342000 * 00343000 * INCLUDE CONTROL SECTION 00344000 * ROUTINE (ICS) 00345000 * 00346000 *********************************************************************** 00347000 * 00348000 C2AE1 C 1,ICS 00349000 BC 7,C3AA1 BR NO 00350000 CLI SPEC+24,C' ' TEST FOR HEX ADDR 00351000 BE BADCRD INVALID CARD 00352000 LA 4,4 00353000 LA 5,SPEC+24 TO BINARY 00354000 L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00355000 BALR 0,1 BR TO HEXB 00356000 LTR R2,R2 BAD CONVERSION? @VA02089 00357000 BM BADCRD YES, BRANCH TO ERROR @VA02089 00358000 LR 6,0 SAVE LENGTH IN REG 00359000 LA 14,RD LOAD LINKAGE TO BRANCH TO RD WH 00360000 LA 3,SYMDEF IF NAME IN REFTBL, IS IT DEFINE 00361000 BAL 2,SERCH 00362000 SAVELNTH EQU * RETURN HERE FROM SEARCH IF NAME NOT FOUND @VA12730 00362100 STCM R6,M7,REFADDR(R12) SAVE CS LENGTH IN REFTBL @VA12730 00362200 CLI SPEC+15,COMMA REQUEST FOR NEW CSECT? @VA12730 00362300 BE CSECTDEF YES, SET CSECT FLAG @VA12730 00362400 OI REFLG2(R12),REFICS ICS CARD WAITING FOR MATCH @VA12730 00362500 BR R14 READ NEXT RECORD @VA12730 00362600 CSECTDEF EQU * @VA12730 00362700 OI REFLG2(R12),REFCSD IDENTIFY CSECT ENTRY @VA12730 00362800 * ENTERED C2AJ1 FROM ESD00 ROUTINE 00363000 C2AJ1 L 1,LOCCT LOD PRESENT LOCATION 00364000 LA 1,7(0,1) ALIGN TO DBL WRD BOUND 00365000 N 1,DBLBND ... 00366000 ST 1,LOCCT ... 00367000 LR 7,14 TEST FOR UNDEFINED BIT 00368000 L 5,AADDEF AND DEFINE IF NECESSARY 00369000 BALR 14,5 00370000 ST R1,12(0,R12) STORE VALUE OF LOCCT IN REFTBL 00371000 AR 1,6 UPDATE LOCCT 00372000 ST 1,LOCCT 00373000 SR 5,5 IO INDEX FOR ENTRY PRINT 00374000 ST R5,8(0,R12) CLEAR FLAG BYTE OF REFTBL 00375000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00376000 BALR 14,11 GO PRINT NAME 'AT' LOC 00377000 LR 14,7 00378000 SR 6,6 00379000 BCR 15,14 RETURNS TO RD OR C3AD4 (IN ESD 00380000 SYMDEF EQU * NAME FOUND IN LOADER TABLE @VA12730 00380500 CLI SPEC+15,COMMA NEW CSECT FOR INSERTION? @VA12730 00381000 BE BADICS ERROR; MATCHING NAME IN TABLE @VA12730 00381500 TM 8(R12),X'80' IS SYMBOL UNDEFINED? @VA12730 00382000 BO SAVELNTH YES, FLAG ICS REQUEST @VA12730 00382500 TM REFLG2(R12),REFICS IS ICS FOR SAME CSECT? @VA12730 00383000 BO SAVELNTH GET UPDATED LENGTH @VA12730 00383500 B BADICS NAME DEFINED; INVALID ICS CARD @VA12730 00384000 EJECT 00385000 *********************************************************************** 00386000 * 00387000 * DETERMINE IF ESD TYPE CARD 00388000 * 00389000 *********************************************************************** 00390000 * 00391000 C3AA1 C 1,ESD 00392000 BC 7,C4AA1 NO- TEST FOR TXT CRD 00393000 SPACE 1 00394000 CA3A1 CLI SPEC+24,X'0A' WEAK EXTRN ? 00395000 BE WEAKEXT YES 00396000 NI SPEC+24,X'07' MASK ESD TYPE BYTE 00397000 CLI SPEC+24,X'04' IS THIS A PC 00398000 BE PC YES 00399000 CA3A11 EQU * 00400000 LH 12,SPEC+24 GET ESD NO 00401000 SRL 12,8 (ISOLATE IT) JS 00402000 AR 12,12 DOUBLE ESD NO. FOR JUMP-TBL, JS 00403000 LH 12,ESDANAL(12) GET TBL ADDR FOR BRANCH 00404000 LA R15,RELDR 00405000 B 0(12,15) BRANCH TO APPROPRIATE ROUTINE 00406000 EJECT 00407000 *********************************************************************** 00408000 * 00409000 * ESD TYPE 1 ROUTINE (ENTRY) 00410000 * 00411000 *********************************************************************** 00412000 * 00413000 ENTESD SR R3,R3 CLEAR R3 00414000 IC R3,SPEC+31 GET ID OF SECTION DEFINITION 00415000 BAL 14,REFADR OBTAINS ADDR OF THE ENTRY IN RE 00416000 LA R10,ESD00 SET PROCESS TO ESD00 00417000 LATESD L R7,8(0,R12) LOAD RELOCATION FACTOR OF CSECT 00418000 LA R7,0(0,R7) CLEAR FLAG BYTE 00419000 STC 6,SPEC+24 (IF CSECT NOT DEFINED, BRANCH HERE) 00420000 A 7,SPEC+24 FORM ENTRY POINT 00421000 LA R7,0(0,R7) CLEAR HI BYTE P0966 00422000 LA 2,C3AD1 NOT FOUND RETURN 00423000 BAL 3,SERCH SEARCH FOR NAME IN REFTBL 00424000 L R0,12(0,R12) LOAD ABSOLUTE ADDRESS 00425000 TM 8(12),X'80' IS ENTRY DEFINED 00426000 BC 1,C3AD2 NO - DEFINE IT 00427000 TM FLAG1,NODUP IS MSG TO ISSUED ? @VM08875 00428000 BO ESD1OK NO, BRANCH @VM08875 00429000 MVC OUTBUF(8),0(12) MOVE NAME TO BUFF 00430000 LA 5,ERRORM ERROR 202W 00431000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00432000 BALR 14,11 GO PRINT MESS AND NAME 00433000 ESD1OK BR R10 GO TO ESD00 OR SDDEF RTN @VM08875 00434000 C3AD2 LR 1,7 LOAD REG 1 FROM 7 00435000 L 5,AADDEF 00436000 BALR 14,5 00437000 ST R1,12(0,R12) UPDATE REFTBL, STORE ABS. ADDRESS 00438000 BC 15,PRNT 00439000 C3AD1 ST R7,12(0,R12) STORE ABS. ADDR. IN REFTBL 00440000 PRNT SR 5,5 IO INDEX FOR ENTRY PRINT 00441000 ST R5,8(0,R12) CLEAR FLAG BYTE OF REFTBL 00442000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00443000 BALR 14,11 GO PRINT NAME 'AT' LOC 00444000 BR R10 GO TO ESD00 OR SDDEF RTN 00445000 EJECT 00446000 *********************************************************************** 00447000 * 00448000 * ESD TYPE 0 + 4 ROUTINE (SEGMENT NAME + PRIVATE CODE) 00449000 * 00450000 *********************************************************************** 00451000 * 00452000 C3AA3 EQU * @V1D1705 00453000 LR R11,R8 INSURE NON-ZERO R11 @VA04910 00454000 TM FLAGS,ESD1ST IS FIRST ESDID SET YET? @VA04910 00455000 BO C3AA3A BRANCH IF YES @VA04910 00456000 SR R11,R11 INDICATE FIRST ESDID @VA04910 00457000 C3AA3A EQU * @VA04910 00458000 BAL R3,ESIDINC CHECK AND UPDATE ESDID NO. 00459000 LA 2,C3AC3 NAME NOT IN TBL RETURN 00460000 BAL 3,SERCH SEARCH FOR NAME IN REFTBL 00461000 CLI SPEC+24,PCTYPE IS THIS PC CODE? @VA04910 00462000 BNE CHKCOM BRANCH IF NOT @VA04910 00463000 LTR R11,R11 WAS ESDID NUMBER UPDATED? @VA04910 00464000 BNZ DECESID BRANCH IF YES @VA04910 00465000 NI FLAGS,255-ESD1ST REMOVE ESD PROCESSED BIT @VA04910 00466000 B PC GO TRY AGAIN @VA04910 00467000 DECESID EQU * @VA04910 00468000 LH R2,SPEC+14 GET ESDID NUMBER @VA04910 00469000 BCTR R2,0 DECREMENT BY ONE @VA04910 00470000 STH R2,SPEC+14 AND SAVE IT(KEEP ORIG.NO.) @VA04910 00471000 B PC GET ANOTHER NUMBER @VA04910 00472000 CHKCOM EQU * @VA04910 00473000 CLI 8(12),X'82' WAS THIS NAME DEFINED AS COMMON @VA09317 00474000 BE COMFIX2 YES IT WAS @VA09317 00475000 TM REFLG2(R12),REFICS UNMATCHED ICS ENTRY? @VA12730 00475060 BZ TSTUNDEF OTHERWISE UNDEFINED OR DUPLICATE @VA12730 00475120 NI REFLG2(R12),255-REFICS RESET UNMATCHED FLAG @VA12730 00475180 CLC SPEC+28(4),BLANKS LENGTH FIELD IN END CARD? @VA12730 00475240 BE BADICS CANNOT HANDLE ICS REQUEST @VA12730 00475300 ICM R6,M7,REFADDR(R12) LOAD NEW LENGTH FOR CSECT @VA12730 00475360 MVC REFADDR(3,R12),ZEROES CLEAR REFTBL FIELD @VA12730 00475420 LA R14,C3AD4 SET LINKAGE @VA12730 00475480 B CSECTDEF GO TO DEFINITION ROUTINE @VA12730 00475540 BADICS EQU * @VA12730 00475600 LA R14,N03 SET RETURN ADDRESS FOR LIO @VA12730 00475660 LA R5,ERRORB SET ERROR FUNCTION FOR LIO @VA12730 00475720 L R11,ADMSLIO TYPE MESSAGE, SET RETURN CODE, @VA12730 00475780 BR R11 AND EXIT @VA12730 00475840 TSTUNDEF EQU * @VA12730 00475900 TM 8(12),X'80' IS ENTRY DEFINED 00476000 BC 7,C3AC3 NO - GET STARTING LOCATION 00477000 TM FLAG1,NODUP IS MSG TO BE ISSUED ? @VM08875 00478000 BO ESD0OK NO, BRANCH @VM08875 00479000 LA 5,ERRORM ERROR 202W 00480000 MVC OUTBUF(8),0(12) MOVE NAME TO BUFF 00481000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00482000 BALR 14,11 GO PRINT MESSAGE AND NAME 00483000 ESD0OK LH R2,SPEC+14 GET ESID TABLE POSITION @VM08875 00484000 AR R2,R2 TIMES TWO 00485000 O R4,ESIDDUPF SET DUPLICATE SD FLAG 00486000 STH 4,ESIDTB(2) STORE POINTER IN ESID TABLE 00487000 B ESD00 GET NEXT CARD 00488000 C3AD4 L R0,12(0,R12) GET ABS. ADDR. TO COMPUTE REL. FACTOR 00489000 LH 2,SPEC+14 LOD ESID 00490000 AR R2,R2 TIMES TWO 00491000 SR R5,R5 CLEAR R5 00492000 IC R5,ESIDTB(R2) SAVE FLAG FIELD 00493000 SRL R5,4 ISOLATE 4 FLAG BITS V0308 00494000 SLL R5,12 V0308 00495000 OR R4,R5 00496000 O R4,ESIDSDF SET SD FLAG 00497000 STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 00498000 STC 6,SPEC+24 LOD ASSEMBLED ADDR 00499000 L 2,SPEC+24 00500000 CR 0,2 00501000 BC 5,COMP BR- ORG2 LESS THAN ADDR 00502000 SR 0,2 00503000 RELF STCM R0,B'0111',9(R12) SAVE RELOCATION FACTOR P0966 00504000 LH R2,SPEC+14 GET ESID OF SD 00505000 AR R2,R2 DOUBLE FOR ESIDTB INDEX 00506000 LA R5,ESIDTB(R2) POINT TO ID TABLE ENTRY 00507000 TM 0(R5),ESIDLATE ANY WAITING LD'S 00508000 BO SDDEF YES, RESOLVE THEM 00509000 BC 15,ESD00 READ ANOTHER CARD 00510000 COMP SR 2,0 ADDRESS MINUS ORIGIN 00511000 LCR 0,2 COMPLEMENT (TWOS) 00512000 OI REFLG2(R12),REFNEG NEGATIVE RELOCATION FACTOR @VA12730 00513000 BC 15,RELF 00514000 C3AC3 EQU * @VA12730 00514600 OI REFLG2(R12),REFCSD INDICATE CSECT @VA12730 00515200 STC 6,SPEC+28 RETURNED HERE FOR NAME NOT FND 00516000 L 6,SPEC+28 LOD SEGMENT LENGTH 00517000 LA 14,C3AD4 00518000 BC 15,C2AJ1 CK ADDR 00519000 SPACE 4 00520000 ESIDINC LH R2,SPEC+14 GET ESDID NUMBER 00521000 CH R2,=X'00FF' COMPARE WITH 255 00522000 BH ESDTBOVR ERROR IF > 255 00523000 TM FLAGS,ESD1ST IS THIS 1ST ESDID ON CARD 00524000 BZ FSTESD YES, DON'T INCREMENT 00525000 LA 2,1(0,2) ADD 1 00526000 STH 2,SPEC+14 INSERT AS NEW ESID NO 00527000 FSTESD OI FLAGS,ESD1ST INDICATE FIRST ESD PROCESSED THIS CARD 00528000 BR 3 RETURN TO CALLER 00529000 COMFIX2 MVI 8(12),X'80' CHANGE IT TO REAL CSECT 00530000 L 6,8(,12) GET LENGHTH UP UNTIL NOW 00531000 LA 6,0(,6) CLEAR HIGH ORDER BYTE 00532000 MVI SPEC+28,0 00533000 C 6,SPEC+28 WAS PREV LENGTH GTR THAN CSECT 00534000 BNL COMFIX3 BR YES 00535000 L 6,SPEC+28 NO USE THIS LENGTH 00536000 COMFIX3 ST 6,SPEC+28 00537000 LA 14,C3AD4 GO TO ICS 00538000 BC 15,C2AJ1 00539000 ESDTBOVR LA R5,ESDOVER 00540000 B FATERR TERMINATE 00541000 EJECT 00542000 *********************************************************************** 00543000 * 00544000 * ESD TYPE 2 ROUTINE (EXTRN) 00545000 * THIS ROUTINE HAS TWO ENTRY POINTS. LOC C3AH1 AND LOC ESD00 00546000 * LOCATION C3AH1 IS ENTERED FROM THE ESD CARD ANALYSIS ROUTINE 00547000 * LOCATION ESD00 IS ENTERED FROM... 00548000 * 1. THE ESD CARD ANALYSIS ROUTINE WHEN THE CARD BEING 00549000 * PROCESSED IS A TYPE 1OR 2 , AND AN ABS LOAD IS INDICATED 00550000 * 2. THE ESD TYPE 0 ROUTINE AND TYPE 1 ENTER AS THE LAST 00551000 * STEP OF THESE ROUTINES 00552000 *********************************************************************** 00553000 * 00554000 C3AH1 BAL 3,ESIDINC GO CHECK + UPDATE ESID NO 00555000 LA R2,C3AH2 NOT FOUND RETURN 00556000 BAL R3,SERCH LOOK FOR NAME IN REFTBL 00557000 CLI 8(R12),X'83' WEAK EXTRN REFERENCE P3093 00558000 BNE COM01 NO P3093 00559000 L R2,12(,R12) GET RELOCATION FACTOR @VM08899 00560000 ST R2,TEMPST SAVE FOR A WHILE @VM08899 00561000 XC 0(20,R12),0(R12) ZERO OUT WXTRN ENTRY @VM08899 00562000 BAL R2,SERCH GO PROMOTE ENTRY IN LDRTBLS @VM08899 00563000 L R2,TEMPST GET RELOCATION FACTOR @VM08899 00564000 ST R2,12(,R12) STORE IN NEW LOCATION @VM08899 00565000 OI 8(R12),X'80' TURN UNDEFINED BIT ON @VM08899 00566000 OI FLAGS,LUNDEF SHOW UNDEF TO LIBE @VM08899 00567000 COM01 LH R2,SPEC+14 GET ESID NUMBER 00568000 SLL 2,1 TIMES TWO 00569000 STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 00570000 ESD00 LA 2,16 TEST FOR MULTIPLE ENTRIES IN CA 00571000 LH 1,SPEC+10 00572000 SR 1,2 00573000 BC 3,C3AH5 00574000 NI FLAGS,255-ESD1ST RESET FIRST ESD FLAG 00575000 B RD NEXT CARD @V1D1705 00576000 C3AH5 MVC SPEC+16(32),SPEC+32 00577000 STH 1,SPEC+10 00578000 BC 15,CA3A1 00579000 C3AH2 OI 8(12),X'80' PLACE UNDEFINED BIT ON 00580000 OI FLAGS,LUNDEF SHOW UNDEFS TO LIBE 00581000 SR 3,3 CLEAR REGISTER 3 00582000 ST 3,12(,12) STORE ZERO IN RELOCATION FACTOR 00583000 B COM01 FINISH 00584000 EJECT 00585000 ********************************************************************** 00586000 * 00587000 * ESD TYPE A (WEAK EXTRN) 00588000 * 00589000 ********************************************************************** 00590000 SPACE 00591000 WEAKEXT BAL R3,ESIDINC CHECK ESID 00592000 LA R2,WEAKEXT1 NOT FOUND RETURN 00593000 BAL R3,SERCH LOOK FOR NAME IN REFTBL 00594000 B COM01 FINISH 00595000 WEAKEXT1 OI 8(R12),WKEXT INDICATE WEAK EXTRN 00596000 B C3AH2 FINISH 00597000 EJECT 00598000 *********************************************************************** 00599000 * 00600000 * ESD 5 + 6 ROUTINE (COMMON + PSEUDO REGISTER ) 00601000 * 00602000 *********************************************************************** 00603000 SPACE 1 00604000 COMESD BAL 3,ESIDINC GO CHECK + UPDATE ESID NO 00605000 LA 2,COM03 00606000 BAL 3,SERCH 00607000 TM REFLG2(R12),REFICS ICS FLAG SET ON? @VA12730 00607300 BO BADICS INVALID MATCH @VA12730 00607600 TM 8(12),X'80' 00608000 BZ COM01 00609000 CLI 8(R12),X'82' PREVIOUSLY DEFINED AS COMMON @V201005 00610000 BNER R2 TO 'COM04' - SKIP LENGTH CK @VA01759 00611000 CLC 9(3,12),SPEC+29 GET LONGEST COMMON 00612000 BNL COM04 KEEP OLD LENGTH 00613000 COM03 MVC 9(3,12),SPEC+29 MOVE CURRENT LENGTH 00614000 COM04 MVI 8(R12),X'82' DEFINE AS COMMON @V201005 00615000 OI FLAG1,COMMONEX INDICATE COMMON EXISTS 00616000 B COM01 TR 00617000 EJECT 00618000 * HANDLE PR (PSEDUO-REGISTER) 00619000 PRVESD BAL R3,ESIDINC CHECK AND UPDATE ESID NUMBER @V1D1705 00620000 CLI SPEC+28,C' ' BLANK ALIGNMENT FACTOR @V201005 00621000 BNE NONBLANK NO @V201005 00622000 MVI SPEC+28,X'03' REPLACE WITH WORD ALIGN @V201005 00623000 NONBLANK LA R2,DEFENTRY IN CASE NOT FOUND @V201005 00624000 BAL 3,PRSERCH LOOK FOR ENTRY IN REFTBL 00625000 TM REFLG2(R12),REFICS ICS FLAG SET ON? @VA12730 00625300 BO BADICS INVALID MATCH @VA12730 00625600 LH 2,SPEC+14 GET ESDID NO. 00626000 SLL 2,1 TIMES TWO 00627000 STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 00628000 CLC 9(3,12),SPEC+29 OLD LENGTH GREATER THAN NEW 00629000 BNL ALTST YES, CHECK ALIGNMENT 00630000 MVC 9(3,12),SPEC+29 NO, KEEP GREATER LENGTH 00631000 ALTST TR SPEC+28(1),PRTRAN ENCODE ALIGNMENT BYTE @V201005 00632000 CLC 8(1,12),SPEC+28 IS NEW AL MORE RESTRICTIVE 00633000 BNL ESD00 NO, LOOK FOR MORE ESD'S 00634000 LA 5,PRERR GET MESS # FOR PR ERR 00635000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00636000 BALR 14,11 ... 00637000 B ESD00 BACK FOR MORE ESD'S 00638000 DEFENTRY LH 2,SPEC+14 GET ESDID NO 00639000 SLL 2,1 TIMES TWO 00640000 STH 4,ESIDTB(2) PUT INDEX IN ESID TABLE 00641000 MVC 8(4,12),SPEC+28 PUT LENGTH AND ALIGN IN ENTRY 00642000 OI FLAG1,PREXIST INDICATE PR EXISTS 00643000 SR 2,2 GET A ZERO 00644000 IC 2,SPEC+28 GET FLAG BYTE 00645000 LCR 4,2 AND ITS COMPLEMENT 00646000 BCTR 4,0 ... 00647000 AH R2,PRVCNT ALIGN PR DISPLACEMENT 00648000 NR 2,4 ... 00649000 ST 2,12(0,12) STORE IN REFTBL 00650000 AH 2,10(0,12) ADD LENGTH 00651000 STH R2,PRVCNT AND STORE AS NEW COUNT 00652000 TR 8(1,12),PRTRAN CODE ALIGN BYTE 00653000 B ESD00 BACK FOR MORE ESD'S 00654000 EJECT 00655000 ****************************************************************** 00656000 * 00657000 * ESD 04 PRIVATE CODE 00658000 * 00659000 ****************************************************************** 00660000 * 00661000 PC EQU * @V1D1705 00662000 L R15,=V(DMSLSY) CREATE A UNIQUE SYMBOL 00663000 BALR R14,R15 00664000 MVC SPEC+16(8),NXTSYM MOVE SYMBOL TO ESD NAME FIELD 00665000 MVI SPEC+16,C'.' 00666000 B CA3A11 00667000 EJECT 00668000 *********************************************************************** 00669000 * 00670000 * TEXT CARD ROUTINE (TXT) 00671000 * 00672000 *********************************************************************** 00673000 * 00674000 C4AA1 C 1,TXT 00675000 BC 7,C4AA3 BR- NOT TEXT CRD 00676000 STC 6,SPEC+4 00677000 LH 7,SPEC+10 NUM OF BYTES 00678000 LTR 7,7 00679000 BC 8,RD ZERO COUNT - DON'T NOVE ANY DAT 00680000 LA R15,C4AK2+2 LINKAGE 00681000 REPENT LH R3,SPEC+14 GET ESDID TO FIND ADDRESS @V1D1705 00682000 LTR R3,R3 IS ESD ID VALID? @VA09103 00682300 BNP BADCRD NO, THROW IT OUT @VA09103 00682600 SLL 3,1 CHECK ESID TABLE 00683000 LH 12,ESIDTB(3) ... 00684000 LTR 12,12 IS IT NEGATIVE ENTRY (ALREADY LOADED) 00685000 BM RD YES, SKIP IT 00686000 SRL 3,1 NO, RESET CONDITIONS AND CONTINUE 00687000 BAL 14,REFADR 00688000 L R10,8(0,R12) LOAD RELOCATION FACTOR 00689000 C4AC2 A 10,SPEC+4 ADD ADDR TO RELFAC 00690000 LA R10,0(0,R10) CLEAR HI BYTE P0966 00691000 ST 10,SPEC+4 00692000 LR 1,10 00693000 AR 1,7 00694000 LA R5,ERRORC ERROR 709S 00695000 TM BATFLAGS,BATLOAD BATCH BEING LOADED? V0742 00696000 BO C4AJ2 YES: ALLOW FREE STORAGE LOAD V0742 00697000 TM MODFLGS,SYSLOAD SYSTEM LOAD ? @VA04666 00698000 BO C4AJ2 YES, ALLOW FREE STORAGE LOAD @VA04666 00699000 TM OSSFLAGS,DYLD OS TYPE LOAD ? @V1D1705 00700000 BNO NONDYNA BR IF NOT @V1D1705 00701000 C R1,DYNAEND CHECK AGAINST GETMAINED AREA @V1D1705 00702000 BC 11,FATERR ERROR IF TOO HIGH @V1D1705 00703000 B NONDY2 @V1D1705 00704000 NONDYNA EQU * @V1D1705 00705000 C R1,FREELOWE WOULD WE OVERLAY FREE STOR 00706000 BC 11,FATERR YES - ERROR 00707000 NONDY2 EQU * @V1D1705 00708000 C R10,AUSRAREA ARE WE BELOW USER STOR ? 00709000 BNL C4AJ2 BNL IF NO PROBLEM. JS 00710000 C R1,ALAST ABOVE TRANS AREA? @V305665 00711000 BH FATERR YES, OVERLAY ERROR @VA02752 00712000 C R1,ADTRANS BELOW TRANSIENT AREA? @V305665 00713000 BL FATERR YES, OVERLAY ERROR 00714000 C4AJ2 TM FLAG1,FSTXTADR HAS 1ST TEXT ADDRESS BEEN SAVED ? 00715000 BO C4AK2 YES DON'T SAVE 00716000 OI FLAG1,FSTXTADR INDICATE TEXT ADR SAVED 00717000 ST 10,BRAD SAVE FIRST ADDR LOADED INTO 00718000 C4AK2 BCR 15,R15 LINKAGE 00719000 SR 7,11 SUB ONE FROM NUM OF BYTES 00720000 EX 7,CHAR MOVE TEXT TO STORAGE 00721000 BC 15,RD AND GO READ A CARD 00722000 * 00723000 CHAR MVC 0(1,10),SPEC+16 00724000 EJECT 00725000 *********************************************************************** 00726000 * 00727000 * REPLACE CARD ROUTINE (REP) 00728000 * 00729000 *********************************************************************** 00730000 * 00731000 C4AA3 C 1,REP 00732000 BC 7,C5AA1 BR- NOT REPLACE CARD 00733000 TM FLAG2,NOREP IS REP CARD PRINTING SUPPRESSED 00734000 BC 1,C4AA4 YES 00735000 LA 5,CRDIMJ GO PRINT OUT REP CARD IMAGE 00736000 MVC OUTBUF(79),SPEC+1 MOVE CRD IMAJE TO BUFF 00737000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 00738000 BALR 14,11 GO PRINT REP CARD 00739000 C4AA4 LA 4,6 CONVERT REP CRD HEX ADDR TO BIN 00740000 LA 5,SPEC+6 00741000 L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00742000 BALR 0,1 BR TO HEXB 00743000 LTR R2,R2 BAD CONVERSION? @VA02089 00744000 BM BADCRD YES, BRANCH TO ERROR @VA02089 00745000 ST 0,SPEC+4 SAVE ADDR IN CARD IMAGE 00746000 LA 4,2(0,0) 00747000 LA 5,SPEC+14 CONVERT REP ESID TO BIN 00748000 L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00749000 BALR 0,1 BR TO HEXB 00750000 STH 0,SPEC+14 SAVE THE ESID IN CARD IMAGE 00751000 LA 5,SPEC+16 00752000 NUM LA 7,2 NUM OF BYTES 00753000 ST 5,TMPLOC 00754000 TM FLAG2,APRILB 00755000 BC 1,APR10 00756000 BAL R15,REPENT CK ADDR 00757000 APRIL LA 4,4 CONVERT HALF WORD OF CORRECTION 00758000 L 5,TMPLOC 00759000 L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00760000 BALR 0,1 BR TO HEXB 00761000 L R1,SPEC+4 LOD REPLACE ADDR 00762000 STH 0,0(0,R1) PLACE CORRECTION IN STORAGE 00763000 NI FLAG2,255-APRILB 00764000 CLI 0(5),C',' 00765000 BC 7,RD 00766000 OI FLAG2,APRILB 00767000 LA R1,2(R1,0) 00768000 ST R1,SPEC+4 SAVE REPLACE ADDR 00769000 AR 5,11 00770000 BC 15,NUM 00771000 APR10 LA R15,APRIL 00772000 SR R10,R10 ZERO RELOCATION FACTOR @V1D1705 00773000 B C4AC2 @V1D1705 00774000 EJECT 00775000 *********************************************************************** 00776000 * 00777000 * RELOCATION DICTIONARY CARD (RLD) 00778000 * REG 6= 0 UPON ENTRY INTO C5AA1 00779000 * 00780000 *********************************************************************** 00781000 SPACE 1 00782000 C5AA1 C 1,RLD IS IT RLD 00783000 BNE C6AA1 NO,TEST FOR END 00784000 LA R1,SYSUT1 PLIST ADR 00785000 L R15,AWRBUF WRITE RLD CARD TO WORK FILE V0304 00786000 BALR R14,R15 V0304 00787000 BNZ ERRUTW BRANCH ON ERROR V0304 00788000 OI FLAG1,WORKFILE INDICATE RLD EXISTS 00789000 B RD PROCESS NEXT CARD 00790000 PASSTWO TM FLAG1,WORKFILE ANY RLDS ? 00791000 BNO C6AB6 NO, FINISH THE LOAD 00792000 NI FLAG1,255-WORKFILE RESET WORKFILE IND. 00793000 LA R1,SYSUT1 PLIST ADDRESS TO R1 00794000 L R15,AFINIS CLOSE WORK FILE V0304 00795000 BALR R14,R15 V0304 00796000 BNZ ERRUTW BRANCH ON ERROR V0304 00797000 SR R6,R6 GET A ZERO 00798000 NXTRLDCD LA R1,SYSUT1 ADDRESS OF PLIST 00799000 L R15,ARDBUF READ AN RLD RECORD FROM WORK FILE V0304 00800000 BALR R14,R15 V0304 00801000 BNZ ERRUT1RD BRANCH IF ERROR V0304 00802000 LA 10,SPEC+16 ADDRESS OF DATA FIELD IN 10 00803000 C5AC1 EQU * @VA11245 00803300 ST R6,SAV67 INDICATE ESID POINTER NOT SAVED @VA11245 00803600 LR R6,R10 POINT TO CURRENT DATA FIELD @VA11245 00803900 LR R11,R10 SAVE PTR TO CURRENT DATA FIELD @VA11849 00804050 C5AC1A EQU * @VA11245 00804200 LH R3,0(0,R6) GET RH ESID @VA11245 00804500 N R3,=X'00007FFF' MASK ID FIELD 00805000 LTR 3,3 IS IT 0 00806000 BZ CXDTST YES, CHECK FOR PR CUM LENGTH 00807000 CXDRET BAL 14,REFADR GET ADDR OF ENTRY IN REFTBLE 00808000 ST 12,TEMPST SAVE ADDRESS 00809000 C R12,TBLREF IS TXT ADDR INVALID @VA06291 00810000 BE RLDABND YES. R12 IS AT STORAGE END @VA06291 00811000 SR R0,R0 GET A ZERO @V201005 00812000 TM 8(R12),X'80' IS NAME DEFINED @V201005 00813000 BO PLOAD1 NO @V201005 00814000 L R0,12(R12) GET NAME'S ADDRESS @V201005 00815000 TM 4(R10),X'30' NON BRANCH ADCON @V201005 00816000 BNZ PLOAD1 NO @V201005 00817000 LH R3,0(0,R6) TEST IF SD ESIDTB @VA11245 00818000 N R3,=X'00007FFF' MASK ID FIELD @VM08509 00819000 AR R3,R3 MULT. BY TWO @VM08509 00820000 LA R3,ESIDTB(R3) GET ADDR OF ESIDTB ENTRY @VM08509 00821000 TM 0(R3),ESIDSDFB TEST ESID SD BIT @VM08509 00822000 BNO PLOAD1 NO @V201005 00823000 L R0,8(R12) YES, USE RELOCATION FACTOR @V201005 00824000 TM REFLG2(R12),REFNEG NEGATIVE RELOCATION FACTOR? @VA12730 00825000 BNO PLOAD1 NO @V1D1705 00826000 ICM R0,B'1000',=X'FF' COMPENSATE FOR 3 BYTE RELOCA@V1D1705 00827000 PLOAD1 EQU * @VA11245 00827500 LH R3,2(0,R6) GET PH @VA11245 00828000 SR R6,R6 RESTORE TO ZERO @VA11245 00828500 N R3,=X'00007FFF' MASK ID FIELD 00829000 LTR 3,3 IS IT 0 00830000 BZ BADCRD2 YES, BAD CARD @VA01260 00831000 SLL 3,1 CHECK ESID TABLE 00832000 LH 12,ESIDTB(3) ... 00833000 LTR 12,12 IS IT NEGATIVE ENTRY (ALREADY LOADED) 00834000 BM SKIPRLD YES, SKIP THESE ENTRIES 00835000 SRL 3,1 NO, RESET CONDITIONS AND CONTINUE 00836000 BAL 14,REFADR GET REFTBL ADDR OF PH 00837000 L R15,8(0,R12) GET REL. FACTOR OF PH 00838000 BAL 14,CTR SEE IF END OF CARD 00839000 SPACE 2 00840000 C5AA3 AR 10,5 ADDR OF NEXT 4 BYTE DATA FIELD 00841000 BCTR 5,0 C(REG 5) = 3 00842000 IC 6,0(0,10) GET FLAG BYTE 00843000 SRL 6,2 SHIFT OVER LENGTH BITS 00844000 NR 6,5 MASK OUT ALL BUT LAST 2 BITS 00845000 LA R5,RLDCONST+3 POINT TO WORK AREA +3 @V201005 00846000 SR R5,R6 BACK UP ACCORDING TO ADCON LENGTH@V201005 00847000 L 3,0(0,10) GET ASSIGNED ADDRESS OF (CON) 00848000 LA 3,0(3,R15) COMPUTE LOADED ADDRESS 00849000 TM 0(R10),X'30' NONBRANCH ADCON @V201005 00850000 BNZ ZERO NO @V201005 00851000 EX R6,MVCFROM MOVE RLD CONSTANT TO WORK AREA @V201005 00852000 ZERO L R4,RLDCONST GET CONSTANT IN R4 @V201005 00853000 TM 0(10),X'02' SHOULD WE SUBTRACT 00854000 BO C5AE4 YES GO DO IT 00855000 AR 4,R0 VAL=CON+ RH REL FAC 00856000 EJECT 00857000 COMPP ST R4,RLDCONST PUT VALUE BACK IN RLD CONST 00858000 EX R6,MVCTO MOVE CONSTANT TO STOR. @V201005 00859000 L 12,TEMPST GET ADDRESS OF RH SYMBOL 00860000 TM 8(12),X'80' IS ENTRY DEFINED? 00861000 BZ CTEX1 YES, SKIP REMEMBERING RTN. @V201005 00862000 L 7,APPNT GET ADDRESS OF APOINT 00863000 BALR 14,7 GO ADD TO STRING OF UNDEF'S 00864000 CTEX1 SR R6,R6 GET 0 @V201005 00865000 BAL 14,CTR CHECK FOR END OF CARD 00866000 TM 0(10),X'01' NEXT RH + PH SAME AS THIS ONE 00867000 BNO NXTENTRY NO, READ NEW DATA FIELD @VA11245 00867130 TM 0(R10),X'30' IF SAME, COMPARE FLAGS @VA11245 00867260 BZ BRTEST1 FIRST ENTRY IS NON-BRANCH @VA11245 00867390 TM 4(R10),X'30' CHECK SECOND ENTRY @VA11245 00867520 BNZ C5AA3 BOTH ARE BRANCH ADCONS @VA11245 00867650 B BRTEST2 MIXED TYPES, REREAD ESID DATA @VA11245 00867780 BRTEST1 EQU * @VA11245 00867910 TM 4(R10),X'30' CHECK SECOND ENTRY @VA11245 00868040 BZ C5AA3 BOTH ARE NON-BRANCH ADCONS @VA11245 00868170 BRTEST2 EQU * @VA11245 00868300 LH R4,SPEC+10 GET REMAINING BYTES IN RLD CARD @VA11849 00868430 AR R4,R5 ADD 4 TO ADJUST FOR REREADING @VA11849 00868560 STH R4,SPEC+10 STORE ADJUSTED BYTE COUNT @VA11245 00868690 L R6,SAV67 LOAD REGISTER FOR TEST @VA11245 00868820 LTR R6,R6 WAS ESID POINTER SAVED? @VA11245 00868950 BNZ C5AC1A YES, REREAD RH AND PH @VA11245 00869080 LR R6,R11 POINT BACK TO CURRENT ESID'S @VA11849 00869280 ST R6,SAV67 SAVE THE POINTER @VA11245 00869470 B C5AC1A BACK TO REREAD RH AND PH @VA11245 00869600 NXTENTRY EQU * @VA11245 00869730 AR R10,R5 GET ADDRESS OF NEXT DATA FIELD @VA11245 00869860 B C5AC1 BACK TO GET NEW PH + RH 00870000 C5AE4 SR 4,R0 SUB RH FROM ASSIGNED VAL 00871000 B COMPP BACK TO ROUTINE 00872000 MVCFROM MVC 0(*-*,R5),0(R3) EXECUTED MOVE @V201005 00873000 MVCTO MVC 0(*-*,R3),0(R5) @V201005 00874000 SPACE 2 00875000 CTR LA 5,4 4 BYTES PER DATA FIELD 00876000 ST R6,RLDCONST ZERO CONSTANT FIELD 00877000 LH 4,SPEC+10 GET BYTE COUNT 00878000 SR 4,5 SUBTRACT 5 00879000 BZ NXTRLDCD GET NEXT RLD CARD FROM WORK FILE 00880000 STH 4,SPEC+10 STORE NEW BYTE COUNT 00881000 BR 14 BACK TO CALLLER 00882000 SPACE 2 00883000 CXDTST EQU * @VA11245 00883600 TM 4(R6),X'30' IS IT A PR CUM LENGTH CONST? @VA11245 00884200 BNO BADCRD2 NO, BAD CARD @VA01260 00885000 LA 1,FAKECXD YES, SET TO DEFINE CXD ENTRY 00886000 LA 2,NOCXD RETURN IF NOT FOUND 00887000 BAL 3,PRSERCH1 LOOK FOR ENTRY IN REFTBL 00888000 TM REFLG2(R12),REFICS ICS FLAG SET ON? @VA12730 00888300 BO BADICS INVALID MATCH @VA12730 00888600 NOCXD MVI 8(12),X'81' SET CXD CODE BYTE 00889000 B CXDRET+4 BACK TO ROUTINE 00890000 SPACE 2 00891000 SKIPRLD BAL 14,CTR CHECK FOR END OF CARD 00892000 SKIPRLD2 AR 10,5 MOVE TO NEXT 4-BYTE FIELD 00893000 BAL 14,CTR CHECK FOR END OF CARD 00894000 TM 0(10),X'01' NEXT RH + PH SAME AS THIS ONE ? 00895000 BO SKIPRLD2 YES 00896000 AR 10,5 NO, MOVE TO IT 00897000 B C5AC1 PROCESS IT 00898000 ERRUT1RD LA R5,RDERR62 ERROR MSG 104S (READ ERROR) 00899000 CH R15,=H'12' WAS IT EOF ? 00900000 BNE ERRUTWA NO, TERMINATE THIS COMMAND 00901000 L R15,AERASE ERASE WORK FILE V0304 00902000 BALR R14,R15 V0304 00903000 B C6AB6 COMPLETE THE LOADING 00904000 ERRUTW LA R5,WRERR46 ERROR MSG 105S (WRITE ERROR) 00905000 ERRUTWA MVC OUTBUF(18),8(R1) FILE NAME TO MSG BUFFER 00906000 LR R2,R15 SAVE ERROR RETURN CODE 00907000 B FATERR TERMINATE THIS COMMAND 00908000 EJECT 00909000 *********************************************************************** 00910000 * 00911000 * END CARD ROUTINE (END) 00912000 * 00913000 *********************************************************************** 00914000 * 00915000 C6AA1 C 1,END 00916000 BC 7,C6AC1 BR-NOT END CARD 00917000 CLC SPEC+28(4),BLANKS CHECK FOR CSECT LENGTH IN END 00918000 BE C6AB5 NO - CONTINUE NORMALLY 00919000 L 1,LOCCT YES - UPDATE THE LOCATION COUNT 00920000 LA R1,7(0,R1) ALIGN TO DOUBLEWORD BOUNDARY @VA12730 00920300 N R1,DBLBND REMOVE EXCESS BITS @VA12730 00920600 A 1,SPEC+28 ... 00921000 LA 1,7(0,1) ALIGN TO DBL BOUND 00922000 N 1,DBLBND ... 00923000 ST 1,LOCCT ... 00924000 C6AB5 SR 2,2 ... 00925000 CLI SPEC+5,C' ' 00926000 BC 8,C6AB3 BR IF NO ADDR 00927000 STC 6,SPEC+4 00928000 TM FLAG1,ENDCDADR END CARD ADR ALLOWED 00929000 BC 1,C6AB3 BR NO, ADDR SAVED 00930000 LH 3,SPEC+14 LOD ESID 00931000 BAL 14,REFADR 00932000 L R2,8(0,R12) GET RELOCATION FACTOR 00933000 C6AB4 A 2,SPEC+4 FORM ADDR 00934000 STCM R2,B'0111',BRAD+1 SET ENTRY ADDRESS P0966 00935000 OI FLAG1,ENDCDADR INDICATE END CARD ADDRESS SAVED 00936000 C6AB3 B PASSTWO PROCESS RLDS 00937000 C6AB6 XC ESIDTB(256),ESIDTB CLEAR ESID TABLE 00938000 XC ESIDTB+256(256),ESIDTB+256 CLEAR ESID TABLE @VA02083 00939000 BC 15,RD TO RD 00940000 RLDABND EQU * @VA06291 00941000 L R11,ADMSLIO SET R11 FOR LIO BASE ADDR @VA06291 00942000 LA R5,ERRORB SET UP FUNCTION CODE FOR LIO @VA06291 00943000 LA R14,N03 SET UP RETURN EXIT ADDR @VA06291 00944000 BR 11 GO TYPE MSG AND RETURN TO EXIT @VA06291 00945000 EJECT 00946000 *********************************************************************** 00947000 * 00948000 * LOAD TERMINATE CARD ROUTINE (LDT) 00949000 * 00950000 *********************************************************************** 00951000 * 00952000 C6AC1 C 1,LDT 00953000 BE C6AC2 LDT CARD, PROCESS IT 00954000 B CTLCRD1 PROCESS AS A CONTROL CARD 00955000 C6AC2 CLI SPEC+16,C' ' IS THERE A NAME ? 00956000 BE CHKTXT CHECK FOR TEXT FILE @VA04695 00957000 LA 2,ERLDT1 00958000 BAL 3,SERCH 00959000 MVC BRAD(4),12(R12) PUT NEW START IN BRAD 00960000 CHKTXT EQU * @VA04695 00961000 CLC FTYPE,=CL8'TEXT' IS THIS TEXT FILE? @VA04695 00962000 BE RD BRANCH IF YES, MORE PROC REQ @VA04695 00963000 EJECT 00964000 *********************************************************************** 00965000 * 00966000 * INVOKE TEXT LIBRARY SEARCHING 00967000 * 00968000 *********************************************************************** 00969000 * 00970000 LIBGO TM FLAG2,NOAUTO+NOLIBE ARE SEARCHES SUPPRESSED 00971000 BO C6AD7 YES, DON'T LOOK 00972000 NI FLAG3,X'FF'-CMD NO LONGER PROC COMMAND LINE @VA01699 00973000 TM FLAGS,LUNDEF ANY UNDEFINEDS? 00974000 BZ C6AD7 NO - SKIP LIBE SEARCH 00975000 LA 3,NXTRD SET FOUND RETURN 00976000 L 11,ALIBE GO SEARCH LIBE 00977000 BALR 14,11 ... 00978000 EJECT 00979000 *********************************************************************** 00980000 * 00981000 * TERMINATE LOADING 00982000 * 00983000 *********************************************************************** 00984000 C6AD7 EQU * 00985000 L 12,ENTADR WAS 'ENTRY' SPECIFIED? 00986000 LA R12,0(,R12) 00987000 LTR 12,12 ... 00988000 BZ NOENTCRD NO 00989000 TM 8(12),X'80' WAS ENTRY-POINT DEFINED? 00990000 BO NOENTCRD NO 00991000 L R3,12(0,R12) GET V(ENTRY POINT) 00992000 CLC 04(8,R3),=C'CMS"XEQ"' SAVE NORMAL START ADDR? 00993000 BNE NOENT NO @VA03251 00994000 CLC 12(4,R3),ZEROES ADDRESS FILLED IN? @VA12730 00995000 BNE NOENTCRD YES @VA03251 00996000 MVC 12(4,R3),BRAD SAVE OLD START ADDR 00997000 NOENT MVC BRAD+1(3),13(R12) SET NEW START ADDRESS @VA03251 00998000 NOENTCRD EQU * 00999000 L 0,BRAD LOAD START ADDRESS 01000000 EX 0,C6AB6 CLEAR ESID TABLE 01001000 ST R0,STRTADDR SAVE STARTING ADDRESS 01002000 L R4,FLAG1 GET FLAG1 AND 2 01003000 ST R4,LDRFLAGS SAVE IN NUCON 01004000 STH R4,TBENT SAVE LDR TBL COUNT IN NUCON 01005000 MVI LOCCNT,X'00' CLEAR FIRST BYTE OF "LOCCNT" 01006000 MVC LOCCNT+1(3),LOCCT+1 SAVE CURR VALUE OF "LOCCT" 01007000 CLC LOCCNT,AUSRAREA ARE WE BELOW USER STOR? @VA02752 01008000 BNL TRANOVR NO, PROCEED AS USUAL @VA02752 01009000 CLC LOCCNT,ALAST ABOVE TRANSIENT AREA? @V305665 01010000 BH FATERR1 YES, ERROR @VA02752 01011000 TRANOVR EQU * @VA05785 01012000 L 12,TBLREF 01013000 SR 4,4 SHOW NO ERRORS IF NOT 01014000 LH R4,TBLCT GET NUMBER OF LDR TBL ENTRIES 01015000 CH R4,=H'2' WAS ANYTHING LOADED 01016000 BE N03 NO, BACK TO USER 01017000 LA 3,20 LDR TBL ENTRY SIZE 01018000 SR 0,0 01019000 SUB1 SR 12,3 POINT TI FIRST ENTRY IN REFTBL 01020000 CLI 8(12),X'80' IS ENTRY DEFINED? 01021000 BNE NO1 YES - LOOK AT NEXT ENTRY 01022000 MVI UNRES,X'80' SAVE UNRESOLVED FLAG @VA02829 01023000 TM REFLG2(R12),REFLBT NAME FOUND IN DMSLIB SEARCH? @VA12730 01024000 BO NO1 YES, DON'T LIST AS UNDEF. 01025000 EJECT 01026000 SYMCHK LTR 0,0 TEST FOR PREV UNDEF SYM 01027000 BC 7,SUB2 IF NONE, PRINT HEADER 01028000 LA 5,ERRORS PRINT UNDEFINED SYMBOL MESSAGE 01029000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 01030000 BALR 14,11 GO PRINT HEADING 01031000 LA 2,OUTPUT+1 INITIALIZE POINTERS 01032000 LA 5,OUTPUT+68 01033000 SUB2 MVC 0(8,2),0(12) MOVE NAME INTO OUTPUT LINE 01034000 LA 2,9(,2) SPACE UP LINE POINTER 01035000 CR 2,5 ARE WE AT END OF LINE 01036000 BC 4,SUB3 NO - CONTINUE 01037000 LA 5,OUTR YES, PRINT OUT LINE 01038000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 01039000 BALR 14,11 GO PRINT 01040000 LA 2,OUTPUT+1 INITIALIZE POINTERS 01041000 LA 5,OUTPUT+68 01042000 SUB3 LA R0,4 ERROR (NON-FATAL) 01043000 NO1 BCT 4,SUB1 01044000 LTR 0,0 TEST FOR ERRORS 01045000 BZ LDXEQ BRANCH NO ERRORS @VA05785 01046000 ST R0,LDRADDR+4 SAVE ERROR CODE 01047000 LA 5,OUTPUT 01048000 CR 2,5 01049000 BZ LDXEQ NO OUTPUT @VA05785 01050000 LA 5,OUTR 01051000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 01052000 BALR 14,11 PRINT LAST LINE 01053000 EJECT 1 01054000 USING XPRTAB,R10 @VA05785 01055000 LDXEQ EQU * @VA05785 01056000 LA R10,SPEC USE SPEC & ESIDTB FOR FREE @VA05785 01057000 SR R6,6 GET 0 @VA05785 01058000 ST R6,HALFAD CLEAR SOME OF FREE @VA05785 01059000 ST R6,BYTEAD ... @VA05785 01060000 ST R6,FULLAD ... @VA05785 01061000 ST R6,DBLAD ... @VA05785 01062000 ST R6,CXDAD ... @VA05785 01063000 MVC COMMON(4),LOCCNT @VA05785 01064000 L R12,TBLREF POINT TO FIRST ITEM IN REFERENCE @VA05785 01065000 LH R4,TBLCT @VA05785 01066000 LTR R4,R4 ANY LOADER TABLE ENTRIES @VA05785 01067000 BZ N03 NO, OMIT LOAD COMPLETION @VA05785 01068000 LA R3,20 @VA05785 01069000 L R7,AADDEF TR @VA05785 01070000 SPACE 2 01071000 TM FLAG1,COMMONEX DO COMMON ENTRIES EXIST @VA05785 01072000 BZ S1 NO, DON'T PRINT HEADER @VA05785 01073000 NI FLAG1,255-COMMONEX RESET COMMON BIT @VA05785 01074000 LA R5,CMDEF GET IO INDEX FOR HEADER @VA05785 01075000 L R11,ADMSLIO GET LINKAGE @VA05785 01076000 BALR 14,11 GO PRINT HEADING @VA05785 01077000 EJECT 01078000 S1 SR R12,3 NEXT ENTRY IN REFTBL @VA05785 01079000 CLI 8(12),X'00' IS ENTRY DEFINED @VA05785 01080000 BE N1 YES LOOK AT NEXT @VA05785 01081000 TR 8(1,R12),TRANPR TRANSLATE FLAG TO INDEX @VA08891 01081500 SR R6,R6 GET 0 @VA05785 01083000 LR R1,6 DEFINE UNDEFS AT 0 @VA05785 01084000 IC R6,8(0,12) GET ENTRYS FLAG BYTE @VA05785 01085000 SLL R6,1 MULTIPLY BY 2 @VA05785 01086000 LH R6,XTRATBL(6) INDEX TRANSFER TABLE @VA05785 01087000 B R0(6,R8) GO TO APPROPRIATE ROUTINE @VA05785 01088000 N1 BCT R4,S1 BACK FOR MORE ENTRIES @VA05785 01089000 SPACE 2 01090000 TM FLAG1,PREXIST ARE THERE ANY PR ENTRIES @VA05785 01091000 BZ N03 @VA05785 01092000 NI FLAG1,255-PREXIST RESET PR PENDING BIT @VA05785 01093000 LA R5,PRDEF IO INDEX FOR P-R HEADER @VA05785 01094000 L R11,ADMSLIO PRINT HEADING @VA05785 01095000 BALR 14,11 ... @VA05785 01096000 SPACE 3 01097000 LA R3,DBLAD ADDRESS OF DBL PR TBL @VA05785 01098000 BAL R15,XPRPRT PRINT OUT DOUBLE AL PR @VA05785 01099000 LA R3,FULLAD ADDRESS OF FULL PR TBL @VA05785 01100000 BAL R15,XPRPRT PRINT FULL AL PR @VA05785 01101000 LA R3,HALFAD ADDRESS OF HALF PR TBL @VA05785 01102000 BAL R15,XPRPRT PRINT HALF AL PR @VA05785 01103000 LA R3,BYTEAD ADDRESS OF BYTE PR TBL @VA05785 01104000 BAL R15,XPRPRT PRINT BYTE AL PR @VA05785 01105000 LA R3,CXDAD ADDRESS OF CXD TBL @VA05785 01106000 BAL R15,XPRPRT PRINT CXD LENGTH @VA05785 01107000 B N03 RETURN TO USER @VA05785 01108000 XDBL LA R6,DBLAD ADDRESS OF DBL PR TBL @VA05785 01109000 LA R14,HALFAD-DBLAD SIZE OF DOUBLE TABLE @VA05785 01110000 B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY @VA05785 01111000 XFULL LA R6,FULLAD ADDRESS OF FULL PR TBL @VA05785 01112000 LA R14,DBLAD-FULLAD SIZE OF FULL TABLE @VA05785 01113000 B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY @VA05785 01114000 XHALF LA R6,HALFAD ADDRESS OF HALF PR TBL @VA05785 01115000 LA R14,BYTEAD-HALFAD SIZE OF HALF TABLE @VA05785 01116000 B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY @VA05785 01117000 XBYTE LA R6,BYTEAD LOC OF BYTE PR TBL @VA05785 01118000 LA R14,COMMON-BYTEAD SIZE OF BYTE TABLE @VA05785 01119000 B PRVSAVE GO SAVE REFTBL LOC OF PR ENTRY @VA05785 01120000 XCXD LA R6,CXDAD LOC OF PR CUM LENGTH TBL @VA05785 01121000 LA R14,8 SIZE OF CXD FIELD @VA05785 01122000 OI 8(12),X'80' UNDEFINE IT @VA05785 01123000 B PRVSAVE GO SAVE LOC OF PR CUM LENGTH @VA05785 01124000 XUNDEF MVI 8(12),X'80' RESET UNDEF BIT @VA05785 01125000 XC 0(8,12),0(12) ZERO OUT UNDEFINED ENTRY @VA05785 01126000 BALR 14,7 DEFINE ENTRY AT 0 @VA05785 01127000 B N1 RETURN TO LOOK AGAIN @VA05785 01128000 SPACE 2 01129000 XCOMSET L R1,COMMON GET CURRENT LOC OF COMMON @VA05785 01130000 L R2,8(,12) GET LENGTH OF CSECT @VA05785 01131000 LA R2,0(0,R2) CLEAR HIGH ORDER BYTE @VA05785 01132000 LA R1,7(,1) @VA05785 01133000 N R1,DBLBND ALIGN TO DOUBLE WRD @VA05785 01134000 LR R6,R1 SAVE BEGINNING OF THIS COMMON @VA05785 01135000 * SECT 01136000 AR R6,R2 ADD THE LENGTH @VA05785 01137000 ST R6,COMMON RESET COMMON LOCATION COUNTER @VA05785 01138000 ST R6,LOCCNT RESET LOCATION COUNTER @VA05785 01139000 OI 8(12),X'80' UNDEFINE THE ENTRY @VA05785 01140000 BAL R6,XENTDEF NO, GO DEFINE ENTRY @VA05785 01141000 LA R5,CMVAL IO INDES FOR COMMON PRINT @VA05785 01142000 L R11,ADMSLIO PRINT NAME, VAL + LENGTH @VA05785 01143000 BALR 14,11 ... @VA05785 01144000 CLC COMMON,FREELOWE IS MEMORY EXCEEDED @VA05785 01145000 BNL FATERR1 YES, GIVE FATAL ERROR MESSAGE @VA05785 01146000 * AND GIVE UP 01147000 B N1 BACK TO LOOK AGAIN @VA05785 01148000 PRVSAVE LH R1,0(0,6) GET DISP OF NEXT LOC IN TBL @VA05785 01149000 LA R1,2(0,1) ... @VA05785 01150000 CR R1,R14 WILL TABLE OVERFLOW @VA05785 01151000 BNL PRTBLOVR YES, FATAL ERROR @VA05785 01152000 LH R2,TBLCT TOTAL NO OF ENTRIES IN REFTBL @VA05785 01153000 SR R2,R4 MINUS CNT GIVES INDEX FROM TOP @VA05785 01154000 LA R2,1(0,2) OFF BY 1 @VA05785 01155000 STH R2,0(1,6) PUT INTO TBL @VA05785 01156000 STH R1,0(0,6) SAVE TBL INDEX @VA05785 01157000 B N1 BACK TO LOOK AGAIN @VA05785 01158000 PRTBLOVR LA R5,PROVER DMSLIO CODE @VA05785 01159000 B FATERR TERMINATE @VA05785 01160000 EJECT 01161000 XENTDEF EQU * @VA05785 01162000 BALR 14,7 GO DEFINE ENTRY @VA05785 01163000 ST R1,12(0,12) SET LOCATION IN LOADER TABLE @VA05785 01164000 MVI 8(12),X'00' CLEAR FLAG BYTE @VA05785 01165000 BR R6 BACK TO CALLER @VA05785 01166000 SPACE 2 01167000 XPRPRT LH R4,0(0,3) GET ENTRY COUNT FROM TABLE @VA05785 01168000 LTR R4,R4 ANYTHING IN TBL @VA05785 01169000 BCR 8,R15 NO BACK TO CALLER @VA05785 01170000 XPRSET2 L R12,TBLREF ADDRESS OF REFTBL TOP @VA05785 01171000 LA R3,2(0,3) INDEX PTR @VA05785 01172000 LH R2,0(0,3) GET REFTBL INDEX @VA05785 01173000 MH R2,=H'20' MULTIPLY BY 20 @VA05785 01174000 SR R12,R2 GET ADDRESS OF ENTRY @VA05785 01175000 L R1,12(0,12) GET VALUE FROM REFTBL @VA05785 01176000 LH R5,PRVCNT GET PRESENT PR COUNT @VA05785 01177000 LH R2,10(0,12) GET LENGTH OF PR ENTRY @VA05785 01178000 AR R2,R1 ADD TO VALUE @VA05785 01179000 CLI 8(12),X'84' IS THIS A CXD? @VA05785 01180000 BNE XPRCNT NO - PROCEED NORMALLY @VA05785 01181000 LR R1,5 YES - GET PRCNT AS VALUE @VA05785 01182000 XPRCNT CLR R2,R5 PRESENT PR VAL HIGHEST? @VA05785 01183000 BNH XPRDEF NO - DON'T REPLACE @VA05785 01184000 STH R2,PRVCNT NO, PUT NEW COUNT IN PRVCNT @VA05785 01185000 XPRDEF BAL R6,XENTDEF GO DEFINE ENTRY @VA05785 01186000 LA R5,PRVAL IO INDEX FOR PR PRINT @VA05785 01187000 L R11,ADMSLIO PRINT NAME, VAL + LENGTH @VA05785 01188000 BALR 14,11 ... @VA05785 01189000 XC 0(8,R12),0(R12) CLEAR PR FROM TABLE @VA05785 01190000 BCTR R4,0 SUBTRACT 1 @VA05785 01191000 BCT R4,XPRSET2 BACK FOR ANOTHER ENTRY @VA05785 01192000 BR R15 RETURN TO CALLER @VA05785 01193000 EJECT 1 01194000 N03 L 3,RETREG SET TO RETURN TO CALLER 01195000 N032 OI FLAGS,CLOSELIB SET TO CLOSE LIBRARIES 01196000 L 11,ALIBE GO TO LIBE ROUTINE 01197000 BALR 14,11 ... 01198000 LA 5,LDRFIN IO INDEX FOR LDR FINISH 01199000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 01200000 BALR 14,11 GO FINISH 01201000 TM OSSFLAGS,DYLD IS THIS A DYNAMIC LOAD 01202000 BO AROUND YES,LEAVE TXTLIB DIRECTORIES IN STOR. 01203000 STM R0,R15,APSV SAVE REGISTERS 01204000 L R15,=V(DMSLGTA) FREE THE TXTLIB DIRECTORY BLOCKS 01205000 BALR R14,R15 01206000 LM R0,R15,APSV RESTORE REGISTERS 01207000 AROUND EQU * 01208000 LM R9,R12,GPRSAV 01209000 LA R0,NEED RETURN FRRE STORAGE 01210000 LR 1,13 01211000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 01212000 LR 1,6 01213000 LR 14,3 01214000 L R15,LDRRTCD GET RETURN CODE P0934 01215000 BCR 15,14 RETURN 01216000 SPACE 4 01217000 ERLDT1 LA 1,SPEC+16 SET POINTER TO NAME 01218000 ERLDT LA R5,ERROR30 ERROR MSG 209E (NAME NOT FOUND) 01219000 MVC OUTBUF(8),0(1) MOVE NAME TO BUFF 01220000 BC 15,FATERR 01221000 EJECT 01222000 *********************************************************************** 01223000 * 01224000 * ROUTINE TO LOCATE REFTBL ENTRIES 01225000 * THRU ESID 01226000 * 01227000 * LH 3, WITH ESID, RH, OR PH 01228000 * VALUE BEFORE ENTERING ROUTINE 01229000 * 01230000 *********************************************************************** 01231000 * 01232000 REFADR L 12,TBLREF 01233000 SLL 3,1 TIMES TWO 01234000 LR R5,R3 SAVE TABLE INDEX 01235000 LH 3,ESIDTB(3) GET INDEX OF ENTRY 01236000 N R3,ESIDMASK CLEAR OUT FLAG BITS 01237000 MH R3,=H'20' MULTIPLY BY 20 01238000 SR 12,3 SIZE-(ESID X 16) 01239000 C 12,TBLREF SEE IF ESD EXISTS 01240000 BCR 7,14 YES - BACK TO CALLER 01241000 L R7,LOCCT ASSUME LOCATION 01242000 LA R7,7(0,R7) ROUND TO DBL WD BOUNDARY 01243000 N R7,DBLBND 01244000 ST R7,LOCCT 01245000 CLC SPEC(4),ESD ESD CARD ? 01246000 BNE 4(0,R14) NO, RETURN +4 01247000 DMSFREE DWORDS=3,TYPCALL=BALR GET WAITING BLK 01248000 LR R7,R5 SET R7 TO ID TABLE INDEX 01249000 LA R2,MEMBOUND POINT TO WAITING CHAIN 01250000 BACK L R3,0(R2) 1ST (NEXT) BLOCK 01251000 LTR R3,R3 EXIST 01252000 BZ ENDCHAIN NO, ADD NEW BLOCK 01253000 LR R2,R3 YES, LOOK FOR NEXT 01254000 B BACK 01255000 ENDCHAIN ST R1,0(R2) CHAIN NEW BLOCK 01256000 MVC 4(16,R1),SPEC+16 SAVE ESD DATA ITEM FOR LD 01257000 XC 0(4,R1),0(R1) ZERO LASR POINTER 01258000 LA R1,ESIDTB(R7) GET TO ESIDTB FOR SD 01259000 OI 0(R1),ESIDLATE INDICATE WAITING LD'S 01260000 B ESD00 PROCESS NEXT ESD DATA ITEM 01261000 SDDEF LH R7,SPEC+14 ID OF SD 01262000 LA R2,MEMBOUND POINT TO WAITING CHAIN 01263000 LDLOOK L R3,0(R2) R3 = NEXT (1ST) BLOCK 01264000 LTR R3,R3 EXIST 01265000 BZ ESD00 NO, DO NEXT ESD DATA ITEM 01266000 CH R7,18(R3) LD AND SD ID'S MATCH 01267000 BE LDFND YES, THIS LD IS WAITING 01268000 LR R2,R3 UPDATE BASE PTR 01269000 B LDLOOK LOOK AT NEXT BLOCK 01270000 LDFND STM R0,R15,PLISTSAV PROTECT REGISTERS 01271000 MVC SPEC+16(16),4(R3) RESTORE ESD DATA ITEM TO SPEC BUFFER 01272000 BAL R10,LATESD PROCESS LD ITEM 01273000 LM R0,R15,PLISTSAV RESTORE REGISTERS 01274000 L R5,0(R3) PTR TO NEXT BLOCK 01275000 LR R1,R3 SET FREE LOCATION 01276000 DMSFRET DWORDS=3,LOC=(1),TYPCALL=BALR 01277000 ST R5,0(R2) ELIMINATE FREED BLOCK FROM CHAIN 01278000 B LDLOOK LOOK FOR MORE WAITING BLOCKS 01279000 EJECT 01280000 *********************************************************************** 01281000 * 01282000 * ROUTINE TO SEARCH REFERENCE TABLE 01283000 * FOR A GIVEN NAME 01284000 * 01285000 *********************************************************************** 01286000 * 01287000 * CALLING SEQUENCE-- 01288000 * L(LA) 2,NOT FOUND RETURN 01289000 * BAL 3,ENTRY FOUND RETURN 01290000 * REG 12 = ADDR OF ENTRY IN REFTBL.REG 11=1,REG 1= NAME OF PROG 01291000 * REG. 3 = REFTBL NUMBER (E.G. 1,2,3,...) 01292000 * THIS ROUTINE COMPARES EACH REFERENCE TABLE ENTRY 01293000 * WITH THE GIVEN NAME,DETERMINING FIRST WHETHER THERE 01294000 * IS AN ENTRY FOR THAT NAME AND 2ND WHAT THE 01295000 * STORAGE ADDRESS OF THAT ENTRY IS. 01296000 * 01297000 *********************************************************************** 01298000 * 01299000 PRSERCH LA 1,SPEC+16 ADDR OF NAME IN CARD 01300000 PRSERCH1 LA R15,X'80' PR MASK FOR CHKTYPE 01301000 B SERCH2 SKIP OVER SERCH INITIALIZATION 01302000 SERCH LA 1,SPEC+16 ADDR OF NAME IN CARD 01303000 SERCH1 LA R15,X'70' NON-PR MASK FOR CHKTYPE 01304000 SERCH2 LH 0,TBLCT NO OF ENTRIES IN REFTBL 01305000 SR 4,4 01306000 LA R5,20 LDR TBL ENTRY SIZE 01307000 L 12,TBLREF LARGEST ADDR IN STORAGE+1 01308000 LA R12,0(0,R12) CLEAR COUNT BYTE 01309000 STM R6,R7,SAV67 SAVE 6 + 7 01310000 LTR 0,0 01311000 BC 8,NOT 01312000 LM 6,7,0(1) LOAD WORD FOR SEARCH 01313000 CMP SR 12,5 01314000 AH R4,=H'1' TO ACCUMULATE ENTRY POSITION 01315000 CL 7,4(0,12) SECOND HALF OF ENTRY MATCH? 01316000 BNE CMPEND NO - TRY ANOTHER 01317000 CL 6,0(0,12) FIRST HALF OF ENTRY MATCH? 01318000 BE CHKTYPE YES - CHECK FOR TYPE MATCH 01319000 CMPEND BCT 0,CMP BACK TO LOOK AGAIN 01320000 NOT SR 12,5 01321000 AH R4,=H'1' ADD TO TOTAL ENTRIES 01322000 SR R0,R0 GET NUMBER OF PAGES OF LOADER-TABLES JS 01323000 IC R0,TBLREF FROM LEFT-MOST BYTE OF "LDRTBL", JS 01324000 MH R0,=H'204' X 204 (204 ENTRIES PER PAGE) 01325000 CR 4,0 01326000 BC 10,ERREF REFERENCE TABLE OVERFLOW 01327000 STH 4,TBLCT NO. FO ENTRIES IN TBLREF 01328000 MVC 0(8,12),0(1) PLACE NAME IN REFTBL 01329000 XC 8(12,12),8(12) ZERO OTHER PART OF ENTRY 01330000 LM R6,R7,SAV67 RESTORE 6 + 7 01331000 BCR 15,2 01332000 ERREF LA 5,ERRORR GO TO ERPRNT WITH COMMENT OF RE 01333000 BC 15,FATERR 01334000 SPACE 01335000 CHKTYPE CLI 8(R12),X'83' IS THIS A WEAK EXTRN 01336000 BE NMFND YES, OMIT CHECK 01337000 TM 8(R12),X'0D' DON'T CHECK FOR COMMON BIT 01338000 NMFND EX R15,TYPECHK PR BC 8; NON-PR BC 7 @V1D1705 01339000 LM R6,R7,SAV67 RESTORE REGS @V1D1705 01340000 BR 3 BACK TO FOUND RETURN 01341000 SPACE 01342000 TYPECHK BC 0,CMPEND 01343000 EJECT 01344000 *********************************************************************** 01345000 * 01346000 * ERROR ROUTINES 01347000 * 01348000 *********************************************************************** 01349000 DMSLDRD EQU * 01350000 FATERR L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 01351000 BALR 14,11 GO DO SOMETHING 01352000 B N03 GO TO TERMINATE LOADING 01353000 SPACE 01354000 FATERR1 EQU * 01355000 LA 5,ERRORC CORE SIZE EXCEEDED 01356000 B FATERR GIVE UP 01357000 SPACE 2 01358000 DMSLDRC EQU * 01359000 BADCRD LA R14,RD RETURN FROM LIO @VA01260 01360000 B BADCRD3 GO SET ERROR CODE @VA01260 01361000 BADCRD2 LA R14,NXTRLDCD RETURN FROM LIO @VA01260 01362000 BADCRD3 LA R5,ERRORA ERROR CODE FOR LIO @VA01260 01363000 MVC OUTBUF+15(80),SPEC MOVE CRD IMJ TO BUFF 01364000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 01365000 BR 11 GO PRINT INV CARD 01366000 EJECT 01367000 *********************************************************************** 01368000 * CONSTANTS AREA 01369000 *********************************************************************** 01370000 SPACE 2 01371000 ALIBE DC V(DMSLIB) LIBRARY SEARCH ROUTINE 01372000 AADDEF DC A(DMSLSBC) LINKAGE DEFINITION ROUTINE 01373000 APPNT DC A(DMSLSBB) LINKAGE WAITING ROUTINE 01374000 HEXBB DC A(DMSLSBA) HEX TO BINARY CONVERSION 01375000 SPACE 1 01376000 SLC DC X'02' *** 01377000 DC C'SLC' 01378000 ICS DC X'02' *** 01379000 DC C'ICS' 01380000 ESD DC X'02' *** 01381000 DC C'ESD' 01382000 TXT DC X'02' *** 01383000 DC C'TXT' 01384000 REP DC X'02' *** 01385000 DC C'REP' 01386000 RLD DC X'02' *** 01387000 DC C'RLD' 01388000 END DC X'02' *** 01389000 DC C'END' 01390000 LDT DC X'02' *** 01391000 DC C'LDT' 01392000 SPACE 1 01393000 SPACE 1 01394000 OUTR EQU 2 TYPE OUT MSG BUFFER 01395000 LDRSET EQU 4 IO INDEX 01396000 LDRFIN EQU 6 IO INDEX 01397000 PRDEF EQU 8 IO INDEX 01398000 CMDEF EQU 12 IO INDEX 01399000 PRVAL EQU 16 IO INDEX 01400000 CMVAL EQU 20 IO INDEX 01401000 ERRORU EQU 28 203W - SLCNAME UNDEFINED 01402000 ERROR30 EQU 30 209E - ENTRY POINT NOT FOUND 01403000 ERRORA EQU 32 - INVALID CARD TO LOAD MAP 01404000 PROVER EQU 38 168S - PR TABLE OVERFLOW 01405000 ERRORR EQU 44 716S - LOADER TABLE OVERFLOW 01406000 WRERR46 EQU 46 705S - WRITE ERROR 01407000 ERRORM EQU 48 202W - DUPLICATE IDENTIFIER 01408000 ERRORI EQU 50 455E - ENTRY POINT NOT DEFINED 01409000 ERRORS EQU 52 201W - THE FOLLOWING NAMES ARE UNDEFINED 01410000 ERRORB EQU 54 - FILE CONTAINS INVALID RECORDS @VA06291 01411000 ESDOVER EQU 56 169S - ESDID TBL OVERFLOW 01412000 CRDIMJ EQU 60 - CARD IMAGE TO LOAD MAP 01413000 RDERR62 EQU 62 704S - READ ERROR 01414000 PRERR EQU 70 206W - PR ALIGNMENT ERROR 01415000 CTLCRD EQU 78 - CONTROL CARD TO LOAD MAP 01416000 ERRORC EQU 82 709S - STORAGE EXCEEDED 01417000 EJECT 01418000 SPACE 1 01419000 RDISK DC CL8'RDBUF' ROUTINE 01420000 DS 8C FILE 01421000 DC CL8'TEXT' TYPE 01422000 DC CL2' ' MODE 01423000 DC H'0' ITEM NO. 01424000 DS 4C 01425000 SETBYTE DC AL4(800) BUFF SIZE (10 CARDS 01426000 DS 2C 01427000 DC H'10' GET 10 80-BYTE ITEMS 01428000 DC AL4(0) 01429000 FDISK DC CL8'FINIS' ROUTINE 01430000 DS 8C FIEL 01431000 DC CL8'TEXT' TYPE 01432000 DC AL2(0) 01433000 WORKSET DC CL8'ERASE' 01434000 DC CL8'DMSLDR' 01435000 DC CL8'SYSUT1' 01436000 DC CL2'A5' 01437000 DC H'0' 01438000 DS 4X 01439000 DC AL4(80) 01440000 DC CL2'F' 01441000 DC H'1' 01442000 DS 4X 01443000 DC AL2(0) MODE 01444000 SPACE 1 01445000 SPACE 2 01446000 DS 0F 01447000 * FORMAT OF ESIDTB ENTRY IS -- 01448000 * BIT 0 DUPLICATE SD FLAG 01449000 * BIT 1 SD-TYPE ESID FLAG 01450000 * BIT 2 WAITING LD'S EXIST 01451000 * BIT 3 UNUSED 01452000 * BIT 4-15 REFTBL ENTRY NUMBER (E.G. 1,2,3,...) 01453000 ESIDMASK DC X'00001FFF' MASK OUT ESIDTB FLAGS 01454000 ESIDDUPF DC X'00008000' DUPLICATE SD FLAG 01455000 ESIDSDF DC X'0000',AL1(ESIDSDFB),X'00' SD-TYPE ESID FLAG 01456000 ESIDSDFB EQU X'40' SD-TYPE ESID BIT 01457000 ESIDLATE EQU X'20' WAITNG LABEL DEFINITIONS EXIST 01458000 SPACE 01459000 DBLBND DC X'00FFFFF8' MASK FOR DBL WD ALIGN 01460000 ALAST DC X'00010000' END OF TRANSIENT AREA @V305665 01461000 ADTRANS DC X'0000E000' START OF TRANSIENT AREA @V305665 01462000 EJECT 01463000 DROP R8 @V305665 01464000 USING RELDR,0 GET HALF-WORD DISP FROM RELDR 01465000 USING RELDR+4096,1 @VA02616 01466000 DS 0H 01467000 XTRATBL EQU * @VA05785 01468000 DC S(XBYTE) @VA05785 01469000 DC S(XHALF) @VA05785 01470000 DC S(XCOMSET) @VA05785 01471000 DC S(XFULL) @VA05785 01472000 DC S(XCXD) @VA05785 01473000 DC S(XUNDEF) @VA05785 01474000 DC S(XUNDEF) @VA05785 01475000 DC S(XDBL) @VA05785 01476000 ESDANAL EQU * FOR ESD ANALYSIS 01477000 DC S(C3AA3) 01478000 DC S(ENTESD) 01479000 DC S(C3AH1) 01480000 DC S(BADCRD) 01481000 DC S(C3AA3) TREAT PC AS CSECT 01482000 DC S(COMESD) 01483000 DC S(PRVESD) 01484000 DC S(BADCRD) 01485000 DROP 0,R1 @VA02616 01486000 USING DMSOLD,R8 @V305665 01487000 SPACE 1 01488000 DS 0F 01489000 FAKECXD DC X'FF' 01490000 DC CL7'CXD' 01491000 BLANKS EQU FAKECXD+4 FIELD OF BLANKS 01492000 COMMA EQU X'6B' SPECIAL CHARACTER: ',' @VA12730 01492100 ZEROES DC F'0' FOUR BYTES OF ZEROES @VA12730 01492200 M7 EQU 7 BINARY MASK '0111' @VA12730 01492300 M1 EQU 1 BINARY MASK '0001' @VA12751 01493500 M2 EQU 2 BINARY MASK '0010' @VA12751 01494000 EJECT @VA12751 01494500 LTORG 01495000 SPACE 01496000 PRTRAN DC X'7C7D827E8180807F' 01497000 DC X'000103070504020500000000000000000000000006' 01498000 TRANPR EQU *-X'90'-1 01499000 PCTYPE EQU X'04' PRIVATE CODE INDICATOR @VA04910 01500000 WKEXT EQU X'03' WEAK EXTERN INDICATOR 01501000 EJECT 01502000 ********************************************************************** 01503000 * 01504000 * CONTROL CARD PROCESSOR 01505000 * 01506000 ********************************************************************** 01507000 DS F 01508000 CTLCRD1 EQU * 01509000 SPACE 01510000 LA 1,SPEC SET P-LIST FOR 'SCAN' 01511000 STM R2,R15,APSV+8 SAVE REGS @VA02089 01512000 LA R0,80 SET COUNT TO 80 BYTES 01513000 USING NUCON,R0 01514000 MVC PLISTSAV(256),CMNDLIST SAVE SCAN WORK AREA 01515000 MVC PLISTSAV+256(256),CMNDLIST+256 01516000 L R15,ASCANN GET ADDRESS OF SCAN 01517000 BALR 14,15 AND AWAY WE GO ... 01518000 LM R2,R15,APSV+8 RESTORE REGS @VA02089 01519000 CLC 0(8,1),=CL8'ENTRY' IS IT ENTRY 01520000 BE CTLENT YES 01521000 CLC 0(8,1),=CL8'LIBRARY' IS IT LIBRARY 01522000 BE CTLLIB YES 01523000 MVC CMNDLIST(256),PLISTSAV RESTORE PLIST 01524000 MVC CMNDLIST+256(256),PLISTSAV+256 01525000 TM FLAG2,NOINV DO WE PRINT ILLEGAL CARDS ? 01526000 BC 8,BADCRD YES 01527000 B RD GET NEXT CARD 01528000 SPACE 2 01529000 CTLENT EQU * 01530000 LA R6,CTLRET RETURN FROM TABLE SEARCHING 01531000 MVC ENTNAME,8(R1) SAVE ENTRY NAME 01532000 CTLENT1 EQU * COME HERE IF RESET WAS SPECIFIED 01533000 LA 1,ENTNAME SET ADDRESS OF ENTRY NAME 01534000 LA 2,ENTNO SET 'NOT FOUND' ADDRESS 01535000 BAL 3,SERCH1 SEARCH LOADER TABLES 01536000 CTLENT2 TM FLAGS,RESET RESET 'NAME' IN EFFECT P3093 01537000 BCR 1,R6 YES, IGNORE ENTRY FUNCTION P3093 01538000 ST 12,ENTADR SAVE ADDRESS OF LOADER TABLE ENTRY 01539000 BR R6 RETURN TO CALLER 01540000 ENTNO EQU * 01541000 OI 8(12),X'80' INDICATE ENTRY UNDEFINED 01542000 OI FLAGS,LUNDEF NOTE THAT THERE ARE UNDEFINES 01543000 B CTLENT2 P3093 01544000 CTLRET EQU * 01545000 LA 5,CTLCRD SET I/O MESSAGE NUMBER 01546000 MVC OUTBUF+15(80),SPEC CARD IMAGE 01547000 L R11,ADMSLIO GET LINKAGE TO IO ROUTINE @V305614 01548000 BALR R14,R11 PRINT CONTROL CARD 01549000 CTRESTR MVC CMNDLIST(256),PLISTSAV RESTORE SCAN WORK AREA 01550000 MVC CMNDLIST+256(256),PLISTSAV+256 01551000 B RD PROCESS NEXT CARD 01552000 SPACE 2 01553000 CTLLIB EQU * 01554000 CLI 8(1),C'*' IS IT NON-OBLIGATOEY REFERENCE 01555000 BE NONREF YES 01556000 CLI 8(1),C'(' IS IT NON-OBLIGATORY REFERENCE 01557000 BNE BADCRD NO, CONDIDER IT INVALID 01558000 NONREF EQU * 01559000 LA 11,1 SET A 1 INTO REG. 11 01560000 LA 6,SPEC SCAN FOR ( 01561000 LA R5,SPEC+79 POINT TO END OF CARD P3072 01562000 NONREF1 EQU * 01563000 AR 6,11 INCREMENT 01564000 CR R6,R5 AT END OF CARD P3072 01565000 BH BADCRD YES, SOMETHING WRONG P3072 01566000 CLI 0(6),C'(' IS IT ( 01567000 BNE NONREF1 NO 01568000 NONREF2 EQU * 01569000 MVC OUTBUF(8),=CL8' ' SPACE TO FORM NAME @VA11148 01570000 LA 7,OUTBUF-1 INITIALIZE POINTER 01571000 NONREF3 LA R5,SPEC+79 SET R5 TO END OF CARD P3089 01572000 AR 6,11 INCREMENT 01573000 CR R6,R5 AT END OF CARD P3072 01574000 BH BADCRD YES, SOMETHING WRONG P3072 01575000 AR 7,11 INCREMENT 01576000 CLI 0(6),C',' END OF NAME? 01577000 BE NONREFM YES 01578000 CLI 0(6),C')' END OF CONTROL CARD? 01579000 BE NONREFN YES 01580000 MVC 0(1,7),0(6) MOVE CHARACTER 01581000 B NONREF3 GET NEXT CHARACTER 01582000 SPACE 01583000 NONREFM EQU * 01584000 BAL 7,NONREFX MARK ENTRY 01585000 B NONREF2 GET NEXT ENTRY 01586000 SPACE 01587000 NONREFN EQU * 01588000 BAL 7,NONREFX MARK LAST ENTRY 01589000 B CTLRET PRINT CONTROL CARD 01590000 SPACE 01591000 NONREFX EQU * 01592000 LA 1,OUTBUF SET ADDR. OF ENTRY NAME 01593000 LA 2,NONREFNT SET 'NOT FOUND' RETURN 01594000 BAL 3,SERCH1 SEARCH LOADER TABLE 01595000 TM 8(12),X'80' IS IT DEFINED ALREADY 01596000 BZ 0(0,7) YES, TOO LATE TO BOTHER 01597000 TM REFLG2(R12),REFCMD DEFND BY CMD? @VA01699 01598000 BCR 7,R7 OVERRIDE LIBE CARD @VA01699 01599000 OI REFLG1(R12),REFLIB NOTE SKIP LIBE SEARCH @VA01699 01600000 BCR 15,7 RETURN TO CALLER 01601000 NONREFNT EQU * 01602000 OI REFLG1(R12),REFLIB+REFUND 'UNDEFINED' ALSO @VA01699 01603000 BCR 15,7 BACK TO CALLER 01604000 SPACE 01605000 LTORG 01606000 * 01607000 EJECT 01608000 XPRTAB DSECT 01609000 SPACE 01610000 FULLAD DS 64D 01611000 DBLAD DS 32D 01612000 HALFAD DS 16D 01613000 BYTEAD DS 8D 01614000 COMMON DS 1F 01615000 CXDAD DS 1F 01616000 EJECT 01617000 LDRST 01618000 * 01619000 *********************************************************************** 01620000 * 01621000 * NUCLEUS CONSTANT AREA 01622000 * 01623000 *********************************************************************** 01624000 * 01625000 NUCON 01626000 SVCSAVE 01627000 REGEQU @V305665 01628000 END 01629000