ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:10 2020 Source File: \u7rdrec.asm RDREC- READ *ID RECORD 2 | * JUNE 20,1967 U7C00020 3 | *************************************************** U7C00030 4 | * ENTRY POINT * U7C00040 5 | *************************************************** U7C00050 6 | ENT RDREC U7C00060 7 | *************************************************** U7C00070 8 | * * U7C00080 9 | * STATUS - VERSION 2 MOD LEVEL 9. * U7C00090 10 | * * U7C00100 11 | * FUNCTION/OPERATION- * U7C00110 12 | * READ THE *ID RECORD USED BY SEVERAL SUBRS. * U7C00120 13 | * * CALLS THE FSLEN SUBR TO FETCH * U7C00130 14 | * PRINCIPAL SYSTEM DEVICE PH. ENTRY FROM * U7C00140 15 | * SLET. * U7C00150 16 | * * CALLS FSYSU TO BRING IN REQUEST SYSTEM * U7C00160 17 | * DEVICE ROUTINE. * U7C00170 18 | * * CADDR OF USER,S TABLE FOR STORING THE * U7C00180 19 | * CONVERTED AND PACKED NUMBERS IS PLACED * U7C00190 20 | * IN THE ACCUMULATOR BEFORE CALLING RDREC * U7C00200 21 | * * USING THE REGUESTED SUBROUTINES THE *ID * U7C00210 22 | * RECORD IS READ,CONVERT AND STORED IN A * U7C00220 23 | * USER@S AREA * U7C00230 24 | * * THE USER'S TABLE CONTAINS A BINARY TABLE* U7C00240 25 | * A FROM-TO ENTRY COUNT AND A FROM-TO * U7C00250 26 | * TABLE IN PACKED EBCDIC FOR PRINTING. * U7C00260 27 | * * INVALID *ID RECORDS ARE CHECKED * U7C00270 28 | * * THE FROM-TO NUMBERS ARE CHECKED FOR * U7C00280 29 | * VALIDITY. * U7C00290 30 | * * PRINT *ID RECORD USING PRINCIPAL PRINT * U7C00300 31 | * SUBROUTINES. * U7C00310 32 | * * THE ADDRESS OF THE ENTRY POINT TO THE * U7C00320 33 | * PRINCIPAL PRINT SUBROUTINE IS PLACE IN * U7C00330 34 | * THE ACCUMULATOR FOR THE USER. * U7C00340 35 | * * U7C00350 36 | * * U7C00360 37 | * ENTRY POINTS- * U7C00370 38 | * *RDREC-USER ENTRY * U7C00380 39 | * * U7C00390 40 | * INPUT- * U7C00400 41 | * **ID RECORD * U7C00410 42 | * * U7C00420 43 | * OUTPUT- * U7C00430 44 | * * ERROR MESSAGE * U7C00440 45 | * * *ID RECORD PRINT-OUT * U7C00450 46 | * * SIGNOFF MESSAGE. * U7C00460 47 | * * U7C00470 48 | * EXTERNAL REFERENCES- * U7C00480 49 | * SUBROUTINES * U7C00490 50 | * * FSLEN * U7C00500 51 | * * FSYSU * U7C00510 52 | * COMMA/DCOM- * U7C00520 53 | * * DZ000 * U7C00530 54 | * * $PBSY * U7C00540 55 | * * $IBSY * U7C00550 56 | * * $LAST * U7C00560 57 | * * $DBSY * U7C00570 58 | * * $EXIT 2-9 U7C00575 59 | * EIXTS * U7C00580 60 | * NORMAL -RM440 * U7C00590 61 | * ERROR -BRANCH TO $EXIT 2-9 U7C00595 62 | * * U7C00600 63 | * TABLES/WORK AREAS- * U7C00610 64 | * * RR950- *IO RECORD AREA * U7C00620 65 | * RR900- * U7C00630 66 | * RR901- * U7C00640 67 | * * U7C00650 68 | * * U7C00660 69 | * ATTRIBUTES- * U7C00670 70 | * RELOCATABLE * U7C00680 71 | * * U7C00690 72 | *NOTES-N/A * U7C00700 73 | * * U7C00710 74 | * * U7C00720 75 | *************************************************** U7C00730 SYSTEMS EQUATES 00F2 77 | DZ000 EQU /0F2 DISK ENTRY POINT U7C00750 0013 78 | $IBSY EQU /13 PRINC I/O BUSY INDR,NON-ZERO=BSY U7C00760 0033 79 | $LAST EQU /33 LAST CD INDR,NON-ZERO=LAST CARD U7C00770 00EE 80 | $DBSY EQU /EE DISK BUSY INDR,NON-ZERO=DK BUSY U7C00780 0036 81 | $PBSY EQU /36 PRINC PTR BUSY INDR,NON-ZERO=BSY U7C00790 -RDREC- READ *ID RECORD 0000 0000 83 | RDREC DC *-* U7C00810 0001 6D00 0102R 84 | STX L1 RM430+1 SAVE XR1 U7C00820 0003 6E00 0104R 85 | STX L2 RM440+1 SAVE XR2 U7C00830 0005 D400 00A5R 86 | STO L RM280 STORE USER'S TABLE ADDR. U7C00840 0007 D400 006BR 87 | STO L RM075+1 U7C00850 0009 D400 0070R 88 | STO L RM085+1 U7C00860 000B D400 0075R 89 | STO L RM086+1 U7C00870 000D D400 00FFR 90 | STO L RM425+1 U7C00880 000F 6202 91 | LDX 2 RM160 U7C00890 92 | *************************************************** U7C00900 93 | * FETCH THE WORD COUNT AND SECTOR ADDRESS OF THE * U7C00910 94 | * PRINCIPAL INPUT DEVICE. * U7C00920 95 | *************************************************** U7C00930 0010 0689*3155 96 | RM010 CALL FSLEN FETCH WD CNT-SECTOR ADDRESS U7C00940 0012 009A 97 | DC 154 U7C00950 0013 4818 98 | BSC +- SKIP IF FOUND U7C00960 0014 70FB 99 | MDX RM010 TRY AGAIN U7C00970 100 | * U7C00980 101 | *************************************************** U7C00990 102 | * CALL IN THE PRINCIPAL INPUT DEVICE SUBROUTINE * U7C01000 103 | *************************************************** U7C01010 104 | * U7C01020 0015 068A*88A4 105 | RM020 CALL FSYSU U7C01030 0017 D400 00A4R 106 | STO L RM270 STORE SUBR ENTRY POINT U7C01040 0019 7400 0033 107 | MDX L $LAST,0 U7C01050 001B 7001 108 | MDX RM021 U7C01060 001C 7005 109 | MDX RM025 U7C01070 001D C076 110 | RM021 LD RM170 U7C01080 001E 1890 111 | SRT 16 U7C01090 001F C076 112 | LD RM185 FEED REQUEST FOR 1442 U7C01100 0020 4480 00A4R 113 | BSI I RM270 U7C01110 0022 C071 114 | RM025 LD RM170 FETCH WD CNT ADDRESS U7C01120 0023 1890 115 | SRT 16 U7C01130 0024 C070 116 | LD RM180 FETCH FUNCTION CODE U7C01140 0025 4480 00A4R 117 | BSI I RM270 GO TO GET *ID RCD U7C01150 0027 7400 0013 118 | MDX L $IBSY,0 U7C01160 0029 70FD 119 | MDX *-3 U7C01170 120 | * U7C01180 121 | *************************************************** U7C01190 122 | * FETCH WORD COUNT AND SLET ADDRESS OF CONV SUBR * U7C01200 123 | *************************************************** U7C01210 124 | * U7C01220 002A 0689*3155 125 | RM030 CALL FSLEN U7C01230 002C 009C 126 | DC 156 PHASE ID U7C01240 002D 4818 127 | BSC +- SKIP IF FOUND U7C01250 002E 70FB 128 | MDX RM030 TRY AGAIN U7C01260 129 | * U7C01270 130 | *************************************************** U7C01280 131 | * CALL PRINCIPAL CONVERSION SUBR * U7C01290 132 | *************************************************** U7C01300 133 | * U7C01310 002F 068A*88A4 134 | CALL FSYSU U7C01320 0031 D072 135 | STO RM270 SAVE ENTRY POINT U7C01330 0032 C061 136 | LD RM170 LOAD WD CNT ADDR U7C01340 0033 4480 00A4R 137 | BSI I RM270 TO CONVRT SUBR U7C01350 138 | *************************************************** U7C01360 139 | * TEST FOR VALID *ID RECORD * U7C01370 140 | *************************************************** U7C01380 141 | * U7C01390 0035 C074 142 | LD RM320 LD * OF ID RCD U7C01400 0036 9060 143 | S RM190 U7C01410 0037 4820 144 | BSC Z SKIP IF * U7C01420 0038 7057 145 | MDX RM120 ERROR U7C01430 0039 C071 146 | LD RM320+1 LD I U7C01440 003A 905D 147 | S RM200 U7C01450 003B 4820 148 | BSC Z SKIP IF I U7C01460 003C 7053 149 | MDX RM120 ERROR U7C01470 003D C06E 150 | LD RM320+2 LD 3RD CHAR IN RCD 2-9 U7C01472 003E 905F 151 | S RM260 CHECK FOR CHAR=D 2-9 U7C01474 003F 4820 152 | BSC Z SKIP IF D 2-9 U7C01476 0040 704F 153 | MDX RM120 BR TO PR ERROR AND EXIT 2-9 U7C01478 154 | * U7C01480 155 | *************************************************** U7C01490 156 | * CHECK FOR END OF FROM-TO FIELDS * U7C01500 157 | * PACK THE EBCDIC NO. AND STORE IN THE USER PRINT* U7C01510 158 | * TABLE. * U7C01520 159 | * CONVERT EBCDIC NO. TO BINARY AND STORE IN USER'A* U7C01530 160 | * BINARY FROM-TO TABLE. PLACE COUNT OF FROM-TO * U7C01540 161 | * FIELDS IN USER'S TABLE * U7C01550 162 | * * U7C01560 163 | *************************************************** U7C01570 164 | * U7C01580 0041 6100 165 | LDX 1 RM140 FETCH FROM FIELD ADDR U7C01590 0042 C500 00ADR 166 | RM040 LD L1 RM330 FETCH FROM NO. U7C01600 0044 F054 167 | EOR RM210 TEST IF BLANK U7C01610 0045 4818 168 | BSC +- NOT BLANK, SKIP U7C01620 0046 704B 169 | MDX RM130 END OF FROM-TO FIELDS U7C01630 170 | * U7C01640 0047 C05E 171 | LD RM290 FETCH COUNT U7C01650 0048 9051 172 | S RM220 SUB FOUR U7C01660 0049 4810 173 | BSC - U7C01670 004A 7047 174 | MDX RM130 END OF FROM-TO FIELDS U7C01680 004B 8400 018DR 175 | A L RM740 ADD FIVE U7C01690 004D D058 176 | STO RM290 U7C01700 177 | * U7C01710 178 | *************************************************** U7C01720 179 | * PACK AND STORE FROM-TO FIELDS * U7C01730 180 | *************************************************** U7C01740 181 | * U7C01750 004E 6A10 182 | STX 2 RM060+1 SAVE XR2 U7C01760 004F 6600 000C 183 | RM050 LDX L2 RM150 U7C01770 0051 4011 184 | BSI RM070 PACK AND STORE FROM FIELD U7C01780 0052 7201 185 | MDX 2 +1 U7C01790 0053 7102 186 | MDX 1 +2 U7C01800 0054 400E 187 | BSI RM070 U7C01810 0055 7204 188 | MDX 2 4 PACK AND STORE TO FIELD U7C01820 0056 7103 189 | MDX 1 3 U7C01830 0057 400B 190 | BSI RM070 U7C01840 0058 7201 191 | MDX 2 1 U7C01850 0059 7102 192 | MDX 1 2 U7C01860 005A 4008 193 | BSI RM070 U7C01870 005B 720A 194 | MDX 2 10 SET FOR NEXT FROM FIELD U7C01880 005C 6E00 0050R 195 | STX L2 RM050+1 SAVE FOR NEXT 'FROM' PROC. U7C01890 005E 6600 0000 196 | RM060 LDX L2 *-* SET XR2 FOR BINARY TABLE U7C01900 0060 71F9 197 | MDX 1 -7 RESET XR1 FOR BINARY CONVRT U7C01910 0061 7000 198 | MDX * DUMMY U7C01920 0062 700B 199 | MDX RM080 U7C01930 200 | * U7C01940 0063 0000 201 | RM070 DC *-* ENTRY FOR PACK AND STORE U7C01950 0064 C500 00AER 202 | LD L1 RM340 PACK U7C01960 0066 1888 203 | SRT 8 U7C01970 0067 C500 00ADR 204 | LD L1 RM330 U7C01980 0069 1088 205 | SLT 8 U7C01990 006A D600 0000 206 | RM075 STO L2 *-* STORE TO USER'S AREA U7C02000 006C 4C80 0063R 207 | BSC I RM070 RETURN U7C02010 208 | *************************************************** U7C02020 209 | * BINARY CONVERSION AND STORE * U7C02030 210 | *************************************************** U7C02040 211 | * U7C02050 006E 4008 212 | RM080 BSI RM090 TO CONVERT FROM FIELD U7C02060 006F D600 0000 213 | RM085 STO L2 *-* STORE FOR USER U7C02070 0071 7105 214 | MDX 1 +5 SETUP FOR TO FIELD U7C02080 0072 7201 215 | MDX 2 +1 U7C02090 0073 4003 216 | BSI RM090 CONVERT TO FIELD U7C02100 0074 D600 0000 217 | RM086 STO L2 *-* U7C02110 0076 7016 218 | MDX RM110 U7C02120 219 | * U7C02130 0077 0000 220 | RM090 DC *-* ENTRY/EXIT U7C02140 0078 C500 00ADR 221 | LD L1 RM330 FETCH NO. TO BE CONVERTED U7C02150 007A D00B 222 | STO RM100 U7C02160 007B C500 00AER 223 | LD L1 RM340 U7C02170 007D D009 224 | STO RM100+1 U7C02180 007E C500 00AFR 225 | LD L1 RM350 U7C02190 0080 D007 226 | STO RM100+2 U7C02200 0081 C500 00B0R 227 | LD L1 RM360 U7C02210 0083 D005 228 | STO RM100+3 U7C02220 229 | * U7C02230 230 | *************************************************** U7C02240 231 | * GO TO CONVERSION SUBROUTINE * U7C02250 232 | *************************************************** U7C02260 0084 4400 0137R 233 | BSI L RM500 U7C02270 0086 0000 234 | RM100 DC *-* NO. TO BE CONVRT. U7C02280 0087 0000 235 | DC *-* U7C02290 0088 0000 236 | DC *-* U7C02300 0089 0000 237 | DC *-* U7C02310 008A 7005 238 | MDX RM120 U7C02320 008B 4C80 0077R 239 | BSC I RM090 RETURN U7C02330 240 | *************************************************** U7C02340 241 | * SETUP FOR NEXT FROM-TO FIELDS * U7C02350 242 | *************************************************** U7C02360 243 | * U7C02370 008D 7105 244 | RM110 MDX 1 5 TO NEXT FROM FIELD U7C02380 008E 7201 245 | MDX 2 1 INCR BINARY TABLE CNT U7C02390 008F 70B2 246 | MDX RM040 GET NEXT NUMBER U7C02400 0090 4C00 012ER 247 | RM120 BSC L RM480 U7C02410 248 | * U7C02420 0092 7067 249 | RM130 MDX RM420 BR PR RCD AND BACK TO ML U7C02430 250 | * U7C02440 RDREC- EQUATES 252 | *************************************************** U7C02460 0000 253 | RM140 EQU 0 U7C02470 000C 254 | RM150 EQU 12 U7C02480 0002 255 | RM160 EQU 2 U7C02490 256 | * U7C02500 RDREC- CONSTANTS 258 | *************************************************** U7C02520 0094 259 | BSS E 0 U7C02530 0094 00A9R 260 | RM170 DC RM310 ADDRESS OF *ID WD CNT U7C02540 0095 7002 261 | RM180 DC /7002 FUNCTION CODE-INPUT RTN U7C02550 0096 7003 262 | RM185 DC /7003 U7C02560 0097 005C 263 | RM190 DC /005C * CODE U7C02570 0098 00C9 264 | RM200 DC /00C9 I U7C02580 0099 0040 265 | RM210 DC /0040 BLANK U7C02590 009A 0004 266 | RM220 DC 4 FOUR U7C02600 009B 0001 267 | RM230 DC 1 ONE U7C02610 009C 0028 268 | RM240 DC 40 U7C02620 009D 7001 269 | RM250 DC /7001 PRINT FUNCTION CODE U7C02630 009E 00C4 270 | RM260 DC /00C4 EBCDIC D 2-9 U7C02640 009F 00C5 271 | RM265 DC /00C5 E U7C02650 00A0 00D9 272 | DC /00D9 R U7C02660 00A1 00D9 273 | DC /00D9 R U7C02670 00A2 00D6 274 | DC /00D6 0 U7C02680 00A3 00D9 275 | DC /00D9 R U7C02690 RDREC -WORKING STORAGE 277 | *************************************************** U7C02710 278 | * U7C02720 00A4 279 | BSS E 0 U7C02730 00A4 0000 280 | RM270 DC *-* SYSTEM SUBR ENTRY POINT U7C02740 00A5 0000 281 | RM280 DC *-* USER'S TABLE ADDRESS U7C02750 00A6 0000 282 | RM290 DC *-* FIELD COUNT U7C02760 00A7 0000 283 | RM300 DC U7C02770 RDREC- I/O AREAS 285 | *************************************************** U7C02790 286 | * U7C02800 00A8 287 | BSS E 1 U7C02810 00A9 0050 288 | RM310 DC 80 WD CNT OF *ID RECORD U7C02820 00AA 289 | RM320 BSS 3 AREA U7C02830 00AD 0000 290 | RM330 DC *-* FROM FIELD 1 U7C02840 00AE 0000 291 | RM340 DC *-* U7C02850 00AF 0000 292 | RM350 DC *-* U7C02860 00B0 0000 293 | RM360 DC *-* U7C02870 00B1 0000 294 | RM370 DC *-* COMMA U7C02880 00B2 0000 295 | RM380 DC *-* TO FIELD 1 U7C02890 00B3 0000 296 | RM390 DC *-* U7C02900 00B4 0000 297 | RM400 DC *-* U7C02910 00B5 0000 298 | RM410 DC *-* U7C02920 00B6 0000 299 | DC *-* COMMA U7C02930 00B7 300 | BSS 35 FROM-TO FIELDS 2-4 U7C02940 00DA 301 | RM415 BSS 32 U7C02950 FROM-TO FIELD PROCESSING 303 | *************************************************** U7C02970 304 | * END OF FROM-TO FIELDS * U7C02980 305 | * STORE FROM-TO CNT IN USER TABLE * U7C02990 306 | * CHECK FOR MISSING FROM NO. IN FIRST FIELD * U7C03000 307 | * * U7C03010 308 | *************************************************** U7C03020 309 | * U7C03030 00FA C0AB 310 | RM420 LD RM290 TEST FIRST FROM FIELD U7C03040 00FB 4808 311 | BSC + U7C03050 00FC 7031 312 | MDX RM480 ERROR U7C03060 00FD 6201 313 | LDX 2 1 U7C03070 00FE D600 0000 314 | RM425 STO L2 *-* STORE CNT FOR USER U7C03080 0100 4007 315 | BSI RM450 PRINT *ID RECORD U7C03090 0101 6500 0000 316 | RM430 LDX L1 *-* RESET USER'A XR U7C03100 0103 6600 0000 317 | RM440 LDX L2 *-* U7C03110 0105 C09E 318 | LD RM270 ENTRY POINT U7C03120 0106 4C80 0000R 319 | BSC I RDREC RETURN U7C03130 320 | * U7C03140 321 | * U7C03150 RDREC PRINT AND CONVERSION SUBRS 323 | *************************************************** U7C03170 0108 0000 324 | RM450 DC *-* ENTRY FOR PRINT U7C03180 0109 6200 325 | LDX 2 0 U7C03190 326 | * U7C03240 010A 61B0 327 | RM452 LDX 1 -80 COLUMN CNT U7C03250 010B C500 00FBR 328 | RM460 LD L1 RM320+81 PACKED *ID RECD FOR PRINT U7C03260 010D 1888 329 | SRT 8 U7C03270 010E C500 00FAR 330 | LD L1 RM320+80 U7C03280 0110 1088 331 | SLT 8 U7C03290 0111 D600 00AAR 332 | STO L2 RM320 U7C03300 0113 7201 333 | MDX 2 1 U7C03310 0114 7102 334 | MDX 1 +2 SKIP WHEN RECD PACKED U7C03320 0115 70F5 335 | MDX RM460 GET NEXT CHAR U7C03330 336 | *************************************************** U7C03340 337 | * CALL FSLEN TO GET WD CNT AND SECT ASSR FOR PTR U7C03350 338 | *************************************************** U7C03360 0116 0689*3155 339 | RM470 CALL FSLEN U7C03370 0118 0099 340 | DC 153 U7C03380 0119 4818 341 | BSC +- SKIP IF FOUND U7C03390 011A 70FB 342 | MDX RM470 TRY AGAIN U7C03400 343 | * U7C03410 344 | *************************************************** U7C03420 345 | * CALL IN PRINCIPAL PRINT SUBROUTINE * U7C03430 346 | *************************************************** U7C03440 347 | * U7C03450 348 | * U7C03460 011B 068A*88A4 349 | CALL FSYSU CALL PRINT SUBROUTINE U7C03470 011D D086 350 | STO RM270 STORE ENTRY POINT U7C03480 011E C400 009CR 351 | LD L RM240 FETCH WD CNT U7C03490 0120 D088 352 | STO RM310 U7C03500 0121 C400 0094R 353 | LD L RM170 FETCH WD CNT ADDRESS U7C03510 0123 1890 354 | SRT 16 U7C03520 0124 C400 009DR 355 | LD L RM250 U7C03530 0126 4480 00A4R 356 | BSI I RM270 GO TO PRINT *ID RECORD U7C03540 0128 7400 0036 357 | MDX L $PBSY,0 U7C03550 012A 70FD 358 | MDX *-3 U7C03560 012B 4C80 0108R 359 | BSC I RM450 RETURN U7C03570 360 | * U7C03580 012D 006B 361 | RM267 DC /006B COMMA U7C03660 362 | * U7C03670 012E 61FB 363 | RM480 LDX 1 -5 U7C03680 012F C500 00A4R 364 | RM490 LD L1 RM265+5 SETUP ERROR U7C03690 0131 D500 00DAR 365 | STO L1 RM415 U7C03700 0133 7101 366 | MDX 1 +1 SKIP IF ZERO U7C03710 0134 70FA 367 | MDX RM490 U7C03720 0135 40D2 368 | BSI RM450 PRINT U7C03730 0136 6038 369 | EXIT EXIT TO TERMINATE OP 2-9 U7C03740 NUMBER CONVERSION SUBROUTINE 371 | *************************************************** U7C03760 372 | * * U7C03770 373 | * BSI L RM500 * U7C03780 374 | * DC A * U7C03790 375 | * DC B * U7C03800 376 | * DC C * U7C03810 377 | * DC D * U7C03820 378 | * MDX BR TO ERROR ROUTINE * U7C03830 379 | * WHERE A,B,C,D ARE THE 4 NUMBERS TO * U7C03840 380 | * BE CONVERTED. * U7C03850 381 | * THE CONVERTED BINARY NUMBER IS RETURNING IN* U7C03860 382 | * THE ACCUMULATOR. * U7C03870 383 | * * U7C03880 384 | * * U7C03890 385 | *************************************************** U7C03900 386 | * U7C03910 387 | * U7C03920 0137 0000 388 | RM500 DC *-* ENTRY U7C03930 0138 693E 389 | STX 1 RM590+1 U7C03940 0139 C0FD 390 | LD RM500 SET RETURN EXITS U7C03950 013A 8051 391 | A RM730 ERROR U7C03960 013B D047 392 | STO RM640 U7C03970 013C 804A 393 | A RM680 NORMAL U7C03980 013D D046 394 | STO RM650 U7C03990 013E 61FC 395 | LDX 1 -4 U7C04000 013F 680F 396 | STX 0 RM530+1 SETUP UNPACKED LOCATION U7C04010 0140 C00E 397 | RM510 LD RM530+1 U7C04020 0141 8043 398 | A RM660 U7C04030 0142 D00C 399 | STO RM530+1 U7C04040 0143 9049 400 | S RM740 SETUP UNPACKED ADDRESS U7C04050 0144 D02B 401 | STO RM570+1 *AND STORE U7C04060 0145 D026 402 | STO RM560+1 U7C04070 0146 D020 403 | STO RM550+1 U7C04080 0147 D00F 404 | STO RM540+1 U7C04090 0148 D014 405 | STO RM542+1 STO ADDR OF RM620 2-9 U7C04092 0149 D015 406 | STO RM545+1 2-9 U7C04094 014A C0EC 407 | LD RM500 SETUP SENDING FIELD ADDR U7C04100 014B D001 408 | STO *+1 U7C04110 014C C400 0000 409 | RM520 LD L *-* FETCH UNPACKED NO. U7C04120 014E D500 0000 410 | RM530 STO L1 *-* U7C04130 0150 C0FC 411 | LD RM520+1 INCR SENDING FIELD ADDR. U7C04140 0151 8035 412 | A RM680 U7C04150 0152 D0FA 413 | STO RM520+1 U7C04160 0153 7101 414 | MDX 1 1 SKIP WHEN 4 DIGITS STORED U7C04170 0154 70F7 415 | MDX RM520 GET NEXT DIGIT U7C04180 416 | * U7C04190 417 | *************************************************** U7C04200 418 | * THE FOLLOWING ROUTINE CONVERTS 4 UNPACKED EBCDIC* U7C04210 419 | * WORDS OF DATA TO ONE WORD OF BINARY DATA WITHIN * U7C04220 420 | * THE LIMITS OF /0000 TO /FFFF. * U7C04230 421 | *************************************************** U7C04240 0155 6104 422 | LDX 1 4 U7C04250 0156 C500 0000 423 | RM540 LD L1 *-* FETCH DIGIT U7C04260 0158 9035 424 | S RM750 CHECK IF EBCDIC BLANK 2-9 U7C04261 0159 4C20 015ER 425 | BSC L RM545,Z BR IF NOT BLANK 2-9 U7C04262 015B C02C 426 | LD RM690 FETCH EBCDIC ZERO 2-9 U7C04263 015C D500 0000 427 | RM542 STO L1 *-* REPLACE BL WITH ZERO 2-9 U7C04264 015E C500 0000 428 | RM545 LD L1 *-* FETCH CHAR AGAIN 2-9 U7C04265 0160 F027 429 | EOR RM690 GT THAN 9 U7C04270 0161 1884 430 | SRT 4 U7C04280 0162 4818 431 | BSC +- U7C04290 0163 700F 432 | MDX RM580 GET NEXT WORD U7C04300 433 | * U7C04310 434 | *************************************************** U7C04320 435 | * IF THE NUMBER IS GT /0009 IT IS CHECKED FOR A * U7C04330 436 | * VALID EBCDIC CHAR TO DENOTE THE HEX VALUES OF * U7C04340 437 | * A THRU F. * U7C04350 438 | *************************************************** U7C04360 0164 1084 439 | SLT 4 U7C04370 0165 C020 440 | LD RM670 FETCH /F MASK U7C04380 0166 9500 0000 441 | RM550 S L1 *-* U7C04390 0168 4828 442 | BSC Z+ U7C04400 0169 7010 443 | MDX RM600 HIGH VALUE EXCEEDED U7C04410 444 | * U7C04420 016A C01E 445 | LD RM700 U7C04430 016B 9500 0000 446 | RM560 S L1 *-* U7C04440 016D 4830 447 | BSC Z- U7C04450 016E 700B 448 | MDX RM600 VALUE LESS THAN /A U7C04460 449 | * U7C04470 016F C500 0000 450 | RM570 LD L1 *-* U7C04480 0171 8018 451 | A RM710 CONVERT HEX TO BINARY U7C04490 0172 18C4 452 | RTE 4 SAVE IN QREG U7C04500 0173 71FF 453 | RM580 MDX 1 -1 U7C04510 0174 70E1 454 | MDX RM540 NEXT NO. U7C04520 455 | * U7C04530 0175 18D0 456 | RTE 16 FETCH BINARY NO. U7C04540 0176 6500 0000 457 | RM590 LDX L1 *-* RESTORE XR1 U7C04550 0178 4C80 0184R 458 | BSC I RM650 U7C04560 459 | * U7C04570 017A 6500 0000 460 | RM600 LDX L1 *-* RESTORE XR1 U7C04580 CONVERSION CONSTANTS AND WORK AREA 017C 4C80 0183R 462 | RM610 BSC I RM640 RETURN TO ERROR EXIT U7C04600 017E 463 | RM620 BSS E 4 UNPACKED NO. U7C04610 0182 0000 464 | RM630 DC *-* PACKED NO. U7C04620 0183 0000 465 | RM640 DC *-* ERROR RETURN ADDRESS U7C04630 0184 0000 466 | RM650 DC *-* NORMAL RETURN U7C04640 0185 0042 467 | RM660 DC RM630-RM510 ADDRESS OF UNPACK NO. U7C04650 0186 00C6 468 | RM670 DC /00C6 HIGH LIMIT MASK U7C04660 0187 0001 469 | RM680 DC 1 ADDRESS MODIFIER U7C04670 0188 00F0 470 | RM690 DC /00F0 GT 9 MASK U7C04680 0189 00C1 471 | RM700 DC /00C1 LOW LIMIT MASK U7C04690 018A 0009 472 | RM710 DC /0009 USED FOR CONVERTING. U7C04700 018B 00F9 473 | RM720 DC /00F9 MASK FOR LAST WORD U7C04710 018C 0004 474 | RM730 DC 4 ADDRESS COMPUTING FACTOR U7C04720 018D 0005 475 | RM740 DC 5 U7C04730 018E 0040 476 | RM750 DC /0040 EBCDIC BLANK 2-9 U7C04745 018F 477 | END U7C04755 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced $DBSY 00EE 80 $IBSY 0013 78 118 $LAST 0033 79 107 $PBSY 0036 81 357 DZ000 00F2 77 RDREC 0000R 83 319 RM010 0010R 96 99 RM020 0015R 105 RM021 001DR 110 108 RM025 0022R 114 109 RM030 002AR 125 128 RM040 0042R 166 246 RM050 004FR 183 195 RM060 005ER 196 182 RM070 0063R 201 184 187 190 193 207 RM075 006AR 206 87 RM080 006ER 212 199 RM085 006FR 213 88 RM086 0074R 217 89 RM090 0077R 220 212 216 239 RM100 0086R 234 222 224 226 228 RM110 008DR 244 218 RM120 0090R 247 145 149 153 238 RM130 0092R 249 169 174 RM140 0000 253 165 RM150 000C 254 183 RM160 0002 255 91 RM170 0094R 260 110 114 136 353 RM180 0095R 261 116 RM185 0096R 262 112 RM190 0097R 263 143 RM200 0098R 264 147 RM210 0099R 265 167 RM220 009AR 266 172 RM230 009BR 267 RM240 009CR 268 351 RM250 009DR 269 355 RM260 009ER 270 151 RM265 009FR 271 364 RM267 012DR 361 RM270 00A4R 280 106 113 117 135 137 318 350 356 RM280 00A5R 281 86 RM290 00A6R 282 171 176 310 RM300 00A7R 283 RM310 00A9R 288 260 352 RM320 00AAR 289 142 146 150 328 330 332 RM330 00ADR 290 166 204 221 RM340 00AER 291 202 223 RM350 00AFR 292 225 RM360 00B0R 293 227 RM370 00B1R 294 RM380 00B2R 295 RM390 00B3R 296 RM400 00B4R 297 RM410 00B5R 298 RM415 00DAR 301 365 RM420 00FAR 310 249 RM425 00FER 314 90 RM430 0101R 316 84 RM440 0103R 317 85 RM450 0108R 324 315 359 368 RM452 010AR 327 RM460 010BR 328 335 RM470 0116R 339 342 RM480 012ER 363 247 312 RM490 012FR 364 367 RM500 0137R 388 233 390 407 RM510 0140R 397 467 RM520 014CR 409 411 413 415 RM530 014ER 410 396 397 399 RM540 0156R 423 404 454 RM542 015CR 427 405 RM545 015ER 428 406 425 RM550 0166R 441 403 RM560 016BR 446 402 RM570 016FR 450 401 RM580 0173R 453 432 RM590 0176R 457 389 RM600 017AR 460 443 448 RM610 017CR 462 RM620 017ER 463 RM630 0182R 464 467 RM640 0183R 465 392 462 RM650 0184R 466 394 458 RM660 0185R 467 398 RM670 0186R 468 440 RM680 0187R 469 393 412 RM690 0188R 470 426 429 RM700 0189R 471 445 RM710 018AR 472 451 RM720 018BR 473 RM730 018CR 474 391 RM740 018DR 475 175 400 RM750 018ER 476 424