ibm:ibm1130-lib:dmsr2v12:u6modsf_lst
U6MODSF
| Table Of Contents |
|---|
|
- u6modsf.lst
ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:10 2020 Source File: \u6modsf.asm PROGRAM TO MODIFY DSF-PROGRAMS IN UA 2 | *************************************************** U6I00020 3 | * MODSF * PROGRAM TO MODIFY DSF-PROGRAMS IN UA * U6I00030 4 | *************************************************** U6I00040 5 | * * U6I00050 6 | *STATUS - VERSION 2, MODIFICATION LEVEL 12 * U6I00060 7 | * * U6I00070 8 | *FUNCTION -- * U6I00080 9 | * * PERMITS THE MODIFICATION OF A DSF-PROGRAM * U6I00090 10 | * IN USER-AREA OF ANY ON-LINE CARTRIDGE. * U6I00100 11 | * * MODIFICATION MAY BE REPLACEMENT OF EXISTING * U6I00110 12 | * CODE, OR ADDITION OF CODE AT END OF PROGRAM.* U6I00120 13 | * * LOCATION OF CODE TO BE PATCHED MAY BE SPECI-* U6I00130 14 | * FIED EITHER IN TERMS OF RELATIVE PROGRAM * U6I00140 15 | * ADDRESS, OR PHYSICAL DISPLACEMENT BEYOND * U6I00150 16 | * BEGINNING OF DSF-TEXT. * U6I00160 17 | * * MULTIPLE PROGRAMS WITH CODE *REPLACEMENT* * U6I00170 18 | * ONLY MAY BE MODIFIED DURING A SINGLE 'MODSF'* U6I00180 19 | * RUN, BUT ANY PROGRAM TO WHICH CODING IS TO * U6I00190 20 | * BE ADDED MUST BE THE LAST PROGRAM AFFECTED * U6I00200 21 | * IN THE RUN. * U6I00210 22 | * * PROGRAMS WITH CODE REPLACEMENT ONLY ARE * U6I00220 23 | * MODIFIED IN PLACE IN USER AREA. A PROGRAM * U6I00230 24 | * TO WHICH CODE IS TO BE ADDED IS MOVED TO * U6I00240 25 | * WORKING-STORAGE--THE USER MUST PROVIDE THE * U6I00250 26 | * // DUP, *DELETE, AND *STORE CARDS HIMSELF IN* U6I00260 27 | * ORDER TO PLACE IT BACK INTO USER-AREA. * U6I00270 28 | * * U6I00280 29 | *ENTRY POINT -- * U6I00290 30 | * THIS PROGRAM IS INVOKED BY A * U6I00300 31 | * // XEQ MODSF * U6I00310 32 | * MONITOR CONTROL RECORD. * U6I00320 33 | * * U6I00330 34 | *INPUT -- * U6I00340 35 | * * PATCH CONTROL RECORDS, OF WHICH COLUMNS 1-4 * U6I00350 36 | * CONTAIN THE CHARACTERS '*PRO', AND WHICH * U6I00360 37 | * SPECIFY ALL NECESSARY FACTS ABOUT THE * U6I00370 38 | * PROGRAM TO BE MODIFIED. * U6I00380 39 | * * PATCH DATA RECORDS, WHICH SPECIFY WITHIN * U6I00390 40 | * A PROGRAM THE LOCATION(S) TO BE MODIFIED, * U6I00400 41 | * AND THE CONTENT TO BE INSERTED INTO THOSE * U6I00410 42 | * LOCATIONS. * U6I00420 43 | * * THE TERMINATION CONTROL RECORD '*END'. * U6I00430 44 | * * U6I00440 45 | *OUTPUT -- * U6I00450 46 | * * LISTING ON PRINCIPAL PRINTER, RECORDING * U6I00460 47 | * INPUT REQUESTS, REPORTING ACTIONS TAKEN, AND* U6I00470 48 | * INDICATING ANY ERROR COMMITTED. * U6I00480 49 | * * DSF-TEXT -- IN PLACE -- FOR ANY PROGRAM FOR * U6I00490 50 | * WHICH CODING WAS REPLACED ONLY. * U6I00500 51 | * * DSF-TEXT -- IN WORKING-STORAGE -- FOR ANY * U6I00510 52 | * PROGRAM TO WHICH CODING HAS BEEN ADDED. * U6I00520 53 | * * U6I00530 54 | *EXTERNAL REFERENCES -- * U6I00540 55 | * * IN DCOM * U6I00550 56 | * #JBSW, #SYSC, #CIDN(5), #ULET(5), * U6I00560 57 | * #DBCT, #FMAT, #NAME, #ENTY * U6I00570 58 | * * IN SLET * U6I00580 59 | * EXTRACTS FOR PRINCIPAL PRINT ROUTINE AND * U6I00590 60 | * PRINCIPAL INPUT ROUTINE * U6I00600 61 | * * IN PAGE HEADING SECTOR * U6I00610 62 | * JOB-NAME * U6I00620 63 | * * PRINCIPAL PRINTER DEVICE SUBROUTINE * U6I00630 64 | * * PRINCIPAL INPUT DEVICE SUBROUTINE * U6I00640 65 | * * DISKZ (VIA ENTRY POINT DZ000) * U6I00650 66 | * * IN COMMA * U6I00660 67 | * $LEV0, $LEV1, $IREQ * U6I00670 68 | * $IBSY, $PBSY, $DBSY, $CH12, $CTSW, $LAST * U6I00680 69 | * $WSDR, $FPAD, $CORE, $FLSH * U6I00690 70 | * * U6I00700 71 | *EXIT, NORMAL -- * U6I00710 72 | * * TO MONITOR, VIA $EXIT * U6I00720 73 | * * U6I00730 74 | *EXIT, ERROR -- * U6I00740 75 | * * TO MONITOR, VIA $EXIT, AFTER APPROPRIATE * U6I00750 76 | * ERROR MESSAGE * U6I00760 77 | * * U6I00770 78 | *TABLES/WORKAREAS -- * U6I00780 79 | * * COMRG (COMMUNICATION REGION) CONTAINS ALL * U6I00790 80 | * POINTERS AND SWITCHES USED BY THE PROGRAM. * U6I00800 81 | * * DAREA IS A DISK BUFFER USED FOR ALL DISK * U6I00810 82 | * OPERATIONS. * U6I00820 83 | * * U6I00830 84 | *ATTRIBUTES -- * U6I00840 85 | * * N/A * U6I00850 86 | * * U6I00860 87 | *NOTES -- * U6I00870 88 | * * MUST NOT BE USED IN TEMPORARY JOB MODE, * U6I00880 89 | * NOR IF $NDUP IS SET NON-ZERO. * U6I00890 90 | * * U6I00900 91 | *************************************************** U6I00910 93 | *************************************************** U6I00930 94 | * S Y S T E M E Q U A T E S * U6I00940 95 | *************************************************** U6I00950 97 | * DCOM EQUATES U6I00970 0004 99 | #NAME EQU 4 PROGRAM NAME IN NAMECODE U6I00990 0006 100 | #DBCT EQU 6 DISK BLOCK COUNT OF PROGRAM U6I01000 0008 101 | #SYSC EQU 8 VERSION/MODLEVEL VVMM U6I01010 0009 102 | #JBSW EQU 9 NON-ZERO=TEMPORARY JOB MODE U6I01020 0010 103 | #ENTY EQU 16 RELATIVE ENTRY POINT U6I01030 0019 104 | #PIOD EQU 25 PRIN I/O DEVICE INDIC U6I01040 0037 105 | #CIDN EQU 55 CART ID BY LOG DRIVE U6I01050 0046 106 | #FMAT EQU 70 FORMAT PROG IN WS, LOGDR 0 U6I01060 0050 107 | #ULET EQU 80 LET SAD BY LOG DRIVE U6I01070 0055 108 | #WSCT EQU 85 DISK BLOCK COUNT U6I01080 110 | * PHASE ID EQUATES U6I01100 0099 112 | @PPTR EQU /99 PRINCIPAL PRINTER U6I01120 009A 113 | @PIWK EQU /9A PRINCIPAL READER U6I01130 115 | * SECTOR EQUATES U6I01150 0001 117 | @DCOM EQU /0001 ADDR OF DCOM U6I01170 0003 118 | @SLET EQU /0003 ADDR OF SLET U6I01180 0007 119 | @HDNG EQU /0007 ADDR OF HEADING SECTOR U6I01190 121 | * EQUATES IN COMMA AND SKELETON SUPERVISOR U6I01210 0005 123 | $CIBA EQU /5 SAD OF CORE-IMAGE BUFFER U6I01230 0006 124 | $CH12 EQU /6 POINTER TO CH12 INDIC U6I01240 0008 125 | $LEV0 EQU /8 LEVEL 0 BRANCH WORD U6I01250 0009 126 | $LEV1 EQU /9 LEVEL 1 BRANCH WORD U6I01260 000E 127 | $CORE EQU /E SIZE OF MAIN STORAGE IN WD U6I01270 000F 128 | $CTSW EQU /F MCR TRAP SW U6I01280 0013 129 | $IBSY EQU /13 INPUT-BUSY SW U6I01290 002C 130 | $IREQ EQU /2C INT REQ BRANCH WORD U6I01300 0032 131 | $IOCT EQU /32 MASTER I/O COUNT U6I01310 0033 132 | $LAST EQU /33 INPUT LAST CARD SW U6I01320 0034 133 | $NDUP EQU /34 SUPPRESS-DUP IF NON-ZERO U6I01330 0036 134 | $PBSY EQU /36 PRINTER BUSY INDICATOR U6I01340 003F 135 | $DUMP EQU /3F DUMP ENTRY POINT U6I01350 0071 136 | $FLSH EQU /71 FLUSH-TO-NEXT-JOB SW U6I01360 0076 137 | $DZ1N EQU /76 DISKZ= -1 U6I01370 007B 138 | $WRD1 EQU /7B ADDR OF CI-HEADER U6I01380 007C 139 | $KCSW EQU /7C KEYBOARD+CONSPRTR=1 U6I01390 007A 140 | $WSDR EQU /7A WS DRIVE CODE U6I01400 0095 141 | $FPAD EQU /95 BEGIN OF WS FOR 5 DRIVES U6I01410 00EE 142 | $DBSY EQU /EE DISK BUSY INDIC U6I01420 00F2 143 | DZ000 EQU /F2 DISKZ ENTRY POINT U6I01430 145 | * MISCELLANEOUS EQUATES U6I01450 01FE 147 | ORGIN EQU /1FE INITIAL LOAD ADDR U6I01470 01F9 148 | IBT4 EQU ORGIN-5 ADDR RIGHTMOST IBT ENTRY U6I01480 0000 149 | I1134 EQU 0 U6I01490 0001 150 | IKBCP EQU 1 U6I01500 0002 151 | I1442 EQU 2 U6I01510 0003 152 | I2501 EQU 3 U6I01520 0004 153 | I1403 EQU 4 U6I01530 155 | *************************************************** U6I01550 156 | * C O M M U N I C A T I O N A R E A * U6I01560 157 | *************************************************** U6I01570 0000R 159 | COMRG EQU * U6I01590 161 | * SLET EXTRACTS U6I01610 0000 0099 163 | SLETX DC @PPTR PHASE ID OF PRIN PRINT ROUT U6I01630 0001 0000 164 | DC *-* FILLED IN BY XSLET U6I01640 0002 0000 165 | DC *-* FILLED IN BY XSLET U6I01650 0003 0000 166 | DC *-* FILLED IN BY XSLET U6I01660 0004 009A 168 | DC @PIWK PHASE ID OF PRIN INPUT ROUT U6I01680 0005 0000 169 | DC *-* FILLED IN BY XSLET U6I01690 0006 0000 170 | DC *-* FILLED IN BY XSLET U6I01700 0007 0000 171 | DC *-* FILLED IN BY XSLET U6I01710 173 | * DCOM INFORMATION U6I01730 0008 0000 175 | JBSW DC *-* FROM #JBSW U6I01750 0009 0000 176 | VMOD DC *-* FROM #SYSC (VVMM) U6I01760 000A 0000 177 | PIODV DC *-* PRIN I/O DEVICE (NEG=PAPT) U6I01770 000B 178 | CIDN5 BSS 5 FROM #CIDN(5) U6I01780 0010 179 | ULET5 BSS 5 FROM #ULET(5) U6I01790 181 | * INFORMATION RELATING TO CURRENT PROGRAM U6I01810 0015 0000 183 | CID DC *-* CURRENT CARTRIDGE ID U6I01830 0016 184 | PNAME BSS 5 PROG NAME IN EBCDIC U6I01840 001C 0000 0000 185 | PNAMC DEC 0 PROG NAME IN NAMECODE U6I01850 001E 0000 186 | COUNT DC *-* NO. PATCH DATA RECORDS U6I01860 001F 0000 187 | EXPSW DC *-* EXPAND ENCOUNTERED SW U6I01870 0020 0000 188 | MODE DC *-* CURRENT ADDRESSING MODE U6I01880 0021 0000 189 | DRCOD DC *-* DRIVE CODE U6I01890 0022 0000 190 | ADLET DC *-* LET ADDRESS ON DESIRED CART U6I01900 0024 191 | BSS E 0 U6I01910 0024 0000 192 | DBCNT DC *-* DISK BLOCK COUNT U6I01920 0025 0000 193 | DBADR DC *-* DISK BLOCK ADDRESS U6I01930 0026 0000 194 | STPTR DC *-* POINTER TO ADDR/RC/VALUES U6I01940 196 | * MISCELLANEOUS GLOBAL ITEMS U6I01960 0028 198 | BSS E 0 ASSURE EVEN BOUNDARY U6I01980 0028 5CD7 D9D6 199 | KPRO EBC .*PRO. COMPARAND FOR CARD TYPE U6I01990 002A 5CC5 D5C4 200 | KEND EBC .*END. COMPARAND TO CARD TYPE U6I02000 002C 201 | DZCON BSS E 0 DISKZ CONTROLS U6I02010 002C 0280 202 | DC 640 WORD COUNT U6I02020 002D 0000 203 | DC *-* SECTOR ADDRESS U6I02030 002E 0000 204 | LIBSW DC *-* LAST WAS LIBF SWITCH U6I02040 002F 0000 205 | PADDR DC *-* CURRENT PATCH ADDRESS U6I02050 207 | *************************************************** U6I02070 208 | * T R A N S F E R V E C T O R * U6I02080 209 | *************************************************** U6I02090 0030R 211 | INSTV EQU * U6I02110 0030 0000 213 | DREAD DC *-* ENTRY FOR DISK READ U6I02130 0031 4C00 065BR 214 | BSC L DR001 U6I02140 0033 0000 216 | DWRIT DC *-* ENTRY FOR DISK WRITE U6I02160 0034 4C00 065FR 217 | BSC L DW001 U6I02170 0036 0000 219 | PRINT DC *-* ENTRY POINT U6I02190 0037 4C00 0613R 220 | BSC L PR001 BR TO PRINT ROUTINE U6I02200 0039 0000 222 | SPACE DC *-* ENTRY POINT U6I02220 003A 4C00 0634R 223 | BSC L SP001 BR TO SPACE ROUTINE U6I02230 003C 0000 225 | PKPRT DC *-* ENTRY POINT U6I02250 003D 4C00 0639R 226 | BSC L PP001 BR TO PACK AND PRINT U6I02260 003F 0000 228 | ERROR DC *-* ENTRY POINT U6I02280 0040 4C00 067ER 229 | BSC L ER001 BR TO ERROR ROUIINE U6I02290 0042 0000 231 | PACK4 DC *-* ENTRY POINT U6I02310 0043 4C00 0648R 232 | BSC L P4001 BR TO PACK 4 CHARS IN A/E U6I02320 0045 0000 234 | GTREC DC *-* ENTRY POINT U6I02340 0046 4C00 0545R 235 | BSC L GR001 BR TO GET INPUT RECORD U6I02350 0048 0000 237 | CVXB4 DC *-* ENTRY POINT U6I02370 0049 4C00 0504R 238 | BSC L CI001 BR TO CONVERT HEX TO BINARY U6I02380 004B 0000 240 | TSTBL DC *-* ENTRY POINT U6I02400 004C 4C00 0530R 241 | BSC L TB001 BR TO TEST BLANK U6I02410 243 | *************************************************** U6I02430 244 | * DEFINITION OF CARD AND PRINT AREAS * U6I02440 245 | *************************************************** U6I02450 004E 247 | BSS E 1 U6I02470 0050R 248 | CAREA EQU *+1 CAREA IS THE CARD AREA U6I02480 00A2R 250 | PRBUF EQU CAREA+82 THE PRINTER BUFFER U6I02500 004F 0000 252 | XSLET DC *-* ENTRY POINT U6I02520 254 | *************************************************** U6I02540 255 | * XSLET * FILL IN SLET EXTRACTS * U6I02550 256 | *************************************************** U6I02560 257 | * * U6I02570 258 | *INPUT -- ARG 0 = NUMBER OF PHASE IDS, * U6I02580 259 | * ARG 1 = ADDR(FIRST WORD OF SLET EXTRACT)* U6I02590 260 | * ARG 2 = ADDR OF 322-WORD BUFFER AREA * U6I02600 261 | * * U6I02610 262 | *OUTPUT -- LOAD ADDRESSES, WORDCOUNTS, AND SADS IN* U6I02620 263 | * ALL EXTRACTS FOR WHICH SLET ENTRY FOUND* U6I02630 264 | * * U6I02640 265 | *EXTERNAL REFERENCES -- DZ000 AND $DBSY * U6I02650 266 | * * U6I02660 267 | *ERRORS -- NONE DETECTED * U6I02670 268 | * * U6I02680 269 | *RETURN -- ALWAYS TO BSI + 4 * U6I02690 270 | * * U6I02700 271 | *NOTES -- SLET EXTRACTS AND BUFFER ADDR MUST BE * U6I02710 272 | * ON EVEN BOUNDARIES. * U6I02720 273 | * X1 AND X2 ARE SAVED/RESTORED * U6I02730 274 | * X3 IS NOT USED * U6I02740 275 | * ACC/EXT/STAT ARE NOT SAVED/RESTORED * U6I02750 276 | * * U6I02760 277 | *************************************************** U6I02770 279 | * INITIALIZATION U6I02790 0050 6935 281 | XS001 STX 1 XS091+1 SAVE INDEX 1 U6I02810 0051 6A36 282 | STX 2 XS092+1 SAVE INDEX 2 U6I02820 0052 6580 004FR 283 | LDX I1 XSLET INDEX 1 = ADDR(ARGLIST) U6I02830 0054 C101 284 | LD 1 1 ACC=ADDR(SLET EXTRACTS) U6I02840 0055 D015 285 | STO XS060+1 SET INTO INSTR U6I02850 0056 C102 286 | LD 1 2 ACC=ADDR(BUFFER AREA) U6I02860 0057 D003 287 | STO XS020+1 SET INTO INSTR U6I02870 0058 7103 288 | MDX 1 +3 SET INDEX FOR RETURN U6I02880 0059 6930 289 | STX 1 XS099+1 SET EXIT ADDR IN INSTR U6I02890 005A 6500 0000 290 | XS020 LDX L1 *-* XR1=ADDR(BUFFER) U6I02900 005C C82F 291 | LDD XS320 ACC=320, EXT=3 (=SAD(SLET) U6I02910 005D D900 292 | STD 1 0 SET INTO DISK CTL WORDS U6I02920 294 | * OUTER LOOP -- PER DISK SECTOR OF SLET U6I02940 005E C0FC 296 | XS030 LD XS020+1 ACC=ADDR(DCTL) U6I02960 005F 1890 297 | SRT 16 U6I02970 0060 4400 00F2 298 | BSI L DZ000 TELL DISKZ TO READ U6I02980 0062 7400 00EE 299 | MDX L $DBSY,0 U6I02990 0064 70FD 300 | MDX *-3 WAIT FOR READ COMPLETE U6I03000 0065 6250 301 | LDX 2 80 XR2=LIMIT FOR SLET ENTRIES U6I03010 0066 6A29 302 | STX 2 XS111 STORE LIMIT COUNT U6I03020 304 | * MIDDLE LOOP -- PER ENTRY IN SLET U6I03040 0067 C480 004FR 306 | XS050 LD I XSLET ACC=NUMBER OF EXTRACTS U6I03060 0069 D025 307 | STO XS110 STORE THE COUNT U6I03070 006A 6600 0000 308 | XS060 LDX L2 *-* XR2=ADDR(SLET EXTRACTS) U6I03080 310 | * INNER LOOP -- PER INDIVIDUAL SLET EXTRACT U6I03100 006C C102 312 | XS070 LD 1 2 ACC=PHID FROM SLET U6I03120 006D F200 313 | EOR 2 0 COMPARE PHID IN EXTRACT U6I03130 006E 4820 314 | BSC Z SKIP IF EQUAL U6I03140 006F 7005 315 | MDX XS082 NOT EQ--GO MODIFY EXTR PTR U6I03150 317 | * AN EXTRACT IS MATCHED--ENTER INFO INTO EXTRACT U6I03170 0070 C103 319 | LD 1 3 ACC=LOAD ADDRESS FOR M SLE U6I03190 0071 D201 320 | STO 2 1 LOAD ADDR TO EXTRACT U6I03200 0072 C904 321 | LDD 1 4 WORDCOUNT/SAD FROM SLET U6I03210 0073 DA02 322 | STD 2 2 WORDCOUNT/SAD TO EXTRACT U6I03220 0074 7004 323 | MDX XS081 GO TO NEW SLET ENTRY U6I03230 0075 7204 325 | XS082 MDX 2 +4 UPDATE EXTRACT POINTER U6I03250 0076 74FF 008FR 326 | MDX L XS110,-1 DECREMENT COUNT OF EXTRS U6I03260 0078 70F3 327 | MDX XS070 BR IF NOT ALL U6I03270 0079 7104 329 | XS081 MDX 1 +4 UPDATE SLET ENTRY POINTER U6I03290 007A 74FF 0090R 330 | MDX L XS111,-1 DECREMENT LIMIT COUNT U6I03300 007C 70EA 331 | MDX XS050 BR IF NOT END-OF-SECTOR U6I03310 007D 6580 005BR 333 | LDX I1 XS020+1 RESET INDEX 1 U6I03330 007F C101 334 | LD 1 1 GET SECTOR ADDRESS U6I03340 0080 800D 335 | A XS101 ADD 1 U6I03350 0081 D101 336 | STO 1 1 SET SAD FOR SECOND SCTR U6I03360 0082 4804 337 | BSC E SKIP IF NOW 4 U6I03370 0083 7001 338 | MDX *+1 BR IF NOW FIVE U6I03380 0084 70D9 339 | MDX XS030 BR TO PROCESS NEW SECTOR U6I03390 341 | * RESTORE AND RETURN U6I03410 0085 6500 0000 343 | XS091 LDX L1 *-* RESTORE INDEX 1 U6I03430 0087 6600 0000 344 | XS092 LDX L2 *-* RESTORE INDEX 2 U6I03440 0089 4C00 0000 345 | XS099 BSC L *-* RETURN TO CALLER U6I03450 347 | * CONSTANTS AND WORKSPACES U6I03470 008C 349 | BSS E 0 U6I03490 008C 0140 350 | XS320 DC 320 WORDCOUNT U6I03500 008D 0003 351 | DC 3 SAD OF SLET U6I03510 008E 0001 352 | XS101 DC 1 CONSTANT--INCREMENT U6I03520 008F 0000 353 | XS110 DC *-* HOLD NO. SLET EXTRACTS U6I03530 0090 0000 354 | XS111 DC *-* HOLD NO. ENTRIES IN SLET U6I03540 356 | *************************************************** U6I03560 357 | * I N I T I A L I Z A T I O N R O U T I N E * U6I03570 358 | *************************************************** U6I03580 359 | * * U6I03590 360 | * THE FOLLOWING AREA CONTAINS THE INITIALIZATION * U6I03600 361 | * CODE FOR THIS PROGRAM, AND IS OVERLAID BY THE * U6I03610 362 | * CARD AND PRINT AREAS AFTER INITIALIZATION. * U6I03620 363 | * * U6I03630 364 | * THE FUNCTIONS OF INITIALIZATION ARE AS FOLLOWS--* U6I03640 365 | * * ESTABLISH ADDRESSABILITY OF THE COMMUNI- * U6I03650 366 | * CATION REGION AND INTERNAL TRANSFER VECTOR. * U6I03660 367 | * * READ DCOM, CAPTURING AND STORING #JBSW, * U6I03670 368 | * #SYSC, #CIDN QUINTUPLE, AND #ULET QUINTUPLE * U6I03680 369 | * * READ THE HEADING SECTOR, CAPTURING THE JOB * U6I03690 370 | * NAME. * U6I03700 371 | * * SEARCH SLET (USING SUBROUTINE XSLET) FOR * U6I03710 372 | * ENTRIES FOR PRINCIPAL PRINTER AND PRINCIPAL * U6I03720 373 | * INPUT DEVICE SUBROUTINES. * U6I03730 374 | * * LOAD THE TWO DEVICE SUBROUTINES AND PLUG * U6I03740 375 | * APPROPRIATE INTERRUPT LOCATIONS. * U6I03750 376 | * * PRINT THE PAGE HEADING FOR THE FIRST TIME. * U6I03760 377 | * * TEST #JBSW FOR TEMPORARY MODE--ABORT WITH * U6I03770 378 | * MESSAGE IF TEMPORARY MODE. * U6I03780 379 | * * TEST THE $NDUP SWITCH FOR SUPPRESS-DUP. * U6I03790 380 | * ABORT WITH MESSAGE IF DUP SUPPRESSED. * U6I03800 381 | * * READ THE FIRST OF ALL INPUT CARDS. IF NOT * U6I03810 382 | * *PRO, ABORT WITH MESSAGE. * U6I03820 383 | * * TRANSFER CONTROL TO THE MAIN ROUTINE OF * U6I03830 384 | * MODSF. * U6I03840 385 | * * U6I03850 386 | *************************************************** U6I03860 388 | * ESTABLISH ADDRESSABILITY OF COMMUNICATION U6I03880 389 | * REGION AND INTERNAL TRANSFER VECTOR. U6I03890 0091R 391 | BEGIN EQU * U6I03910 0091 6780 007B 392 | LDX I3 $WRD1 XR3=ADDR(CORE-IMAGE HEADER) U6I03920 0093 737F 393 | MDX 3 +127 XR3=ADDR(CI-HDR + 127) U6I03930 0061R 394 | X3 EQU COMRG-30+127 ESTABLISH BASE SYMBOL U6I03940 000C 395 | $LEV4 EQU /C LEVEL 4 BR ADDR 2-11 U6I03945 397 | * READ DCOM, CAPTURING #JBSW, #SYSC, #CIDK(5), U6I03960 398 | * AND #ULET(5) U6I03970 0094 6600 0986R 400 | LDX L2 DAREA-2 XR2=ADDR(DISK BUF) U6I03990 0096 CC00 00FER 401 | LDD L DCLST ACC/EXT=WD CNT/SAD 2-11 U6I04000 0098 43CF 402 | BSI 3 DREAD-X3 GO READ DCOM SECTOR U6I04010 0099 C400 0990R 403 | LD L DAREA+#SYSC GET VERSION/MOD U6I04020 009B D3A8 404 | STO 3 VMOD-X3 SAVE IN COMMUNICATION REGN U6I04030 009C C400 0991R 405 | LD L DAREA+#JBSW GET TEMP MODE INDIC U6I04040 009E D3A7 406 | STO 3 JBSW-X3 SAVE IN COMMUNICATION REGN U6I04050 009F C400 09A1R 407 | LD L DAREA+#PIOD GET PRIN I/O DEV INDIC U6I04060 00A1 D3A9 408 | STO 3 PIODV-X3 SAVE IT U6I04070 00A2 61FB 409 | LDX 1 -5 SET DISPL/COUNT FOR QUINT U6I04080 00A3 C500 09C4R 410 | DCLUP LD L1 DAREA+#CIDN+5 GET CARTRIDGE ID U6I04090 00A5 D500 0010R 411 | STO L1 CIDN5+5 STORE IN COMMUNICATION REGN U6I04100 00A7 C500 09DDR 412 | LD L1 DAREA+#ULET+5 GET ADDR OF LET U6I04110 00A9 D500 0015R 413 | STO L1 ULET5+5 STORE IN COMMUNICATION REGN U6I04120 00AB 7101 414 | MDX 1 +1 INCREMENT INDEX U6I04130 00AC 70F6 415 | MDX DCLUP BR IF NOT YET 5 U6I04140 417 | * IF // TYP IN FORCE, SUBSTITUTE ITS DEVICE SUBR U6I04160 418 | * PHASE ID FOR THAT OF PRINCIPAL INPUT U6I04170 00AD C400 007C 420 | LD L $KCSW NON-ZERO SAYS TYP IN FORCE U6I04190 00AF 4C18 00B5R 421 | BSC L *+4,+- BR IF NOT // TYP MODE 212 U6I04200 00B1 C0FF 422 | LD *-1 FORCE NEGATIVE NUMBER 212 U6I04205 00B2 D3A9 423 | STO 3 PIODV-X3 SET FOR NO CONVERSION U6I04210 00B3 74F8 0004R 424 | MDX L SLETX+4,-8 CHANGE PHASE ID TO /92 U6I04220 426 | * NOW SEARCH SLET FOR I/O SUBROUTINES U6I04240 00B5 4099 428 | BSI XSLET INVOKE SUBROUTINE U6I04260 00B6 0002 429 | DC 2 *ARG 1--NO. ENTRIES U6I04270 00B7 0000R 430 | DC SLETX *ARG 2--ADDR OF EXTRACT U6I04280 00B8 0988R 431 | DC DAREA *ARG 3--ADDR OF DISK BUFFER U6I04290 433 | * READ IN FIRST 10 WORDS OF HEADING SECTOR, U6I04310 434 | * CAPTURING JOB-NAME U6I04320 00B9 6600 0968R 436 | LDX L2 HEADR-2 XR2=ADDR(INPUT AREA) U6I04340 00BB C844 437 | LDD HDLST ACC/EXT=WORDCOUNT/SAD U6I04350 00BC 43CF 438 | BSI 3 DREAD-X3 READ THE SECTOR U6I04360 440 | *************************************************** U6I04372 441 | * INDEX REGISTER 1 IS USED THROUGHOUT THE LOGIC * U6I04373 442 | * THAT LOADS THE PRINCIPLE INPUT/OUTPUT * U6I04374 443 | * ROUTINES. IT SHOULD NOT BE ALTERED. * U6I04375 444 | *************************************************** U6I04376 445 | * U6I04377 446 | * READ IN THE PRINTER ROUTINE FROM SYSTEM AREA U6I04380 447 | * AND PLUG INTERRUPT POINTERS U6I04390 00BD 6600 069ER 449 | LDX L2 PR000-2 XR2=ADDR(PRINTER ROUTINE) U6I04410 00BF CBA1 450 | LDD 3 SLETX+2-X3 WORDCOUNT/SAD U6I04420 00C0 43CF 451 | BSI 3 DREAD-X3 READ IN THE ROUTINE U6I04430 00C1 7206 453 | MDX 2 +2+4 XR2=PR000+4--LEV 4 INT ENTR U6I04450 00C2 6E00 01F5 454 | STX L2 IBT4-I1403 IN CASE THIS IS 1403 U6I04460 455 | * 14 INSTRUCTIONS REMOVED 2-12 U6I04461 00C4 6E00 0009 456 | DC300 STX L2 $LEV1 IN CASE THIS IS 1132 2-11 U6I04475 458 | * READ IN THE INPUT ROUTINE AND PLUG INTERRUPT U6I04490 459 | * POINTERS U6I04500 00C6 6600 07DER 461 | LDX L2 CD000-2 XR2=ADDR(INPUT ROUTINE) U6I04520 00C8 CBA5 462 | LDD 3 SLETX+6-X3 ACC/EXT=WORDCOUNT/SAD U6I04530 00C9 43CF 463 | BSI 3 DREAD-X3 READ IN THE ROUTINE U6I04540 00CA 7206 465 | MDX 2 +2+4 XR2=CD000+4--LEV 4 INT ENTR U6I04560 466 | * 9 INSTRUCTIONS REMOVED 2-12 U6I04562 00CB 6E00 01F7 467 | NUP20 STX L2 IBT4-I1442 IN CASE THIS IS 1442 2-11 U6I04578 00CD 6E00 01F6 468 | STX L2 IBT4-I2501 IN CASE THIS IS 2501 U6I04580 00CF 6E00 01F9 469 | STX L2 IBT4-I1134 IN CASE THIS IS 1134 U6I04590 00D1 6E00 01F8 470 | STX L2 IBT4-IKBCP IN CASE OF KEYBOARD U6I04600 00D3 7203 472 | MDX 2 +3 XR2=CD000+7--LEV 0 INT ENTR U6I04620 00D4 6E00 0008 473 | STX L2 $LEV0 IN CASE THIS IS 1442 U6I04630 475 | * FORCE MODSF TO USE THE SYSTEM ILS04 2-12 U6I04634 00D6 C02D 477 | LD HD0C4 PLACE ADDR OF RES MON 2-12 U6I04638 00D7 D400 000C 478 | STO L $LEV4 *ILS04 IN INT BR ADDR 2-12 U6I04639 480 | * PRINT THE PAGE HEADING FOR THE FIRST TIME U6I04650 00D9 C828 483 | LDD HDXXX ARGUMENT LIST U6I04670 00DA 4400 06A1R 484 | BSI L PR000+1 INVOKE PRINTER ROUTINE U6I04680 00DC 4400 06A1R 485 | BSI L PR000+1 INVOKE AGAIN TO PRINT IT U6I04690 00DE 7400 0036 486 | MDX L $PBSY,0 WAIT FOR COMPLETE U6I04700 00E0 70FD 487 | MDX *-3 U6I04710 489 | * IF IN TEMPORARY MODE, ABORT WITH ERROR 01 U6I04730 00E1 C3A7 491 | LD 3 JBSW-X3 GET SWITCH U6I04750 00E2 4C18 00E6R 492 | BSC L *+2,+- BR IF *NOT* TEMP MODE U6I04760 00E4 43DE 493 | BSI 3 ERROR-X3 INVOKE ERROR U6I04770 00E5 F0F1 494 | EBC .01. *ARGUMENT FOR ERROR 01 U6I04780 496 | * IF SUPPRESS-DUP IS IN FORCE, ABORT WITH U6I04800 497 | * ERROR 02 U6I04810 00E6 C400 0034 499 | LD L $NDUP GET SWITCH U6I04830 00E8 4C18 00ECR 500 | BSC L *+2,+- BR IF *NOT* ON U6I04840 00EA 43DE 501 | BSI 3 ERROR-X3 INVOKE ERROR ROUTINE U6I04850 00EB F0F2 502 | EBC .02. *ARGUMENT FOR ERROR 02 U6I04860 504 | * ESTABLISH WORDCOUNTS IN THE CARD AND PRINT AREAS U6I04880 00EC 6250 506 | LDX 2 80 WORDCOUNT OF 80 U6I04900 00ED 6E00 004FR 507 | STX L2 CAREA-1 * FOR THE CARD AREA U6I04910 00EF 6228 508 | LDX 2 40 WORDCOUNT OF 40 U6I04920 00F0 6E00 00A1R 509 | STX L2 PRBUF-1 * FOR THE PRINT AREA U6I04930 511 | * NOW READ THE FIRST CARD U6I04950 00F2 43E4 513 | BSI 3 GTREC-X3 INVOKE CARD READ ROUTINE U6I04970 00F3 43E1 514 | BSI 3 PACK4-X3 INVOKE PACK ROUTINE U6I04980 00F4 0050R 515 | DC CAREA *ARGUMENT--ADDR OF EBCDIC U6I04990 00F5 9BC7 516 | SD 3 KPRO-X3 SUBTRACT '*PRO' U6I05000 00F6 4818 517 | BSC +- SKIP UNLESS ACC = ZERO U6I05010 00F7 1090 518 | SLT 16 EXT TO ACC IF ACC WAS ZERO U6I05020 00F8 4C18 00FCR 519 | BSC L *+2,+- BR IF COLS. 1-4=*PRO U6I05030 00FA 43DE 520 | BSI 3 ERROR-X3 ELSE INVOKE ERROR U6I05040 00FB F0F3 521 | EBC .03. ARGUMENT FOR ERROR 03 U6I05050 523 | * INITIALIZATION NOW COMLETE--BEGIN NORMAL U6I05070 524 | * EXECUTION U6I05080 00FC 4C00 0106R 526 | BSC L NUPRO GO PROCESS PROGRAM U6I05100 528 | * CONSTANTS U6I05120 00FE 530 | BSS E 0 U6I05140 00FE 0140 531 | DCLST DC 320 ARGUMENT LIST FOR U6I05150 00FF 0001 532 | DC @DCOM * DCOM U6I05160 0100 000A 533 | HDLST DC 10 ARGUMENT LIST FOR U6I05170 0101 0007 534 | DC @HDNG * HEADING SECTOR U6I05180 0102 7000 535 | HDXXX DC /7000 ARGUMENT LIST FOR U6I05190 0103 0969R 536 | DC HEADR-1 * PRINTING HEADER AFTER EJ U6I05200 0104 00C4 537 | HD0C4 DC /C4 ADDR OF SYSTEM ILS04 2-11 U6I05203 0105 0091 538 | HD091 DC /91 INDICATES ISS 2-11 U6I05205 539 | * 1 CONSTANT REMOVED 2-12 U6I05207 541 | *************************************************** U6I05220 542 | * NUPRO * BEGIN TO PROCESS NEW PROGRAM * U6I05230 543 | *************************************************** U6I05240 0106R 544 | NUPRO EQU * U6I05250 546 | * FIRST, PACK THE CURRENT RECORD INTO PRINT AREA U6I05270 547 | * AND PRINT IT AFTER A SPACE U6I05280 0106 43D8 549 | BSI 3 SPACE-X3 SINGLE SPACE U6I05300 0107 43DB 550 | BSI 3 PKPRT-X3 PACK AND PRINT THE RECORD U6I05310 552 | * NOW SEE WHICH KIND OF RECORD IT IS U6I05330 0108 43E1 554 | BSI 3 PACK4-X3 INVOKE CONVERSION ROUTINE U6I05350 0109 0050R 555 | DC CAREA VALUE IN ACC/EXT U6I05360 010A 9BC7 556 | SD 3 KPRO-X3 COMPARE TO '*PRO' U6I05370 010B 4818 557 | BSC +- SKIP IF NOT ACC ZERO U6I05380 010C 1090 558 | SLT 16 SHIFT IF ACC WAS ZERO U6I05390 010D 4C18 0127R 559 | BSC L DOPRO,+- BR TO PROCESS *PRO IF IT IS U6I05400 010F 43E1 561 | BSI 3 PACK4-X3 INVOKE PACK ROUTINE AGAIN U6I05420 0110 0050R 562 | DC CAREA VALUE INTO ACC/EXT U6I05430 0111 9BC9 563 | SD 3 KEND-X3 COMPARE TO '*END' U6I05440 0112 4C18 0116R 564 | BSC L *+2,+- BR IF IT IS *END U6I05450 566 | * INVALID PATCH CONTROL RECORD--ERROR 06 U6I05470 0114 43DE 568 | BSI 3 ERROR-X3 INVOKE ERROR U6I05490 0115 F0F6 569 | EBC .06. ARGUMENT FOR ERROR 06 U6I05500 571 | *************************************************** U6I05520 572 | * NORMAL TERMINATION WITH REPLACEMENT ONLY * U6I05530 573 | *************************************************** U6I05540 0116R 575 | FINSH EQU * U6I05560 0116 43D8 576 | BSI 3 SPACE-X3 SINGLE SPACE U6I05570 0117 43D5 577 | BSI 3 PRINT-X3 INVOKE PRINT RUUTINE U6I05580 0118 011BR 578 | DC BYMSG-1 *TO PRINT NORMAL SIGNOFF U6I05590 0119 6038 580 | EXIT RETURN TO MONITOR U6I05610 582 | * SIGNOFF MESSAGE U6I05630 011A 584 | BSS E 1 ASSURE ODD BOUNDARY U6I05650 011B 000B 585 | DC BYMSX-* U6I05660 011C E2E4 C3C3 C5E2 E2C6 586 | BYMSG EBC .SUCCESSFUL COMPLETION . U6I05670 E4D3 40C3 D6D4 D7D3 | C5E3 C9D6 D540 | 0127R 587 | BYMSX EQU * U6I05680 589 | *************************************************** U6I05700 590 | * DOPRO * PROCESSING OF THE '*PRO' CONTROL REC * U6I05710 591 | *************************************************** U6I05720 0127R 593 | DOPRO EQU * U6I05740 595 | * CHECK THAT THE PREVIOUS PROGRAM WAS NOT EXPANDED U6I05760 0127 C3BE 597 | LD 3 EXPSW-X3 GET THE SWITCH U6I05780 0128 4C18 012CR 598 | BSC L *+2,+- BR IF WAS *NOT* EXPANDED U6I05790 600 | * IT WAS EXPANDED--ERROR 31 U6I05810 012A 43DE 602 | BSI 3 ERROR-X3 INVOKE ERROR U6I05830 012B F3F1 603 | EBC .31. NO *END AFTER EXPANSION U6I05840 605 | * NOW CLEAR THE STRING AREA U6I05860 012C 6197 607 | LDX 1 -105 FOR 35 SLOTS U6I05880 012D C027 608 | LD PRO80 /8000 (NULL INDICATOR) U6I05890 012E D500 0C71R 609 | PRO81 STO L1 STRNG+105 STORE NULL INDIC U6I05900 0130 7101 610 | MDX 1 +1 MODIFY POINTER U6I05910 0131 70FC 611 | MDX PRO81 BR IF NOT EXHAUSTED U6I05920 0132 1010 612 | SLA 16 SET STOPPER U6I05930 0133 D400 0C71R 613 | STO L STRNG+105 STORE STOPPER U6I05940 615 | * FIRST, TEST THE REQUIRED BLANK COLUMNS--ERROR 07 U6I05960 0135 62F2 617 | LDX 2 -14 SET FOR 14 LOOKS U6I05980 0136 C600 0151R 618 | PRO01 LD L2 BLLST+14 ACC=ADDR TO FIND BLANK U6I05990 0138 D001 619 | STO *+1 SET NEXT INSTR U6I06000 0139 C400 0000 620 | LD L *-* GET COLUMN U6I06010 013B F016 621 | EOR PROBL COMPARE TO BLANK U6I06020 013C 4C20 0141R 622 | BSC L PRO07,Z BR IF *NOT* BLANK U6I06030 013E 7201 623 | MDX 2 +1 UPDATE POINTER U6I06040 013F 70F6 624 | MDX PRO01 BR IF NOT TEST ALL 14 U6I06050 0140 7015 625 | MDX PRO02 ALL TESTED--GO ON TO NEXT U6I06060 627 | * ERROR 07--COLUMN IS NOT BLANK U6I06080 0141 43DE 629 | PRO07 BSI 3 ERROR-X3 INVOKE ERROR U6I06100 0142 F0F7 630 | EBC .07. ARGUMENT FOR ERROR 7 U6I06110 632 | * LIST OF POSITIONS TO BE BLANK U6I06130 0143R 634 | BLLST EQU * U6I06150 0143 0054R 635 | DC CAREA+5-1 COL 5 U6I06160 0144 0058R 636 | DC CAREA+9-1 COL 9 U6I06170 0145 005ER 637 | DC CAREA+15-1 COL 15 U6I06180 0146 0063R 638 | DC CAREA+20-1 COL 20 U6I06190 0147 0065R 639 | DC CAREA+22-1 COL 22 U6I06200 0148 006AR 640 | DC CAREA+27-1 COL 27 U6I06210 0149 006FR 641 | DC CAREA+32-1 COL 32 U6I06220 014A 0074R 642 | DC CAREA+37-1 COL 37 U6I06230 014B 0079R 643 | DC CAREA+42-1 COL 42 U6I06240 014C 007ER 644 | DC CAREA+47-1 COL 47 U6I06250 014D 0083R 645 | DC CAREA+52-1 COL 52 U6I06260 014E 0088R 646 | DC CAREA+57-1 COL 57 U6I06270 014F 008DR 647 | DC CAREA+62-1 COL 62 U6I06280 0150 0092R 648 | DC CAREA+67-1 COL 67 U6I06290 650 | * CONSTANTS U6I06310 0151 00F0 652 | PROF0 DC /00F0 CONSTANT EBCDIC ZERO U6I06330 0152 0040 653 | PROBL DC /0040 CONSTANT BLANK U6I06340 0153 00D7 654 | PROKP DC .P CONSTANT 'P' U6I06350 0154 00C4 655 | PROKD DC .D CONSTANT 'D' U6I06360 0155 8000 656 | PRO80 DC /8000 NULL INDICATOR FOR STRING U6I06370 658 | * NOW CK THE VERSION AND MOD LEVEL U6I06390 0156R 660 | PRO02 EQU * U6I06410 0156 C0FA 661 | LD PROF0 ACC=/00F0 U6I06420 0157 D400 0054R 662 | STO L CAREA+5-1 SET ZERO IN COL 5 U6I06430 0159 43E7 663 | BSI 3 CVXB4-X3 INVOKE CONVERSION ROUTINE U6I06440 015A 0054R 664 | DC CAREA+5-1 COLS 5-8 FOR 0VMM U6I06450 015B 7002 665 | MDX *+2 BR IF VALID FORMAT FOR V/M U6I06460 667 | * VERSION/MOD INVALIDLY SPECIFIED--ERROR 08 U6I06480 015C 43DE 669 | BSI 3 ERROR-X3 INVOKE ERROR ROUTINE U6I06500 015D F0F8 670 | EBC .08. ARGUMENT FOR ERROR 8 U6I06510 672 | * IF NOT EQUAL TO TRUE VER/MOD, ERROR 09 U6I06530 015E 93A8 674 | S 3 VMOD-X3 COMPARE TO TRUE VER/MOD U6I06550 015F 4C18 0163R 675 | BSC L *+2,+- BR IF CORRECT VERSION/MOD U6I06560 0161 43DE 676 | BSI 3 ERROR-X3 INVOKE ERROR U6I06570 0162 F0F9 677 | EBC .09. ARGUMENT FOR ERROR 09 U6I06580 679 | * NOW CONVERT TO NAMECODE--IF INVALID, ERROR 10 U6I06600 0163 4400 05B8R 682 | BSI L CVEBN INVOKE NAMECODE CONVERSION U6I06630 0165 0005 683 | PRO10 DC 5 NAME LENGTH U6I06640 0166 0059R 684 | DC CAREA+10-1 ADDR OF LEFTMOST CHAR U6I06650 0167 7002 685 | MDX *+2 BR IF VALID NAME U6I06660 0168 43DE 686 | ERR10 BSI 3 ERROR-X3 INVOKE ERROR U6I06670 0169 F1F0 687 | EBC .10. ARGUMENT FOR ERROR 10 U6I06680 016A DBBB 688 | STD 3 PNAMC-X3 SAVE NAMECODE IN COMRG U6I06690 690 | * NOW GET NUMBER OF RECORDS IN HEX--INVALID, ERR 11 U6I06710 016B 43E7 692 | BSI 3 CVXB4-X3 INVOKE CONVERSION U6I06730 016C 005FR 693 | DC CAREA+16-1 ADDR OF LEFTMOST CHAR U6I06740 016D 7002 694 | MDX *+2 BR IF VALID HEX U6I06750 016E 43DE 696 | ERR11 BSI 3 ERROR-X3 INVOKE ERROR U6I06770 016F F1F1 697 | EBC .11. ARGUMENT FOR ERROR 11 U6I06780 0170 4C08 016ER 699 | BSC L ERR11,+ BR IF NUMBER NOT POSITIVE U6I06800 0172 D3BD 700 | STO 3 COUNT-X3 STORE COUNT IN COMRG U6I06810 0173 1805 701 | SRA 5 STRIP RIGHT 5 BITS U6I06820 0174 4C20 016ER 702 | BSC L ERR11,Z BR IF GT 31 RECS SPECIFIED U6I06830 704 | * GET ADDRESSING MODE--IF NOT D OR P, ERROR 18 U6I06850 0176 C400 0064R 706 | LD L CAREA+21-1 GET COLUMN 21 U6I06870 0178 F0DA 707 | EOR PROKP COMPARE TO 'P' U6I06880 0179 4C20 017DR 708 | BSC L *+2,Z BR IF *NOT* 'P' U6I06890 017B D3BF 710 | STO 3 MODE-X3 SET MODE = ZERO--P-ADDRESS U6I06910 017C 7008 711 | MDX MODOK BR TO NEXT CHECK U6I06920 017D F0D5 713 | EOR PROKP RESTORE CHAR U6I06940 017E F0D5 714 | EOR PROKD COMPARE TO 'D' U6I06950 017F 4C18 0183R 715 | BSC L *+2,+- BR IF IT WAS 'D' U6I06960 0181 43DE 717 | BSI 3 ERROR-X3 INVOKE ERROR U6I06980 0182 F1F8 718 | EBC .18. ARGUMENT FOR ERROR 18 U6I06990 0183 2001 720 | LDS 1 SET FOR D-ADDRESS U6I07010 0184 2BBF 721 | STS 3 MODE-X3 SET D-ADDRESS INTO MODE SW U6I07020 0185R 722 | MODOK EQU * U6I07030 724 | * SEE IF A CARTRIDGE ID IS PRESENT U6I07050 0185 61FC 726 | LDX 1 -4 SET LENGTH ARGUMENT U6I07070 0186 43EA 727 | BSI 3 TSTBL-X3 INVOKE TEST-FOR-BLANK ROUT U6I07080 0187 006AR 728 | DC CAREA+23+3 ADDR OF FIRST COL BEYOND U6I07090 0188 7008 729 | MDX NOCID BR IF ALL BLANK U6I07100 0189 43E7 731 | BSI 3 CVXB4-X3 INVOKE CONVERSION U6I07120 018A 0066R 732 | DC CAREA+23-1 ADDR OF LEFTMOST CHAR U6I07130 018B 7002 733 | MDX *+2 BR IF VALID HEX U6I07140 018C 43DE 735 | ERR12 BSI 3 ERROR-X3 INVOKE ERROR U6I07160 018D F1F2 736 | EBC .12. ARGUMENT FOR ERROR 12 U6I07170 018E 4C08 018CR 738 | BSC L ERR12,+ BR IF ID NOT POSITIVE U6I07190 0190 7001 739 | MDX CIDOK BR TO STORE CID U6I07200 0191 C3AA 741 | NOCID LD 3 CIDN5-X3 GET LOGICAL 0 CID U6I07220 0192 D3B4 743 | CIDOK STO 3 CID-X3 STORE DESIRED CID IN COMRG U6I07240 745 | * NOW SEE IF THE CARTRIDGE IS ON LINE--IF NOT, U6I07260 746 | * ERROR 13 U6I07270 0193 62FB 748 | LDX 2 -5 U6I07290 0194 1010 749 | SLA 16 MAKE A ZERO U6I07300 0195 D3C0 750 | STO 3 DRCOD-X3 SET DRIVE CODE = ZERO U6I07310 0196 C600 0010R 751 | CID01 LD L2 CIDN5+5 GET AN ON-LINE ID U6I07320 0198 F3B4 752 | EOR 3 CID-X3 COMPARE TO REQUESTED ID U6I07330 0199 4C18 01A1R 753 | BSC L CID00,+- BR IF EQUAL U6I07340 019B 7401 0021R 754 | MDX L DRCOD,+1 INCR DRIVE CODE U6I07350 019D 7201 755 | MDX 2 +1 INCREMENT POINTER U6I07360 019E 70F7 756 | MDX CID01 U6I07370 019F 43DE 758 | BSI 3 ERROR-X3 CARTRIDGE NOT ONLINE U6I07390 01A0 F1F3 759 | EBC .13. ARGUMENT FOR ERROR 13 U6I07400 01A1 C3C0 761 | CID00 LD 3 DRCOD-X3 GET THE DRIVE CODE U6I07420 01A2 100C 762 | SLA 12 PUT INTO BITS 0-3 U6I07430 01A3 EE00 0015R 763 | OR L2 ULET5+5 OR IN ADDR OF LET U6I07440 01A5 D3C1 764 | STO 3 ADLET-X3 U6I07450 766 | * NOW FIND THE PROGRAM U6I07470 01A6 CBBB 768 | LDD 3 PNAMC-X3 ACC/EXT=NAMECODE U6I07490 01A7 6500 0022R 769 | LDX L1 ADLET XR1=ADDR(DRCOD/SAD) U6I07500 01A9 4400 0564R 770 | BSI L LETSR INVOKE LET SEARCH ROUT U6I07510 01AB 0986R 771 | DC DAREA-2 ADDR OF BUFFER TO USE U6I07520 01AC 2800 772 | STS * SET STATUS IN INSTR U6I07530 01AD 6200 773 | LDX 2 *-* XR2=STATUS RETURNED U6I07540 01AE 4E80 01B0R 774 | BSC I2 * BR ACC TO FOLLOWING TABLE U6I07550 01B0 01BAR 776 | DC ISDSF 00--DSF OR NOT FOUND U6I07570 01B1 01B4R 777 | DC ERR15 01--SECONDARY ENTRY POINT U6I07580 01B2 01B6R 778 | DC ERR16 10--CORE-IMAGE PROGRAM U6I07590 01B3 01B8R 779 | DC ERR17 11--DATA FILE U6I07600 01B4 43DE 781 | ERR15 BSI 3 ERROR-X3 INVOKE ERROR U6I07620 01B5 F1F5 782 | EBC .15. SECONDARY ENTRY POINT U6I07630 01B6 43DE 784 | ERR16 BSI 3 ERROR-X3 INVOKE ERROR U6I07650 01B7 F1F6 785 | EBC .16. CORE-IMAGE PROGRAM U6I07660 01B8 43DE 787 | ERR17 BSI 3 ERROR-X3 INVOKE ERROR U6I07680 01B9 F1F7 788 | EBC .17. DATA-FILE U6I07690 01BA 4C20 01BER 790 | ISDSF BSC L *+2,Z BR IF PROGRAM FOUND U6I07710 01BC 43DE 792 | BSI 3 ERROR-X3 INVOKE ERROR U6I07730 01BD F1F4 793 | EBC .14. PROGRAM NOT FOUND U6I07740 01BE DBC3 794 | STD 3 DBCNT-X3 SAVE COUNT/SAD U6I07750 796 | * NOW COLLECT THE VERIFICATION PARAMETERS IF U6I07770 797 | * PRESENT U6I07780 01BF 61D8 799 | LDX 1 -40 SET FOR 40 COLUMNS U6I07800 01C0 6297 800 | LDX 2 -105 SET FOR BEGIN OF STRING U6I07810 01C1R 801 | VER00 EQU * U6I07820 01C1 43EA 802 | BSI 3 TSTBL-X3 TEST FOR ALL BLANK U6I07830 01C2 0093R 803 | VER01 DC CAREA+67 1 BEYOND LAST COLUMN U6I07840 01C3 701A 804 | MDX VER99 BR IF ALL BLANK U6I07850 01C4 6907 806 | STX 1 VER10 STORE -40,-30,-20,-10 U6I07870 01C5 C006 807 | LD VER10 * AND PLACE IN ACC U6I07880 01C6 80FB 808 | A VER01 ADD ADDR FIRST COL BEYOND U6I07890 01C7 D004 809 | STO VER10 SET ARGUMENT U6I07900 01C8 D00C 810 | STO VER20 SET SECOND ARGUMENT U6I07910 01C9 7405 01D5R 811 | MDX L VER20,+5 * AS FIVE BEYOND FIRST U6I07920 01CB 43E7 812 | BSI 3 CVXB4-X3 INVOKE HEX CONVERSION U6I07930 01CC 0000 813 | VER10 DC *-* ARGUMENT -- ADDRESS U6I07940 01CD 7002 814 | MDX *+2 BR IF VALID HEX U6I07950 01CE 43DE 816 | ERR19 BSI 3 ERROR-X3 INVOKE ERROR U6I07970 01CF F1F9 817 | EBC .19. INVALID VERIFY ADDRESS U6I07980 01D0 4C28 01CER 819 | BSC L ERR19,+Z BR IF ADDRESS NEGATIVE U6I08000 01D2 D600 0C71R 820 | STO L2 STRNG+105 STORE THE ADDRESS U6I08010 01D4 43E7 822 | BSI 3 CVXB4-X3 INVOKE CONVERSION OF VALUE U6I08030 01D5 0000 823 | VER20 DC *-* ADDR OF VALUE U6I08040 01D6 7002 824 | MDX *+2 BR IF VALID HEX U6I08050 01D7 43DE 826 | BSI 3 ERROR-X3 INVOKE ERROR U6I08070 01D8 F2F0 827 | EBC .20. INVALID VALUE U6I08080 01D9 D600 0C73R 829 | STO L2 STRNG+105+2 STORE THE VALUE U6I08100 01DB 7203 831 | MDX 2 +3 INCR TO NEXTSTRING SLOT U6I08120 01DC 710A 832 | MDX 1 +10 MODIFY COLUMN POINTER U6I08130 01DD 70E3 833 | MDX VER00 BR IF NOT DONE 4 U6I08140 01DE 6E00 0026R 834 | VER99 STX L2 STPTR SET STRING POINTER U6I08150 836 | *************************************************** U6I08170 837 | * PATCH * ROUTINE TO READ PATCH DATA RECORDS * U6I08180 838 | *************************************************** U6I08190 840 | * GET NEXT RECORD--IF * RECORD, HIS COUNT WAS WRONG U6I08210 01E0 43E4 842 | PATCH BSI 3 GTREC-X3 GET THE RECORD U6I08230 01E1 C400 0050R 843 | LD L CAREA GET COLUMN 1 U6I08240 01E3 F072 844 | EOR PHAST COMPARE TO ASTERISK U6I08250 01E4 4C20 01E8R 845 | BSC L *+2,Z BR IF NOT ASTERISK U6I08260 01E6 43DE 847 | ERR22 BSI 3 ERROR-X3 INVOKE ERROR U6I08280 01E7 F2F2 848 | EBC .22. ERRONEOUS COUNT--DATA RECS U6I08290 01E8 43DB 850 | BSI 3 PKPRT-X3 PACK AND PRINT THE RECORD U6I08310 852 | * NOW INITIALIZE INDEX FOR STRING POINTER AND U6I08330 853 | * CONVERT THE PATCH ADDRESS U6I08340 01E9 43E7 855 | BSI 3 CVXB4-X3 CONVERT ADDRESS U6I08360 01EA 0050R 856 | DC CAREA ADDRESS OF HEX FORM U6I08370 01EB 7002 857 | MDX *+2 BR IF IT WAS VALID HEX U6I08380 01EC 43DE 859 | ERR23 BSI 3 ERROR-X3 INVOKE ERROR U6I08400 01ED F2F3 860 | EBC .23. INVALID PATCH ADDRESS U6I08410 01EE 4C28 01ECR 862 | BSC L ERR23,+Z BR IF ADDR NEGATIVE--ERROR U6I08430 01F0 6680 0026R 863 | LDX I2 STPTR INIT INDEX 2 WITH CUR POS U6I08440 01F2 D3CE 864 | STO 3 PADDR-X3 STORE PATCH ADDRESS U6I08450 866 | * NOW BRANCH IF IN D-MODE--CONTINUE IF IN PMODE U6I08470 01F3 C3BF 868 | LD 3 MODE-X3 GET THE MODE (0=P, 1=D) U6I08490 01F4 4C20 0261R 869 | BSC L MODEP,Z BR IF IN D-MODE U6I08500 01F6 61C1 870 | LDX 1 -63 SET INDEX 1 FOR MAX COLUMNS U6I08510 872 | * TEST FOR BLANK IN COLUMN 5 AND ALL SUCH POSITIONS U6I08530 01F7R 874 | VALUP EQU * U6I08550 01F7 C3CE 875 | LD 3 PADDR-X3 GET CURRENT PATCH ADDR U6I08560 01F8 D600 0C71R 876 | STO L2 STRNG+105+0 STORE ADDRESS IN STRING U6I08570 01FA C500 0093R 877 | LD L1 CAREA+67+0 GET THE CHARACTER U6I08580 01FC F05A 878 | EOR PH040 COMPARE TO BLANK U6I08590 01FD 4C18 0201R 879 | BSC L *+2,+- BR IF IT WAS BLANK U6I08600 01FF 43DE 881 | ERR24 BSI 3 ERROR-X3 INVOKE ERROR U6I08620 0200 F2F4 882 | EBC .24. ERRONEOUSLY NON-BLANK U6I08630 884 | * NOW FIND THE RELOCATION MODE OF THE PATCH U6I08650 0201 6A0F 886 | STX 2 RSTX2+1 SAVE INDEX 2 FOR NOW U6I08670 0202 62FC 887 | LDX 2 -4 SET FOR FOUR LOOKS U6I08680 0203 C500 0094R 888 | RCLUP LD L1 CAREA+67+1 GET MODE CHARACTER U6I08690 0205 F600 025CR 889 | EOR L2 RELOA+4 COMPARE TO VALID CHAR U6I08700 0207 4C18 020DR 890 | BSC L RCFND,+- BR IF FOUND U6I08710 0209 7201 891 | MDX 2 +1 MODIFY LIST POINTER U6I08720 020A 70F8 892 | MDX RCLUP BR IF NOT EXHAUSTED U6I08730 020B 43DE 894 | BSI 3 ERROR-X3 INVOKE ERROR U6I08750 020C F2F5 895 | EBC .25. INVALID RELOC CODE U6I08760 020DR 897 | RCFND EQU * U6I08780 020D 6A4E 898 | STX 2 TEMP1 GET INDEX 2 VALUE U6I08790 020E C04D 899 | LD TEMP1 ELSE GET INDEX VALUE U6I08800 020F 804D 900 | A CON4 ADD CONSTANT 4 U6I08810 0210 6600 0000 901 | RSTX2 LDX L2 *-* RESTORE INDEX 2 VALUE U6I08820 0212 D600 0C72R 902 | STO L2 STRNG+105+1 STORE RELOC CODE U6I08830 904 | * IF IT WAS A LIBF, SET LIBSW. IF IT WAS 'A', U6I08850 905 | * AND AFTER A LIBF, SET RELOC CODE=4 U6I08860 0214 4C20 021ER 907 | BSC L NOTL2,Z BR IF NOT 'A' U6I08880 0216 C3CD 908 | LD 3 LIBSW-X3 GET THE LIBF SWITCH U6I08890 0217 4C18 021ER 909 | BSC L NOTL2,+- BR IF SWITCH NOT ON U6I08900 0219 C043 910 | LD CON4 'A' AFTER 'L'--SET RC=4 U6I08910 021A D600 0C72R 911 | STO L2 STRNG+105+1 STORE THE RELOC CODE U6I08920 021C 1010 912 | SLA 16 MAKE A ZERO U6I08930 021D D3CD 913 | STO 3 LIBSW-X3 CLEAR THE LIBF SWITCH U6I08940 021E 9040 914 | NOTL2 S CON2 TEST FOR 'L' U6I08950 021F 4C20 022ER 915 | BSC L NOTL1,Z BR IF THIS NOT 'L' U6I08960 0221 7401 002ER 916 | MDX L LIBSW,+1 IT IS 'L'--TURN LIBF SW ON U6I08970 0223 7107 917 | MDX 1 +7 SKIP IF AT END OF CARD U6I08980 0224 7002 918 | MDX *+2 NO SKIP--NOT END OF CARD U6I08990 0225 43DE 919 | ERR29 BSI 3 ERROR-X3 INVOKE ERROR U6I09000 0226 F2F9 920 | EBC .29. ITEM AFTER LIBF NOT 'A' U6I09010 0227 C500 0094R 921 | LD L1 CAREA+67+1 GET NEXT RELOC CODE U6I09020 0229 F02E 922 | EOR RELOA COMPARE TO 'A' U6I09030 022A 4C20 0225R 923 | BSC L ERR29,Z BR IF NEXT CODE NOT 'A' U6I09040 022C 71F9 924 | MDX 1 -7 RESTORE INDEX VALUE U6I09050 022D 7002 925 | MDX *+2 SKIP OVER NEXT INSTR U6I09060 022E 7401 002FR 926 | NOTL1 MDX L PADDR,+1 UPDATE PATCH ADDR U6I09070 928 | * NOW CHECK THE POSN AFTER RELOC CODE FOR BLANK U6I09090 0230 C500 0095R 930 | LD L1 CAREA+67+2 GET COLUMN U6I09110 0232 F024 931 | EOR PH040 COMPARE TO BLANK U6I09120 0233 4C20 01FFR 932 | BSC L ERR24,Z BR IF NOT BLANK--ERROR U6I09130 934 | * NOW GATHER A VALUE FROM THE RECORD U6I09150 0235 C028 936 | LD CONVL GET BASE ADDRESS U6I09170 0236 6903 937 | STX 1 VLARG GET THE CURRENT INDEX VALUE U6I09180 0237 8002 938 | A VLARG ADD THAT VALUE TO BASE U6I09190 0238 D001 939 | STO VLARG SET UP ARG FOR CONVERT U6I09200 0239 43E7 940 | BSI 3 CVXB4-X3 CONVERT VALUE U6I09210 023A 0000 941 | VLARG DC *-* ADDR OF THAT TO CONVERT U6I09220 023B 7002 942 | MDX *+2 BR IF VALID HEX U6I09230 023C 43DE 944 | ERR26 BSI 3 ERROR-X3 INVOKE ERROR IF INVALID U6I09250 023D F2F6 945 | EBC .26. INVALID HEX VALUE TO PATCH U6I09260 023E D600 0C73R 947 | STO L2 STRNG+105+2 STORE VALUE INTO U6I09280 948 | * *SPECIFICATION STRING U6I09285 0240 7203 949 | MDX 2 +3 INCR STRING PTR U6I09290 0241 7002 950 | MDX *+2 BR IF NOT EXHAUSTED U6I09300 0242 43DE 951 | ERR32 BSI 3 ERROR-X3 INVOKE ERROR U6I09310 0243 F3F2 952 | EBC .32. TOO MANY SPECIFICATIONS U6I09320 0244 7107 953 | MDX 1 +7 UP COLUMN INDEX TO NEXT U6I09330 0245 700C 954 | MDX PHBLK BR IF MORE COLUMNS U6I09340 0246 6E00 0026R 955 | PATCX STX L2 STPTR SAVE STRING POINTER U6I09350 0248 74FF 001ER 956 | MDX L COUNT,-1 REDUCE COUNT U6I09360 024A 7095 957 | MDX PATCH BR IF MORE PATCH RECS U6I09370 024B 43E4 958 | BSI 3 GTREC-X3 NO MORE PATCH--SHOULD BE * U6I09380 024C C400 0050R 959 | LD L CAREA GET COLUMN 1 U6I09390 024E F007 960 | EOR PHAST COMPARE TO ASTERISK U6I09400 024F 4C20 01E6R 961 | BSC L ERR22,Z BR IF NOT * -- COUNT ERROR U6I09410 0251 7033 962 | MDX DOIT IF WAS *, GO DO PATCHING U6I09420 0252 43EA 963 | PHBLK BSI 3 TSTBL-X3 TEST REMAINING COLS FOR BLK U6I09430 0253 0093R 964 | DC CAREA+67 BASE ADDRESS FOR TEST U6I09440 0254 70F1 965 | MDX PATCX BR IF IT WAS BLANK U6I09450 0255 70A1 966 | MDX VALUP BR IF MORE ON RECORD U6I09460 968 | * CONSTANTS AND WORKSPACES U6I09480 0256 005C 970 | PHAST DC .* CONSTANT ASTERISK U6I09500 0257 0040 971 | PH040 DC /0040 CONSTANT BLANK U6I09510 0258 00C1 972 | RELOA DC .A ABSOLUTE RELOC CODE U6I09520 0259 00D9 973 | DC .R RELOCATABLE RELOC CODE U6I09530 025A 00D3 974 | DC .L LIBF RELOC CODE U6I09540 025B 00C3 975 | DC .C CALL RELOC CODE U6I09550 025C 0000 976 | TEMP1 DC *-* WORKSPACE U6I09560 025D 0004 977 | CON4 DC 4 CONSTANT 4 U6I09570 025E 0096R 978 | CONVL DC CAREA+67+3 BASE ADDR FOR CONVERT U6I09580 025F 0002 979 | CON2 DC 2 CONSTANT 2 U6I09590 0260 0096R 980 | PHVL2 DC CAREA+69+1 U6I09600 982 | * MODE IS 'D'--PROCESS THE PATCH CARD U6I09620 0261 61BF 984 | MODEP LDX 1 -65 SET INITIAL INDEX VALUE U6I09640 986 | * TEST FOR SEPARATOR BLANK U6I09660 0262R 988 | VALU2 EQU * U6I09680 0262 C3CE 989 | LD 3 PADDR-X3 GET CURRENT PATCH ADDR U6I09690 0263 D600 0C71R 990 | STO L2 STRNG+105+0 STORE ADDR IN STRING U6I09700 0265 7401 002FR 991 | MDX L PADDR,+1 INCR PATCH ADDR U6I09710 0267 C500 0095R 992 | LD L1 CAREA+69+0 GET BLANK POSN U6I09720 0269 F0ED 993 | EOR PH040 COMPARE TO BLANK U6I09730 026A 4C20 01FFR 994 | BSC L ERR24,Z BR IF NOT BLANK U6I09740 996 | * NOW CONVERT AND STORE THE VALUE U6I09760 026C C0F3 998 | LD PHVL2 BASE ADDRESS U6I09780 026D 6903 999 | STX 1 V2ARG GET INDEX VALUE U6I09790 026E 8002 1000 | A V2ARG ADD INDEX VALUE U6I09800 026F D001 1001 | STO V2ARG SET ARGUMENT FOR CONVERT U6I09810 0270 43E7 1002 | BSI 3 CVXB4-X3 DO THE CONVERSION U6I09820 0271 0000 1003 | V2ARG DC *-* ADDR OF HEX ITEM U6I09830 0272 7002 1004 | MDX *+2 BR IF WAS GOOD HEX U6I09840 0273 4C00 023CR 1005 | BSC L ERR26 BR IF BAD HEX U6I09850 0275 D600 0C73R 1006 | STO L2 STRNG+105+2 STORE THE VALUE U6I09860 0277 1010 1007 | SLA 16 MAKE A ZERO U6I09870 0278 D600 0C72R 1008 | STO L2 STRNG+105+1 STORE ZERO RELOC CODE U6I09880 027A 7203 1009 | MDX 2 +3 U6I09890 027B 7002 1010 | MDX *+2 BR IF NOT OUT OF SPEC SPACE U6I09900 027C 4C00 0242R 1011 | BSC L ERR32 BR IF TOO MANY SPECS U6I09910 027E 7105 1012 | MDX 1 +5 SET INDEX TO NEXT SLOT U6I09920 027F 7001 1013 | MDX P2BLK BR IF NOT END OF CARD U6I09930 0280 70C5 1014 | MDX PATCX BR IF END OF CARD U6I09940 0281 43EA 1015 | P2BLK BSI 3 TSTBL-X3 TEST REST COLS BLANK U6I09950 0282 0095R 1016 | DC CAREA+69 BASE ADDR FOR TEST U6I09960 0283 70C2 1017 | MDX PATCX BR IF REST BLANK U6I09970 0284 70DD 1018 | MDX VALU2 ELSE BR TO GET NEXT VALUE U6I09980 1019 | *************************************************** U6I09990 1020 | * DO THE PATCHING AND REPORT TO USER RESULTS * U6I10000 1021 | *************************************************** U6I10010 0285R 1023 | DOIT EQU * U6I10030 0285 4400 02F4R 1024 | BSI L VRMOD GO VERIFY/MODIFY U6I10040 0287 43D5 1025 | BSI 3 PRINT-X3 PRINT 'MODIFICATIONS U6I10050 0288 02C9R 1026 | DC MSGQ-1 MADE' MESSAGE U6I10060 0289 C3BE 1027 | LD 3 EXPSW-X3 SEE IF PROGRAM EXPANDED U6I10070 028A 4C18 0106R 1028 | BSC L NUPRO,+- BR IF NO EXPANSION U6I10080 028C 43D5 1029 | BSI 3 PRINT-X3 PRINT '--IN WORKING-STORAGE U6I10090 028D 02D7R 1030 | DC MSGW-1 MESSAGE U6I10100 028E 43E1 1031 | BSI 3 PACK4-X3 PACK COLS 1-4 OF U6I10110 028F 0050R 1032 | DC CAREA NEXT CARD U6I10120 0290 9BC9 1033 | SD 3 KEND-X3 COMPARE TO *END U6I10130 0291 4818 1034 | BSC +- U6I10140 0292 1090 1035 | SLT 16 U6I10150 0293 4C18 0297R 1036 | BSC L *+2,+- BR IF NEXT IS *END U6I10160 0295 43DE 1038 | BSI 3 ERROR-X3 INVOKE ERROR IF NEXT U6I10180 0296 F3F1 1039 | EBC .31. RECORD NOT *END U6I10190 0297 43D8 1040 | BSI 3 SPACE-X3 U6I10200 0298 43DB 1041 | BSI 3 PKPRT-X3 PACK END CARD TO PRINT U6I10210 0299 43D5 1042 | BSI 3 PRINT-X3 PRINT *STORE/*DELETE MSG U6I10220 029A 02E5R 1043 | DC MSGD-1 U6I10230 1045 | * FOR THE EXPANDED PROGRAM, POST NECESSARY U6I10250 1046 | * FACTS TO DCOM U6I10260 029B C400 007A 1048 | LD L $WSDR GET W-S DRIVE CODE U6I10280 029D D001 1049 | STO *+1 U6I10300 029E 6500 0000 1050 | LDX L1 *-* X1=DRIVE CODE FOR WS U6I10310 02A0 C500 0095 1051 | LD L1 $FPAD GET APPROP W-S SAD U6I10320 02A2 1890 1052 | SRT 16 U6I10340 02A3 C022 1053 | LD K320 U6I10350 02A4 6600 0986R 1054 | LDX L2 DAREA-2 PREPARE TO READ FIRST SCTR U6I10360 02A6 43CF 1055 | BSI 3 DREAD-X3 FIRST SECTOR READ IN U6I10370 02A7 C81E 1056 | LDD DCID GET DCOM ARGS U6I10380 02A8 6600 0AC6R 1057 | LDX L2 DAREA+320-2 U6I10390 02AA 43CF 1058 | BSI 3 DREAD-X3 DCOM READ IN U6I10400 02AB C400 0994R 1059 | LD L DAREA+12 GET PROG NAME 1ST WORD U6I10410 02AD D400 0ACCR 1060 | STO L DAREA+320+#NAME INTO DCOM U6I10420 02AF C400 0995R 1061 | LD L DAREA+13 GET 2ND WORD PF PROG NAME U6I10430 02B1 D400 0ACDR 1062 | STO L DAREA+321+#NAME INTO DCOM U6I10440 02B3 C400 0996R 1063 | LD L DAREA+14 GET ENTRY ADDR U6I10450 02B5 D400 0AD8R 1064 | STO L DAREA+320+#ENTY INTO DCOM U6I10460 02B7 1010 1065 | SLA 16 MAKE A ZERO FOR DSF FORMAT U6I10470 02B8 D500 0B0ER 1066 | STO L1 DAREA+320+#FMAT SET FORMAT IN DCOM U6I10480 02BA C400 098FR 1067 | LD L DAREA+7 GET DISK BLOCK COUNT U6I10490 02BC D500 0B1DR 1068 | STO L1 DAREA+320+#WSCT SET BLK CNT IN DCOM U6I10500 02BE 6600 0AC6R 1069 | LDX L2 DAREA+320-2 U6I10510 02C0 C805 1070 | LDD DCID WRITE OF DCOM U6I10520 02C1 43D2 1071 | BSI 3 DWRIT-X3 WRITE DCOM U6I10530 1073 | * NOW INVOKE DUP VIA AUX SUPERVISOR U6I10550 02C2 4400 003F 1075 | BSI L $DUMP U6I10570 02C4 FFFB 1076 | DC -5 U6I10580 1078 | * CONSTANTS AND MESSAGES U6I10600 02C5 0095 1079 | DISPF DC $FPAD A($FPAD) 2-12 U6I10605 02C6 1081 | BSS E 0 U6I10620 02C6R 1082 | DCID EQU * U6I10630 02C6 0140 1083 | K320 DC 320 BLOCK LENGTH U6I10640 02C7 0001 1084 | DC /0001 SAD OF DCOM U6I10650 02C8 1086 | BSS E 1 U6I10670 02C9 000B 1087 | DC MSGQX-* U6I10680 02CA 6060 D4D6 C4C9 C6C9 1088 | MSGQ EBC .--MODIFICATIONS MADE--. U6I10690 C3C1 E3C9 D6D5 E240 | D4C1 C4C5 6060 | 02D5R 1089 | MSGQX EQU * U6I10700 02D6 1091 | BSS E 1 U6I10720 02D7 000B 1092 | DC MSGWX-* U6I10730 02D8 6060 C9D5 40E6 D6D9 1093 | MSGW EBC .--IN WORKING-STORAGE--. U6I10740 D2C9 D5C7 60E2 E3D6 | D9C1 C7C5 6060 | 02E3R 1094 | MSGWX EQU * U6I10750 02E4 1096 | BSS E 1 U6I10770 02E5 000E 1097 | DC MSGDX-* U6I10780 02E6 4D5C C4C5 D3C5 E3C5 1098 | MSGD EBC .(*DELETE/*STORE MUST FOLLOW). U6I10790 615C E2E3 D6D9 C540 | D4E4 E2E3 40C6 D6D3 | D3D6 E65D | 02F4R 1099 | MSGDX EQU * U6I10800 1101 | *************************************************** U6I10820 1102 | * VRMOD * VERIFY AND MODIFY ON DISK * U6I10830 1103 | *************************************************** U6I10840 02F4 0000 1105 | VRMOD DC *-* ENTRY TO VERIFY AND MODIFY U6I10860 1107 | *SETS UP 1ST SECTOR ADDR IN DZCON+1 U6I10880 1108 | *READS 1ST SECTOR INTO BUFFER U6I10890 1109 | *GETS WDS BEYOND BEGINNING OF SECTOR THAT PROG U6I10900 1110 | *STARTS IN ZH01 U6I10910 02F5 6600 0986R 1112 | LDX L2 DAREA-2 U6I10930 02F7 C400 0025R 1113 | LD L DBADR LOAD DISK BLK ADR OF PROG U6I10940 02F9 1890 1114 | SRT 16 MOVE TO EXT U6I10950 02FA C3C0 1115 | LD 3 DRCOD-X3 LOAD DISK DRIVE CODE U6I10960 02FB 108C 1116 | SLT 12 U6I10970 02FC D3CC 1117 | STO 3 DZCON+1-X3 U6I10980 02FD D078 1118 | STO DZHLD U6I10990 02FE 1010 1119 | SLA 16 CLEAR ACC U6I11000 02FF 1086 1120 | SLT 6 U6I11010 0300 D073 1121 | STO ZH01 U6I11020 0301 1082 1122 | SLT 2 U6I11030 0302 8071 1123 | A ZH01 MULT BY 16 U6I11040 0303 D070 1124 | STO ZH01 SAVE ADDR OF 1ST WD U6I11050 0304 6500 0C08R 1125 | YM01 LDX L1 STRNG SET X1 U6I11060 0306 CBCB 1126 | YM02 LDD 3 DZCON-X3 U6I11070 0307 43CF 1127 | BSI 3 DREAD-X3 U6I11080 0308 C3BF 1128 | LD 3 MODE-X3 GET MODE U6I11090 0309 4418 03BFR 1129 | BSI L YFIND,+- PROCESS IF P NODE U6I11100 030B C3BF 1130 | LD 3 MODE-X3 U6I11110 030C 4420 0378R 1131 | BSI L ZADDR,Z PROCESS IF D MODE U6I11120 030E C067 1132 | LD DZHLD U6I11130 030F D3CC 1133 | STO 3 DZCON+1-X3 RESET SECTOR ADDR U6I11140 0310 7103 1134 | MDX 1 3 STEP TO NEXT STRING ELEMENT U6I11150 0311 C100 1135 | LD 1 0 U6I11160 0312 4C10 0306R 1136 | BNN YM02 LOOP BACK UNTIL END U6I11170 0314 7400 0371R 1137 | MDX L VPSW,0 SKIP IF VERIFY PASS U6I11180 0316 7042 1138 | B YM06 BRANCH IF MODIFY PASS U6I11190 0317 6959 1139 | STX 1 VPSW SET MODIFY PASS U6I11200 0318 C400 001FR 1140 | LD L EXPSW GET EXPAND SWITCH U6I11210 031A 4C18 0304R 1141 | BZ YM01 BRANCH IF NO EXPANSION NEEDED U6I11220 031C C057 1142 | LD ZH01 DISPLACEMENT BEYOND U6I11230 031D 8059 1143 | A ZBUF *START OF BUFFER U6I11240 031E D018 1144 | STO YM03+1 'FROM' POINTER U6I11250 031F C056 1145 | LD DZHLD 'FROM' SECTOR ADDR U6I11260 0320 D3CC 1146 | STO 3 DZCON+1-X3 U6I11270 0321 C400 007A 1147 | LD L $WSDR SYSTEM DRIVE NUMBER U6I11280 0323 80A1 1148 | A DISPF *CALC ADDR OF $FPAD 2-12 U6I11286 0324 D001 1149 | STO YM025+1 *ENTRY FOR WS DRIVE 2-12 U6I11288 0325 C400 0000 1150 | YM025 LD L *-* GET FILE PROTECT ADDR 2-12 U6I11290 0327 D04B 1151 | STO YMCON+1 'TO' SECTOR ADDRESS U6I11300 0328 D04D 1152 | STO DZHLD NEW PROGRAM ADDRESS U6I11310 0329 6B1B 1153 | STX 3 YM05+1 SAVE X3 U6I11320 032A C400 0024R 1154 | LD L DBCNT GET DISK BLOCK COUNT U6I11330 032C 1884 1155 | SRT 4 CONVERT TO SECTORS U6I11340 032D D041 1156 | STO YMLP SAVE FOR LOOP CONTROL U6I11350 032E 100C 1157 | SLA 12 CLEAR ACC U6I11360 032F 1084 1158 | SLT 4 BRING OVER REMAINDER U6I11370 0330 4C18 0334R 1159 | BZ *+2 SKIP IF FULL SECTOR U6I11380 0332 7401 036FR 1160 | MDX L YMLP,1 STEP TO MOVE PARTIAL SECTOR U6I11390 0334 1804 1161 | SRA 4 CLEAR ACC U6I11400 0335 D03E 1162 | STO ZH01 NEW PROGRAM STARTS ON SECTOR U6I11410 1163 | * BOUNDARY U6I11420 0336 6500 0000 1164 | YM03 LDX L1 *-* SET 'FROM' U6I11430 0338 CBCB 1165 | LDD 3 DZCON-X3 SET FOR READ U6I11440 0339 43CF 1166 | BSI 3 DREAD-X3 READ IN SECTORS U6I11450 033A 7401 002DR 1167 | MDX L DZCON+1,1 STEP SECTOR ADDRESS U6I11460 033C 6700 0140 1168 | LDX L3 320 LOOP CONTROL FOR SHIFTING IN U6I11470 033E C900 1169 | YM04 LDD 1 0 MOVE TWO WORDS U6I11480 033F DA02 1170 | STD 2 2 U6I11490 0340 7102 1171 | MDX 1 2 U6I11500 0341 7202 1172 | MDX 2 2 U6I11510 0342 73FE 1173 | MDX 3 -2 U6I11520 0343 70FA 1174 | B YM04 U6I11530 0344 6700 0000 1175 | YM05 LDX L3 *-* RESTORE X3 U6I11540 0346 6600 0986R 1176 | LDX L2 DAREA-2 RESET X2 U6I11550 0348 C829 1177 | LDD YMCON SET FOR WRITE U6I11560 0349 43D2 1178 | BSI 3 DWRIT-X3 WRITE OUT SECTOR U6I11570 034A 7401 0373R 1179 | MDX L YMCON+1,1 STEP SECTOR ADDRESS U6I11580 034C C026 1180 | LD YMCON+1 CHECK FOR ROOM LEFT U6I11590 034D 1004 1181 | SLA 4 2-12 U6I11600 034E 906F 1182 | S X6000 2-12 U6I11605 034F 4C28 0353R 1183 | BN YM055 BRANCH OK U6I11610 0351 43DE 1184 | BSI 3 ERROR-X3 U6I11620 0352 F3F3 1185 | EBC .33. NOT ENOUGH WORKING STORAGE U6I11630 0353 74FF 036FR 1186 | YM055 MDX L YMLP,-1 DECREMENT COUNT OF SECTORS U6I11640 0355 70E0 1187 | B YM03 LOOP BACK U6I11650 0356 C01F 1188 | LD DZHLD GET NEW PROGRAM ADDR (WS) U6I11660 0357 D3CC 1189 | STO 3 DZCON+1-X3 SET CONTROL TO POINT TO NE U6I11670 0358 70AB 1190 | B YM01 RESET BUFR AND BEGIN MODIFY U6I11680 0359 C3BF 1191 | YM06 LD 3 MODE-X3 GET MODE U6I11690 035A 4CA0 02F4R 1192 | BNZ I VRMOD RETURN IF D MODE U6I11700 035C CBCB 1193 | LDD 3 DZCON-X3 SET FOR READ U6I11710 035D 43CF 1194 | BSI 3 DREAD-X3 BRING IN 1ST SECTOR U6I11720 035E C011 1195 | LD YPLEN GET NEW PROG LENGTH SWITCH U6I11730 035F 4820 1196 | BSC Z SKIP IF NOT SET U6I11740 0360 D205 1197 | STO 2 5 STORE NEW PROGRAM LENGTH U6I11750 0361 C015 1198 | LD ZBUF ADDR OF BUFFER U6I11760 0362 8011 1199 | A ZH01 DISPL FROM BEG OF SCTR U6I11761 0363 8043 1200 | A X7 DB CNT = 8TH WD OF HDR U6I11762 0364 D010 1201 | STO ZH02 U6I11763 0365 C3C3 1202 | LD 3 DBCNT-X3 GET DISK BLOCK COUNT U6I11764 0366 D480 0375R 1203 | STO I ZH02 UPDATE DISK BLOCK COUNT U6I11770 0368 CBCB 1204 | YM07 LDD 3 DZCON-X3 HAVE TO REPLACE 1ST SECTOR U6I11780 0369 43D2 1205 | BSI 3 DWRIT-X3 *IN CASE IT WAS UPDATED U6I11790 036A 1010 1206 | SLA 16 U6I11800 036B D004 1207 | STO YPLEN CLEAR PROG LENGTH SWITCH U6I11810 036C D004 1208 | STO VPSW SWT VERIFY SWITCH U6I11820 036D 4C80 02F4R 1209 | B I VRMOD RETURN U6I11830 036F 0000 1212 | YMLP DC *-* LOOP CONTROL U6I11860 0370 0000 1213 | YPLEN DC *-* NEW PROGRAM LENGTH U6I11870 0371 0000 1214 | VPSW DC *-* VERIFY PASS SWITCH. 0=VERIFY U6I11880 0372 1215 | YMCON BSS E 0 DISK CONTROLS FOR WRITE U6I11890 0372 0140 1216 | DC 320 *DURING MOVE FOR EXPANSION U6I11900 0373 0000 1217 | DC *-* U6I11910 0374 0000 1218 | ZH01 DC *-* ADDR OF 1ST WORD U6I11920 0375 0000 1219 | ZH02 DC *-* ADDR OF UPDATED DB COUNT U6I11925 0376 0000 1220 | DZHLD DC *-* 1ST SECTOR ADDR(DZCON+1) U6I11930 0377 0988R 1221 | ZBUF DC DAREA U6I11940 1223 | * TEST TO SEE IF WITHIN RANGE U6I11960 1224 | *IF NOT MUST NOT BE VERIFY U6I11970 1225 | *IF RANGE OK - VERIFY ON PASS 1, MODIFY PASS 2 U6I11980 0378 0000 1227 | ZADDR DC *-* U6I12000 0379 C0FA 1228 | LD ZH01 WDS FROM BEGIN OF SECTOR U6I12010 037A 802C 1229 | A X7 U6I12020 037B 80FB 1230 | A ZBUF U6I12030 037C D001 1231 | STO *+1 U6I12040 037D C400 0000 1232 | LD L *-* ACC=DISK BLK CT-TOTAL U6I12050 037F A026 1233 | M Z20 U6I12060 0380 1090 1234 | SLT 16 U6I12070 0381 9100 1235 | S 1 0 SUBTRACT WDS IN PROG U6I12080 0382 4C10 038BR 1236 | BNN ZA020 IF NON-NEG--WITHIN RANGE U6I12090 0384 6D00 001FR 1237 | STX L1 EXPSW TURN ON EXPAND SWITCH U6I12100 0386 C101 1238 | LD 1 1 IS IT VERIFY U6I12110 0387 4C10 039AR 1239 | BNN ZA030 BR IF NOT VERIFY U6I12120 0389 43DE 1240 | BSI 3 ERROR-X3 U6I12130 038A F3F4 1241 | EBC .34. VERIFY BEYOND END OF PROGRAM U6I12140 038BR 1242 | ZA020 EQU * U6I12150 038B C101 1243 | LD 1 1 IS IT VERIFY U6I12160 038C 4C10 039AR 1244 | BNN ZA030 BR IF NOT VERIFY U6I12170 038E C0E2 1245 | LD VPSW IS IT PASS 1 U6I12180 038F 4C20 03A4R 1246 | BNZ ZA100 NOT PASS 1 U6I12190 0391 4016 1247 | BSI ZAGET GET SECTOR AND ADDR IN BUF U6I12200 0392 D001 1248 | STO *+1 U6I12210 0393 C400 0000 1249 | LD L *-* LOAD VALUE IN BUF U6I12220 0395 9102 1250 | S 1 2 SUB VERIFICATION VALUE U6I12230 0396 4C18 03A4R 1251 | BZ ZA100 VER OK U6I12240 0398 43DE 1252 | BSI 3 ERROR-X3 U6I12250 0399 F2F1 1253 | EBC .21. U6I12260 039AR 1254 | ZA030 EQU * U6I12270 039A C0D6 1255 | LD VPSW IS IT PASS 2 U6I12280 039B 4C18 03A4R 1256 | BZ ZA100 NO U6I12290 039D 400A 1257 | BSI ZAGET YES SO MODIFY U6I12300 039E D002 1258 | STO ZA040+1 U6I12310 039F C102 1259 | LD 1 2 LOAD NEW AVALUE U6I12320 03A0 D400 0000 1260 | ZA040 STO L *-* PUT IN BUF U6I12330 03A2 CBCB 1261 | LDD 3 DZCON-X3 U6I12340 03A3 43D2 1262 | BSI 3 DWRIT-X3 U6I12350 03A4 4C80 0378R 1263 | ZA100 BSC I ZADDR U6I12360 03A6 0014 1265 | Z20 DC 20 U6I12380 03A7 0007 1266 | X7 DC 7 U6I12390 1268 | *THIS ROUTINE READS SECTOR INTO BUFFER AND RETURNS U6I12410 1269 | *CORE ADDR IN BUFFER OF WORD TO BE OPERATED ON U6I12420 1270 | *VALUE IS RETURNED IN ACC U6I12430 03A8 0000 1272 | ZAGET DC *-* U6I12450 03A9 C0CA 1273 | LD ZH01 WDS BEYOND BEGIN OF SECTOR U6I12460 1274 | * THAT PROGRAM STARTS U6I12470 03AA 8100 1275 | A 1 0 ADD ADDR IN PROG U6I12480 03AB 1890 1276 | SRT 16 U6I12490 03AC A8C5 1277 | D YMCON DIVIDE BY 320 U6I12500 03AD 4C18 03B7R 1278 | BZ SKIP1 IF 0 READ NOT NEEDED U6I12510 03AF 83CC 1279 | A 3 DZCON+1-X3 ADD 1ST SECTOR CT U6I12520 03B0 D3CC 1280 | STO 3 DZCON+1-X3 U6I12530 03B1 1090 1281 | SLT 16 U6I12540 03B2 D008 1282 | STO ZHOLD U6I12550 03B3 CBCB 1283 | LDD 3 DZCON-X3 U6I12560 03B4 43CF 1284 | BSI 3 DREAD-X3 U6I12570 03B5 C005 1285 | LD ZHOLD U6I12580 03B6 7001 1286 | B SKIP2 U6I12590 03B7 1090 1287 | SKIP1 SLT 16 U6I12600 03B8 80BE 1288 | SKIP2 A ZBUF U6I12610 03B9 4C80 03A8R 1289 | BSC I ZAGET U6I12620 03BB 0000 1291 | ZHOLD DC *-* U6I12640 03BC 0000 1292 | LAC DC *-* LOCATION ASIGNMENT COUNTER U6I12650 03BD 0000 1293 | YDLUP DC *-* LOOP CONTROL U6I12660 03BE 6000 1294 | X6000 DC /6000 2-12 U6I12670 03BF 0000 1296 | YFIND DC *-* ENTRY FOR P MODE SEARCH U6I12690 03C0 C0B3 1297 | LD ZH01 PICK UP DISPLACEMENT IN BUFFE U6I12700 03C1 80B5 1298 | A ZBUF ADD START ADDRESS OF BUFFER U6I12710 03C2 D400 0445R 1299 | STO L YGPT PLACE IN GET POINTER U6I12720 03C4 7402 0445R 1300 | MDX L YGPT,2 IGNORE 1ST 3 WDS OF HEADER U6I12730 03C6 4400 043DR 1301 | BSI L YGET GET WORD 3 (NEXT AVAIL ADDR) U6I12740 03C8 9100 1302 | S 1 0 COMPARE TO DESIRED ADDESS U6I12750 03C9 4C30 03D7R 1303 | BP YF005 BRANCH IF IN RANGE U6I12760 03CB C101 1304 | LD 1 1 U6I12770 03CC 4C28 03D5R 1305 | BN YF00 BRANCH IF VERIFY U6I12780 03CE 7400 0371R 1306 | MDX L VPSW,0 SKIP IF VERIFY PASS U6I12790 03D0 700C 1307 | B YF01 U6I12800 03D1 6D00 001FR 1308 | STX L1 EXPSW TURN ON EXPAND SWITCH U6I12810 03D3 4C80 03BFR 1309 | B I YFIND RETURN U6I12820 03D5 43DE 1310 | YF00 BSI 3 ERROR-X3 U6I12830 03D6 F3F4 1311 | EBC .34. VERIFY IN BSS OR ORG GAP, OR U6I12840 1312 | * BEYOND END OF PROGRAM U6I12850 03D7 7400 0371R 1313 | YF005 MDX L VPSW,0 SKIP IF VERIFY PASS U6I12860 03D9 7003 1314 | B YF01 BRANCH IF MODIFY PASS U6I12870 03DA C101 1315 | LD 1 1 U6I12880 03DB 4C90 03BFR 1316 | BNN I YFIND RETURN IF NOT VERIFY U6I12890 03DD 7401 0445R 1317 | YF01 MDX L YGPT,1 PASS WORD 4 U6I12900 03DF 405D 1318 | BSI YGET GET WORD 5 (LENGTH OF HEADER) U6I12910 03E0 8037 1319 | A X0003 ADD 3 U6I12920 03E1 8063 1320 | A YGPT ADD TO POINTER TO PASS U6I12930 03E2 D062 1321 | STO YGPT *REST OF PROG HEADER U6I12940 1323 | * GET DATA HEADER U6I12960 03E3 4059 1325 | YF02 BSI YGET GET STARTING LOAD ADDRESS U6I12980 03E4 D0D7 1326 | STO LAC PLACE IN LOC ASIGNMENT COUNTE U6I12990 03E5 9100 1327 | S 1 0 COMPARE TO REQUESTED ADDRESS U6I13000 03E6 4C08 03EDR 1328 | BNP YF03 BRANCH IF NOT PAST IT U6I13010 03E8 C101 1329 | LD 1 1 CHECK FOR VERIFY U6I13020 03E9 4C28 03D5R 1330 | BN YF00 BRANCH IF VERIFY U6I13030 03EB 43DE 1331 | BSI 3 ERROR-X3 U6I13040 03EC F2F7 1332 | EBC .27. PATCH IN BSS OR ORG GAP U6I13050 03ED 404F 1333 | YF03 BSI YGET GET LENGTH U6I13060 03EE 4C18 0491R 1334 | BZ YF13 BRANCH IF END U6I13070 03F0 907E 1335 | S YD2 ALLOW FOR DATA HEADER U6I13080 03F1 4C18 03E3R 1336 | BZ YF02 BR IF HEADER FOLLOWS 2-12 U6I13082 03F3 D0C9 1337 | STO YDLUP SET LOOP COUNT U6I13090 03F4 4048 1338 | YF04 BSI YGET GET NEXT RELOC WORD U6I13100 03F5 D021 1339 | STO YRLOC+1 SAVE RELOC WORD U6I13110 03F6 74FF 03BDR 1340 | MDX L YDLUP,-1 DECREMENT COUNT TO NEXT HEAD U6I13120 03F8 C04C 1341 | LD YGPT U6I13130 03F9 D077 1342 | STO YPT SAVE RELOC POINTER U6I13140 03FA 6210 1343 | LDX 2 16 WORD GROUP COUNT (TIMES 2) U6I13150 1345 | * SCAN 8 WORD GROUP U6I13170 03FB C0C0 1347 | YF05 LD LAC U6I13190 03FC 9100 1348 | S 1 0 COMPARE TO ADDRESS REQUESTED U6I13200 03FD 4C18 0419R 1349 | BZ YF06 BRANCH ON MATCH U6I13210 03FF C816 1350 | LDD YRLOC GET RELOC BITS U6I13220 0400 1082 1351 | SLT 2 BRING OVER NEXT 2 U6I13230 0401 D814 1352 | STD YRLOC REPLACE U6I13240 0402 E015 1353 | AND X0003 REMOVE ALL BUT 2 WANTED U6I13250 0403 F06B 1354 | EOR YD2 COMPARE TO 2 U6I13260 0404 4C20 0408R 1355 | BNZ *+2 BRANCH IF NOT LIBF U6I13270 0406 74FF 03BCR 1356 | MDX L LAC,-1 BACK UP LAC IF LIBF U6I13280 0408 1000 1357 | NOP U6I13285 0409 7401 0445R 1358 | MDX L YGPT,1 PASS NEXT WORD OF TEXT U6I13290 040B 74FF 03BDR 1359 | MDX L YDLUP,-1 U6I13300 040D 7001 1360 | B *+1 BRANCH IF MORE U6I13310 040E 70D4 1361 | B YF02 GET NEXT SECTOR HEXDER U6I13320 040F 7401 03BCR 1362 | MDX L LAC,1 STEP LAC U6I13330 0411 1000 1363 | NOP U6I13335 0412 72FE 1364 | MDX 2 -2 DECR COUNT OF WDS IN GROUP U6I13340 0413 70E7 1365 | B YF05 EXAMINE NEXT UNTIL OUT U6I13350 0414 70DF 1366 | B YF04 GET NEXT RELOC WORD U6I13360 0416 1368 | YRLOC BSS E 2 HOLDS RELOCATABILITY WORD U6I13380 0418 0003 1369 | X0003 DC /0003 U6I13390 0419 6A66 1372 | YF06 STX 2 YF11+1 SAVE X2 U6I13440 041A 6600 0986R 1373 | LDX L2 DAREA-2 SET X2 FOR READ AND WRITE U6I13450 041C 4020 1374 | BSI YGET GET WORD LOOKED FOR U6I13460 041D C8F8 1375 | LDD YRLOC GET RELOC BITS U6I13470 041E 1082 1376 | SLT 2 BRING OVER BITS WANTED U6I13480 041F D8F6 1377 | STD YRLOC REPLACE U6I13490 0420 E0F7 1378 | AND X0003 REMOVE UNWANTED BITS U6I13500 0421 F04D 1379 | EOR YD2 CHECK FOR LIBF U6I13510 0422 4C18 0448R 1380 | BZ YF08 BRANCH IF LIBF U6I13520 0424 C101 1381 | LD 1 1 GET REQUESTED RELOC U6I13530 0425 E047 1382 | AND X000F REMOVE VERIFY BIT U6I13540 0426 4C18 0461R 1383 | BZ YF09 BRANCH IF ABSOLUTE U6I13550 0428 4C04 0461R 1384 | BOD YF09 BRANCH IF RELOCATABLE OR CALL U6I13560 042A 43DE 1385 | BSI 3 ERROR-X3 ERROR U6I13570 042B F3F0 1386 | EBC .30. ATTEMPT TO ADD LIBF U6I13580 042C 43DE 1387 | YF07 BSI 3 ERROR-X3 U6I13590 042D F2F8 1388 | EBC .28. ATTEMPT TO CHANGE LIBF U6I13600 042E C016 1389 | YRFBF LD YGPT BACK UP POINTER TO RESET U6I13610 042F 93CB 1390 | S 3 DZCON-X3 *TO PROPER POSITION IN NEW U6I13620 0430 D014 1391 | STO YGPT *BUFFER FULL U6I13630 0431 6600 0986R 1392 | LDX L2 DAREA-2 SET X2 FOR READ U6I13640 0433 7400 04E8R 1393 | MDX L YPRSW,0 SKIP IF PRE WRITE REQUIRED U6I13650 0435 7002 1394 | B YG015 BRANCH IF NOT U6I13660 0436 CBCB 1395 | LDD 3 DZCON-X3 U6I13670 0437 43D2 1396 | BSI 3 DWRIT-X3 WRITE OUT OLD SECTOR U6I13680 0438 7402 002DR 1397 | YG015 MDX L DZCON+1,2 STEP SECTOR ADDRESS U6I13690 043A CBCB 1398 | LDD 3 DZCON-X3 SET FOR READ U6I13700 043B 43CF 1399 | BSI 3 DREAD-X3 READ NEXT 2 SECTORS U6I13710 043C 7007 1400 | B YG01 RETURN U6I13720 043D 0000 1402 | YGET DC *-* ENTRY TO GET NEXT WORD U6I13740 043E C006 1403 | LD YGPT GET POINTER U6I13750 043F 802C 1404 | A YD1 STEP POINTER U6I13760 0440 D004 1405 | STO YGPT REPLACE POINTER U6I13770 0441 9029 1406 | S DENDA COMPARE TO END OF BUFFER U6I13780 0442 4C30 042ER 1407 | BP YRFBF BR AND REFILL IF OUT OF BFR U6I13790 0444 C400 0000 1408 | YG01 LD L *-* GET WORD U6I13800 0445R 1409 | YGPT EQU *-1 POINTER U6I13810 0446 4C80 043DR 1410 | B I YGET RETURN U6I13820 1412 | * CHECK FOR 2ND WORD OF LIBF AND EITHER BOTH LIBF U6I13835 1413 | * OR NEITHER LIBF U6I13836 0448 C101 1414 | YF08 LD 1 1 GET RELOC REQUEST U6I13840 0449 4C28 0464R 1415 | BN YF092 BR IF VERIFY U6I13850 044B 4C18 042CR 1416 | BZ YF07 BR IF ABSOLUTE U6I13860 044D 4C04 042CR 1417 | BOD YF07 BRANCH IF RELOC OR CALL U6I13870 044F 100D 1418 | SLA 13 CHECK FOR 2ND WORD LIBF U6I13880 0450 4C10 0461R 1419 | BNN YF09 BRANCH IF NOT 2ND WORD LIBF U6I13890 0452 40EA 1420 | YF085 BSI YGET GET 2ND WORD LIBF U6I13900 0453 C02C 1421 | LD YF11+1 LOAD SHIFT COUNT AND 2-10 U6I13902 0454 F01B 1422 | EOR YD3 *CHECK FOR LIBF SPLIT 2-10 U6I13904 1423 | * *OVER INDICATOR WORD 2-10 U6I13906 0455 4C18 045AR 1424 | BZ YF087 BRANCH IF TRUE. 2-10 U6I13908 0457 C8BE 1425 | LDD YRLOC GET RELOC BITS U6I13910 0458 1082 1426 | SLT 2 BRING OVER NEXT 2 U6I13920 0459 D8BC 1427 | STD YRLOC REPLACE U6I13930 045A 74FE 0480R 1428 | YF087 MDX L YF11+1,-2 DECREMENT SHIFT COUNT. 2-10 U6I13931 045C 7004 1429 | B YF09 BR IF IN SAME GROUP U6I13932 045D D0B9 1430 | STO YRLOC+1 HOLD NEW RELOC WORD U6I13933 045E 7412 0480R 1431 | MDX L YF11+1,18 RESET SHIFT COUNT U6I13934 0460 70F1 1432 | B YF085 GO GET NEXT WORD U6I13935 0461 C101 1433 | YF09 LD 1 1 U6I13940 0462 4C10 0472R 1434 | BNN YF10 BRANCH IF NOT VERIFY U6I13950 0464 C480 0445R 1435 | YF092 LD I YGPT GET WORD FOUND U6I13960 0466 F102 1436 | EOR 1 2 COMPARE TO DESIRED U6I13970 0467 4C98 03BFR 1437 | BZ I YFIND LEAVE IF MATCH U6I13980 0469 43DE 1438 | YF095 BSI 3 ERROR-X3 ERROR U6I13990 046A F2F1 1439 | EBC .21. U6I14000 046B 0C07R 1441 | DENDA DC DAREA+639 END OF DAREA U6I14020 046C 0001 1442 | YD1 DC 1 CONSTANT U6I14030 046D 000F 1443 | X000F DC /000F U6I14040 046E FFFC 1444 | XFFFC DC /FFFC U6I14050 046F 0002 1445 | YD2 DC 2 CONSTANT 2 U6I14060 0470 0012 1446 | YD3 DC /0012 USE WITH SPLIT LIBF CK 2-10 U6I14065 0471 0000 1447 | YPT DC *-* RELOC POINTER U6I14070 0472 C102 1449 | YF10 LD 1 2 GET NEW WORD U6I14090 0473 D480 0445R 1450 | STO I YGPT PLACE IN BUFFER U6I14100 0475 C0CF 1451 | LD YGPT BUFFER ADDR OF DATA WORD U6I14110 0476 90FA 1452 | S YPT BUFFER ADDR OF RELOC WORD U6I14120 0477 4C30 047FR 1453 | BP YF11 BRANCH IF BOTH IN SAME U6I14130 0479 CBCB 1454 | LDD 3 DZCON-X3 SET FOR WRITE U6I14140 047A 43D2 1455 | BSI 3 DWRIT-X3 WRITE OUT BUFFER U6I14150 047B 74FE 002DR 1456 | MDX L DZCON+1,-2 BACK UP TO PREVIOUS SECTOR U6I14160 047D CBCB 1457 | LDD 3 DZCON-X3 SET FOR READ U6I14170 047E 43CF 1458 | BSI 3 DREAD-X3 BRING IN PREVIOUS BUFFER U6I14180 047F 6600 0000 1459 | YF11 LDX L2 *-* RESTORE X2 U6I14190 0481 C101 1460 | LD 1 1 GET REQUESTED RELOC U6I14200 0482 E095 1461 | AND X0003 REMOVE ALL BUT NEW RELOC BITS U6I14210 0483 D101 1462 | STO 1 1 REPLACE U6I14220 0484 C891 1463 | LDD YRLOC GET OLD RELOC U6I14230 0485 E0E8 1464 | AND XFFFC REMOVE BITS BEING REPLACED U6I14240 0486 E901 1465 | OR 1 1 ADD NEW BITS U6I14250 0487 72FE 1466 | MDX 2 -2 U6I14260 0488 1280 1467 | SLT 2 0 REPOSITION IN ACC U6I14270 0489 D480 0471R 1468 | STO I YPT PLACE IN BUFFER U6I14280 048B 6600 0986R 1469 | YF12 LDX L2 DAREA-2 SET X2 FOR WRITE U6I14290 048D CBCB 1470 | LDD 3 DZCON-X3 SET FOR WRITE U6I14300 048E 43D2 1471 | BSI 3 DWRIT-X3 WRITE OUT BUFFER U6I14310 048F 4C80 03BFR 1472 | B I YFIND U6I14320 1474 | * FOR EXPANSION U6I14340 0491 D056 1476 | YF13 STO YPRSW SET FORCE REWRITE SWITCH ON U6I14360 0492 C0B2 1477 | LD YGPT CALCULATE PROGRAM WORDS U6I14370 0493 9400 0377R 1478 | S L ZBUF *IN BUFFER U6I14380 0495 1890 1479 | SRT 16 POSITION FOR DIVIDE U6I14390 0496 AC00 03A6R 1480 | D L Z20 DIVIDE BY WORDS PER BLOCK U6I14400 0498 1090 1481 | SLT 16 BRING OVER U6I14410 0499 9049 1482 | S YD16 COMPARE TO 16 U6I14420 049A 4C08 049ER 1483 | BNP *+2 BRANCH IF ENOUGH ROOM IN LAST U6I14430 049C 7401 0024R 1484 | MDX L DBCNT,1 STEP DISK BLOCK COUNT U6I14440 049E 74FF 0445R 1485 | MDX L YGPT,-1 BACK UP POINTER U6I14450 04A0 C0A4 1486 | LD YGPT NEED TO BACK UP ONE WORD, U6I14460 04A1 9400 0377R 1487 | S L ZBUF *MAKE SURE IT IS IN BUFFER U6I14470 04A3 4C10 04ADR 1488 | BNN YF14 BRANCH OK U6I14480 04A5 74FE 002DR 1489 | MDX L DZCON+1,-2 BACK UP SECTOR ADDRESS U6I14490 04A7 6600 0986R 1490 | LDX L2 DAREA-2 SET FOR READ U6I14500 04A9 CBCB 1491 | LDD 3 DZCON-X3 U6I14510 04AA 43CF 1492 | BSI 3 DREAD-X3 READ IN OLD SECTORS U6I14520 04AB C0BF 1493 | LD DENDA SET TO END U6I14530 04AC D098 1494 | STO YGPT *OF BUFFER U6I14540 04AD C100 1495 | YF14 LD 1 0 GET REQUESTED ADDRESS U6I14550 04AE D480 0445R 1496 | STO I YGPT STORE IT IN DATA HEADER U6I14560 04B0 408C 1497 | BSI YGET SET TO NEXT WORD U6I14570 04B1 C0BA 1498 | LD YD1 U6I14580 04B2 9101 1499 | S 1 1 NEGATIVE IF CALL OR LIBF U6I14590 04B3 1001 1500 | SLA 1 TURN ON CARRY IF CALL/LIBF U6I14600 04B4 C032 1501 | LD YD4 GET WORD COUNT U6I14610 04B5 4802 1502 | BSC C U6I14620 04B6 80B5 1503 | A YD1 INCREASE BY 1 IF LIBF OR CALL U6I14630 04B7 D480 0445R 1504 | STO I YGPT STORE IT IN DATA HEADER U6I14640 04B9 4083 1505 | BSI YGET SET TO NEXT WORD U6I14650 04BA C0B1 1506 | LD YD1 U6I14660 04BB 9101 1507 | S 1 1 NEGATIVE IF LIBF OR CALL U6I14670 04BC 4C28 04E9R 1508 | BN YF17 BRANCH IF LIBF OR CALL U6I14680 04BE C101 1509 | LD 1 1 GET RELOCATABILITY U6I14690 04BF 100E 1510 | SLA 14 POSITION IT U6I14700 04C0 D480 0445R 1511 | STO I YGPT STORE IT U6I14710 04C2 4400 043DR 1512 | BSI L YGET SET TO NEXT U6I14720 04C4 C102 1513 | YF15 LD 1 2 GET DATA WORD U6I14730 04C5 D480 0445R 1514 | YF16 STO I YGPT STORE IT U6I14740 04C7 4400 043DR 1515 | BSI L YGET SET TO NEXT WORD U6I14750 04C9 C100 1516 | LD 1 0 GET ADDRESS U6I14760 04CA 80A1 1517 | A YD1 STEP BY ONE U6I14770 04CB D480 0445R 1518 | STO I YGPT STORE IT U6I14780 04CD D400 0370R 1519 | STO L YPLEN SAVE FOR NEW PROGRAM LENGTH U6I14790 04CF 4400 043DR 1520 | BSI L YGET SET TO NEXT U6I14800 04D1 1010 1521 | SLA 16 CLEAR ACC U6I14810 04D2 D480 0445R 1522 | STO I YGPT SET END DATA HEADER U6I14820 04D4 6913 1523 | STX 1 YPRSW SET SWITCH OFF U6I14830 1524 | * CALCULATE NEW DISK BLOCK COUNT U6I14840 04D5 C3CC 1525 | LD 3 DZCON+1-X3 START WITH PRESENT SECTOR U6I14850 04D6 9400 0376R 1526 | S L DZHLD *ADDRESS, SUBTRACT PROGRAM U6I14860 1527 | * *STARTING SECTOR ADDRESS U6I14870 04D8 A00D 1528 | M YD320 BY WORDS PER SECTOR U6I14880 04D9 1090 1529 | SLT 16 BRING THEM OVER U6I14890 04DA 8400 0445R 1530 | A L YGPT ADD PRESENT POINTER U6I14900 04DC 9400 0377R 1531 | S L ZBUF SUBTRACT BUFFER ADDRESS U6I14910 1532 | * NOW HAVE TOTAL WORDS U6I14920 04DE 1890 1533 | SRT 16 POSITION FOR DIVIDE U6I14930 04DF A805 1534 | D YD20 CONVERT TO SECTOR BLOCKS U6I14940 04E0 808B 1535 | A YD1 U6I14945 04E1 D3C3 1536 | STO 3 DBCNT-X3 UPDATE SECTOR BLOCK COUNT U6I14950 04E2 70A8 1537 | B YF12 WRITE AND RETURN U6I14960 04E3 0010 1539 | YD16 DC 16 CONSTANT U6I14980 04E4 0012 1540 | YD18 DC 18 U6I14990 04E5 0014 1541 | YD20 DC 20 U6I15000 04E6 0140 1542 | YD320 DC 320 U6I15010 04E7 0004 1543 | YD4 DC 4 CONSTANT U6I15020 04E8 0001 1544 | YPRSW DC 1 FORCE WRITE BEFORE READ IF 0 U6I15030 04E9 C101 1545 | YF17 LD 1 1 GET RELOCATABILITY U6I15040 04EA 1890 1546 | SRT 16 PLACE 1ST RELOC IN EXT U6I15050 04EB C104 1547 | LD 1 4 GET 2ND U6I15060 04EC E400 0418R 1548 | AND L X0003 REMOVE BIT 13 IN CASE 2ND IN U6I15070 04EE 9080 1549 | S YD2 *LIBF U6I15080 04EF D013 1550 | STO YHOLD SAVE FOR LATER BRANCHES U6I15090 04F0 4828 1551 | BSC +Z SKIP IF 2ND RELOC IS 2 OR 3 U6I15100 04F1 C104 1552 | LD 1 4 GET 2ND RELOC U6I15110 04F2 100E 1553 | SLA 14 POSITION 2ND RELOC OR 0 IF U6I15120 1554 | * INVALID U6I15130 04F3 18C2 1555 | RTE 2 BRING OVER 1ST U6I15140 04F4 D480 0445R 1556 | STO I YGPT STORE RELOC U6I15150 04F6 4400 043DR 1557 | BSI L YGET MAKE SURE NEXT WORD IS IN BUF U6I15160 04F8 C102 1558 | LD 1 2 GET 1ST WORD TO MODIFY U6I15170 04F9 D480 0445R 1559 | STO I YGPT STORE 1ST WORD U6I15180 04FB 4400 043DR 1560 | BSI L YGET MAKE SURE NEXT WORD IS IN BUF U6I15190 04FD C005 1561 | LD YHOLD NEGATIVE IF VALID U6I15200 04FE 1801 1562 | SRA 1 ZERO IF 2ND RELOC INVALID U6I15210 04FF 4C18 04C5R 1563 | BZ YF16 BRANCH IF 2ND RELOC INVALID U6I15220 0501 7103 1564 | MDX 1 3 POINT TO NEXT STRING ITEM U6I15230 0502 70C1 1565 | B YF15 U6I15240 0503 0000 1566 | YHOLD DC *-* NON-NEGATIVE IF 2ND RELOC INV U6I15250 1568 | *************************************************** U6I15270 1569 | * CVXB4 * CONVERT UNPACKED-EBCDIC TO BINARY * U6I15280 1570 | *************************************************** U6I15290 1571 | * * U6I15300 1572 | *INPUT -- ARGUMENT=ADDR(LEFTMOST OF 4 EBCDIC CHARS* U6I15310 1573 | * * U6I15320 1574 | *OUTPUT -- 16-BIT BINARY IN ACC * U6I15330 1575 | * * U6I15340 1576 | *EXTERNAL REFERENCES -- NONE * U6I15350 1577 | * * U6I15360 1578 | *ERRORS -- EBCDIC CHAR NOT IN SET (0-9 A-F) * U6I15370 1579 | * * U6I15380 1580 | *RETURN -- 1. TO BSI+2 IF VALID * U6I15390 1581 | * 2. TO BSI+3 IF ERROR * U6I15400 1582 | * * U6I15410 1583 | *NOTES -- X2 IS SAVED/RESTORED * U6I15420 1584 | * X1 AND X3 ARE NOT USED * U6I15430 1585 | * ACC/EXT/STATUS ARE NOT SAVED RESTORED * U6I15440 1586 | * * U6I15450 1587 | *************************************************** U6I15460 1589 | * INITIALIZATION U6I15480 0504 6A22 1591 | CI001 STX 2 CI092+1 SAVE INDEX 2 U6I15500 0505 C480 0048R 1592 | LD I CVXB4 ACC=ADDR(EBCDIC FIELD) U6I15510 0507 9023 1593 | S CI101 SUBTRACT 1 U6I15520 0508 D004 1594 | STO CI003+1 SET INTO LOAD INSTR U6I15530 0509 6204 1595 | LDX 2 +4 XR2=LENGTH OF EBCDIC U6I15540 050A 7401 0048R 1596 | MDX L CVXB4,+1 SET RETURN ADDRESS U6I15550 1598 | * CONVERSION LOOP--PER INPUT CHARACTER U6I15570 050C C600 0000 1600 | CI003 LD L2 *-* GET INPUT CHAR (R TO L) U6I15590 050E 801B 1601 | A CI100 ADD /FF10 U6I15600 050F 4C02 051DR 1602 | BSC L CI010,C BR IF CARRY--F0-FF U6I15610 0511 801A 1603 | A CI12F ADD /002F--SHOULD CARRY U6I15620 0512 4C02 0517R 1604 | BSC L *+3,C BR IF CARRY--C1-EF U6I15630 1606 | * ERROR--SET RETURN ADDR FOR ERROR RETURN U6I15650 0514 7401 0048R 1608 | CI095 MDX L CVXB4,+1 SET FOR ERROR RETURN U6I15670 0516 700F 1609 | MDX CI092 GO START THE RETURN U6I15680 1611 | * CONTINUE NORMAL PROCESSING U6I15700 0517 8015 1613 | A CI110 ADD /000A U6I15720 0518 D016 1614 | STO CI200 SAVE CUR REPRESENTATION U6I15730 0519 9014 1615 | S CI115 SUBTRACT /000F U6I15740 051A 4C30 0514R 1616 | BSC L CI095,-Z BR TO ERR IF NOT C1-C6 U6I15750 051C 7004 1617 | MDX CI020 IS C1-C6--GO TO COMN ROUT U6I15760 051D D011 1619 | CI010 STO CI200 SAVE CUR REPRESENTATION U6I15780 051E 900E 1620 | S CI110 SUBTRACT /000A U6I15790 051F 4C10 0514R 1621 | BSC L CI095,- BR TO ERR IF NOT F0-F9 U6I15800 0521 C00D 1623 | CI020 LD CI200 RETRIEVE REPRESENTATION U6I15820 0522 1884 1624 | SRT 4 SHIFT TO EXTENSION U6I15830 0523 72FF 1625 | MDX 2 -1 DECR POINTER/COUNT U6I15840 0524 70E7 1626 | MDX CI003 BR IF NOT EXHAUSTED U6I15850 1628 | * RETURN U6I15870 0525 1090 1630 | SLT 16 PUT INTO ACC U6I15890 0526 6600 0000 1631 | CI092 LDX L2 *-* RESTORE XR2 U6I15900 0528 4C80 0048R 1632 | BSC I CVXB4 RETURN TO CALLER U6I15910 1634 | * CONSTANTS AND WORKSPACE U6I15930 052A FF10 1636 | CI100 DC /FF10 TO FORCE F-ZONE TO CARRY U6I15950 052B 0001 1637 | CI101 DC 1 CONSTANT 1 U6I15960 052C 002F 1638 | CI12F DC /002F FORCE C-ZONE TO CARRY U6I15970 052D 000A 1639 | CI110 DC /000A CONSTANT 10 U6I15980 052E 000F 1640 | CI115 DC /000F CONSTANT 15 U6I15990 052F 0000 1641 | CI200 DC *-* HOLD CUR REPRESENTATION U6I16000 1643 | *************************************************** U6I16020 1644 | * TSTBL * TEST A FIELD FOR ALL BLANKS * U6I16030 1645 | *************************************************** U6I16040 1646 | * * U6I16050 1647 | *INPUT -- XR1=NEG WORD COUNT, ARG=ADDR RIGHT+1 * U6I16060 1648 | * * U6I16070 1649 | *OUTPUT -- NONE * U6I16080 1650 | * * U6I16090 1651 | *EXTERNAL REFERENCES -- NONE * U6I16100 1652 | * * U6I16110 1653 | *RETURN -- 1. TO BSI+2 IF ALL BLANK * U6I16120 1654 | * 2. TO BSI+3 IF NOT ALL BLANK * U6I16130 1655 | * * U6I16140 1656 | *ERRORS -- NONE * U6I16150 1657 | * * U6I16160 1658 | *NOTES -- X1 IS SAVED/RESTORED * U6I16170 1659 | * X2 AND X3 ARE NOT USED * U6I16180 1660 | * ACC/EXT/STATUS ARE NOT SAVED/RESTORED * U6I16190 1661 | * * U6I16200 1662 | *************************************************** U6I16210 1664 | * INITIALIZATION U6I16230 0530 690D 1666 | TB001 STX 1 TB091+1 SAVE INDEX 1 U6I16250 0531 C480 004BR 1667 | LD I TSTBL ACC=ADDR(RIGHTMOST+1) U6I16260 0533 D003 1668 | STO TB010+1 SET LOAD INSTR U6I16270 0534 7401 004BR 1669 | MDX L TSTBL,+1 SET NORMAL RETURN U6I16280 1671 | * LOOP--ONCE PER CHARACTER U6I16300 0536 C500 0000 1673 | TB010 LD L1 *-* GET CHARACTER U6I16320 0538 F00B 1674 | EOR TB140 COMPARE TO BLANK U6I16330 0539 4C20 0541R 1675 | BSC L TB050,Z BR IF *NOT* BLANK U6I16340 053B 7101 1676 | MDX 1 +1 INCREMENT INDEX POINTER U6I16350 053C 70F9 1677 | MDX TB010 BR IF NOT EXHAUSTED U6I16360 1679 | * RETURN U6I16380 053D 6500 0000 1681 | TB091 LDX L1 *-* RESTORE INDEX 1 U6I16400 053F 4C80 004BR 1682 | BSC I TSTBL RETURN TO CALLER U6I16410 1684 | * NON-BLANK CHAR ENCOUNTERED U6I16430 0541 7401 004BR 1686 | TB050 MDX L TSTBL,+1 SET FOR NON-BLANK RETURN U6I16450 0543 70F9 1687 | MDX TB091 START THE RETURN U6I16460 1689 | * CONSTANT U6I16480 0544 0040 1691 | TB140 DC /0040 CONSTANT BLANK U6I16500 1693 | *************************************************** U6I16520 1694 | * GTREC ROUTINE -- READ INPUT RECORD FROM PRDR * U6I16530 1695 | *************************************************** U6I16540 1697 | * READ AND DO STRICT CONVERSION U6I16560 0545R 1699 | GR001 EQU * U6I16580 0545 7400 007C 1700 | MDX L $KCSW,0 TEST IF TYP IN FORCE U6I16590 0547 7006 1701 | MDX *+6 SKIP LAST CARD TEST IF TYP U6I16600 0548 C400 0033 1702 | LD L $LAST GET LAST CD INDIC U6I16610 054A 4C18 054ER 1703 | BSC L *+2,+- BR IF NOT EOF U6I16620 054C 43DE 1704 | BSI 3 ERROR-X3 EOF--INVOKE ERROR U6I16630 054D F0F4 1705 | EBC .04. ERROR 4 U6I16640 054E C813 1706 | LDD GR100 INPUT LIST OF ARGS U6I16650 054F 4400 07E1R 1707 | BSI L CD000+1 INVOKE INPUT ROUTINE U6I16660 0551 7400 0013 1708 | MDX L $IBSY,0 WAIT FOR U6I16670 0553 70FD 1709 | MDX *-3 *COMPLETION U6I16680 0554 C400 000AR 1710 | LD L PIODV BR IF I/O FROM U6I16690 0556 4C28 055BR 1711 | BN GR005 *P/T OR TYP U6I16700 0558 C00A 1712 | LD GR100+1 POINTER TO CARD AREA U6I16710 0559 4400 08F0R 1713 | BSI L CVHEB CONVERT TO EBC IF FROM CARD U6I16720 055B 7400 000F 1714 | GR005 MDX L $CTSW,0 SKIP IF NOT MCR U6I16730 055D 7002 1715 | MDX GR009 MCR ENCOUNTERED--ERROR U6I16740 055E 4C80 0045R 1716 | BSC I GTREC RETURN TO CALLER U6I16750 1718 | * MONITOR CONTROL REC ENCOUNTERED U6I16770 0560 43DE 1720 | GR009 BSI 3 ERROR-X3 INVOKE ERROR U6I16790 0561 F0F5 1721 | EBC .05. ARGUMENT FOR ERROR 5 U6I16800 1723 | * ARGUMENT LIST U6I16820 0562 1724 | BSS E 0 U6I16830 0562 7002 1725 | GR100 DC /7002 READ (WITH CONVERSION) U6I16840 0563 004FR 1726 | DC CAREA-1 U6I16850 0564 0000 1728 | LETSR DC *-* ENTRY POINT U6I16870 1730 | *************************************************** U6I16890 1731 | * LETSR * SEARCH LET/FLET FOR PROGRAM/FILE * U6I16900 1732 | *************************************************** U6I16910 1733 | * * U6I16920 1734 | *INPUT -- X1=ADDR(SAD OF LET--WITH DRIVE CODE) * U6I16930 1735 | * ACC/EXT=NAMECODE ITEM (BITS0-1=00) * U6I16940 1736 | * IN-LINE ARG=ADDR OF 322-WORD AREA ON * U6I16950 1737 | * EVEN BOUNDARY TO USE AS BUFFER * U6I16960 1738 | * * U6I16970 1739 | *OUTPUT -- ACC=ZERO IF ITEM NOT FOUND, OR * U6I16980 1740 | * DISK-BLOCK COUNT IF ITEM WAS FOUND * U6I16990 1741 | * EXT=DISK-BLOCK ADDR OF FOUND ITEM * U6I17000 1742 | * STATUS=00 FOR DSF OR NOT-FOUND * U6I17010 1743 | * 01 FOR SECONDARY ENTRY POINT * U6I17020 1744 | * 10 FOR CORE-IMAGE PROGRAM * U6I17030 1745 | * 11 FOR DATA-FILE * U6I17040 1746 | * * U6I17050 1747 | *EXTERNAL REFERENCES-- * U6I17060 1748 | * DZ000 -- ENTRY FOR DISKZ * U6I17070 1749 | * $DBSY -- DISK-BUSY INDICATOR * U6I17080 1750 | * * U6I17090 1751 | *RETURN -- ALWAYS TO ARGUMENT+1 * U6I17100 1752 | * * U6I17110 1753 | *NOTES -- X1/X2 ARE SAVED/RESTORED * U6I17120 1754 | * X3 IS NOT USED * U6I17130 1755 | * ACC/EXT/STATUS ARE SET BY THE ROUTINE * U6I17140 1756 | * * U6I17150 1757 | *************************************************** U6I17160 1759 | * INITIALIZATION U6I17180 0565 D842 1761 | LS001 STD LS500 SAVE THE NAMECODE U6I17200 0566 693C 1762 | STX 1 LS091+1 SAVE INDEX 1 U6I17210 0567 6A3D 1763 | STX 2 LS092+1 SAVE INDEX 2 U6I17220 0568 C100 1764 | LD 1 0 ACC=DRIVECODE/SAD U6I17230 0569 188C 1765 | SRT 12 ACC=DRCODE, EXT=SAD U6I17240 056A 100C 1766 | SLA 12 DRCODE IN BITS 0-4 U6I17250 056B D040 1767 | STO LS104 SAVE DRIVECODE U6I17260 056C 180C 1768 | SRA 12 DRCODE ADJACENT TO SAD U6I17270 056D 1884 1769 | SRT 4 EXT=DRCODE/SAD U6I17280 056E C480 0564R 1770 | LD I LETSR ACC=ADDR(BUFFER) U6I17290 0570 7401 0564R 1771 | MDX L LETSR,+1 UPDATE FOR RETURN U6I17300 0572 D038 1772 | STO LS200+1 ADDR(BUFFER) TO RDLIST U6I17310 0573 6580 05ABR 1773 | LDX I1 LS200+1 SET X1 NOW=ADDR(BUF) U6I17320 0575 C037 1774 | LD LS320 CONSTANT 320 U6I17330 0576 D900 1775 | STD 1 0 SET UP DCTL FIELD U6I17340 0577 4037 1776 | BSI LS900 DO UNOVERLAPPED READ U6I17350 0578 C103 1777 | LD 1 3 ACC=SAD(UA) U6I17360 0579 1004 1778 | SLA 4 MAKE INTO DISK BLK ADDR U6I17370 057A D033 1779 | STO LS658 INITIALIZE DBADR U6I17380 057B 7001 1780 | MDX *+1 SKIP TO PROCESS FIRST SECT U6I17390 1782 | * SEARCH A SECTOR OF LET/FLET U6I17410 057C 4032 1784 | LS010 BSI LS900 DO UNOVERLAPPED READ U6I17430 057D 6269 1785 | LDX 2 105 X2=NUMBER OF ENTRIES/SECTR U6I17440 057E C108 1786 | LS020 LD 1 8 SECOND WORD OF NAME U6I17450 057F 1890 1787 | SRT 16 PUT INTO EXT U6I17460 0580 C107 1788 | LD 1 7 FIRST WORD OF NAME U6I17470 0581 9826 1789 | SD LS500 SUBTRACT DESIRED NAME U6I17480 0582 1002 1790 | SLA 2 REMOVE TYPE-BITS U6I17490 0583 4818 1791 | BSC +- U6I17500 0584 1090 1792 | SLT 16 U6I17510 0585 4C18 0598R 1793 | BSC L LS077,+- BR IF EQUAL U6I17520 0587 C026 1794 | LD LS658 GET CURRENT DBADR U6I17530 0588 8109 1795 | A 1 9 ADD NEW DBCNT U6I17540 0589 D024 1796 | STO LS658 UPDATED DBADR U6I17550 058A 7103 1797 | MDX 1 +3 UPDATE LET POINTER U6I17560 058B 72FF 1798 | MDX 2 -1 REDUCE COUNT U6I17570 058C 70F1 1799 | MDX LS020 BR IF IN SAME SECTOR U6I17580 1801 | * MUST GO TO A NEW SECTOR U6I17600 058D 6580 05ABR 1803 | LS015 LDX I1 LS200+1 X1=ADDR(BUFFER) U6I17620 058F C106 1804 | LD 1 6 ACC=SAD(NEXT LET SECTOR) U6I17630 0590 E81B 1805 | OR LS104 OR IN THE DRIVE CODE U6I17640 0591 D101 1806 | STO 1 1 STORE INTO DCTL U6I17650 0592 1004 1807 | SLA 4 GET RID OF DRIVE CODE U6I17660 0593 4820 1808 | BSC Z SKIP IF *NO* NEXT SECTOR U6I17670 0594 70E7 1809 | MDX LS010 BR TO PROCESS NEW SECTOR U6I17680 1811 | * FILE/PROGRAM WAS NOT FOUND AT ALL U6I17700 0595 10A0 1813 | SLT 32 CLEAR ACC/EXT U6I17720 0596 2000 1814 | LS202 LDS 0 SET STATUS = ZERO U6I17730 0597 700A 1815 | MDX LS091 GO START THE RETURN U6I17740 1817 | * FILE/PROGRAM WAS FOUND U6I17760 0598 C107 1819 | LS077 LD 1 7 FIRST WORD OF NAME AGAIN U6I17780 0599 180E 1820 | SRA 14 PREFIX TO ACC BITS 14-15 U6I17790 059A E8FB 1821 | OR LS202 MAKE AN LDS INSTR U6I17800 059B D005 1822 | STO LS090 STORE IN INSRT SEQ U6I17810 059C C011 1823 | LD LS658 GET THE DB ADR U6I17820 059D 1890 1824 | SRT 16 EXT=DBADR U6I17830 059E C109 1825 | LD 1 9 ACC=DBCNT U6I17840 059F 2001 1826 | LDS 1 SET FOR SECONDARY ENTRY PT U6I17850 05A0 4820 1827 | BSC Z SKIP IF *YES* SEC ENTRY PT U6I17860 05A1 2000 1828 | LS090 LDS 0 MODIFIED AS APPROP U6I17870 05A2 6500 0000 1829 | LS091 LDX L1 *-* RESTORE X1 U6I17880 05A4 6600 0000 1830 | LS092 LDX L2 *-* RESTORE INDEX 2 U6I17890 05A6 4C80 0564R 1831 | LS099 BSC I LETSR RETURN TO CALLER U6I17900 1833 | * CONSTANTS AND WORKSPACE U6I17920 05A8 1835 | BSS E 0 U6I17940 05A8 1836 | LS500 BSS 2 HOLD NAMECDE ITEM U6I17950 05AA 0000 1837 | LS200 DC 0 INDICATE READ U6I17960 05AB 0000 1838 | DC *-* SECOND HALF OF RDLIST U6I17970 05AC 0000 1839 | LS104 DC *-* HOLD DRIVE CODE U6I17980 05AD 0140 1840 | LS320 DC 320 CONSTANT 320 U6I17990 05AE 0000 1841 | LS658 DC *-* HOLD RUNNING DBADR U6I18000 1843 | * UNOVERLAPPED DISK READ SERVICE ROUTINE U6I18020 05AF 0000 1845 | LS900 DC *-* ENTRY U6I18040 05B0 C8F9 1846 | LDD LS200 READLIST U6I18050 05B1 4400 00F2 1847 | BSI L DZ000 INVOKE DISKZ TO READ U6I18060 05B3 7400 00EE 1848 | MDX L $DBSY,0 DWELL UNTIL U6I18070 05B5 70FD 1849 | MDX *-3 *READ COMPLETE U6I18080 05B6 4C80 05AFR 1850 | BSC I LS900 RETURN TO CALLER U6I18090 05B8 0000 1853 | CVEBN DC *-* ENTRY POINT U6I18120 1855 | *************************************************** U6I18140 1856 | * CVEBN * CONVERT SINGLE-EBCDIC TO NAMECODE * U6I18150 1857 | *************************************************** U6I18160 1858 | * * U6I18170 1859 | *INPUT -- ARG 0 = LENGTH, ARG 1 = ADDR(EBCDIC) * U6I18180 1860 | * * U6I18190 1861 | *OUTPUT -- NAMECODE ITEM (PREFIX 00) IN ACC/EXT * U6I18200 1862 | * * U6I18210 1863 | *EXTERNAL REFERENCES -- NONE * U6I18220 1864 | * * U6I18230 1865 | *ERRORS -- 1. LENGTH LT 1 OR GT 5 * U6I18240 1866 | * 2. ANY CHAR NOT OF SET (A-Z $ # @ 0-9) * U6I18250 1867 | * 3. FIRST CHAR NOT OF SET (A-Z $ # @) * U6I18260 1868 | * * U6I18270 1869 | *RETURN -- 1. TO BSI+3 IF VALID * U6I18280 1870 | * 2. TO BSI+4 IF ERROR * U6I18290 1871 | * * U6I18300 1872 | *NOTES -- X1 AND X2 ARE SAVED/RESTORED * U6I18310 1873 | * X3 IS NOT USED * U6I18320 1874 | * ACC/EXT/STAT ARE NOT SAVED/RESTORED * U6I18330 1875 | * * U6I18340 1876 | *************************************************** U6I18350 1878 | * INITIALIZATION U6I18370 05B9 693B 1880 | CN001 STX 1 CN091+1 SAVE INDEX 1 U6I18390 05BA 6A3C 1881 | STX 2 CN092+1 SAVE INDEX 2 U6I18400 05BB 6580 05B8R 1882 | LDX I1 CVEBN X1=ADDR(ARGLIST) U6I18410 05BD C101 1883 | LD 1 1 ADDR(EBCDIC) U6I18420 05BE 904A 1884 | S CN101 ADDR(EBCDIC)-1 U6I18430 05BF D010 1885 | STO CN003+1 SET INTO LOAD INSTR U6I18440 05C0 C100 1886 | LD 1 0 ACC=LENGTH U6I18450 05C1 D001 1887 | STO *+1 U6I18460 05C2 6600 0000 1888 | LDX L2 *-* X2=LENGTH U6I18470 05C4 7102 1889 | MDX 1 +2 X1=ADDR(NORMAL RETURN) U6I18480 05C5 6933 1890 | STX 1 CN099+1 SET RETURN INSTR U6I18490 05C6 4C08 0606R 1891 | BSC L CN095,+ BR TO ERR IF LENGTH LT 1 U6I18500 05C8 9049 1892 | S CN105 LENGTH - 5 U6I18510 05C9 4C30 0606R 1893 | BSC L CN095,-Z BR TO ERR IF LENGTH GT 5 U6I18520 05CB 10A0 1894 | SLT 32 ACC/EXT = 0 U6I18530 1896 | * CONVERSION LOOP -- PER INPUT CHARACTER U6I18550 05CC 1886 1898 | CN002 SRT 6 SHIFT CUR NAMECODE VALUE U6I18570 05CD D83C 1899 | STD CN205 *AND SAVE IT U6I18580 05CE 1090 1900 | SLT 16 ASSURE EXT = 0 U6I18590 05CF C600 0000 1901 | CN003 LD L2 *-* GET INPUT CHARACTER U6I18600 05D1 1009 1902 | SLA 9 EBCDIC BIT 0 TO CARRY U6I18610 05D2 4C10 0606R 1903 | BSC L CN095,- BR TO ERR IF 00-3F, 80-BF U6I18620 05D4 D037 1904 | STO CN110 SAVE 7-BIT CHAR U6I18630 05D5 4C02 05E3R 1905 | BSC L CN050,C BR IF CARRY--C0-FF U6I18640 1907 | * CHAR IS IN RANGE 40-7F U6I18660 05D7 1001 1909 | SLA 1 RETAIN 6 BITS ONLY U6I18680 05D8 4818 1910 | BSC +- SKIP UNLESS BLANK U6I18690 05D9 E830 1911 | OR CN205 BLANK--OR PREV CHARS U6I18700 05DA 4820 1912 | BSC Z SKIP IF NO PREV--ELSE ERR U6I18710 05DB F031 1913 | EOR CN15B IS IT DOLLAR U6I18720 05DC 4820 1914 | BSC Z SKIP IF MATCH U6I18730 05DD F030 1915 | EOR CN17B IS IT POUND SIGN U6I18740 05DE 4820 1916 | BSC Z SKIP IF MATCH U6I18750 05DF F02F 1917 | EOR CN17C IS IT AT-SIGN U6I18760 05E0 4C20 0606R 1918 | BSC L CN095,Z BR TO ERR IF NONE OF ABOVE U6I18770 05E2 7009 1919 | MDX CN080 FOUND--GO TO COMMON ROUT U6I18780 1921 | * CHAR IS IN THE RANGE C0-FF U6I18800 05E3 1002 1923 | CN050 SLA 2 RETAIN 5 BITS AND CARRY U6I18820 05E4 4C02 05FAR 1924 | BSC L CN055,C BR IF IN RANGE E0-FF U6I18830 05E6 1001 1925 | CN060 SLA 1 RANGE C0-DF--RETAIN DIGIT U6I18840 05E7 4C18 0606R 1926 | BSC L CN095,+- BR TO ERR IF DIGIT ZERO U6I18850 05E9 8026 1927 | CN070 A CN160 ADD /6000--SHOULD NOT CARE U6I18860 05EA 4C02 0606R 1928 | BSC L CN095,C BR TO ERR IF DIGIT A-F U6I18870 1930 | * COMMON COMPLETION OF CONVERSION OF AN INPUT CHAR U6I18890 05EC C01F 1932 | CN080 LD CN110 GET OLD 7-BIT CHAR U6I18910 05ED 1001 1933 | SLA 1 GET RID OF TOP BIT U6I18920 05EE 1802 1934 | SRA 2 BITS 0-1=0, BITS 2-7=CHAR U6I18930 05EF 881A 1935 | AD CN205 ADD PREV NAMECODE VALUE U6I18940 05F0 72FF 1936 | MDX 2 -1 DECR LOOP COUNTER U6I18950 05F1 70DA 1937 | MDX CN002 BR BACK IF NOT EXHAUSTED U6I18960 05F2 4C18 0606R 1938 | BSC L CN095,+- BRANCH IF BLANK NAME U6I18965 1940 | * RETURN U6I18980 05F4 6500 0000 1942 | CN091 LDX L1 *-* RESTORE INDEX 1 U6I19000 05F6 6600 0000 1943 | CN092 LDX L2 *-* RESTORE INDEX 2 U6I19010 05F8 4C00 0000 1944 | CN099 BSC L *-* RETURN TO CALLER U6I19020 1946 | * SPECIAL HANDLING FOR CHAR IN RANGE E0-FF U6I19040 05FA F016 1948 | CN055 EOR CN1E1 IS IT THE INVALID E1 U6I19060 05FB 4C18 0606R 1949 | BSC L CN095,+- BR TO ERR IF IT IS U6I19070 05FD F013 1950 | EOR CN1E1 RESTORE PREV CONTENT U6I19080 05FE 4C10 05E6R 1951 | BSC L CN060,- BR IF E0, E2-EF U6I19090 1953 | * SPECIAL HANDLING FOR F0-FF U6I19110 0600 72FF 1955 | MDX 2 -1 SKIP IF FIRST CHAR U6I19130 0601 7001 1956 | MDX *+1 BR IF NOT FIRST CHAR U6I19140 0602 7003 1957 | MDX CN095 BR TO ERR--FIRST CHAR NUM U6I19150 0603 7201 1958 | MDX 2 +1 RETURN X2 TO PREV VALUE U6I19160 0604 1001 1959 | SLA 1 RETAIN DIGIT ONLY U6I19170 0605 70E3 1960 | MDX CN070 BR TO TEST DIGIT GT 9 U6I19180 1962 | * SET ERROR RETURN U6I19200 0606 7401 05F9R 1964 | CN095 MDX L CN099+1,+1 SET ERR RETURN ADDR U6I19220 0608 70EB 1965 | MDX CN091 GO TO RETURN U6I19230 1967 | * CONSTANTS AND WORKSPACE U6I19250 0609 0001 1968 | CN101 DC 1 CONSTANT 1 U6I19260 060A 0000 0000 1969 | CN205 DEC 0 HOLD CUR NAMECODE VALUE U6I19270 060C 0000 1970 | CN110 DC *-* HOLD CUR 7-BIT CHAR U6I19280 060D 6C00 1971 | CN15B DC /6C00 TO COMPARE /5B ($) U6I19290 060E 8000 1972 | CN17B DC /8000 TO COMPARE /7B (#) U6I19300 060F 1C00 1973 | CN17C DC /1C00 TO COMPARE /7C (@) U6I19310 0610 6000 1974 | CN160 DC /6000 TO TEST DIGIT GT 9 U6I19320 0611 0800 1975 | CN1E1 DC /0800 TO TEST FOR /E1 U6I19330 0612 0005 1976 | CN105 DC 5 CONSTANT 5 U6I19340 1978 | *************************************************** U6I19360 1979 | * P R I N T R O U T I N E * U6I19370 1980 | *************************************************** U6I19380 0613 C480 0006 1982 | PR001 LD I $CH12 GET APPROP OFLO INDIC U6I19400 0615 4C18 0622R 1983 | BSC L PR010,+- BR IF *NO* OVERFLOW U6I19410 1985 | * CARRIAGE OVERFLOW--DO HEADING AFTER SKIP TO 1 U6I19430 0617 C818 1987 | LDD PR101 SKIP-TO-1 ARGLIST U6I19450 0618 4400 06A1R 1988 | BSI L PR000+1 INVOKE DEVICE SUBROUTINE U6I19460 061A 4400 06A1R 1989 | BSI L PR000+1 INVOKE DEVICE SUB -- HEAD U6I19470 061C C016 1990 | LD PR102 SPACE IMMED OPERATION ARG U6I19480 061D 4400 06A1R 1991 | BSI L PR000+1 LEAVE TWO BLANK LINES U6I19490 061F C013 1992 | LD PR102 *AFTER U6I19500 0620 4400 06A1R 1993 | BSI L PR000+1 *HEADING U6I19510 1995 | * NORMAL PRINT ACTION U6I19530 0622 C480 0036R 1997 | PR010 LD I PRINT GET LOCN ARG U6I19550 0624 1890 1998 | SRT 16 U6I19560 0625 C00C 1999 | LD PR100 MAKE ACC=PRINT OPERATION U6I19570 0626 4400 06A1R 2000 | BSI L PR000+1 INVOKE DEVICE ROUTINE U6I19580 0628 7400 0036 2001 | MDX L $PBSY,0 U6I19590 062A 70FD 2002 | MDX *-3 WAIT UNTIL PRINT COMPLETE U6I19600 062B 7401 0036R 2003 | MDX L PRINT,+1 PREPARE RETURN U6I19610 062D 4C80 0036R 2004 | BSC I PRINT RETURN TO CALLER U6I19620 2006 | * ARGUMENT LISTS U6I19640 0630 2008 | BSS E 0 U6I19660 0630 7000 2009 | PR101 DC /7000 SKIP TO 1 ARGLIST U6I19670 0631 0969R 2010 | DC HEADR-1 ADDR OF HEADER LINE - 1 U6I19680 0632 7001 2011 | PR100 DC /7001 PRINT AND SPACE 1 OP U6I19690 0633 7002 2012 | PR102 DC /7002 SPACE 1 OP U6I19700 2014 | *************************************************** U6I19720 2015 | * P R I N T E R S P A C E R O U T I N E * U6I19730 2016 | *************************************************** U6I19740 0634 C0FE 2018 | SP001 LD PR102 SPACE 1 IMMED OPCODE U6I19760 0635 4400 06A1R 2019 | BSI L PR000+1 START AND DON'T WAIT U6I19770 0637 4C80 0039R 2020 | BSC I SPACE RETURN TO CALLER U6I19780 2022 | *************************************************** U6I19800 2023 | * PKPRT * PACK AND PRINT SERVICE ROUTINE * U6I19810 2024 | *************************************************** U6I19820 0639R 2026 | PP001 EQU * U6I19840 0639 61D8 2027 | LDX 1 -40 XR1=NEG LEN PRINT BUFFER U6I19850 063A 6600 0050R 2028 | LDX L2 CAREA XR2=ADDR(INPUT AREA) U6I19860 063C C200 2029 | NUP02 LD 2 0 GET INPUT WORD U6I19870 063D 1008 2030 | SLA 8 INTO BITS 0-7 U6I19880 063E EA01 2031 | OR 2 1 OR IN ODD WORD U6I19890 063F D500 00CAR 2032 | STO L1 PRBUF+40 STORE TO PRINT BUFFER U6I19900 0641 7202 2033 | MDX 2 +2 UPDATE INPUT POINTER U6I19910 0642 7101 2034 | MDX 1 +1 UPDATE PRINT POINTER U6I19920 0643 70F8 2035 | MDX NUP02 BR IF NOT FINISHED U6I19930 0644 43D5 2036 | BSI 3 PRINT-X3 INVOKE PRINT ROUTINE U6I19940 0645 00A1R 2037 | DC PRBUF-1 ARGUMENT--ADDR OF BUFFER U6I19950 0646 4C80 003CR 2038 | BSC I PKPRT RETURN TO CALLER U6I19960 2040 | *************************************************** U6I19980 2041 | * PACK4 * PACK 4 EBCDIC CHARS INTO ACC/EXT * U6I19990 2042 | *************************************************** U6I20000 0648 6A0D 2044 | P4001 STX 2 P4092+1 SAVE INDEX 2 U6I20020 0649 C480 0042R 2045 | LD I PACK4 ACC=ADDR(FIRST CHAR) U6I20030 064B D001 2046 | STO *+1 U6I20040 064C 6600 0000 2047 | LDX L2 *-* XR2=ADDR(FIRST CHAR) U6I20050 064E C202 2048 | LD 2 2 ACC=THIRD CHAR U6I20060 064F 1008 2049 | SLA 8 ACC=XX00 U6I20070 0650 EA03 2050 | OR 2 3 OR IN FOURTH CHAR U6I20080 0651 1890 2051 | SRT 16 EXT=XXYY--XX=3RD, YY=4TH U6I20090 0652 C200 2052 | LD 2 0 ACC=1ST CHAR U6I20100 0653 1008 2053 | SLA 8 ACC=AA00 U6I20110 0654 EA01 2054 | OR 2 1 OR IN 2ND CHAR U6I20120 0655 6600 0000 2055 | P4092 LDX L2 *-* RESTORE XR2 U6I20130 0657 7401 0042R 2056 | MDX L PACK4,+1 PREPARE RETURN ADDRESS U6I20140 0659 4C80 0042R 2057 | BSC I PACK4 RETURN TO CALLER U6I20150 2059 | *************************************************** U6I20170 2060 | * D I S K R E A D / W R I T E R O U T I N E S * U6I20180 2061 | *************************************************** U6I20190 065B 4007 2063 | DR001 BSI DRW01 GO TO COMMON ROUT WITH U6I20210 065C 0000 2064 | DC 0 ARG=0 U6I20220 065D 4C80 0030R 2065 | BSC I DREAD RETURN TO CALLER WHEN DONE U6I20230 065F 4003 2067 | DW001 BSI DRW01 GO TO COMMON ROUT WITH U6I20250 0660 0001 2068 | DC 1 ARG=1 U6I20260 0661 4C80 0033R 2069 | BSC I DWRIT RETURN TO CALLER WHEN DONE U6I20270 2071 | * COMMON DISK READ/WRITE CODING U6I20290 0663 0000 2073 | DRW01 DC *-* COMMON ENTRY POINT U6I20310 0664 6A14 2074 | STX 2 DRW02 STORE ADDR OF DCTL FLD U6I20320 0665 D814 2075 | STD DRW03 SAVE COUNT/SAD U6I20330 0666 CA00 2076 | LDD 2 0 GET CURRENT CONTENT OF DCT U6I20340 0667 D814 2077 | STD DRW04 SAVE FOR LATER RESTORE U6I20350 0668 C811 2078 | LDD DRW03 GET OUR COUNT/SAD U6I20360 0669 DA00 2079 | STD 2 0 PLACE INTO DCTL FLD U6I20370 066A C00E 2080 | LD DRW02 ACC=ADDR OF DCTL U6I20380 066B 1890 2081 | SRT 16 PUT INTO EXT U6I20390 066C C480 0663R 2082 | LD I DRW01 GET 0/1 ARGUMENT U6I20400 066E 4400 00F2 2083 | BSI L DZ000 INVOKE DISKZ U6I20410 0670 7400 00EE 2084 | MDX L $DBSY,0 WAIT FOR U6I20420 0672 70FD 2085 | MDX *-3 *COMPLETION U6I20430 0673 C808 2086 | LDD DRW04 GET OLD CONTENT OF DCTL U6I20440 0674 DA00 2087 | STD 2 0 RESTORE THAT CONTENT U6I20450 0675 7401 0663R 2088 | MDX L DRW01,+1 SET RETURN ADDRESS U6I20460 0677 4C80 0663R 2089 | BSC I DRW01 RETURN TO SPECIFIC ROUTINE U6I20470 2091 | * WORKSPACES U6I20490 0679 0000 2093 | DRW02 DC *-* HOLD ADDR OF DCTL U6I20510 067A 0000 0000 2094 | DRW03 DEC 0 HOLD NEW DCTL CONTENT U6I20520 067C 0000 0000 2095 | DRW04 DEC 0 HOLD OLD DCTL CONTENT U6I20530 2097 | *************************************************** U6I20550 2098 | * ERROR * PRINT ERROR AND ABORT SUBROUTINE * U6I20560 2099 | *************************************************** U6I20570 2101 | * INITIALIZATION U6I20590 067E C480 003FR 2103 | ER001 LD I ERROR ACC=ERROR CODE IN EBCDIC U6I20610 0680 6C00 0034 2104 | STX L $NDUP SET NO DUP SWITCH U6I20615 0682 D00D 2105 | STO ER100+4 STORE INTO MESSAGE U6I20620 2107 | * PRINT '**ERROR XX**' AFTER SINGLE SPACE U6I20640 0683 43D8 2109 | BSI 3 SPACE-X3 INVOKE SPACE ROUTINE U6I20660 0684 43D5 2110 | BSI 3 PRINT-X3 INVOKE PRINT ROUTINE U6I20670 0685 068BR 2111 | DC ER100-1 BUFFER ADDRESS U6I20680 2113 | * PRINT 'PROGRAM HAS NOT BEEN MODIFIED' AFTER SPACE U6I20700 0686 43D5 2115 | BSI 3 PRINT-X3 INVOKE PRINT ROUTINE U6I20720 0687 0692R 2116 | DC ER110-1 ADDR OF BUFFER U6I20730 2118 | * NOW EXIT TO THE MONITOR U6I20750 0688 6038 2120 | EXIT U6I20770 2122 | * ERROR MESSAGES U6I20790 068A 2124 | BSS E 1 ASSURE ODD BOUNDARY U6I20810 068B 0006 2125 | DC 6 LENGTH OF MESSAGE U6I20820 068C 5C5C C5D9 D9D6 D940 2126 | ER100 EBC .**ERROR **. U6I20830 4040 5C5C | 0692 000C 2128 | DC 12 LENGTH OF MESSAGE U6I20850 0693 D7D9 D6C7 D9C1 D440 2129 | ER110 EBC .PROGRAM WAS NOT MODIFIED. U6I20860 E6C1 E240 D5D6 E340 | D4D6 C4C9 C6C9 C5C4 | 2131 | *************************************************** U6I20880 2132 | * PR0000 * PRINCIPAL PRINTER ROUTINE * U6I20890 2133 | *************************************************** U6I20900 06A0 2135 | BSS E 0 ASSURE EVEN BOUNDARY U6I20920 06A0 2136 | PR000 BSS /140 AREA FOR PRIN PRINTER ROUT U6I20930 2138 | *************************************************** U6I20950 2139 | * CD000 * PRINCIPAL INPUT DEVICE ROUTINE * U6I20960 2140 | *************************************************** U6I20970 07E0 2142 | BSS E 0 ASSURE EVEN BOUNDARY U6I20990 07E0 2143 | CD000 BSS /110 SPACE FOR PRIN INPUT ROUTIN U6I21000 2145 | *************************************************** U6I21020 2146 | * CVHEB * CONVERT EXT HOLLERITH TO EBCDIC * U6I21030 2147 | *************************************************** U6I21040 08F0 0000 2149 | CVHEB DC *-* ENTRY POINT U6I21060 08F1 6600 0050R 2150 | LDX L2 CAREA XR2=ADDR(COL 1 IN BUFFER) U6I21070 08F3 6A02 2151 | STX 2 CH010+1 SET GET INSTRUCTION U6I21080 08F4 62B0 2152 | LDX 2 -80 XR2=NEG LEN IN WORDS U6I21090 2154 | * LOOP FOR EACH CHARACTER--EXTENDS TO MDX CH010 U6I21110 08F5 C400 0000 2156 | CH010 LD L *-* GET BLOCK CHARACTER U6I21130 08F7 7401 08F6R 2157 | MDX L CH010+1,+1 UPDATE BLOCK POINTER U6I21140 08F9 1804 2159 | SRA 4 ACC=0XXX -- AVOID PROPAGATION U6I21160 08FA 1889 2160 | SRT 9 ACC=12,11,0 EXT=1-9 U6I21170 08FB D003 2161 | STO CH020+1 STORE ZONE CONFIG AS 0-7 U6I21180 08FC 1002 2162 | SLA 2 MULTIPLY BY 4 U6I21190 08FD D045 2163 | STO CH110+1 STORE ZONE CONFIG AS 0-28 U6I21200 08FE 6500 0000 2164 | CH020 LDX L1 *-* X1=0--7, ACC TO ZONE CONFIG U6I21210 0900 C05C 2165 | LD CH960 ACC=BIT 2/3 VALUES, AND S/M U6I21220 0901 2000 2166 | LDS 0 ASSURE CARRY OFF, OFLO OFF U6I21230 0902 1100 2167 | SLA 1 SHIFT ACC TO ZONE CONFIG U6I21240 0903 2853 2168 | STS CH900 MULT ZONE GIVES '2', ELSE '0' U6I21250 0904 1007 2169 | SLA 7 ACC BITS 0,1 = EBC BITS 2,3 U6I21260 0905 180E 2170 | SRA 14 ACC BITS 14,15 = EBC BITS 2,3 U6I21270 0906 D051 2171 | STO CH910 SAVE EBC BITS 2,3 U6I21280 0907 1090 2173 | SLT 16 ACC=1,2,3,4,5,6,7,8,9,....... U6I21300 0908 6108 2174 | LDX 1 8 SET X1=8 FOR SHIFT COUNT U6I21310 0909 1140 2175 | SLCA 1 X1=(N=0,1=8,2=7,...,7=2,8=1) U6I21320 090A 694E 2176 | STX 1 CH920 SAVE AS BITS 4,5,6,7 FOR NOW U6I21330 090B 4802 2177 | BSC C SKIP ONLY IF NO PCHS 1--8 U6I21340 090C F04E 2178 | EOR CH940 IF ANY PCHS, CLEAR FIRST U6I21350 090D 1140 2179 | SLCA 1 X1=(IF 8-PCH=1, IF NO 8-PCH=0) U6I21360 090E 4802 2180 | BSC C SKIP IF NO PCHS OR NO 8-PCH U6I21370 090F 1001 2181 | SLA 1 GET RID OF 8-PCH. 9 IN BIT 0 U6I21380 0910 804A 2182 | A CH940 OFLO=(IF 9-PCH=ON, ELSE=OFF) U6I21390 0911 71FF 2184 | MDX 1 -1 SKIP IF VALID CHAR U6I21410 0912 7052 2185 | MDX CH200 GO SET CHARACTER = AMPERSAND U6I21420 0913 1010 2187 | SLA 16 ASSURE ACC=0 U6I21440 0914 9044 2188 | S CH920 NEGATIVE OF FIRST COUNT IN X1 U6I21450 0915 4C10 0940R 2189 | BSC L CH100,- IF ALREADY 0, NONE 1-8 U6I21460 0917 7100 2190 | MDX 1 0 SKIP IF DIGIT *NOT* LOW U6I21470 0918 702F 2191 | MDX CH120 BR IF DIGIT IS LOW U6I21480 0919 8042 2193 | A CH950 IF ZERO, PCHS 1,8 U6I21500 091A 4C20 091FR 2194 | BSC L CH030,Z BR IF PUNCHES 2,8 THRU 7,8 U6I21510 091C 7400 0957R 2195 | MDX L CH900,0 SKIP IF *NOT* MULTIPLE ZONES U6I21520 091E 7034 2196 | MDX CH140 BR IF *MULTIPLE* ZONES U6I21530 091FR 2198 | CH030 EQU * FOR 2,8 THRU 7,8 & 1,8 NO M/Z U6I21550 091F 8044 2199 | A CH990 ADJUST DIGIT FOR HIGH U6I21560 0920 D038 2200 | STO CH920 SET THE DIGIT U6I21570 0921 C035 2201 | LD CH900 0=SINGLE ZONE, 2=MULTIPLE U6I21580 0922 4801 2202 | BSC O SKIP IF *NO* 9-PUNCH U6I21590 0923 F036 2203 | EOR CH930 INVERT ACC IF *9-PUNCH* U6I21600 0924 4820 2204 | BSC Z SKIP IF MULTZ=9-PUNCH U6I21610 0925 7002 2205 | MDX CH050 BR IF MULTZ *NOT* = 9-PUNCH U6I21620 0926 7401 0957R 2206 | CH040 MDX L CH900,+1 SET BIT 1 *ON* U6I21630 0928 C02E 2207 | CH050 LD CH900 U6I21640 0929 1002 2208 | SLA 2 ACC BITS 12,13=EBC BITS 0,1 U6I21650 092A E82D 2209 | OR CH910 ACC BITS 12-15=EBC BITS 0-3 U6I21660 092B 1004 2210 | CH060 SLA 4 ACC BITS 8-11=EBC ZONE U6I21670 092C E82C 2211 | OR CH920 OR IN EBC DIGIT U6I21680 092D D02B 2212 | STO CH920 SAVE THE WHOLE EBC CHAR U6I21690 092E 61FC 2213 | LDX 1 -4 SET FOR HANDLING EXCEPTIONS U6I21700 092F 1008 2215 | CH070 SLA 8 ACC BITS 0-7 = EBC CHAR U6I21720 0930 F500 0962R 2216 | EOR L1 CH970+4 EXCL OR BOTH CHARS U6I21730 0932 1888 2217 | SRT 8 ACC=0 IF FIRST CHAR MATCH U6I21740 0933 4C20 0937R 2218 | BSC L CH080,Z BR IF NOT A MATCH U6I21750 0935 1088 2219 | SLT 8 *MATCH* -- GET REPLACEMENT U6I21760 0936 7003 2220 | MDX CH090 AND GO STORE THE CHARACTER U6I21770 0937 C021 2221 | CH080 LD CH920 RELOAD WHOLE SAVED CHARACTER U6I21780 0938 7101 2222 | MDX 1 +1 SET TO LOOK MORE U6I21790 0939 70F5 2223 | MDX CH070 IF NOT ALL, LOOK AGAIN U6I21800 093A D600 00A0R 2225 | CH090 STO L2 CAREA+80 STORE THE CHARACTER U6I21820 093C 7201 2226 | MDX 2 +1 SET FOR NEXT CHARACTER U6I21830 093D 70B7 2227 | MDX CH010 IF NOT ALL, GO CONV NEXT CHAR U6I21840 093E 4C80 08F0R 2229 | BSC I CVHEB AND RETURN TO CALLER U6I21860 0940 4801 2231 | CH100 BSC O SKIP IF *NO* 9-PUNCH U6I21880 0941 7006 2232 | MDX CH120 9-PCH. NOTE 9-PCH-INDIC SET OFF U6I21890 0942 6500 0000 2233 | CH110 LDX L1 *-* *NO* 9-PCH. SET SPCL CASE U6I21900 0944 C81D 2234 | LDD CH980 SPCL CASE ZONES. WILL SHIFT. U6I21910 0945 1180 2235 | SLT 1 SHIFT ACC TO HOL ZONE CONFIG U6I21920 0946 180C 2236 | SRA 12 SET ZONE IN ACC BITS 12-15 U6I21930 0947 70E3 2237 | MDX CH060 AND PROCEED TO INSERT DIG 0 U6I21940 0948 801B 2239 | CH120 A CH990 U6I21960 0949 D00F 2240 | STO CH920 U6I21970 094A C00C 2241 | LD CH900 0=SINGLE ZONE, 2=MULTIPLE U6I21980 094B 4801 2242 | BSC O SKIP IF *NO* 9-PUNCH U6I21990 094C F00D 2243 | EOR CH930 INVERT IF*9-PUNCH* U6I22000 094D 4820 2244 | BSC Z SKIP IF MULTZ = 9-PUNCH U6I22010 094E 70D9 2245 | MDX CH050 BR IF MULTZ *NOT* = 9-PUNCH U6I22020 094F C007 2246 | CH130 LD CH900 0=SINGLE, 2=MULTIPLE U6I22030 0950 F009 2247 | EOR CH930 INVERT FOR REAL IF MZ=9 U6I22040 0951 D005 2248 | STO CH900 AND STORE INVERTED BIT 0 U6I22050 0952 70D3 2249 | MDX CH040 GO TURN BIT 1 ON U6I22060 0953 D005 2251 | CH140 STO CH920 SET DIGIT = 0 U6I22080 0954 4801 2252 | BSC O SKIP IF *NO* 9-PUNCH U6I22090 0955 D001 2253 | STO CH900 IF *9-PUNCH*, SET BIT 0 OFF U6I22100 0956 70D1 2254 | MDX CH050 THEN CONTINUE NORMALLY U6I22110 2256 | * CONSTANTS AND WORKSPACE U6I22130 0957 0000 2258 | CH900 DC *-* FOR EBC BITS 0,1 U6I22150 0958 0000 2259 | CH910 DC *-* FOR EBC BITS 2,3 U6I22160 0959 0000 2260 | CH920 DC *-* FOR EBC DIGIT (AND CHAR SAVE) U6I22170 095A 0002 2261 | CH930 DC /0002 EXCL OR CONSTANT U6I22180 095B 8000 2262 | CH940 DC /8000 FOR AFFECTING ACC BIT 0 U6I22190 095C 0008 2263 | CH950 DC 8 INCREMENT--CONSTANT 8 U6I22200 095D 2FA3 2264 | CH960 DC /2FA3 BIT23 & SINGLE/MULT STAT U6I22210 095E 61E1 2265 | CH970 DC /61E1 LIST U6I22220 095F E161 2266 | DC /E161 * OF U6I22230 0960 6AE0 2267 | DC /6AE0 * EXCEPTION U6I22240 0961 E06A 2268 | DC /E06A * CHARACTERS U6I22250 0962 2269 | BSS E 0 ASSURE EVEN BOUNDARY U6I22260 0962 4F6D 2270 | CH980 DC /4F6D FOR HOL N,0,11,11-0 U6I22270 0963 5CE7 2271 | DC /5CE7 FOR HOL 12,12-0,12-11,12-11-0 U6I22280 0964 0009 2272 | CH990 DC 9 CONSTANT 9--INCREMENT U6I22290 2274 | * VALIDITY ERROR--MAKE CHARACTER AMPERSAND U6I22310 0965 C001 2276 | CH200 LD CH999 LOAD AMPERSAND U6I22330 0966 70D3 2277 | MDX CH090 GO PUT THE CHARACTER U6I22340 0967 0050 2279 | CH999 DC /0050 AMPERSAND U6I22360 2281 | *************************************************** U6I22380 2282 | * HEADR * PRINT HEADER AREA * U6I22390 2283 | *************************************************** U6I22400 0968 2285 | BSS E 1 ASSURE ODD BOUNDARY U6I22420 0969 001C 2286 | DC HEDRX-* WORDCOUNT FOR HEADING U6I22430 096A 2287 | HEADR BSS 10 FOR 'PAGEXXXX JOB-NAME' U6I22440 0974 4040 D4D6 C4C9 C6E8 2288 | EBC . MODIFY DSF-PROGRAM(S) IN USER AR. U6I22450 40C4 E2C6 60D7 D9D6 | C7D9 C1D4 4DE2 5D40 | C9D5 40E4 E2C5 D940 | C1D9 | 0985 C5C1 2289 | EBC .EA. U6I22460 0986R 2290 | HEDRX EQU * U6I22470 2292 | *************************************************** U6I22490 2293 | * DAREA * DISK BUFFER AREA * U6I22500 2294 | *************************************************** U6I22510 0986 2296 | BSS E 0 ASSURE EVEN BOUNDARY U6I22530 0986 2297 | BSS 2 DISK CONTROL FIELD U6I22540 0988 2298 | DAREA BSS 640 RESERVE TWO SECTOR BUFFER U6I22550 0C08 2299 | STRNG BSS 106 FOR SPECIFICATION STRING U6I22560 0C72 2300 | END BEGIN U6I22570 There were no errors in this assembly Program transfer address = 0091 === CROSS REFERENCES ========================================================== Name Val Defd Referenced #CIDN 0037 105 410 #DBCT 0006 100 #ENTY 0010 103 1064 #FMAT 0046 106 1066 #JBSW 0009 102 405 #NAME 0004 99 1060 1062 #PIOD 0019 104 407 #SYSC 0008 101 403 #ULET 0050 107 412 #WSCT 0055 108 1068 $CH12 0006 124 1982 $CIBA 0005 123 $CORE 000E 127 $CTSW 000F 128 1714 $DBSY 00EE 142 299 1848 2084 $DUMP 003F 135 1075 $DZ1N 0076 137 $FLSH 0071 136 $FPAD 0095 141 1051 1079 $IBSY 0013 129 1708 $IOCT 0032 131 $IREQ 002C 130 $KCSW 007C 139 420 1700 $LAST 0033 132 1702 $LEV0 0008 125 473 $LEV1 0009 126 456 $LEV4 000C 395 478 $NDUP 0034 133 499 2104 $PBSY 0036 134 486 2001 $WRD1 007B 138 392 $WSDR 007A 140 1048 1147 'DCOM 0001 117 532 'HDNG 0007 119 534 'PIWK 009A 113 168 'PPTR 0099 112 163 'SLET 0003 118 ADLET 0022R 190 764 769 BEGIN 0091R 391 2300 BLLST 0143R 634 618 BYMSG 011CR 586 578 BYMSX 0127R 587 585 CAREA 0050R 248 250 507 515 555 562 635 636 637 638 639 640 641 642 643 644 645 646 647 648 662 664 684 693 706 728 732 803 843 856 877 888 921 930 959 964 978 980 992 1016 1032 1726 2028 2150 2225 CD000 07E0R 2143 461 1707 CH010 08F5R 2156 2151 2157 2227 CH020 08FER 2164 2161 CH030 091FR 2198 2194 CH040 0926R 2206 2249 CH050 0928R 2207 2205 2245 2254 CH060 092BR 2210 2237 CH070 092FR 2215 2223 CH080 0937R 2221 2218 CH090 093AR 2225 2220 2277 CH100 0940R 2231 2189 CH110 0942R 2233 2163 CH120 0948R 2239 2191 2232 CH130 094FR 2246 CH140 0953R 2251 2196 CH200 0965R 2276 2185 CH900 0957R 2258 2168 2195 2201 2206 2207 2241 2246 2248 2253 CH910 0958R 2259 2171 2209 CH920 0959R 2260 2176 2188 2200 2211 2212 2221 2240 2251 CH930 095AR 2261 2203 2243 2247 CH940 095BR 2262 2178 2182 CH950 095CR 2263 2193 CH960 095DR 2264 2165 CH970 095ER 2265 2216 CH980 0962R 2270 2234 CH990 0964R 2272 2199 2239 CH999 0967R 2279 2276 CI001 0504R 1591 238 CI003 050CR 1600 1594 1626 CI010 051DR 1619 1602 CI020 0521R 1623 1617 CI092 0526R 1631 1591 1609 CI095 0514R 1608 1616 1621 CI100 052AR 1636 1601 CI101 052BR 1637 1593 CI110 052DR 1639 1613 1620 CI115 052ER 1640 1615 CI12F 052CR 1638 1603 CI200 052FR 1641 1614 1619 1623 CID 0015R 183 743 752 CID00 01A1R 761 753 CID01 0196R 751 756 CIDN5 000BR 178 411 741 751 CIDOK 0192R 743 739 CN001 05B9R 1880 CN002 05CCR 1898 1937 CN003 05CFR 1901 1885 CN050 05E3R 1923 1905 CN055 05FAR 1948 1924 CN060 05E6R 1925 1951 CN070 05E9R 1927 1960 CN080 05ECR 1932 1919 CN091 05F4R 1942 1880 1965 CN092 05F6R 1943 1881 CN095 0606R 1964 1891 1893 1903 1918 1926 1928 1938 1949 1957 CN099 05F8R 1944 1890 1964 CN101 0609R 1968 1884 CN105 0612R 1976 1892 CN110 060CR 1970 1904 1932 CN15B 060DR 1971 1913 CN160 0610R 1974 1927 CN17B 060ER 1972 1915 CN17C 060FR 1973 1917 CN1E1 0611R 1975 1948 1950 CN205 060AR 1969 1899 1911 1935 COMRG 0000R 159 394 CON2 025FR 979 914 CON4 025DR 977 900 910 CONVL 025ER 978 936 COUNT 001ER 186 700 956 CVEBN 05B8R 1853 682 1882 CVHEB 08F0R 2149 1713 2229 CVXB4 0048R 237 663 692 731 812 822 855 940 1002 1592 1596 1608 1632 DAREA 0988R 2298 400 403 405 407 410 412 431 771 1054 1057 1059 1060 1061 1062 1063 1064 1066 1067 1068 1069 1112 1176 1221 1373 1392 1441 1469 1490 DBADR 0025R 193 1113 DBCNT 0024R 192 794 1154 1202 1484 1536 DC300 00C4R 456 DCID 02C6R 1082 1056 1070 DCLST 00FER 531 401 DCLUP 00A3R 410 415 DENDA 046BR 1441 1406 1493 DISPF 02C5R 1079 1148 DOIT 0285R 1023 962 DOPRO 0127R 593 559 DR001 065BR 2063 214 DRCOD 0021R 189 750 754 761 1115 DREAD 0030R 213 402 438 451 463 1055 1058 1127 1166 1194 1284 1399 1458 1492 2065 DRW01 0663R 2073 2063 2067 2082 2088 2089 DRW02 0679R 2093 2074 2080 DRW03 067AR 2094 2075 2078 DRW04 067CR 2095 2077 2086 DW001 065FR 2067 217 DWRIT 0033R 216 1071 1178 1205 1262 1396 1455 1471 2069 DZ000 00F2 143 298 1847 2083 DZCON 002CR 201 1117 1126 1133 1146 1165 1167 1189 1193 1204 1261 1279 1280 1283 1390 1395 1397 1398 1454 1456 1457 1470 1489 1491 1525 DZHLD 0376R 1220 1118 1132 1145 1152 1188 1526 ER001 067ER 2103 229 ER100 068CR 2126 2105 2111 ER110 0693R 2129 2116 ERR10 0168R 686 ERR11 016ER 696 699 702 ERR12 018CR 735 738 ERR15 01B4R 781 777 ERR16 01B6R 784 778 ERR17 01B8R 787 779 ERR19 01CER 816 819 ERR22 01E6R 847 961 ERR23 01ECR 859 862 ERR24 01FFR 881 932 994 ERR26 023CR 944 1005 ERR29 0225R 919 923 ERR32 0242R 951 1011 ERROR 003FR 228 493 501 520 568 602 629 669 676 686 696 717 735 758 781 784 787 792 816 826 847 859 881 894 919 944 951 1038 1184 1240 1252 1310 1331 1385 1387 1438 1704 1720 2103 EXPSW 001FR 187 597 1027 1140 1237 1308 FINSH 0116R 575 GR001 0545R 1699 235 GR005 055BR 1714 1711 GR009 0560R 1720 1715 GR100 0562R 1725 1706 1712 GTREC 0045R 234 513 842 958 1716 HD091 0105R 538 HD0C4 0104R 537 477 HDLST 0100R 533 437 HDXXX 0102R 535 483 HEADR 096AR 2287 436 536 2010 HEDRX 0986R 2290 2286 I1134 0000 149 469 I1403 0004 153 454 I1442 0002 151 467 I2501 0003 152 468 IBT4 01F9 148 454 467 468 469 470 IKBCP 0001 150 470 INSTV 0030R 211 ISDSF 01BAR 790 776 JBSW 0008R 175 406 491 K320 02C6R 1083 1053 KEND 002AR 200 563 1033 KPRO 0028R 199 516 556 LAC 03BCR 1292 1326 1347 1356 1362 LETSR 0564R 1728 770 1770 1771 1831 LIBSW 002ER 204 908 913 916 LS001 0565R 1761 LS010 057CR 1784 1809 LS015 058DR 1803 LS020 057ER 1786 1799 LS077 0598R 1819 1793 LS090 05A1R 1828 1822 LS091 05A2R 1829 1762 1815 LS092 05A4R 1830 1763 LS099 05A6R 1831 LS104 05ACR 1839 1767 1805 LS200 05AAR 1837 1772 1773 1803 1846 LS202 0596R 1814 1821 LS320 05ADR 1840 1774 LS500 05A8R 1836 1761 1789 LS658 05AER 1841 1779 1794 1796 1823 LS900 05AFR 1845 1776 1784 1850 MODE 0020R 188 710 721 868 1128 1130 1191 MODEP 0261R 984 869 MODOK 0185R 722 711 MSGD 02E6R 1098 1043 MSGDX 02F4R 1099 1097 MSGQ 02CAR 1088 1026 MSGQX 02D5R 1089 1087 MSGW 02D8R 1093 1030 MSGWX 02E3R 1094 1092 NOCID 0191R 741 729 NOTL1 022ER 926 915 NOTL2 021ER 914 907 909 NUP02 063CR 2029 2035 NUP20 00CBR 467 NUPRO 0106R 544 526 1028 ORGIN 01FE 147 148 P2BLK 0281R 1015 1013 P4001 0648R 2044 232 P4092 0655R 2055 2044 PACK4 0042R 231 514 554 561 1031 2045 2056 2057 PADDR 002FR 205 864 875 926 989 991 PATCH 01E0R 842 957 PATCX 0246R 955 965 1014 1017 PH040 0257R 971 878 931 993 PHAST 0256R 970 844 960 PHBLK 0252R 963 954 PHVL2 0260R 980 998 PIODV 000AR 177 408 423 1710 PKPRT 003CR 225 550 850 1041 2038 PNAMC 001CR 185 688 768 PNAME 0016R 184 PP001 0639R 2026 226 PR000 06A0R 2136 449 484 485 1988 1989 1991 1993 2000 2019 PR001 0613R 1982 220 PR010 0622R 1997 1983 PR100 0632R 2011 1999 PR101 0630R 2009 1987 PR102 0633R 2012 1990 1992 2018 PRBUF 00A2R 250 509 2032 2037 PRINT 0036R 219 577 1025 1029 1042 1997 2003 2004 2036 2110 2115 PRO01 0136R 618 624 PRO02 0156R 660 625 PRO07 0141R 629 622 PRO10 0165R 683 PRO80 0155R 656 608 PRO81 012ER 609 611 PROBL 0152R 653 621 PROF0 0151R 652 661 PROKD 0154R 655 714 PROKP 0153R 654 707 713 RCFND 020DR 897 890 RCLUP 0203R 888 892 RELOA 0258R 972 889 922 RSTX2 0210R 901 886 SKIP1 03B7R 1287 1278 SKIP2 03B8R 1288 1286 SLETX 0000R 163 424 430 450 462 SP001 0634R 2018 223 SPACE 0039R 222 549 576 1040 2020 2109 STPTR 0026R 194 834 863 955 STRNG 0C08R 2299 609 613 820 829 876 902 911 947 990 1006 1008 1125 TB001 0530R 1666 241 TB010 0536R 1673 1668 1677 TB050 0541R 1686 1675 TB091 053DR 1681 1666 1687 TB140 0544R 1691 1674 TEMP1 025CR 976 898 899 TSTBL 004BR 240 727 802 963 1015 1667 1669 1682 1686 ULET5 0010R 179 413 763 V2ARG 0271R 1003 999 1000 1001 VALU2 0262R 988 1018 VALUP 01F7R 874 966 VER00 01C1R 801 833 VER01 01C2R 803 808 VER10 01CCR 813 806 807 809 VER20 01D5R 823 810 811 VER99 01DER 834 804 VLARG 023AR 941 937 938 939 VMOD 0009R 176 404 674 VPSW 0371R 1214 1137 1139 1208 1245 1255 1306 1313 VRMOD 02F4R 1105 1024 1192 1209 X0003 0418R 1369 1319 1353 1378 1461 1548 X000F 046DR 1443 1382 X3 0061R 394 402 404 406 408 423 438 450 451 462 463 491 493 501 513 514 516 520 549 550 554 556 561 563 568 576 577 597 602 629 663 669 674 676 686 688 692 696 700 710 717 721 727 731 735 741 743 750 752 758 761 764 768 781 784 787 792 794 802 812 816 822 826 842 847 850 855 859 864 868 875 881 894 908 913 919 940 944 951 958 963 989 1002 1015 1025 1027 1029 1031 1033 1038 1040 1041 1042 1055 1058 1071 1115 1117 1126 1127 1128 1130 1133 1146 1165 1166 1178 1184 1189 1191 1193 1194 1202 1204 1205 1240 1252 1261 1262 1279 1280 1283 1284 1310 1331 1385 1387 1390 1395 1396 1398 1399 1438 1454 1455 1457 1458 1470 1471 1491 1492 1525 1536 1704 1720 2036 2109 2110 2115 X6000 03BER 1294 1182 X7 03A7R 1266 1200 1229 XFFFC 046ER 1444 1464 XS001 0050R 281 XS020 005AR 290 287 296 333 XS030 005ER 296 339 XS050 0067R 306 331 XS060 006AR 308 285 XS070 006CR 312 327 XS081 0079R 329 323 XS082 0075R 325 315 XS091 0085R 343 281 XS092 0087R 344 282 XS099 0089R 345 289 XS101 008ER 352 335 XS110 008FR 353 307 326 XS111 0090R 354 302 330 XS320 008CR 350 291 XSLET 004FR 252 283 306 428 YD1 046CR 1442 1404 1498 1503 1506 1517 1535 YD16 04E3R 1539 1482 YD18 04E4R 1540 YD2 046FR 1445 1335 1354 1379 1549 YD20 04E5R 1541 1534 YD3 0470R 1446 1422 YD320 04E6R 1542 1528 YD4 04E7R 1543 1501 YDLUP 03BDR 1293 1337 1340 1359 YF00 03D5R 1310 1305 1330 YF005 03D7R 1313 1303 YF01 03DDR 1317 1307 1314 YF02 03E3R 1325 1336 1361 YF03 03EDR 1333 1328 YF04 03F4R 1338 1366 YF05 03FBR 1347 1365 YF06 0419R 1372 1349 YF07 042CR 1387 1416 1417 YF08 0448R 1414 1380 YF085 0452R 1420 1432 YF087 045AR 1428 1424 YF09 0461R 1433 1383 1384 1419 1429 YF092 0464R 1435 1415 YF095 0469R 1438 YF10 0472R 1449 1434 YF11 047FR 1459 1372 1421 1428 1431 1453 YF12 048BR 1469 1537 YF13 0491R 1476 1334 YF14 04ADR 1495 1488 YF15 04C4R 1513 1565 YF16 04C5R 1514 1563 YF17 04E9R 1545 1508 YFIND 03BFR 1296 1129 1309 1316 1437 1472 YG01 0444R 1408 1400 YG015 0438R 1397 1394 YGET 043DR 1402 1301 1318 1325 1333 1338 1374 1410 1420 1497 1505 1512 1515 1520 1557 1560 YGPT 0445R 1409 1299 1300 1317 1320 1321 1341 1358 1389 1391 1403 1405 1435 1450 1451 1477 1485 1486 1494 1496 1504 1511 1514 1518 1522 1530 1556 1559 YHOLD 0503R 1566 1550 1561 YM01 0304R 1125 1141 1190 YM02 0306R 1126 1136 YM025 0325R 1150 1149 YM03 0336R 1164 1144 1187 YM04 033ER 1169 1174 YM05 0344R 1175 1153 YM055 0353R 1186 1183 YM06 0359R 1191 1138 YM07 0368R 1204 YMCON 0372R 1215 1151 1177 1179 1180 1277 YMLP 036FR 1212 1156 1160 1186 YPLEN 0370R 1213 1195 1207 1519 YPRSW 04E8R 1544 1393 1476 1523 YPT 0471R 1447 1342 1452 1468 YRFBF 042ER 1389 1407 YRLOC 0416R 1368 1339 1350 1352 1375 1377 1425 1427 1430 1463 Z20 03A6R 1265 1233 1480 ZA020 038BR 1242 1236 ZA030 039AR 1254 1239 1244 ZA040 03A0R 1260 1258 ZA100 03A4R 1263 1246 1251 1256 ZADDR 0378R 1227 1131 1263 ZAGET 03A8R 1272 1247 1257 1289 ZBUF 0377R 1221 1143 1198 1230 1288 1298 1478 1487 1531 ZH01 0374R 1218 1121 1123 1124 1142 1162 1199 1228 1273 1297 ZH02 0375R 1219 1201 1203 ZHOLD 03BBR 1291 1282 1285
ibm/ibm1130-lib/dmsr2v12/u6modsf_lst.txt · Last modified: 2023/08/06 13:34 by Site Administrator