ibm:vm370-lib:cp:dmkld00e.assemble_src
Table of Contents
DMKLD00E Source
References
- Fixes Applied : 3
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [HRC031DK]
Source Listing
- DMKLD00E.ASSEMBLE.txt
- LD00E TITLE 'DMKLD00E (CP) VM/370 - RELEASE 6' 00001000
- PUNCH 'SLC 002000' 00002000
- * 00003000
- * THE LOADER HAS BEEN MODIFIED TO HANDLE ASSEMBLER AND 00004000
- * FORTRAN OUTPUT FROM BPS, BOS, AND OS ASSEMBLERS AND 00005000
- * COMPILERS. THE ORDER THE DECKS ARE LOADED IS NOT 00006000
- * IMPORTANT. LOADING WILL START AT X'100' UNLESS 00007000
- * MODIFIED VIA AN 'SLC' CARD. THE LOADER WILL NOT PERMIT 00008000
- * ITSELF OR THE BOTTOM 128 LOCATIONS OF CORE TO BE 00009000
- * OVERLAID BY INCOMING TEXT. IT WILL, HOWEVER, ALLOW 00010000
- * THE DEFINITION OF CONTROL SECTIONS SPANNING THIS AREA. 00011000
- * 00012000
- * MODIFIED FOR BETTER I/O HANDLING AND TO PERMIT CHOICE 00013000
- * OF PRINTER AND READER DYNAMICALLY. ALSO, 'SKIP' OPTION 00014000
- * INCLUDED TO PERMIT SELECTIVE REPLACEMENT OF MODULES 00015000
- * FROM PRESTORED TAPE. NEW CTL CARDS ARE 'RDR XXX', WTR 00016000
- * XXX', AND 'SKIP NAME '. GOOD LUCK! 00017000
- * 00018000
- *********************************************************************** 00019000
- * 00020000
- * THE RELOCATING LOADER CAN LOAD ASSEMBLED 00021000
- * PROGRAM MODULES INTO STORAGE AT LOCATIONS 00022000
- * OTHER THAN THOSE ASSIGNED BY THE ASSEMBLER-- 00023000
- * IT COMPLETES LINKAGE AMONG THE MODULES SO 00024000
- * THAT ONE PROGRAM MODULE MAY REFER TO ANOTH- 00025000
- * ER-- IT ALLOWS CORRECTIONS OR ADDITIONS TO 00026000
- * BE MADE TO THE PROGRAM AT LOAD TIME-- AND IT 00027000
- * TRANSFERS CONTROL TO ONE OF THE LOADED 00028000
- * MODULES FOR EXECUTION. 00029000
- * 00030000
- * THE OPERATION OF THIS PROGRAM, EXCEPT AS 00031000
- * NOTED BELOW, DEPENDS UPON AN INTERNAL REPRE- 00032000
- * SENTATION OF THE EXTERNAL CHARACTER SET 00033000
- * WHICH IS EQUIVALENT TO THE ONE USED AT AS- 00034000
- * SEMBLY TIME. THE CODING HAS BEEN ARRANGED SO 00035000
- * THAT REDEFINITION OF CHARACTER CONSTANTS, BY 00036000
- * REASSEMBLY, WILL RESULT IN A CORRECT MODULE 00037000
- * FOR THE NEW DEFINITIONS. 00038000
- * 00039000
- * THOSE STATEMENTS MARKED WITH AN * 00040000
- * 71 BELOW DO NOT DEPEND UPON A PARTICULAR IN- 00041000
- * TERNAL REPRESENTATION OF THE EXTERNAL CHAR- 00042000
- * ACTER SET EXCEPT THAT THE DECIMAL NUMBERS 00043000
- * MUST BE CODED SO THAT THE LOW ORDER FOUR 00044000
- * BITS, WHEN CONSIDERED AS A BINARY INTEGER, 00045000
- * IDENTIFY THE VALUE OF THAT DIGIT. 00046000
- * 00047000
- * THE CONSTANT MARKED WITH A DOUBLE * 00048000
- * COLUMNS 70 AND 71 REPRESENT THE DIFFERENCE 00049000
- * BETWEEN THE HEXIDECIMAL VALUE OF THE NUMBER 00050000
- * A AND THE INTERNAL BINARY VALUE OF THE CHAR- 00051000
- * ACTER A, AND MUST BE ALTERED SHOULD THE IN- 00052000
- * TERNAL REPRESENTATIONS OF THE LETTERS A 00053000
- * THROUGH F CHANGE. 00054000
- * 00055000
- * THE CONSTANTS WITH *** IN COL. 00056000
- * THE X'02' EQUAL A T-2-9 PUNCH AND MUST BE 00057000
- * MODIFIED IF THE PROPERTIES OF THE CHARACTER 00058000
- * SET ARE CHANGED. 00059000
- * 00060000
- *********************************************************************** 00061000
- EJECT 00062000
- RELDR START 8192 00063000
- ENTRY LDRGEN 00064000
- ALPHA DS 0D 00065000
- DS 0D ALIGNMENT 00066000
- * 00067000
- MON EQU * 00068000
- * 00069000
- *********************************************************************** 00070000
- * 00071000
- * APOINT - ADD TO THE POINTER TABLES 00072000
- * 00073000
- * THIS ROUTINE ADDS TO THE STRING OF LOCATIONS WAITING FOR 00074000
- * AN UNDEFINED SYMBOL TO BE DEFINED (BY AN ENTRY POINT OR 00075000
- * AN ICS CARD) 00076000
- * IT IS REACHED BY A BRANCH FROM THE RLD SUBROUTINE 00077000
- * 00078000
- * REGISTER USE 00079000
- * 00080000
- * 3. LOCATION AT WHICH CONSTANT SHOULD BE STORED 00081000
- * 4. CURRENT VALUE OF CONSTANT 00082000
- * 5. BYTE COUNT - 1 (LENGTH OF CONSTANT) 00083000
- * 10. POINTER TO FLAG BYTE 00084000
- * 11. ONE 00085000
- * 12. ENTRY OF SYMBOL IN REFTBL 00086000
- * 13. SAVE AREA LOCATION 00087000
- * 14. RETURN LOCATION 00088000
- * 00089000
- *********************************************************************** 00090000
- * 00091000
- APOINT STM 0,15,APSV(13) 00092000
- BALR 6,0 00093000
- USING *,6 ESTABLISH ADDRESSABILITY 00094000
- L 9,SECBASE 00095000
- L 6,RLDR 00096000
- USING RELDR,6,9 00097000
- SR 2,2 ZERO OUT REGISTER 2 00098000
- LA 0,2 LOAD REG 0 WITH TWO 00099000
- CR 5,0 IS BYTE COUNT EQUAL TO THREE 00100000
- BC 8,APOIN9 YES 00101000
- LA 3,0(,3) INSURE THAT FIRST BYTE IS ALL ZERO 00102000
- O 3,ONEBIT NO - SET A MINUS BIT IN LOC. POINTER 00103000
- APOIN9 NC 13(3,12),13(12) ANY MORE BLOCKS 00104000
- BZ APOIN1 00105000
- L 12,12(,12) 00106000
- B APOIN9 00107000
- APOIN1 L 15,AFREE YES - GET TWO DOUBLE WORDS OF STORAGE 00108000
- BALR 14,15 00109000
- O 1,12(,12) LEAVE COMP. FLAG INTACT 00110000
- ST 1,12(,12) STORE THE LOCATION OF THE DOUBLE WORDS 00111000
- ST 4,0(,1) IN POINTER AND STORE CONSTANT 00112000
- ST 3,4(,1) SET UP FIRST LOCATION POINTER 00113000
- ST 3,8(,1) AND LAST LOCATION POINTER 00114000
- ST 2,12(,1) MAKE POINTER TO NEXT BLOCK EQUAL ZERO 00115000
- TM 0(10),X'02' IS COMP. FLAG ON 00116000
- BC 8,APOIN2 NO 00117000
- MVI 12(1),X'02' 00118000
- APOIN2 LM 0,15,APSV(13) RESTORE REGISTERS 00119000
- BCR 15,14 AND RETURN TO CALLER 00120000
- RLDR DC A(RELDR) 00121000
- SECBASE DC A(RELDR+4096) 00122000
- * 00123000
- DROP 6 00124000
- EJECT 00125000
- *********************************************************************** 00126000
- * 00127000
- * ADDEF - SUBROUTINE TO REMOVE UNDEFINED BIT FROM REFTBL AND 00128000
- * REPLACE THE STRING ADDRESSES WITH THEIR PROPER VALUE 00129000
- * 00130000
- * REGISTER SETTINGS UPON ENTRY 00131000
- * 1. ABSOLUTE LOCATION OF SYMBOL 00132000
- * 12. ENTRY POINT IN REFTBL 00133000
- * 13. SAVE AREA LOCATION 00134000
- * 14. RETURN 00135000
- * 00136000
- *********************************************************************** 00137000
- * 00138000
- ADDEF TM 8(12),X'80' IS UNDEFINED BIT ON 00139000
- BCR 8,14 NO - RETURN TO CALLER 00140000
- NI 8(12),X'7F' YES - TURN IT OFF 00141000
- L 10,12(,12) POINTER TO FIRST CONSTANT 00142000
- LTR 10,10 IS THERE A POINTER 00143000
- BCR 8,14 NO - RETURN TO CALLER 00144000
- STM 0,15,APSV(13) YES - SAVE REGISTERS 00145000
- BALR 11,0 ESTABLISH ADDRESSABILITY 00146000
- USING *,11 00147000
- SR 2,2 ZERO OUT REG 2 00148000
- LR 3,1 PUT ABS LOCATION IN REG 3 00149000
- ADDEF7 LR 6,10 SAVE POINTER TO FIRST CONSTANT 00150000
- L 8,4(,10) ADCON CORE LOC. 00151000
- LTR 8,8 00152000
- BM GETVAL4 4 BYPE 00153000
- MVC 1(3,10),0(8) GET 3-BYTE VALUE 00154000
- B EVAL 00155000
- GETVAL4 MVC 0(4,10),0(8) GET 4-BYTE VALUE 00156000
- EVAL DS 0H 00157000
- LM 7,10,0(10) REG 7 CONTAINS THE CONSTANT 00158000
- * REG 8 HAS FIRST MEM LOCATION 00159000
- * REG 9 HAS LAST MEM LOCATION 00160000
- * REG 10 HAS POINTER TO NEXT CONSTANT 00161000
- LR 5,9 LOAD REG 5 WITH LAST MEN LOCATION 00162000
- L 9,APSV+36(13) RESTORE 2ND BASE REG. 00163000
- TM 12(6),X'02' IS COMP. FLAG ON 00164000
- BC 8,ADDEF1 NO 00165000
- SR 7,3 00166000
- ST 7,TEMPST(,13) STORE LOCATION TEMPORARILY 00167000
- BC 15,ADDEF2 00168000
- ADDEF1 AR 7,3 VALUE OF THE SYMBOL 00169000
- ST 7,TEMPST(,13) STORE VALUE TEMPORARILY 00170000
- ADDEF2 LTR 8,8 IS THE LOCATION FOUR BYTES LONG 00171000
- BC 4,ADDEF8 YES - BRANCH 00172000
- MVC TMPLOC+1(3,13),0(8) N0 - MOVE ADDRESS PTR 00173000
- TM TMPLOC+1(13),X'80' IS NEXT ADDR 4 BYTES 00174000
- BC 7,SIGN YES 00175000
- NI TMPLOC(13),0 00176000
- ADDMOV MVC 0(3,8),TEMPST+1(13) MOVE IN CONST 00177000
- BC 15,ADDEF9 AND CHECK NEXT ADDR 00178000
- SIGN OI TMPLOC(13),X'80' TURN ON SIGN BIT 00179000
- NI TMPLOC+1(13),X'7F' AND TURN OFF SIGN BIT IN 00180000
- * SECOND BYTE. 00181000
- BC 15,ADDMOV GO MOVE IN CONSTANT 00182000
- ADDEF8 MVC TMPLOC(4,13),0(8) MOVE NEW ADDRESS TO TEMP LOC. 00183000
- MVC 0(4,8),TEMPST(13) MOVE IN CONSTANT 00184000
- ADDEF9 CLR 8,5 00185000
- BC 8,ADDEF6 YES - PICK UP POINTER TO NEXT CPMSTAMT 00186000
- L 8,TMPLOC(,13) NO - PICK UP NEXT MEMORY LOCATION 00187000
- BC 15,ADDEF2 AND GO WORK ON NEXT LOCATION 00188000
- ADDEF6 LA 0,2 NO OF DOUBLE WORDS TO GIVE BACK 00189000
- LR 1,6 LOCATION WE ARE THROUGH WITH 00190000
- L 15,AFRETX 00191000
- BALR 14,15 AND BRANCH TO FRET 00192000
- LA 10,0(,10) 00193000
- LTR 10,10 00194000
- BC 7,ADDEF7 NO - GO TO NEXT AREA 00195000
- LM 0,15,APSV(13) YES - RESTORE REGISTERS 00196000
- BCR 15,14 AND RETURN 00197000
- * 00198000
- DROP 11 00199000
- EJECT 00200000
- ********************************************************************** 00201000
- * 00202000
- * HEX-BINARY CONVERSION ROUTINE 00203000
- * 00204000
- * PLACE THE NUMBER OF CHARACTERS IN REG 4 00205000
- * ADDRESS OF HIGH ORDER IN REG 5 00206000
- * LINKAGE-- L 1,HEXADD 00207000
- * RETURN ADDRESS IN REG 0. 00208000
- * BALR 0,1 00209000
- * ANSWER RETURNED IN REG 0 00210000
- * 00211000
- * 00212000
- ********************************************************************** 00213000
- * 00214000
- HEXB EQU * 00215000
- USING HEXB,1 00216000
- ST 0,RETT(,13) 00217000
- SR 3,3 00218000
- LR 0,3 00219000
- LA 2,ERR2 00220000
- L1 CLI 0(5),C'0' CMP TO VALUE OF ZERO 00221000
- BC 4,L3 BR IF NOT 0 THRU 9 00222000
- CLI 0(5),C'9' CMP TO VALUE OF NINE 00223000
- BCR 3,2 ERROR. 00224000
- * CLEAR HIGH ORDER BITS OF CHAR 00225000
- NI 0(5),X'0F' * 00226000
- IC 3,0(0,5) * 00227000
- L2 SLL 0,4 * 00228000
- AR 0,3 * 00229000
- LA 5,1(,5) 00230000
- BCT 4,L1 00231000
- L 2,RETT(,13) 00232000
- BCR 15,2 00233000
- L3 CLI 0(5),C'A' 00234000
- BCR 4,2 BR IF VALUE LESS 00235000
- CLI 0(5),C'F' 00236000
- BCR 3,2 ERROR. 00237000
- IC 3,0(0,5) 00238000
- SH 3,CONST 00239000
- BC 15,L2 00240000
- ERR2 MVC CDIMJ(80),SPEC(13) 00241000
- LA 7,SPEC+5(,13) LET REGISTER FIVE HOLD NO. OF POSITIONS 00242000
- SR 5,7 IN REP CARD TO BLANK OUT FOR PRINTING 00243000
- MVI SPEC+5(13),C' ' MOVE IN ONE BLANK 00244000
- LTR 5,5 ARE THERE ANY MORE TO MOVE 00245000
- BC 4,LDERRA NO - GO PRINT ERROR MESSAGE 00246000
- EX 5,MVC4 YES - MOVE IN REMAINING BLANKS 00247000
- LDERRA LA 5,ERRORA 00248000
- BAL R14,ERPRNT BAD CONVERSION 00249000
- BAL R14,PAGER EJECT PAGE 00250000
- SVC 100 DIE... 00251000
- * 00252000
- MVC4 MVC SPEC+6(1,13),SPEC+5(13) 00253000
- * 00254000
- DS 0H 00255000
- * 00256000
- CONST DC X'00B7' 00257000
- * 00258000
- DROP 1 00259000
- EJECT 00260000
- *********************************************************************** 00261000
- * 00262000
- * ROUTINE TO EXTEND MEMORY BOUND DOWN 00263000
- * 00264000
- *********************************************************************** 00265000
- * 00266000
- USING *,15 00267000
- * 00268000
- EXTEND STM 6,7,EPSW 00269000
- L 15,BREG1 ESTABLISH GOOD ADDRESSABILITY. 00270000
- USING RELDR,15 00271000
- CLI CNTR,0 00272000
- BC 8,FIRST YES 00273000
- L 7,HILOW LOAD HIGHEST LOCATION USED BELOW LOADER. 00274000
- L 6,FREEST(,13) AND LOWER BOUND OF FREE STORAGE 00275000
- S 6,ONTHOU 00276000
- S 6,F32 DROP THE LOWER BOUNDARY BY 4 DW'S 00277000
- A 7,TWTHOU ALLOW TWO-THOUSAND MORE BYTES FOR TEXT 00278000
- CR 6,7 ENOUGH ROOM FOR MORE FREE STORAGE 00279000
- BC 12,NOMORE NO - COMPLAIN 00280000
- LA 0,1000 NO OF BYTES 00281000
- LR 1,6 ADDRESS OF START OF DOUBLE WORDS 00282000
- ST 1,FREEST(,13) 00283000
- ST 1,BELOW 00284000
- ERET LM 6,7,EPSW 00285000
- BCR 15,14 00286000
- * 00287000
- FIRST L 1,TOP 00288000
- L 0,AMAXREF MAX NO. OF UNRESOLVED REF. 00289000
- SLL 0,4 00290000
- SR 1,0 00291000
- LA 0,1264 00292000
- SR 1,0 00293000
- S 1,F32 00294000
- ST 1,T1 00295000
- MVI CNTR,1 00296000
- BCR 15,14 00297000
- * 00298000
- NOMORE LA 5,ERRORO 00299000
- BAL R14,ERPRNT NO FREE STORAGE LEFT 00300000
- BAL R14,PAGER EJECT PAGE 00301000
- SVC 101 DIE... 00302000
- ONTHOU DC F'1000' 00303000
- TWTHOU DC F'2000' 00304000
- EPSW DS 2F 00305000
- CNTR DC X'00' 00306000
- T1 DS 1F .. 00307000
- HILOW DC F'0' HIGHEST LOCATION USED BELOW LOADER. 00308000
- F32 DC F'32' CONSTANT 00309000
- EJECT 00310000
- *********************************************************************** 00311000
- * 00312000
- * PROGRAM INITIAL LOADING ENTRY 00313000
- * 00314000
- * 00315000
- * SWS(13) BIT POSITION 0 = ABS LOAD FLAG 00316000
- * 1 = FTTR1 FLAG - FIRST TIME TRANSFER 00317000
- * 2 = NO HEX ADDR IN SLC CARD 00318000
- * 3 = END CRD ADDR SAVED 00319000
- * 4 = TWO OR MORE REP ENTRIES IN CRD 00320000
- * 00321000
- *********************************************************************** 00322000
- * 00323000
- LOAD2 BALR 15,0 00324000
- USING *,15 00325000
- L 9,BASE 00326000
- L 15,BREG1 00327000
- USING RELDR,15,9 00328000
- MVI DEVSW,X'01' 00329000
- XC SWS(2),SWS CLEAR SWITCH SETTINGS. 00330000
- LA 1,0 TABLE COUNT INITIALLY 00331000
- STH 1,TBLCT(,13) .. 00332000
- L 11,CTRSET 00333000
- ST 11,LOCCT(,13) STARTING LOCTION TO LOAD SAVED 00334000
- EJECT 00335000
- *********************************************************************** 00336000
- * 00337000
- * RESUME LOADING ENTRY 00338000
- * 00339000
- *********************************************************************** 00340000
- * 00341000
- OVRLDR EQU * 00342000
- RESUME BALR 15,0 00343000
- USING *,15 00344000
- L 15,BREG1 00345000
- USING RELDR,15 00346000
- SR 1,1 00347000
- ST 1,BRAD(,13) 00348000
- MVI SWS,ABS+ENDB+FTTR1 TURN ON BITS. 00349000
- SSM CH0OFF NO INTERRUPTS PLEASE @V60B9BA 00349100
- LH 2,PRNTR GET THE PRINTER ADDRESS @V60B9BA 00349200
- MVC ZCAW(4),INITCCW GET INITIALIZE PRINTER CCW @V60B9BA 00349300
- TIO 0(2) CLEAR THE PATH @V60B9BA 00349400
- BC 2,*-4 KEEP ON UNTIL IT'S CLEAR @V60B9BA 00349500
- SIO 0(2) DO THE INITIALIZE PRINTER @V60B9BA 00349600
- BC 4+1,RD FORGET ABOUT IT, THEN @V60B9BA 00349700
- TIO 0(2) WAIT TILL THE INTERRUPT CLEARS @V60B9BA 00349800
- BNZ *-4 ... @V60B9BA 00349900
- RD EQU * 00350000
- LOOP L 1,LOCCT(,13) CHECK FOR HIGHEST LOCATION BELOW LOADER. 00351000
- C 1,LEND AND SEE IF IT HAS CHANGED. BRANCH IF 00352000
- BC 2,LOOP1 LOCATION COUNTER IS ABOVE LOADER. 00353000
- C 1,HILOW .. 00354000
- BC 4,LOOP1 NO CHANGE. 00355000
- ST 1,HILOW UPDATE HIGHEST LOCATION USED BELOW LDR. 00356000
- LOOP1 BAL 10,LOOP2 BRANCH TO START I/O 00357000
- B CONTIN CONTINUE 00358000
- LOOP2 MVC ZCAW(4),RDCCW READ CONTROL WORD TO LOWER CORE. 00359000
- SIO2 SSM CH0OFF TURN OFF MULTIPLEX CHANNEL 00360000
- LH 2,READER 00361000
- SIO 0(2) START INPUT OPERATION 00362000
- BC 8,WAITXX CHECK FOR SUCCESS - IF 0 EVERYTHING O.K 00363000
- BC 4,WAIT1 CSW STORED 00364000
- BC 2,WAIT5 BUSY 00365000
- NOTOP1 LA 5,RETYRD INTERVENTION REQUIRED 00366000
- MVC PRNTR(2),CNSL SET UP TO PRINT MSG ON CONSOLE 00367000
- BAL 14,ERPRNT GO TELL USER 00368000
- BAL 14,PAGER SKIP TO NEW PAGE ON PRINTER 00369000
- MVC PRNTR(2),PRNTSET RESTORE PRNTR ADDRESS 00370000
- WAIT7 MVC ZIONP+2(2),READER SET UP FOR DEVICE END 00371000
- CNOP 4,8 00372000
- WAIT2 LPSW *+4 00373000
- DC X'FF020000' WAIT FOR INTERRUPT 00374000
- WAIT2AD DC A(LOOP2) AND THEN RETRY READ 00375000
- SPACE 2 00376000
- WAIT5 STH 2,ZIONP+2 WAIT FOR ANY INTERRUPT ON THIS CNANNEL 00377000
- OI ZIONP+2,X'80' 00378000
- B WAIT2 00379000
- SPACE 3 00380000
- WAIT1 TM ZCSW+4,X'02' IS IT UNIT CHECK 00381000
- BC 1,NOTOP1 YES - INTERVENTION REQUIRED 00382000
- TM ZCSW+4,X'14' IS IT BUSY 00383000
- BC 1,LOOP2 NOT ANY MORE 00384000
- BC 4,WAIT7 YES - WAIT TO READ 00385000
- TM ZCSW+4,X'01' IS IT END OF FILE 00386000
- BC 1,C6AC3 YES - ENTER LDT PROCESSOR 00387000
- SPACE 3 00388000
- WAIT6 BAL 14,PAGER EJECT PAGE - WAIT FOR OPERATOR. 00389000
- CNOP 4,8 .. 00390000
- LPSW *+4 .. 00391000
- DC X'00020000' 00392000
- DC 4X'CC' 00393000
- SPACE 3 00394000
- CNOP 0,8 -ALIGNMENT- 00395000
- * 00396000
- WAITXX STH 2,ZIONP+2 00397000
- LPSW *+4 00398000
- DC X'FE020000' 00399000
- WAITXXAD DC A(*+4) PROCEED WHEN INPUT OPERATION FINISHED. 00400000
- CLC ZIOOP+2(2),ZIONP+2 00401000
- BNE WAITXX 00402000
- TM ZCSW+4,1 END-OF-FILE? 00403000
- BC 1,C6AC3 YES - BRANCH 00404000
- TM ZCSW+4,X'02' WAS THERE A VALIDITY CHECK 00405000
- BCR 8,10 NO -GO PROCESS 00406000
- CLI ERETRYSW,X'80' IS THE ERROR RETRY SWITCH ON 00407000
- BE TAPERR YES ISSUE SENSE COMMAND 00408000
- STM 2,9,ERRSAV SAVE REGS 00409000
- B TAPERR BRANCH TO TAPE ERROR ROUTINE 00410000
- NOISERTN LM 2,9,ERRSAV RESTORE REGS 00411000
- MVI ERETRYSW,X'00' RESET SWITCH 00412000
- B LOOP1 00413000
- CONTINUE LM 2,9,ERRSAV RESTORE REGS 00414000
- B CONTIN 00415000
- CARDRTN LM 2,9,ERRSAV RESTORE REGS 00416000
- MVI ERETRYSW,X'00' RESET SWITCH 00417000
- CONTCARD LA 5,VALCHK YES SEND A MSG TO THE USER 00418000
- TIO 0(2) DRAIN THE READER 00419000
- TM ZCSW+4,X'10' 00420000
- BC 1,*-8 UNTIL NOT BUSY 00421000
- LA 14,NOTOP1 AND THEN WAIT FOR USER TO 00422000
- BC 15,ERPRNT CORRECT ERROR BEFORE WE REREAD 00423000
- CONTIN SR 6,6 00424000
- LA 11,1 REGISTER 11 ALWAYS SET TO 1 00425000
- L 1,SPEC(,13) 00426000
- TM SWS+1,ENDFLG IS FLUSH-TO-END SWITCH ON 00427000
- BC 1,FLUSH YES - BRANCH 00428000
- TM DEVSW,X'01' 00429000
- BO DEVHNDLR 00430000
- CONTINU C 1,SLC 00431000
- BNE C2AE2 00432000
- BC 15,C2AD1 00433000
- FLUSH C 1,END ALL OVER IF THIS IS THE END 00434000
- BC 7,RD NOT SO 00435000
- MVC READER(2),RDR RESTORE THE READER 00436000
- NI SWS+1,255-ENDFLG CLEAR FLAG 00437000
- BC 15,RD AND CONTINUE 00438000
- EJECT 00439000
- *********************************************************************** 00440000
- * 00441000
- * SET LOCATION COUNTER ROUTINE (SLC) 00442000
- * THIS ROUTINE HAS TWO ENTRIES 00443000
- * (1) AT THE BEGINNING WHEN RESUME FALLS THRU 00444000
- * (2) ORG2- USED TO OBTAIN THE CURRENT ADDRESS OF A GIVEN 00445000
- * SYMBOLIC LOCATION. 00446000
- * THIS ROUTINE SETS THE LOCATION COUNTER TO THE SLC- 00447000
- * CARD SPECIFIED ADDRESS AND/OR OBTAINS THE CURRENT 00448000
- * ADDRESS OF A GIVEN SYMBOLIC LOC. FROM THE REFTBL TABLE. 00449000
- * NOTE THAT IF NO ABS LOC IS PUNCHED AND THE SYMBOLIC NAME 00450000
- * IS AS YET UNDEFINED, AN ERROR IS CREATED. 00451000
- * 00452000
- *********************************************************************** 00453000
- * 00454000
- C2AD1 CLI SPEC+6(13),C' ' CMP ADDR FOR BLANKS 00455000
- BC 7,C2AD BR- ADDR IN CRD 00456000
- OI SWS,BRSW NO ADDRESS - TURN ON SWITCH. 00457000
- BC 15,C2A 00458000
- C2AD LA 4,6(0,0) CONVERT ADDR TO BINARY 00459000
- LA 5,SPEC+6(,13) 00460000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00461000
- BALR 0,1 BR TO HEXB ROUTINE 00462000
- LR 6,0 SAVE ADDR IN REGISTER 00463000
- C2A CLI SPEC+16(13),C' ' TEST IMAGE FOR NAME 00464000
- * SYMBOL IS LEFT ADJUSTED 00465000
- BC 7,C2AE3 BR- NAME IN CRD 00466000
- LA 5,ERRORA 00467000
- MVC CDIMJ(80),SPEC(13) 00468000
- LA 14,RD 00469000
- TM SWS,BRSW 00470000
- BC 1,ERPRNT 00471000
- SR 0,0 00472000
- C2X NI SWS,255-BRSW TURN OFF SWITCH. 00473000
- AR 6,0 ADD CONVERTED ADDR TO ORG2 00474000
- ST 6,LOCCT(,13) SET THE LOCATION COUNTER 00475000
- B RD RETURN TO READ A CARD. 00476000
- C2AE3 LA 2,ERRSLC 00477000
- BAL 3,SERCH 00478000
- LA 14,C2X LINK AGE 00479000
- ORG2 L 0,8(0,12) THE ABSOLUTE LOCATION 00480000
- BCR 15,14 00481000
- ERRSLC LH 3,TBLCT(,13) 00482000
- SR 3,11 00483000
- STH 3,TBLCT(,13) 00484000
- LA 5,ERRORU 00485000
- MVC ERRU(8),0(12) 00486000
- LA 14,RD 00487000
- BC 15,ERPRNT 00488000
- EJECT 00489000
- * SET PAGE BOUNDRY ROUTINE (SPB) 00490000
- * THIS ROUTINE ROUNDS THE LOCATION COUNTER 00491000
- * TO THE NEAREST HIGHER PAGE BOUNDRY 00492000
- C2AE2 C 1,SPB 00493000
- BNE C2AE1 00494000
- L 1,LOCCT(,13) 00495000
- LA 1,4095(,1) 00496000
- N 1,PAGENO 00497000
- ST 1,LOCCT(,13) 00498000
- B RD 00499000
- EJECT 00500000
- *********************************************************************** 00501000
- * 00502000
- * INCLUDE CONTROL SECTION 00503000
- * ROUTINE (ICS) 00504000
- * 00505000
- *********************************************************************** 00506000
- * 00507000
- C2AE1 C 1,ICS 00508000
- BC 7,C3AA1 BR NO 00509000
- LA 5,ERRORA 00510000
- MVC CDIMJ(80),SPEC(13) 00511000
- LA 14,RD 00512000
- CLI SPEC+24(13),C' ' TEST FOR HEX ADDR 00513000
- BC 8,ERPRNT 00514000
- LA 4,4 00515000
- LA 5,SPEC+24(,13) TO BINARY 00516000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00517000
- BALR 0,1 BR TO HEXB 00518000
- LR 6,0 SAVE LENGTH IN REG 00519000
- LA 14,RD LOAD LINKAGE TO BRANCH TO RD WHEN DONE 00520000
- LA 3,SYMDEF IF NAME IN REFTBL, IS IT DEFINED 00521000
- BAL 2,SERCH 00522000
- * ENTERED C2AJ1 FROM ESD00 ROUTINE 00523000
- C2AJ1 L 1,LOCCT(,13) LOD PRESENT LOCATION 00524000
- LTR 6,6 IS THE SEGMENT LENGTH EQUAL TO ZERO 00525000
- BC 8,C2AJ4 YES - BRANCH OUT 00526000
- ADJ TM LOCCT+3(13),X'07' TEST FOR MULT OF EIGHT 00527000
- BC 8,C2AJ4 BR YES 00528000
- AR 1,11 ADD ONE 00529000
- ST 1,LOCCT(,13) 00530000
- BC 15,ADJ 00531000
- C2AJ4 LR 7,14 TEST FOR UNDEFINED BIT 00532000
- L 5,AADDEF AND DEFINE IF NECESSARY 00533000
- BALR 14,5 00534000
- STOABS ST 1,8(,12) STORE VALUE OF LOCCT IN REFTBL 00535000
- AR 1,6 UPDATE LOCCT 00536000
- ST 1,LOCCT(,13) 00537000
- MVC LOC1(8),0(12) MOVE NAME TO PRINT STATEMENT 00538000
- UNPK LOC1+12(7),9(4,12) 00539000
- TR LOC1+12(8),DMPTBL-240 TRANSLATE LOCATION INTO EBCD 00540000
- MVC LOC1+18(20),ORAREA CLEAR PRINT AREA 00541000
- MVC LOC1+38(11),ORAREA ... 00542000
- CLI SPEC+24(R13),X'00' ESD TYPE 0 CARD ? 00543000
- BNE NOTESD0 NO 00544000
- MVC LOC1+24(21),ESDHDR MOVE IN ESD HEADING INFORMATION 00545000
- UNPK LOC1+39(7),SPEC+29(4,R13) UNPACK THE LENGTH 00546000
- TR LOC1+39(8),DMPTBL-240 TRANSLATE PRINTABLE 00547000
- NOTESD0 EQU * HERE IF NOT ESD TYPE 0 00548000
- LA 5,ERRORL 00549000
- BAL 14,ERPRNT AND GO PRINT PIECE OF LOADER MAP 00550000
- MVC LOC1+18(20),ORAREA CLEAR PRINT AREA 00551000
- MVC LOC1+38(9),ORAREA .... 00552000
- LR 14,7 00553000
- SR 6,6 00554000
- BCR 15,14 RETURNS TO RD OR C3AD4 (IN ESD T-0) 00555000
- SYMDEF TM 8(12),X'80' IS UNDEFINED BIT ON 00556000
- BCR 8,14 IF DEFINED, IGNORE ICS CARD 00557000
- BC 15,C2AJ1 YES - ALIGN ABS ADDR OF PROGRAM ON DOUBL 00558000
- * WORD BOUNDARY AND GO GET NEXT CARD 00559000
- EJECT 00560000
- *********************************************************************** 00561000
- * 00562000
- * DETERMINE IF ESD TYPE CARD 00563000
- * 00564000
- *********************************************************************** 00565000
- * 00566000
- C3AA1 C 1,ESD 00567000
- BC 7,C4AA1 NO- TEST FOR TXT CRD 00568000
- CA3A1 NI SPEC+24(13),X'0F' 00569000
- CLI SPEC+24(13),X'00' * 00570000
- BZ C3AA3 (SD)-- ESD TYPE 0 @VA04840 00571500
- LA 5,ERRORA 00574000
- MVC CDIMJ(80),SPEC(13) 00575000
- LA 14,RD 00576000
- * VALID ESD TEST 00577000
- CLI SPEC+24(13),X'03' * 00578000
- BC 10,ERPRNT 00579000
- CLI SPEC+24(13),X'02' * 00580000
- BC 10,C3AH1 BR, EXTERNAL SYMBOL ESD 00581000
- EJECT 00582000
- *********************************************************************** 00583000
- * 00584000
- * ESD TYPE 1 ROUTINE (ENTRY) 00585000
- * 00586000
- *********************************************************************** 00587000
- * 00588000
- LH 3,SPEC+30(,13) LOAD EXTERNAL SYMBOL ID NO. 00589000
- BAL 14,REFADR OBTAINS ADDR OF THE ENTRY IN REFTBL 00590000
- STC 6,SPEC+24(,13) 00591000
- L 7,12(,12) LOAD REL FACTOR OF CONTROL SEGMENT 00592000
- A 7,SPEC+24(,13) FORM ENTRY POINT 00593000
- LA 2,C3AD1 NOT FOUND RETURN 00594000
- BAL 3,SERCH SEARCH FOR NAME IN REFTBL 00595000
- L 0,8(,12) LOAD RELOCATED ADDRESS 00596000
- LA 5,ERRORD 00597000
- MVC ERRD(8),0(12) 00598000
- TM 8(12),X'80' IS ENTRY DEFINED 00599000
- BC 1,C3AD2 NO - DEFINE IT 00600000
- CR 7,0 YES - CMP ORG2 TO GENERATED ADDR 00601000
- BE GOODCMP 00602000
- BAL R14,ERPRNT PRINT BAD NEWS 00603000
- DUPESD BAL R14,PAGER EJECT PAGE @VA08186 00604100
- SVC 102 DIE ..... 00605000
- GOODCMP MVC NAME,0(12) MOVE ENTRY NAME TO ERROR MESSAGE 00606000
- LA 5,ERRORM DUPLICATE IDENTIFIER-FATAL ERROR @VA08186 00607100
- BAL 14,ERPRNT 00608000
- BC 15,DUPESD DUPLICATE ESD ENTRY @VA08186 00609100
- C3AD2 LR 1,7 LOAD REG 1 FROM 7 00610000
- L 5,AADDEF 00611000
- BALR 14,5 00612000
- ST 1,8(,12) AND UPDATE CORE - STORE ABS ADDR 00613000
- BC 15,PRNT 00614000
- C3AD1 ST 7,8(,12) STORE ABS VALUE IN REFTBL 00615000
- PRNT MVC LOC1(8),0(12) MOVE NAME TO PRINT STATEMENT 00616000
- UNPK LOC1+12(7),9(4,12) 00617000
- TR LOC1+12(8),DMPTBL-240 TRANSLATE LOCATION INTO EBCD 00618000
- MVC LOC1+18(2),ORAREA CLEAR 2 BYTES FROM PRINT LINE 00619000
- LA 5,ERRORL 00620000
- BAL 14,ERPRNT AND GO PRINT PIECE OF LOADER MAP 00621000
- BC 15,ESD00 AND GO CHECK FOR MULTIPLE ENTRIES 00622000
- EJECT 00623000
- *********************************************************************** 00624000
- * 00625000
- * ESD TYPE 0 ROUTINE (SEGMENT NAME) 00626000
- * 00627000
- *********************************************************************** 00628000
- * 00629000
- C3AA3 TM SWS+1,SKPFLG SHOULD WE TEST FOR SKIP? 00630000
- BC 1,SKPTST YES - BRANCH 00631000
- C3AA3B NI SWS,255-ABS TURN OFF ABSOLUTE LOAD FLAG 00632000
- TM SWS,ESDSW HAVE WE SEEN TYPE 0 OR 2 BEFORE. 00633000
- BZ C3AA3A NO. - CONTINUE AS USUAL. 00634000
- LH 2,SPEC+14(,13) BUMP ESID NO. BY ONE FOR EXTRA ENTRIES. 00635000
- LA 2,1(,2) .. 00636000
- STH 2,SPEC+14(,13) .. 00637000
- C3AA3A OI SWS,ESDSW SET ESID SWITCH. 00638000
- LA 2,C3AC3 NAME NOT IN TBL RETURN 00639000
- BAL 3,SERCH SEARCH FOR NAME IN REFTBL 00640000
- TM 8(12),X'80' IS ENTRY DEFINED 00641000
- BC 7,C3AC3 NO - GET STARTING LOCATION 00642000
- MVC NAME,0(12) MOVE ESD NAME TO ERROR MESSAGE 00643000
- LA 5,ERRORM 00644000
- BAL 14,ERPRNT POSSIBLE OVERLAYING OF A PREVIOUS DECK 00645000
- C3AD4 L 0,8(,12) COMPUTE RELOCATION FACTOR 00646000
- LH 2,SPEC+14(,13) LOD ESID 00647000
- SLL 2,1 TIMES 2 FOR HALFWORD ENTRY 00648000
- STH 4,ESIDTB(13,2) REFTBLE POSITION TO ESIDTB(13) 00649000
- SRL 2,1 BACK AGAIN 00650000
- STC 6,SPEC+24(,13) LOD ASSEMBLED ADDR 00651000
- L 2,SPEC+24(,13) 00652000
- CR 0,2 00653000
- BC 5,COMP BR- ORG2 LESS THAN ADDR 00654000
- SR 0,2 00655000
- RELF ST 0,12(,12) SAVE RELOCATION FACTOR 00656000
- BC 15,ESD00 READ ANOTHER CARD 00657000
- COMP SR 2,0 ADDRESS MINUS ORIGIN 00658000
- LCR 0,2 COMPLEMENT (TWOS) 00659000
- BC 15,RELF 00660000
- C3AC3 STC 6,SPEC+28(,13) RETURNED HERE FOR NAME NOT FND 00661000
- L 6,SPEC+28(,13) LOD SEGMENT LENGTH 00662000
- LA R0,XTRSIZE SIZE OF BUFFER FOR EXTRNS 00663000
- L R15,AFREE ADDRESS OF FREE STORAGE ROUTINE 00664000
- BALR R14,R15 CALL FREE FOR STORAGE 00665000
- L R15,BREG1 RESTORE REG-15 00666000
- ST R1,PNTXTR0 REMEMBER ESD TYPE 0 CHAIN @VA04840 00667000
- USING XTRBLOK,R3 ADDRESSABILITY 00668000
- LR R3,R1 PUT IN PROPER REGISTER 00669000
- XC XTRPNT(16),XTRPNT CLEAR OUT ADDRESS POINTER FILES 00670000
- MVI XTRDATA,C' ' CLEAR PRINTER AREA TO BLANKS 00671000
- MVC XTRDATA+1(XTRDATAL-1),XTRDATA ... 00672000
- MVC XTRDATA+26(34),HEADING PUN IN THE HEADING LINE 00673000
- LA R1,XTRDATA ADDRESS WHERE PRINT DATA CAN BE FOUND 00674000
- ST R1,XTRLINE SAVE IT IN THE CONTROL BLOK 00675000
- MVI XTRLEN+1,86 MAKE THIS LINE LOOK LIKE ITS FULL 00676000
- MVC XTRDATA+62(8),0(R12) FILL IN CSECT NAME 00677000
- CLC 0(6,R12),DMKPSA LOADING VM/370 SYSTEM ? 00678000
- BNE *+8 NO- NOT FOUND 00679000
- MVI VM370,X'FF' INDICATE LOADING VM/370 00680000
- CLC 0(6,R12),DMKCPE REACH END OF NUCLEUS YET ? 00681000
- BNE *+12 NO - 00682000
- MVI CPEND,X'FF' FLAG FOR SKIP TO CHANNEL 1 00683000
- MVI ENDNUC,X'FF' INDICATE END OF NUCLEUS HAS BEEN REACHED 00684000
- LA R14,C3AD4 RETURN ADDRESS 00685000
- CLI VM370,X'FF' IS THIS VM/370 OR CMS . 00686000
- BNE C2AJ1 MUST BE CMS 00687000
- CLI ENDNUC,X'FF' REACHED END OF NUCLEUS YET ? 00688000
- BNE C2AJ1 NO - DON'T CHECK SPB YET 00689000
- CLC 0(6,R12),DMKWRM IS THIS DMKWRM ? 00690000
- BE C2AJ1 YES - SKIP OVER PAGE BOUNDARY 00691000
- L R2,LOCCT(,R13) GET LOCATION COUNTER 00692000
- LA R2,4095(,R2) FORCE TO NEXT PAGE BOUNDARY 00693000
- N R2,PAGENO REMOVE THE DISPLACEMENT 00694000
- L R1,LOCCT(,R13) RELOAD LOCATION COUNTER 00695000
- CLR R1,R2 ALREADY ON PAGE BOUNDARY ? 00696000
- BE C2AJ1 YES - DON'T CHECK FURTHER. 00697000
- ADJ1 EQU * @VA01938 00698000
- TM LOCCT+3(13),X'07' TEST FOR DOUBLEWORD BOUNDARY @VA01938 00699000
- BC 8,CKFIT YES, SEE IF IT'LL FIT @VA01938 00700000
- AR 1,11 NO, ADD ONE @VA01938 00701000
- ST 1,LOCCT(,13) @VA01938 00702000
- BC 15,ADJ1 DO IT AGAIN @VA01938 00703000
- CKFIT EQU * @VA01938 00704000
- AR R1,R6 ADD TO IT LENGTH OF THIS MODULE 00705000
- CR R1,R2 SHOULD WE FORCE MODULE TO PAGE BOUNDARY 00706000
- BNH C2AJ1 NO - DID NOT SPILL INTO NEXT PAGE 00707000
- ST R2,LOCCT(,R13) FORCE THIS MODULE TO NEXT PAGE BOUNDARY. 00708000
- MVC XTRDATA+70(15),SPBHDR ALSO FLAG IT. 00709000
- DROP R3 00710000
- B C2AJ1 CONTINUE 00711000
- SPACE 1 00712000
- SPACE 00713000
- SKPTST CLC SPEC+16(8,13),SKPMSG IS THIS THE ONE TO SKIP? 00714000
- BC 7,C3AA3B 00715000
- XI SWS+1,SKPFLG+ENDFLG YES - SKIP TO END CARD 00716000
- BC 15,RD 00717000
- EJECT 00718000
- *********************************************************************** 00719000
- * 00720000
- * ESD TYPE 2 ROUTINE (EXTRN) 00721000
- * THIS ROUTINE HAS TWO ENTRY POINTS. LOC C3AH1 AND LOC ESD00 00722000
- * LOCATION C3AH1 IS ENTERED FROM THE ESD CARD ANALYSIS ROUTINE 00723000
- * LOCATION ESD00 IS ENTERED FROM... 00724000
- * 1. THE ESD CARD ANALYSIS ROUTINE WHEN THE CARD BEING 00725000
- * PROCESSED IS A TYPE 1OR 2 , AND AN ABS LOAD IS INDICATED 00726000
- * 2. THE ESD TYPE 0 ROUTINE AND TYPE 1 ENTER AS THE LAST 00727000
- * STEP OF THESE ROUTINES 00728000
- *********************************************************************** 00729000
- * 00730000
- C3AH1 TM SWS,ESDSW HAVE WEE SEEN TYPE 0 OR 2 ON THIS CARD. 00731000
- BC 8,C3AH3 00732000
- LH 2,SPEC+14(,13) 00733000
- LA 2,1(,2) 00734000
- STH 2,SPEC+14(,13) 00735000
- C3AH3 LA 2,C3AH2 00736000
- OI SWS,ESDSW INDICATE WE HAVE ESD 2 ON THIS CARD. 00737000
- USING XTRBLOK,R3 ADDRESSABILITY 00738000
- L R3,PNTXTR GET POINTER TO LIST OF CHAIN 00739000
- LTR R3,R3 CHAIN EMPTY ? @VA04840 00740100
- BZ FNDONE1 IF YES,ADD NEW BUFFER TO LIST @VA04840 00740150
- SLR R0,R0 CLEAR A COMPARISON REGISTER @VA04840 00740200
- LA R3,PNTXTR YES,POINT TO ANCHOR @VA04840 00740250
- NXTBUF CL R0,0(,R3) ARE WE AT THE END OF THE CHAIN 00741000
- BE FNDONE YES - 00742000
- L R3,0(,R3) NO - KEEP SEARCHING 00743000
- B NXTBUF .. 00744000
- FNDONE CLI XTRLEN+1,XTRFULL IS THIS BUFFER FULL UP ? 00745000
- BNH NOXFREE IF NOT THEN DON'T CALL FREE 00746000
- FNDONE1 LA R0,XTRSIZE SIZE OF EXT BUFFER @VA04840 00747500
- L R15,AFREE ADDRESS OF FREE STORAGE ROUTINE 00748000
- BALR R14,R15 CALL FREE 00749000
- L R15,BREG1 RESTORE REG-15 00750000
- LTR R3,R3 CHAIN EMPTY ? @VA04840 00751100
- BNZ FNDONE2 NO,PATCH TO LAST BUFFER @VA04840 00751200
- ST R1,PNTXTR ELSE,INIT ANCHOR @VA04840 00751300
- B FNDONE3 @VA04840 00751400
- FNDONE2 ST R1,0(,R3) PATCH TO EXISTING CHAIN @VA04840 00751500
- FNDONE3 LR R3,R1 START WORKING W/ NEW BUFR @VA04840 00751600
- XC XTRPNT(16),XTRPNT CLEAR OUT CONTROL DATA POINTERS 00753000
- MVI XTRLEN+1,25 START AT PRINT POSITION 26 00754000
- MVI XTRDATA,C' ' CLEAR PRINTER INFORMATION TO BLANKS 00755000
- MVC XTRDATA+1(XTRDATAL-1),XTRDATA ... 00756000
- LA R0,XTRDATA GET ADDRESS WHERE PRINT DATA WILL GO 00757000
- ST R0,XTRLINE AND SAVE ITS ADDRESS 00758000
- NOXFREE SLR R1,R1 CLEAR 00759000
- LH R1,XTRLEN GET NUMBER OF BYTES IN USE. 00760000
- LA R1,XTRDATA(R1) POINT TO CORRECT BUFFER LOCATION 00761000
- MVC 0(8,R1),SPEC+16(R13) MOVE IN EXTRN NAME 00762000
- LH R1,XTRLEN GET NUMBER OF BYTES AGAIN 00763000
- LA R1,10(,R1) INCREMENT TO NEXT BUFFER LOCATION 00764000
- STH R1,XTRLEN AND STORE IT BACK 00765000
- DROP R3 00766000
- SPACE 00767000
- BAL 3,SERCH SEARCH FOR NAME IN REFTBL 00768000
- LH 2,SPEC+14(,13) LOAD ESID 00769000
- SLL 2,1 TIMES 2 FOR HALFWORD ENTRY 00770000
- STH 4,ESIDTB(13,2) REFTBLE POSITION TO ESIDTB 00771000
- SRL 2,1 BACK AGAIN 00772000
- TM 8(12),X'80' IS UNDEFINED BIT ON 00773000
- BC 1,ESD00 YES - CHECK FOR MULTIPLE ENTRIES 00774000
- L 0,8(,12) LOAD RELOCATED ADDRESS 00775000
- ST 0,12(,12) STORE RELFAC IN REFTBL 00776000
- ESD00 LA 2,16 TEST FOR MULTIPLE ENTRIES IN CARD 00777000
- LH 1,SPEC+10(,13) 00778000
- SR 1,2 00779000
- BC 3,C3AH5 00780000
- NI SWS,255-ESDSW CLEAR SWITCH FOR START OF NEXT CARD. 00781000
- BC 15,RD 00782000
- C3AH5 MVC SPEC+16(32,13),SPEC+32(13) 00783000
- STH 1,SPEC+10(,13) 00784000
- BC 15,CA3A1 00785000
- C3AH2 OI 8(12),X'80' PLACE UNDEFINED BIT ON 00786000
- SR 3,3 CLEAR REGISTER 3 00787000
- ST 3,12(,12) STORE ZERO IN RELOCATION FACTOR 00788000
- LH 2,SPEC+14(,13) LOAD ESID. 00789000
- SLL 2,1 TIMES 2 FOR HALFWORD ENTRY 00790000
- STH 4,ESIDTB(13,2) REFTBL POSITION TO ESIDTB 00791000
- SRL 2,1 BACK AGAIN 00792000
- BC 15,ESD00 AND CHECK FOR MULTIPLE ENTRIES 00793000
- EJECT 00794000
- *********************************************************************** 00795000
- * 00796000
- * TEXT CARD ROUTINE (TXT) 00797000
- * 00798000
- *********************************************************************** 00799000
- * 00800000
- C4AA1 C 1,TXT 00801000
- BC 7,C4AA3 BR- NOT TEXT CRD 00802000
- STC 6,SPEC+4(,13) 00803000
- LH 7,SPEC+10(,13) NUM OF BYTES 00804000
- LTR 7,7 00805000
- BZ RD ZERO COUNT - DON'T MOVE TEXT. 00806000
- LA 8,C4AK2+2 00807000
- REPENT TM SWS,ABS TEST ABSOLUTE LOAD FLAG. 00808000
- BC 8,C4AC1 BR, RELOCATABLE LOAD 00809000
- APR1 SR 10,10 00810000
- BC 15,C4AC2 00811000
- C4AC1 LH 3,SPEC+14(,13) LOD ESID TO FIND ADDR 00812000
- BAL 14,REFADR 00813000
- L 10,12(,12) LOAD RELFAC 00814000
- C4AC2 A 10,SPEC+4(,13) ADD ADDR TO RELFAC 00815000
- ST 10,SPEC+4(,13) 00816000
- LR 1,10 00817000
- AR 1,7 00818000
- LA 5,ERRORO 00819000
- C 10,LEND TEST ADDR ABOVE LDR 00820000
- BC 10,C4AG2 BR- YES 00821000
- C 1,BELOW TEST ADDR BELOW LDR 00822000
- BC 2,UNDERLDR 00823000
- C 1,ABOVE 00824000
- BC 4,PROTREG ADDRESS BELOW INTERRUPT REGION - AN ERRO 00825000
- C4AG2 TM SWS,ABS TEST ABSOLUTE LOAD FLAG. 00826000
- C4AJ2 TM SWS,FTTR1 .. 00827000
- BC 14,C4AK2 BR-OFF 00828000
- LA 0,128 IS ADDR BELOW FIRST 128 BYTES 00829000
- CR 1,0 00830000
- BC 5,C4AK2 BR, DO NOT SAVE ADDR 00831000
- NI SWS,255-FTTR1 .. 00832000
- ST 10,BRAD(,13) SAVE FIRST ADDR LOADED INTO 00833000
- C4AK2 BCR 15,8 00834000
- SR 7,11 SUB ONE FROM NUM OF BYTES 00835000
- EX 7,CHAR MOVE TEXT TO STORAGE 00836000
- BC 15,RD AND GO READ A CARD 00837000
- SPACE 1 00838000
- UNDERLDR BAL R14,ERPRNT PRINT IT 00839000
- BAL R14,PAGER EJECT PAGE 00840000
- SVC 106 DIE... 00841000
- SPACE 1 00842000
- PROTREG BAL R14,ERPRNT PRINT IT 00843000
- BAL R14,PAGER EJECT PAGE 00844000
- SVC 107 DIE... 00845000
- * 00846000
- CHAR MVC 0(1,10),SPEC+16(13) 00847000
- EJECT 00848000
- *********************************************************************** 00849000
- * 00850000
- * REPLACE CARD ROUTINE (REP) 00851000
- * 00852000
- *********************************************************************** 00853000
- * 00854000
- C4AA3 C 1,REP 00855000
- BC 7,C5AA1 BR- NOT REPLACE CARD 00856000
- TM SWS,REPSW DO WE WANT REP CARDS PRINTED. 00857000
- BC 1,C4AA4 NO 00858000
- MVC CDIMJ(80),SPEC(13) 00859000
- MVI CDIMJ,C' ' BLANK OUT 12-2-9 PUNCH. 00860000
- LA 5,CRDIMJ GO PRINT OUT REP CARD IMAGE 00861000
- BAL 14,ERPRNT 00862000
- C4AA4 LA 4,6 CONVERT REP CRD HEX ADDR TO BIN 00863000
- LA 5,SPEC+6(,13) 00864000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00865000
- BALR 0,1 BR TO HEXB 00866000
- ST 0,SPEC+4(,13) SAVE ADDR IN CARD IMAGE 00867000
- LA 4,2(0,0) 00868000
- LA 5,SPEC+14(,13) CONVERT REP ESID TO BIN 00869000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00870000
- BALR 0,1 BR TO HEXB 00871000
- STH 0,SPEC+14(,13) SAVE THE ESID IN CARD IMAGE 00872000
- LA 5,SPEC+16(,13) 00873000
- NUM LA 7,2 NUM OF BYTES 00874000
- ST 5,TMPLOC(,13) 00875000
- TM SWS,FREPSW .. 00876000
- BC 1,APR10 00877000
- BAL 8,REPENT 00878000
- APRIL LA 4,4 CONVERT HALF WORD OF CORRECTIONS 00879000
- L 5,TMPLOC(,13) 00880000
- L 1,HEXBB LOAD CONVERSION ROUTINE ADDRESS 00881000
- BALR 0,1 BR TO HEXB 00882000
- L 8,SPEC+4(,13) LOD REPLACE ADDR 00883000
- STH 0,0(0,8) PLACE CORRECTION IN STORAGE 00884000
- NI SWS,255-FREPSW .. 00885000
- CLI 0(5),C',' 00886000
- BC 7,RD 00887000
- OI SWS,FREPSW TURN ON REP FIRST SWITCH. 00888000
- LA 8,2(8,0) 00889000
- ST 8,SPEC+4(,13) SAVE REPLACE ADDR 00890000
- AR 5,11 00891000
- BC 15,NUM 00892000
- APR10 LA 8,APRIL 00893000
- BC 15,APR1 00894000
- EJECT 00895000
- *********************************************************************** 00896000
- * 00897000
- * RELOCATION DICTIONARY CARD (RLD) 00898000
- * REG 6= 0 UPON ENTRY INTO C5AA1 00899000
- * 00900000
- *********************************************************************** 00901000
- * 00902000
- C5AA1 C 1,RLD 00903000
- BC 7,C6AA1 BR-NOT RLD CARD 00904000
- TM SWS,ABS TEST ABSOLUTE LOAD FLAG. 00905000
- BC 1,RD ON ABS LOAD ONLY 00906000
- * REL. HEADER ON CARD USED TO OBTAIN CURRENT ADDR 00907000
- * OF SYMBOL. THIS ADDR IS FOUND IN REL FAC. OF REFTBL 00908000
- LA 10,SPEC+16(,13) 00909000
- C5AC1 LH 3,0(,10) RH ESID 00910000
- LTR 3,3 ERROR IF RH ESI=0 00911000
- BC 8,ERRLD 00912000
- BAL 14,REFADR COMPUTE POS OF ENTRY IN TABLE (REG 12) 00913000
- ST 12,TEMPST(,13) AND SAVE ADDRESS 00914000
- TM 8(12),X'80' IS THE UNDEF. BIT=1 00915000
- BC 8,PLOAD NO - PROGRAM PREVIOUSLY LOADED 00916000
- LA 8,0 YES, USE A REL. FACTOR OF ZERO 00917000
- BC 15,PLOAD1 SKIP AN INSTR TO RELOAD REL FAC IN 8 00918000
- PLOAD L 8,12(,12) OBTAIN REL FACTOR OF SYMBOL 00919000
- PLOAD1 LH 3,2(,10) POSITION HEADER OF CURRENT SEGMENT 00920000
- LTR 3,3 00921000
- BC 8,ERRLD 00922000
- BAL 14,REFADR 00923000
- L 0,12(,12) RELFACT OF CURRENT SYMBOL 00924000
- LH 1,MVC1+2(,13) MVC (TO) WD DECREMENT 00925000
- LH 2,MVC2+4(,13) MVC FROM WD TO STORAGE 00926000
- BAL 14,CTR REDUCES CD BYTE COUNT BY 4, TEST FOR ZERO 00927000
- * IF NON 0, RETURNS, IF =0 BRANCHES TO RD 00928000
- * LENGTH OF SYMBOL IN BYTES IN REG 5 00929000
- C5AA3 AR 10,5 00930000
- LR 3,1 00931000
- LR 4,2 00932000
- TM 0(10),X'0C' TEST FOR FOUR BYTES 00933000
- BC 14,C5AB3 BR-TEST FOR THREE 00934000
- C5AF3 SR 5,11 00935000
- AR 3,6 TO MVC 'TO' 00936000
- AR 4,6 TO MVC 'FROM' 00937000
- STH 3,MVC1+2(,13) 'TO' 00938000
- STH 4,MVC2+4(,13) 'FROM' 00939000
- L 3,0(10,0) LOAD ADDR 00940000
- LA 3,0(,3) AND TAKE OUT FLAGS FROM 1ST BYTE 00941000
- AR 3,0 00942000
- EX 5,MVC1(,13) MVC WD(1,13),0(3) 00943000
- STH 1,MVC1+2(,13) 00944000
- L 4,WD(,13) THE SYMBOL VALUE W/O CONATANT 00945000
- TM 0(10),X'02' TEST COMPLEMENT FLAG 00946000
- BC 1,C5AE4 BR YES 00947000
- AR 4,8 ADD TO CONTENTS OF CELL 00948000
- COMPP ST 4,WD(,13) THE COMPLETE VALUE OF THE CONSTANT 00949000
- L 12,TEMPST(,13) RESTORE REFTBL ENTRY POINT OF SUBR 00950000
- TM 8(12),X'80' IS UNDEF BIT =1 00951000
- BC 8,CTEX 00952000
- STH 2,MVC2+4(,13) RESTORE ORIGINAL MVC2. 00953000
- L 7,APPNT 00954000
- BALR 14,7 UPDATE POINTERS 00955000
- BC 15,CTEX1 RESUME 00956000
- CTEX EX 5,MVC2(,13) MVC 0(1,3),WD(13) 00957000
- STH 2,MVC2+4(,13) 00958000
- CTEX1 BAL 14,CTR REDUCES BYTE COUNT OF CARD 00959000
- SR 6,6 00960000
- TM 0(10),X'01' TEST CONTINUATION FLAG 00961000
- BC 1,C5AA3 BR, FLAG-ADR FOLLOWS 00962000
- AR 10,5 00963000
- BC 14,C5AC1 BR, RH FOLLOWS 00964000
- CTR LA 5,4 CLOSED SBR, REDUCING BYTE COUNT BY 4 00965000
- SR 4,4 CLEAR OUT WORD 00966000
- ST 4,WD(,13) 00967000
- LH 4,SPEC+10(,13) BYTE COUNT 00968000
- SR 4,5 00969000
- BC 8,RD BYTES COUNT = 0 00970000
- STH 4,SPEC+10(,13) 00971000
- BCR 15,14 00972000
- C5AE4 SR 4,8 ADDR MINUS RELFAC 00973000
- BC 15,COMPP 00974000
- C5AB3 AR 6,11 00975000
- SR 5,11 00976000
- TM 0(10),X'08' TEST FOR THREE BYTE LOAD 00977000
- BC 1,C5AF3 BR-THREE BYTE 00978000
- AR 6,11 00979000
- SR 5,11 00980000
- TM 0(10),X'04' TEST FOR TWO BYTE LOAD 00981000
- BC 1,C5AF3 BR-TWO BYTE 00982000
- AR 6,11 00983000
- SR 5,11 00984000
- BC 15,C5AF3 00985000
- ERRLD LA 5,ERRORA 00986000
- MVC CDIMJ(80),SPEC(13) 00987000
- LA 14,RD 00988000
- BC 15,ERPRNT 00989000
- EJECT 00990000
- *********************************************************************** 00991000
- * 00992000
- * END CARD ROUTINE (END) 00993000
- * 00994000
- *********************************************************************** 00995000
- * 00996000
- C6AA1 C 1,END 00997000
- BC 7,C6AC1 BR-NOT END CARD 00998000
- CLC SPEC+28(4,13),BLANKS CHECK FOR CSECT LENGTH IN END. 00999000
- BE C6AB5 NO - CONTINUE NORMALLY. 01000000
- L 1,LOCCT(,13) YES - UPDATE THE LOCATION COUNTER. 01001000
- A 1,SPEC+28(,13) .. 01002000
- AH 1,HW7 FORCE ALIGNMENT ON DOUBLE WORD. 01003000
- SRL 1,3 .. 01004000
- SLL 1,3 .. 01005000
- ST 1,LOCCT(,13) .. 01006000
- C6AB5 SR 2,2 .. 01007000
- CLI SPEC+5(13),C' ' 01008000
- BC 8,C6AB3 BR IF NO ADDR 01009000
- STC 6,SPEC+4(,13) 01010000
- TM SWS,ENDB END BIT ON --- 01011000
- BC 8,C6AB3 BR NO, ADDR SAVED 01012000
- NI SWS,255-(FTTR1+ENDB) .. 01013000
- TM SWS,ABS TEST ABSOLUTE LOAD FLAG. 01014000
- BC 1,C6AB4 BR, ABS-LOAD FLAG ON 01015000
- LH 3,SPEC+14(,13) LOD ESID 01016000
- BAL 14,REFADR 01017000
- L 2,12(,12) RELOCATION FACTOR 01018000
- C6AB4 A 2,SPEC+4(,13) FORM ADDR 01019000
- ST 2,BRAD(,13) 01020000
- C6AB3 DS 0H 01021000
- LA 2,ESIDTB(,13) CLEAR ESIDTB TABLE 01022000
- LA 3,NOESD*2/256 GET NUMBER OF XC'S NEEDED 01023000
- XC 0(256,2),0(2) CLEAR 01024000
- LA 2,256(,2) BUMP PTR 01025000
- BCT 3,*-10 01026000
- OI SWS,ABS ABSOLUTE FLAG ON. 01027000
- USING XTRBLOK,R3 ADDRESSABILITY 01028000
- L R1,PNTXTR GET EXTRN BUFFER @VA04840 01029100
- L R3,PNTXTR0 GET ESD TYPE 0 HEADER @VA04840 01029200
- ST R1,0(,R3) PATCH TO EXISTING CHAIN @VA04840 01029300
- XC PNTXTR,PNTXTR ZIP EXTRN BUFFER PNTR @VA04840 01029400
- NXTLINE LA R5,XTRLINE POINT TO CONTROL LIST FOR PRINTER 01030000
- BAL R14,ERPRNT GO PRINT THIS LINE 01031000
- LR R1,R3 ADDRESS INTO R1 FOR FRET 01032000
- LA R0,XTRSIZE AND SIZE OF BLOK 01033000
- L R3,XTRPNT GET POINTER TO NEXT BUFFER (IF ANY) 01034000
- L R15,AFRETX ADDRESS OF FRET ROUTINE 01035000
- BALR R14,R15 NOW FRET IT. 01036000
- L R15,BREG1 RESTORE REG-15 01037000
- LTR R3,R3 ANY MORE BUFFERS IN THE CHAIN 01038000
- BNZ NXTLINE YES - GO PROCESS THEM 01039000
- XC PNTXTR0,PNTXTR0 ZIP ESD TYPE 0 BUFFER PNTR @VA04840 01040500
- LA R5,SPACE1 SPACE PRINTER ONE LINE 01041000
- BAL R14,ERPRNT ... 01042000
- LA R5,SPACE1 SPACE PRINTER 1 ADDITIONAL LINE 01043000
- BAL R14,ERPRNT ... 01044000
- DROP R3 01045000
- BC 15,RD TO RD 01046000
- EJECT 01047000
- *********************************************************************** 01048000
- * 01049000
- * LOAD TERMINATE CARD ROUTINE (LDT) 01050000
- * 01051000
- *********************************************************************** 01052000
- * 01053000
- C6AC1 C 1,LDT 01054000
- BC 7,CTLCRD NOT LDT - IS IT CTL CARD 01055000
- C6AC2 CLI SPEC+16(13),C' ' IS THERE A NAME 01056000
- BC 7,C6AD3 YES 01057000
- C6AC3 C 6,BRAD(,13) NO - IS THERE AN ADDRESS 01058000
- BC 8,C6AD4 BR-NO ADDR DEVELOPED 01059000
- L 0,BRAD(,13) LOD SAVED BR ADDR 01060000
- EXEC DS 0H 01061000
- LA 2,ESIDTB(,13) CLEAR ESIDTB TABLE 01062000
- LA 3,NOESD*2/256 GET NUMBER OF XC'S NEEDED 01063000
- XC 0(256,2),0(2) CLEAR 01064000
- LA 2,256(,2) BUMP PTR 01065000
- BCT 3,*-10 01066000
- OI SWS,ABS SET ABSOLUTE LOAD FLAG. 01067000
- ST 0,PSW+4 01068000
- TM SWS+1,SKPFLG 01069000
- BC 1,SKPERR 01070000
- L 12,TBLREF(,13) 01071000
- LH 4,TBLCT(,13) 01072000
- LA 3,16 01073000
- SUB1 SR 12,3 POINT TI FIRST ENTRY IN REFTBL 01074000
- TM 8(12),X'80' IS UNDEFINED BIT ON 01075000
- BC 8,NO1 NO - PICK UP NEXT ENTRY 01076000
- MVC ERRU(8),0(12) 01077000
- LA 5,ERRORU YES - GO PRINT UNDEFINED NAME 01078000
- BAL 14,ERPRNT 01079000
- SR 1,1 01080000
- L 7,AADDEF DEFINE UNDEFINED SYMBOL AT ZERO 01081000
- BALR 14,7 01082000
- NO1 BCT 4,SUB1 01083000
- BAL 14,PAGER 01084000
- LH 3,TBLCT(,13) GET COUNT OF ENTRIES IN REFTBL 01085000
- LR 2,3 AND PLACE IN REGISTER TWO 01086000
- SLL 3,4 GET THE NUMBER OF BYTES IN REFTBL AND 01087000
- L 1,TBLREF(,13) SUBTRACT QUANTITY FROM LARGEST ADDRESS O 01088000
- SR 1,3 TABLE+1 TO GET START OF REFTBL IN REG. 1 01089000
- LPSW PSW MUST BE CHANGED LATER 01090000
- * 01091000
- C6AC4 LA 3,1 01092000
- BAL 14,REFADR 01093000
- CA6D4 L 0,8(,12) 01094000
- BC 15,EXEC 01095000
- C6AD3 LA 2,ERLDT 01096000
- BAL 3,SERCH GO FIND THE NAME 01097000
- BC 15,CA6D4 NAME FOUND 01098000
- C6AD4 L 12,TBLREF(,13) 01099000
- LA 6,16 01100000
- SR 12,6 01101000
- BC 15,CA6D4 01102000
- * 01103000
- ERLDT MVC ERRU(6),SPEC+16(13) 01104000
- MVC ERRU+6(2),BLANKS 01105000
- LA 5,ERRORU 01106000
- BAL R14,ERPRNT PRINT ERROR 01107000
- BAL R14,PAGER EJECT PAGE 01108000
- SVC 103 DIE..... 01109000
- SPACE 01110000
- SKPERR LA 5,SKIPM CONTROL SECTION NOT FOUND BY EOF 01111000
- BAL R14,ERPRNT PRINT ERROR 01112000
- BAL R14,PAGER EJECT PAGE 01113000
- SVC 104 DIE... 01114000
- EJECT 01115000
- *********************************************************************** 01116000
- * 01117000
- * CONTROL CARD ROUTINE (CTL) 01118000
- * 01119000
- * 01120000
- * THIS ROUTINE PROVIDES FOR THE OPTIONAL PRINTING OF 01121000
- * INVALID CARDS, REPLACE CARDS, AND LOAD LISTING. 01122000
- * 01123000
- *********************************************************************** 01124000
- * 01125000
- CTLCRD C 1,CTL 01126000
- BC 8,SETSWS THIS IS A CONTROL CARD 01127000
- TM SWS,INVSW ILLEGAL CARD - DO WE PRINT IT. 01128000
- BC 8,BADCRD YES 01129000
- BC 15,RD NO - IGNORE AND GET ANOTHER CARD 01130000
- SPACE 3 01131000
- SETSWS MVC CDIMJ(80),SPEC+1(13) 01132000
- LA 5,CRDIMJ 01133000
- BAL 14,ERPRNT PRINT CTL CARD IMAGE 01134000
- LA 5,SPEC+4(,13) SET UP TO SCAN REAST OF CONTROL 01135000
- LA 6,1 CARD FOR FIELDS 01136000
- LA 7,SPEC+79(,13) 01137000
- LOOKBL CLI 0(5),C' ' IS THIS A BLANK 01138000
- BC 8,BUMP YES - BUMP COUNTER 01139000
- TM SWS+1,RDRSWT+WTRSWT 01140000
- BC 7,UNITB 01141000
- CLC 0(4,5),REPS NO - IS IT SREP 01142000
- BC 7,REPPT NO 01143000
- OI SWS,REPSW YES. 01144000
- BC 15,MOVEUP POINT TO NEXT FIELD 01145000
- REPPT CLC 0(4,5),REPP IS IT PREP 01146000
- BC 7,INVSP NO 01147000
- NI SWS,255-REPSW .. 01148000
- BC 15,MOVEUP POINT TO NEXT FIELD 01149000
- INVSP CLC 0(4,5),INVS IS IT SINV 01150000
- BC 7,INVPT NO 01151000
- OI SWS,INVSW YES. 01152000
- BC 15,MOVEUP POINT TO NEXT FIELD 01153000
- INVPT CLC 0(4,5),INVP IS IT VINP 01154000
- BC 7,UNIT 01155000
- NI SWS,255-INVSW .. 01156000
- MOVEUP A 5,THREE NO - LOOK FOR ANOTHER FIELD 01157000
- BUMP BXLE 5,6,LOOKBL 01158000
- BC 15,RD ALL DONE - GET NEXT CARD 01159000
- EJECT 01160000
- BADCRD DS 0H 01161000
- CLI SPEC(13),2 LOADER CARD? 01162000
- BE BDCRDB YES 01163000
- CLI SPEC(13),C'A' COMMENT CARD? 01164000
- BNL BDCRDA YES 01165000
- CLI SPEC(13),C'*' COMMENT CARD? 01166000
- BE BDCRDA YES 01167000
- CLC SPEC(5,13),CMSREAD CMS 'READ' CARD 01168000
- BE CMSCARD YES 01169000
- CLI SPEC(13),C' ' COMMENT CARD? 01170000
- BNE BDCRDB NOP 01171000
- B BDCRDA YES 01172000
- CMSCARD EQU * HERE FOR SPECIAL CMS 'READ' CARD 01173000
- CLI CPEND,X'FF' IS THIS FIRST 'READ' CARD AFTER DMKCPE ? 01174000
- BNE NOTCPE NO - 01175000
- BAL R14,SET YES - SKIP TO CHANNEL 1 01176000
- MVC CDCOM+80(25),ORAREA CLEAR PRINT AREA 01177000
- MVC CDCOM(80),ASTRIS PUT IN EYE CHATCHER 01178000
- LA R5,PRCOM ADDRESS OF CHANNEL PROGRAM 01179000
- BAL R14,ERPRNT PRINT IT... 01180000
- MVC CDCOM(80),CPEHDR PUT IN HEADING LINE. 01181000
- LA R5,PRCOM ADDRESS OF CHANNEL PROGRAM 01182000
- BAL R14,ERPRNT PRINT IT. 01183000
- MVC CDCOM(80),ASTRIS PUT IT EYE CHATCHER. 01184000
- LA R5,PRCOM ADDRESS OF CHANNEL PROGRAM 01185000
- BAL R14,ERPRNT PRINT IT 01186000
- MVI CPEND,X'00' CLEAR DMKCPE SWITCH 01187000
- LA R5,SPACE1 ADDRESS OF CCW TO SPACE PRINTER 01188000
- BAL R14,ERPRNT DO IT. 01189000
- LA R5,SPACE1 CAUSE A DOUBLE SPACE 01190000
- BAL R14,ERPRNT ... 01191000
- NOTCPE MVC CDCOM(80),SPEC(R13) MOVE IN CARD IMAGE 01192000
- MVC CDCOM+80(25),ORAREA BLANK REMAINDER 01193000
- MVI CDCOM,C'*' REPLACE COLON WITH AN ASTERISK @VA11453 01193100
- LA R5,PRCOM PRINT CMS CARD 01194000
- B BDCRDC REJOIN 01195000
- BDCRDA DS 0H 01196000
- MVC CDCOM(25),ORAREA 01197000
- MVC CDCOM+25(80),SPEC(13) MOVE CARD IMAGE 01198000
- LA 5,PRCOM PRINT COMMENT 01199000
- B BDCRDC REJOIN 01200000
- BDCRDB DS 0H 01201000
- LA 5,ERRORA 01202000
- MVC CDIMJ(80),SPEC(13) 01203000
- MVC CDCOM+80(25),ORAREA 01204000
- BDCRDC DS 0H 01205000
- LA 14,RD 01206000
- BC 15,ERPRNT 01207000
- UNIT CLC 0(3,5),RDRCTL RDR CTL CARD 01208000
- BC 7,UNITA NO 01209000
- OI SWS+1,RDRSWT YES - CONTINUE SCAN 01210000
- BC 15,MOVEUP 01211000
- SPACE 01212000
- UNITA CLC 0(3,5),WTRCTL 01213000
- BC 7,SKIPX 01214000
- OI SWS+1,WTRSWT 01215000
- BC 15,MOVEUP 01216000
- SPACE 01217000
- UNITB LA 4,3 01218000
- L 1,HEXBB CONVERT UNIT ADDRESS AND STORE IN PACE 01219000
- BALR 0,1 01220000
- TM SWS+1,RDRSWT 01221000
- BC 1,UNITC 01222000
- STH 0,PRNTR 01223000
- LR 1,5 IF PRINTER IS SWITCHED, LET BOTH KNOW 01224000
- LA 5,CRDIMJ 01225000
- BAL 14,ERPRNT 01226000
- LR 5,1 01227000
- NI SWS+1,255-WTRSWT 01228000
- BC 15,MOVEUP 01229000
- SPACE 01230000
- UNITC STH 0,READER 01231000
- NI SWS+1,255-RDRSWT 01232000
- BC 15,MOVEUP 01233000
- SPACE 01234000
- SKIPX CLC 0(4,5),SKIPWD SPECIAL CONTROL CARD ? 01235000
- BC 7,BUMP 01236000
- OI SWS+1,SKPFLG 01237000
- MVC RDR(2),READER SAVE CURRENT READER 01238000
- MVC SKPMSG(8),5(5) SAVE CSECT NAME TO BE SKIPPED 01239000
- BC 15,RD 01240000
- * SKIP CSECTNAME CAUSES LOADING TO CONTINUE NORMALLY UNTIL 01241000
- * 'CSECTNAME' OCCURS ON AN ESD 0 CARD. AT THAT TIME, ALL INPUT 01242000
- * CARDS ARE SKIPPED UNTIL AND 'END' CARD APPEARS AAT WHICH 01243000
- * TIME 'READER' IS SET BACK TO 'RDR', AND LAODING CONTINUES 01244000
- * NORMALLY. USEFULE FOR SLEECTIVE REPLACEMENT OF DECKS. 01245000
- EJECT 01246000
- *********************************************************************** 01247000
- * 01248000
- * ROUTINE TO LOCATE REFTBL ENTRIES 01249000
- * THRU ESID 01250000
- * 01251000
- * LH 3, WITH ESID, RH, OR PH 01252000
- * VALUE BEFORE ENTERING ROUTINE 01253000
- * THIS ROUTINE COMPUTES THE STORAGE ADDRESS OF A GIVEN ENTRY IN REF 01254000
- * 01255000
- *********************************************************************** 01256000
- * 01257000
- REFADR L 12,TBLREF(,13) 01258000
- SLL 3,1 TIMES 2 FOR HALFWORD ENTRY 01259000
- LH 3,ESIDTB(13,3) OBTAINS FROM ESIDTB TABLE ENTRY 01260000
- SLL 3,4 MULTIPLY BY 16 01261000
- SR 12,3 SIZE-(ESID X 16) 01262000
- BCR 15,14 01263000
- SPACE 3 01264000
- *********************************************************************** 01265000
- * 01266000
- * ROUTINE TO SEARCH REFERENCE TABLE 01267000
- * FOR A GIVEN NAME 01268000
- * 01269000
- *********************************************************************** 01270000
- * 01271000
- * CALLING SEQUENCE-- 01272000
- * L(LA) 2,NOT FOUND RETURN 01273000
- * BAL 3,ENTRY FOUND RETURN 01274000
- * REG 12 = ADDR OF ENTRY IN REFTBL.REG 11=1,REG 1= NAME OF PROG 01275000
- * THIS ROUTINE COMPARES EACH REFERENCE TABLE ENTRY 01276000
- * WITH THE GIVEN NAME,DETERMINING FIRST WHETHER THERE 01277000
- * IS AN ENTRY FOR THAT NAME AND 2ND WHAT THE 01278000
- * STORAGE ADDRESS OF THAT ENTRY IS. 01279000
- * 01280000
- *********************************************************************** 01281000
- * 01282000
- SERCH LH 0,TBLCT(,13) NO. OF ENTRIES IN REFTBL 01283000
- LA 1,SPEC+16(,13) ADDR OF NAME IN CRD 01284000
- SR 4,4 01285000
- LA 5,16 LOAD ENTRY SIZE 01286000
- L 12,TBLREF(,13) LARGEST ADDR IN STORAGE+1 01287000
- LTR 0,0 01288000
- BC 8,NOT 01289000
- CLC 0(8,1),BLANKS IS IT A BLANK NAME 01290000
- BC 7,CMP NO 01291000
- LR 4,0 UPDATE REG 4 WITH TBLCT 01292000
- SLL 0,4 SET REGISTER 12 TO POINT TO 01293000
- SR 12,0 NEXT ENTRY IN REFTBL 01294000
- BC 15,NOT RETURN 01295000
- CMP SR 12,5 01296000
- AR 4,11 TO ACCUM ENTRY POSITION 01297000
- CLC 0(8,1),0(12) COMPARE NAME IN CARD TO NAME IN REFTBL 01298000
- BCR 8,3 BR- NAME FOUND 01299000
- BCT 0,CMP 01300000
- NOT SR 12,5 01301000
- AR 4,11 ADD TO TOTAL ENTRIES 01302000
- L 0,AMAXREF MAX NO. OF UNRESOLVED REF, 01303000
- CR 4,0 01304000
- BC 10,ERREF REFERENCE TABLE OVERFLOW 01305000
- STH 4,TBLCT(,13) NO. FO ENTRIES IN TBLREF 01306000
- MVC 0(8,12),0(1) PLACE NAME IN TABLE 01307000
- XC 8(8,12),8(12) CLEAR OTHER HALF ON ENTRY. 01308000
- BCR 15,2 01309000
- ERREF LA 5,ERRORR GO TO ERPRNT WITH COMMENT OF REFERENCE 01310000
- BAL R14,ERPRNT PRINT TABLE OVERFLOW 01311000
- BAL R14,PAGER EJECT PAGE 01312000
- SVC 105 DIE... 01313000
- EJECT 01314000
- *********************************************************************** 01315000
- * 01316000
- * ERROR MESSAGES ROUTINE 01317000
- * 01318000
- *********************************************************************** 01319000
- * 01320000
- RDCONSL L 0,RDCLCCW 01321000
- N 0,R3BIT 01322000
- O 0,0(,5) 01323000
- ST 0,RDCLCCW 01324000
- LH 0,4(,5) 01325000
- LTR 0,0 01326000
- BCR 8,14 01327000
- STH 0,RDCLCCW+6 01328000
- LA 8,10 LOAD RETRY COUNTER 01329000
- LH 2,PRNTR 01330000
- ERPR2 SSM CH0OFF 01331000
- MVC ZCAW(4),RDCCA 01332000
- LA 0,ERPR2 01333000
- ST 0,PRTWAT+8 01334000
- B STARTIO 01335000
- ERPRNT CLI CPUID,X'FF' RUNNING UNDER CP? HRC031DK 01336000
- BNER R14 NO, MUST BE BARE MACHINE HRC031DK 01336333
- LH R0,4(,R5) GET LENGTH HRC031DK 01336666
- LTR R0,R0 IS ANY THERE ? 01337000
- BCR 8,R14 NO - RETURN 01338000
- MVI PRTLINE,C' ' BLANKS 01339000
- MVC PRTLINE+1(129),PRTLINE FOR STARTER 01340000
- L R2,0(,R5) ADDRESS OF DATA 01341000
- LH R8,4(,R5) AND ITS LENGTH 01342000
- BCTR R8,R0 MINUS 1 BYTE FOR EXCUTE INST. 01343000
- EX R8,PRTMOVE MOVE TO OUTPUT AREA 01344000
- LA R0,ERRCCW ADDRESS OF CCW 01345000
- ST R0,ZCAW STORE IN CAW 01346000
- LA R8,10 RETRY ERROR COUNTER 01347000
- LH R2,PRNTR ADDRESS OF I/O DEVICE 01348000
- ERPR1 SSM CH0OFF MASK OFF CHANNEL 01349000
- LA R0,ERPR1 01350000
- ST R0,PRTWAT+8 01351000
- STARTIO SIO 0(2) AND START I/O 01352000
- SPACE 01353000
- BC 8,PRTDRN SIO OK, .. GO WAIT FOR CE 01354000
- BC 2,PRTWAT UNIT BUSY - WAIT. 01355000
- BCR 1,14 UNIT UNAVAILABLE - FORGET IT AND PAY 01356000
- CH 2,CNSL 01357000
- BE CKERR 01358000
- TM IGNSW,X'01' 01359000
- BZ CKERR 01360000
- BC 15,14 01361000
- CKERR BCT 8,CONT RETRY 10 TIMES? 01362000
- MVC 0(15,0),MSG5 01363000
- B WAITLCMG 01364000
- PRTMOVE MVC PRTLINE(*-*),0(R2) SET UP PRINT LINE 01365000
- CONT TM ZCSW+4,X'02' TEST FOR UNIT CHECK 01366000
- BC 1,ERPR1 YES - CONTINUE TO TRY. 01367000
- TM ZCSW+4,X'14' TEST FOR BUSY AND DEVICE END 01368000
- BC 1,ERPR1 BOTH - TRY AGAIN. 01369000
- TM ZCSW+4,X'10' TEST FOR BUSY. 01370000
- BC 1,PRTWAT YES - WAIT FOR INTERRUPT. 01371000
- BC 15,ERPR1 OTHERWISE - TRY AGAIN. 01372000
- * 01373000
- PRTDRN TIO 0(2) TIO 'TIL CE 01374000
- BC 2,*-4 01375000
- L R0,LINECNT GET CURRENT NUMBER LINES ON THIS PAGE 01376000
- AL R0,CONST1 BUMP IT BY 1. 01377000
- ST R0,LINECNT SAVE IT. 01378000
- CH R0,LINEMAX 60 LINES ON THIS PAGE YET? 01379000
- BCR 4,R14 NO - RETURN TO CALLER 01380000
- B SET YES - SKIP TO PAGE 1. 01381000
- * 01382000
- CNOP 4,8 01383000
- * 01384000
- PRTWAT LPSW *+4 01385000
- DC X'FE020000' 01386000
- PRTWATAD DC AL4(ERPR1) 01387000
- * 01388000
- DMPTBL DC C'0123456789ABCDEF' DUMP CONVERTER 01389000
- * 01390000
- PAGER CLI CPUID,X'FF' UNDER CONTROL OF CP? HRC031DK 01391000
- BNER R14 NO, NO MAP ON BARE MACHINE HRC031DK 01391333
- LA 8,5 SET UP RETRY COUNTER HRC031DK 01391666
- LH 2,PRNTR GET PRINTER ADDRESS. 01392000
- TESTIO TIO 0(2) CLEAR CHANNEL 01393000
- BC 2,*-4 TRY AGAIN 01394000
- BC 8,SET 01395000
- TM ZCSW+4,X'10' BUSY ? 01396000
- BO TESTIO YES 01397000
- TM IGNSW,X'01' 01398000
- BO RTURN 01399000
- BCT 8,TESTIO 01400000
- ST 14,LINKSAV 01401000
- INT LA 5,INTPRT 01402000
- MVC PRNTR(2),CNSL 01403000
- INTVENP BAL 14,ERPRNT 01404000
- CNOP 4,8 01405000
- WAITPRNT LPSW *+4 01406000
- DC X'FE020000' 01407000
- WAITPRAD DC A(*+4) 01408000
- CLC READER,58 01409000
- BE WAITPRNT 01410000
- CLC CNSL,58 01411000
- BE IGNOR 01412000
- MVC PRNTR,58 01413000
- MVC PRNTSET,58 01414000
- L 14,LINKSAV 01415000
- B PAGER 01416000
- LINKSAV DS 1F 01417000
- SPACE , HRC031DK 01418000
- SET CLI CPUID,X'FF' RUNNING UNDER VM? HRC031DK 01418250
- BNER R14 NO, FORGET SKIPS TO CH 1 HRC031DK 01418500
- SSM CH0OFF HRC031DK 01418750
- LH R2,PRNTR GET PRINTER ADDRESS 01419000
- TIO 0(R2) DRAIN OUTSTANDING INTERRUPTS 01420000
- BC 4+2,*-4 ... 01421000
- SLR R0,R0 CLEAR 01422000
- ST R0,LINECNT CURRENT LINE NUMBER COUNTER 01423000
- LA R0,PGRSTR ADDRESS OF SKIP CCW. 01424000
- ST R0,ZCAW STORE IT IN CAW 01425000
- SIO 0(R2) NOW SKIP TO 1 01426000
- SSM CH0ON ENABLE FOR INTERRUPTS 01427000
- RTURN BR R14 RETURN TO CALLER 01428000
- IGNOR TM 68,X'80' 01429000
- BZ WAITPRNT 01430000
- LA 5,IGNMSG 01431000
- BAL 14,RDCONSL 01432000
- MVC PRNTR(2),PRNTSET 01433000
- OC MSG4,ORAREA 01434000
- CLC MSG4,IGN 01435000
- BNE INT 01436000
- MVI IGNSW,X'01' 01437000
- L 14,LINKSAV 01438000
- B RTURN 01439000
- ORAREA DC CL25' ' 01440000
- IGNMSG DC A(MSG4) 01441000
- DC H'0006' 01442000
- IGN DC C'IGNORE' 01443000
- IGNSW DC X'00' 01444000
- MSG5 DC C'UNRECOVERABLE ERROR' 01445000
- EJECT 01446000
- ********************************************************************* 01447000
- * 01448000
- * PRINTED MESSAGES 01449000
- * 01450000
- ********************************************************************* 01451000
- * 01452000
- RMES1 DC C'INTERVENTION ' 01453000
- DC C'REQUIRED - ' 01454000
- RMES2 DC C'UNIT CHECK. RETURN LAST CARD TO HOPPER' 01455000
- RMES3 EQU * 01456000
- ERRU DS 8C 01457000
- DC C' IS UNDEFINED' 01458000
- ERRA DC C'INVALID CARD...' 01459000
- CDIMJ DS 80C 01460000
- ERRD DS 8C 01461000
- DC C' IS DEFINED MORE' 01462000
- DC C' THAN ONCE' 01463000
- ERRO DC C'OVERLAY ERROR' 01464000
- ERRP DC C' ' 01465000
- ERRF DC C' ' 01466000
- RLDREFXT DC CL7' ' 01467000
- LOC1 DS CL8 01468000
- DC C' AT ' 01469000
- DC CL35' ' 01470000
- ERRR DC C'REFERENCE TABLE ' 01471000
- DC C'OVERFLOW.' 01472000
- ERRM DC C'DUPLICATE ' 01473000
- DC C'IDENTIFIER - ' 01474000
- NAME DS CL8 01475000
- ENDERR EQU * 01476000
- SKPMSG DS 8C 01477000
- DC C' NOT FOUND BY EOF TIME' 01478000
- SKPMSG1 EQU * 01479000
- * 01480000
- CDCOM DC CL105' ' 01481000
- PRCOM DC A(CDCOM) 01482000
- DC H'105' 01483000
- RETYRD DC A(RMES1) 01484000
- DC AL2(RMES2-RMES1) 01485000
- VALCHK DC A(RMES2) 01486000
- DC AL2(RMES3-RMES2) 01487000
- ERRORU DC A(ERRU) 01488000
- DC AL2(ERRA-ERRU) 01489000
- ERRORA DC A(ERRA) 01490000
- DC AL2(ERRD-ERRA) 01491000
- ERRORD DC A(ERRD) 01492000
- DC AL2(ERRO-ERRD) 01493000
- ERRORO DC A(ERRO) 01494000
- DC AL2(ERRP-ERRO) 01495000
- ERRORL DC A(RLDREFXT) 01496000
- DC AL2(ERRR-RLDREFXT-2) 01497000
- ERRORR DC A(ERRR) 01498000
- DC AL2(ERRM-ERRR) 01499000
- ERRORM DC A(ERRM) 01500000
- DC AL2(ENDERR-ERRM) 01501000
- CRDIMJ DC A(CDIMJ) 01502000
- DC AL2(ERRD-CDIMJ) 01503000
- SKIPM DC A(SKPMSG) 01504000
- DC AL2(SKPMSG1-SKPMSG) 01505000
- SPACE1 DC A(ORAREA) 01506000
- DC AL2(1) 01507000
- INTPRT DC A(MSG1) 01508000
- DC X'0020' 01509000
- MSG1 DC C'INTERVENTION REQUIRED - PRINTER ' 01510000
- MSG4 DC 3H'0' 01511000
- HEADING DC C'** EXTERNAL SYMBOL DICTIONARY FOR ' 01512000
- DS 0F 01513000
- PNTXTR0 DC F'0' PNTR TO ESD TYPE 0 ESID HEADER @VA04840 01513500
- PNTXTR DC F'0' POINTER TO LIST OF EXTRNS TO PRINT. 01514000
- LINECNT DC F'0' CURRENT LINES PRINTED ON PAGE. 01515000
- LINEMAX DC H'60' MAX. NUMBER LINES ALLOWED ON PAGE 01516000
- CONST1 DC F'1' CONSTANT 01517000
- SPACE 1 01518000
- DMKPSA DC CL6'DMKPSA' MODULE USED BY VM/370 01519000
- DMKCPE DC CL6'DMKCPE' MODULE INDICATING END OF NUCLEUS 01520000
- DMKWRM DC CL6'DMKWRM' DON'T FORCE ON PAGE BOUNDARY 01521000
- SPBHDR DC CL15' (SPB INSERTED)' MESSAGE INDICATOR 01522000
- ASTRIS DC CL80'*** X01523000
- ***' 01524000
- CPEHDR DC CL80' END OF VM/370 RESIDENT NUCLEUS' 01525000
- ESDHDR DC CL21'MODULE SIZE IS XXXXXX' 01526000
- VM370 DC X'00' FF IF DMKPSA FOUND 01527000
- ENDNUC DC X'00' FF IF DMKCPE FOUND 01528000
- CPEND DC X'00' SWITCH FOR FIRST READ CARD AFTER DMKCPE 01529000
- EJECT 01530000
- *********************************************************************** 01531000
- * 01532000
- * CONSTANTS AREA 01533000
- * 01534000
- *********************************************************************** 01535000
- * 01536000
- BELOW DC A(ALPHA) 01537000
- * 01538000
- SLC DC X'02' *** 01539000
- DC C'SLC' 01540000
- SPB DC X'02' *** 01541000
- DC C'SPB' 01542000
- ICS DC X'02' *** 01543000
- DC C'ICS' 01544000
- ESD DC X'02' *** 01545000
- DC C'ESD' 01546000
- TXT DC X'02' *** 01547000
- DC C'TXT' 01548000
- REP DC X'02' *** 01549000
- DC C'REP' 01550000
- RLD DC X'02' *** 01551000
- DC C'RLD' 01552000
- END DC X'02' *** 01553000
- DC C'END' 01554000
- LDT DC X'02' *** 01555000
- DC C'LDT' 01556000
- CTL DC X'02' 01557000
- DC C'CTL' 01558000
- * 01559000
- BLANKS DC CL8' ' 01560000
- SKIPWD DC C'SKIP' 01561000
- RDRCTL DC C'RDR' READER CONTROL CARD 01562000
- WTRCTL DC C'WTR' PRINTER CONTROL CARD 01563000
- CMSREAD DC C':READ' SPECIAL CMS CARD ? 01564000
- HW7 DC H'7' CONSTANT 01565000
- * 01566000
- * THE FOLLOWING INSTRUCTION 01567000
- * SHOULD BE ADJUSTED TO READ-- 01568000
- *CTRSET DC A(CTRR) 01569000
- * FOR LOW ASSEMBLIES, AND 01570000
- *CTRSET DC A(256) 01571000
- * FOR HIGH ASSEMBLIES. 01572000
- * INITIAL VALUE FOR LOCCT(13) 01573000
- * 01574000
- CTRSET DC A(0) INITIAL LOCATION COUNTER SETTING 01575000
- * 01576000
- ABOVE DC A(256) 01577000
- * 01578000
- LEND DC A(OMEGA) 01579000
- AADDEF DC A(ADDEF) 01580000
- AFRINI DC A(FRINIT) 01581000
- AFREE DC A(FREE) 01582000
- AFRETX DC A(FRET) ADDRESS OF FRET. 01583000
- APPNT DC A(APOINT) 01584000
- HEXBB DC A(HEXB) 01585000
- TOP DC A(MON) 01586000
- AMAXREF DC A(MAXREF) MAXIMUM NUMBER OF ESD ENTRIES 01587000
- ANOESD DS A(NOESD) MAXIMUN NUMBER OF EXTERNS IN 1 MODULE 01588000
- * 01589000
- THREE DC F'3' 01590000
- * 01591000
- REPS DC C'SREP' 01592000
- REPP DC C'PREP' 01593000
- INVS DC C'SINV' 01594000
- INVP DC C'PINV' 01595000
- * 01596000
- DS 0D 01597000
- * 01598000
- PSW DC XL16'00' 01599000
- * 01600000
- CTLIST EQU * 01601000
- DC 2D'0' ADDRESS POINTER 01602000
- DC F'3' COMMON NUMBER OF DW'S USED ALOT 01603000
- DC F'0' USAGE COUNTER CONTAINING CALL TO FREE 01604000
- DC D'0' ALIGNMENT FOR DW BOUNDARY 01605000
- DC 4D'0' NEXT ENTRY IN THE CONTROL LIST 01606000
- * 01607000
- ONEBIT DC X'80000000' 01608000
- R3BIT DC X'FF000000' 01609000
- PAGENO DC X'00FFF000' 01610000
- * 01611000
- BYTE1 EQU R3BIT 01612000
- * 01613000
- CTRR DS 0D 01614000
- * 01615000
- * 01616000
- EJECT 01617000
- * 01618000
- ********************************************************************* 01619000
- * 01620000
- * CHANNEL AREA 01621000
- * 01622000
- ********************************************************************* 01623000
- * 01624000
- ZEXOP EQU 24 01625000
- ZPROP EQU 40 01626000
- ZMCOP EQU 48 01627000
- ZIOOP EQU 56 01628000
- ZCSW EQU 64 CHANNEL STATUS WORD. 01629000
- ZCAW EQU 72 CHANNEL ADDRESS WORD 01630000
- ZEXNP EQU 88 EXTERNAL INTERRUPT NEW PSW. 01631000
- ZSUPNP EQU 96 01632000
- ZPRNP EQU 104 01633000
- ZMCNP EQU 112 01634000
- ZIONP EQU 120 INPUT-OUTPUT NEW PSW 01635000
- * 01636000
- SPACE 3 01637000
- *********************************************************************** 01638000
- * 01639000
- * I-O INTERRUPT HANDLER 01640000
- * 01641000
- *********************************************************************** 01642000
- * 01643000
- IOINT NI ZIOOP+1,X'FD' 01644000
- MVI ZIOOP,X'00' DONT ALLOW ANY INTERRUPTS 01645000
- LPSW ZIOOP REMOVE USER FROM WAIT 01646000
- SPACE 01647000
- *********************************************************************** 01648000
- * 01649000
- * EXTERNAL INTERRUPT HANDLER 01650000
- * 01651000
- *********************************************************************** 01652000
- * 01653000
- EXTINT NI ZEXOP+1,X'FD' REMOVE USER FROM WAIT 01654000
- LPSW ZEXOP 01655000
- SPACE 3 01656000
- DROP 15 01657000
- DS 0D 01658000
- IONP DC F'0' 01659000
- IONPAD DC A(IOINT) 01660000
- EXNP DC X'01040000' 01661000
- EXNPAD DC A(EXTINT) 01662000
- SUPNP DC X'00060000' 01663000
- DC 4X'99' 01664000
- MCNP DC X'00020000' 01665000
- DC 4X'BB' 01666000
- PRNP DC X'00060000' WAIT WITH CODE 111111 ON PROGRAM CK. 01667000
- DC 4X'11' .. 01668000
- * DC A(PROGI) TO PROGRAM INTERRUPT ROUTINE LATER. 01669000
- * 01670000
- ERRSAV DC 8F'00' 01671000
- ERETRYSW DC X'00' 01672000
- CNSL DC H'09' ADDR OF CONSOLE 01673000
- PRNTSET DC H'14' 01674000
- PRNTR DC H'14' 01675000
- READER DS H 01676000
- RDR DS H 01677000
- READ EQU 2 READNAD SLCT 1 01678000
- WRITE EQU 9 01679000
- SKIP1 EQU X'8B' 01680000
- SLI EQU X'20' 01681000
- * 01682000
- READCL EQU X'0A' 01683000
- * 01684000
- INITCCW DC A(INITCCWA) INITIALIZE PRINTER CCW @V60B9BA 01684100
- INITCCWA CCW X'37',0,SLI,1 ... @V60B9BA 01684200
- RDCCW DC A(RDCCWA) 01685000
- RDCCWA CCW READ,*-*,0,80 01686000
- ERRCCA DC A(ERRCCW) 01687000
- ERRCCW CCW WRITE,PRTLINE,SLI,130 @V60A6B6 01688000
- PGRSTR CCW SKIP1,*-*,SLI,1 01689000
- RDCLCCW CCW READCL,*-*,0,0 01690000
- RDCCA DC A(RDCLCCW) 01691000
- CH0OFF DC X'00' 01692000
- CH0ON DC X'FE' 01693000
- PRTLINE DC CL130' ' 01694000
- * 01695000
- * THE FOLLOWING BITS ARE DESIGNATED IN SWS --- 01696000
- * 01697000
- SWS DS 2C .. 01698000
- * 01699000
- ABS EQU X'80' ABSOLUTE LOAD FLAG. 01700000
- FTTR1 EQU X'40' 01701000
- BRSW EQU X'20' 01702000
- ENDB EQU X'10' 01703000
- FREPSW EQU X'08' 01704000
- ESDSW EQU X'04' 01705000
- INVSW EQU X'02' 01706000
- REPSW EQU X'01' 01707000
- RDRSWT EQU X'80' SWITCH THE READER 01708000
- WTRSWT EQU X'40' SWITCH THE WTR 01709000
- SKPFLG EQU X'20' SKIP CONTROL SECTION AND SWITCH READER 01710000
- ENDFLG EQU X'10' SKIP TO END CARD 01711000
- SPACE 1 01712000
- DROP 9 01713000
- EJECT 01714000
- *********************************************************************** 01715000
- * 01716000
- * INITIAL ENTRY ROUTINE (RELLDR) 01717000
- * 01718000
- *********************************************************************** 01719000
- * 01720000
- BETA DS 0D 01721000
- RELLDR EQU * 01722000
- BALR 12,0 01723000
- USING *,12 01724000
- L 9,BASE 01725000
- L 12,BREG1 01726000
- USING RELDR,12,9 01727000
- STIDP CPUID GET CPUID HRC031DK 01727500
- MVI CNTR,0 REINITIALIZE TO SHOW NO FREE STORAGE 01728000
- MVC READER(2),2 IPL DEVICE BECOMES READER 01729000
- * 01730000
- * 01731000
- * HERE TO CAUSE RELOCATION TO HIGH CORE 01732000
- * 01733000
- LA R1,PROGINT ADDR. OF PROGRAM INTERRUPT RETURN 01734000
- ST R1,ZPRNP+4 SAVE ADDR. IN NEW PROG. PSW 01735000
- SLR R1,R1 CLEAR.. 01736000
- ST R1,ZPRNP ZERO OUT ALL BUT ADDRESS 01737000
- L R2,ENDE LOAD END ADDRESS OF THIS MODULE 01738000
- L R3,SIZFE CONSTANT BET. 15 AND 16 MEG @VA04629 01739000
- MVCL R2,R2 FORCE PROGRAM CHECK 01740000
- * 01741000
- * 01742000
- PROGINT EQU * P.C. RETURN-- REG-2 = TOP OF STORAGE 01743000
- S R2,PROGSIZE SUBTRACT SIZE OF THIS MODULE 01744000
- L R3,FFF000 ZERO OUT LOW ORDER 12 BITS 01745000
- NR R2,R3 FORCE TO 1K BOUNDARY 01746000
- L R3,PROGSIZE NUMBER OF BYTES TO MOVE TO HIGH CORE 01747000
- LR R4,R2 SAVE FOR RELOCATION FACTOR 01748000
- SLR R4,R12 REG4 NOW HAS RELOCATION FACTOR 01749000
- SLR R8,R8 CLEAR 01750000
- LA R5,ADCONSLG NUMBER OF ADCONS TO RESOLVE 01751000
- LA R6,ADCONS POINTER TO BEGINING OF ADCON LIST 01752000
- NXTADCON L R7,0(,R6) GET ADCON ENTRY ADDRESS 01753000
- ICM R8,B'0111',1(R7) GET ACTUAL ADCON 01754000
- ALR R8,R4 ADD IT TO RELOCATION VALUE 01755000
- STCM R8,B'0111',1(R7) PUT IT BACK 01756000
- LA R6,4(,R6) BUMP TO GET NEXT ADCON IN THE LIST 01757000
- BCT R5,NXTADCON PROCESS TILL LIST IS DELETED 01758000
- LR R5,R2 SAVE R2 BEOFRE MVCL INSTRUCTION 01759000
- LR R13,R3 SECOND OPERAND FOR 'MVCL' INSTRUCTION 01760000
- LA R14,RELDR REMEMBER OLD ADDRESS AND ... @VA03812 01761000
- L R15,ATOTSIZE TOTAL SIZE OF THE LOADER. @VA03812 01762000
- MVCL R2,R12 MOVE MODULE TO HIGH CORE 01763000
- LR R2,R5 RESTORE REG 2 01764000
- LA R1,NEWSTART EXCUTION RESUME ADDRESS WITH 01765000
- ALR R1,R4 PROPER RELOCATION FACTOR 01766000
- ST R1,ZPROP+4 STORE IN OLD PROGRAM CHECK PSW 01767000
- LR R9,R2 NEW BASE REG MUST BE LOADED WITH 01768000
- LA R9,4095(,R9) VALUE OF NEW REG-12 PLUS ADDING 01769000
- LA R9,1(,R9) 4096 BYTES TO IT. 01770000
- LR R12,R2 ... 01771000
- LPSW ZPROP TAKE OFF AT THE NEW LOCATION 01772000
- * 01773000
- SPACE 01774000
- NEWSTART EQU * RESUME EXCUTION AT NEW STARTING LOCATION 01775000
- SR R1,R1 CLEAR R1 (R0 IS IMMATERIAL) @VA03812 01776000
- MVCL R14,R0 CLEAR WHERE THE OLD LOADER WAS @VA03812 01777000
- LA 0,158 01778000
- L 15,AFRINI 01779000
- LA 1,CTLIST 01780000
- BALR 14,15 01781000
- L 15,AFREE 01782000
- BALR 14,15 01783000
- LR 13,1 01784000
- LH 1,READER DRAIN ANY READER CONDITIONS. 01785000
- TIO 0(1) .. 01786000
- BC 7,*-4 01787000
- MVC ZIONP(8),IONP MOVE IO NEW PSW TO 3OWER CORE. 01788000
- MVC ZEXNP(8),EXNP SAME FOR EXTERNAL INTERRUPT. 01789000
- MVC ZSUPNP(8),SUPNP 01790000
- MVC ZMCNP(8),MCNP 01791000
- MVC ZPRNP(8),PRNP 01792000
- L 3,RDCCWA 01793000
- N 3,R3BIT 01794000
- LA 2,SPEC(,13) 01795000
- OR 3,2 01796000
- ST 3,RDCCWA READER CHANNEL COMMAND WORD 01797000
- LA 0,X'B7' 01798000
- STC 0,CONS(,13) 01799000
- L 1,TOP 01800000
- ST 1,TBLREF(,13) 01801000
- MVC MVC1(12,13),MMMVC INITIALIZATION INTO STO MOVE 01802000
- L 1,T1 01803000
- ST 1,FREEST(,13) 01804000
- L 15,BREG2 01805000
- BCR 15,15 INITIAL LOADING ENTRY 01806000
- DROP 12 01807000
- * 01808000
- CPUID DS D CPUID STORED HERE HRC031DK 01808500
- PROGSIZE DC A(OMEGA-RELDR) SIZE OF THIS MODULE 01809000
- SIZFE DC X'00FE0000' CONSTANT BET. 15 AND 16 MEG @VA04629 01810000
- FFF000 DC X'00FFF000' USED TO FORCE TO 1K BOUNDARY 01811000
- BREG1 DC A(RELDR) BASE ADDR OF LOADER 01812000
- BREG2 DC A(LOAD2) INITIAL LOADING ENTRY 01813000
- BASE DC A(RELDR+4096) 01814000
- ATOTSIZE DC A(TOTLSIZE) TOTAL SIZE OF LOADER @VA03812 01815000
- * 01816000
- MMMVC MVC WD(1,13),0(3) INITIALIZATION FOR RLD SUPROUTINE 01817000
- MVC 0(1,3),WD(13) 01818000
- * 01819000
- ADCONS DS 0F TABLE OF ADDRESS CONSTANTS 01820000
- DC A(RLDR) 01821000
- DC A(SECBASE) 01822000
- DC A(WAIT2AD) 01823000
- DC A(WAITXXAD) 01824000
- DC A(PRTWATAD) 01825000
- DC A(WAITPRAD) 01826000
- DC A(IGNMSG) 01827000
- DC A(PRCOM) 01828000
- DC A(RETYRD) 01829000
- DC A(VALCHK) 01830000
- DC A(ERRORU) 01831000
- DC A(ERRORA) 01832000
- DC A(ERRORD) 01833000
- DC A(ERRORO) 01834000
- DC A(ERRORL) 01835000
- DC A(ERRORR) 01836000
- DC A(ERRORM) 01837000
- DC A(CRDIMJ) 01838000
- DC A(SKIPM) 01839000
- DC A(SPACE1) 01840000
- DC A(INTPRT) 01841000
- DC A(BELOW) 01842000
- DC A(LEND) 01843000
- DC A(AADDEF) 01844000
- DC A(AFRINI) 01845000
- DC A(AFREE) 01846000
- DC A(AFRETX) 01847000
- DC A(APPNT) 01848000
- DC A(HEXBB) 01849000
- DC A(TOP) 01850000
- DC A(IONPAD) 01851000
- DC A(EXNPAD) 01852000
- DC A(RDCCW) 01853000
- DC A(INITCCW) @V60B9BA 01853100
- DC A(ERRCCA) 01854000
- DC AL1(128),AL3(ERRCCW) 01855000
- DC A(RDCCA) 01856000
- DC A(BREG1) 01857000
- DC A(BREG2) 01858000
- DC A(BASE) 01859000
- DC A(SNSWAIAD) 01860000
- DC A(INTVRAD) 01861000
- DC AL1(128),AL3(TIECCW) 01862000
- DC AL1(128),AL3(SENSCCW) 01863000
- DC A(EQCKMSG) 01864000
- DC A(NOTOPMG) 01865000
- DC A(UNRECMG) 01866000
- DC A(LPMSG) 01867000
- DC A(SECDBASE) 01868000
- DC A(RDATCKMG) 01869000
- DC A(ARELDR) @VA02639 01870000
- DC A(IOTAA) 01871000
- DC AL1(128),AL3(IPLCCW) 01872000
- DC AL1(128),AL3(IPCCW2) 01873000
- DC A(BETAA) 01874000
- DC A(ENDE) 01875000
- DC A(START) 01876000
- DC A(STOPP) 01877000
- DC AL1(128),AL3(TOPX) 01878000
- DC AL1(128),AL3(CARD3) @VA02018 01879000
- DC AL1(128),AL3(CRD3CCW2) @VA02018 01880000
- DC A(FRETAD) 01881000
- DC A(AFRET) 01882000
- DC A(AEXTND) 01883000
- ADCONSLG EQU (*-ADCONS)/4 NUMBER OF ENTRIES IN LIST 01884000
- EJECT 01885000
- TAPERR BALR 3,0 01886000
- USING *,3 01887000
- L 9,SECDBASE 01888000
- L 4,ARELDR LOAD ADDR OF RELDR 01889000
- USING RELDR,4,9 ESTABLISH ADDRESSABILITY 01890000
- MVC SENSFLD(6),CLEAR CLEAR OUT SENSE FIELD 01891000
- MVC CSWSAV(8),ZCSW SAVE CSW 01892000
- MVI ERETRYSW,X'80' SET SWITCH 01893000
- SNSSIO LA 2,SENSCCW LOAD ADDR OF SENSE CCW 01894000
- SSM DISABLE DISABLE IO INT 01895000
- ST 2,72 STORE CCW ADDR IN CAW 01896000
- LH 2,READER LOAD ADDR OF DEVICE TO BE STARTED 01897000
- SENCK SIO 0(2) START DEVICE 01898000
- BC 8,SNSWAIT DEVICE STARTED 01899000
- BC 3,SIOERR UNIT NOT OPERATIONAL 01900000
- TM 68,X'02' WAS THERE AN ERROR ON SENSE 01901000
- BO EQUIPCHK YES GIVE MSG TERMINATE 01902000
- B SENCK LOOP TILL SIO TAKES 01903000
- CNOP 0,8 ALIGNMENT 01904000
- SNSWAIT STH 2,ZIONP+2 STORE 01905000
- LPSW *+4 LOAD 01906000
- DC X'FE020000' PSW 01907000
- SNSWAIAD DC A(*+4) 01908000
- CLC ZIOOP+2(2),ZIONP+2 COMPARE 01909000
- BNE SNSWAIT WAIT 01910000
- TM SENSFLD,X'80' IS IT COMMAND REJECT 01911000
- BO CARDRTN YES CONTINUE AS A CARD ERROR 01912000
- TM SENSFLD,X'40' IS IT INTERVENTION REQ 01913000
- BO INTVREQ YES 01914000
- TM SENSFLD+1,X'08' IS TAPE AT LOAD POINT 01915000
- BO TAPELP YES 01916000
- TM SENSFLD,X'08' IS IT A DATA CHECK 01917000
- BO DATACK YES 01918000
- TM SENSFLD+1,X'80' IS IT NOISE 01919000
- BO DATACK YES 01920000
- B UNRCTPER 01921000
- DATACK L 7,CSWSAV GET ADDR OF ERROR CCW 01922000
- S 7,EIGHT GET ADDR OF ERROR CCW 01923000
- MVC TIECCW1(8),0(7) LOAD ERROR CCW IN TIE LIST 01924000
- LH 8,6(7) LOAD COUNT OF ERROR CCW IN REG 8 01925000
- SH 8,CSWSAV+6 SUBTRACT TO GET NR OF BYTES READ 01926000
- CH 8,TWELVE TEST FOR TWELVE BYTES 01927000
- BC 10,READTAPE 12 BYTES OR MORE RECORD LENGTH 01928000
- TM SENSFLD+1,X'80' LESS THAN 12 BYTES CHECK NOISE BIT 01929000
- BC 7,READTAPE NOISE BIT ON GO TO READ TAPE ROUTINE 01930000
- NOISEREC B NOISERTN IGNORE NOISE RECORD GET NEXT RECORD 01931000
- READTAPE LA 2,BSPACE GET BS CCW ADDR 01932000
- BAL 6,SIORTN START DEVICE 01933000
- L 7,READTEN SETUP CNTR FOR READ RETRY 01934000
- BCT 7,READLOOP PERFORM TEN RETRIES 01935000
- TM SENSFLD+1,X'08' IS TAPE AT LOAD POINT 01936000
- BC 1,NOCLEAN YES BYPASS TAPE CLEAN ROUTINE 01937000
- MVI LPSWITCH,X'EE' SET LOOP SWITCH TO DETECT BS TO LP 01938000
- LA 2,CLEANTP GET ADDR OF TAPE CLEAN CCWS 01939000
- BAL 6,SIORTN START DEVICE 01940000
- MVI LPSWITCH,X'00' RESET LP SWITCH TO OFF 01941000
- NOCLEAN L 8,CLEANCTR SET UP TAPE CLEAN ENTRY CTR 01942000
- BCT 8,CLEANLOP BRANCH ALLOW TEN ENTRIES INTO TP CLN RTN 01943000
- MVC READTEN(4),READSET SOLID ERROR RESET COUNTER TO 10 01944000
- MVC CLEANCTR(4),CLEANSET 10 ENTRIES TO TAPE CLEAN/RESET 01945000
- MVI LPSWITCH,X'00' RESET LOAD POINT SWITCH OFF 01946000
- B RDATCK LOAD ADDR OF READ DATA CHECK MSG 01947000
- CLEANLOP ST 8,CLEANCTR SAVE DEC CTR VALUE 01948000
- L 7,READSET 10TH READ RETRY, RESET READTEN 01949000
- READLOOP ST 7,READTEN SAVE DEC CTR VALUE 01950000
- MVC TIEBYTE(1),SENSFLD+2 PUT SENSE BYTE 2 IN TIE CCW LIST 01951000
- LA 2,TIECCW LOAD TRACK IN ERROR CCW LIST ADDR 01952000
- ST 2,72 SET UP CAW 01953000
- BAL 10,SIO2 START DEVICE 01954000
- MVC READTEN(4),READSET NO ERROR RETURN RESET COUNTER 01955000
- MVC CLEANCTR(4),CLEANSET NO ERROR RETURN RESET COUNTER 01956000
- MVI ERETRYSW,X'00' RESET SWITCH 01957000
- B CONTINUE 01958000
- SIORTN SSM DISABLE DISABLE IO 01959000
- ST 2,72 STORE CCW ADDR IN CAW 01960000
- LH 2,READER LOAD DEVICE ADDR 01961000
- WAITLOOP TIO 0(2) TEST DEVICE STATUS 01962000
- BC 2,WAITLOOP YES 01963000
- SIO1 SIO 0(2) START DEVICE 01964000
- BC 8,IOWAIT STARTED 01965000
- BC 2,WAITLOOP BUSY TRY AGAIN 01966000
- BC 1,SIOERR NOT OPERATIONAL 01967000
- B TIO3 CHECK FOR ANY ERRORS 01968000
- IOWAIT TIO 0(2) IS IO COMPLETE 01969000
- BC 2,IOWAIT NO KEEP LOOPING 01970000
- BR 6 YES RETURN 01971000
- TIO3 TM 68,X'03' IS STATUS UC OR UE 01972000
- BC 5,TIO2 YES 01973000
- TM 69,X'FF' ANY OTHER ERRORS 01974000
- BC 5,TIO2 YES 01975000
- TM 68,X'04' IS IT DEVICE END 01976000
- BC 8,TIO1 NO 01977000
- BR 6 YES IT IS 01978000
- TIO2 TM 68,X'02' IS IT UNIT CHECK 01979000
- BC 1,SNSSIO YES 01980000
- B UNRCTPER ITS UNIT EXCEPTION 01981000
- TIO1 TM 68,X'30' CNTL UNIT END 01982000
- BC 5,SIO1 01983000
- TM 68,X'08' CHANNEL END 01984000
- BC 1,IOWAIT WAIT FOR DEVICE END 01985000
- B SNSSIO CHECK ERROR 01986000
- INTVREQ LA 5,RETYRD LOAD ADDR OF INT REG MSG 01987000
- MVC PRNTR(2),CNSL SET UP TO PRINT MSG ON CONSOLE 01988000
- BAL 14,ERPRNT GO TELL USER 01989000
- BAL 14,PAGER SKIP TO NEW PAGE ON PRINTER 01990000
- MVC PRNTR(2),PRNTSET RESTORE PRNTR ADDRESS 01991000
- MVC ZIONP+2(2),READER SET UP FOR DEVICE END 01992000
- CNOP 4,8 01993000
- LPSW *+4 01994000
- DC X'FF020000' WAIT FOR INTERRUPT ON THIS CHAN 01995000
- INTVRAD DC A(DATACK) 01996000
- TAPELP TM LPSWITCH,X'EE' LP OCCURED DURING TAPE CLEAN RTN 01997000
- BC 1,LPDATA YES GO TO DATA CHECK AT LP EXIT 01998000
- RDATCK LA 5,RDATCKMG LOAD ADDR OF READ DATA CK MSG 01999000
- MVC PRNTR(2),CNSL PUT MSG OUT ON THE CONSOLE 02000000
- BAL 14,ERPRNT PRINT MSG 02001000
- LPSW ERRPSW LOAD ERROR PSW 02002000
- LPDATA LA 5,LPMSG LOAD ADDR OF LOAD POINT MSG 02003000
- MVC PRNTR(2),CNSL PUT MSG ON CONSOLE 02004000
- BAL 14,ERPRNT PRINT MSG 02005000
- LPSW ERRPSW LOAD ERROR PSW 02006000
- EQUIPCHK LA 5,EQCKMSG LOAD ADDR OF EQUIP CK MSG 02007000
- MVC PRNTR(2),CNSL PUT MSG OUT ON THE CONSOLE 02008000
- BAL 14,ERPRNT PRINT MSG 02009000
- LPSW ERRPSW LOAD ERROR PSW 02010000
- SIOERR LA 5,NOTOPMG LOAD ADDR OF NOT OPERATIONAL MSG 02011000
- MVC PRNTR(2),CNSL PUT MSG OUT ON THE CONSOLE 02012000
- BAL 14,ERPRNT PRINT MSG 02013000
- LPSW ERRPSW LOAD ERROR PSW 02014000
- UNRCTPER LA 5,UNRECMG LOAD ADDR OF UNRECOVERABLE ERROR MSG 02015000
- MVC PRNTR(2),CNSL PUT MSG OUT ON THE CONSOLE 02016000
- BAL 14,ERPRNT PRINT MSG 02017000
- SVC 108 DIE..... 02018000
- DS 0D 02019000
- TIECCW DC X'1B' TRACK IN ERROR COMMAND CODE 02020000
- DC AL3(TIEBYTE) ADDR OF TRACK IN ERROR 02021000
- DC X'60000001' CHAIN BIT ON SLI BIT ON 02022000
- TIECCW1 DC X'0000000000000000' SPACE FOR INSERTING READ CCW 02023000
- TIEBYTE DC X'00' SPACE TO INSERT SENSE BYTE TWO 02024000
- DS 0F 02025000
- READTEN DC X'0000000A' COUNT OF RETRIES 02026000
- READSET DC X'0000000A' RESTORE VALUE 02027000
- CLEANCTR DC X'0000000A' COUNT OF TAPE CLEANER RETRYS 02028000
- CLEANSET DC X'0000000A' RESTORE VALUE 02029000
- DS 0F 02030000
- EIGHT DC F'08' 02031000
- TWELVE DC H'12' 02032000
- SENSFLD DC 6X'00' 02033000
- DISABLE DC X'00' 02034000
- CSWSAV DC 2F'00' 02035000
- DS 0D 02036000
- CLEANTP DC X'27' BACKSPACE OP CODE 02037000
- DC X'00000060000001' CHAIN BIT ON SLI BIT ON 02038000
- DC X'27' BACKSPACE OP CODE 02039000
- DC X'00000060000001' CHAIN BIT ON SLI BIT ON 02040000
- DC X'37' FOWARD SPACE OP CODE 02041000
- DC X'00000060000001' CHAIN BIT ON SLI BIT ON 02042000
- DC X'37' FOWARD SPACE OP CODE 02043000
- DC X'00000020000001' CHAIN BIT OFF SLI BIT ON 02044000
- DS 0D 02045000
- BSPACE DC X'27' BACKSPACE OP CODE 02046000
- DC X'00000020000001' REST OF CCW 02047000
- SENSCCW DC X'04' SENSE CCW OP CODE 02048000
- DC AL3(SENSFLD) ADDR OF READIN AREA 02049000
- DC X'20000006' REST OF CCW 02050000
- LPSWITCH DC X'00' SWITCH AT EE DATA CHECK AT LP 02051000
- CLEAR DC XL8'00' 02052000
- CNOP 0,8 02053000
- ERRPSW DC X'00020000' 02054000
- DC X'0000FFFF' 02055000
- EQCKMSG DC A(REQCKMSG) 02056000
- DC AL2(RNOTOPMG-REQCKMSG) 02057000
- NOTOPMG DC A(RNOTOPMG) 02058000
- DC AL2(RUNRECMG-RNOTOPMG) 02059000
- UNRECMG DC A(RUNRECMG) 02060000
- DC AL2(RLPMSG-RUNRECMG) 02061000
- LPMSG DC A(RLPMSG) 02062000
- DC AL2(RRDATCK-RLPMSG) 02063000
- SECDBASE DC A(RELDR+4096) 02064000
- RDATCKMG DC A(RRDATCK) 02065000
- DC AL2(LASTMSG-RRDATCK) 02066000
- REQCKMSG DC C'TAPE EQUIP CHECK' 02067000
- RNOTOPMG DC C'TAPE NOT OPERATIONAL' 02068000
- RUNRECMG DC C'UNRECOVERABLE TAPE ERROR' 02069000
- RLPMSG DC C'TAPE AT LOAD POINT' 02070000
- RRDATCK DC C'TAPE READ DATA CHECK' 02071000
- LASTMSG EQU * 02072000
- EJECT 02073000
- DROP 3 02074000
- DROP 4 02075000
- ********************************************************************* 02076000
- * CHANGE PRINTER AND TYPEWRITER ADDRESS ROUTINE 02077000
- ********************************************************************* 02078000
- L 15,ARELDR LOAD ADDR OF RELDR 02079000
- USING RELDR,15 02080000
- DEVHNDLR STM 0,15,SAV 02081000
- C 1,DEV 02082000
- BE PROC 02083000
- MVI DEVSW,X'00' 02084000
- BAL 14,PAGER 02085000
- LM 0,15,SAV 02086000
- B CONTINU 02087000
- CNOP 0,8 02088000
- DC X'00020000FFFFFFFF' 02089000
- WAITLCMG LPSW *-8 02090000
- PROC LA 5,SPEC+4(,13) SET UP TO SCAN THE FIRST FIELD 02091000
- LA 6,1 02092000
- LA R7,SPEC+71(,R13) SET UPPER LIMIT TO SCAN @VA04726 02093100
- LOOKUP CLI 0(5),C' ' IS THIS A BLANK 02094000
- BC 8,BPNTR 02095000
- SCAN CLC 0(5,5),TYP 02096000
- BE TYPTR 02097000
- CLC 0(5,5),PRT 02098000
- BE PRTER 02099000
- BAD MVC 0(15,0),MSG2 02100000
- B WAITLCMG 02101000
- BPNTR BXLE 5,6,LOOKUP 02102000
- B NXTCARD 02103000
- PRTER LA 5,5(5) 02104000
- BAL 14,PACKUNT 02105000
- MVC PRNTR,PAREA1 02106000
- MVC PRNTSET,PRNTR 02107000
- B RTN 02108000
- TYPTR LA 5,5(5) 02109000
- BAL 14,PACKUNT 02110000
- MVC CNSL,PAREA1 02111000
- RTN LA 5,3(5) 02112000
- CLI 0(5),C',' 02113000
- BE BPNTR YES, GO CHECK NEXT COL. @VA04087 02114000
- CLI 0(R5),C' ' BLANK? @VA04087 02115000
- BE BPNTR YES, GO CHECK NEXT COL. @VA04087 02116000
- B BAD INVALID DEV CARD @VA04087 02117000
- NXTCARD BAL 14,PAGER 02118000
- MVI DEVSW,X'00' 02119000
- LM 0,15,SAV 02120000
- BC 15,RD 02121000
- PACKUNT LA 1,3 GET NUMBER OF DIGITS @VA10508 02122100
- SR 3,3 CLEAR WORK REG @VA10508 02122600
- LR 4,5 POINT TO DEVICE ADDRESS @VA10508 02123100
- GETNEXT MVC PAREA2,0(4) LOAD FOR CHECKING @VA10508 02123600
- SLL 3,4 SHIFT THE GENERATED ADDRESS @VA10508 02124100
- CLI PAREA2,X'C1' IS IT A? @VA10508 02124600
- BL BADDEV LOWER THAN A -- NO GOOD @VA10508 02125100
- CLI PAREA2,X'C6' MAYBE F @VA10508 02125600
- BH NOTALPH HIGHER THAN F @VA10508 02126100
- XI PAREA2,X'C0' CLEAR 'C' @VA10508 02126600
- AH 3,DIG9 ADD ADJUSTMENT @VA10508 02127100
- B ADDDIG GO FINISH THE PACK @VA10508 02127600
- DIG9 DC X'0009' ADJUSTMENT NUMBER @VA10508 02128100
- NOTALPH CLI PAREA2,X'F0' IS IT NUMERIC? @VA10508 02128600
- BL BADDEV NO--NOT A VALID DEV ADDRESS @VA10508 02129100
- XI PAREA2,X'F0' CLEAR 'F' @VA10508 02129600
- ADDDIG AH 3,PAREA ADD LOW ORDER BITS @VA10508 02130100
- LA 4,1(4) INDEX THE POINTER @VA10508 02130600
- BCT 1,GETNEXT HAVE WE DONE THREE? @VA10508 02131100
- STH 3,PAREA1 @VA10508 02131600
- BR 14 02136000
- BADDEV MVC 0(24,0),MSG3 02137000
- B WAITLCMG 02138000
- DEVSW DS CL1 02144000
- SAV DS 16F 02145000
- MSG2 DC C'BAD DEVICE CARD' 02146000
- MSG3 DC C'INVALID DEVICE SPECIFIED' 02147000
- PRT DC C'PRNT=' 02148000
- TYP DC C'TYPW=' 02149000
- CTN DC H'0' 02150000
- PARLMT DC H'0' 02151000
- UNT DC X'000A0B0C0D0E0F' 02152000
- PAREA1 DC H'0' 02153000
- PAREA DC X'0' @VA10508 02154000
- PAREA2 DC X'0' @VA10508 02154500
- DS F 02155000
- DEV DC X'02' 02156000
- DC C'DEV' 02157000
- DS 0F 02158000
- ARELDR DC A(RELDR) ADDRESS OF BASE MODULE 02159000
- EJECT 02160000
- *********************************************************************** 02161000
- * STORAGE USING REGISTER 13 AND THE FOLLOWING SYMBOLS 02162000
- *********************************************************************** 02163000
- * 02164000
- * TO BEGIN ON DOUBLE WORD BOUNDRY 02165000
- * 02166000
- NOESD EQU 512 NUMBER OF EXTERNS IN 1 MODULE 02167000
- MAXREF EQU 1280 NUMBER OF TYPE 0 & 1 ESD ENTRIES @VA03724 02168000
- * 02169000
- GREG EQU 0 16 WORDS, GEN REGS SAVED BY RELLDR 02170000
- EMSG EQU GREG+64 4 BYTES TO INDICATE ERROE 02171000
- RETT EQU 0 USED BY HEXB SUBROUTINE 02172000
- LOCCT EQU RETT+4 4 BYTES LOC TO BEGIN LOADING (ADDR SV 02173000
- NARG EQU LOCCT+4 4 BYTES ,NO. OF ARG. IN INPUT LIST 02174000
- MVC1 EQU NARG+4 THESE TWO INITIALIZED BY DOLLA. 02175000
- MVC2 EQU MVC1+6 .. 02176000
- WD EQU MVC2+6 4 BYTES, STORAGE FOR RLD SBR 02177000
- BRAD EQU WD+4 4 BYTES, STORAGE 02178000
- SPEC EQU BRAD+4 80 BYTES-------------THE I/O BUFFER 02179000
- CONS EQU SPEC+80 4 BYTES-B7000000 STORAGE 02180000
- * EQU CONS+1 FORMERLY SWS(13) 02181000
- ESIDTB EQU CONS+4 64 BYTES A TABLE 02182000
- TBLCT EQU CONS+2 1 BYTES - NO OF ENTRIES IN TBLREF 02183000
- TBLREF EQU ESIDTB+NOESD*2 HALFWORD ENTRIES 02184000
- APSV EQU TBLREF+4 64 BYTES - REG SAVED 02185000
- PLIST EQU APSV+64 4 BYTES, POINTER TO PARAM LIST 02186000
- TEMPST EQU PLIST+4 02187000
- TMPLOC EQU TEMPST+4 02188000
- FREEST EQU TMPLOC+4 02189000
- EPSV EQU FREEST+4 02190000
- EJECT 02191000
- * 02192000
- * THE OPERATION OF THIS PROGRAM DEPENDS UPON 02193000
- * AN INTERNAL REPRESENTATION OF THE EXTERNAL 02194000
- * CHARACTER SET WHICH IS EQUIVALENT TO THE ONE 02195000
- * USED AT ASSEMBLY TIME. THE CODING HAS BEEN 02196000
- * ARRANGED SO THAT REDEFINITION OF CHARACTER 02197000
- * CONSTANTS, BY REASSEMBLY, WILL RESULT IN A 02198000
- * CORRECT MODULE FOR THE NEW DEFINITIONS. 02199000
- * THE CONSTANTS WITH *** IN COL. 69-71 REQUIRE 02200000
- * THE X'02' EQUAL A T-2-9 PUNCH AND MUST BE 02201000
- * MODIFIED IF THE PROPERTIES OF THE CHARACTER 02202000
- * SET ARE CHANGED. 02203000
- EJECT 02204000
- * 02205000
- LDRGEN DS 0D -LOADER CONTROL- 02206000
- * 02207000
- * 02208000
- EOPSW EQU 24 EXTERNAL OLD PSW 02209000
- MCOP EQU 32 SUPERVISOR CALL OLD PSW 02210000
- PRLOD EQU 40 PROGRAM OLD PSW 02211000
- IOOP EQU 56 I/O OLD PSW 02212000
- CSW EQU 64 CHANNEL STATUS WORD ADDR 02213000
- CAW EQU 72 CHANNEL ADDRESS WORD 02214000
- EXNPSW EQU 88 EXTERNAL NEW PSW 02215000
- NSVCPSW EQU 96 SUPERVISOR CALL NEW PSW 02216000
- NPROG EQU 104 PROGRAM NEW PSW 02217000
- MKNEW EQU 112 MACHINE CHECK NEW PSW 02218000
- NIOPSW EQU 120 I/O NEW PSW 02219000
- * 02220000
- ZUSER EQU 2048 SET BY CONTROL PROGRAM OR IPL SIMULATOR 02221000
- * 02222000
- EJECT 02223000
- BALR 15,0 02224000
- USING *,15 02225000
- L 4,IOTAA LOD BUFFER ADDR 02226000
- LH 8,DEVICE OUTPUT DEVICE ADDRESS 02227000
- LA 11,QRCD I/O ROUTINE ADDR 02228000
- LR 1,8 DEVICE ADDR TO REG-1 02229000
- SRL 1,8 ADJUST REG TO DEVELOP 02230000
- LA 2,256 CHANNEL MASK 02231000
- N6 SRL 2,1 CHANNEL MASK 02232000
- SH 1,N6+2 COUNT DOWN 02233000
- BC 10,N6 BR IF NOT CORRECT CHAN 02234000
- STC 2,WAIT1X CHAN MASK TO WAIT PSW 02235000
- LA 2,1(2) INCLUDE EXTERNAL INTERUP 02236000
- STC 2,WAIT2X 02237000
- STC 2,WAIT3X CHAN MASK TO WAIT PSW 02238000
- MVI CMD+1,EJECT EJECT LAST CARD. 02239000
- SR 1,1 02240000
- LA 2,ERR 02241000
- BALR 12,11 BR TO I/O ROUTINE 02242000
- CLL L 1,IOTAA LOD BUFF ADDR 02243000
- ST 1,TOPX PLACE BUF ADDR IN BOOT- 02244000
- MVI TOPX,X'02' MOVE IN READ C6MMAND. 02245000
- ST 1,CARD3 STORE ADDRESS IN 3RD IPL CCW @VA02018 02246000
- MVI CARD3,X'02' RESTORE READ OP CODE @VA02018 02247000
- LA 1,80(1) BUMP ADDR TO NEXT CARD @VA02018 02248000
- ST 1,CRD3CCW2 STORE ADDRESS IN 4TH IPL CCW @VA02018 02249000
- MVI CRD3CCW2,X'02' RESTORE READ OP CODE @VA02018 02250000
- LA 1,80(1) MOD I/P BUF ADDR 02251000
- ST 1,IPLCCW STORE ADDRESS IN 1ST IPL CCW @VA02018 02252000
- MVI IPLCCW,X'02' RESTORE READ OP CODE @VA02018 02253000
- ST 1,IPCCW2 STORE ADDRESS 02254000
- MVI IPCCW2,X'08' RESTORE TIC OP CODE @VA02018 02255000
- LOXP L 14,ENDE OBJECT PROG END ADDR 02256000
- L 13,START OBJECT PROG START ADDR 02257000
- SR 14,13 DIFF = NUM OF BYTES TO PCH 02258000
- MVI MVCX+1,71 RESTORE BYTE COUNT 02259000
- MVI CMD+1,WRITEC WRITE AND EJECT 02260000
- MVI CCW1+7,24 IPL CARD BYTE COUNT 02261000
- LA 1,IPLPSW ADDR OF IPL CARD 02262000
- LA 2,ERR ERROR RETURN 02263000
- BALR 12,11 BR TO I/O ROUTINE 02264000
- MVI CCW1+7,80 02265000
- LA 1,ENTRY+160 3RD CARD OF BOOTSTRAP RTN @VA02018 02266000
- LA 2,ERR ERROR RETURN @VA02018 02267000
- BALR 12,11 BR TO I/O ROUTINE @VA02018 02268000
- LA 1,ENTRY BOOTSTRAP ROUTINE ADDR 02269000
- LA 2,ERR 02270000
- BALR 12,11 BR TO I/O ROUTINE 02271000
- LA 1,ENTRY+80 PCH SECOND BOOTSTRAP 02272000
- LA 2,ERR CARD 02273000
- BALR 12,11 WRITE RECORD 02274000
- LA 10,72 LOD RECORD BYTE SIZE 02275000
- EXC L 7,CONUM RESTORE TO ZEROS 02276000
- LA 6,10 SETUP CARD SEQ PATTERN 02277000
- LA 5,10 SEQUENCE CONTROLS 02278000
- PCH L 1,BETAA+4 LOD BLANKS TO REPLACE 02279000
- ST 1,0(0,4) BYTES 1-75 IN BUFFER 02280000
- MVC 1(75,4),0(4) 02281000
- MVCX MVC 0(72,4),0(13) MOVE TXT TO BUFFER 02282000
- ST 7,76(0,4) ST SEQ NUM 02283000
- LR 1,4 SETUP I/O CALL 02284000
- LA 2,ERR 02285000
- BALR 12,11 WRITE RECORD 02286000
- PCH1 LA 1,1 LOD SEQ INCREMENT 02287000
- TM ERR0+4,X'80' TEST LAST CRD SWITCH 02288000
- BC 1,OUT BR IF LAST CARD 02289000
- AR 13,10 MODIFY FOR NEXT RECORD 02290000
- LR 9,14 SAVE REMAINING BYTE COUNT 02291000
- AR 7,1 INCREMENT CARD SEQ 02292000
- BCT 5,LO2 02293000
- LA 5,10 RESTORE COUNTER 02294000
- SRL 7,8 ADJUST FOR NEXT CTR 02295000
- AR 7,1 INCREMENT CARD SEQ 02296000
- SLL 7,8 REAJUST REGISTER 02297000
- IC 7,CONUM INSERT ZERO 02298000
- BCT 6,LO2 CONTROL 02299000
- LA 6,10 RESTORE COUNTER 02300000
- SRL 7,16 ADJUST TO HUNDREDS POSITION 02301000
- LO1 AR 7,1 INCREMENT CARD SEQ 02302000
- SLL 7,8 LOD ZEROS 02303000
- IC 7,CONUM LOD ZEROS 02304000
- SLL 7,8 LOD ZEROS 02305000
- IC 7,CONUM LOD ZEROS 02306000
- IC 1,SSM+1 HUNDREDS POSITION COUNTER 02307000
- SH 1,PCH1+2 HUNDREDS POSITION CTL 02308000
- STC 1,SSM+1 RESTORE COUNTER 02309000
- BC 2,LO2 02310000
- LA 1,10 COUNTER WRAPS AROUND 02311000
- STC 1,SSM+1 RESTORE TO ZEROS 02312000
- EX 0,EXC RESTORE TO ZEROS 02313000
- SRL 1,3 RESTORE ONE IN REG 02314000
- LO2 SR 14,10 MODIFY FOR NEXT RECORD 02315000
- *********************************************************************** 02316000
- BC 8,OUT BR IF NOTHING MORE 02317000
- *********************************************************************** 02318000
- CR 14,10 CHECK REMAINING. 02319000
- BC 11,PCH RETURN FOR MORE. 02320000
- OI ERR0+4,X'80' LAST CRD SW ON 02321000
- SR 14,1 SETUP MOVE INST. 02322000
- STC 14,MVCX+1 .. 02323000
- *********************************************************************** 02324000
- BC 15,PCH 02325000
- OUT NI ERR0+4,X'7F' SWITCH OFF 02326000
- LA 1,24 SETUP TO PUNCH END CRD 02327000
- STH 1,CCW1+6 STORE BYTE COUNT 02328000
- MVI CEND+1,C'L' FLAG LAST CARD 02329000
- MVI CEND+2,C'D' ... 02330000
- LA 1,CEND END CARD ADDRESS 02331000
- LA 2,ERR 02332000
- BALR 12,11 BR TO I/O ROUTINE 02333000
- LH 1,CON LOAD DECK COUNT 02334000
- SH 1,PCH1+2 SUBTRACT ONE FROM REG 02335000
- STH 1,CON RESTORE COUNT 02336000
- BC 2,LOXP BR IF COUNT NOT ZERO 02337000
- L 6,EASY LOD EOJ INDICATOR 02338000
- ST 6,ERR0+4 ST IN PSW IMAGE 02339000
- LPSW ERR0 END-OF-JOB 02340000
- * 02341000
- ERR LPSW ERR0 AB-END-OF-JOB 02342000
- * 02343000
- DEVICE DC AL2(OUTPUT) CELL FOR DEVICE ADDR 02344000
- CON DC XL2'1' PUNCH X MANY DECKS 02345000
- * 02346000
- DS 0D 02347000
- ERR0 DC X'0006000000' 02348000
- DC C'GNA' DEVICE NOT AVAILABLE 02349000
- * 02350000
- IPLPSW DC X'00040000' 02351000
- * 02352000
- IOTAA DC A(IOTA) BUFFER ADDRESS 02353000
- * 02354000
- IPLCCW DC X'02' 02355000
- DC AL3(IOTA+160) CCW FOR READING IN 3RD @VA02018 02356000
- * BOOTSTRAP CARD 02357000
- DC X'60000050' 02358000
- IPCCW2 DC X'08' TIC CCW @VA02018 02359000
- DC AL3(IOTA+160) TIC TO 3RD CARD, JUST READ IN @VA02018 02360000
- DC X'00000000' @VA02018 02361000
- CEND DC X'02' *** 02362000
- DC C'XX' END OF LOADER FLAG 02363000
- DC X'02' ... 02364000
- BETAA DC A(BETA) LOAD END TR ADDR 02365000
- DC C' 01' 02366000
- DC C' ' 02367000
- CONUM DC C'0000' CONSTANT ZEROS 02368000
- ENDE DC A(OMEGA) 02369000
- START DC A(ALPHA) 02370000
- EASY DC C' GEA' EOJ 02371000
- * 02372000
- ALPHAA EQU START 02373000
- OMEGAA EQU ENDE 02374000
- * 02375000
- DROP 15 02376000
- EJECT 02377000
- *********************************************************************** 02378000
- * 02379000
- * CARD READ ROUTINE 02380000
- * 02381000
- *********************************************************************** 02382000
- * 02383000
- USING *,11 -ADDRESSIBILITY- 02384000
- QRCD ST 1,CCW1 I/O BUFFER ADDR 02385000
- CMD MVI CCW1,X'02' I/O COMMAND 02386000
- LA 1,CCW1 SETUP CHAN ADDR WORD 02387000
- ST 1,CAW 02388000
- ST 2,REG2 SAVE REGISTER TWO 02389000
- LA 1,WAITX NORMAL WAIT PSW 02390000
- LA 2,TIOA CHAN BUSY RETURN 02391000
- TIOA TIO 0(8) CLEAR CHANNEL 02392000
- BC 1,ERRR1X 02393000
- GO LA 0,SIOD LOD INTERRUPTION ADDR 02394000
- ST 0,NIOPSW+4 ST AT I/O NEW PSW 02395000
- SSM SSM MASK OUT OTHER CHANNELS 02396000
- SIOA SIO 0(8) CMD TO READ/WRITE 02397000
- BCR 8,1 CMD ACCEPTED,WAIT 02398000
- BCR 2,2 TO RETRY,CHAN BUSY 02399000
- TM CSW+4,X'10' TEST FOR UNIT BUSY 02400000
- BCR 1,2 BR-UNIT BUSY 02401000
- BC 15,TEST TEST CONDITIONS 02402000
- SIOD CH 8,IOOP+2 TEST CHAN AND DEVICE 02403000
- BC 8,*+8 TEST FURTHER IF SAME 02404000
- LPSW IOOP OTHERWISE WAIT 02405000
- * 02406000
- TEST TM CSW+5,X'3F' TEST FOR CHANNEL ERROR 02407000
- BC 7,ERRR1X CHAN ERROR BR 02408000
- TM CSW+4,X'0E' DATA ERROR CHECK 02409000
- BC 1,SIOC INDICATE THRU WAIT 02410000
- TM CSW+4,X'0A' DATA ERROR CHECK 02411000
- BC 1,SIOC INDICATE THRU WAIT 02412000
- TM CSW+4,X'06' DATA ERROR CHECK 02413000
- BC 1,SIOC INDICATE THRU WAIT 02414000
- TM CSW+4,X'02' INTERVENTION REQUIRED 02415000
- BC 1,SIOB HOPPER EMPTY 02416000
- TM CSW+4,X'01' LAST CRD TEST 02417000
- BC 1,LAST BR IF LAST CRD READ 02418000
- TM CSW+4,X'04' TEST FOR DEVICE END 02419000
- BC 8,WAIO BR TO WAIT FOR IT 02420000
- BCR 15,12 RETURN 02421000
- * 02422000
- WAIO LPSW IOOP WAIT FOR DEVICE END 02423000
- * 02424000
- LAST L 12,REG2 LAST CRD RETURN ADDR 02425000
- BCR 15,12 RETURN TO OBJECT PROG 02426000
- * 02427000
- WAITX LPSW WAIT1X NORMAL WAIT 02428000
- * 02429000
- SIOB ST 2,EXNPSW+4 READY READER WAIT 02430000
- LPSW WAIT2X 02431000
- * 02432000
- SIOC ST 2,NIOPSW+4 DATA ERROR(S) 02433000
- LPSW WAIT3X 02434000
- * 02435000
- ERRR1X ST 2,NIOPSW+4 02436000
- ST 2,EXNPSW+4 02437000
- LPSW WAIT4X 02438000
- * 02439000
- REG2 DS 1F 02440000
- SSM DC X'0009' MASK OFF ALL CHAN 02441000
- * 02442000
- DS 0D 02443000
- CCW1 DC X'0000000020000050' 02444000
- * 02445000
- WAIT1X DC X'8006' NORMAL WAIT 02446000
- DC XL6'F' PSW 02447000
- * 02448000
- WAIT2X DC X'0106' INTERRUPT TO RESUME 02449000
- DC XL3'0' 02450000
- DC C'GIA' HOPPER EMPTY 02451000
- * 02452000
- * WAIT3X DATA ERROR(S) CHECK 02453000
- * 02454000
- WAIT3X DC X'8106' 02455000
- DC XL3'0' 02456000
- DC C'GDD' DATA ERROR 02457000
- * 02458000
- * WAIT4X CHANNEL ERROR(S) 02459000
- * 02460000
- WAIT4X DC X'0106' INTERRUPT TO RESUME 02461000
- DC XL3'0' 02462000
- DC C'GCA' CHANNEL ERROR 02463000
- DROP 11 02464000
- * 02465000
- NOP EQU 3 02466000
- EJECT EQU NOP 02467000
- WRITEC EQU 1 02468000
- OUTPUT EQU X'D' 02469000
- FREE DS 0D 02470000
- ENTRY FRINIT FREE STORAGE INITIALIZATION 02471000
- ENTRY FRET RETURN FREE STORAGE BLOCKS 02472000
- SPACE 02473000
- SPACE 02474000
- * BLOCK DEFINITIONS 02475000
- * 02476000
- BSIZE EQU 0 BACKWARD SIZE POINTER. 02477000
- FSIZE EQU 4 FORWARD SIZE POINTER 02478000
- BSTOR EQU 8 BACKWARD STORAGE POINTER 02479000
- FSTOR EQU 12 FORWARD STORAGE POINTER 02480000
- SIZE EQU 16 LOCATION OF SIZE BYTE (IF NOT TWO) 02481000
- SPACE 02482000
- CTLSIZ EQU 16 CONTROL LIST SIZE 02483000
- CTLCNT EQU 20 CONTROL LIST USAGE COUNT 02484000
- CTLLEN EQU 32 02485000
- * 02486000
- EJECT 02487000
- *********************************************************************** 02488000
- * 02489000
- * 'FREE' IS THE ENTRY TO OBTAIN BLOCKS OF FREE STORAGE 02490000
- * OF A SPECIFIED SIZE. ITS OPERATION IS DESCRIBED BELOW. 02491000
- * 02492000
- * 'FREE' SEARCHES DOWN THE LIST OF SPECIFIED SIZES 02493000
- * FOR A MATCH WITH THE REQUEST. IF IT FINDS AN ENTRY WHICH 02494000
- * CONTAINS SOMETHING ON ITS STRING, IT WILL DETACH THE FIRST 02495000
- * BLOCK ON THE STRING AND RETURN IT TO THE USER. IF IT FAILS TO 02496000
- * FIND A MATCHING ENTRY, IT WILL LOOK ON THE JUNK LIST FOR AN 02497000
- * ENTRY OF A LARGER SIZE. IF IT FINDS ONE, IT WILL SPLIT OFF 02498000
- * THE USER'S REQUEST FROM THE TOP AND RETURN THE BOTTOM HALF 02499000
- * TO FREE STORAGE VIA A CALL TO 'FRET'. IF IT FAILS TO FIND ONE, 02500000
- * IT WILL LOOK ON THE LIST OF STANDARD SIZES FOR A LARGER SIZE. 02501000
- * IF IT FINDS ONE, IT WILL PERFORM THE SAME OPERATION AS FOR THE 02502000
- * JUNK LIST. IF IT FAILS, IT WILL CALL THE USER ROUTINE 'EXTEND' 02503000
- * FOR AN INCREASE IN THE 'MEMORY BOUND' AND PROCEED TO TRY AGAIN 02504000
- * 02505000
- * IT CHECKS TO SEE WHETHER 'FRINIT' HAS BEEN PREVIOUSLY CALLED 02506000
- * (BY 'FRLIST' BEING NON-ZERO). IF NOT IT WILL INITIALIZE ITSELF 02507000
- * INTERNALLY TO AN ALL GARBAGE LIST AND CLEAR OUT THE STORAGE 02508000
- * THREAD POINTER. 02509000
- * 02510000
- ********************************************************************** 02511000
- SPACE 02512000
- USING *,R15 ADDRESSIBILITY- 02513000
- SPACE 02514000
- STM R0,R15,FREREG SAVE REGISTERS 02515000
- ST R14,RETREG SAVE RETURN REG. 02516000
- BAL R5,ROUNDUP ROUND UP TO 3 DW BOUNDARY 02517000
- STH R0,NREQ SAVE NUM. OF DW'S WANTED. 02518000
- SLR R3,R3 CLEAR OUT LSTENT FOR USAGE COUNTER 02519000
- ST R3,LSTENT ... 02520000
- FREEX SLR R3,R3 ZERO REG 02521000
- L R1,FRLIST GET ADDRESS OF FREE CONTROL LIST. 02522000
- LTR R1,R1 CHECK FOR PROPER FRINIT INITIALIZATION. 02523000
- BNZ FREE3 YES. 02524000
- LA R1,FRGARB NO - GET GARBAGE LIST POINTER. 02525000
- ST R1,FRLIST ... 02526000
- ST R3,STHRED CLEAR OUT STORAGE THREAD. 02527000
- FREE3 L R2,CTLSIZ(R1) GET COUNT VALUE 02528000
- LTR R2,R2 AND TEST FOR END OF LIST. 02529000
- BZ FREE1 IF END OF LIST BRANCH 02530000
- CR R0,R2 COMPARE FOR DESIRED VALUE. 02531000
- BE FREE2 YES - FOUND ONE 02532000
- BNM FREE4 NO- SAVE STRING WITH HIGHER VALUE 02533000
- LTR R3,R3 SEE IF WE HAVE A HIGHER ONE. 02534000
- BNZ FREE4 YES - WE DO 02535000
- L R3,FSIZE(R1) NO - PICK UP ADDRESS. 02536000
- FREE4 LA R1,CTLLEN(R1) GO GET NEXT ELEMENT. 02537000
- B FREE3 ... 02538000
- SPACE 02539000
- FREE2 ST R1,LSTENT SAVE LIST ENTRY. 02540000
- L R4,FSIZE(R1) GET FORWARD SIZE POINTER. 02541000
- LTR R4,R4 ... 02542000
- BZ FREE4 ZERO - NO HIGHER VALUE - GO TO MISC. 02543000
- LR R1,R4 SAVE FOR UNZIP. 02544000
- SPACE 02545000
- FREE6 BAL R10,UNZIP REMOVE FROM ITS LIST (POINTED TO BY 1) 02546000
- SPACE 02547000
- FREXIT L R2,LSTENT BUMP USAGE COUNTER. 02548000
- L R3,CTLCNT(R2) .. 02549000
- LA R3,1(R3) ... 02550000
- ST R3,CTLCNT(R2) ... 02551000
- LM R2,R15,FREREG+8 RESTORE REGISTERS 02552000
- LH R0,NREQ RETURN REQUESTED NUMBER ALSO. 02553000
- L R14,RETREG RESTORE RETURN REGISTER 02554000
- BR R14 EXIT. 02555000
- SPACE 02556000
- FREE1 L R4,LSTENT CHECK FOR SOMETHING IN LSTENT. 02557000
- LTR R4,R4 IS ANYTHING THERE ? 02558000
- BNZ *+8 YES - DON'T CHANGE IT. 02559000
- ST R1,LSTENT NO - ASSUME GARBAGE REQUEST. 02560000
- L R1,FSIZE(R1) ... 02561000
- LTR R1,R1 02562000
- BNZ FREE9 EXTRACT IF THERE IS 02563000
- FREE7A LTR R1,R3 IS THERE ANYTHING IN A LARGER SIZE ? 02564000
- BNZ FREE9 YES - EXTRACT FROM THERE. 02565000
- SPACE 02566000
- FREE7 LR R3,R15 PREPARE TO CALL FOR EXTENSION OF MEMORY. 02567000
- L R5,AFRET CALL FREE RETURN. 02568000
- L R15,AEXTND CALL FOR EXTENSION. 02569000
- BALR R14,R15 ... 02570000
- LR R15,R5 ... 02571000
- SRA R0,3 NO. OF BYTES TO DOUBLE WORDS. 02572000
- BALR R14,R15 ... 02573000
- LR R15,R3 RESTORE ADDRESSABILITY 02574000
- LH R0,NREQ RELOAD NUMBER REQUESTED 02575000
- B FREEX AND CONTINUE FROM START. 02576000
- SPACE 02577000
- FREE5 L R1,FSIZE(R1) GO DOWN LIST TO FIND LARGER OR EQUAL. 02578000
- LTR R1,R1 WAS ANYTHING FOUND. 02579000
- BZ FREE7A NO - LIST EMPTY. 02580000
- FREE9 L R2,SIZE(R1) GET SIZE OF THIS BEAD. 02581000
- CR R0,R2 COMPARE AGAINST REQUEST 02582000
- BE FREE6 EQUAL. 02583000
- BH FREE5 HIGH. 02584000
- SPACE 02585000
- FREE8 BAL R10,UNZIP REMOVE TOP SECT. OF LARGER BEAD 02586000
- L R2,SIZE(R1) FORM TOP ADDRESS OF NEW BEAD. 02587000
- SLR R2,R0 NEW LENGHT 02588000
- ST R2,SIZE(R1) SAVE NEW LENGTH OF OLD HOLE. 02589000
- LR R4,R0 ... 02590000
- SLA R4,3 ... 02591000
- LR R3,R1 SAVE REG 1 FOR CALL TO 'FRET' 02592000
- AR R1,R4 ... 02593000
- L R0,SIZE(R3) RESTORE SIZE OF NEWLY FORMED. 02594000
- LR R5,R15 SAVE ADDRESSABILITY AND RETURN 02595000
- L R15,AFRET CALL FREE RETURN. 02596000
- BALR R14,R15 ... 02597000
- LR R15,R5 RESTORE ADDRESSABILITY. 02598000
- LR R1,R3 RESTORE ADDRESS TO RETURN TO USER. 02599000
- B FREXIT EXIT.. 02600000
- SPACE 02601000
- EJECT 02602000
- ********************************************************************** 02603000
- * 02604000
- * 'FRET' IS CALLED TO RETURN BLOCKS TO FREE STORAGE. 02605000
- * ITS OPERATION IS DESCRIBED BELOW--- 02606000
- * 02607000
- * 'FRET' SEARCHES THROUGH A 'STORAGE' THREAD 02608000
- * IN ORDER TO DETERMINE IF THE RETURNED BLOCKS ADJOINS A BLOCK 02609000
- * ALREADY IN FREE STORAGE. IF IT IS FOUND TO ADJOIN ON EITHER 02610000
- * OR BOTH ENDS, A NEW BLOCK IS FORMED OUT OF THE TWO BLOCKS AND 02611000
- * THE PROCESS IS REPEATED. IN THIS WAY, CORE FRAGMENTATION IS 02612000
- * AVOIDED AT THE COST OF SOME PROGRAM EFFICIENCY. 02613000
- * IF AN ATTEMPT IS MADE TO RETURN A WRONGLY ALIGNED (NOT DOUBLE 02614000
- * WORD BOUNDARIED) BLOCK TO FRET, A WAIT STATE PSW WILL BE 02615000
- * LOADED (WITH INTERRUPT AND MPX CHANNEL ENABLED) POINTING TO 02616000
- * 'FRET'. 02617000
- *********************************************************************** 02618000
- SPACE 02619000
- USING *,R15 ADDRESSABILITY 02620000
- SPACE 02621000
- FRET STM R0,R15,FRTREG SAVE REGISTERS 02622000
- BAL R5,ROUNDUP ROUND UP TO 3 DW BOUNDARY 02623000
- N R1,AMASK CLEAR OUT ALL BUT THE ADDRESS. 02624000
- TM FRTREG+7,X'07' TEST FOR WRONG ALIGMENT. 02625000
- BZ FRETX ALIGNMENT OK. 02626000
- SVC 109 DIE... 02627000
- FRETAD DC A(FRET) 02628000
- SPACE 02629000
- FRETX L R2,STHRED PICK UP STORAGE THREAD 02630000
- LA R3,FRLIST PICK UP THE ADDRESS OF STHRED. 02631000
- N R2,AMASK CLEAR OUT ALL BUT THE ADDRESS 02632000
- BNZ FRET1 NO. 02633000
- SPACE 02634000
- FRET3 SLR R4,R4 ZERO REG. 4 02635000
- ST R4,BSIZE(R1) ZERO OUT TOP REGISTER 02636000
- ST R4,BSTOR(R1) ... 02637000
- ST R4,FSIZE(R1) 02638000
- ST R4,FSTOR(R1) 02639000
- ST R3,BSTOR(R1) AND SAVE. 02640000
- ST R1,STHRED NEW POINTER ADDRESS. 02641000
- OI STHRED,X'80' INDICATE SINGLE LENGTH. 02642000
- B FRET8 02643000
- SPACE 02644000
- FRET1 L R2,FSTOR(R3) GET ADDRESS OF NEXT ELEMENT. 02645000
- LTR R2,R2 IS THERE ONE THERE 02646000
- BZ FRET2 NO - 02647000
- CR R1,R2 YES - COMPARE WITH PROVIDED ADDRESS. 02648000
- BL FRET2 ELEMENT DOES HERE. 02649000
- LR R3,R2 ADVANCE A STAGE 02650000
- B FRET1 ... 02651000
- SPACE 02652000
- FRET2 LR R4,R3 SEE IF NEW ONE SPLICES WITH OLD ONE. 02653000
- L R5,SIZE(R3) ... 02654000
- SLA R5,3 EXPAND INTO BYTES 02655000
- AR R4,R5 FORM TOP ADDRESS OF BACKWARD. 02656000
- CR R4,R1 AND COMPARE WITH RETURN ADDRESS. 02657000
- BNE FRET6 NO MATCH. 02658000
- SRA R5,3 RECOMPRESS LENGTH. 02659000
- AR R5,R0 A MATCH - MERGE COUNTS ONLY HERE. 02660000
- ST R5,SIZE(R3) ... 02661000
- LR R1,R3 ... 02662000
- LR R0,R5 NEW SIZE 02663000
- BAL R10,UNZIP REMOVE THIS ONE FROM ITS STRING 02664000
- B FRETX EXIT 02665000
- SPACE 02666000
- FRET6 LTR R2,R2 CHECK FOR END OF LIST. 02667000
- BZ FRET7A YES - END OF LIST 02668000
- LR R4,R1 SEE IF THIS ONE ADJOINS ONE ABOVE 02669000
- SLA R0,3 CHANGE DW'S TO BYTES 02670000
- AR R4,R0 ... 02671000
- SRA R0,3 RECOMPRESS LENGTH 02672000
- CR R4,R2 02673000
- BNE FRET7 NO MATCH. 02674000
- LR R3,R1 SAVE REGISTER 1 02675000
- LR R1,R2 AND LOAD REG 2 INTO REG 1 02676000
- LR R4,R0 AND SAVE REG 0 ALSO 02677000
- L R0,SIZE(R2) GET SIZE OF FORWARD BEAD. 02678000
- BAL R10,UNZIP AND REMOVE IT FROM STRING. 02679000
- AR R0,R4 GET NEW SIZE OF WHOLE THING. 02680000
- LR R1,R3 RETURN REG 1 02681000
- B FRETX AND RETURN TO START THE MESS AGAIN. 02682000
- SPACE 02683000
- FRET7A ST R2,FSTOR(R1) IT GOES AT THE END OF LIST - PATCH IT IN 02684000
- ST R1,FSTOR(R3) ... 02685000
- ST R3,BSTOR(R1) ... 02686000
- B FRET8 02687000
- SPACE 02688000
- FRET7 LR R4,R1 FORM COMPRESSED ADDRESS OF THIS BEAD. 02689000
- L R5,FSTOR(R3) ... 02690000
- ST R5,FSTOR(R1) ... 02691000
- L R5,BSTOR(R2) ... 02692000
- N R5,AMASK CLEAR OUT ALL BUT THE ADDRESS 02693000
- ST R5,BSTOR(R1) ... 02694000
- ST R4,FSTOR(R3) ... 02695000
- ST R4,BSTOR(R2) ... 02696000
- SPACE 02697000
- FRET8 L R2,FRLIST GET ADDRESS OF CONTROL LIST 02698000
- FRET9 L R3,CTLSIZ(R2) GET THE SIZE. 02699000
- LTR R3,R3 CHECK FOR ZERO 02700000
- BZ FRET10 ZERO - INSERT HERE IN MISCELLANEOUS 02701000
- CR R0,R3 COMPARE WITH REQUEST. 02702000
- BE FRET10 YES - MATCH 02703000
- LA R2,CTLLEN(R2) NO - BUMP POINTER 02704000
- B FRET9 ... 02705000
- FRET10 L R4,FSIZE(R2) ... 02706000
- ST R4,FSIZE(R1) PROCEED TO PATCH IN SIZE SLOT. 02707000
- ST R0,SIZE(R1) 02708000
- ST R2,BSIZE(R1) 02709000
- LTR R4,R4 02710000
- BZ *+8 02711000
- ST R1,BSIZE(R4) 02712000
- ST R1,FSIZE(R2) 02713000
- SPACE 02714000
- FRTXIT LM R0,R15,FRTREG RELOAD REGISTERS 02715000
- BR R14 RETURN TO CALLER 02716000
- SPACE 1 02717000
- ROUNDUP SLR R2,R2 CLEAR 02718000
- LR R3,R0 NUMBER OF DW INTO R3 02719000
- LA R3,2(,R3) ROUND TO 3 DW BOUNDARY 02720000
- LA R4,3 DIVIDE CONSTANT 02721000
- DR R2,R4 FIND NUMBER OF 3 DW FOR THIS REQUEST 02722000
- MR R2,R4 CONVERT BACK TO EVEN DIVISOR 02723000
- LR R0,R3 THIS IS THE NUMBER WE WILL GET UP 02724000
- BR R5 RETURN 02725000
- SPACE 02726000
- DROP R15 02727000
- SPACE 02728000
- EJECT 02729000
- *********************************************************************** 02730000
- * 02731000
- * 'FRINIT' IS THE INITIALIZATION ENTRY OF THE FREE STORAGE 02732000
- * PACKAGE. WITH IT THE USER PROVIDES A LIST OF STANDARD SIZES 02733000
- * WHICH WILL BE USED BY THE FREE STORAGE PACKAGE TO PROVIDE 02734000
- * SMALL ACCESS TIMES TO MOST OFTEN USED BLOCK SIZES. THE FORMAT 02735000
- * OF THE LIST IS AS FOLLOWS -- 02736000
- * 02737000
- * DS 0D -ALIGNMENT- 02738000
- *LIST EQU * LOCATION OF CONTROL LIST. 02739000
- * 02740000
- * DC 2D'0' WILL BE USED BY FREE PACKAGE FOR PNTR. 02741000
- * DC F'3' DESIGNATION OF SIZE OF THIS STRING 02742000
- * DC F'0' WILL BE USED AS COUNTER FOR NUM. OF 02743000
- * TIMES REFERENCED. 02744000
- * DC D'0' BOUNDARY ALIGNMENT. 02745000
- * 02746000
- * 02747000
- * DC 4D'0' END OF LIST DESIGNATOR. 02748000
- * 02749000
- *********************************************************************** 02750000
- SPACE 02751000
- USING *,R15 -ADDRESSABILITY- 02752000
- SPACE 02753000
- FRINIT STM R0,R15,FREREG SAVE REGISTERS 02754000
- ST R1,FRLIST SAVE ADDRESS OF FREE STORAGE CONTROL LIST 02755000
- SLR R3,R3 ZERO REG 02756000
- ST R3,STHRED ENSURE PROPER STORAGE INITIALIZATION 02757000
- FRINI2 L R4,CTLSIZ(R1) GET SIZE OF THIS LIST. 02758000
- ST R3,CTLCNT(R1) ZERO OUT VITAL PARTS OF CONTROL LIST. 02759000
- ST R3,BSIZE(R1) ... 02760000
- LTR R4,R4 SEE IF THIS IS END OF CONTROL LIST 02761000
- BZ FRINI1 YES - 02762000
- LA R1,CTLLEN(R1) NO - BUMP COUNT 02763000
- B FRINI2 GET NEXT ENTRY 02764000
- FRINI1 LM R0,R15,FREREG RELOAD REGISTERS 02765000
- BR R14 RETURN TO CALLER 02766000
- SPACE 02767000
- DROP R15 02768000
- SPACE 02769000
- EJECT 02770000
- *********************************************************************** 02771000
- * 02772000
- * 'UNZIP' IS AN INTERNAL ROUTINE CALLED TO REMOVED 02773000
- * THE FREE STORAGE BLOCK POINTED TO BY GPR 1 FROM ITS STRINGS. 02774000
- * 02775000
- *********************************************************************** 02776000
- SPACE 02777000
- UNZIP BALR R9,R0 -ADDRESSABILITY- 02778000
- USING *,R9 ... 02779000
- L R8,BSIZE(R1) REMOVE THIS ELEMENT FROM SIZE STRING 02780000
- LR R5,R8 ... 02781000
- L R6,FSIZE(R1) ... 02782000
- ST R6,FSIZE(R5) ... 02783000
- LTR R6,R6 02784000
- BZ *+8 BRANCH IF END OF LIST. 02785000
- ST R8,BSIZE(R6) .. 02786000
- L R8,BSTOR(R1) NOW PATCH STORAGE STRING FOR THIS ELEMENT 02787000
- N R8,AMASK REMOVE SIZE BIT. 02788000
- LR R5,R8 .. 02789000
- L R6,FSTOR(R1) 02790000
- ST R6,FSTOR(R5) 02791000
- LTR R6,R6 ARE WE AT END OF LIST 02792000
- BCR 8,R10 IF YES - RETURN TO CALLER 02793000
- ST R8,BSTOR(R6) NO 02794000
- BR R10 RETURN TO CALLER 02795000
- SPACE 02796000
- DROP R9 ADDRESSABILITY 02797000
- SPACE 02798000
- FREREG DS 16F STORAGE FOR FREE. 02799000
- FRTREG DS 16F FRET REGISTER SAVE AREA 02800000
- SPACE 02801000
- DS 0D -ALIGNMENT- 02802000
- FRLIST DS 1F ADDRESS OF FREE CONTROL LIST 02803000
- DC F'0' FILLER 02804000
- DC F'0' FILLER 02805000
- STHRED DC F'0' ADDRESS OF STORAGE THREAD (DOUBLE+4) 02806000
- DC F'0' FILLER 02807000
- DC F'0' FILLER 02808000
- AFRET DC A(FRET) ADDRESS OF FRET 02809000
- AEXTND DC A(EXTEND) ADDRESS OF EXTEND ROUTINE 02810000
- ONE DC F'1' CONSTANT OF (1) 02811000
- NREQ DS 1H NUM. OF DOUBLE WORDS DESIRED (FREE). 02812000
- HW3 DC H'3' MINIMUM NUMBER OF DW'S FOR FREE CALL 02813000
- SPACE 02814000
- DS 0F ALIGNMENT 02815000
- AMASK DC X'00FFFFFF' USED TO CLEAR OUT UNWANTED BITS 02816000
- RETREG DS 1F RETURN SAVE REGISTER 02817000
- LSTENT DS 1F POINTER TO ACTIVE LIST ENTRY. 02818000
- FRGARB DC 2D'0' DEFAULT GARBAGE LIST 02819000
- OMEGA DC CL160'O' END OF PROGRAM 02820000
- DS 0D ALIGEMENT 02821000
- IOTA DC CL240'I' INPUT CARD READIN AREA @VA02018 02822000
- LTORG @VA08517 02869010
- EJECT 02869020
- DS 0D @VA08517 02869030
- ENTRY L R13,4 ADDRESS OF "ENTRY" @VA08517 02869040
- USING ENTRY,R13 ESTABLISH ADDRESSABILITY @VA08517 02869050
- LH R1,2 OBTAIN IPL ADDRESS @VA08517 02869060
- SRL R1,8 CH PORTION TO LOW ORDER BITS @VA08517 02869070
- LA R2,1 INCREMENT @VA08517 02869080
- SR R3,R3 CLEAR WORK REG @VA08517 02869090
- AR R1,R2 INCREMENT CH NUMBER BY ONE @VA08517 02869100
- SHFTLOOP SRDL R2,1 R3 CONTAINS MASK BITS FOR CR2 @VA08517 02869110
- BCT R1,SHFTLOOP WHEN THRU... @VA08517 02869120
- STCM R3,B'1000',WAIT11 SAVE IN PSW IN CASE CH 0-5 @VA08517 02869130
- NI WAIT11,X'FC' ONLY WANT TO SET BITS IF 0-5 @VA08517 02869140
- BNZ READY MUST BE CH 0-5 IF BNZ @VA08517 02869150
- ST R3,CREG2 CH 6 AND ABOVE, MUST SET UP CR2 @VA08517 02869160
- LCTL C2,C2,CREG2 LOAD CREG2 @VA08517 02869170
- OI WAIT11,IOMASK TURN ON I/O SUMMARY BIT IN PSW @VA08517 02869180
- READY STCM R13,B'0111',CCW+1 SETUP CAW TO READ FROM @VA08517 02869190
- LA R1,CCW IPL DEVICE @VA08517 02869200
- ST R1,CAW ... @VA08517 02869210
- SR R0,R0 CLEAR @VA08517 02869220
- LA R1,INTRPT SET UP TO POINT TO I/O NEW PSW @VA08517 02869230
- STM R0,R1,NIOPSW FOR RETURN WHEN I/O IS HANDLED @VA08517 02869240
- L R3,STOPP STARTING LOAD ADDRESS @VA08517 02869250
- LH R8,2 IPL ADDRESS AGAIN @VA08517 02869260
- TIO TIO 0(R8) CLEAR CHANNEL @VA08517 02869270
- BNZ TIO LOOP IF BUSY @VA08517 02869280
- ALLSET SSM *+1 DISABLE ALL I/O @VA08517 02869290
- SIO 0(R8) GO AHEAD AND PERFORM I/O @VA08517 02869300
- WAITT LPSW WAIT11 NORMAL WAIT PSW @VA08517 02869310
- INTRPT TM CCW+4,UC IF UNIT CHECK, ERROR @VA08517 02869320
- BO UCLPSW LOAD DISABLED WAIT @VA08517 02869330
- TM CSW+4,DE IF DEVICE-END, @VA08517 02869340
- BZ WAITT CONTINUE TO WAIT @VA08517 02869350
- LM R4,R5,ENTRY PREPARE TO CHECK IF LAST @VA08517 02869360
- C R4,ENDX CARD READ; IF YES, BR TO @VA08517 02869370
- BER R5 STARTING ROUTINE @VA08517 02869380
- MVC 0(72,R3),ENTRY OTHERWISE, MOVE CARD AND @VA08517 02869390
- LA R3,72(R3) PREPARE FOR NEXT READ @VA08517 02869400
- B ALLSET GO LOOP AGAIN @VA08517 02869410
- * 02870000
- DS 0D -ALIGNMENT- 02871000
- * 02872000
- ENDX DC X'02' *** 02873000
- DC C'LD' END OF LOADER FLAG 02874000
- DC X'02' ... 02875000
- * 02876000
- STOPP DC A(ALPHA) STARTING LOAD ADDRESS. 02877000
- * 02878000
- * 02879000
- ORG ENTRY+160 ORG FOR THIRD CARD @VA02018 02880000
- * 02881000
- CARD3 DC X'02' IPL CCW TO READ 1ST BOOTSTRP CARD@VA02018 02882000
- DC AL3(IOTA) @VA02018 02883000
- DC X'60000050' @VA02018 02884000
- CRD3CCW2 DC X'02' IPL CCW TO READ 2ND BOOTSTRP CARD@VA02018 02885000
- DC AL3(IOTA+80) @VA02018 02886000
- DC X'20000050' @VA02018 02887000
- * 02888000
- UCLPSW LPSW DISABW LOAD DISABLED WAIT PSW WITH UNIT @VA02018 02889000
- * CHECK ERROR CODE 02890000
- * 02891000
- DS 0D ALIGNMENT @VA02018 02892000
- WAIT11 DC X'FF020000' ENABLED WAIT PSW @VA02018 02893000
- TOPX DC AL1(2),AL3(ENTRY) @VA02018 02894000
- DISABW DC X'00020000' DISABLED WAIT PSW @VA02018 02895000
- DC X'22222222' UNIT CHECK ERROR CODE @VA02018 02896000
- * 02896100
- CREG2 DS F WORK AREA FOR CREG2 @VA08517 02896200
- CCW CCW 2,0,SILI,80 READ TAPE CCW @VA08517 02896300
- LTORG (IF ANY) @VA03812 02897000
- TOTLSIZE EQU *-RELDR TOTAL SIZE OF LOADER @VA03812 02898000
- * 02899000
- ORG ENTRY+240 RESERVE SPACE FOR 3 CARDS @VA02018 02900000
- * 02901000
- DROP 13 @VA02018 02902000
- EJECT 02903000
- XTRBLOK DSECT 02904000
- XTRPNT DS 1F POINTER TO NEXT XTRBLOK 02905000
- XTRLINE DS 1F ADDRESS OF DATA TO PRINT 02906000
- XTRLEN DS 1H NUMBER OF BYTES PRESENTLY IN USE 02907000
- DS 1H FILLER 02908000
- DS 1F FILLER 02909000
- XTRDATA DS CL96 EXTRN DATA ENTRIES 02910000
- XTRDATAL EQU L'XTRDATA NUMBER OF BYTES TO CLEAR 02911000
- XTRFULL EQU 84 MAX. NUMBER OF BUFFER PRINT POSITIONS 02912000
- DS 0D FORCE ALIGNMENT 02913000
- XTRSIZE EQU (*-XTRBLOK)/8 NUMBER OF DOUBLE WORDS OF BLOK. 02914000
- SPACE 2 02915000
- COPY EQU 02916000
- END LDRGEN 02917000
ibm/vm370-lib/cp/dmkld00e.assemble_src.txt · Last modified: 2023/08/06 13:37 by Site Administrator