ibm:ibm1130-lib:dmsr2v12:kforph09_lst
KFORPH09
| Table Of Contents |
|---|
|
- kforph09.lst
ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:06 2020 Source File: \kforph09.asm 1130 FORTRAN COMPILER PHASE 9 2 | *************************************************** K0900020 3 | * * K0900030 4 | *STATUS - VERSION 2 MODIFICATION 7 * K0900040 5 | * * K0900050 6 | *FUNCTION/OPERATION- * K0900060 7 | * * EXAMINES ONLY DATA STATEMENTS, BYPASSING ALL* K0900070 8 | * OTHER STATEMENTS. * K0900080 9 | * * CHECKS EACH VARIABLE FOR VALIDITY * K0900090 10 | * * CHECKS TO SEE THAT EACH VARIABLE NAME HAS * K0900100 11 | * BEEN ENTERED INTO THE SYMBOL TABLE. * K0900110 12 | * * CHECKS TO ENSURE THAT DIMENSIONING INDICATED* K0900120 13 | * IN THE DATA STATEMENT DOES NOT EXCEED THE * K0900130 14 | * DIMENSIONS INDICATED BY THE SYMBOL TBL ENTRY* K0900140 15 | * * CHECKS EACH DATA STMNT FOR CORRECT SYNTAX * K0900150 16 | * * REFORMATS THE DATA STMNT INTO A STRING OF * K0900160 17 | * DATA GROUPS. * K0900170 18 | * * K0900180 19 | *ENTRY POINTS- * K0900190 20 | * * BEGIN-PHASE 9 IS READ INTO CORE BY THE ROL * K0900200 21 | * PROGRAM AND EXECUTION BEGINS AT THIS ADDRESS* K0900210 22 | * * K0900220 23 | *INPUT- * K0900230 24 | * * THE STATEMENT STRING * K0900240 25 | * * THE SYMBOL TABLE * K0900250 26 | * * DCOM * K0900260 27 | * * K0900270 28 | *OUTPUT- * K0900280 29 | * * THE UPDATED STATEMENT STRING * K0900290 30 | * * THE UPDATED SYMBOL TABLE * K0900300 31 | * * DCOM * K0900310 32 | * * K0900320 33 | *EXTERNAL REFERENCES- * K0900330 34 | * SUBROUTINES- * K0900340 35 | * * ROL * K0900350 36 | * COMMA/DCOM- * K0900360 37 | * * $PHSE * K0900370 38 | * * K0900380 39 | *EXITS- * K0900390 40 | * NORMAL- * K0900400 41 | * * EXITS VIA A CALL TO THE ROL SUBROUTINE TO* K0900410 42 | * READ IN THE NEXT PHASE. * K0900420 43 | * * K0900430 44 | * ERROR- * K0900440 45 | * * OVERLAP-DOES NO PROCESSING AND EXITS * K0900450 46 | * NORMALLY * K0900460 47 | * * ERRORS DETECTED BY THIS PHASE ARE * K0900470 48 | * 75, 76, 77, 78, 79, 80, AND 82. * K0900480 49 | * * K0900490 50 | *TABLES/WORK AREAS-N/A * K0900500 51 | * * K0900510 52 | *ATTRIBUTES-NONE * K0900520 53 | * * K0900530 54 | *NOTES-N/A * K0900540 55 | * * K0900550 56 | *************************************************** K0900560 1130 FORTRAN COMPILER PHASE 9 58 | * K0900580 59 | ABS K0900590 60 | * K0900600 61 | * /8000 SYSTEM EQUATES K0900610 8000 62 | MEMRY EQU /8000 CORE SIZE K0900620 7A23 63 | OVERL EQU MEMRY-1501 PHASE OVERLAY AREA SIZE K0900630 7FBC 64 | ROL EQU MEMRY-68 K0900640 0078 65 | $PHSE EQU /78 K0900650 7A23 66 | ORG OVERL K0900660 0027 67 | PHID EQU 39 K0900670 68 | * K0900680 69 | * FORTRAN COMMUNICATION AREA K0900690 70 | * K0900700 7A23 71 | ORG BSS 1 ORIGIN ADDRESS 2-4 K0900705 7A24 72 | SOFS BSS 1 START OF STRING K0900710 7A25 73 | EOFS BSS 1 END OF STRING K0900720 7A26 74 | SOFST BSS 1 START OF SYMBOL TABLE K0900730 7A27 75 | SOFNS BSS 1 START OF NON-STATEMENT NUMBERS K0900740 7A28 76 | SOFXT BSS 1 START OF SUBSCRIPT TEMPORARIES K0900750 7A29 77 | SOFGT BSS 1 START OF GENERATED TEMPORARIES K0900760 7A2A 78 | EOFST BSS 1 END OF SYMBOL TABLE K0900770 7A2B 79 | COMON BSS 1 NEXT AVAILABLE COMMON K0900780 7A2C 80 | CSIZE BSS 1 SIZE OF COMMON K0900790 7A2D 81 | ERROR BSS 1 OVERLAP ERROR K0900800 7A2E 82 | FNAME BSS 1 PROGRAM NAME K0900810 7A2F 83 | BSS 1 * K0900820 7A30 84 | SORF BSS 1 SUBROUTINE(-) OR FUNCTION(+) K0900830 7A31 85 | CCWD BSS 1 CONTROL CARD WORD K0900840 86 | * BIT 15 TRANSFER TRACE K0900850 87 | * BIT 14 ARITHMETIC TRACE K0900860 88 | * BIT 13 EXTENDED PRECISION K0900870 89 | * BIT 12 LIST SYMBOL TABLE K0900880 90 | * BIT 11 LIST SUBPROGRAM NAMES K0900890 91 | * BIT 10 LIST SOURCE PROGRAM K0900900 92 | * BIT 9 ONE WORD INTEGERS K0900910 93 | * BIT 8 ORIGIN K0900920 7A32 94 | IOCS BSS 1 IOCS CONTROL CARD WORD K0900940 95 | * BIT 15 CARD K0900950 96 | * BIT 14 PAPER TAPE K0900960 97 | * BIT 13 TYPEWRITER K0900970 98 | * BIT 12 1443 PRINTER K0900980 99 | * BIT 11 MAGNETIC TAPE K0900990 100 | * BIT 10 KEYBOARD K0901000 101 | * BIT 8 DISK K0901010 102 | * BIT 3 PLOTTER K0901020 103 | * BIT 1 UNFORMATTED DISK K0901030 7A33 104 | DFCNT BSS 1 K0901040 105 | * K0901050 106 | * K0901060 107 | * K0901070 108 | * END OF FORTRAN COMMUNICATION K0901080 109 | * AREA K0901090 110 | * K0901100 7A36 111 | BPHAR EQU *+2 BEGINNING ADDR OF PHASE K0901110 7A34 0000 112 | DC 0 LOADER WORK AREA K0901120 7A35 FFD9 113 | DC -39 -PHASE ID FOR SLET LOOKUP K0901130 7A36 022E 114 | DC NXTPH-*+1 TABLE FOR NEXT PHASE ENTRY K0901140 7A37 0001 115 | DC 1 ONE ENTRY TO BE SET BY LDR K0901150 7A36 116 | ORG *-2 K0901160 117 | * K0901170 118 | * THIS PHASE PROCESSES THE DATA STATEMENT. INPUT IS K0901180 119 | * K0901190 120 | * ST-ID NAME1,...,NAMEN/CON1,...CONN/ K0901200 121 | * WHERE NAMES HAVE NOT YET BEEN LOOKED UP IN THE K0901210 122 | * SYMBOL LIST, REAL CONSTANTS ARE ALREADY CONVERTED K0901220 123 | * EXCEPT FOR SIGN, AND INTEGERS ARE NOT YET K0901230 124 | * CONVERTED. OUTPUT IS OF THE FORM K0901240 125 | * K0901250 126 | * ST-ID DATAGROUP HDR CON1 NAME1 DATAGROUP HDR K0901260 127 | * CON2 NAME2...DATAGROUP HDR CONN NAMEN K0901270 128 | * K0901280 129 | * WHERE THE DATAGROUP HDR IS OF THE FORM BIT0=0, K0901290 130 | * BIT 1-7=DUPLICATION FACTOR, BITS 8-15=CONSTANT K0901300 131 | * LENGTH. BIT 1 OF THE NAME PT=1 IF A DISPLACEMENT K0901310 132 | * WORD FOLLOWS, ELSE IT IS 0. ALL NAME PTS NOW K0901320 133 | * POINT TO THE SYMBOL LIST, AND ALL CONSTANTS ARE K0901330 134 | * CONVERTED. K0901340 135 | * K0901350 7A36 6127 136 | BEGIN LDX 1 PHID GET ID THIS PHASE K0901360 7A37 6D00 0078 137 | STX L1 $PHSE STORE IN SYSTEM PHASE AREA K0901370 7A39 C0F3 138 | LD ERROR OVERLAP ERROR SWITCH K0901380 7A3A 4C20 7C5E 139 | BSC L EXIT1,Z SKIP PHASE IF OVERLAP ERROR K0901390 7A3C C0E7 140 | LD SOFS START OF STRING ADDRESS K0901400 7A3D D400 7AC0 141 | STO L NEXT NEXT STMNT ID WORD ADDRESS K0901410 7A3F 6500 7E26 142 | LDX L1 WORK INDEX REG 1= WORK AREA ADDR K0901420 7A41 4068 143 | BSI FINDD FIND FIRST DATA STMNT K0901430 7A42 C06E 144 | LD START CURRENT STMNT ID WD ADDR K0901440 7A43 D400 7C43 145 | STO L ENDD PRESET FOR MOVE K0901450 7A45 C0EB 146 | LD CCWD CONTROL CARD WORD K0901460 7A46 E01E 147 | AND L4 EXTRACT BIT 13- PRECISION K0901470 7A47 1802 148 | SRA 2 RIGHT JUSTIFY K0901480 7A48 807D 149 | A TWO LENGTH=2 NORMAL, 3 EXTENDED K0901490 7A49 D400 7CD3 150 | STO L LNGTH REAL WORD LENGTH K0901500 7A4B D07C 151 | STO INTL SAVE AS INTEGER LENGTH K0901510 7A4C C0E4 152 | LD CCWD CONTROL CARD WORD K0901520 7A4D 1009 153 | SLA 9 ONE-WD INTEGER INDR TO SIGN K0901530 7A4E 180F 154 | SRA 15 RIGHT JUSTIFY INDICATOR K0901540 7A4F 4820 155 | BSC Z SKIP IF NO ONE-WD INTEGERS K0901550 7A50 D077 156 | STO INTL SET INTEGER LENGTH TO ONE K0901560 157 | * K0901570 158 | * FIND FIRST CONSTANT IN SUBSTATEMENT K0901580 159 | * K0901590 7A51 6E00 7C39 160 | FINDC STX L2 K SET K=J K0901600 7A53 6A0F 161 | STX 2 J SAVE J K0901610 7A54 162 | FNDC1 EQU * LABEL FNDC1 EQUALS LOOP1 K0901620 7A54 C480 7C39 163 | LOOP1 LD I K NEXT STMNT WORD K0901630 7A56 9072 164 | S SLASH SLASH CONSTANT K0901640 7A57 4C18 7A66 165 | BSC L LOOP2,+- BRANCH IF SLASH K0901650 7A59 7401 7C39 166 | MDX L K,1 INCREMENT K=K+1 K0901660 7A5B C064 167 | LD NEXT ADDR NEXT STMNT ID WORD K0901670 7A5C 9400 7C39 168 | S L K ADDR CURRENT STMNT POINTER K0901680 7A5E 4C20 7A54 169 | BSC L LOOP1,Z BR IF NOT STMNT END K0901690 7A60 614B 170 | ERR8 LDX X1 D8 ILLEGAL STATEMENT FORMAT K0901700 7A61 4C00 7C2B 171 | BSC L ERR BR TO SET UP ERROR 75 K0901710 172 | * K0901720 173 | * CONSTANTS AND WORK AREA K0901730 174 | * K0901740 7A63 175 | J BSS 1 INDEX FOR VARIABLES K0901750 7A64 176 | HDRPT BSS 1 DATA GROUP HEADER WD PT K0901760 7A65 0004 177 | L4 DC 4 DECIMAL 4 K0901770 178 | * K0901780 179 | * CHECK FOR NAMES K0901790 180 | * K0901800 7A66 D400 7B7F 181 | LOOP2 STO L SUB CLEAR SUBSCRIPT K0901810 7A68 C400 7C39 182 | LD L K CURRENT POINTER ADDRESS K0901820 7A6A 90F8 183 | S J POINTER AFTER LAST CONSTANT K0901830 7A6B 1801 184 | SRA 1 K0901840 7A6C 4C20 7A72 185 | BSC L NEXTC+1,Z BR IF NAMES SPECIFIED K0901850 7A6E 614B 186 | LDX X1 D1 NO NAMES SPECIFIED K0901860 7A6F 4C00 7C2B 187 | BSC L ERR BR TO SET UP ERROR 75 K0901870 7A71 188 | NEXTC EQU * LABEL FOR NEXT INSTRUCTION K0901880 7A71 6AF1 189 | STX 2 J SAVE POINTER AFTER LAST CON K0901890 7A72 7401 7C39 190 | MDX L K,1 INCR INTER-STMNT POINTER K0901900 7A74 69EF 191 | STX 1 HDRPT HEADER WORD POINTER K0901910 7A75 4028 192 | BSI INCRP INCR WORK AREA POINTER K0901920 7A76 4400 7C7A 193 | BSI L GCON BR TO GET NEXT CONSTANT K0901930 7A78 C04E 194 | LD CONL CONSTANT LENGTH INDR K0901940 7A79 4C18 7A60 195 | BSC L ERR8,+- BR IF CONSTANT NOT FOUND K0901950 7A7B 6201 196 | LDX 2 1 K0901960 7A7C 6A75 197 | STX 2 DUP DUPLICATION FACTOR=1 K0901970 7A7D C480 7C39 198 | LD I K NEXT STMNT WORD K0901980 7A7F 901C 199 | S STAR ASTERISK CONSTANT K0901990 7A80 4C20 7ACA 200 | BSC L BLDH,Z BR IF NOT ASTERISK K0902000 7A82 C044 201 | LD CONL CONSTANT LENGTH INDICATOR K0902010 7A83 9400 7C3E 202 | S L ONE K0902020 7A85 4C18 7A8A 203 | BSC L *+3,+- BR IF CONSTANT LENGTH=1 K0902030 7A87 614B 204 | ERR2 LDX X1 D2 NOT A POSITIVE INTEGER K0902040 7A88 4C00 7C2B 205 | BSC L ERR BR TO SET UP ERROR 75 K0902050 7A8A C1FF 206 | LD 1 -1 LAST WORD HEADER WORK AREA K0902060 7A8B 4C28 7A87 207 | BSC L ERR2,Z+ BR TO SET ERROR 75 K0902070 7A8D D064 208 | STO DUP SAVE FOR NAME ITERATION K0902080 7A8E 900E 209 | S TOP CHECK DUPLICATION SIZE K0902090 7A8F 4C10 7A87 210 | BSC L ERR2,- BR IF TOO LARGE K0902100 7A91 7401 7C39 211 | MDX L K,1 INCREMENT K K0902110 7A93 71FF 212 | MDX 1 -1 MOVE WORK AREA POINTER K0902120 7A94 4400 7C7A 213 | BSI L GCON GET NEXT CONSTANT K0902130 7A96 C030 214 | LD CONL CONSTANT LENGTH INDR K0902140 7A97 4C20 7ACA 215 | BSC L BLDH,Z BR IF CONSTANT FOUND K0902150 7A99 614B 216 | LDX X1 D3 SET UP ERROR 75 IF CONSTANT K0902160 7A9A 4C00 7C2B 217 | BSC L ERR NOT FOUND AFTER DUP FACTOR K0902170 218 | * K0902180 219 | * CONSTANTS K0902190 220 | * K0902200 7A9C 001C 221 | STAR DC /1C ASTERISK CONSTANT K0902210 7A9D 1000 222 | TOP DC /1000 DUPLICATION FACTOR LIMIT K0902220 223 | * K0902230 224 | * THIS ROUTINE INCREMENTS X1, THE WORK AREA POINTER K0902240 225 | * BY ONE, CHECKING TO SEE THAT THE LIMIT OF THE K0902250 226 | * AREA IS NOT EXCEEDED. IF IT IS EXCEEDED, THE K0902260 227 | * STATEMENT RECEIVES AN ERROR 82. K0902270 228 | * K0902280 7A9E 229 | INCRP BSS 1 RETURN ADDR K0902290 7A9F 7101 230 | MDX 1 1 INCR WORK AREA POINTER K0902300 7AA0 6908 231 | STX 1 WKAA K0902310 7AA1 C007 232 | LD WKAA WORK AREA POINTER K0902320 7AA2 9005 233 | S WKNDA WORK AREA END ADDRESS K0902330 7AA3 4CA8 7A9E 234 | BSC I INCRP,+Z EXIT IF NO OVERLAP K0902340 7AA5 6152 235 | LDX 1 D15 OVERLAP ERROR INDICATED K0902350 7AA6 4C00 7C2B 236 | BSC L ERR SET UP ERROR 82 K0902360 237 | * K0902370 238 | * CONSTANT AND WORK AREA K0902380 239 | * K0902390 7AA8 7F8A 240 | WKNDA DC WKEND ADDR END OF WORK AREA K0902400 7AA9 0000 241 | WKAA DC *-* CURRENT END OF WORK AREA K0902410 242 | * K0902420 243 | * THIS ROUTINE LOCATES THE NEXT DATA STATEMENT. K0902430 244 | * THE POINTERS START AND NEXT ARE UPDATED TO POINT K0902440 245 | * TO THE START OF THE NEXT DATA STATEMENT AND TO K0902450 246 | * THE STATEMENT FOLLOWING, RESPECTIVELY. K0902460 247 | * K0902470 7AAA 248 | FINDD BSS 1 RETURN ADDRESS K0902480 7AAB 6680 7AC0 249 | LDX I2 NEXT POINTER TO NEXT STMNT ID WD K0902490 7AAD 6E00 7C41 250 | STX L2 SAVE+1 SAVE FOR MOVE K0902500 7AAF 6A01 251 | FNDD1 STX 2 START SAVE AS START OF STMNT K0902510 7AB1 252 | START EQU *+1 LABEL NEXT INSTRUCTION ADDR K0902520 7AB0 C400 0000 253 | LD L *-* STMNT ID WORD K0902530 7AB2 1802 254 | SRA 2 RIGHT JUSTIFY STMNT WD CNT K0902540 7AB3 E00E 255 | AND L1FF EXRACT WORD COUNT K0902550 7AB4 80FC 256 | A START START OF STMNT ADDR K0902560 7AB5 D00A 257 | STO NEXT ADDR OF NEXT STMNT ID WORD K0902570 7AB6 9400 7A25 258 | S L EOFS END OF STRING ADDRESS K0902580 7AB8 4C30 7C57 259 | BSC L EXIT,Z- EXIT IF END OF STRING K0902590 7ABA C200 260 | LD 2 0 STMNT ID WORD K0902600 7ABB 180B 261 | SRA 11 RIGHT JUSTIFY STMNT TYPE K0902610 7ABC 9006 262 | S DATA DATA STMNT TYPE CONSTANT K0902620 7ABD 4C98 7AAA 263 | BSC I FINDD,+- EXIT IF DATA STMNT K0902630 7AC0 264 | NEXT EQU *+1 LABEL NEXT INSTRUCTION ADDR K0902640 7ABF 6600 0000 265 | LDX L2 *-* SET POINTER NEXT STMNT ID K0902650 7AC1 70ED 266 | MDX FNDD1 BR TO FIND NEXT STMNT ID WD K0902660 267 | * K0902670 268 | * CONSTANTS AND WORK AREA K0902680 269 | * K0902690 7AC2 01FF 270 | L1FF DC /1FF STMNT WD COUNT MASK K0902700 7AC3 001F 271 | DATA DC /1F DATA STMNT TYPE CODE K0902710 7AC4 8001 272 | H8000 DC /8001 NAME BIT PLUS 1 K0902720 7AC5 0020 273 | H20 DC /20 DEFINED BIT K0902730 7AC6 0002 274 | TWO DC 2 DECIMAL TWO K0902740 7AC7 275 | CONL BSS 1 LENGTH OF CONSTANT K0902750 7AC8 276 | INTL BSS 1 INTEGER ELEMENT LENGTH K0902760 7AC9 0021 277 | SLASH DC /21 / CONSTANT K0902770 278 | * K0902780 279 | * BUILD DATAGROUP HEADER WORD K0902790 280 | * K0902800 7ACA C0FC 281 | BLDH LD CONL CONSTANT LENGTH K0902810 7ACB D028 282 | STO CONLT SAVE FOR NAME ITERATION K0902820 7ACC C025 283 | LD DUP DUPLICATION FACTOR K0902830 7ACD 1003 284 | SLA 3 TO HIGH 13 BITS K0902840 7ACE 80F8 285 | A CONL CONSTANT LENGTH K0902850 7ACF D480 7A64 286 | STO I HDRPT DATAGROUP HEADER WORD K0902860 7AD1 C025 287 | LD CONTP CONSTANT TYPE K0902870 7AD2 D022 288 | STO CONTT SAVE FOR NAME ITERATION K0902880 7AD3 6680 7A63 289 | LDX I2 J SET INDEX REG 2 = J K0902890 7AD5 7400 7B7F 290 | MDX L SUB,0 CHECK SUBSC TEMP-SKIP IF 0 K0902900 7AD7 702B 291 | MDX NXTN4+1 BR IF NAME NOT YET FULL K0902910 7AD8 7201 292 | NEXTN MDX 2 1 INCR J=J+1 K0902920 7AD9 C200 293 | LD 2 0 NEXT STMNT WORD K0902930 7ADA 4C10 7A87 294 | BSC L ERR2,- BR IF NOT A NAME 2-6 K0902940 7ADC 6780 7A27 295 | LDX I3 SOFNS INDEX REG 3=SYMBOL TABLE PT K0902950 7ADE C200 296 | NXTN1 LD 2 0 NEXT STMNT WORD K0902960 7ADF 9301 297 | S 3 1 SYMBOL TABLE ENTRY K0902970 7AE0 4C18 7AF9 298 | BSC L NXTN3,+- BR IF NAME FOUND K0902980 7AE2 299 | NXTNA EQU * LABEL NEXT INSTRUCTION K0902990 7AE2 C300 300 | LD 3 0 EXTRACT DIMENSION K0903000 7AE3 1003 301 | SLA 3 *INFORMATION K0903010 7AE4 180E 302 | SRA 14 * K0903020 7AE5 4820 303 | BSC Z SKIP NEXT IF NO DIMENSION K0903030 7AE6 73FD 304 | MDX 3 -3 DECR SYMBOL TABLE POINTER K0903040 7AE7 73FD 305 | MDX 3 -3 DECR SYMBOL TABLE POINTER K0903050 7AE8 6B0A 306 | STX 3 NOST ADDR TEMP K0903060 7AE9 C009 307 | LD NOST CURRENT SYMBOL TBL POINTER K0903070 7AEA 9400 7A2A 308 | S L EOFST END OF SYMBOL TABLE ADDRESS K0903080 7AEC 4C20 7ADE 309 | BSC L NXTN1,Z BR IF NOT STRING END K0903090 7AEE 6150 310 | ERR4 LDX X1 D4 NAME IS UNDEFINED K0903100 7AEF 4C00 7C2B 311 | BSC L ERR SET UP ERROR 80 K0903110 312 | * K0903120 313 | * CONSTANTS AND WORK AREA K0903130 314 | * K0903140 7AF1 0003 315 | THREE DC 3 DECIMAL 3 CONSTANT K0903150 7AF2 316 | DUP BSS 1 DUPLICATION FACTOR K0903160 7AF3 317 | NOST BSS 1 INTEGER SAVE TEMPORARY K0903170 7AF4 318 | CONLT BSS 1 CONSTANT LENGTH TEMPORARY K0903180 7AF5 319 | CONTT BSS 1 CONSTANT TYPE TEMPORARY K0903190 7AF6 4040 320 | BLANK DC /4040 WORD OF EBCDIC BLANKS K0903200 7AF7 321 | CONTP BSS 1 CONSTANT TYPE K0903210 7AF8 8000 322 | T8000 DC /8000 NAME BIT CONSTANT K0903220 323 | * K0903230 324 | * CONTINUE BUILD DATAGROUP HEADER WORD K0903240 325 | * K0903250 7AF9 C201 326 | NXTN3 LD 2 1 NEXT STMNT WORD K0903260 7AFA 4810 327 | BSC - SKIP IF 2ND WORD OF NAME K0903270 7AFB C0FC 328 | LD T8000 BLANK 2ND WORD OF NAME K0903280 7AFC 9302 329 | S 3 2 2ND WD FR SYMBOL TABLE K0903290 7AFD 4C20 7AE2 330 | BSC L NXTNA,Z BR IF NAME NOT FOUND K0903300 7AFF C201 331 | LD 2 1 2ND HALF OF NAME K0903310 7B00 4828 332 | BSC +Z SKIP NEXT IF NOT NAME K0903320 7B01 7201 333 | MDX 2 1 INCR STMNT POINTER J=J+1 K0903330 7B02 334 | NXTN4 EQU * LABEL FOR NEXT INSTRUCTION K0903340 7B02 7201 335 | MDX 2 1 INCR STMNT POINTER K0903350 7B03 6BEF 336 | STX 3 NOST SYMBOL TABLE POINTER K0903360 7B04 C400 7A26 337 | LD L SOFST START OF SYMBOL TABLE ADDR K0903370 7B06 90EC 338 | S NOST CURRENT POINTER VALUE K0903380 7B07 1890 339 | SRT 16 MAKE NORMAL DIVIDEND K0903390 7B08 A8E8 340 | D THREE NO. OF WORDS PER ENTRY K0903400 7B09 80BA 341 | A H8000 NAME BIT K0903410 7B0A D035 342 | STO TNAME STORE NAME K0903420 343 | * K0903430 7B0B C300 344 | LD 3 0 SYMBOL TABLE ID WORD K0903440 7B0C E8B8 345 | OR H20 SET DEFINED BIT K0903450 7B0D D300 346 | STO 3 0 RESTORE ID WORD K0903460 7B0E 4C08 7B1C 347 | BSC L ERR9,+ BR IF NOT A VARIABLE- ERROR K0903470 7B10 180A 348 | SRA 10 IS IT A DUMMY VARIABLE 2-5 K0903472 7B11 4C04 7AEE 349 | BSC L ERR4,E ERROR 80 IF YES 2-5 K0903474 7B13 1804 350 | SRA 4 DATA TYPE BITS K0903480 7B14 D0DE 351 | STO NOST K0903490 7B15 90DF 352 | S CONTT CON TYPE TEMPORARY K0903500 7B16 4C18 7B1F 353 | BSC L NXTN8,+- BR IF SAME TYPE K0903510 7B18 C0DC 354 | LD CONTT CONSTANT TYPE TEMP K0903520 7B19 90AC 355 | S TWO K0903530 7B1A 4C18 7B1F 356 | BSC L *+3,+- BR IF HOLLERITH DATA K0903540 7B1C 614D 357 | ERR9 LDX 1 D9 DATA TYPES DO NOT MATCH K0903550 7B1D 4C00 7C2B 358 | BSC L ERR SET UP ERROR 77 K0903560 7B1F C0D3 359 | NXTN8 LD NOST CON TYPE 2-1 K0903570 7B20 4C20 7B26 360 | BSC L INT,Z BR IF INTEGER 2-1 K0903580 7B22 C400 7CD3 361 | LD L LNGTH LENGTH OF REAL 2-1 K0903590 7B24 D05E 362 | STO NAML CURRENT LENGTH 2-1 K0903600 7B25 7004 363 | MDX *+4 2-1 K0903610 7B26 C0A1 364 | INT LD INTL LENGTH OF INTEGER 2-1 K0903620 7B27 D05B 365 | STO NAML CURRENT LENGTH 2-1 K0903630 7B28 C400 7C3E 366 | LD L ONE 2-1 K0903640 7B2A 90C9 367 | S CONLT CONSTANT LENGTH TEMPORARY K0903650 7B2B 4C28 7CCF 368 | BSC L ERR11,+Z BR TO SET UP ERR 78 IF NEG K0903660 7B2D 4C08 7B41 369 | BSC L NXT8A,+ BRANCH IF ZERO K0903670 370 | * K0903680 7B2F C0C5 371 | LD CONTT K0903690 7B30 9095 372 | S TWO K0903700 7B31 4C20 7B41 373 | BSC L NXT8A,Z BRANCH IF NOT ALPHA CONST K0903710 374 | * K0903720 7B33 C0C2 375 | LD BLANK PACK CONSTANT WITH BLANKS K0903730 7B34 D100 376 | STO 1 0 * K0903740 7B35 4400 7A9E 377 | BSI L INCRP K0903750 7B37 C480 7A64 378 | LD I HDRPT ADJUST HEADER K0903760 7B39 8400 7C3E 379 | A L ONE * K0903770 7B3B D480 7A64 380 | STO I HDRPT * K0903780 7B3D 7401 7AF4 381 | MDX L CONLT,1 INCREMENT CONSTANT LENGTH K0903790 7B3F 70DF 382 | MDX NXTN8 CONTINUE K0903800 383 | * K0903810 7B40 0000 384 | TNAME DC 0 NAME SAVE AREA K0903820 385 | * K0903830 7B41 C0FE 386 | NXT8A LD TNAME OUTPUT NAME K0903840 7B42 D100 387 | STO 1 0 * K0903850 7B43 4400 7A9E 388 | BSI L INCRP * K0903860 389 | * K0903870 7B45 C300 390 | LD 3 0 SYMBOL TABLE ID WORD K0903880 7B46 1003 391 | SLA 3 EXTRACT AND RIGHT JUSTIFY K0903890 7B47 180E 392 | SRA 14 DIMENSION BITS. K0903900 7B48 D063 393 | STO DIMN SAVE DIMENSIONALITY K0903910 7B49 D03A 394 | STO DIMNT SAVE FOR SUBSC CALCULATION K0903920 7B4A 4C18 7B56 395 | BSC L NXTN7,+- BR IF NOT DIMENSIONED K0903930 7B4C 4400 7A9E 396 | BSI L INCRP INCR WORK AREA POINTER K0903940 7B4E 7400 7B7F 397 | MDX L SUB,0 TEST FOR SUBSCRIPT K0903950 7B50 705C 398 | MDX NXTN2 BR IF SUBSCRIPT K0903960 7B51 71FF 399 | MDX 1 -1 DECR WORK AREA POINTER K0903970 7B52 C200 400 | LD 2 0 NEXT STMNT WORD K0903980 7B53 902D 401 | S LPAR LEFT PARENTHESIS CONSTANT K0903990 7B54 4C18 7B92 402 | BSC L NXTN5,+- BR TO GET SUBSCRIPT K0904000 7B56 C400 7C3E 403 | NXTN7 LD L ONE K0904010 7B58 7400 7BAC 404 | MDX L DIMN,0 SKIP IF NOT DIMENSIONED K0904020 7B5A C3FD 405 | LD 3 -3 NEXT SYMBOL ID WORD K0904030 7B5B 9023 406 | S SUB REMAINING ELEMENTS IN NAME K0904040 7B5C 4C30 7B61 407 | BSC L *+3,-Z BR IF SUBSCRIPT OK K0904050 7B5E 408 | ERR13 EQU * LABEL FOR NEXT INSTRUCTION K0904060 7B5E 6121 409 | LDX X1 D13 SUBSCRIPT TOO LARGE K0904070 7B5F 4C00 7C2B 410 | GERR BSC L ERR SET UP ERROR 33 K0904080 7B61 9090 411 | S DUP DUPLICATION FACTOR K0904090 7B62 D01D 412 | STO TEMP REMAINING AFTER THIS CON K0904100 7B63 4C08 7B69 413 | BSC L NXTN9,+ BF IF NAME FULL OR OVERFLOW K0904110 7B65 C3FD 414 | LD 3 -3 NEXT ENTRY ID WORD K0904120 7B66 9019 415 | S TEMP REMAINDER K0904130 7B67 D017 416 | STO SUB SUBSCRIPT FOR NEXT CONSTANT K0904140 7B68 7058 417 | MDX COM BR TO TEST FOR ANOTHER CON K0904150 7B69 1810 418 | NXTN9 SRA 16 K0904160 7B6A D014 419 | STO SUB CLEAR SUBSCRIPT K0904170 7B6B 9014 420 | S TEMP REMAINDER K0904180 7B6C D085 421 | STO DUP DUPCTN FACTOR FOR NEXT NAME K0904190 7B6D 4C18 7B74 422 | BSC L *+5,+- BR IF CONSTANT EXHAUSTED K0904200 7B6F C200 423 | LD 2 0 NEXT STMNT WORD K0904210 7B70 9014 424 | S COMMA COMMA CONSTANT K0904220 7B71 4C18 7AD8 425 | BSC L NEXTN,+- BR CONSTANT NOT EXHAUSTED K0904230 7B73 7055 426 | MDX ERR7 NO COMMA AFTER NAME K0904240 7B74 C200 427 | LD 2 0 NEXT STMNT WORD K0904250 7B75 900F 428 | S COMMA COMMA CONSTANT K0904260 7B76 4C18 7BC1 429 | BSC L COM,+- BR IF COMMA K0904270 7B78 430 | SLSH2 EQU * LABEL FOR NEXT INSTRUCITON K0904280 7B78 C200 431 | LD 2 0 NEXT STMNT WORD K0904290 7B79 9400 7AC9 432 | S L SLASH SLASH CONSTANT K0904300 7B7B 4C18 7BCB 433 | BSC L SLSH,+- BR IF SLASH K0904310 7B7D 614B 434 | LDX X1 D5 ILLEGAL CHAR AFTER NAME K0904320 7B7E 70E0 435 | MDX GERR BR TO SET UP ERROR 75 K0904330 436 | * K0904340 437 | * CONSTANTS AND WORK AREA K0904350 438 | * K0904360 7B7F 0000 439 | SUB DC 0 SUBSCRIPT TEMPORARY K0904370 7B80 440 | TEMP BSS 1 REMAINDER TEMPORARY K0904380 7B81 000D 441 | LPAR DC /0D LEFT PARENTHESIS CONSTANT K0904390 7B82 4000 442 | H4000 DC /4000 NAME SUBSCRIPT BIT K0904400 7B83 443 | NAML BSS 1 CURRENT DIMENSION LENGTH K0904410 7B84 0000 444 | DIMNT DC 0 DIMENSION TEMPORARY K0904420 7B85 002B 445 | COMMA DC /2B COMMA CONSTANT K0904430 7B86 7B87 446 | SUBSW DC * SUBSCRIPTED ELEMENT SWITCH K0904440 447 | * K0904450 448 | * CALCULATE VECTOR DISPLACEMENT FROM K0904460 449 | * VARIABLE STATEMENT K0904470 450 | * K0904480 7B87 C200 451 | NEXTS LD 2 0 NEXT STMNT WORD K0904490 7B88 90FC 452 | S COMMA COMMA CONSTANT K0904500 7B89 4C20 7B5E 453 | BSC L ERR13,Z BR NO COMMA BETWEEN SUBSC K0904510 7B8B 71FF 454 | MDX 1 -1 DECR WORK AREA POINTER K0904520 7B8C 4400 7C68 455 | BSI L GCONS GET NEXT SUBSCRIPT INTEGER K0904530 7B8E A300 456 | M 3 0 MPY BY DIMENSION K0904540 7B8F 18D0 457 | RTE 16 PRODUCT TO ACC K0904550 7B90 80EE 458 | A SUB ACCUMULATED VALUE K0904560 7B91 7008 459 | MDX TESTS BR TO SAVE AND TEST SUBSC K0904570 7B92 D0F3 460 | NXTN5 STO SUBSW SET SUBSCRIPTED ELT SWITCH K0904580 7B93 C400 7C39 461 | LD L K K0904590 7B95 D0EA 462 | STO TEMP SAVE K K0904600 7B96 6E00 7C39 463 | STX L2 K K=J K0904610 7B98 4400 7C68 464 | BSI L GCONS GET SUBSCRIPT INTEGER K0904620 7B9A D0E4 465 | TESTS STO SUB SAVE ACCUMULATED RESULT K0904630 7B9B 93FF 466 | S 3 -1 TEST FOR CURRENT SIZE K0904640 7B9C 4C10 7B5E 467 | BSC L ERR13,- TOO LARGE K0904650 7B9E 73FF 468 | MDX 3 -1 MOVE DIMENSION PT BACK ONE K0904660 7B9F 74FF 7B84 469 | MDX L DIMNT,-1 TEST IF MORE SUBSC EXPECTED K0904670 7BA1 70E5 470 | MDX NEXTS YES K0904680 7BA2 C0DD 471 | NXTN6 LD TEMP K FROM TEMPORARY K0904690 7BA3 D400 7C39 472 | STO L K RESET K K0904700 7BA5 7201 473 | MDX 2 1 INCREMENT STMNT POINTER K0904710 7BA6 C2FF 474 | LD 2 -1 LAST STMNT WORD K0904720 7BA7 9400 7C3B 475 | S L RPAR RIGHT PARENTHESIS CONSTANT K0904730 7BA9 4C20 7B5E 476 | BSC L ERR13,Z BR NOT RIGHT PARENTHESIS K0904740 7BAC 477 | DIMN EQU *+1 NUMBER OF DIMENSIONS K0904750 7BAB 7700 0000 478 | MDX L3 *-* RESET SYMBOL TBL POINTER K0904760 7BAD C0D1 479 | NXTN2 LD SUB SUBSCRIPT TEMP K0904770 7BAE A0D4 480 | M NAML GET TRUE DISPLACEMENT K0904780 7BAF 1090 481 | SLT 16 PRODUCT TO ACC K0904790 7BB0 D1FF 482 | STO 1 -1 STORE SUBSCRIPT IN WORK K0904800 7BB1 C1FE 483 | LD 1 -2 NAME WORD K0904810 7BB2 E8CF 484 | OR H4000 SET SUBSCRIPT BIT IN NAME K0904820 7BB3 D1FE 485 | STO 1 -2 RESTORE NAME WORD K0904830 7BB4 7400 7B86 486 | MDX L SUBSW,0 SKIP IF SUBSCRIPTED ELT K0904840 7BB6 709F 487 | MDX NXTN7 BR TO FIND MORE ENTRIES K0904850 7BB7 68CE 488 | STX SUBSW RESET SUBSCRIPTED ELT SW K0904860 7BB8 1010 489 | SLA 16 LOAD ZERO K0904870 7BB9 D0F2 490 | STO DIMN ZERO NO. OF DIMENSIONS K0904880 7BBA D0C9 491 | STO DIMNT ZERO WORK AREA K0904890 7BBB D0C3 492 | STO SUB ZERO SUBSCRIPTS K0904900 7BBC C1FE 493 | LD 1 -2 SET SUBSCRIPTED ELEMENT K0904910 7BBD E802 494 | OR H2000 *BIT INTO NAME POINTER K0904920 7BBE D1FE 495 | STO 1 -2 * K0904930 7BBF 7096 496 | MDX NXTN7 BR TO FIND MORE K0904940 7BC0 2000 497 | H2000 DC /2000 SUBSCRIPTED ELEMENT BIT K0904950 7BC1 498 | COM EQU * LABEL FOR NEXT INSTRUCTION K0904960 7BC1 C480 7C39 499 | LD I K NEXT STMNT WORD K0904970 7BC3 90C1 500 | S COMMA COMMA CONSTANT K0904980 7BC4 4C18 7A71 501 | BSC L NEXTC,+- NEXT CON IF MORE IN LIST K0904990 7BC6 7400 7B7F 502 | MDX L SUB,0 SKIP NEXT SUBSCRIPT = ZERO K0905000 7BC8 70AF 503 | MDX SLSH2 CHK FOR UNFILLED LAST NAME K0905010 7BC9 614C 504 | ERR7 LDX X1 D7 NO. OF CONS, NAMES UNEQUAL K0905020 7BCA 7060 505 | MDX ERR BR TO SET UP ERROR 76 K0905030 506 | * K0905040 507 | * MOVE WORK STRING TO STRING AREA K0905050 508 | * K0905060 7BCB 509 | SLSH EQU * LABEL FOR NEXT INSTRUCITON K0905070 7BCB D0B3 510 | STO SUB CLEAR SUBSCRIPT K0905080 7BCC C480 7C39 511 | LD I K NEXT STMNT WORD K0905090 7BCE 9400 7AC9 512 | S L SLASH SLASH CONSTANT K0905100 7BD0 4C20 7BC9 513 | BSC L ERR7,Z BR IF NOT SLASH K0905110 7BD2 7401 7C39 514 | MDX L K,1 INCR STMNT POINTER K0905120 7BD4 C480 7C39 515 | LD I K NEXT STMNT WORD K0905130 7BD6 90AE 516 | S COMMA COMMA CONSTANT K0905140 7BD7 4C20 7BDE 517 | BSC L SLSH1,Z BR IF NOT A COMMA K0905150 7BD9 C05F 518 | LD K STMNT POINTER K0905160 7BDA D400 7A63 519 | STO L J J=K K0905170 7BDC 4C00 7A54 520 | BSC L FNDC1 BR FOR MULTIPLE STMNTS K0905180 7BDE 7401 7C39 521 | SLSH1 MDX L K,1 INCR STMNT POINTER K0905190 7BE0 C058 522 | LD K CURRENT POINTER VALUE K0905200 7BE1 9400 7AC0 523 | S L NEXT ADDR NEXT STMNT ID WORD K0905210 7BE3 4C20 7A60 524 | BSC L ERR8,Z BR IF NOT STMNT END K0905220 7BE5 7500 81DB 525 | MDX L1 1-WORK GET LENGTH K0905230 7BE7 690D 526 | STX 1 SL+1 END OF OUTPUT INCREMENT K0905240 7BE8 6680 7C43 527 | LDX I2 ENDD PICK UP END OF OUTPUT PT K0905250 7BEA C04F 528 | LD DATAS DATA STMNT ID SHIFTED 2 RT K0905260 7BEB E809 529 | OR SL+1 BUILD NEW STMNT ID FOR DATA K0905270 7BEC 1002 530 | SLA 2 RESTORE TO NORMAL FROM K0905280 7BED D016 531 | STO IDWD SAVE NEW ID WORD K0905290 7BEE 9200 532 | S 2 0 END OF OUTPUT WORD K0905300 7BEF 4C30 7C06 533 | BSC L OPEN,-Z BR TO OPEN STRING K0905310 7BF1 C012 534 | CONTS LD IDWD RESTORE NEW ID WORD K0905320 7BF2 D200 535 | STO 2 0 MOVE IN DATA STMNT ID K0905330 7BF3 71FF 536 | MDX 1 -1 DECR WORK AREA POINTER K0905340 7BF4 7600 0000 537 | SL MDX L2 *-* POINT TO END OF OUTPUT K0905350 7BF6 6A4C 538 | STX 2 ENDD SAVE AS NEW END K0905360 7BF7 C500 7E25 539 | LOOP3 LD L1 WORK-1 WORD FROM WORK AREA K0905370 7BF9 D2FF 540 | STO 2 -1 TO STRING AREA K0905380 7BFA 72FF 541 | MDX 2 -1 DECR STRING POINTER K0905390 7BFB 71FF 542 | MDX 1 -1 DECR AREA POINTER K0905400 7BFC 70FA 543 | MDX LOOP3 BR IF WORK PT NOT ZERO K0905410 7BFD 4400 7AAA 544 | NXTD BSI L FINDD FIND NEXT DATA STMNT K0905420 7BFF 403F 545 | BSI MOVE COMPRESS STRING K0905430 7C00 6500 7E26 546 | LDX L1 WORK RESET WORK POINTER K0905440 7C02 4C00 7A51 547 | BSC L FINDC FIND CONSTANT K0905450 548 | * K0905460 549 | * WORK AREA K0905470 550 | * K0905480 7C04 0000 551 | IDWD DC *-* NEW ID WORD TEMPORARY K0905490 7C05 0000 552 | RUNOF DC *-* STRING SIZE TO MOVE K0905500 553 | * K0905510 554 | * THIS ROUTINE OPENS THE STRING TO PUT K0905520 555 | * ENLARGED DATA STMNT IN STRING AREA K0905530 556 | * K0905540 7C06 1802 557 | OPEN SRA 2 K0905550 7C07 D022 558 | STO CNTOF COUNT OVERFLOW K0905560 7C08 8400 7A25 559 | A L EOFS FIND NEW END OF STRING K0905570 7C0A D011 560 | STO OWD1+3 PUT ADDR IN MOVER LOOP K0905580 7C0B C400 7A25 561 | LD L EOFS END OF STRING ADDRESS K0905590 7C0D D00C 562 | STO OWD1+1 MOVE INSTRUCTION K0905600 7C0E 9034 563 | S ENDD START OF MOVE AREA K0905610 7C0F 802E 564 | A ONE ONE K0905620 7C10 D0F4 565 | STO RUNOF STRING SIZE TO MOVE K0905630 7C11 C00A 566 | LD OWD1+3 K0905640 7C12 9400 7A2A 567 | S L EOFST CHECK IF OVERLAP 2-7 K0905642 7C14 4C10 7C35 568 | BSC L ERR97,- BRANCH IF YES 2-7 K0905644 7C16 C005 569 | LD OWD1+3 LOAD AND STORE 2-7 K0905646 7C17 D400 7A25 570 | STO L EOFS NEW END OF STRING ADDRESS K0905650 7C19 C400 0000 571 | OWD1 LD L *-* NEXT WORD TO MOVE K0905660 7C1B D400 0000 572 | STO L *-* OPEN STRING K0905670 7C1D 74FF 7C1A 573 | MDX L OWD1+1,-1 DECR NEXT WORD TO MOVE ADDR K0905680 7C1F 74FF 7C1C 574 | MDX L OWD1+3,-1 DECR MOVE TO ADDRESS K0905690 7C21 74FF 7C05 575 | MDX L RUNOF,-1 DECR NO. OF WORDS TO MOVE K0905700 7C23 70F5 576 | MDX OWD1 BR TO CONTINUE K0905710 7C24 C400 7AC0 577 | LD L NEXT ADDR NEXT STMNT ID WORD K0905720 7C26 8003 578 | A CNTOF RANGE OF MOVE K0905730 7C27 D400 7AC0 579 | STO L NEXT NEW NEXT STMNT ADDR K0905740 7C29 70C7 580 | MDX CONTS BR TO RESTORE NEW ID WORD K0905750 581 | * K0905760 7C2A 0000 582 | CNTOF DC *-* RANGE OF STRING OPENING K0905770 583 | * K0905780 584 | * THIS ROUTINE IS ENTERED FOR ALL ERROR CONDITIONS. K0905790 585 | * THE STATEMENT BEING PROCESSED IS DISCARDED, AND K0905800 586 | * REPLACED BY AN ERROR RECORD. MOVE IS THEN CALLED K0905810 587 | * TO CONDENSE THE STRING, AND PROCESSING CONTINUES K0905820 588 | * WITH THE NEXT STATEMENT. ON INPUT, INDEX 1 HOLDS K0905830 589 | * THE ERROR NUMBER. K0905840 590 | * K0905850 7C2B C00C 591 | ERR LD ERRCD ERROR INDICATOR K0905860 7C2C D480 7C43 592 | STO I ENDD SET ERROR IN STMNT ID WORD K0905870 7C2E 7401 7C43 593 | MDX L ENDD,1 INCR END OF STRING K0905880 7C30 6D80 7C43 594 | STX I1 ENDD SET ERROR CODE K0905890 7C32 7401 7C43 595 | MDX L ENDD,1 INCR END OF STRING K0905900 7C34 70C8 596 | MDX NXTD COMPRESS, THEN NEXT STMNT K0905910 597 | * K0905912 7C35 7401 7A2D 598 | ERR97 MDX L ERROR,1 SET ERROR 97 2-7 K0905914 7C37 7026 599 | MDX EXIT1 EXIT TO NEXT PHASE 2-7 K0905916 600 | * K0905918 601 | * K0905920 602 | * CONSTANTS AND ERROR EQUIVALENCE TABLE K0905930 603 | * K0905940 7C38 A008 604 | ERRCD DC /A008 ERROR INDICATOR - STMNT ID K0905950 004B 605 | D1 EQU 75 NO NAMES SPECIFIED K0905960 004B 606 | D2 EQU 75 DUPCTN FACTOR NOT POS DIGI K0905970 004B 607 | D3 EQU 75 NO CON AFTER DUPCTN FACTOR K0905980 0050 608 | D4 EQU 80 UNDEFINED NAME K0905990 004B 609 | D5 EQU 75 ILLEGAL CHAR AFTER NAME K0906000 0018 610 | D6 EQU 24 ILLEGAL INTEGER CONSTANT K0906010 004C 611 | D7 EQU 76 NAMES AND CONS NOT 1 TO 1 K0906020 004B 612 | D8 EQU 75 ILLEGAL STMNT FORMAT K0906030 004D 613 | D9 EQU 77 NAME AND CON TYPE NOT SAME K0906040 004B 614 | D10 EQU 75 ILLEGAL MINUS SIGN K0906050 004E 615 | D11 EQU 78 ILLEGAL HOLLERITH CONSTANT K0906060 004F 616 | D12 EQU 79 ILLEGAL PARTIAL WORD FIELD K0906070 0021 617 | D13 EQU 33 ILLEGAL SUBSCRIPT K0906080 004F 618 | D14 EQU 79 ILLEGAL CHAR IN PARTIAL WD K0906090 0052 619 | D15 EQU 82 WORK AREA EXCEEDED K0906100 7C39 620 | K BSS 1 INDEX FOR CONSTANTS K0906110 7C3A 3E00 621 | DATAS DC /3E00 DATA STMNT ID SHIFTED 2 RT K0906120 7C3B 001D 622 | RPAR DC /1D RIGHT PARENTHESIS CONSTANT K0906130 7C3C 0020 623 | MINUS DC /20 - K0906140 7C3D 003D 624 | BCD DC /3D QUOTE MARK (APOSTROPHE) K0906150 7C3E 0001 625 | ONE DC 1 DECIMAL ONE CONSTANT K0906160 626 | * K0906170 627 | * THIS SUBROUTINE COMPRESSES THE STATEMENT STRING. K0906180 628 | * THE INPUT CONSISTS OF A FROM POINTER AND A TO K0906190 629 | * POINTER, IN START AND ENDD RESPECTIVELY K0906200 630 | * ON OUTPUT, ENDD IS UPDATED TO POINT ONE BEYOND K0906210 631 | * THE NEW END, AND INDEX 2 CONTAINS THE INPUT START K0906220 632 | * VALUE. K0906230 633 | * K0906240 7C3F 634 | MOVE BSS 1 RETURN ADDRESS K0906250 7C40 6700 0000 635 | SAVE LDX L3 *-* START OF STRING TO MOVE K0906260 7C43 636 | ENDD EQU *+1 LABEL NEXT INSTRUCTION ADD K0906270 7C42 6600 0000 637 | LDX L2 *-* START OF MOVE AREA K0906280 7C44 C0F9 638 | LD ONE K0906290 7C45 9400 7AB1 639 | S L START 1-START K0906300 7C47 D003 640 | STO TEST+1 SAVE FOR END TEST K0906310 7C48 C300 641 | MOVE1 LD 3 0 NEXT WORD TO MOVE K0906320 7C49 D200 642 | STO 2 0 COMPRESS STRING K0906330 7C4A 7700 0000 643 | TEST MDX L3 *-* TEST FOR END OF MOVE K0906340 7C4C 7005 644 | MDX DONE DONE IF NOT ZERO OR NEG K0906350 7C4D 7780 7AB1 645 | MDX I3 START EFFECTIVE INCR MOVE ADDR K0906360 7C4F 7000 646 | MDX * NO-OP FOR POSSIBLE SKIP K0906370 7C50 7201 647 | MDX 2 1 INCR MOVE TO ADDRESS K0906380 7C51 70F6 648 | MDX MOVE1 NEXT WORD K0906390 7C52 6AF0 649 | DONE STX 2 ENDD NEW END OF STRING K0906400 7C53 6680 7AB1 650 | LDX I2 START RESET INDEX REG 2 K0906410 7C55 4C80 7C3F 651 | BSC I MOVE EXIT K0906420 652 | * K0906430 653 | * THIS ROUTINE COMPLETES STRING COMPRESSION AND K0906440 654 | * EXITS TO THE NEXT PHASE K0906450 655 | * K0906460 7C57 C0EB 656 | EXIT LD ENDD END OF STRING K0906470 7C58 4C18 7C5E 657 | BSC L EXIT1,+- IF ENDD IS ZERO, NO MOVE K0906480 7C5A 40E4 658 | BSI MOVE MOVE THE REST OF THE STRING K0906490 7C5B C0E7 659 | LD ENDD K0906500 7C5C D400 7A25 660 | STO L EOFS NEW END OF STRING ADDR K0906510 7C5E 661 | EXIT1 EQU * LABEL FOR NEXT INSTRUCTION K0906520 7C5E 6580 7C65 662 | LDX I1 NXTPH+1 LOAD PARAM FOR READING K0906530 7C60 C805 663 | LDD NXTPH+2 NEXT PHASE K0906540 7C61 4C00 7FBC 664 | BSC L ROL BR TO READ IN NEXT PHASE K0906550 7C64 665 | BSS E 0 MAKE ADDRESS EVEN K0906560 7C64 0028 666 | NXTPH DC 40 ID OF NEXT PHASE K0906570 7C65 667 | BSS 3 LOADER TBL FOR NEXT PHASE K0906580 668 | * K0906590 669 | * THIS SUBROUTINE CALLS THE GET CONSTANT SUBROUTINE K0906600 670 | * TO FIND A SUBSCRIPT INTEGER. IT TESTS THE GCON K0906610 671 | * OUTPUT TO DETERMINE VALIDITY OF THE SUBSCRIPT. K0906620 672 | * K0906630 7C68 673 | GCONS BSS 1 RETURN ADDRESS K0906640 7C69 7401 7C39 674 | MDX L K,1 INCR CONSTANT INDEX K0906650 7C6B 400E 675 | BSI GCON GET CONSTANT K0906660 7C6C C400 7AC7 676 | LD L CONL CONSTANT LENGTH K0906670 7C6E 90CF 677 | S ONE ONE K0906680 7C6F 4C20 7C77 678 | BSC L ERR6,Z ERROR IF NOT AN INTEGER K0906690 7C71 C1FF 679 | LD 1 -1 CONSTANT K0906700 7C72 90CB 680 | S ONE CONSTANT - 1 K0906710 7C73 6680 7C39 681 | LDX I2 K J=K K0906720 7C75 4C90 7C68 682 | BSC I GCONS,- EXIT IF POSITIVE INTEGER K0906730 7C77 6118 683 | ERR6 LDX X1 D6 ILLEGAL SUBSCRIPT K0906740 7C78 70B2 684 | MDX ERR SET UP ERROR 24 K0906750 685 | * K0906760 7C79 000E 686 | PLUS DC /0E + SIGN K0906770 687 | * K0906780 688 | * THIS SUBROUTINE FINDS THE NEXT CONSTANT IN THE K0906790 689 | * STRING, IF ANY. ON INPUT, K POINTS TO THE K0906800 690 | * EXPECTED FIRST WORD OF THE CONSTANT, AND INDEX 1 K0906810 691 | * TO THE NEXT AVAILABLE WORD IN THE WORK AREA. K0906820 692 | * ON EXIT, THE CONSTANT IS IN THE WORK AREA, INDEX K0906830 693 | * 1 UPDATED, AND THE FOLLOWING SWITCHES SET. K0906840 694 | * CONL=0 NO CONSTANT FOUND K0906850 695 | * =OTHER LENGTH OF CONSTANT K0906860 696 | * CONTP=O REAL CONSTANT K0906870 697 | * =1 INTEGER CONSTANT K0906880 698 | * =2 HOLLERITH CONSTANT K0906890 699 | * K0906900 700 | * IN ADDITION, K IS UPDATED TO POINT TO THE NEXT K0906910 701 | * WORD PAST THE CONSTANT K0906920 702 | * K0906930 7C7A 703 | GCON BSS 1 RETURN ADDRESS K0906940 7C7B 1810 704 | SRA 16 CLEAR ACCUMULATOR K0906950 7C7C D400 7AC7 705 | STO L CONL ZERO CONSTANT LENGTH K0906960 7C7E D400 7AF7 706 | STO L CONTP CONSTANT TYPE K0906970 7C80 D053 707 | STO NEG NEGATIVE SWITCH K0906980 7C81 6F00 7D60 708 | STX L3 SAV3+1 SAVE INDEX REGISTER O K0906990 7C83 6780 7C39 709 | LDX I3 K SET INDEX REG 3 = K K0907000 7C85 C300 710 | LD 3 0 NEXT STMNT WORD K0907010 7C86 90F2 711 | S PLUS PLUS SIGN K0907020 7C87 4C20 7C8B 712 | BSC L *+2,Z BR IF NOT PLUS SIGN K0907030 7C89 7301 713 | MDX 3 1 DISCARD PLUS SIGN K0907040 7C8A 7006 714 | MDX *+6 BR TO LOAD NEXT STMNT WORD K0907050 7C8B C300 715 | LD 3 0 NEXT STMNT WORD K0907060 7C8C 90AF 716 | S MINUS MINUS SIGN K0907070 7C8D 4C20 7C91 717 | BSC L *+2,Z BR NOT MINUS SIGN CHAR K0907080 7C8F 6844 718 | STX NEG MINUS SIGN, SET NEG NONZERO K0907090 7C90 7301 719 | MDX 3 1 INCR STMNT POINTER K0907100 7C91 C300 720 | LD 3 0 NEXT STMNT WORD K0907110 7C92 90AA 721 | S BCD QUOTE MARK K0907120 7C93 4C20 7CD5 722 | BSC L GCON1,Z BR IF NOT HOLLERITH K0907130 7C95 C03E 723 | LD NEG NEGATIVE INDICATOR K0907140 7C96 4C18 7C9A 724 | BSC L *+2,+- BR IF POSITIVE K0907150 7C98 725 | ERR10 EQU * LABEL FOR NEXT INSTRUCTION K0907160 7C98 614B 726 | LDX X1 D10 NEGATIVE HOLLERITH CONSTANT K0907170 7C99 7091 727 | MDX ERR BR TO SET UP ERROR 75 K0907180 7C9A 7402 7AF7 728 | MDX L CONTP,2 SET DATA TYPE =2 K0907190 7C9C 7301 729 | MDX 3 1 INCR STMNT POINTER K0907200 730 | * K0907210 731 | * PROCESS EBCDIC CONSTANTS K0907220 732 | * K0907230 7C9D 1090 733 | GCON2 SLT 16 CLEAR EXTENSION K0907240 7C9E C300 734 | LD 3 0 NEXT STMNT WORD K0907250 7C9F F09D 735 | EOR BCD QUOTE MARK CONSTANT K0907260 7CA0 4C18 7CBA 736 | BSC L GCON4,+- BR IF QUOTE MARK K0907270 7CA2 1808 737 | SRA 8 K0907280 7CA3 4C18 7CCF 738 | BSC L ERR11,+- BR IF ILLEGAL HOLLERITH CON K0907290 7CA5 C300 739 | LD 3 0 NEXT STMNT WORD K0907300 7CA6 7301 740 | B MDX 3 1 INCR STMNT POINTER K0907310 7CA7 18D0 741 | RTE 16 BRING IN PREVIOUS WORD K0907320 7CA8 4C18 7C9E 742 | BSC L GCON2+1,+- DISCARD IF EMPTY K0907330 7CAA D100 743 | STO 1 0 WORK AREA K0907340 7CAB 4400 7A9E 744 | BSI L INCRP INCR WORK AREA POINTER K0907350 7CAD C1FF 745 | LD 1 -1 LOAD LAST O/P WORD K0907360 7CAE E00A 746 | AND LFF MASK OUT LEFT CHARACTER K0907370 7CAF 7401 7AC7 747 | MDX L CONL,1 INCR CONSTANT LENGTH IF K0907380 7CB1 4C20 7C9E 748 | BSC L GCON2+1,Z WORD FULL. K0907390 7CB3 C1FF 749 | LD 1 -1 LAST WD FROM WORK AREA K0907400 7CB4 1808 750 | SRA 8 RIGHT JUSTIFY LEFT CHAR K0907410 7CB5 1088 751 | SLT 8 PACK IN ONE MORE CHARACTER K0907420 7CB6 D1FF 752 | STO 1 -1 RESTORE TO WORK AREA K0907430 7CB7 70E6 753 | MDX GCON2+1 GET NEXT INPUT K0907440 754 | * K0907450 7CB8 7D00 755 | BCD1 DC /7D00 LEFT ADJUSTED QOUTE MARK K0907460 7CB9 00FF 756 | LFF DC /FF LOW 8 BIT MASK K0907470 757 | * K0907480 7CBA 7301 758 | GCON4 MDX 3 1 INCR STMNT POINTER K0907490 7CBB C300 759 | LD 3 0 NEXT STMNT WORD K0907500 7CBC 9080 760 | S BCD QUOTE MARK K0907510 7CBD 4C20 7CC1 761 | BSC L QT1,Z BR IF NOT ANOTHER QUOTE K0907520 7CBF C0F8 762 | LD BCD1 COMPRESS TO ONE QUOTE K0907530 7CC0 70E5 763 | MDX B CONTINUE PACKING K0907540 7CC1 1090 764 | QT1 SLT 16 SHIFT IN PREVIOUS WORD K0907550 7CC2 4C18 7CCB 765 | BSC L QT2,+- BR IF ZERO K0907560 7CC4 EC00 7AF6 766 | OR L BLANK BLANK LOW CHAR IF ZERO K0907570 7CC6 D100 767 | STO 1 0 WORK AREA K0907580 7CC7 4400 7A9E 768 | BSI L INCRP INCR WORK AREA POINTER K0907590 7CC9 7401 7AC7 769 | MDX L CONL,1 UPDATE CONSTANT LENGTH K0907600 7CCB C400 7AC7 770 | QT2 LD L CONL CONSTANT LENGTH K0907610 7CCD 4C20 7D5D 771 | BSC L GCONX,Z EXITIF VALID K0907620 7CCF 614E 772 | ERR11 LDX X1 D11 ILLEGAL CONSTANT LENGTH K0907630 7CD0 4C00 7C2B 773 | BSC L ERR SET UP ERROR 77 K0907640 774 | * K0907650 7CD2 005E 775 | REAL DC /5E REAL CONSTANT INDR K0907660 7CD3 0000 776 | LNGTH DC 0 LENGTH OF REAL INDR K0907670 7CD4 777 | NEG BSS 1 NEGATIVE CONSTANT HDR K0907680 778 | * K0907690 779 | * PROCESS REAL CONSTANTS K0907700 780 | * K0907710 7CD5 C300 781 | GCON1 LD 3 0 NEXT STMNT WORD K0907720 7CD6 90FB 782 | S REAL REAL CONSTANT INDR K0907730 7CD7 4C20 7D09 783 | BSC L GCON3,Z BR IF NOT A REAL CONSTANT K0907740 7CD9 C301 784 | LD 3 1 FIRST WORD OF REAL CONSTANT K0907750 7CDA D100 785 | STO 1 0 WORK AREA K0907760 7CDB D028 786 | STO WD SAVE IN CASE NEGATIVE K0907770 7CDC C302 787 | LD 3 2 SECOND WORD OF REAL CON K0907780 7CDD D101 788 | STO 1 1 WORK AREA K0907790 7CDE C0F4 789 | LD LNGTH LENGTH OF REAL INDR K0907800 7CDF D400 7AC7 790 | STO L CONL SET CONSTANT LENGTH K0907810 7CE1 9400 7AF1 791 | S L THREE THREE K0907820 7CE3 D022 792 | STO EXTND NORMAL PRECISION= NON-ZERO K0907830 7CE4 4C20 7CED 793 | BSC L INC3,Z BR IF NORMAL PRECISION K0907840 7CE6 C302 794 | LD 3 2 2ND WORD OF EXTENDED REAL K0907850 7CE7 D01C 795 | STO WD SAVE IN CASE NEGATIVE K0907860 7CE8 C303 796 | LD 3 3 3RD WORD OF EXTENDED REAL K0907870 7CE9 D102 797 | STO 1 2 WORK AREA K0907880 7CEA 7301 798 | MDX 3 1 SPECIAL INCR FOR 3RD WORD K0907890 7CEB 4400 7A9E 799 | BSI L INCRP INCR WORK AREA POINTER K0907900 7CED 7303 800 | INC3 MDX 3 3 UPDATE STMNT POINTER K0907910 7CEE 4400 7A9E 801 | BSI L INCRP INCREMENT WORK AREA POINTER K0907920 7CF0 4400 7A9E 802 | BSI L INCRP TWICE. K0907930 7CF2 C0E1 803 | LD NEG NEGATIVE CONSTANT INDR K0907940 7CF3 4C18 7D5D 804 | BSC L GCONX,+- EXIT IF POSITIVE K0907950 7CF5 C3FF 805 | LD 3 -1 LAST WORD (THIRD OR SECOND) K0907960 7CF6 7400 7D06 806 | MDX L EXTND,0 SKIP NEXT IF EXTENDED PREC K0907970 7CF8 E00E 807 | AND HFF00 MASK OUT EXPONENT K0907980 7CF9 D00B 808 | STO WD+1 SAVE FOR COMPLEMENT K0907990 7CFA F3FF 809 | EOR 3 -1 IF NORMAL, SET EXPONENT K0908000 7CFB D00C 810 | STO EXP IF EXTENDED, SET ZERO K0908010 7CFC 1898 811 | SRT 24 CLEAR ACC AND EXT K0908020 7CFD 9806 812 | SD WD COMPLEMENT MANTISSA K0908030 7CFE D1FE 813 | STO 1 -2 (LAST-1) WORD TO WORK K0908040 7CFF 18D0 814 | RTE 16 LAST WORD K0908050 7D00 E807 815 | OR EXP SET EXPONENT IF NORMAL PREC K0908060 7D01 D1FF 816 | STO 1 -1 LAST WORD TO WORK K0908070 7D02 705A 817 | MDX GCONX EXIT K0908080 818 | * K0908090 7D04 819 | WD BSS E 2 TEMP FOR COMPLEMENTING K0908100 7D06 0000 820 | EXTND DC 0 NORMAL PRECISION=NONZERO K0908110 7D07 FF00 821 | HFF00 DC /FF00 HIGH ORDER 8-BIT MASK K0908120 7D08 0000 822 | EXP DC 0 EXPONENT FOR NORMAL PREC K0908130 823 | * K0908140 824 | * PROCESS INTEGER CONSTANTS K0908150 825 | * K0908160 7D09 C300 826 | GCON3 LD 3 0 LOOK FOR PARTIAL WORD SPEC K0908170 7D0A E05B 827 | AND H7E00 EXTRACT 1ST CHAR OF SYMBOL K0908180 7D0B F05B 828 | EOR SYMZ CHECK FOR A Z K0908190 7D0C 4C18 7D70 829 | BSC L BPWS,+- BRANCH IF SO. K0908200 7D0E 7005 830 | MDX *+5 BR TO CHECK FOR OPERATOR K0908210 7D0F C300 831 | LD 3 0 LOAD CHARACTER K0908220 7D10 F400 7B81 832 | EOR L LPAR CHK FOR LEFT PARENTHESIS K0908230 7D12 4C18 7D1C 833 | BSC L FPWS,+- BR IF LEFT PARENTHESIS K0908240 7D14 C300 834 | LD 3 0 CHK FOR OPERATOR K0908250 7D15 4C10 7A60 835 | BSC L ERR8,- BRANCH IF SO (ERROR). K0908260 7D17 4400 7DC4 836 | BSI L GCONI GET INTEGER K0908270 7D19 4400 7A9E 837 | BSI L INCRP INCR WORK AREA POINTER K0908280 7D1B 7041 838 | MDX GCONX EXIT K0908290 7D1C C0B7 839 | FPWS LD NEG NEGATIVE CONSTANT INDICATOR K0908300 7D1D 4C20 7C98 840 | BSC L ERR10,Z BR IF NEG PARTIAL WORD K0908310 7D1F 1810 841 | SRA 16 CLEAR ACCUMULATOR K0908320 7D20 D042 842 | STO PW CLEAR PARTIAL WD ACC K0908330 7D21 D042 843 | STO PWTOT CLEAR PARTIAL WORD COUNT K0908340 844 | * K0908350 845 | * PROCESS PARTIAL WORD CONSTANTS K0908360 846 | * K0908370 7D22 7301 847 | GCON9 MDX 3 1 DISCARD DELIMITER K0908380 7D23 4400 7DC4 848 | BSI L GCONI GET INTEGER K0908390 7D25 C100 849 | LD 1 0 COUNT FROM WORK AREA K0908400 7D26 D015 850 | STO PWCT SAVE COUNT FOR THIS FIELD K0908410 7D27 803C 851 | A PWTOT UPDATE TOTAL COUNT K0908420 7D28 D03B 852 | STO PWTOT RESTORE K0908430 7D29 903B 853 | S L16 DECIMAL 16 K0908440 7D2A 4C08 7D2F 854 | BSC L *+3,+ BR PRATIAL WORD COUNT OK K0908450 7D2C 614F 855 | ERR12 LDX X1 D12 PARTIAL WD CNT GT 16 K0908460 7D2D 4C00 7C2B 856 | BSC L ERR BR TO SET UP ERROR 79 K0908470 7D2F C400 7AC7 857 | LD L CONL CONSTANT LENGTH K0908480 7D31 4C18 7D2C 858 | BSC L ERR12,+- BR CONSTANT NOT FOUND K0908490 7D33 C300 859 | LD 3 0 NEXT STMNT WORD K0908500 7D34 903A 860 | S EQSGN EQUAL SIGN K0908510 7D35 4C20 7D2C 861 | BSC L ERR12,Z BR NO EQUAL SIGN K0908520 7D37 7301 862 | MDX 3 1 INCR STMNT POINTER K0908530 7D38 4400 7DC4 863 | BSI L GCONI GET INTEGER K0908540 7D3A 6A09 864 | STX 2 SAV2+1 SAVE INDEX REG 2 K0908550 7D3C 865 | PWCT EQU *+1 PARTIAL WD ELEMENT LENGTH K0908560 7D3B 6600 0000 866 | LDX L2 *-* GET SHIFT COUNT K0908570 7D3D C100 867 | LD 1 0 HEADER WD FROM WORK AREA K0908580 7D3E 1A80 868 | SRT 2 0 K0908590 7D3F 4C20 7D2C 869 | BSC L ERR12,Z BR IF CONSTANT TOO LARGE K0908600 7D41 C021 870 | LD PW PARTIAL WORD TO ACCUMULATOR K0908610 7D42 1280 871 | SLT 2 0 PUT IN NEW FIELD K0908620 7D43 6600 0000 872 | SAV2 LDX L2 *-* RESTORE INDEX REG 2 K0908630 7D45 D01D 873 | STO PW STORE UPDATED PARTIAL WORD K0908640 7D46 C300 874 | LD 3 0 NEXT STMNT WORD K0908650 7D47 9400 7B85 875 | S L COMMA COMMA CONSTANT K0908660 7D49 4C18 7D22 876 | BSC L GCON9,+- BR TO GET NEXT FIELD IF ANY K0908670 7D4B C300 877 | LD 3 0 NEXT STMNT WORD K0908680 7D4C 9400 7C3B 878 | S L RPAR RIGHT PARENTHESIS CONSTANT K0908690 7D4E 4C20 7D2C 879 | BSC L ERR12,Z ERROR IF NOT RT PARENTHESIS K0908700 7D50 C012 880 | LD PW PARTIAL WORD K0908710 7D51 D100 881 | STO 1 0 TO WORK AREA K0908720 7D52 4400 7A9E 882 | BSI L INCRP INCR WORK AREA POINTER K0908730 7D54 7301 883 | MDX 3 1 INCR STMNT POINTER K0908740 7D55 6F00 7C39 884 | STX L3 K SAVE AS K K0908750 7D57 6301 885 | LDX 3 1 SET INTEGER SWITCH K0908760 7D58 6F00 7AF7 886 | STX L3 CONTP CONSTANT TYPE K0908770 7D5A 6F00 7AC7 887 | STX L3 CONL CONSTANT LENGTH K0908780 7D5C 7002 888 | MDX SAV3 BR TO RESTORE XR3 AND EXIT K0908790 7D5D 6F00 7C39 889 | GCONX STX L3 K SAVE K K0908800 7D5F 6700 0000 890 | SAV3 LDX L3 *-* RESTORE XR3 K0908810 7D61 4C80 7C7A 891 | BSC I GCON EXIT K0908820 892 | * K0908830 893 | * CONSTANTS AND WORK AREA K0908840 894 | * K0908850 7D63 895 | PW BSS 1 PARTIAL WORD TEMPORARY K0908860 7D64 896 | PWTOT BSS 1 PARTIAL WORD TOTAL LENGTH K0908870 7D65 0010 897 | L16 DC 16 PARTIAL WD COUNT LIMIT K0908880 7D66 7E00 898 | H7E00 DC /7E00 MASK TO GET 1ST CHAR K0908890 7D67 5200 899 | SYMZ DC /5200 Z DENOTES HEX DIGITS FOLLOW K0908900 7D68 900 | PW1 BSS E 1 HOLDS 1-4 CHARACTERS (HEX K0908910 7D69 901 | PW2 BSS 1 DIGITS W/ Z PRECEDING). K0908920 7D6A C000 902 | HC000 DC /C000 MASK TO GET ZONE BITS K0908930 7D6B F000 903 | HF000 DC /F000 MASK TO GET NUMERIC PART K0908940 7D6C 9000 904 | H9000 DC /9000 GT THAN WHICH ARE CHARS K0908950 7D6D 1800 905 | H1800 DC /1800 ADD TO NO. PART TO GET BIN K0908960 7D6E FC00 906 | HFC00 DC /FC00 MASK TO GET 1ST CHAR K0908970 7D6F 003E 907 | EQSGN DC /3E = K0908980 908 | * K0908990 909 | * CONTINUE PROCESSING PARTIAL WD CONS K0909000 910 | * K0909010 7D70 C400 7CD4 911 | BPWS LD L NEG CHK FOR NEGATIVE K0909020 7D72 4C20 7C98 912 | BSC L ERR10,Z BRANCH IF SO (ERROR). K0909030 7D74 D0EE 913 | STO PW CLEAR PARTIAL WORD K0909040 7D75 D0F3 914 | STO PW2 ZERO 2ND HALF OF SYMBOL K0909050 7D76 C300 915 | LD 3 0 CHECK FIRST CHAR AFTER K0909060 7D77 1007 916 | SLA 7 THE Z, MUST BE NON-BLANK. K0909070 7D78 E0F5 917 | AND HFC00 EXTRACT THE CHAR K0909080 7D79 4C18 7DC1 918 | BSC L ER14,+- BR TO SET UP ERROR IF BLANK K0909090 7D7B 10A0 919 | SLT 32 CLEAR EXTENSION K0909100 7D7C C300 920 | LD 3 0 GET 1ST HALF K0909110 7D7D 1001 921 | SLA 1 SHIFT OUT INDICATOR BIT K0909120 7D7E D0E9 922 | STO PW1 SAVE IN PW1 TEMPORARY K0909130 7D7F C301 923 | LD 3 1 CHECK FOR 3-5 CHARS K0909140 7D80 4C10 7D8D 924 | BSC L SYMGT,- BRANCH IF NOT K0909150 7D82 1001 925 | SLA 1 SHIFT OUT INDICATOR BIT K0909160 7D83 1801 926 | SRA 1 REPLACE IT W/ ZERO, MOVE K0909170 7D84 188E 927 | SRT 14 LAST 15 BITS TO Q, TO LEAVE K0909180 7D85 E8E2 928 | OR PW1 THE CHARACTERS CONTIGUOUS K0909190 7D86 D0E1 929 | STO PW1 AND LEFT JUSTIFIED IN K0909200 7D87 18D0 930 | RTE 16 PW1 AND PW2. K0909210 7D88 D0E0 931 | STO PW2 K0909220 7D89 7301 932 | MDX 3 1 INCREMENT STRING POINTER K0909230 7D8A C301 933 | LD 3 1 CHECK TO BE SURE THE NEXT K0909240 7D8B 4C28 7D2C 934 | BSC L ERR12,+Z CHAR IS AN OPERATOR, BR NOT K0909250 7D8D 6A31 935 | SYMGT STX 2 X2S+1 SAVE X2 K0909260 7D8E 6206 936 | LDX 2 6 SET SHIFT COUNTER FOR 1ST K0909270 7D8F C8D8 937 | GTHD LDD PW1 LOAD THE PW SPEC ZHHHH K0909280 7D90 1280 938 | SLT 2 0 GET THE NTH CHARACTER K0909290 7D91 E0D8 939 | AND HC000 CHK ZONE BITS K0909300 7D92 4C18 7DA7 940 | BSC L CKAD,+- BR IF A TO F. K0909310 7D94 90D5 941 | S HC000 ELSE IT MUST BE NUMERIC, K0909320 7D95 4C20 7DC1 942 | BSC L ER14,Z ERROR IF NOT. K0909330 7D97 C8D0 943 | LDD PW1 GET THE DIGIT, IN 6-BIT K0909340 7D98 1280 944 | SLT 2 0 CODE, LEFT JUSTIFY IN ACC. K0909350 7D99 1002 945 | SLA 2 STRIP ZONE BITS K0909360 7D9A E0D0 946 | AND HF000 DROP OTHER DIGITS K0909370 7D9B 4C18 7DA1 947 | BSC L PTHD,+- BRANCH ON DIGIT ZERO K0909380 7D9D 90CE 948 | S H9000 CHK WITHIN RANGE 0 TO 9 K0909390 7D9E 4C30 7DC1 949 | BSC L ER14,-Z BR NOT 0 TO 9 K0909400 7DA0 80CB 950 | A H9000 (RESTORE ACTUAL VALUE) K0909410 7DA1 1890 951 | PTHD SRT 16 LEFT JUSTIFY DIGIT IN EX- K0909420 7DA2 C0C0 952 | LD PW TENSION, THEN APPEND IT TO K0909430 7DA3 1084 953 | SLT 4 THE PARTIAL WD BEING BUILT. K0909440 7DA4 D0BE 954 | STO PW K0909450 7DA5 7206 955 | MDX 2 6 INCR XR2 TO GET NEXT CHAR K0909460 7DA6 70E8 956 | MDX GTHD BR TO GET CHARACTER K0909470 7DA7 C8C0 957 | CKAD LDD PW1 CHECK DIGITS A-F. K0909480 7DA8 1280 958 | SLT 2 0 GET THE CHARACTER K0909490 7DA9 E0C4 959 | AND HFC00 DROP OTHER CHARACTERS K0909500 7DAA 4C08 7DB2 960 | BSC L ENDHD,+ EXIT IF 000000 K0909510 7DAC 90C0 961 | S H1800 CHECK TO SEE IF IN RANGE K0909520 7DAD 4C30 7DC1 962 | BSC L ER14,-Z BRANCH IF NOT A-F. K0909530 7DAF 80BE 963 | A HFC00 ADD BACK 1800 PLUS 2400 TO K0909540 7DB0 1002 964 | SLA 2 GET BINARY EQUIVALENT. K0909550 7DB1 70EF 965 | MDX PTHD INSTALL IN PARTIAL WORD K0909560 7DB2 C0B0 966 | ENDHD LD PW PARTIAL WORD TEMPORARY K0909570 7DB3 D100 967 | STO 1 0 STORE PARTIAL WD K0909580 7DB4 4400 7A9E 968 | BSI L INCRP INCR WORK AREA POINTER K0909590 7DB6 7301 969 | MDX 3 1 K=K+1 K0909600 7DB7 6F00 7C39 970 | STX L3 K SAVE K K0909610 7DB9 6301 971 | LDX 3 1 K0909620 7DBA 6F00 7AF7 972 | STX L3 CONTP CONSTANT TYPE K0909630 7DBC 6F00 7AC7 973 | STX L3 CONL CONSTANT LENGTH K0909640 7DBE 6600 0000 974 | X2S LDX L2 *-* RESTORE XR2 K0909650 7DC0 709E 975 | MDX SAV3 BR TO RESTORE XR3 AND EXIT K0909660 7DC1 614F 976 | ER14 LDX 1 D14 ERROR - CHAR NOT A-F IN K0909670 7DC2 4C00 7C2B 977 | BSC L ERR PARTIAL WORD SPEC. K0909680 978 | * K0909690 979 | * THIS SUBROUTINE IS USED BY GCON TO GET AN INTEGER K0909700 980 | * CONST WHICH IS PUT IN NEXT AVAIL WORK AREA WORD. K0909710 981 | * WK AREA POINTER IS UPDATED. K0909720 982 | * K0909730 7DC4 983 | GCONI BSS 1 RETURN ADDRESS K0909740 7DC5 10A0 984 | SLT 32 CLEAR ACC AND EXTENSION K0909750 7DC6 D100 985 | STO 1 0 CLEAR NEXT WORK AREA WORD K0909760 7DC7 C300 986 | LD 3 0 NEXT STMNT WORD K0909770 7DC8 D833 987 | STD NOS SAVE INTEGER WORD 1 K0909780 7DC9 7301 988 | MDX 3 1 INCR STMNT POINTER K0909790 7DCA C300 989 | LD 3 0 NEXT STMNT WORD K0909800 7DCB 4C10 7DD0 990 | BSC L GCON6,- BR IF NO WORD 2 K0909810 7DCD 1001 991 | SLA 1 KNOCK OUT HIGH BIT K0909820 7DCE D02E 992 | STO NOS+1 SAVE INTEGER WORD 2 K0909830 7DCF 7301 993 | MDX 3 1 INCR STMNT POINTER K0909840 7DD0 2000 994 | GCON6 LDS 0 CLEAR CARRY BIT K0909850 7DD1 C02A 995 | LD NOS INTEGER TEMPORARY K0909860 7DD2 1002 996 | GCON7 SLA 2 K0909870 7DD3 4C02 7DD8 997 | BSC L *+3,C BR IF NOT FINISHED K0909880 7DD5 4C20 7C77 998 | BSC L ERR6,Z BR TO ERROR IF NOT A DIGIT K0909890 7DD7 7018 999 | MDX GCON8 BR FINISHED K0909900 7DD8 4C10 7C77 1000 | BSC L ERR6,- BR TO ERROR IF NOT A DIGIT K0909910 7DDA 1001 1001 | SLA 1 STRIP OFF ZONE BITS K0909920 7DDB 180C 1002 | SRA 12 ISOLATE DIGIT K0909930 7DDC D400 7AF3 1003 | STO L NOST SAVE DIGIT K0909940 7DDE 901F 1004 | S NINE DIGIT LIMIT VALUE K0909950 7DDF 4C30 7C77 1005 | BSC L ERR6,-Z BR IF NOT A DECIMAL DIGIT K0909960 7DE1 C100 1006 | LD 1 0 ACCUMULATED TOTAL K0909970 7DE2 A017 1007 | M TEN MPY BY 10 K0909980 7DE3 1081 1008 | SLT 1 K0909990 7DE4 4C20 7C77 1009 | BSC L ERR6,Z BR IF VALUE TOO LARGE K0910000 7DE6 108F 1010 | SLT 15 SHIFT INTO ACCUMULATOR K0910010 7DE7 8400 7AF3 1011 | A L NOST ADD LATEST DIGIT K0910020 7DE9 4C01 7C77 1012 | BSC L ERR6,O BR IF VALUE TOO LARGE K0910030 7DEB D100 1013 | STO 1 0 UPDATE ACCUMULATED TOTAL K0910040 7DEC C80F 1014 | LDD NOS INTEGER TEMPORARY K0910050 7DED 1086 1015 | SLT 6 SHIFT OFF PROCESSED DIGIT K0910060 7DEE D80D 1016 | STD NOS RESTORE K0910070 7DEF 70E2 1017 | MDX GCON7 BR TO FIND NEXT DIGIT K0910080 7DF0 9100 1018 | GCON8 S 1 0 NEGATE INTEGER K0910090 7DF1 7400 7CD4 1019 | MDX L NEG,0 SKIP NEXT IF NEG INDR OFF K0910100 7DF3 D100 1020 | STO 1 0 SET INTEGER NEGATIVE K0910110 7DF4 7401 7AC7 1021 | MDX L CONL,1 INCR CONSTANT LENGTH K0910120 7DF6 7401 7AF7 1022 | MDX L CONTP,1 INCR CONSTANT TYPE K0910130 7DF8 4C80 7DC4 1023 | BSC I GCONI EXIT K0910140 1024 | * K0910150 1025 | * CONSTANTS, WORK, AND PATCH AREA K0910160 1026 | * K0910170 7DFA 000A 1027 | TEN DC 10 DECIMAL 10 MPY CONSTANT K0910180 7DFC 1028 | NOS BSS E 2 INTEGER TEMPORARY STORE K0910190 7DFE 0009 1029 | NINE DC 9 DECIMAL 9 DIGIT LIMIT CON K0910200 7DFF 1030 | PATCH BSS /7E25-* PATCH AREA K0910210 7E25 0000 1031 | DC 0 K0910220 7E26 1032 | WORK BSS ROL-50-* ORIGIN OF OUTPUT DATA STMNT K0910230 7F8A 1033 | WKEND EQU * END OF WK AREA + 1 K0910240 1034 | * K0910250 7F8A 1035 | END BPHAR-2 K0910260 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced $PHSE 0078 65 137 B 7CA6 740 763 BCD 7C3D 624 721 735 760 BCD1 7CB8 755 762 BEGIN 7A36 136 BLANK 7AF6 320 375 766 BLDH 7ACA 281 200 215 BPHAR 7A36 111 1035 BPWS 7D70 911 829 CCWD 7A31 85 146 152 CKAD 7DA7 957 940 CNTOF 7C2A 582 558 578 COM 7BC1 498 417 429 COMMA 7B85 445 424 428 452 500 516 875 COMON 7A2B 79 CONL 7AC7 275 194 201 214 281 285 676 705 747 769 770 790 857 887 973 1021 CONLT 7AF4 318 282 367 381 CONTP 7AF7 321 287 706 728 886 972 1022 CONTS 7BF1 534 580 CONTT 7AF5 319 288 352 354 371 CSIZE 7A2C 80 D1 004B 605 186 D10 004B 614 726 D11 004E 615 772 D12 004F 616 855 D13 0021 617 409 D14 004F 618 976 D15 0052 619 235 D2 004B 606 204 D3 004B 607 216 D4 0050 608 310 D5 004B 609 434 D6 0018 610 683 D7 004C 611 504 D8 004B 612 170 D9 004D 613 357 DATA 7AC3 271 262 DATAS 7C3A 621 528 DFCNT 7A33 104 DIMN 7BAC 477 393 404 490 DIMNT 7B84 444 394 469 491 DONE 7C52 649 644 DUP 7AF2 316 197 208 283 411 421 ENDD 7C43 636 145 527 538 563 592 593 594 595 649 656 659 ENDHD 7DB2 966 960 EOFS 7A25 73 258 559 561 570 660 EOFST 7A2A 78 308 567 EQSGN 7D6F 907 860 ER14 7DC1 976 918 942 949 962 ERR 7C2B 591 171 187 205 217 236 311 358 410 505 684 727 773 856 977 ERR10 7C98 725 840 912 ERR11 7CCF 772 368 738 ERR12 7D2C 855 858 861 869 879 934 ERR13 7B5E 408 453 467 476 ERR2 7A87 204 207 210 294 ERR4 7AEE 310 349 ERR6 7C77 683 678 998 1000 1005 1009 1012 ERR7 7BC9 504 426 513 ERR8 7A60 170 195 524 835 ERR9 7B1C 357 347 ERR97 7C35 598 568 ERRCD 7C38 604 591 ERROR 7A2D 81 138 598 EXIT 7C57 656 259 EXIT1 7C5E 661 139 599 657 EXP 7D08 822 810 815 EXTND 7D06 820 792 806 FINDC 7A51 160 547 FINDD 7AAA 248 143 263 544 FNAME 7A2E 82 FNDC1 7A54 162 520 FNDD1 7AAF 251 266 FPWS 7D1C 839 833 GCON 7C7A 703 193 213 675 891 GCON1 7CD5 781 722 GCON2 7C9D 733 742 748 753 GCON3 7D09 826 783 GCON4 7CBA 758 736 GCON6 7DD0 994 990 GCON7 7DD2 996 1017 GCON8 7DF0 1018 999 GCON9 7D22 847 876 GCONI 7DC4 983 836 848 863 1023 GCONS 7C68 673 455 464 682 GCONX 7D5D 889 771 804 817 838 GERR 7B5F 410 435 GTHD 7D8F 937 956 H1800 7D6D 905 961 H20 7AC5 273 345 H2000 7BC0 497 494 H4000 7B82 442 484 H7E00 7D66 898 827 H8000 7AC4 272 341 H9000 7D6C 904 948 950 HC000 7D6A 902 939 941 HDRPT 7A64 176 191 286 378 380 HF000 7D6B 903 946 HFC00 7D6E 906 917 959 963 HFF00 7D07 821 807 IDWD 7C04 551 531 534 INC3 7CED 800 793 INCRP 7A9E 229 192 234 377 388 396 744 768 799 801 802 837 882 968 INT 7B26 364 360 INTL 7AC8 276 151 156 364 IOCS 7A32 94 J 7A63 175 161 183 189 289 519 K 7C39 620 160 163 166 168 182 190 198 211 461 463 472 499 511 514 515 518 521 522 674 681 709 884 889 970 L16 7D65 897 853 L1FF 7AC2 270 255 L4 7A65 177 147 LFF 7CB9 756 746 LNGTH 7CD3 776 150 361 789 LOOP1 7A54 163 169 LOOP2 7A66 181 165 LOOP3 7BF7 539 543 LPAR 7B81 441 401 832 MEMRY 8000 62 63 64 MINUS 7C3C 623 716 MOVE 7C3F 634 545 651 658 MOVE1 7C48 641 648 NAML 7B83 443 362 365 480 NEG 7CD4 777 707 718 723 803 839 911 1019 NEXT 7AC0 264 141 167 249 257 523 577 579 NEXTC 7A71 188 185 501 NEXTN 7AD8 292 425 NEXTS 7B87 451 470 NINE 7DFE 1029 1004 NOS 7DFC 1028 987 992 995 1014 1016 NOST 7AF3 317 306 307 336 338 351 359 1003 1011 NXT8A 7B41 386 369 373 NXTD 7BFD 544 596 NXTN1 7ADE 296 309 NXTN2 7BAD 479 398 NXTN3 7AF9 326 298 NXTN4 7B02 334 291 NXTN5 7B92 460 402 NXTN6 7BA2 471 NXTN7 7B56 403 395 487 496 NXTN8 7B1F 359 353 382 NXTN9 7B69 418 413 NXTNA 7AE2 299 330 NXTPH 7C64 666 114 662 663 ONE 7C3E 625 202 366 379 403 564 638 677 680 OPEN 7C06 557 533 ORG 7A23 71 OVERL 7A23 63 66 OWD1 7C19 571 560 562 566 569 573 574 576 PATCH 7DFF 1030 PHID 0027 67 136 PLUS 7C79 686 711 PTHD 7DA1 951 947 965 PW 7D63 895 842 870 873 880 913 952 954 966 PW1 7D68 900 922 928 929 937 943 957 PW2 7D69 901 914 931 PWCT 7D3C 865 850 PWTOT 7D64 896 843 851 852 QT1 7CC1 764 761 QT2 7CCB 770 765 REAL 7CD2 775 782 ROL 7FBC 64 664 1032 RPAR 7C3B 622 475 878 RUNOF 7C05 552 565 575 SAV2 7D43 872 864 SAV3 7D5F 890 708 888 975 SAVE 7C40 635 250 SL 7BF4 537 526 529 SLASH 7AC9 277 164 432 512 SLSH 7BCB 509 433 SLSH1 7BDE 521 517 SLSH2 7B78 430 503 SOFGT 7A29 77 SOFNS 7A27 75 295 SOFS 7A24 72 140 SOFST 7A26 74 337 SOFXT 7A28 76 SORF 7A30 84 STAR 7A9C 221 199 START 7AB1 252 144 251 256 639 645 650 SUB 7B7F 439 181 290 397 406 416 419 458 465 479 492 502 510 SUBSW 7B86 446 460 486 488 SYMGT 7D8D 935 924 SYMZ 7D67 899 828 T8000 7AF8 322 328 TEMP 7B80 440 412 415 420 462 471 TEN 7DFA 1027 1007 TEST 7C4A 643 640 TESTS 7B9A 465 459 THREE 7AF1 315 340 791 TNAME 7B40 384 342 386 TOP 7A9D 222 209 TWO 7AC6 274 149 355 372 WD 7D04 819 786 795 808 812 WKAA 7AA9 241 231 232 WKEND 7F8A 1033 240 WKNDA 7AA8 240 233 WORK 7E26 1032 142 525 539 546 X2S 7DBE 974 935
ibm/ibm1130-lib/dmsr2v12/kforph09_lst.txt · Last modified: 2023/08/06 13:34 by Site Administrator