| 1 | * TAPE 4 OF 5 - BEGIN |
| 2 | * |
| 3 | EX34 LDA B IF B = 0 |
| 4 | SUB EXT7 |
| 5 | SZE |
| 6 | JMP EX40 NO, GO TO EX40 |
| 7 | LDA T0EX IF T (0) = 0 |
| 8 | SZE |
| 9 | JMP EX38 NO, GO TO EX38 |
| 10 | EX35 CRA |
| 11 | STA IFLG IFLG = 0 |
| 12 | LDA F |
| 13 | AOA |
| 14 | SMI F . GE. -1 |
| 15 | JMP EX36 YES |
| 16 | JMP* EX00 RETURN - NO |
| 17 | EX36 JST CA00 SCAN |
| 18 | JST OT00 OUTPUT TRIADS |
| 19 | JMP* EX00 RETURN |
| 20 | EX38 JST STXI |
| 21 | LDA B |
| 22 | SUB K109 |
| 23 | STA B |
| 24 | LDA K103 |
| 25 | STA MFL |
| 26 | LDA T0EX |
| 27 | LGL 9 O (I) = T (0) |
| 28 | ADD B I (I) = B+9 |
| 29 | ADD K124 I = I+2 |
| 30 | STA DP+1,1 |
| 31 | JST EX99 DATA POOL CHECK |
| 32 | CRA |
| 33 | STA T0EX T0 = 0 |
| 34 | STA EXT7 T7 = 0 |
| 35 | EX39 LDA L0 |
| 36 | STA A A = L0 |
| 37 | STA IM IM NOT EQ 0 |
| 38 | JMP EX10 |
| 39 | EX40 LDA TC TC 0 , |
| 40 | CAS K5 ='254 (,) IN BCD MODE |
| 41 | JMP *+2 |
| 42 | JMP EX41 |
| 43 | SUB K134 =17 |
| 44 | SZE |
| 45 | JMP EX44 NO, GO TO EX44 |
| 46 | EX41 LDA I |
| 47 | EX42 SUB K102 |
| 48 | STA XR B VS. I (J) |
| 49 | LDA DP+1,1 |
| 50 | ANA K118 |
| 51 | CAS B |
| 52 | JMP *+3 |
| 53 | JMP EX24 EQUAL, GO TO EX24 |
| 54 | JMP* EX00 LESS, RETURN |
| 55 | LDA XR GREATER, REPEAT LOOP |
| 56 | JMP EX42 |
| 57 | EX44 JST IP00 ) - INPUT OPERATOR |
| 58 | JMP EX30 GO TO EX30 |
| 59 | EX46 LDA* A |
| 60 | STA T6EX IF O1(O1(A)) = L(0) |
| 61 | LDA* T6EX |
| 62 | CAS L0 |
| 63 | JMP *+2 |
| 64 | JMP EX34 GO TO EX34 |
| 65 | STA O2 O2 = L0 |
| 66 | EX48 JST ET00 ENTER TRIAD |
| 67 | JMP EX34 |
| 68 | EX50 JST STXI |
| 69 | LDA A A(I) = A |
| 70 | STA DP,1 |
| 71 | LDA IU IU = SUB OR ARR |
| 72 | SLN |
| 73 | JMP EX30 NO, GO TO EX30 |
| 74 | LDA TC |
| 75 | SUB K17 TC = ( |
| 76 | SZE |
| 77 | JMP EX76 NO, GO TO EX76 |
| 78 | LDA B YES, B = B+16 |
| 79 | ADD K109 |
| 80 | STA B |
| 81 | LDA IU IU = ARR |
| 82 | SUB K103 |
| 83 | SZE |
| 84 | JMP EX75 NO, GO TO EX75 |
| 85 | CRA |
| 86 | STA DP,1 A(I) = 0 |
| 87 | STA X4 X4 = 0 |
| 88 | STA T3EX T3 = 0 |
| 89 | STA K T5 = A |
| 90 | LDA D0 |
| 91 | STA T9EX T9 = D0 |
| 92 | LDA A |
| 93 | STA T5EX T5 = A |
| 94 | LDA AT |
| 95 | SUB K105 AT = DUM |
| 96 | SZE |
| 97 | JMP EX74 NO, GO TO EX74 |
| 98 | CRA |
| 99 | STA T2EX YES, T (0) = 0 |
| 100 | JST EX99 DATA POOL CHECK |
| 101 | JST STXI |
| 102 | LDA A |
| 103 | STA DP,1 A(I) = A |
| 104 | LDA K132 OI (I) = A, 11 |
| 105 | LGL 9 |
| 106 | ADD K124 |
| 107 | STA DP+1,1 I=9 |
| 108 | EX54 LDA D0 IF D0 = 1, GO TO EX56 |
| 109 | SUB K101 |
| 110 | SNZ |
| 111 | JMP EX56 |
| 112 | JST EX99 DATA POOL CHECK |
| 113 | JMP *+2 |
| 114 | EX55 IRS K K = K+1 |
| 115 | LDA K |
| 116 | STA XR |
| 117 | LDA X,1 |
| 118 | STA T6EX T6 = X (K) |
| 119 | JST STXI |
| 120 | LDA T6EX |
| 121 | STA DP,1 O(I) = * |
| 122 | LDA K103 I (I) = T3+13 |
| 123 | LGL 9 T3 = T3+16 |
| 124 | ADD T3EX A (A) = T6 |
| 125 | ADD K129 =13 |
| 126 | STA DP+1,1 |
| 127 | ANA K118 |
| 128 | ADD K103 |
| 129 | STA T3EX T3 = A(A) |
| 130 | EX56 JST IV00 INPUT INTEGER VARIABLE |
| 131 | JST EX99 DATA POOL CHECK |
| 132 | JST STXI |
| 133 | LDA A A(I) = A |
| 134 | STA DP,1 |
| 135 | LDA NT |
| 136 | SZE |
| 137 | JMP EX68 CONSTANT ENCOUNTERED |
| 138 | JST UC00 UNINPUT COLUMN |
| 139 | JST DN00 INPUT DO NOT ASSIGN |
| 140 | SNZ |
| 141 | JMP EX57 IM = 0 |
| 142 | SUB K101 |
| 143 | SNZ |
| 144 | JMP EX57 IM * INTEGEH |
| 145 | JST ER00 |
| 146 | BCI 1,SU SUBSCRIPT INCREMENTER NOT A CONSTANT |
| 147 | EX57 JST STXI |
| 148 | LDA K101 |
| 149 | LGL 9 |
| 150 | ADD T3EX |
| 151 | ADD K127 |
| 152 | STA DP+1,1 O(1) = +, I(I) = T3+11 |
| 153 | JST EX99 DATA POOL CHECK |
| 154 | EX58 LDA T9EX |
| 155 | STA D0 RESET D(0) |
| 156 | LDA ID SUBSCRIPT SIZE |
| 157 | SUB K101 ID = ID-1 |
| 158 | STA ID |
| 159 | SNZ IF ZERO, GO TO EX60 |
| 160 | JMP EX60 |
| 161 | LDA K |
| 162 | STA 0 |
| 163 | LDA D0,1 D(K) = 0 |
| 164 | SNZ |
| 165 | JMP EX67 YES - (DUMMY DIMENSION) |
| 166 | IAB |
| 167 | LDA ID |
| 168 | JST IM00 |
| 169 | ADD T2EX |
| 170 | STA T2EX T2 = T2+ID*D(K) |
| 171 | EX60 LDA T9EX |
| 172 | STA D0 RESET D(0) |
| 173 | LDA K |
| 174 | STA 0 |
| 175 | LDA X+2,1 X(K+2) = 0 |
| 176 | SNZ |
| 177 | JMP EX62 YES - FINISHED |
| 178 | LDA K134 =17 |
| 179 | JST TS00 COMMA TEST |
| 180 | LDA D0+1,1 |
| 181 | IAB |
| 182 | LDA D0,1 |
| 183 | JST IM00 |
| 184 | STA D0+1,1 D(K+1) = D(K+1)*D(K) |
| 185 | JMP EX55 |
| 186 | EX62 JST STXI |
| 187 | LDA DP-1,1 DOES O(--2) = * |
| 188 | SSP |
| 189 | LGR 9 |
| 190 | CAS K103 |
| 191 | JMP *+2 |
| 192 | JMP EX66 YES. |
| 193 | SNZ NO. |
| 194 | JMP EX64 O(I-2) = 0 - YES |
| 195 | CAS K132 DOES O(I-2) = A |
| 196 | JMP EX63 |
| 197 | JMP *+2 YES |
| 198 | JMP EX63 |
| 199 | LDA T2EX IS T2 = 0 |
| 200 | SNZ |
| 201 | JMP EX65 YES (DUMMY ARRAY (1,1,1)) |
| 202 | EX63 LDA K101 |
| 203 | STA DP-1,1 01(I-2) = 1 |
| 204 | LDA T2EX A(I) = T2 |
| 205 | STA DP,1 |
| 206 | LDA K137 0='X' ('24), I=2 |
| 207 | STA DP+1,1 |
| 208 | CRA |
| 209 | STA DP+3,1 O1(1+2) = 0 |
| 210 | LDA T5EX |
| 211 | STA DP+2,1 A(I+2) = T5 |
| 212 | JST EX99 DATA POOL CHECK |
| 213 | JST CA00 SCAN |
| 214 | LDA O1 |
| 215 | STA A A = O1 |
| 216 | JST STXA |
| 217 | LDA DP+2,1 S(A) = NON-ZERO |
| 218 | SSM |
| 219 | STA DP+2,1 S(A) = 1 |
| 220 | JMP EX44 |
| 221 | EX64 LDA L0 |
| 222 | STA DP,1 A(I) = L0 |
| 223 | JST EX99 DATA POOL CHECK |
| 224 | JST STXI |
| 225 | JMP EX63 |
| 226 | EX65 LDA I |
| 227 | SUB K104 |
| 228 | STA I I = I-4 |
| 229 | LDA T5EX |
| 230 | STA DP-4,1 A (I) = T5 |
| 231 | JMP EX44 |
| 232 | EX66 LDA I |
| 233 | SUB K102 |
| 234 | STA I I = I-2 |
| 235 | JMP EX62 ASSIGN INT CONSTANT |
| 236 | EX67 JST AI00 |
| 237 | JST STXI SET XR TO I |
| 238 | LDA A |
| 239 | STA DP,1 A(I) = A |
| 240 | LDA K101 |
| 241 | LGL 9 |
| 242 | ADD T3EX |
| 243 | ADD K127 |
| 244 | STA DP+1,1 OI(I) = +, T3+11 |
| 245 | JST EX99 DATA POOL CHECK |
| 246 | JMP EX60 |
| 247 | EX68 LDA TC IS TC |
| 248 | CAS K103 = * |
| 249 | JMP *+2 |
| 250 | JMP *+2 |
| 251 | JMP EX58 NO |
| 252 | LGL 9 |
| 253 | ADD T3EX |
| 254 | ADD K129 =13 |
| 255 | STA DP+1,1 OI(I) = *, T3+13 |
| 256 | JST IR00 INPUT INTEGER VAR/CON |
| 257 | JMP EX56+1 |
| 258 | EX69 CRA SET LISTING FOR OCTAL ADDR |
| 259 | STA A |
| 260 | LDA OMI5 JMP 0 INSTRUCTION |
| 261 | STA DF SET LISTING FOR SYMBOLIC A INSTR, |
| 262 | JST OA00 OUTPUT ABSOLUTE |
| 263 | LDA RPL |
| 264 | STA O2 |
| 265 | LDA K138 |
| 266 | STA P P = H |
| 267 | JST ET00 ENTER TRIAD |
| 268 | JST HS00 TRANSFER HOLLERITH STRING |
| 269 | LDA CRET (A) = C/R |
| 270 | JST OK00 OUTPUT PACK |
| 271 | CRA |
| 272 | STA 0 SET LISTING FOR OCTAL ADDR. |
| 273 | STA A SET LISTING FOR OCTAL ADDR. |
| 274 | LDA O2 |
| 275 | SUB K101 |
| 276 | JST OS00 OUTPUT STRING RPL-1 |
| 277 | JST CH00 INPUT CHARACTER |
| 278 | JST FN00 |
| 279 | JST STXI RESET INDEX TO I |
| 280 | LDA L |
| 281 | STA DP,1 A(I) = L |
| 282 | JMP EX76 |
| 283 | EX74 LDA AF |
| 284 | STA T2EX T2 = AF |
| 285 | JMP EX54 GO TO EX54 |
| 286 | EX75 LDA K134 |
| 287 | STA TC TC = , |
| 288 | JMP EX24 GO TO EX24 |
| 289 | EX76 LDA DP-1,1 |
| 290 | LGR 9 |
| 291 | ANA K133 |
| 292 | SUB K134 |
| 293 | SNZ |
| 294 | JMP EX34 WITHIN AN ARGUMENT LIST |
| 295 | JST ER00 |
| 296 | BCI 1,AG SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST |
| 297 | EX78 LDA K127 |
| 298 | EX79 STA T1EX T (1) = 11 |
| 299 | JMP EX22 |
| 300 | EX80 LDA K129 T (1) = 13 |
| 301 | JMP EX79 |
| 302 | EX81 LDA K106 |
| 303 | STA T1EX T (1) = 6 |
| 304 | JMP EX20 |
| 305 | EX82 LDA K104 T (1) = 4 |
| 306 | JMP EX81+1 |
| 307 | EX83 LDA T0EX T (0) =0 |
| 308 | SZE |
| 309 | JMP EX84 |
| 310 | LDA TC YES, |
| 311 | STA T0EX T (0) = TC |
| 312 | LDA EX92+1 |
| 313 | STA TC TC = - |
| 314 | LDA B |
| 315 | ADD K109 |
| 316 | STA B |
| 317 | STA EXT7 |
| 318 | LDA *+2 |
| 319 | JMP EX79 |
| 320 | DEC -5 |
| 321 | EX84 JST ER00 ERROR |
| 322 | BCI 1,RL MORE THAN 1 RELATIONAL OPERATOR |
| 323 | EX85 LDA F |
| 324 | ADD K102 T (5) = T (5) +2 = B = 0 |
| 325 | STA F |
| 326 | ADD B |
| 327 | SNZ |
| 328 | JMP EX24 |
| 329 | JST ER00 ERROR |
| 330 | BCI 1,EQ MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF = |
| 331 | EX90 OCT 250 ( |
| 332 | OCT 3 * |
| 333 | OCT 5 NOT |
| 334 | OCT 1 + |
| 335 | OCT 2 - |
| 336 | OCT 310 H |
| 337 | EX91 DAC EX12 ( |
| 338 | DAC EX16 * |
| 339 | DAC EX18 NOT |
| 340 | DAC EX26 + |
| 341 | DAC EX26 - |
| 342 | DAC EX69 H |
| 343 | EX92 OCT 1 + |
| 344 | OCT 2 - |
| 345 | OCT 3 * |
| 346 | OCT 4 / |
| 347 | OCT 6 AND |
| 348 | OCT 7 OR |
| 349 | OCT 15 NE |
| 350 | OCT 12 EQ |
| 351 | OCT 14 GT |
| 352 | OCT 10 LT |
| 353 | OCT 13 GE |
| 354 | OCT 11 LE |
| 355 | OCT 16 = |
| 356 | OCT 16 = (ERROR) |
| 357 | EX93 DAC EX78 + |
| 358 | DAC EX78 |
| 359 | DAC EX80 * |
| 360 | DAC EX80 / |
| 361 | DAC EX81 AND |
| 362 | DAC EX82 OR |
| 363 | DAC EX83 NE |
| 364 | DAC EX83 EQ |
| 365 | DAC EX83 GT |
| 366 | DAC EX83 LT |
| 367 | DAC EX83 GE |
| 368 | DAC EX83 LE |
| 369 | DAC EX85 = |
| 370 | DAC EX34 NONE OF THESE |
| 371 | EX95 JST ER00 |
| 372 | BCI 1,OP MURE THAN ONE OPERATOR IN A ROW |
| 373 | EX96 JST ER00 ERROR |
| 374 | BCI 1,PA OPERATOR MUST BE WITHIN PARENTHESES |
| 375 | EX97 JST ER00 ERROR |
| 376 | BCI 1,UO MULTIPLE + OR - SIGNS NOT AS UNARY OPS |
| 377 | * BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW |
| 378 | EX99 DAC ** |
| 379 | IRS I |
| 380 | IRS I |
| 381 | LDA I |
| 382 | AOA |
| 383 | CAS L |
| 384 | NOP |
| 385 | JMP AS50 |
| 386 | JMP* EX99 |
| 387 | K133 OCT 77 |
| 388 | K130 DEC -6 |
| 389 | K141 DEC 33 |
| 390 | K PZE 0 |
| 391 | KM8 DEC -8 |
| 392 | * |
| 393 | * |
| 394 | * |
| 395 | * |
| 396 | * ****************** |
| 397 | * *SCAN * |
| 398 | * *TRIAD SEARCH * |
| 399 | * *TEMP STORE CHECK* |
| 400 | * ****************** |
| 401 | T0CA PZE 0 |
| 402 | T1CA PZE 0 |
| 403 | T2CA PZE 0 |
| 404 | T9CA PZE 0 |
| 405 | * THE AOIN TABLE IS PROCESSED FROM THE BOTTOM |
| 406 | * UP AND ENTRIES ARE FORMED FOR INCLUSION |
| 407 | * IN THE TRIAD TABLE, LEVELS ARE USED |
| 408 | * TO CONTROL THE ORDER OF ENTRY INTO |
| 409 | * THE TRIADS. SIGN CONTROL IS ALSO |
| 410 | * ACCOMPLISHED IN THIS ROUTINE. |
| 411 | CA00 DAC ** |
| 412 | LDA L0 |
| 413 | STA ACCP INDICATE EMPTY ACCUM |
| 414 | CA04 JST STXI ESTABLISH I |
| 415 | STA T1CA T1 = I |
| 416 | LDA DP-1,1 |
| 417 | ANA K118 IF I (I-2) = 0, |
| 418 | * OR .LT. I (I) |
| 419 | STA T9CA |
| 420 | LDA DP+1,1 |
| 421 | ANA K118 |
| 422 | CAS T9CA |
| 423 | JMP CA08 GO TO CA08 |
| 424 | NOP |
| 425 | LDA I |
| 426 | SUB K102 |
| 427 | STA I I = I-2 |
| 428 | STA 0 |
| 429 | CA08 LDA DP+3,1 |
| 430 | ERA DP+1,1 |
| 431 | STA T0CA |
| 432 | LDA DP+1,1 |
| 433 | ANA K118 |
| 434 | STA T2CA |
| 435 | LDA DP+1,1 |
| 436 | SSP |
| 437 | LGR 9 P = O (I) |
| 438 | STA P |
| 439 | CAS K102 IF P IS NOT * OR /, GO TO CCA10 |
| 440 | CAS K105 |
| 441 | JMP CA10 |
| 442 | JMP CA10 |
| 443 | JMP CA14 GO T0 CA14 |
| 444 | CA10 LDA T0CA |
| 445 | SMI |
| 446 | JMP CA13 |
| 447 | LDA KM8 |
| 448 | IMA XR |
| 449 | IAB |
| 450 | LDA P |
| 451 | CAS CA90+8,1 |
| 452 | JMP *+2 |
| 453 | JMP *+4 |
| 454 | IRS XR |
| 455 | JMP *-4 |
| 456 | JMP CA45 |
| 457 | LDA CA91+8,1 |
| 458 | STA P |
| 459 | IAB |
| 460 | STA XR |
| 461 | CA13 LDA K130 |
| 462 | IMA XR |
| 463 | IAB |
| 464 | LDA P |
| 465 | CAS CA90+8,1 |
| 466 | JMP *+2 |
| 467 | JMP CA50 |
| 468 | IRS XR |
| 469 | JMP *-4 |
| 470 | IAB |
| 471 | STA XR |
| 472 | IAB |
| 473 | LDA DP+1,1 |
| 474 | JMP *+2 |
| 475 | CA50 CRA |
| 476 | STA T0CA |
| 477 | IAB |
| 478 | STA XR |
| 479 | CA14 LDA DP,1 |
| 480 | STA O1 O1=A(I) |
| 481 | LDA DP+2,1 |
| 482 | STA O2 O2 = A (I+2) |
| 483 | LDA T2CA |
| 484 | SNZ |
| 485 | JMP CA37 IF ZER0, GO TO CA37 |
| 486 | LDA DP-1,1 |
| 487 | SSP |
| 488 | LGR 9 |
| 489 | STA T1CA |
| 490 | LDA DP-1,1 |
| 491 | ANA K118 IF T2 .GT. I (I-2) |
| 492 | SUB T2CA |
| 493 | SPL |
| 494 | JMP CA18 |
| 495 | SZE |
| 496 | JMP CA04 |
| 497 | LDA O2 |
| 498 | SUB ACCP |
| 499 | SZE |
| 500 | JMP CA04 |
| 501 | LDA P |
| 502 | SUB K103 |
| 503 | SMI |
| 504 | JMP CA39 |
| 505 | LDA T1CA |
| 506 | SUB P |
| 507 | SZE |
| 508 | LDA K101 GO TO |
| 509 | ADD K101 P = - OR + |
| 510 | STA P |
| 511 | CA18 LDA I |
| 512 | STA 0 J=I |
| 513 | CA20 LDA DP+2,1 |
| 514 | STA DP,1 AOIN(J) = AOIN(J+2) |
| 515 | LDA DP+3,1 |
| 516 | STA DP+1,1 |
| 517 | SSP |
| 518 | SNZ |
| 519 | JMP CA22 |
| 520 | IRS XR J = J+2 |
| 521 | IRS XR |
| 522 | JMP CA20 |
| 523 | CA22 JST STXI |
| 524 | LDA DP+1,1 |
| 525 | SSP IF O (I) = , |
| 526 | LGR 9 |
| 527 | CAS P |
| 528 | JMP CA24 |
| 529 | CAS K134 |
| 530 | JMP CA24 |
| 531 | JMP CA30 GO TO CA30 |
| 532 | CA24 JST ST00 TRIAD SEARCH |
| 533 | LDA P |
| 534 | CAS K132 IF P = +,*, AND, OR |
| 535 | JMP CA28 |
| 536 | JMP CA37 GO TO CA37 |
| 537 | CAS K107 |
| 538 | JMP CA28 ELSE, GO TO CA26 |
| 539 | JMP CA37 |
| 540 | CAS K106 |
| 541 | JMP CA28 |
| 542 | JMP CA37 |
| 543 | CAS K103 |
| 544 | JMP CA28 |
| 545 | JMP CA37 |
| 546 | CAS K101 |
| 547 | JMP CA26 |
| 548 | * |
| 549 | * |
| 550 | * |
| 551 | JMP CA37 |
| 552 | CA26 CAS K102 |
| 553 | JMP *+2 IF P = - |
| 554 | JMP CA35 GO TO |
| 555 | CA28 LDA O1 |
| 556 | JST TC00 TEMP STORE CHECK |
| 557 | CA30 LDA O2 |
| 558 | JST TC00 TEMP STORE CHECK |
| 559 | CA31 JST ET00 ENTER TRIAD |
| 560 | CA32 JST STXI |
| 561 | LDA O1 |
| 562 | STA DP,1 |
| 563 | LDA DP+1,1 |
| 564 | LRL 15 |
| 565 | LDA T0CA |
| 566 | LGR 15 |
| 567 | LLL 15 |
| 568 | STA DP+1,1 |
| 569 | LDA T2CA IF T2 NOT ZERO, |
| 570 | SZE |
| 571 | JMP CA04 GO TU CA04 |
| 572 | JMP* CA00 ELSE, RETURN |
| 573 | CA35 LDA T0CA |
| 574 | ERA ='100000 |
| 575 | STA T0CA |
| 576 | CA37 LDA O2 |
| 577 | IMA O1 O1 * = O2 |
| 578 | STA O2 |
| 579 | SNZ IF 02 = 0, |
| 580 | JMP CA32 GO TO CA32 |
| 581 | * |
| 582 | * |
| 583 | * |
| 584 | JST ST00 TRIAD SEARCH |
| 585 | LDA T0CA |
| 586 | SMI |
| 587 | JMP CA28 GO TO CA28 |
| 588 | LDA P |
| 589 | JMP CA26 ELSE, GO TO CA26 |
| 590 | CA39 SUB K128 |
| 591 | SNZ IF P = , OR |
| 592 | JMP CA04 |
| 593 | LDA T1CA |
| 594 | SUB K104 |
| 595 | SZE ELSE, |
| 596 | JMP CA18 GO TO CA18 |
| 597 | JMP CA04 |
| 598 | CA45 LDA T1CA |
| 599 | STA I I = T1 |
| 600 | STA T2CA |
| 601 | CRA |
| 602 | STA T0CA * * * * * * * * * * * |
| 603 | STA O2 O2 = C = 0 |
| 604 | SUB K110 P = C |
| 605 | STA P |
| 606 | JMP CA24 GO TO CA24 |
| 607 | * IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES |
| 608 | * ANY TRIAD TABLE ENTRY, EXIT WITH THE |
| 609 | * POINTER VALUE OF THE MATCHING ENTRY |
| 610 | * (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT |
| 611 | * SUBEXPRESSION CALCULATIONS. |
| 612 | ST00 DAC ** TRIAD SEARCH |
| 613 | LDA F |
| 614 | ADD K103 |
| 615 | SZE |
| 616 | JMP ST10 GO TO ST10 |
| 617 | ST05 LDA P ELSE, IF P = X |
| 618 | SUB K139 |
| 619 | SNZ |
| 620 | JMP CA31 GO TO CA31 |
| 621 | LDA O1 ELSE, IF 01=ACCP |
| 622 | SUB ACCP |
| 623 | SNZ |
| 624 | JMP CA30 GO TO CA30 |
| 625 | JMP* ST00 ELSE, RETURN |
| 626 | ST10 LDA L0 |
| 627 | STA XR |
| 628 | ST20 LDA XR |
| 629 | SUB K103 |
| 630 | STA XR J = J-2 |
| 631 | SUB L IF J .LT. L |
| 632 | SPL |
| 633 | JMP ST05 GO TO ST05 |
| 634 | LDA O2 |
| 635 | SUB DP,1 IF O1/P/O2 .NE. O1/P/O2(J) |
| 636 | SZE |
| 637 | JMP ST20 GO TO ST20 |
| 638 | LDA DP+2,1 |
| 639 | SSP EXTRACT OFF STORE BIT |
| 640 | SUB P |
| 641 | SZE |
| 642 | JMP ST20 |
| 643 | LDA O1 |
| 644 | SUB DP+1,1 |
| 645 | SZE |
| 646 | JMP ST20 O1 = J |
| 647 | LDA XR |
| 648 | STA O1 |
| 649 | JST STXI ESTABLISH I |
| 650 | JMP CA32 GO T0 CA32 |
| 651 | * IF J IS A REFERENCE TO A TRIAD , THE TEMP |
| 652 | * STORE BIT 0F THE REFERENCED TRIAD IS SET.) |
| 653 | TC00 DAC ** TEMP STORE CHECK |
| 654 | STA XR |
| 655 | LDA ABAR |
| 656 | SUB XR |
| 657 | SMI IS J .GR. ABAR |
| 658 | JMP* TC00 NO. |
| 659 | LDA DP+2,1 YES. |
| 660 | SSM |
| 661 | STA DP+2,1 S(J) = 1 |
| 662 | JMP* TC00 |
| 663 | CA90 OCT 1,2,11,10,13,14,12,15 |
| 664 | CA91 OCT 2,1,13,14,11,10,12,15 |
| 665 | * |
| 666 | * |
| 667 | * ************* |
| 668 | * *ENTER TRIAD* |
| 669 | * ************* |
| 670 | * STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY |
| 671 | * LOCATION. |
| 672 | ET00 DAC ** |
| 673 | JST SAV |
| 674 | LDA L |
| 675 | SUB K103 =3 |
| 676 | STA L L=L-3 |
| 677 | STA ACCP SET ACCUM PTR TO LAST TRIAD ENTRY |
| 678 | STA 0 J=L |
| 679 | LDA P |
| 680 | STA DP+2,1 P(J) = P |
| 681 | LDA O1 |
| 682 | STA DP+1,1 O1(J) = O1 |
| 683 | LDA O2 |
| 684 | STA DP,1 O2(J) = O2 |
| 685 | LDA 0 |
| 686 | STA O1 O1=J |
| 687 | JST RST |
| 688 | JMP* ET00 |
| 689 | ACCP DAC ** ACCUM POINTER |
| 690 | * |
| 691 | * |
| 692 | SFTB BSS 36 SUBFUNCTION TABLE |
| 693 | * ************************** |
| 694 | * *GENERATE SUBPRO ENTRANCE* |
| 695 | * ************************** |
| 696 | * OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE |
| 697 | * CALL TO ARGUMENT ADDRESS TRANSFER. |
| 698 | T0GE PZE 0 |
| 699 | GE00 DAC ** |
| 700 | CRA |
| 701 | STA T0GE |
| 702 | LDA K17 ( TEST |
| 703 | JST TS00 |
| 704 | GE10 JST NA00 INPUT NAME |
| 705 | LDA I IFF I=0, |
| 706 | SNZ |
| 707 | JMP GE20 GO TO GE20 |
| 708 | CAS K141 |
| 709 | NOP |
| 710 | JMP GE30 MAKE ENTRY IN SFTB TABLE |
| 711 | ADD K103 |
| 712 | STA I IF FULL, GO TO GE30 |
| 713 | JST STXA SET XR TO A |
| 714 | LDA DP,1 |
| 715 | IAB |
| 716 | JST STXI ESTABLISH I |
| 717 | IAB |
| 718 | STA SFTB,1 |
| 719 | JST STXA SET XR TO A |
| 720 | LDA DP+1,1 |
| 721 | IAB |
| 722 | JST STXI SET XR TO I |
| 723 | IAB |
| 724 | STA SFTB+1,1 |
| 725 | LDA A |
| 726 | STA SFTB+2,1 |
| 727 | JST STXA SET XR TO A |
| 728 | CRA |
| 729 | STA DP+1,1 CLEAR OLD USACE |
| 730 | GE20 LDA K105 |
| 731 | IAB |
| 732 | LDA RPL |
| 733 | ADD T0GE |
| 734 | ADD K103 (B) = DUM |
| 735 | JST AF00 DEFINE AFT (A=RPL+T0+3) |
| 736 | IRS T0GE T0 = T0+1 |
| 737 | LDA K134 |
| 738 | SUB TC IF TC = , |
| 739 | SNZ |
| 740 | JMP GE10 GO TO GE10 |
| 741 | JST IP00 INPUT OPERATOR |
| 742 | CRA |
| 743 | STA DF |
| 744 | JST OA00 OUTPUT ABS (0) |
| 745 | LDA T0GE |
| 746 | STA ID ID = T0 |
| 747 | LDA K69 |
| 748 | STA NAMF+1 NAMF = AT |
| 749 | JST NF00 FILL IN REMAINING NAME |
| 750 | JST OL00 OUTPUT OBJECT LINK |
| 751 | LDA T0GE |
| 752 | TCA |
| 753 | STA T0GE |
| 754 | CRA |
| 755 | JST OA00 OUTPUT NUMBER OF ARGS |
| 756 | IRS T0GE OUTPUT SPACE FOR ARG. ADDR. |
| 757 | JMP *-3 |
| 758 | JMP* GE00 RETURN |
| 759 | GE30 JST ER00 CONSTR, ERROR |
| 760 | BCI 1,AE |
| 761 | K69 BCI 1,AT AT |
| 762 | * |
| 763 | * **************** |
| 764 | * *EXCHANGE LINKS* |
| 765 | * **************** |
| 766 | * CL SUBA IS INTERCHANGED WITH CL SUBF |
| 767 | EL00 DAC ** |
| 768 | JST STXA |
| 769 | LDA DP,1 |
| 770 | STA EL90 CL (F) == CL (A) |
| 771 | LDA F |
| 772 | STA 0 |
| 773 | JST EL40 |
| 774 | JST STXA |
| 775 | JST EL40 |
| 776 | JMP* EL00 |
| 777 | EL40 DAC ** |
| 778 | LDA DP,1 |
| 779 | IMA EL90 |
| 780 | ANA K118 |
| 781 | IMA DP,1 |
| 782 | ANA K119 |
| 783 | ADD DP,1 |
| 784 | STA DP,1 |
| 785 | JMP* EL40 |
| 786 | EL90 PZE 0 |
| 787 | * |
| 788 | * |
| 789 | * ***************** |
| 790 | * *NON COMMON TEST* |
| 791 | * ***************** |
| 792 | NM00 DAC ** NON-COMMON TEST |
| 793 | LDA AT |
| 794 | SUB K104 |
| 795 | SZE |
| 796 | JMP* NM00 |
| 797 | JST ER00 |
| 798 | BCI 1,CR ILLEGAL COMMON REFERENCE |
| 799 | * |
| 800 | * |
| 801 | * ************************** |
| 802 | * *NON DUMMY OR SUBPRO TEST* |
| 803 | * ************************** |
| 804 | ND00 DAC ** |
| 805 | LDA AT TEST |
| 806 | SUB K105 |
| 807 | SZE |
| 808 | JMP ND10 |
| 809 | JST ER00 |
| 810 | BCI 1,DA ILLEGAL USE OF A DUMMY ARGUMENT |
| 811 | JMP* ND00 |
| 812 | ND10 JST NS00 |
| 813 | JMP* ND00 |
| 814 | * |
| 815 | * |
| 816 | * ***************** |
| 817 | * *INPUT SUBSCRIPT* |
| 818 | * ***************** |
| 819 | SCT0 PZE 0 |
| 820 | SC00 DAC ** |
| 821 | STA SCT0 T0 = (A) |
| 822 | CRA |
| 823 | STA NS |
| 824 | STA S2 NS = S2 = S3 = 0 |
| 825 | STA S3 |
| 826 | LDA K17 (-TEST |
| 827 | JST TS00 |
| 828 | SC10 LDA EBAR |
| 829 | SMI |
| 830 | JMP SC15 EBAR .GR. 0 |
| 831 | JST XN00 EXAMINE NEXT CHAR, |
| 832 | SZE |
| 833 | JMP SC70 IF (A) NON ZERO, |
| 834 | SC15 JST IG00 GO TO SC70 |
| 835 | LDA SCT0 INPUT INTEGER |
| 836 | SZE |
| 837 | SPL |
| 838 | JMP SC60 |
| 839 | LDA ID |
| 840 | SUB K101 |
| 841 | JMP SC30 |
| 842 | SC60 JST AS00 ASSIGN ITEM |
| 843 | SC20 LDA A S (NS+1) = A |
| 844 | SC30 IAB |
| 845 | LDA SC90 |
| 846 | ADD NS |
| 847 | STA SC91 |
| 848 | IAB S(NS + 1) = A |
| 849 | STA* SC91 |
| 850 | LDA NS |
| 851 | AOA |
| 852 | STA NS NS = NS + 1 |
| 853 | SUB K103 |
| 854 | SZE |
| 855 | JMP SC50 MORE SUBSCRIPTS PERMITTED |
| 856 | SC40 JST IP00 )-INPUT OPERATOR |
| 857 | JMP* SC00 RETURN |
| 858 | SC50 LDA TC |
| 859 | SUB K134 |
| 860 | SZE |
| 861 | JMP SC40 TERMINATOR NOT A COMMA |
| 862 | JMP SC10 G0 TO SC10 |
| 863 | SC70 JST IR00 INPUT INT VARIABLE |
| 864 | LDA SCT0 CHECK FOR NON-DUMMY |
| 865 | SNZ VARIABLE DIMENSIONS |
| 866 | JMP SC20 |
| 867 | LDA AT |
| 868 | SUB K105 |
| 869 | SNZ |
| 870 | JMP SC20 |
| 871 | JST ER00 |
| 872 | BCI 1,VD ILLEGAL SYMBOLIC SUBSCRIPT |
| 873 | SC90 DAC S1 |
| 874 | SC91 DAC ** |
| 875 | * |
| 876 | * |
| 877 | * ******************** |
| 878 | * *INPUT LIST ELEMENT* |
| 879 | * ******************** |
| 880 | * IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT |
| 881 | IL00 DAC ** |
| 882 | JST NA00 INPUT NAME |
| 883 | LDA AT |
| 884 | SUB K105 NON-DUMMY TEST |
| 885 | SZE |
| 886 | JMP *+3 |
| 887 | JST ER00 USAGE ERROR |
| 888 | BCI 1,DD DUMMY ITEM IN AN EQUIV, OR DATA LIST |
| 889 | LDA IU IF IU NOT ARR, |
| 890 | SUB K103 |
| 891 | SZE |
| 892 | JMP IL30 GO TO IL30 |
| 893 | LDA K103 |
| 894 | JST SC00 INPUT SUBSCRIPTS |
| 895 | JST FA00 FETCH ASSIGNS |
| 896 | LDA ND IF ND = NS |
| 897 | SUB NS |
| 898 | SZE S1 = D* (S1 + D1* (S2+D2*S3) |
| 899 | JMP IL10 ELSE, GO TO IL10 |
| 900 | LDA S3 |
| 901 | IAB |
| 902 | LDA D2 |
| 903 | JST IM00 |
| 904 | ADD S2 |
| 905 | IAB |
| 906 | LDA D1 |
| 907 | JST IM00 |
| 908 | ADD S1 |
| 909 | IAB |
| 910 | LDA D0 |
| 911 | JST IM00 |
| 912 | STA S1 |
| 913 | JMP* IL00 RETURN |
| 914 | IL10 LDA NS IF NS NOT 1 |
| 915 | SUB K101 |
| 916 | SZE |
| 917 | JMP IL20 GO TO IL20 |
| 918 | LDA S1 ELSE, 20 |
| 919 | IAB S1 * D0*S1 |
| 920 | LDA D0 |
| 921 | JST IM00 |
| 922 | IL18 STA S1 |
| 923 | JMP* IL00 RETURN |
| 924 | IL20 JST ER00 |
| 925 | BCI 1,ND WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT |
| 926 | JMP* IL00 RETURN |
| 927 | IL30 JST TV00 TAG VARIABLE |
| 928 | CRA S1 = 0 |
| 929 | JMP IL18 RETURN |
| 930 | * |
| 931 | * |
| 932 | * ************ |
| 933 | * *FUNCTION * |
| 934 | * *SUBROUTINE* |
| 935 | * ************ |
| 936 | * IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER |
| 937 | * FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS |
| 938 | R1 LDA K101 |
| 939 | STA SFF SFF = 1 |
| 940 | R2 LDA LSTF |
| 941 | SZE IF LSTF = 0 |
| 942 | JMP R2A |
| 943 | JST ER00 ILLEGAL STATEMENT |
| 944 | BCI 1,FS NOT FIRST STATEMENT IN SUBPROGRAM |
| 945 | R2A JST NA00 INPUT NAME |
| 946 | LDA A |
| 947 | STA SBF SBF = A |
| 948 | CRA ADDR=0, S/C CODE =0 |
| 949 | JST ON00 OUTPUT NAME BLOCK TO THE LOADER |
| 950 | LDA MFL |
| 951 | SZE |
| 952 | JST DM00 DEFINE IM |
| 953 | LDA TC |
| 954 | SUB CRET IF IC NOT C/R |
| 955 | SZE |
| 956 | JMP R2C GO TO |
| 957 | LDA SFF IF SFF = 0 |
| 958 | SNZ |
| 959 | JMP R2D GO TO R2D |
| 960 | JST ER00 ERROR |
| 961 | BCI 1,FA FUNCTION HAS NO ARGUMENTS |
| 962 | R2C CRA |
| 963 | STA I I = 0 |
| 964 | JST GE00 GENERATE SUBPROGRAM ENTRY |
| 965 | JMP A1 GO TO C/R TEST |
| 966 | R2D CRA |
| 967 | JST OA00 OUTPUT ABS |
| 968 | JMP C6 GO TO CONTINUE |
| 969 | * |
| 970 | * |
| 971 | * ****************** |
| 972 | * *INTEGER * |
| 973 | * *REAL * |
| 974 | * *DOUBLE PRECISION* |
| 975 | * *COMPLEX * |
| 976 | * *LOGICAL * |
| 977 | * ****************** |
| 978 | * THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE |
| 979 | * VALUE AND ANY ARRAY INFO IS PROCESSED |
| 980 | A3 LDA K101 INTEGER |
| 981 | JMP A7A TMFL = INT |
| 982 | A4 LDA K102 REAL |
| 983 | JMP A7A TMFL = REAL |
| 984 | A5 LDA K106 DOUBLE PRECISION |
| 985 | JMP A7A TMFL = DBL |
| 986 | A6 LDA K105 COMPLEX |
| 987 | JMP A7A TMFL = CPX |
| 988 | A7 LDA K103 LOGICAL |
| 989 | A7A STA MFL TMFL = LOG |
| 990 | LDA LSTF IF LSTF = 0, GO TO A7B (2) |
| 991 | SNZ |
| 992 | JMP A7B ELSE, |
| 993 | LDA CC SAVE CC |
| 994 | STA A790 |
| 995 | CRA |
| 996 | STA ICSW |
| 997 | JST DN00 INPUT DNA |
| 998 | LDA A790 RESTORE CC |
| 999 | STA CC |
| 1000 | STA ICSW ICSW = IPL |
| 1001 | LDA DFL IF DFL NOT = 0, GO TO A7B |
| 1002 | SZE |
| 1003 | JMP A7B |
| 1004 | LDA TID IF ID = FUNCTI, |
| 1005 | SUB A7K GO TO A9 |
| 1006 | SNZ SKIP IF NOT 'FUNCTION' |
| 1007 | JMP A9 FUNCTION PROCESSOR |
| 1008 | A7A5 JST ER00 CONSTRUCTION ERROR |
| 1009 | BCI 1,TF 'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST |
| 1010 | A7K BCI 1,FU CONSTANT FOR 'FUNCTION' CHECK |
| 1011 | A7B JST NA00 INPUT NAME |
| 1012 | LDA MFL |
| 1013 | JST DM00 DEFINE IM |
| 1014 | JMP B7 GO TO INPUT DIMENSION |
| 1015 | A790 PZE 0 |
| 1016 | * |
| 1017 | * |
| 1018 | * - B2 EXTERNAL |
| 1019 | * TAGS NAME AS SUBPROGRAM |
| 1020 | B2 JST NA00 EXTERNAL, INPUT NAME |
| 1021 | JST TG00 TAG SUBPROGRAM |
| 1022 | JMP B1 GO TO , OR C/R TEST |
| 1023 | * |
| 1024 | * |
| 1025 | * ***************** |
| 1026 | * *DIMENSION * |
| 1027 | * *INPUT DIMENSION* |
| 1028 | * ***************** |
| 1029 | * PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL |
| 1030 | * ARRAY POINTER ITEM |
| 1031 | B3T0 PZE 0 |
| 1032 | B3T1 PZE 0 |
| 1033 | B3T2 PZE 0 |
| 1034 | B3T3 PZE 0 |
| 1035 | B3 JST NA00 |
| 1036 | B3A LDA AT IF AT = DUM |
| 1037 | SUB K105 (A) = 0 |
| 1038 | SZE ELSE (A) = .LT. 0 |
| 1039 | SSM |
| 1040 | B3B STA B3T0 T0 = (A) |
| 1041 | LDA AF |
| 1042 | STA B3T3 T3 = AF |
| 1043 | LDA A |
| 1044 | STA B3T1 T1 = A |
| 1045 | LDA AT TEST FOR AT=DUMMY |
| 1046 | SUB K105 =5 |
| 1047 | SZE SKIP NO-USAGE TEST IF DUMMY |
| 1048 | JST NU00 NO USAGE TEST |
| 1049 | JST STXA |
| 1050 | LDA DP+1,1 IU (A) = ARR |
| 1051 | LRL 14 |
| 1052 | LDA K103 |
| 1053 | LLL 14 |
| 1054 | STA DP+1,1 |
| 1055 | LDA B3T0 (A) = T0 |
| 1056 | JST SC00 INPUT SUBSCRIPT |
| 1057 | LDA S1 |
| 1058 | STA ID |
| 1059 | LDA S2 PLACE SUBSCRIPTS IN ID |
| 1060 | STA ID+1 |
| 1061 | LDA S3 |
| 1062 | STA ID+2 |
| 1063 | LDA NS (A) = 0, B = NS |
| 1064 | LRL 16 |
| 1065 | JST AA00 ASSIGN SPECIAL. |
| 1066 | JST STXA |
| 1067 | LDA DP+1,1 |
| 1068 | LLR 2 |
| 1069 | LDA B3T3 |
| 1070 | LGL 2 |
| 1071 | LRR 2 |
| 1072 | STA DP+1,1 DEFINE GF T0 GF(A) |
| 1073 | LDA A |
| 1074 | STA B3T2 T2 = A |
| 1075 | LDA B3T1 |
| 1076 | STA A A = T1 |
| 1077 | JST STXA |
| 1078 | LDA DP+1,1 |
| 1079 | LLR 2 |
| 1080 | LDA B3T2 |
| 1081 | LGL 2 |
| 1082 | LRR 2 |
| 1083 | STA DP+1,1 DEFINE GF TO GF(A) |
| 1084 | B3D LDA TC |
| 1085 | SUB K104 IF TC NOT SLASH |
| 1086 | SZE |
| 1087 | JMP B1 GO TO ,-C/R TEST |
| 1088 | LDA A9T2 IF SIDSW = COMMON-4 |
| 1089 | SUB B4Z9 |
| 1090 | SZE GO T0 B4 (COMMON-0) |
| 1091 | JMP B1 ELSE, GO TO ,-C/R TEST |
| 1092 | JMP B40 |
| 1093 | B7 LDA TC IF TC = ( |
| 1094 | SUB K17 |
| 1095 | SZE |
| 1096 | JMP B3D |
| 1097 | JMP B3A |
| 1098 | * |
| 1099 | * |
| 1100 | * ******** |
| 1101 | * *COMMON* |
| 1102 | * ******** |
| 1103 | * INPUT BLOCK NAMES AND LINK THEM WITH THE |
| 1104 | * FOLLOWING VAR/ARRAY NAMES, BLOCK NAMES |
| 1105 | * ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS |
| 1106 | B4 LDA K81 |
| 1107 | STA ID |
| 1108 | STA ID+1 |
| 1109 | STA ID+2 |
| 1110 | LDA B4Z9 SET SWITCH IN INPUT DIMENSION |
| 1111 | STA A9T2 |
| 1112 | JST CH00 INPUT CHAR |
| 1113 | SUB K9 IF NOT SLASH |
| 1114 | SZE GO TO |
| 1115 | JMP B4E |
| 1116 | B40 JST DN00 INPUT DNA |
| 1117 | LDA K104 SLASH TEST |
| 1118 | JST TS00 |
| 1119 | B4B LRL 32 |
| 1120 | LDA K101 (A) = SUB, (B) = 0 |
| 1121 | JST AA00 ASSIGN SPECIAL |
| 1122 | LDA CFL |
| 1123 | SNZ |
| 1124 | LDA A |
| 1125 | STA CFL |
| 1126 | LDA A |
| 1127 | STA F |
| 1128 | JST FL00 FETCH LINK |
| 1129 | SZE |
| 1130 | JMP B4D |
| 1131 | LDA CFL |
| 1132 | STA 0 |
| 1133 | LDA DP+1,1 GF(CFL) |
| 1134 | IMA A |
| 1135 | STA 0 INDEX = A |
| 1136 | IMA A |
| 1137 | STA DP+1,1 GF(A) = GF(CFL) |
| 1138 | LDA CFL |
| 1139 | STA 0 INDEX = CFL |
| 1140 | LDA A |
| 1141 | ADD K122 ='040000 |
| 1142 | STA DP+1,1 GF(CFL) = A |
| 1143 | B4D JST NA00 INPUT NAME |
| 1144 | JST ND00 NON DUMMY/SUBPROG TEST |
| 1145 | JST NM00 NON-COMMON TEST |
| 1146 | JST EL00 EXCHANGE LINKS |
| 1147 | LDA DP,1 |
| 1148 | ANA B4F ='107777 |
| 1149 | ADD K122 AT(A) = COM (='040000) |
| 1150 | STA DP,1 |
| 1151 | JMP B7 |
| 1152 | B4E JST UC00 UNINPUT COLUMN |
| 1153 | JMP B4B |
| 1154 | B4Z9 DAC B4D GO TO INPUT DIMENSION |
| 1155 | B4F OCT 107777 EXTRACT MASK TO STRIP OFF AT FIELD |
| 1156 | * |
| 1157 | * |
| 1158 | * ************* |
| 1159 | * *EQUIVALENCE* |
| 1160 | * ************* |
| 1161 | * STORE EQUIV INFO IN THE DATA POOL FOR LATER |
| 1162 | * PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP) |
| 1163 | B5 LDA E0 L = NEXT WORD IN EQUIVALENCE TABLE |
| 1164 | STA I I=L |
| 1165 | SUB K101 (=1) |
| 1166 | STA E0 L=L-1 |
| 1167 | SUB ABAR |
| 1168 | SMI |
| 1169 | JMP *+3 |
| 1170 | JST ER00 DATA POOL FULL |
| 1171 | BCI 1,MO MEMORY OVERFLOW |
| 1172 | JST STXI ESTABLISH I |
| 1173 | CRA |
| 1174 | STA DP,1 DP (I) = 0 |
| 1175 | B5B JST CH00 |
| 1176 | LDA DP,1 INPUT CHAR |
| 1177 | SZE |
| 1178 | JMP B5D |
| 1179 | LDA TC PUT IN FIRST CHARACTER |
| 1180 | LGL 8 PACK INTO DP (I) |
| 1181 | B5C STA DP,1 |
| 1182 | LDA TC |
| 1183 | SUB CRET |
| 1184 | SNZ |
| 1185 | JMP C6 CHARACTER E C/R - EXIT |
| 1186 | LDA DP,1 |
| 1187 | ANA K100 |
| 1188 | SNZ |
| 1189 | JMP B5B WORD NOT FULL |
| 1190 | JMP B5 OBTAIN NEW WORD |
| 1191 | B5D LDA TC PUT IN SECOND CHARACTER |
| 1192 | ERA DP,1 |
| 1193 | JMP B5C |
| 1194 | * |
| 1195 | * |
| 1196 | * ********************* |
| 1197 | * *RELATE COMMON ITEMS* |
| 1198 | * ********************* |
| 1199 | * ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED |
| 1200 | * AND THEIR INVERSE OFFSETS CALCULATED. THESE |
| 1201 | * WILL BE INVERTED LATER TO GIVE TRUE |
| 1202 | * POSITION IN THE BLOCK. |
| 1203 | C2T0 PZE 0 |
| 1204 | C2 LDA CFL |
| 1205 | STA A A = F = CFL |
| 1206 | C2A CRA |
| 1207 | STA C2T0 T0 = 0 |
| 1208 | LDA A |
| 1209 | STA F F = A |
| 1210 | C2B JST FL00 FETCH LINK |
| 1211 | SNZ |
| 1212 | JMP C2D |
| 1213 | LDA D0 |
| 1214 | ADD C2T0 T0 = T0 + D0 |
| 1215 | STA C2T0 |
| 1216 | JST DA00 DEFINE ADDRESS FIELD |
| 1217 | JMP C2B |
| 1218 | C2D JST FL00 FETCH LINK |
| 1219 | SZE |
| 1220 | JMP C2F |
| 1221 | LDA AF |
| 1222 | STA A A = AF |
| 1223 | SUB CFL |
| 1224 | SZE |
| 1225 | JMP C2A AF = CFL. NO |
| 1226 | JMP C3 YES - GROUP EQUIVALENCE |
| 1227 | C2F LDA C2T0 |
| 1228 | SUB AF (A) = T0 - AF |
| 1229 | JST DA00 DEFINE AF |
| 1230 | LDA IU |
| 1231 | SZE |
| 1232 | JMP C2D |
| 1233 | JST TV00 TAG VARIABLE |
| 1234 | JMP C2D |
| 1235 | * |
| 1236 | * |
| 1237 | * ******************* |
| 1238 | * *GROUP EQUIVALENCE* |
| 1239 | * ******************* |
| 1240 | * THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON |
| 1241 | * USAGE IS CHECKED TO SEE THAT THE ORIGIN |
| 1242 | * IS NOT MOVED AND THAT ONLY ONE ITEM IS |
| 1243 | * COMMON. |
| 1244 | C3T0 PZE 0 |
| 1245 | C3T1 PZE 0 |
| 1246 | C3T2 PZE 0 |
| 1247 | C3T3 PZE 0 |
| 1248 | C3T4 PZE 0 |
| 1249 | C3T5 PZE 0 |
| 1250 | T0C3 EQU C3T0 |
| 1251 | T1C3 EQU C3T1 |
| 1252 | T2C3 EQU C3T2 |
| 1253 | T3C3 EQU C3T3 |
| 1254 | T4C3 EQU C3T4 |
| 1255 | C3 LDA E0 |
| 1256 | STA EBAR EBAR=E(0) = END OF EQUIVALENCE TABLE |
| 1257 | LDA L0 |
| 1258 | STA E E=L(0) = START OF EUUIVALENCE TABLE |
| 1259 | LDA CRET |
| 1260 | STA TC |
| 1261 | C3B LDA E |
| 1262 | STA EP E-PRIME = E |
| 1263 | CRA |
| 1264 | STA F I = 0 |
| 1265 | LDA K102 T4 = STR-ABS |
| 1266 | STA C3T4 |
| 1267 | JST CH00 INPUT CHARACTER |
| 1268 | LDA K17 |
| 1269 | JST TS00 (TEST |
| 1270 | C3D JST IL00 INPUT LIST ELEMENT |
| 1271 | JST SAF |
| 1272 | LDA S1 |
| 1273 | SUB AF TL = S1-AF |
| 1274 | STA C3T1 |
| 1275 | LDA A T2 = A |
| 1276 | STA C3T2 |
| 1277 | C3F LDA F IF I=0, GO TO C3P |
| 1278 | SNZ |
| 1279 | JMP C3P |
| 1280 | C3G LDA F ELSE, |
| 1281 | SUB A |
| 1282 | SNZ IF A = I, GO TO C3N |
| 1283 | JMP C3N |
| 1284 | C3H LDA AT |
| 1285 | SUB K104 ELSE, |
| 1286 | SNZ IF AT = COM, GO TO C3O |
| 1287 | JMP C3O |
| 1288 | C3H2 LDA T1C3 |
| 1289 | ADD AF |
| 1290 | STA T0C3 T(0) = AF +T (1) |
| 1291 | LDA T4C3 |
| 1292 | SUB K104 IF T(4) = 0, GO T0 C3K |
| 1293 | SZE |
| 1294 | JMP C3K |
| 1295 | LDA T3C3 |
| 1296 | SUB T0C3 ELSE, |
| 1297 | STA T0C3 T(0) = T(3)-T(0) |
| 1298 | SMI |
| 1299 | JMP C3K |
| 1300 | JST ER00 IF T(0)<0, |
| 1301 | BCI 1,IC |
| 1302 | C3K LDA C3T4 IMPOSSIBLE COMMON EQUIVALENCING |
| 1303 | IAB |
| 1304 | LDA T0C3 AT (A) = COM |
| 1305 | ALS 2 |
| 1306 | LGR 2 |
| 1307 | JST AF00 |
| 1308 | JST FL00 DEFINE AF |
| 1309 | JST SAF FETCH LINK |
| 1310 | LDA A |
| 1311 | SUB C3T2 |
| 1312 | SZE IF A .NE. T (2), |
| 1313 | JMP C3G GO TO C3G (5) |
| 1314 | * |
| 1315 | JST EL00 EXCHANGE CL(A) == CL(I) |
| 1316 | C3M LDA TC EXCHANGE LINKS (CL(A) WITH CL(F) ) |
| 1317 | SUB K134 IF TC = , |
| 1318 | SNZ |
| 1319 | JMP C3D ELSE, |
| 1320 | JST IP00 )-INPUT OPERATOR |
| 1321 | LDA TC |
| 1322 | SUB K134 IF TC = , OR C/R |
| 1323 | SNZ GO TO C3B (1) |
| 1324 | JMP C3B |
| 1325 | LDA TC |
| 1326 | SUB CRET |
| 1327 | SNZ |
| 1328 | JMP C3B ELSE, |
| 1329 | JST ER00 |
| 1330 | BCI 1,EC EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR |
| 1331 | JMP C3B |
| 1332 | C3N LDA T1C3 IF T1 = 0, GO TO C3M |
| 1333 | SNZ |
| 1334 | JMP C3M |
| 1335 | C3N5 JST ER00 ERROR IMPOSSIBLE GROUP |
| 1336 | BCI 1,IE IMPOSSIBLE EQUIVALENCE GROUPING |
| 1337 | C3O LDA S1 |
| 1338 | ADD AF |
| 1339 | STA T3C3 |
| 1340 | LDA K104 =4 |
| 1341 | CAS T4C3 |
| 1342 | JMP *+2 |
| 1343 | JMP C3N5 |
| 1344 | STA T4C3 |
| 1345 | LDA F |
| 1346 | CAS A IF A = F, GO TO C3M (B) |
| 1347 | JMP *+2 |
| 1348 | JMP C3M ELSE, |
| 1349 | STA A A = I |
| 1350 | IMA C3T2 |
| 1351 | STA F |
| 1352 | CRA T1 = 0 |
| 1353 | STA C3T1 |
| 1354 | JST FA00 FETCH ASSIGNS |
| 1355 | JST SAF |
| 1356 | JMP C3H2 GO TO C3H2 |
| 1357 | C3P LDA A |
| 1358 | STA F |
| 1359 | JMP C3H |
| 1360 | * |
| 1361 | * |
| 1362 | * *********************** |
| 1363 | * *ASSIGN SPECIFICATIONS* |
| 1364 | * *********************** |
| 1365 | * NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER |
| 1366 | * COMMON BLOCKS ARE OUTPUT (WITH SIZE). |
| 1367 | C4T0 PZE 0 |
| 1368 | C4T1 PZE 0 |
| 1369 | C4B STA A A = 0 |
| 1370 | C4C LDA A |
| 1371 | ADD K105 I = A = A+5 |
| 1372 | STA A |
| 1373 | STA F |
| 1374 | CAS ABAR |
| 1375 | JMP NP35 RETURN TO FIRST NON-SPEC CHECK (POINT 1) |
| 1376 | NOP |
| 1377 | JST FA00 ELSE, FETCH ASSIGN |
| 1378 | LDA AT |
| 1379 | SUB K102 IF AT = STR-ABS |
| 1380 | SZE IU=VAR, OR ARR, AND |
| 1381 | JMP C4C NT = 0 |
| 1382 | LDA IU GO TO C4E |
| 1383 | SUB K102 ELSE, GO TO C4C |
| 1384 | SPL |
| 1385 | JMP C4C |
| 1386 | LDA NT |
| 1387 | SZE |
| 1388 | JMP C4C |
| 1389 | C4E CRA |
| 1390 | STA C4T0 T0 = 0. T1 =-MAX |
| 1391 | SUB K111 |
| 1392 | STA C4T1 |
| 1393 | JST KT00 SET D(0) = NO. OF WORDS PER ITEM |
| 1394 | C4F JST SAF |
| 1395 | CAS C4T0 |
| 1396 | STA C4T0 |
| 1397 | NOP |
| 1398 | LDA D0 |
| 1399 | SUB AF (A) = D(0) - AF |
| 1400 | CAS C4T1 |
| 1401 | STA C4T1 |
| 1402 | NOP |
| 1403 | JST FL00 FETCH LINK ( (A)=A - F ) |
| 1404 | SZE |
| 1405 | JMP C4F GO TO C4F |
| 1406 | LDA RPL |
| 1407 | ADD C4T0 RPL * RPL + T0 + TL |
| 1408 | STA C4T0 |
| 1409 | ADD C4T1 TO = RPL-T1 |
| 1410 | STA RPL |
| 1411 | C4I JST SAF |
| 1412 | LDA K101 |
| 1413 | IAB (B) = REL |
| 1414 | LDA C4T0 (A) = TO-AF |
| 1415 | SUB AF |
| 1416 | JST AF00 DEFIME AFT |
| 1417 | JST FL00 FETCH LINK |
| 1418 | SZE IF (A) NOT ZERO, |
| 1419 | JMP C4I NOT END OF EQUIVALENCE GROUP |
| 1420 | JMP C4C CHECK NEXT ITEM IN ASSIGNMENI TABLE |
| 1421 | * |
| 1422 | C4L2 LDA FLT1 = LINK LOCATION TO COMMON BLOCK NAME |
| 1423 | STA C4T1 |
| 1424 | C4L3 LDA A |
| 1425 | STA I SAVE A FOR LATER MODIFICATION |
| 1426 | JST FL00 FETCH LINK |
| 1427 | SNZ |
| 1428 | JMP C4M END OF COMMON GROUP |
| 1429 | JST STXI SET INDEX TO POINT TO CURRENT ITEM IN |
| 1430 | * COMMON GROUP. |
| 1431 | LDA DP,1 SET CL FIELD TO POINT AT COMMON BLOCK |
| 1432 | * NAME. |
| 1433 | ANA K119 ( = '177000) |
| 1434 | ADD C4T1 (= LINK LOCATION OF COMMON BLOCK NAME) |
| 1435 | STA DP,1 |
| 1436 | JMP C4L3 PROCESS NEXT ITEM IN COMMON BLOCK |
| 1437 | * |
| 1438 | C4 LDA CFL LOC, OF FIRST (BLANK) COMMON BLOCK |
| 1439 | STA F |
| 1440 | C4L6 STA A |
| 1441 | CRA |
| 1442 | STA C4T0 |
| 1443 | C4L JST FL00 FETCH LINK |
| 1444 | SNZ |
| 1445 | JMP C4L2 NO MORE ITEMS IN COMMON BLOCK |
| 1446 | LDA D0 ELSE, IF TO .LT. DO+AF, |
| 1447 | ADD AF |
| 1448 | CAS C4T0 T0 = D0 + AF |
| 1449 | STA C4T0 |
| 1450 | NOP |
| 1451 | JMP C4L GO TO C4L |
| 1452 | C4M LDA AF |
| 1453 | STA F I=AF |
| 1454 | LDA C4T0 (A) = T0 |
| 1455 | JST DA00 DEFINE AF |
| 1456 | * OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER |
| 1457 | LDA AF LENGTH OF COMMON BLOCK |
| 1458 | ANA K111 ='37777 |
| 1459 | ADD K122 ='40000 (S/C CODE = 1) |
| 1460 | JST ON00 OUTPUT NAME BLOCK TO LOADER |
| 1461 | LDA F |
| 1462 | SUB CFL IF I = CFL |
| 1463 | SNZ |
| 1464 | JMP C4B |
| 1465 | LDA F |
| 1466 | JMP C4L6 |
| 1467 | * |
| 1468 | SAF DAC ** |
| 1469 | LDA AF |
| 1470 | LGL 2 |
| 1471 | ARS 2 |
| 1472 | STA AF |
| 1473 | JMP* SAF |
| 1474 | * |
| 1475 | * ************************** |
| 1476 | * *DATA STATEMENT PROCESSOR* |
| 1477 | * ************************** |
| 1478 | * PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS |
| 1479 | * TO APPROPRIATE LOCATIONS. MODES MUST AGREE |
| 1480 | T0W4 PZE 0 |
| 1481 | T1W4 PZE 0 |
| 1482 | G PZE 0 LOWEST INDEX POINT IN LIST |
| 1483 | W4 LDA L0 |
| 1484 | STA I I=END OF DATA POOL |
| 1485 | W4B JST IL00 INPUT LIST ELEMENT |
| 1486 | LDA AT D (0) = =WDS/ITEM |
| 1487 | SUB K102 |
| 1488 | SNZ IF AT = 'STR-ABS' |
| 1489 | JMP W4T GO TO |
| 1490 | LDA I |
| 1491 | STA 0 |
| 1492 | LDA S1 S1 * DEFLECTION IF AN ARRAY |
| 1493 | ADD AF |
| 1494 | STA DP,1 DP(E) = AF + S1 |
| 1495 | W4C LDA A |
| 1496 | STA DP-1,1 DP (E-1) = A |
| 1497 | LDA I |
| 1498 | SUB K102 |
| 1499 | STA I |
| 1500 | STA G |
| 1501 | LDA TC IF TC = , |
| 1502 | SUB K134 |
| 1503 | SNZ |
| 1504 | JMP W4B GO TO W4B |
| 1505 | LDA K104 |
| 1506 | JST TS00 TEST FOR SLASH TERMINATOR |
| 1507 | LDA RPL |
| 1508 | STA T1W4 |
| 1509 | LDA L0 |
| 1510 | STA I I= END OF DATA POOL |
| 1511 | W4E CRA |
| 1512 | STA KPRM K' = KBAR = 0 |
| 1513 | STA KBAR |
| 1514 | W4F JST DN00 INPUT, DNA |
| 1515 | LDA NT |
| 1516 | SZE IF NT = 0 |
| 1517 | JMP W4G VARIABLE OR ARRAY |
| 1518 | LDA TC LAST CHARACTER |
| 1519 | CAS K17 ='250 ( =( ) |
| 1520 | JMP *+2 |
| 1521 | JMP *+3 START OF COMPLEX CONSTANT |
| 1522 | JST ER00 ERROR |
| 1523 | BCI 1,CN NON-CON DATA |
| 1524 | STA SXF SET SXF TO NON-ZERO |
| 1525 | JMP W4F FINISH INPUT OF COMPLEX CONSTANT |
| 1526 | W4G LDA KBAR MULTIPLY COUNT |
| 1527 | SZE |
| 1528 | JMP W4K GO TO W4K |
| 1529 | LDA TC IF TC NOT * |
| 1530 | SUB K103 |
| 1531 | SZE |
| 1532 | JMP W4L |
| 1533 | LDA ID |
| 1534 | SUB K101 |
| 1535 | STA KBAR KBAR = ID-1 |
| 1536 | JST IT00 INTEGER TEST |
| 1537 | JMP W4F |
| 1538 | W4K LDA KPRM IF K NOT ZERO |
| 1539 | SZE |
| 1540 | JMP W4M GO TO W4M |
| 1541 | W4L LDA KBAR |
| 1542 | ALS 1 K ' = E-3* KBAR |
| 1543 | TCA |
| 1544 | ADD I |
| 1545 | STA KPRM |
| 1546 | W4M JST STXI SET INDEX = I |
| 1547 | LDA DP-1,1 |
| 1548 | STA A A = DP (E-1) |
| 1549 | LDA IM |
| 1550 | STA T0W4 TO = IM |
| 1551 | JST FA00 |
| 1552 | LDA BDF IF BDF NOT ZERO |
| 1553 | SZE |
| 1554 | JMP W4S GO TO W4S |
| 1555 | JST NM00 NON-COMMON TEST |
| 1556 | W4O JST STXI SET INDEX = I |
| 1557 | LDA DP,1 |
| 1558 | STA RPL RPL = AF |
| 1559 | JST FS00 FLUSH |
| 1560 | CRA |
| 1561 | STA DF DF = 0 |
| 1562 | LDA HOLF IS IT HOLLERITH DATA |
| 1563 | SZE NO |
| 1564 | JMP WHOW YES, GO TO OUTPUT IT |
| 1565 | LDA D0 |
| 1566 | STA 0 |
| 1567 | JMP *,1 SWITCH ON NUMBER OF WORDS TO OUTPUT |
| 1568 | JMP W405 |
| 1569 | JMP W403 |
| 1570 | JMP W404 |
| 1571 | LDA TID+2 |
| 1572 | JST OA00 |
| 1573 | LDA TID+1 |
| 1574 | JST OA00 |
| 1575 | LDA TIDB+2 |
| 1576 | JST OA00 |
| 1577 | LDA TIDB+1 |
| 1578 | JMP W406 |
| 1579 | * |
| 1580 | * TAPE 4 OF 5 - END |
| 1581 | MOR |