| 1 | * C210-001-6601 (FRTN) 3C NO.180463000 REV. D |
| 2 | * |
| 3 | * |
| 4 | * |
| 5 | * COMPUTER. DDP-116,516 |
| 6 | * |
| 7 | * |
| 8 | * |
| 9 | * |
| 10 | * PROGRAM CATEGORY- COMPILER |
| 11 | * |
| 12 | * |
| 13 | * |
| 14 | * |
| 15 | * PROGRAM TITLE. FRTN |
| 16 | * EXPANDED FORTRAN IV COMPILER |
| 17 | * FOR DDP-116,516 |
| 18 | * |
| 19 | * |
| 20 | * |
| 21 | * |
| 22 | * |
| 23 | * |
| 24 | * |
| 25 | * APPROVAL DATE |
| 26 | * |
| 27 | * |
| 28 | * PROG--------------------- ------------ |
| 29 | * |
| 30 | * |
| 31 | * SUPR---------------------- ------------ |
| 32 | * |
| 33 | * |
| 34 | * QUAL---------------------- ------------ |
| 35 | * |
| 36 | * |
| 37 | * NO. OF PAGES ------------ |
| 38 | * |
| 39 | * REVISIONS |
| 40 | * |
| 41 | * REV. D ECO 5249 |
| 42 | * REV. C ECO 3824 10-31-66 |
| 43 | * REV. B ECO 3476 09-19-66 |
| 44 | * REV. A 06-08-66 |
| 45 | * |
| 46 | * AUTHOR |
| 47 | * |
| 48 | * HONEYWELL. INC. - COMPUTER CONTROL DIVISION |
| 49 | * |
| 50 | * |
| 51 | * PURPOSE |
| 52 | * |
| 53 | * THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV |
| 54 | * PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE |
| 55 | * DDP-116 OR DDP-516. |
| 56 | * |
| 57 | * |
| 58 | * RESTRICTIONS |
| 59 | * |
| 60 | * MINIMUM 8K CORE STORAGE |
| 61 | * |
| 62 | * |
| 63 | * STORAGE |
| 64 | * |
| 65 | * 6682 (DECIMAL) |
| 66 | * 15034 (OCTAL) |
| 67 | * |
| 68 | * |
| 69 | * USE |
| 70 | * |
| 71 | * |
| 72 | * ******************************** |
| 73 | * |
| 74 | * *FORTRAN-IV OPERATING PROCEDURE* |
| 75 | * ******************************** |
| 76 | * |
| 77 | * 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE' |
| 78 | * (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES |
| 79 | * |
| 80 | * 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE |
| 81 | * SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE |
| 82 | * SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START. |
| 83 | * |
| 84 | * 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY)..... |
| 85 | * 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS |
| 86 | * OPTION IS USED WHEN COMPILING THOSE PARTS OF THE |
| 87 | * LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE |
| 88 | * LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO |
| 89 | * GENERATE SPECIAL CODING. |
| 90 | * |
| 91 | * 2-7....NOT ASSIGNED |
| 92 | * |
| 93 | * 8-10...INPUT DEVICE SELECTION |
| 94 | * 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER) |
| 95 | * 2 = NCR CARD READER |
| 96 | * 3 = DIGITRONICS PAPER TAPE READER |
| 97 | * 4 = MAGNETIC TAPE ( UNIT 1 ) |
| 98 | * 5-7 = (SPARES) |
| 99 | * |
| 100 | * 11-13..SYMBOLIC LISTING SELECTION |
| 101 | * 0. SUPPRESS ALL SYMBOLIC LISTINGS |
| 102 | * 1. ASR-33/35 TYPEWRITER |
| 103 | * 2. LINE PRINTER |
| 104 | * 3 = ( SPARE ) |
| 105 | * 4 = LISTING ON MAGNETIC TAPE UNIT 2 |
| 106 | * 5-7 = (SPARES) |
| 107 | * |
| 108 | * 14-16..BINARY OUTPUT SELECTION |
| 109 | * 0. SUPPRESS BINARY OUTPUT. |
| 110 | * 1. BRPE HIGH SPEED PAPER TAPE PUNCH |
| 111 | * 2. ASR BINARY OUTPUT ASR/33 |
| 112 | * 3. ASR BINARY OUTPUT ASR/35 |
| 113 | * 4 = MAGNETIC TAPE OUTPUT |
| 114 | * 5-7 (SPARES) |
| 115 | * |
| 116 | * |
| 117 | * 4. SENSE SWITCH SETTINGS AND MEANINGS....... |
| 118 | * 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE |
| 119 | * SIDE-BY-SIDE OCTAL INFORMATION. |
| 120 | * 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET). |
| 121 | * 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING |
| 122 | * THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT |
| 123 | * STATUS OF THE I/O KEYBOARD, IT MAY BE |
| 124 | * CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING |
| 125 | * SSW-3 AND PRESSING START TO CONTINUE. |
| 126 | * 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED |
| 127 | * IN THE OBJECT CODING BEING GENERATED REGARDLESS OF |
| 128 | * ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR |
| 129 | * OVERRIDE). |
| 130 | * |
| 131 | * 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER |
| 132 | * AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A |
| 133 | * LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF |
| 134 | * TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE |
| 135 | * PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START' |
| 136 | * TO PROCESS THE NEXT PROGRAM (BATCH COMPILING). |
| 137 | * |
| 138 | * FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS |
| 139 | * PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT |
| 140 | * THE COMPILATION. |
| 141 | * |
| 142 | * |
| 143 | * ERRORS |
| 144 | * |
| 145 | * THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A |
| 146 | * SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION. |
| 147 | * ************************* |
| 148 | * *DATA POOL ENTRY FORMATS* |
| 149 | * ************************* |
| 150 | * |
| 151 | * THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION |
| 152 | * 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS |
| 153 | * AT THE END OF THE COMPILER AND EXTENDS TOWARD THE |
| 154 | * END OF MEMORY. |
| 155 | * |
| 156 | * TDCCCCCCCCCCCCCC....DP(A+4) |
| 157 | * CCCCCCCCCCCCCCCC....DP(A+3) |
| 158 | * CCCCCCCCCCCCCCCC....DP(A+2) |
| 159 | * IIAAAAAAAAAAAAAA....DP(A+1) |
| 160 | * NRRRMMMLLLLLLLLL....DP(A) |
| 161 | * |
| 162 | * T = TRACE TAG |
| 163 | * D = DATA TAG |
| 164 | * C = SIX 8-BIT CHAR. OR BINARY CONSTANT |
| 165 | * I = ITEM USAGE (IU) |
| 166 | * 0 = NO USAGE 2 = VAR/CONSTAN^ |
| 167 | * 1 = SUBPROGRAM 3 = ARRAY |
| 168 | * A = ASSIGNMENT ADDRESS |
| 169 | * N = NAME TAG (NT) |
| 170 | * 0 = NAME 1 = CONSTANT |
| 171 | * R = ADDRESS TYPE (AT) |
| 172 | * 0 = ABSOLUTE 3 = STRING-REL |
| 173 | * 1 = RELATIVE 4 = COMMON |
| 174 | * 2 = STRING-ABS 5 = DUMMT |
| 175 | * M = ITEM MODE (IM) |
| 176 | * 1 = INTEGER 5 = COMPLEX |
| 177 | * 2 = REAL 6 = DOUBLE |
| 178 | * 3 = LOGICAL |
| 179 | * 4=COM/EQU LINK |
| 180 | * 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT |
| 181 | * TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT |
| 182 | * A DO-LOOP, EACH ENTRY IS 5 WORDS. |
| 183 | * 00IIIIIIIIIIIIII |
| 184 | * 00TTTITTTTTTTTTT |
| 185 | * 00XXXXXXXXXXXXXX |
| 186 | * 00UUUUUUUUUUUUUU |
| 187 | * 00NNNNNNNNNNNNNN |
| 188 | * I = INITIAL VALUE/OR RPL |
| 189 | * T = TERMINAL VALUE |
| 190 | * X = INDEX |
| 191 | * U = INCREMENT |
| 192 | * N = STATEMENT NUMBER |
| 193 | * |
| 194 | * 3. THE EXPRESSION TABLE (AOI TABLE) 'FLOATS' ON TOP |
| 195 | * THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES. |
| 196 | * |
| 197 | * NOOOOOO00IIIIIII.....DP(I+1) |
| 198 | * 00AAAAAAAAAAAAAAAA...DP(I) |
| 199 | * N = NEGATION INDICATOR |
| 200 | * O = OPERATOR |
| 201 | * I = INDEX (OPERATOR LEVEL) |
| 202 | * A = ASSIGNMENT TABLE REFERENCE |
| 203 | * 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND |
| 204 | * IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE |
| 205 | * COMPILER. EACH ENTRY IS THREE WORDS LONG. |
| 206 | * |
| 207 | * S000000000PPPPPP.....DP(L+2) |
| 208 | * 0011111111111111.....DP(L+1) |
| 209 | * 0022222222222222.....DP(L) |
| 210 | * S = TEMP STORAGE INDICATOR |
| 211 | * P = OPERATOR |
| 212 | * 1 = FIRST OPERAND ADDRESS |
| 213 | * 2 = SECOND OPERAND ADDRESS |
| 214 | ABS |
| 215 | ORG '100 |
| 216 | * |
| 217 | * ************************************ |
| 218 | * * DIRECTORY OF FORTRAN IV COMPILER * |
| 219 | * ************************************ |
| 220 | * |
| 221 | * |
| 222 | * |
| 223 | *..............ENTRANCE GROUP |
| 224 | DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE |
| 225 | DAC DP DATA POOL START |
| 226 | * |
| 227 | *..............INPUT GROUP |
| 228 | DAC IC00 (IPG1) INPUT COLUMN |
| 229 | DAC UC00 (IPG2) UNINPUT COLUMN |
| 230 | DAC CH00 (IPG3) INPUT CHARACTER |
| 231 | DAC ID00 (IPG4) INPUT DIGIT |
| 232 | DAC IA00 (IPG5) INPUT (A) CHARACTERS |
| 233 | DAC FN00 (IPG6) FINISH OPERATOR |
| 234 | DAC DN00 (IPG7) INPUT DNA |
| 235 | DAC II00 (IPG8) INPUT ITEM |
| 236 | DAC OP00 (IPG9) INPUT OPERAND |
| 237 | DAC NA00 (IPG10) INPUT NAME |
| 238 | DAC IG00 (IPG11) INPUT INTEGER |
| 239 | DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT |
| 240 | DAC IR00 (IPG13) INPUT INTEGER VARIABLE |
| 241 | DAC IS00 (IPG14) INPUT STATEMENT NUMBER |
| 242 | DAC XN00 (IPG15) EXAMINE NEXT CHARACTER |
| 243 | DAC SY00 INPUT STMBOL |
| 244 | * |
| 245 | *..............TEST GROUP |
| 246 | DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R) |
| 247 | DAC IP00 (TSG2) )-INPUT OPERATOR |
| 248 | DAC A1 (TSG3) C/R TEST |
| 249 | DAC B1 (TSG4) , OR C/R TEST |
| 250 | DAC NU00 (TSG5) NO USAGE TEST |
| 251 | DAC NC00 (TSG6) NON CONSTANT TEST |
| 252 | DAC NS00 (TSG7) NON SUBPROGRAM TEST |
| 253 | DAC AT00 (TSG8) ARRAY TEST |
| 254 | DAC IT00 (TSG9) INTEGER TEST |
| 255 | DAC NR00 (TSG10) NON REL TEST |
| 256 | * |
| 257 | *..............ASSIGNMENT GROUP |
| 258 | DAC AS00 (ASG1) ASSIGN ITEM |
| 259 | DAC TG00 (ASG2) TAG SUBPROGRAM |
| 260 | DAC TV00 (ASG3) TAG VARIABLE |
| 261 | DAC FA00 (ASG4) FETCH ASSIGN |
| 262 | DAC FL00 (ASG5) FETCH LINK |
| 263 | DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION |
| 264 | DAC DM00 (ASG7) DEFINE IM |
| 265 | DAC DA00 (ASG8) DEFINE AF |
| 266 | DAC AF00 (ASG9) DEFINE AFT |
| 267 | DAC LO00 (ASG10) DEFINE LOCATION |
| 268 | DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT |
| 269 | DAC AA00 (ASG12) ASSIGN SPECIAL |
| 270 | DAC NXT GET NEXT ENTRY FROM ASSGN TABLE |
| 271 | DAC BUD BUILD ASSIGNMENT TABLE ENTRT |
| 272 | * |
| 273 | *..............CONTROL GROUP |
| 274 | DAC B6 (CNG1) JUMP |
| 275 | DAC C5 ILL TERM |
| 276 | DAC C6 (CNG2) CONTINUE |
| 277 | DAC C7 (CNG3) STATEMENT INPUT |
| 278 | DAC C8 (CNG4) STATEMENT SCAN |
| 279 | DAC A9 (CNG5) STATEMENT IDENTIFICATION |
| 280 | DAC NP00 (CNG6) FIRST NON-SPEC CHECK |
| 281 | * |
| 282 | *..............SPECIFICATIONS GROUP |
| 283 | DAC EL00 (SPG1) EXCHANGE LINKS |
| 284 | DAC NM00 (SPG2) NON COMM0N TEST |
| 285 | DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST |
| 286 | DAC SC00 (SPG4) INPUT SUBSCRIPT |
| 287 | DAC IL00 (SPG5) INPUT LIST ELEMENT |
| 288 | DAC R1 (SPG6) FUNCTION |
| 289 | DAC R2 SUBROUTINE |
| 290 | DAC A3 (SPG7) INTEGER |
| 291 | DAC A4 REAL |
| 292 | DAC A5 DOUBLE PRECISION |
| 293 | DAC A6 COMPLEX |
| 294 | DAC A7 LOGICAL |
| 295 | DAC B2 (SPG8) EXTERNAL |
| 296 | DAC B3 (SPG9) DIMENSION |
| 297 | DAC B7 INPUT DIMENSION |
| 298 | DAC B4 (SPG10) COMMON |
| 299 | DAC B5 (SPG11) EQUIVALENCE |
| 300 | DAC C2 (SPG12) RELATE COMMON ITEMS |
| 301 | DAC C3 (SPG13) GROUP EOUIVALENCE |
| 302 | DAC C4 (SPG14) ASSIGN SPECIFICATIONS |
| 303 | DAC W4 (SPG15) DATA |
| 304 | DAC R3 (SPG16) BLOCK DATA |
| 305 | DAC TRAC (SPG17) TRACE |
| 306 | * |
| 307 | *..............PROCESSOR GROUP |
| 308 | DAC V3 (PRG1) IF |
| 309 | DAC R7 (PRG2) GO TO |
| 310 | DAC IB00 INPUT BRANCH LIST |
| 311 | DAC W3 (PRG3) ASSIGN |
| 312 | DAC C9 (PRG5) DO |
| 313 | DAC V7 (PRG6) END FILE |
| 314 | DAC V6 BACKSPACE |
| 315 | DAC V8 REWIND |
| 316 | DAC V5 (PRG7) READ |
| 317 | DAC V4 WRITE |
| 318 | DAC V2 (PRG8) FORMAT |
| 319 | DAC SI00 INPUT FORMAT STRING |
| 320 | DAC IN00 INPUT NUMERIC FORMAT STRING |
| 321 | DAC NZ00 NON ZERO STRING TEST |
| 322 | DAC W8 (PRG9) PAUSE |
| 323 | DAC W7 STOP |
| 324 | DAC R8 (PRG10) CALL |
| 325 | DAC G2 ASSIGNMENT STATEMENT |
| 326 | DAC R9 (PRG11) RETURN |
| 327 | DAC G1 (PRG12) STATEMENT FUNCTION |
| 328 | DAC W5 (PRG13) END |
| 329 | * |
| 330 | *..............PROCESSOR SUBROUTINES GROUP |
| 331 | DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK |
| 332 | DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING |
| 333 | DAC DP00 (PSG3) DO INPUT |
| 334 | DAC DS00 (PSG4) DO INITIALIZE |
| 335 | DAC DQ00 (PSG5) DO TERMINATION |
| 336 | DAC EX00 (PSG6) EXPRESSION |
| 337 | DAC CA00 (PSG7) SCAN |
| 338 | DAC ST00 TRIAD SEARCH |
| 339 | DAC TC00 TEMP STORE CHECK |
| 340 | DAC ET00 (PSG8) ENTER TRIAD |
| 341 | DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE |
| 342 | * |
| 343 | *..............OUTPUT GROUP |
| 344 | DAC OL00 (OPG1) OUTPUT OBJECT LINK |
| 345 | DAC OI00 (OPG2) OUTPUT I/O LINK |
| 346 | DAC CN00 (OPG3) CALL NAME |
| 347 | DAC OK00 (OPG4) OUTPUT PACK |
| 348 | DAC OB00 (OPG5) OUTPUT OA |
| 349 | DAC OT00 (OPG6) OUTPUT TRIADS |
| 350 | DAC OM00 (OPG7) OUTPUT ITEM |
| 351 | DAC OR00 (OPG8) OUTPUT REL |
| 352 | DAC OA00 OUTPUT ABS |
| 353 | DAC OS00 OUTPUT STRING |
| 354 | DAC OW00 (OPG9) OUTPUT WORD |
| 355 | DAC PU00 PICKUP |
| 356 | DAC FS00 (OPG10) FLUSH |
| 357 | DAC TRSE (OPG11) OUTPUT TRACE COUPLING |
| 358 | DAC PRSP SET BUFFER TO SPACES |
| 359 | * |
| 360 | *..............MISC. GROUP |
| 361 | DAC AD3 ADD TWO 3 WORD INTEGERS |
| 362 | DAC IM00 MULTIPLY (A) BY (B) |
| 363 | DAC STXA SET A INTO INDEX |
| 364 | DAC STXI SET I INTO INDEX |
| 365 | DAC NF00 SET FS INTO NAMF |
| 366 | DAC BLNK SET AREA TO ZEROS |
| 367 | DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE |
| 368 | DAC CIB COMPARE IBUF TO A CONSTANT |
| 369 | DAC SAV SAVE INDEX IN PUSH-DOWN STACK |
| 370 | DAC RST RESET INDEX FROM PUSH-DOWN STACK |
| 371 | DAC PACK |
| 372 | DAC ER00 ERROR OUTPUT |
| 373 | DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.) |
| 374 | DAC SFT SHIFT LEFT 1 (TRIPLE PRES.) |
| 375 | DAC LIST |
| 376 | * |
| 377 | * |
| 378 | * **************************** |
| 379 | * *CONSTANT AND VARIABLE POOL* |
| 380 | * **************************** |
| 381 | * |
| 382 | XR EQU 0 INDEX REGISTER |
| 383 | * THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING |
| 384 | * PROGRAM INITIALIZATION |
| 385 | A EQU '40 ASSIGNMENT TABLE INDEX |
| 386 | I EQU A+1 EXPRESSION TABLE INDEX |
| 387 | C EQU A+2 |
| 388 | ASAV EQU A+3 |
| 389 | L EQU A+4 |
| 390 | MFL EQU A+5 MODE FLAG |
| 391 | SFF EQU A+6 FUNCTION FLAG |
| 392 | SBF EQU A+7 SUBFUNCTION FLAG |
| 393 | SXF EQU A+8 POSSIBLE CPX FLAG |
| 394 | SPF EQU A+9 PEC. FLAG |
| 395 | TCF EQU A+10 TEMP STORE COUNT |
| 396 | IFF EQU A+11 |
| 397 | ABAR EQU A+12 BASE OF ASSIGN TABLE |
| 398 | XST EQU A+13 FIRST EXECUTABLE STMNT. |
| 399 | CFL EQU A+14 MON FLAG |
| 400 | D EQU A+15 DO INDEX |
| 401 | RPL EQU A+16 RELATE PROGRAM LOCATION |
| 402 | BDF EQU A+17 LOCK DATA FLAG |
| 403 | SLST EQU A+18 SOURCE LIST |
| 404 | OBLS EQU A+19 OUTPUT BINARY LIST |
| 405 | BNOT EQU A+20 BINART OUTPUT FLAG |
| 406 | TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.) |
| 407 | TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN |
| 408 | * AN EXPRESSION (FOR USE BY TRACE). |
| 409 | SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET) |
| 410 | LIF EQU A+24 LOGICAL IF FLAG |
| 411 | LSTN EQU A+25 LAST STATEMENT NO. |
| 412 | LSTF EQU A+26 LAST STATEMENT FLAG |
| 413 | LSTP EQU A+27 LAST STATEMENT STOP |
| 414 | SDSW EQU A+28 STATEMENT I0 SWITCH |
| 415 | * |
| 416 | NAMF EQU '570 NAME FUNCTION |
| 417 | ND EQU NAMF+1 NO OF DIMENSIONS |
| 418 | NS EQU '572 NO OF SUBSCRIPTS |
| 419 | NT EQU NS+1 NAME TAG |
| 420 | NTF EQU NS+2 NAME TAG FLAG |
| 421 | NTID EQU NS+3 NO. WORDS IN TID |
| 422 | O1 EQU NS+4 OPERATOR 1 |
| 423 | O2 EQU NS+5 OPERATOR 2 |
| 424 | P EQU NS+6 |
| 425 | PCNT EQU NS+7 |
| 426 | OCNT EQU NS+8 OUTPUT COUNT |
| 427 | S0 EQU NS+9 |
| 428 | S1 EQU NS+10 SUBSCRIPT NO.1 |
| 429 | S2 EQU NS+11 SUBSCRIPT NO.2 |
| 430 | S3 EQU NS+12 SUBSCRIPT NO.3 |
| 431 | TC EQU NS+13 TERMINAL CHAR |
| 432 | TT EQU NS+14 |
| 433 | TYPE EQU NS+15 |
| 434 | X EQU NS+16 ARRAY INDICES |
| 435 | X1 EQU NS+17 |
| 436 | X2 EQU NS+18 |
| 437 | X3 EQU NS+19 |
| 438 | X4 EQU NS+20 |
| 439 | NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS |
| 440 | ATA EQU NS+22 |
| 441 | IMA EQU NS+23 |
| 442 | CLA EQU NS+24 |
| 443 | IUA EQU NS+25 |
| 444 | DTA EQU NS+26 |
| 445 | TTA EQU NS+27 |
| 446 | *..........ADJUST THIS ORG IF THE SIZE OF THE CONSTANT POOL IS MODIFIED |
| 447 | ORG '630 |
| 448 | AF PZE 0 ADDRESS FIELD |
| 449 | GF EQU AF |
| 450 | AT PZE 0 ADDRESS TYPE |
| 451 | CODE PZE 0 OUTPUT CODE |
| 452 | D0 PZE 0 DIMENSIONS |
| 453 | D1 PZE 0 |
| 454 | D2 PZE 0 |
| 455 | D3 PZE 0 |
| 456 | D4 PZE 0 |
| 457 | DF PZE 0 DATA FLAG |
| 458 | NF PZE 0 |
| 459 | B PZE 0 |
| 460 | DFL PZE 0 DELIMITER FLAG |
| 461 | E OCT 0 EQUIVALENCE INDEX |
| 462 | EP PZE 0 E-PRIME |
| 463 | E0 PZE 0 E-ZERO |
| 464 | FTOP PZE 0 OUTPUT COMMAND |
| 465 | GFA PZE 0 |
| 466 | ICSW PZE 1 INPUT CONTROL SWITCH |
| 467 | IFLG PZE 0 I-FLAG |
| 468 | IM PZE 0 ITEM MODE |
| 469 | IOF PZE 0 I-0 FLAG |
| 470 | IU PZE 0 ITEM USAGE |
| 471 | KBAR PZE 0 TEM STORE |
| 472 | KPRM PZE 0 TEM STORE |
| 473 | EBAR OCT -1 E-BAR |
| 474 | DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT) |
| 475 | CC PZE '111 CARD COLUMN COUNTER |
| 476 | DCT PZE 0 DUMMY ARGUMENT COUNT |
| 477 | F PZE 0 TRIAD TABLE INDEX |
| 478 | CL PZE 0 ASSIGNMENT ITEMS UNPACKED |
| 479 | DT PZE 0 |
| 480 | FLT1 PZE 0 FETCH LINK CL POINTER LOCATION |
| 481 | LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET) |
| 482 | *..........CONSTANTS USED BY THE COMPILER |
| 483 | K4 OCT 251 0) |
| 484 | K5 OCT 254 0, |
| 485 | K8 OCT 240 0-SPACE |
| 486 | K9 OCT 257 0/ |
| 487 | K10 OCT 256 0. |
| 488 | K12 OCT 255 0- |
| 489 | K13 OCT 253 0+ |
| 490 | K15 OCT 244 0$ |
| 491 | K16X OCT 16 |
| 492 | K17 OCT 250 0( |
| 493 | K18 OCT 275 0= |
| 494 | K19 BCI 1,DO DO |
| 495 | K34 OCT 324 0T |
| 496 | K35 OCT 317 0O |
| 497 | K40 BCI 1,WN |
| 498 | K41 BCI 1,RN RN |
| 499 | K42 BCI 1,CB |
| 500 | K43 OCT 311 0I |
| 501 | K44 OCT 321 0Q |
| 502 | K45 EQU K34 0T |
| 503 | K57 OCT 252 0* |
| 504 | K60 OCT 260 00 (BCI ZERO) |
| 505 | K61 OCT 271 09 |
| 506 | K68 EQU K19 |
| 507 | K101 OCT 1 |
| 508 | K102 OCT 2 |
| 509 | K103 OCT 3 |
| 510 | K104 OCT 4 |
| 511 | K105 OCT 5 |
| 512 | K106 OCT 6 |
| 513 | K107 OCT 7 |
| 514 | K109 DEC 16 |
| 515 | K100 OCT 377 |
| 516 | K111 OCT 37777 |
| 517 | K110 DEC -17 |
| 518 | K115 OCT 170777 |
| 519 | K116 OCT 177400 |
| 520 | K117 DEC -27 |
| 521 | K118 OCT 777 |
| 522 | K119 OCT 177000 |
| 523 | K120 DEC -15 |
| 524 | K122 OCT 040000 |
| 525 | K123 DEC -1 |
| 526 | K124 DEC 9 |
| 527 | K125 DEC 8 |
| 528 | K126 DEC 10 |
| 529 | K127 DEC 11 |
| 530 | K128 DEC 12 |
| 531 | K129 DEC 13 |
| 532 | K131 DEC -14 |
| 533 | K132 OCT 22 |
| 534 | K134 OCT 17 |
| 535 | K137 OCT 24002 |
| 536 | K138 OCT 25 |
| 537 | K139 OCT 24 |
| 538 | CRET OCT 215 0 C/R |
| 539 | ZERO OCT 0 |
| 540 | HBIT OCT 140000 HIGH BITS FOR ALPHA DATA |
| 541 | KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT |
| 542 | MIN2 DEC -2 -2 |
| 543 | HC2 OCT 340 |
| 544 | K357 OCT 357 |
| 545 | * |
| 546 | * |
| 547 | DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET |
| 548 | * BY THE FORTRAN IOS SUBROUTINE.) |
| 549 | L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS) |
| 550 | * THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER |
| 551 | * TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS |
| 552 | * 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL |
| 553 | * CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL |
| 554 | * LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER |
| 555 | * CONFIGURATION. |
| 556 | ORG '1000 |
| 557 | PZE DP-4,1 (100) |
| 558 | PZE DP-3,1 (101) DATA POOL REFERENCES |
| 559 | PZE DP-2,1 (102) |
| 560 | PZE DP-1,1 (103) |
| 561 | PZE DP,1 (104) |
| 562 | PZE DP+1,1 (105) |
| 563 | PZE DP+2,1 (106) |
| 564 | PZE DP+3,1 (107) |
| 565 | PZE DP+4,1 (108) |
| 566 | PZE DP+9,1 (111) |
| 567 | PZE DP+6,1 (112) |
| 568 | PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS |
| 569 | * |
| 570 | * |
| 571 | ORG 1 |
| 572 | JST ER00 THIS INSTRUCTION REACHED ONLY IF THE |
| 573 | BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE. |
| 574 | * |
| 575 | * |
| 576 | * |
| 577 | * |
| 578 | * ******************* |
| 579 | * *START OF COMPILER* |
| 580 | * ******************* |
| 581 | * |
| 582 | ORG '1000 |
| 583 | * |
| 584 | * |
| 585 | * |
| 586 | * - A0 COMP ENT EMPTY BUFFERS |
| 587 | LRL 15 |
| 588 | STA LIBF SET SPECIAL LIBRARY FLAG |
| 589 | LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS) |
| 590 | A0 CALL F4$INT INITIALIZE I/O DEVICES |
| 591 | LDA K108 |
| 592 | STA CC CC = 73 |
| 593 | JST IC00 INPUT COLUMN |
| 594 | A051 LDA A090 |
| 595 | STA XR |
| 596 | LDA A092 LOC. OF INDEX PUSH-DOWN BUFFER |
| 597 | STA SAV9 INITIALIZE PUSH-DOWN BUFR. |
| 598 | CRA |
| 599 | STA A+M,1 SET M VARIABLES TO ZERO |
| 600 | STA NAMF+M,1 |
| 601 | IRS XR |
| 602 | JMP *-3 |
| 603 | STA IFLG |
| 604 | STA PKF |
| 605 | JST FS00 INITIALIZE OUTPUT BUFFER |
| 606 | CMA |
| 607 | STA LSTF LSTF NOT EQ 0 |
| 608 | STA LSTP LSTP NOT EQ 0 |
| 609 | STA EBAR EBAR SET NEGATIVE |
| 610 | LDA L0 |
| 611 | STA ICSW |
| 612 | STA E0 INITIALIZE EQUIVALENCE TABLE |
| 613 | STA L INITIALIZE TRIAD TABLE POINTER |
| 614 | JST PRSP SET PRINT BUFFER TO SPACES |
| 615 | LDA K134 |
| 616 | STA DO INITIALIZE DO TABLE POINTER |
| 617 | SUB K138 |
| 618 | STA A091 |
| 619 | CRA |
| 620 | STA ID |
| 621 | A055 IRS ID ESTABLISH CONSTANTS |
| 622 | JST AI00 |
| 623 | IRS A091 |
| 624 | JMP A055 |
| 625 | LDA K81 |
| 626 | STA ID |
| 627 | STA ID+1 |
| 628 | STA ID+2 |
| 629 | CRA |
| 630 | LRL 32 (B)=0 IM=NO USAGE |
| 631 | LDA K101 (A)=1 IU=SUBR |
| 632 | JST AA00 ASSIGN (SPECIAL) |
| 633 | JST STXA SET POINTER A INTO INDEX AND (A) |
| 634 | STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK) |
| 635 | ADD K122 ='40000 (IU=SUBR) |
| 636 | STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFIED) |
| 637 | JMP C7 GO TO STMNT INPUT |
| 638 | M EQU 30 |
| 639 | A090 DAC* -M,1 |
| 640 | A091 PZE 0 |
| 641 | A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER |
| 642 | * |
| 643 | * |
| 644 | * |
| 645 | * ************** |
| 646 | * *INPUT COLUMN* |
| 647 | * ************** |
| 648 | * |
| 649 | * INPUT NEXT CHARACTER |
| 650 | * IGNORE BLANKS |
| 651 | * CHECK FOR COMMENTS |
| 652 | * IC02 SET AS FOLLOWS - |
| 653 | * NORMAL - ICIP |
| 654 | * INITIAL SCAN -ICSR |
| 655 | IC00 DAC ** LINK STORE |
| 656 | JST SAV SAVE INDEX |
| 657 | LDA CC IF CC = 73, GO TO IC 10 |
| 658 | SUB K108 |
| 659 | SZE |
| 660 | JMP IC19 ELSE, GO TO IC |
| 661 | IC10 LDA ICSW IF ICSW. GO TO IC12 |
| 662 | SNZ |
| 663 | JMP IC24 ELSE, GO TO IC24 |
| 664 | IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE |
| 665 | DAC CI |
| 666 | LDA CI |
| 667 | LGR 8 GO 70 IC 14 |
| 668 | CAS K16 =(C) |
| 669 | JMP *+2 |
| 670 | JMP IC30 COMMENT CARD (IGNORE) |
| 671 | SUB K15 =($) |
| 672 | SNZ |
| 673 | JMP IC18 CONTROL CARD (IGNORE COLUMN 6) |
| 674 | LDA K357 IF CARD COL, SIX IS |
| 675 | ANA CI+2 ZERO OR BLANK, GO TO IC18 |
| 676 | SUB K8 |
| 677 | SZE |
| 678 | JMP IC26 ELSE, GO TO IC26 |
| 679 | IC18 STA CC CC = 0. |
| 680 | LDA CI+2 CI(6) = SPECIAL |
| 681 | ANA K116 |
| 682 | ADD HC2 ='340 |
| 683 | STA CI+2 |
| 684 | LDA CRET |
| 685 | JMP IC20 TC = C.R. |
| 686 | IC19 LDA CC TC = CI(CC) |
| 687 | SUB K101 |
| 688 | LGR 1 |
| 689 | STA XR |
| 690 | LDA CI,1 |
| 691 | SSC |
| 692 | LGR 8 |
| 693 | ANA K100 |
| 694 | IC20 STA TC |
| 695 | IRS CC CC = CC+1 |
| 696 | IC22 JST RST RESTORE INDEX |
| 697 | JMP* IC00 RETURN |
| 698 | IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN |
| 699 | STA TC |
| 700 | JMP IC22 GO TO IC22 |
| 701 | IC26 JST LIST LIST, CONTINUATION CARD |
| 702 | LDA K107 CC = 7, IGNORE STATEMENT NO. |
| 703 | STA CC |
| 704 | JMP IC19 G0 TO IC19 |
| 705 | IC30 JST LIST PRINT CARD IMAGE |
| 706 | JMP IC12 READ IN NEW CARD |
| 707 | K16 OCT 303 0C |
| 708 | K108 DEC 73 |
| 709 | KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER |
| 710 | CI BSS 40 |
| 711 | BCI 20, |
| 712 | * |
| 713 | * |
| 714 | * |
| 715 | * **************** |
| 716 | * *UNINPUT COLUMN* |
| 717 | * **************** |
| 718 | * BACK UP ONE COLUMN |
| 719 | * |
| 720 | UC00 DAC ** |
| 721 | IMA CC CC= CC-1 |
| 722 | SUB K101 RETAIN (A) |
| 723 | IMA CC |
| 724 | JMP* UC00 |
| 725 | * |
| 726 | * |
| 727 | * ***************** |
| 728 | * *INPUT CHARACTER* |
| 729 | * ***************** |
| 730 | * INPUT ONE CHARACTER FROM EITHER |
| 731 | * 1, INPUT BUFFER (EBAR POSITIVE) OR |
| 732 | * 2, EQUIVALENCE BUFFER (EBAR NEGATIVE) |
| 733 | * |
| 734 | CH00 DAC ** |
| 735 | LDA EBAR IF EBAR 7 0, |
| 736 | SMI |
| 737 | JMP CH10 G0 10 CH10 |
| 738 | CH03 JST IC00 INPUT COLUMN |
| 739 | SUB K8 IF BLANK, REPEAT |
| 740 | SNZ |
| 741 | JMP CH03 |
| 742 | LDA TC ELSE, |
| 743 | * |
| 744 | CH04 CAS CH13 ='301 |
| 745 | NOP |
| 746 | JMP CH06 |
| 747 | CAS K61 ='271 |
| 748 | JMP CH05 |
| 749 | NOP |
| 750 | CAS K15 ='244 |
| 751 | JMP *+2 |
| 752 | JMP CH05-1 |
| 753 | CAS K60 ='260 |
| 754 | NOP |
| 755 | CRA ALPHA NUMERIC CHARACTER |
| 756 | CH05 STA DFL DELIMITER ENTRY |
| 757 | LDA TC EXIT WITH TC IN A |
| 758 | JMP* CH00 |
| 759 | CH06 CAS K63 ='332 |
| 760 | JMP CH05 |
| 761 | NOP |
| 762 | JMP CH05-1 |
| 763 | CH08 STA DFL |
| 764 | JMP* CH00 |
| 765 | CH10 LDA E IF E = EBAR |
| 766 | CAS EBAR |
| 767 | JMP *+2 |
| 768 | JMP CH12 GO TO CH12 |
| 769 | STA 0 SET E INTO INDEX |
| 770 | LLL 16 SET (B) TO ZERO |
| 771 | LDA DP,1 CURRENT CHARACTER WORD |
| 772 | LLR 8 |
| 773 | STA DP,1 SAVE REMAINING CHARACTER IF ANY |
| 774 | IAB |
| 775 | STA TC TC=LEFTMOST CHARACTER |
| 776 | SZE SKIP IF NEW CHARACTER WORD NEEDED |
| 777 | JMP CH04 |
| 778 | LDA E E=E-1 |
| 779 | SUB K101 =1 |
| 780 | STA E |
| 781 | JMP CH10 PICK UP NEXT CHARACTER WORD |
| 782 | CH12 SSM MAKE E MINUS |
| 783 | STA EBAR |
| 784 | JMP C4 GO TO ASSIGN SPEC |
| 785 | K63 OCT 332 0Z |
| 786 | CH13 OCT 301 |
| 787 | * |
| 788 | * |
| 789 | * ************* |
| 790 | * *INPUT DIGIT* |
| 791 | * ************* |
| 792 | * A IS ZERO IF NOT DIGIT |
| 793 | * |
| 794 | ID00 DAC ** INPUT DIGIT |
| 795 | JST CH00 INPUT A CHAR |
| 796 | CAS K61 ='271 (9) |
| 797 | JMP* ID00 (A) = TC |
| 798 | JMP ID10 ELSE, (A) = 0 |
| 799 | CAS K60 RETURN |
| 800 | NOP |
| 801 | JMP *+2 |
| 802 | JMP* ID00 |
| 803 | ID10 CRA |
| 804 | JMP* ID00 |
| 805 | * |
| 806 | * |
| 807 | * ********************** |
| 808 | * *INPUT (A) CHARACTERS* |
| 809 | * ********************** |
| 810 | * CHAR COUNT IN XR, TERMINATES WITH EITHER |
| 811 | * 1, CHAR COUNT -1 = ZERO OR |
| 812 | * 2, LAST CHAR IS A DELIMITER |
| 813 | * |
| 814 | IA00 DAC ** |
| 815 | TCA SET COUNTER |
| 816 | STA IA99 |
| 817 | JST IA50 EXCHANGE IBUF AND ID |
| 818 | CRA |
| 819 | STA NTID NTID = 0 |
| 820 | IA10 JST CH00 INPUT A CHARACTER |
| 821 | JST PACK |
| 822 | LDA DFL IF DFL NOT ZERO, |
| 823 | SZE CONTINUE |
| 824 | JMP IA20 ELSE, |
| 825 | IRS IA99 TEST COUNTER |
| 826 | JMP IA10 MORE CHARACTERS TO INPUT |
| 827 | IA20 JST IA50 EXCHANGE ID AND IBUF |
| 828 | JMP* IA00 RETURN |
| 829 | IA50 DAC ** EXCHANGE IBUF AND ID |
| 830 | JST SAV SAVE INDEX |
| 831 | LDA IA90 |
| 832 | STA XR |
| 833 | LDA IBUF+3,1 |
| 834 | IMA ID+3,1 |
| 835 | STA IBUF+3,1 |
| 836 | IRS XR |
| 837 | JMP *-4 |
| 838 | JST RST RESTORE INDEX |
| 839 | LDA NTID |
| 840 | JMP* IA50 |
| 841 | IA90 OCT -3 |
| 842 | IA99 PZE 0 |
| 843 | * |
| 844 | * |
| 845 | * ***************** |
| 846 | * *FINISH OPERATOR* |
| 847 | * ***************** |
| 848 | * WRAP UP LOGICAL/RELATIONAL OPERATORS |
| 849 | * |
| 850 | FN00 DAC ** |
| 851 | LDA DFL IF DFL NOT . , |
| 852 | STA IBUF |
| 853 | SUB K10 |
| 854 | SZE |
| 855 | JMP FN05 GO TO FN05 |
| 856 | LDA K104 |
| 857 | JST IA00 |
| 858 | FN05 LDA K110 USE TABLE TO CONVERT |
| 859 | STA XR OPERATOR |
| 860 | FN10 LDA FN90+17,1 |
| 861 | CAS IBUF |
| 862 | JMP *+2 |
| 863 | JMP FN20 |
| 864 | IRS XR |
| 865 | JMP FN10 |
| 866 | LDA TC |
| 867 | JMP* FN00 |
| 868 | FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR |
| 869 | STA TC SET INTO TC |
| 870 | JMP* FN00 |
| 871 | FN90 OCT 253,255,252,257 +-*/ |
| 872 | BCI 9,NOANORLTLEEQGEGTNE |
| 873 | OCT 275,254 =, |
| 874 | FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17 |
| 875 | * |
| 876 | * |
| 877 | * *********** |
| 878 | * *INPUT DNA* |
| 879 | * *********** |
| 880 | * BASIC INPUT ROUTINE, HANDLES FOLLOWING - |
| 881 | * CONSTANT CONVERSION |
| 882 | * MODE TYPING (CONSTANTS, IMPLIED/VARIABLES) |
| 883 | * ALL OPERATORS (TERMINATE ITEM) |
| 884 | * |
| 885 | ID BSS 4 |
| 886 | TID EQU ID TEMP STORE FOR ID |
| 887 | IBUF BSS 3 3-WORD BUF |
| 888 | TIDN PZE 0 |
| 889 | K155 OCT 177727 -41 |
| 890 | K156 OCT 024000 1085 |
| 891 | K157 OCT 007777 |
| 892 | K158 OCT 074000 |
| 893 | F1 PZE 0 SIGN FLAG |
| 894 | F2 PZE 0 |
| 895 | F3 PZE 0 INPUT EXPONENT |
| 896 | F4 PZE 0 NO. FRAC. POSITIONS |
| 897 | F5 PZE 0 TEMP DELIMITER STORE |
| 898 | F6 PZE 0 |
| 899 | L4 PZE 0 |
| 900 | HOLF PZE 0 HOLLERITH FLAG |
| 901 | DN00 DAC ** |
| 902 | DN01 CRA |
| 903 | STA HOLF SET HOLF =0 |
| 904 | STA F4 F4 = 0 |
| 905 | STA IU |
| 906 | STA NT IU=NT=NTID=0 |
| 907 | STA NTID |
| 908 | JST BLNK CLEAR OUT TID = ID |
| 909 | DAC TID |
| 910 | JST BLNK |
| 911 | DAC F1 F1,F2,F3 = 0 |
| 912 | DN06 CRA |
| 913 | STA IM |
| 914 | STA DNX2 |
| 915 | DN07 JST ID00 INPUT DIGIT |
| 916 | SZE |
| 917 | JMP DN14 (A) NON-ZERO, G0 T0 DN14 |
| 918 | DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST |
| 919 | ANA K158 POSITION COUNT IF NECESSARY. |
| 920 | SZE |
| 921 | JMP SKIP |
| 922 | ADD IM |
| 923 | ARS 1 |
| 924 | ADD F4 F4 = F4+1 IF NO OVERFLOW |
| 925 | STA F4 AND IM ALREADY SET TO REAL |
| 926 | LDA K101 |
| 927 | STA NT NT=1 |
| 928 | ADD K101 |
| 929 | STA IU IU = VAR/COD |
| 930 | JST SFT SHIFT ID LEFT |
| 931 | DAC ID |
| 932 | JST MOV3 MOVE TO TEMP STORE |
| 933 | JST SFT |
| 934 | DAC ID |
| 935 | JST SFT |
| 936 | DAC ID |
| 937 | JST AD3 ID = 10*ID+TC |
| 938 | JST BLNK |
| 939 | DAC DNX1 |
| 940 | LDA TC |
| 941 | SUB K60 |
| 942 | STA DNX1 |
| 943 | JST AD3 |
| 944 | JMP DN07 |
| 945 | SKIP LDA MIN2 |
| 946 | ADD IM |
| 947 | ARS 1 |
| 948 | ADD F4 |
| 949 | STA F4 |
| 950 | JMP DN07 |
| 951 | DN14 LDA IM IM = REAL |
| 952 | SUB K102 |
| 953 | SZE |
| 954 | JMP DN50 NO. GO TO DN50 |
| 955 | DN16 LDA K10 YES. |
| 956 | DN17 STA F5 F5 = '.' |
| 957 | LDA DFL IF DFL =0, GO SO DN20 (5) |
| 958 | SZE |
| 959 | JMP DN90 ELSE GO TO DN90 (9) |
| 960 | DN20 LDA TC IF TC = D, GO TO DN26 |
| 961 | SUB K11 |
| 962 | SNZ |
| 963 | JMP DN26 |
| 964 | SUB K101 ELSE, IF TC = E, GO TO DN22 |
| 965 | SNZ |
| 966 | JMP DN22 TERMINATOR = E |
| 967 | JST UC00 |
| 968 | LDA K10 ='256 (.) |
| 969 | STA DFL SET DELIMITER FLAG |
| 970 | LDA K101 =1 |
| 971 | STA IM SET ITEM MODE TO INTEGER |
| 972 | JMP DN67 FINISH OPERATOR AND EXIT |
| 973 | * |
| 974 | DN22 JST ID00 INPUT DIGIT |
| 975 | SNZ IF (A) = 0, GO TO DN30 |
| 976 | JMP DN30 |
| 977 | LDA TC IF TC = -, GO TO DN28 |
| 978 | SUB K12 |
| 979 | SNZ |
| 980 | JMP DN28 |
| 981 | ADD K102 |
| 982 | SNZ |
| 983 | JMP DN29 |
| 984 | LDA F5 |
| 985 | STA DFL |
| 986 | JST UC00 UN-INPUT COL |
| 987 | DN24 JST FN00 FINISH OPERATOR |
| 988 | DN25 LDA K101 IM = INT |
| 989 | STA IM |
| 990 | LDA ID+1 IF ID IS TOO BIG TO |
| 991 | SZE BE AN INTEGER (>L2), |
| 992 | JMP DN69 GO TO DN69 (20) |
| 993 | LDA ID+2 |
| 994 | SZE |
| 995 | JMP DN69 |
| 996 | JMP DN84 OTHERWISE, GO TO DN84(12) |
| 997 | DN26 LDA K106 IM = DBL |
| 998 | STA IM |
| 999 | JMP DN22 |
| 1000 | DN28 LDA K101 F2 = 1 |
| 1001 | STA F2 |
| 1002 | DN29 JST ID00 INPUT DIGIT |
| 1003 | SZE IF (A) = 0, GO TO DN30 (8.5) |
| 1004 | JMP DN69 ELSE, GO TO DN69 (20) |
| 1005 | DN30 LDA F3 F3 = 10 * F3 |
| 1006 | ALS 3 |
| 1007 | IMA F3 F3 = F3 +TC |
| 1008 | ALS 1 |
| 1009 | ADD F3 |
| 1010 | ADD TC INPUT DIGIT |
| 1011 | SUB K60 |
| 1012 | STA F3 IF (A) = 0, GO TO DN30 (8.5) |
| 1013 | JST ID00 ELSE, GO TO DN90 (9) |
| 1014 | SZE |
| 1015 | JMP DN90 |
| 1016 | JMP DN30 |
| 1017 | DN50 LDA K102 IM=REA |
| 1018 | STA IM |
| 1019 | LDA TC IF TC = ., GO TO DN54 |
| 1020 | SUB K10 |
| 1021 | SNZ |
| 1022 | JMP DN54 ELSE, |
| 1023 | LDA NT |
| 1024 | SNZ IF NT = 0, GO TO DN72 |
| 1025 | JMP DN72 |
| 1026 | LDA TC IF TC = H, GO TO DN9H (22) |
| 1027 | SUB K14 |
| 1028 | SNZ |
| 1029 | JMP DN9H |
| 1030 | LDA DFL IF DFL = 0, |
| 1031 | SZE GO TO DN16 (4.9) |
| 1032 | JMP DN25 ELSE, GO TO DN25 |
| 1033 | JMP DN16 |
| 1034 | DN54 JST ID00 INPUT DIGIT |
| 1035 | SNZ |
| 1036 | JMP DN10 IF (A) = 0, GO TO DN10 (3) |
| 1037 | LDA NT |
| 1038 | SNZ IF NT = 0, GO TO DN56 |
| 1039 | JMP DN56 |
| 1040 | LDA TC F5 = TC |
| 1041 | JMP DN16 GO TO DN16 (4) |
| 1042 | DN56 CRA |
| 1043 | STA TC TC = ) |
| 1044 | DN58 JST UC00 UN-INPUT A COLUMN, |
| 1045 | LDA F1 IF F1 = 0, GO TO DN60 |
| 1046 | SZE |
| 1047 | JMP DN63 ELSE, GO TO DN63 (15) |
| 1048 | DN60 LDA K106 |
| 1049 | JST IA00 INPUT (6) CHARS |
| 1050 | JST CIB IF IBUF = TRUE., |
| 1051 | DAC K1+3,1 |
| 1052 | JMP DN64 |
| 1053 | JST CIB IF IBUF = FALSE., |
| 1054 | DAC K2+3,1 GO TO DN66 (16) |
| 1055 | JMP DN66 |
| 1056 | JST CIB CHECK FOR .NOT. OPERATOR |
| 1057 | DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR |
| 1058 | JMP DN9N OPERATOR IS .NOT. |
| 1059 | DN63 CRA IM = 0 |
| 1060 | STA IM |
| 1061 | JMP DN67 GO TO DN67 (18) |
| 1062 | DN64 LDA K101 |
| 1063 | STA TID |
| 1064 | DN66 LDA K101 |
| 1065 | STA NT NAME TAG = 1 (CONSTANT) |
| 1066 | LDA K102 IU=VAR |
| 1067 | STA IU |
| 1068 | LDA K103 |
| 1069 | STA IM IM = LOG |
| 1070 | JST CH00 |
| 1071 | DN67 JST FN00 FINISH OPERATOR |
| 1072 | DN68 LDA F6 IF F6 = 0, |
| 1073 | SNZ GO TO DN70 (21) |
| 1074 | JMP DN70 |
| 1075 | DN69 LDA K10 |
| 1076 | STA TC TC = . |
| 1077 | DN70 CRA |
| 1078 | STA F6 F6 = SXF = 0 |
| 1079 | STA SXF |
| 1080 | LDA IM (A) = IM |
| 1081 | JMP* DN00 RETURN |
| 1082 | DN72 LDA F1 IF F1 = 0, GO TO DN74 |
| 1083 | SNZ |
| 1084 | JMP DN74 |
| 1085 | LDA F1 ELSE, TC = F1 |
| 1086 | STA TC |
| 1087 | JMP DN58 GO TO DN58 (14) |
| 1088 | DN74 LDA TC IF TC = -, GO TO DN82 |
| 1089 | SUB K12 |
| 1090 | SNZ |
| 1091 | JMP DN82 |
| 1092 | ADD K102 CHECK FOR TC = + |
| 1093 | SNZ |
| 1094 | JMP DN82 |
| 1095 | LDA DFL IF DFL = NON-ZERO |
| 1096 | SZE |
| 1097 | JMP DN63 GO TO DN63 (15) |
| 1098 | LDA TC |
| 1099 | CAS K43 |
| 1100 | JMP *+3 |
| 1101 | JMP DN78 |
| 1102 | JMP DN80 |
| 1103 | CAS K62 |
| 1104 | JMP DN80 |
| 1105 | NOP |
| 1106 | DN78 LDA K101 IM = INT |
| 1107 | STA IM |
| 1108 | DN80 LDA TC PACK TC TO ID |
| 1109 | JST PACK |
| 1110 | JST CH00 INPUT CHAR |
| 1111 | LDA DFL IF DFL IS NOT ZERO, |
| 1112 | SZE GO TO DN67 (18) |
| 1113 | JMP DN67 |
| 1114 | LDA NTID IF NTID = 6, GO TO DN67 |
| 1115 | SUB K106 |
| 1116 | SZE |
| 1117 | JMP DN80 |
| 1118 | JMP DN67 |
| 1119 | DN82 JST FN00 |
| 1120 | STA F1 F1 = CONVERTED TC |
| 1121 | JMP DN06 GO TO DN06 (2) |
| 1122 | DN84 LDA F1 IF F1 = -, |
| 1123 | SUB K102 GO TO DN85(13) |
| 1124 | SZE |
| 1125 | JMP DN85 |
| 1126 | CRA |
| 1127 | SUB TID COMPLEMENT THREE WORDS AT TID |
| 1128 | SZE |
| 1129 | JMP DN8A |
| 1130 | SUB TID+1 |
| 1131 | SZE |
| 1132 | JMP DN8B |
| 1133 | JMP DN8C |
| 1134 | DN8A STA TID |
| 1135 | LDA K123 |
| 1136 | SUB TID+1 |
| 1137 | DN8B STA TID+1 |
| 1138 | LDA K123 |
| 1139 | DN8C SUB TID+2 |
| 1140 | STA TID+2 |
| 1141 | DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18) |
| 1142 | SNZ |
| 1143 | JMP DN67 ELSE, |
| 1144 | LDA IM IF IM NOT = REA, |
| 1145 | SUB K102 |
| 1146 | SZE GO TO DN67 (18) |
| 1147 | JMP DN67 |
| 1148 | LDA F6 ELSE, |
| 1149 | SNZ IF F6 = 0, GO TO DN87 |
| 1150 | JMP DN87 |
| 1151 | LDA K105 |
| 1152 | STA IM IM = CPX |
| 1153 | LDA TID INTERCHANGE |
| 1154 | IMA TIDB 3 CELLS |
| 1155 | STA TID TID |
| 1156 | LDA TID+1 WITH |
| 1157 | IMA TIDB+1 3 CELLS |
| 1158 | STA TID+1 OF |
| 1159 | LDA TID+2 TIDB |
| 1160 | IMA TIDB+2 |
| 1161 | STA TID+2 |
| 1162 | JST IP00 )-INPUT OPERATOR |
| 1163 | JMP DN70 GO TO DN70 (21) |
| 1164 | DN87 LDA TC IF TC = , |
| 1165 | SUB K5 |
| 1166 | SZE |
| 1167 | JMP DN67 TID-BAR = TID |
| 1168 | LDA TID F6 = 1 |
| 1169 | STA TIDB GO TO DN01 (1) |
| 1170 | LDA TID+1 |
| 1171 | STA TIDB+1 ELSE, GO TO DN67 (18) |
| 1172 | LDA TID+2 |
| 1173 | STA TIDB+2 |
| 1174 | LDA K101 |
| 1175 | STA F6 |
| 1176 | JMP DN01 |
| 1177 | DN90 LDA F2 IF F2= 0, GO TO DN9A (10) |
| 1178 | SNZ |
| 1179 | JMP DN9A |
| 1180 | LDA F3 F3 = - F3 |
| 1181 | TCA |
| 1182 | STA F3 |
| 1183 | DN9A LDA F3 F4 = F3 - F4 |
| 1184 | SUB F4 |
| 1185 | STA F4 |
| 1186 | LDA K12 F2 = EXP, BIAS + MANTISSA |
| 1187 | STA F2 |
| 1188 | LDA TID IF TID = 0, |
| 1189 | ADD TID+1 |
| 1190 | ADD TID+2 GO TO DN85(13) |
| 1191 | SNZ |
| 1192 | JMP DN85 |
| 1193 | DN9C LDA TID+2 |
| 1194 | LGL 1 NORMALIZE ID |
| 1195 | SPL |
| 1196 | JMP DN9D ID IS NORMALIZED |
| 1197 | JST SFT |
| 1198 | DAC ID |
| 1199 | * F2 = F2 - # SHIFTS |
| 1200 | LDA F2 |
| 1201 | SUB K101 |
| 1202 | STA F2 |
| 1203 | JMP DN9C CONTINUE NORMALIZE LOOP |
| 1204 | DN9D LDA F4 |
| 1205 | CAS ZERO |
| 1206 | JMP DN9E |
| 1207 | JMP DN9G FINISHED E FACTOR LOOP |
| 1208 | IRS F4 |
| 1209 | NOP F4 = F4 +1 |
| 1210 | LDA K155 DIVIDE LOOP COUNTER |
| 1211 | STA TIDN |
| 1212 | JST SRT RIGHT SHIFT TID |
| 1213 | DAC TID |
| 1214 | JST SRT |
| 1215 | DAC TID |
| 1216 | DND1 JST SFT |
| 1217 | DAC TID |
| 1218 | LDA TID+2 |
| 1219 | SUB K156 10 AT B=4 |
| 1220 | SMI |
| 1221 | STA TID+2 |
| 1222 | SMI |
| 1223 | IRS TID |
| 1224 | IRS TIDN |
| 1225 | JMP DND1 REDUCE DIVIDE COUNTER |
| 1226 | JST SFT |
| 1227 | DAC TID |
| 1228 | LDA TID+2 |
| 1229 | ANA K157 |
| 1230 | STA TID+2 |
| 1231 | JMP DN9C |
| 1232 | DN9E SUB K101 |
| 1233 | STA F4 F4 = F4-1 |
| 1234 | LDA F2 F2 = F2+4 |
| 1235 | ADD K104 |
| 1236 | STA F2 |
| 1237 | JST SRT |
| 1238 | DAC ID |
| 1239 | JST MOV3 |
| 1240 | JST SRT ID = ID*10 |
| 1241 | DAC ID |
| 1242 | JST SRT |
| 1243 | DAC ID |
| 1244 | JST AD3 ADD THREE WORD INTEGERS |
| 1245 | JMP DN9C |
| 1246 | * CONVERT THREE WORD INTEGER TO INTERNAL FORMAT |
| 1247 | DN9G LDA TID+2 |
| 1248 | IAB |
| 1249 | LDA F2 |
| 1250 | LRS 8 |
| 1251 | SNZ |
| 1252 | JMP *+3 |
| 1253 | JST ER00 |
| 1254 | BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW) |
| 1255 | IAB |
| 1256 | IMA TID+2 |
| 1257 | IAB |
| 1258 | LDA TID+1 |
| 1259 | LGL 1 |
| 1260 | LRR 8 |
| 1261 | STA TID+1 |
| 1262 | LRR 9 |
| 1263 | LDA TID PACK UP TRIPLE PRECISION |
| 1264 | LGL 1 |
| 1265 | LRR 7 REAL CONSTANT |
| 1266 | STA TID |
| 1267 | LDA F2 |
| 1268 | LGR 8 |
| 1269 | SZE |
| 1270 | JMP DN69 GO TO DN69 (20) |
| 1271 | JMP DN84 ELSE, GO TO DN84 (12) |
| 1272 | DN9H STA IM |
| 1273 | LDA SPF |
| 1274 | SUB K102 |
| 1275 | SZE |
| 1276 | LDA K106 |
| 1277 | SUB K124 |
| 1278 | ADD TID |
| 1279 | SMI |
| 1280 | JMP DN70 |
| 1281 | LDA TID |
| 1282 | STA HOLF HOLF=NO.OF HOLLERITH CHARS. |
| 1283 | STA F3 |
| 1284 | TCA |
| 1285 | SNZ |
| 1286 | JMP DN9K FIELD WIDTH OF ZERO |
| 1287 | STA F2 F2= -1(1 CHAR) OR -2(2 CHAR) |
| 1288 | JST BLNK SET ID,ID+1(ID+2 TO ZERO |
| 1289 | DAC TID |
| 1290 | DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS) |
| 1291 | JST PACK PACK CHARACTERS 2 PER WORD |
| 1292 | IRS F2 REDUCE CHARACTER COUNT |
| 1293 | JMP DN9J INPUT AND PACK MORE CHARACTERS |
| 1294 | LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT |
| 1295 | ANA K101 |
| 1296 | SNZ |
| 1297 | JMP *+3 |
| 1298 | LDA K8 ='240 (SP) |
| 1299 | JST PACK SHIFT A SPACE INTO THE LAST WORD |
| 1300 | IRS IM |
| 1301 | DN9M JST CH00 INPUT THE TERMINATING CHARACTER |
| 1302 | JMP DN67 FINISH OPERATOR AND EXIT |
| 1303 | DN9K JST ER00 |
| 1304 | BCI 1,HF |
| 1305 | DN9N LDA K105 SET .NOT. OPERATOR (TC=5) |
| 1306 | STA TC SET .NOT. OPERATOR (TC=5) |
| 1307 | CRA |
| 1308 | STA IM IM=0 = UNDEFINED |
| 1309 | JMP DN68 |
| 1310 | DNX1 BSS 3 |
| 1311 | DNX2 DAC ** OVERFLOW FLAG |
| 1312 | JMP* *-1 |
| 1313 | * |
| 1314 | * |
| 1315 | * ************ |
| 1316 | * *INPUT ITEM* |
| 1317 | * ************ |
| 1318 | * INPUTS AND ASSIGNS ITEM (IF ONE EXISTS) |
| 1319 | * |
| 1320 | II00 DAC ** |
| 1321 | JST DN00 INPUT DNA |
| 1322 | SNZ IF (A) = 0 |
| 1323 | JMP* II00 RETURN |
| 1324 | JST AS00 NO, ASSIGN ITEM |
| 1325 | LDA IM |
| 1326 | JMP* II00 RETURN (A) = IM |
| 1327 | * |
| 1328 | * |
| 1329 | * *************** |
| 1330 | * *INPUT OPERAND* |
| 1331 | * *************** |
| 1332 | * EXIT WITH ITEM MODE IN A (TC SET TO . IF NO |
| 1333 | * OPERAND) |
| 1334 | * |
| 1335 | OP00 DAC ** INPUT OPERAND |
| 1336 | JST II00 INPUT ITEM |
| 1337 | SZE IF IM = 0, SKIP |
| 1338 | JMP* OP00 ELSE (A) = IM, RETURN |
| 1339 | LDA K10 TC = . |
| 1340 | STA TC (A) = 0 |
| 1341 | CRA |
| 1342 | JMP* OP00 RETURN |
| 1343 | * |
| 1344 | * |
| 1345 | * ************ |
| 1346 | * *INPUT NAME* |
| 1347 | * ************ |
| 1348 | * INPUT OPERAND AND ENSURE THAT IT IS A NAME |
| 1349 | * |
| 1350 | NA00 DAC ** INPUT NAME |
| 1351 | JST OP00 INPUT OPERAND |
| 1352 | LDA NT IF NT = 1, |
| 1353 | SNZ |
| 1354 | JMP NA10 |
| 1355 | JST ER00 |
| 1356 | PZE 9 |
| 1357 | NA10 LDA IM (A) = IM |
| 1358 | JMP* NA00 RETURN |
| 1359 | * |
| 1360 | * |
| 1361 | * *************** |
| 1362 | * *INPUT INTEGER* |
| 1363 | * *************** |
| 1364 | * INPUT ITEM AND ENSURE THAT IT IS AN INTEGER CONSTANT |
| 1365 | * GREATER THAN ZERO |
| 1366 | * |
| 1367 | IG00 DAC ** INPUT INTEGER |
| 1368 | JST DN00 INPUT - DNA |
| 1369 | LDA F1 |
| 1370 | SZE IF F1 = 0, |
| 1371 | JMP IG20 AND NT = 1, |
| 1372 | LDA NT AND IM = INT, |
| 1373 | SNZ AND TID L2**15, |
| 1374 | JMP IG20 GO TO IG10 |
| 1375 | LDA IM ELSE, GO TO IG20 |
| 1376 | SUB K101 |
| 1377 | SZE |
| 1378 | JMP IG20 |
| 1379 | LDA TID+1 |
| 1380 | SZE |
| 1381 | JMP IG20 |
| 1382 | LDA TID+2 |
| 1383 | SZE |
| 1384 | JMP IG20 |
| 1385 | IG10 LDA TID |
| 1386 | JMP* IG00 |
| 1387 | IG20 JST ER00 ERROR |
| 1388 | BCI 1,IN INTEGER REQUIRED |
| 1389 | * |
| 1390 | * |
| 1391 | * *********************** |
| 1392 | * *INPUT INTEGER VAR/CON* |
| 1393 | * *********************** |
| 1394 | * |
| 1395 | IV00 DAC ** |
| 1396 | JST OP00 INPUT OPERAND |
| 1397 | JST IT00 INTER TEST |
| 1398 | JST TV00 TAG VARIABLE |
| 1399 | JMP* IV00 EXIT |
| 1400 | * |
| 1401 | * |
| 1402 | * ************************ |
| 1403 | * *INPUT INTEGER VARIABLE* |
| 1404 | * ************************ |
| 1405 | * |
| 1406 | IR00 DAC ** INPUT INT VAR |
| 1407 | JST IV00 INPUT INT VAR/CON |
| 1408 | JST NC00 NON-CONSTANT TEST |
| 1409 | JMP* IR00 RETURN |
| 1410 | * |
| 1411 | * |
| 1412 | * ************************ |
| 1413 | * *INPUT STATEMENT NUMBER* |
| 1414 | * ************************ |
| 1415 | * NUMBER IS FORMED AS SPECIAL NAME , NOT CONVERTED |
| 1416 | * TO NUMERIC |
| 1417 | * |
| 1418 | IS00 DAC ** |
| 1419 | IS04 CRA |
| 1420 | STA NT |
| 1421 | STA IM |
| 1422 | STA IU IU = IM = IT = 0 |
| 1423 | STA NTID PUT LEADING '$' IN STATEMENT NO. |
| 1424 | LDA K79 |
| 1425 | JST PACK |
| 1426 | IS10 JST ID00 INPUT DIGIT |
| 1427 | SZE |
| 1428 | JMP IS20 NOT A DIGIT GO TO IS20 |
| 1429 | LDA NTID |
| 1430 | SUB K106 |
| 1431 | SMI |
| 1432 | JMP IS22 |
| 1433 | LDA TC |
| 1434 | JST PACK PACK TC TO ID - LEGAL ST. NO. CHAR |
| 1435 | LDA TID |
| 1436 | CAS K79X |
| 1437 | JMP IS10 |
| 1438 | JMP IS04 IGNORE LEAD ZERO ON ST. NO. |
| 1439 | JMP IS10 |
| 1440 | IS20 LDA NTID |
| 1441 | SUB K101 |
| 1442 | SMI |
| 1443 | JMP IS25 |
| 1444 | IS22 JST ER00 |
| 1445 | BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT |
| 1446 | IS25 JST AS00 ASSIGN ITEM |
| 1447 | JST STXA |
| 1448 | LDA DP+1,1 |
| 1449 | ANA K111 |
| 1450 | STA DP+1,1 IU = 0 |
| 1451 | LDA AF ADDRESS FIELD IS |
| 1452 | CAS XST LE XST - ALREADY ASSIGNED |
| 1453 | JMP* IS00 |
| 1454 | JMP* IS00 OK - OTHERWISE |
| 1455 | LDA AT MUST HAVE STR-ABS OTHERWISE |
| 1456 | CAS K102 |
| 1457 | JMP *+2 |
| 1458 | JMP* IS00 |
| 1459 | JST ER00 |
| 1460 | BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER |
| 1461 | K79 OCT 337 |
| 1462 | K79X OCT 157660 |
| 1463 | * |
| 1464 | SY00 DAC ** INPUT SYMBOL |
| 1465 | LDA K101 |
| 1466 | STA NTF NTF NOT 0 - DON'T SET IU IN AS00 |
| 1467 | JST NA00 INPUT NAME |
| 1468 | JMP* SY00 EXIT |
| 1469 | * |
| 1470 | * ************************ |
| 1471 | * *EXAMINE NEXT CHARACTER* |
| 1472 | * ************************ |
| 1473 | * CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT) |
| 1474 | * |
| 1475 | XN00 DAC ** |
| 1476 | JST ID00 INPUT DIGIT |
| 1477 | JST UC00 UNINPUT COLUMM |
| 1478 | JMP* XN00 |
| 1479 | K1 BCI 3,TRUE. |
| 1480 | K2 BCI 3,FALSE. |
| 1481 | K3 OCT 247 |
| 1482 | KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST |
| 1483 | K11 OCT 304 0D |
| 1484 | K14 OCT 310 0H |
| 1485 | K62 OCT 316 0N |
| 1486 | K64 OCT 336 0) |
| 1487 | * |
| 1488 | * |
| 1489 | * ******************** |
| 1490 | * *ALL CHARACTER TEST* |
| 1491 | * ******************** |
| 1492 | * |
| 1493 | TS00 DAC ** TEST (A) AGAINST TC |
| 1494 | SUB TC |
| 1495 | SNZ |
| 1496 | JMP* TS00 RETURN |
| 1497 | JST ER00 TO ERROR TEST |
| 1498 | BCI 1,CH IMPROPER TERMINATING CHARACTER |
| 1499 | * |
| 1500 | * |
| 1501 | * ******************* |
| 1502 | * *)- INPUT OPERATOR* |
| 1503 | * ******************* |
| 1504 | * |
| 1505 | IP00 DAC ** |
| 1506 | LDA K4 TEST - ) |
| 1507 | JST TS00 |
| 1508 | JST CH00 INPUT CHAR |
| 1509 | JST FN00 FINISH OPERATOR |
| 1510 | LDA B B = B-16 |
| 1511 | SUB K109 |
| 1512 | STA B |
| 1513 | CRA (A) = 0 |
| 1514 | JMP* IP00 RETURN |
| 1515 | * |
| 1516 | * |
| 1517 | * |
| 1518 | * B1 COMMA OR C/R TST |
| 1519 | B1 LDA K134 IF TC = ','(CONVERTED TO 17) |
| 1520 | SUB TC |
| 1521 | SNZ |
| 1522 | JMP* A9T2 GO TO SIDSW |
| 1523 | JMP A1 ELSE, GO TO C/R TEST |
| 1524 | * |
| 1525 | * |
| 1526 | NR00 DAC ** NON-REL TEST |
| 1527 | LDA AT |
| 1528 | SUB K101 IF AT = 1 GO TO ERROR- |
| 1529 | SZE TEST |
| 1530 | JMP* NR00 RETURN |
| 1531 | JST ER00 ERROR TEST ROUTINE |
| 1532 | BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER |
| 1533 | * |
| 1534 | * |
| 1535 | * *************** |
| 1536 | * *NO USAGE TEST* |
| 1537 | * *************** |
| 1538 | * |
| 1539 | NU00 DAC ** N0 USAGE TEST |
| 1540 | LDA IU |
| 1541 | SNZ IF IU NOT = 0, TO ERROR |
| 1542 | JMP* NU00 RETURN |
| 1543 | JST ER00 ERROR TEST |
| 1544 | BCI 1,NU NAME ALREADY BEING USED |
| 1545 | * |
| 1546 | * |
| 1547 | * ******************* |
| 1548 | * *NON-CONSTANT TEST* |
| 1549 | * ******************* |
| 1550 | * |
| 1551 | NC00 DAC ** NON CONSTANT TEST |
| 1552 | LDA NT |
| 1553 | SNZ IF NT NOT = 0, TO ERROR TEST |
| 1554 | JMP* NC00 RETURN |
| 1555 | JST ER00 ERROR TEST |
| 1556 | BCI 1,NC CONSTANT MUST BE PRESENT |
| 1557 | * |
| 1558 | * |
| 1559 | * ********************* |
| 1560 | * *NON SUBPROGRAM TEST* |
| 1561 | * ********************* |
| 1562 | * |
| 1563 | NS00 DAC ** NON SUBPROGRAM TEST |
| 1564 | LDA IU |
| 1565 | SUB K101 IF IU = 1, GO TO- |
| 1566 | SZE ERROR TEST |
| 1567 | JMP* NS00 RETURN |
| 1568 | JST ER00 ERROR TEST |
| 1569 | BCI 1,NS SUBPROGRAM NAME NOT ALLOWED |
| 1570 | * |
| 1571 | * |
| 1572 | * ********** |
| 1573 | * *ARR TEST* |
| 1574 | * ********** |
| 1575 | * |
| 1576 | AT00 DAC ** ARRAY TEST |
| 1577 | LDA IU |
| 1578 | SUB K103 IF IU = 3, GO TO |
| 1579 | SNZ |
| 1580 | JMP* AT00 RETURN |
| 1581 | JST ER00 ERROR TEST |
| 1582 | BCI 1,AR ITEM NOT AN ARRAY NAME |
| 1583 | * |
| 1584 | * |
| 1585 | * ************** |
| 1586 | * *INTEGER TEST* |
| 1587 | * ************** |
| 1588 | * |
| 1589 | IT00 DAC ** INTEGER TEST |
| 1590 | LDA IM |
| 1591 | SUB K101 IF IM = 1, GO TO- |
| 1592 | SNZ ERROR ROUTINE, ELSE |
| 1593 | JMP* IT00 RETURN |
| 1594 | JST ER00 TO ERROR TEST |
| 1595 | BCI 1,IT ITEM NOT AN INTEGER |
| 1596 | * |
| 1597 | * |
| 1598 | TA00 DAC ** |
| 1599 | LDA AT STRING-ABS TEST |
| 1600 | SUB K102 |
| 1601 | SNZ |
| 1602 | JMP* TA00 |
| 1603 | JST ER00 |
| 1604 | BCI 1,NR ITEM NOT A RELATIVE VARIABLE |
| 1605 | * |
| 1606 | * |
| 1607 | * |
| 1608 | * |
| 1609 | * |
| 1610 | * |
| 1611 | * |
| 1612 | * |
| 1613 | AD3 DAC ** ADD TWO THREE WORD INTEGERS. |
| 1614 | LDA TID |
| 1615 | ADD DNX1 |
| 1616 | CSA |
| 1617 | STA TID |
| 1618 | LDA TID+1 |
| 1619 | ACA |
| 1620 | ADD DNX1+1 |
| 1621 | CSA |
| 1622 | STA TID+1 |
| 1623 | LDA TID+2 |
| 1624 | ACA |
| 1625 | ADD DNX1+2 |
| 1626 | STA TID+2 |
| 1627 | JMP* AD3 |
| 1628 | * |
| 1629 | * |
| 1630 | * *********************** |
| 1631 | * *ASSIGN INDEX REGISTER* |
| 1632 | * *********************** |
| 1633 | * |
| 1634 | STXA DAC ** |
| 1635 | LDA A |
| 1636 | STA 0 |
| 1637 | JMP* STXA |
| 1638 | STXI DAC ** |
| 1639 | LDA I |
| 1640 | STA 0 |
| 1641 | JMP* STXI |
| 1642 | K153 OCT 16 |
| 1643 | IM00 DAC ** |
| 1644 | STA T1IM MULTIPLY A BY B |
| 1645 | LDA K120 =-15 |
| 1646 | STA T2IM |
| 1647 | CRA |
| 1648 | RCB C BIT = 0 |
| 1649 | IM10 LRL 1 LOW BIT OF B INTO C |
| 1650 | SRC SKIP IF B = 0 |
| 1651 | ADD T1IM |
| 1652 | IRS T2IM |
| 1653 | JMP IM10 |
| 1654 | LLL 14 |
| 1655 | JMP* IM00 RETURN, RESULT IN A |
| 1656 | T1IM PZE 0 |
| 1657 | T2IM PZE 0 |
| 1658 | * |
| 1659 | * |
| 1660 | NF00 DAC ** CONSTRUCT EXTERNAL NAME |
| 1661 | LDA K80 ENTRY FOR FORTRAN GENERATER |
| 1662 | STA NAMF |
| 1663 | LDA K81 SUBROUTINE CALLS. |
| 1664 | STA NAMF+2 |
| 1665 | JMP* NF00 |
| 1666 | K80 BCI 1,F$ |
| 1667 | K81 BCI 1, |
| 1668 | KM92 DEC 1 001 = INT |
| 1669 | DEC 2 010 = REA |
| 1670 | DEC 1 011 = LOG |
| 1671 | DEC 0 - - |
| 1672 | DEC 4 101 = CPX |
| 1673 | DEC 3 110 = DSL |
| 1674 | OCT 3 111 = HOL |
| 1675 | * |
| 1676 | * |
| 1677 | BLNK DAC ** CLEAR A 3/36 |
| 1678 | JST SAV AREA TO ZEROS |
| 1679 | LDA* BLNK |
| 1680 | STA XR |
| 1681 | CRA CLEAR 3 WORDS OF MEMORY |
| 1682 | STA 1,1 PARAMETER INPUT ADDRESS TO 0 |
| 1683 | STA 2,1 |
| 1684 | STA 0,1 |
| 1685 | JST RST |
| 1686 | IRS BLNK |
| 1687 | JMP* BLNK EXIT |
| 1688 | * |
| 1689 | * |
| 1690 | MOV3 DAC ** MOVE 3-WORDS |
| 1691 | LDA TID TO TEMO STORE |
| 1692 | STA DNX1 |
| 1693 | LDA TID+1 |
| 1694 | STA DNX1+1 |
| 1695 | LDA TID+2 |
| 1696 | STA DNX1+2 |
| 1697 | JMP* MOV3 |
| 1698 | * |
| 1699 | * |
| 1700 | * |
| 1701 | * |
| 1702 | CIB DAC ** COMPARE IBUF TO A CONSTANT |
| 1703 | JST SAV SAVE INDEX |
| 1704 | LDA* CIB +DDR OF CON+3,0 |
| 1705 | STA CIBZ |
| 1706 | CRA |
| 1707 | SUB K103 XR=-3 |
| 1708 | STA XR |
| 1709 | CIBB LDA IBUF+3,1 |
| 1710 | SUB* CIBZ |
| 1711 | SZE |
| 1712 | JMP CIBD |
| 1713 | IRS XR |
| 1714 | JMP CIBB |
| 1715 | CIBC IRS CIB |
| 1716 | JST RST RESTORE INDEX |
| 1717 | JMP* CIB |
| 1718 | CIBD IRS CIB |
| 1719 | JMP CIBC |
| 1720 | CIBZ DAC ** |
| 1721 | * |
| 1722 | * |
| 1723 | * |
| 1724 | * |
| 1725 | SAV DAC ** SAVE INDEX REGISTER |
| 1726 | STA SAVY STACKED IN PUSH DOWN LIST |
| 1727 | LDA XR |
| 1728 | STA* SAV9 |
| 1729 | IRS SAV9 |
| 1730 | LDA SAVY |
| 1731 | JMP* SAV |
| 1732 | RST DAC ** RESTORE INDEX REGISTER |
| 1733 | STA SAVY |
| 1734 | LDA SAV9 UNSTACK PUSH DOWN LIST |
| 1735 | SUB K101 |
| 1736 | STA SAV9 |
| 1737 | LDA* SAV9 |
| 1738 | STA XR |
| 1739 | LDA SAVY |
| 1740 | JMP* RST |
| 1741 | SAVY PZE 0 |
| 1742 | SAV9 DAC SAVX IS INITIATED BY A092 |
| 1743 | SAVX BSS 20 |
| 1744 | * |
| 1745 | * |
| 1746 | PACK DAC ** PLACE CHARACTER IN A |
| 1747 | STA PAK7 |
| 1748 | LDA NTID INTO ID - UPDATE 3 WORDS OF |
| 1749 | PAK1 SNZ |
| 1750 | JMP PAK4 ID |
| 1751 | LRL 1 |
| 1752 | ADD PAK9 |
| 1753 | STA PAK8 |
| 1754 | LDA PAK7 |
| 1755 | IAB |
| 1756 | SPL |
| 1757 | JMP PAK3 |
| 1758 | LLL 24 |
| 1759 | ADD K8 |
| 1760 | PAK2 STA* PAK8 |
| 1761 | IRS NTID |
| 1762 | JMP* PACK |
| 1763 | PAK3 LLL 8 |
| 1764 | LDA* PAK8 |
| 1765 | LGR 8 |
| 1766 | LLL 8 |
| 1767 | JMP PAK2 |
| 1768 | PAK4 LDA PAK6 |
| 1769 | STA TID |
| 1770 | STA TID+1 |
| 1771 | STA TID+2 |
| 1772 | STA TID+3 |
| 1773 | LDA NTID |
| 1774 | JMP PAK1+2 |
| 1775 | PAK6 BCI 1, |
| 1776 | PAK7 DAC ** |
| 1777 | PAK8 DAC ** |
| 1778 | PAK9 DAC TID |
| 1779 | * |
| 1780 | * |
| 1781 | * *************** |
| 1782 | * *ERROR ROUTINE* |
| 1783 | * *************** |
| 1784 | * |
| 1785 | ER00 DAC ** ERROR ROUTINE |
| 1786 | LDA SAV9 |
| 1787 | STA SAVX |
| 1788 | LDA ER93 =-35 |
| 1789 | STA 0 SET INDEX |
| 1790 | LDA ER91 (*)(*) |
| 1791 | STA PRI+35,1 SET ** INTO PRINT BUFFER |
| 1792 | IRS 0 SET COMPLETE PRINT BUFFER TO ******** |
| 1793 | JMP *-2 |
| 1794 | LDA CC |
| 1795 | ARS 1 CC = CC/2 |
| 1796 | SUB K101 =1 |
| 1797 | SPL |
| 1798 | CRA |
| 1799 | STA XR |
| 1800 | LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.) |
| 1801 | SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT |
| 1802 | JMP *+3 |
| 1803 | LDA KAEQ ='142721 (=(E)(Q) ) |
| 1804 | STA PRI+1,1 |
| 1805 | LDA* ER00 |
| 1806 | STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER |
| 1807 | CALL F4$SYM PRINT THE BUFFER |
| 1808 | DAC PRI |
| 1809 | JST PRSP SET PRINT BUFFER TO SPACES |
| 1810 | LDA TC |
| 1811 | ER20 CAS CRET INPUT CHARACTERS UNTIL C/R |
| 1812 | JMP *+2 |
| 1813 | JMP C7 GO TO STATEMENT INPUT |
| 1814 | JST CH00 |
| 1815 | JMP ER20 |
| 1816 | ER91 BCI 1,** |
| 1817 | ER93 OCT 177735 -35 |
| 1818 | * |
| 1819 | * |
| 1820 | SRT DAC ** |
| 1821 | JST SAV |
| 1822 | LDA* SRT SHIFT RIGHT ONE PLACE |
| 1823 | STA XR TRIPLE PRECISION |
| 1824 | LDA 0,1 |
| 1825 | IAB |
| 1826 | LDA 1,1 |
| 1827 | LRS 1 |
| 1828 | LGL 1 |
| 1829 | IAB |
| 1830 | STA 0,1 |
| 1831 | LDA 2,1 |
| 1832 | LRS 1 |
| 1833 | STA 2,1 |
| 1834 | IAB |
| 1835 | STA 1,1 |
| 1836 | JST RST |
| 1837 | IRS SRT |
| 1838 | JMP* SRT |
| 1839 | * |
| 1840 | * |
| 1841 | SFT DAC ** TRIPLE PRECISION |
| 1842 | JST SAV SHIFT LEFT ONE PLACE |
| 1843 | LDA* SFT |
| 1844 | STA XR |
| 1845 | LDA 0,1 |
| 1846 | IAB |
| 1847 | LDA 1,1 |
| 1848 | LLS 1 |
| 1849 | CSA |
| 1850 | STA 1,1 |
| 1851 | IAB |
| 1852 | STA 0,1 |
| 1853 | ACA |
| 1854 | LRS 1 |
| 1855 | LDA 2,1 |
| 1856 | LLS 1 |
| 1857 | CSA |
| 1858 | STA 2,1 |
| 1859 | JST RST |
| 1860 | IRS SFT |
| 1861 | JMP* SFT |
| 1862 | * |
| 1863 | LIST DAC ** |
| 1864 | JST PRSP |
| 1865 | SR2 |
| 1866 | JMP *+3 |
| 1867 | CALL F4$SYM PRINT BLANK LINE |
| 1868 | DAC PRI |
| 1869 | CALL F4$SYM PRINT SOURCE INPUT LINE |
| 1870 | DAC CI |
| 1871 | JMP* LIST |
| 1872 | * ************* |
| 1873 | * *ASSIGN ITEM* |
| 1874 | * ************* |
| 1875 | * CHECKS ASSIGNMENT AREA OF DATA POOL (A0 TO ABAR) |
| 1876 | * FOR ITEM DEFINED BY ID, IM, IU, ETC. |
| 1877 | * IF FOUND, EXIT WITH POINTER AND |
| 1878 | * ASSIGNMENTS DATA SET, OTHERWISE |
| 1879 | * ASSIGN THE ITEM. |
| 1880 | * |
| 1881 | * |
| 1882 | * |
| 1883 | T0AS PZE 0 |
| 1884 | AS00 DAC ** |
| 1885 | CRA |
| 1886 | STA A A = A (0) |
| 1887 | AS04 JST STXA |
| 1888 | JST NXT GET NEXT ENTRY |
| 1889 | JMP AS30 AT END, GO TO AS30 |
| 1890 | LDA NT |
| 1891 | SUB NTA NT = NT(A) |
| 1892 | SZE |
| 1893 | JMP AS04 NO, G0 TO AS04 |
| 1894 | LDA TID |
| 1895 | SUB TIDA |
| 1896 | SZE |
| 1897 | JMP AS04 TID = TID(A) |
| 1898 | LDA TID+1 |
| 1899 | SUB TIDA+1 |
| 1900 | SZE |
| 1901 | JMP AS04 NO, GO TO AS04 |
| 1902 | LDA TID+2 |
| 1903 | SUB TIDA+2 |
| 1904 | SZE |
| 1905 | JMP AS04 |
| 1906 | LDA NT IF NT (A) .NE. 0, |
| 1907 | SNZ GO TO AS10 |
| 1908 | JMP AS16 GO TO AS16 (4) |
| 1909 | AS10 LDA IM IF IM .NE. IM (A), |
| 1910 | SUB IMA GO TO AS04 (1) |
| 1911 | SZE |
| 1912 | JMP AS04 |
| 1913 | LDA IU IF IU = 0, |
| 1914 | SNZ OR NOT EQUAL IU (A) |
| 1915 | JMP AS04 GO TO AS04 (1) |
| 1916 | SUB IUA |
| 1917 | SZE |
| 1918 | JMP AS04 ELSE, |
| 1919 | LDA IM |
| 1920 | SUB K105 GO TO AS16 (4) |
| 1921 | SZE |
| 1922 | JMP AS16 |
| 1923 | JST NXT ELSE, GET NEXT ENTRY |
| 1924 | JMP AS30 |
| 1925 | LDA TIDA IF ID (A) = TIDB |
| 1926 | SUB TIDB GO TO AS16 (4) |
| 1927 | SZE ELSE, GO TO AS04 (1) |
| 1928 | JMP AS04 |
| 1929 | LDA TIDA+1 |
| 1930 | SUB TIDB+1 |
| 1931 | SZE |
| 1932 | JMP AS04 |
| 1933 | LDA TIDA+2 |
| 1934 | SUB TIDB+2 |
| 1935 | SZE |
| 1936 | JMP AS04 |
| 1937 | LDA A |
| 1938 | SUB K105 |
| 1939 | STA A |
| 1940 | AS16 LDA IUA IF IU (A) .NE. 0 |
| 1941 | ADD NTF |
| 1942 | SZE |
| 1943 | JMP AS18 GO TO AS18 (5) |
| 1944 | LDA SPF IF SPF = 0, GO TO AS18 (5) |
| 1945 | SNZ |
| 1946 | JMP AS18 |
| 1947 | LDA TC IF TC = ( |
| 1948 | SUB K17 |
| 1949 | SZE |
| 1950 | JMP AS19 |
| 1951 | JST TG00 TAG SUBPROGRAM |
| 1952 | AS18 CRA SET NTF TO 0 |
| 1953 | STA NTF SET NTF TO 0 |
| 1954 | JST FA00 GO TO FETCH ASSIGNS |
| 1955 | JST STXA |
| 1956 | LDA IM |
| 1957 | JMP* AS00 RETURN |
| 1958 | AS19 JST TV00 TAG VARIABLE |
| 1959 | JMP AS18 |
| 1960 | AS30 JST BUD BUILD ASSIGNMENT ENTRY |
| 1961 | LDA NT IF NT = 1 |
| 1962 | SZE |
| 1963 | JMP AS32 OR IV = VAR, |
| 1964 | LDA IU |
| 1965 | SUB K102 |
| 1966 | SZE |
| 1967 | JMP AS40 AMD |
| 1968 | AS32 LDA IM IF IM = CPX, |
| 1969 | SUB K105 |
| 1970 | SZE |
| 1971 | JMP AS40 |
| 1972 | STA IU MOVE 1ST PART OF |
| 1973 | LDA TIDB COMPLEX ENTRY TO |
| 1974 | STA TID TID AND BUILD |
| 1975 | LDA TIDB+1 ASSIGNMENT ENTRY |
| 1976 | STA TID+1 |
| 1977 | LDA TIDB+2 |
| 1978 | STA TID+2 |
| 1979 | LDA A |
| 1980 | ADD K105 |
| 1981 | STA A |
| 1982 | JST BUD |
| 1983 | LDA A |
| 1984 | SUB K105 RESTORE A |
| 1985 | STA A |
| 1986 | AS40 LDA ABAR |
| 1987 | SUB A T0 = -(ABAR-A+5) |
| 1988 | ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP |
| 1989 | TCA |
| 1990 | STA T0AS |
| 1991 | TCA |
| 1992 | ADD DO CO=DO+T0 |
| 1993 | STA DO |
| 1994 | LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE |
| 1995 | SNZ |
| 1996 | JMP AS60 GO TO AS60 |
| 1997 | LDA I |
| 1998 | SUB T0AS |
| 1999 | STA I I = I - T0(T0 IS NEGATIVE) |
| 2000 | AOA |
| 2001 | AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE |
| 2002 | NOP |
| 2003 | JMP AS50 |
| 2004 | ADD '104 =DP,1 |
| 2005 | STA AS91 AS91 = NEW TABLE TOP |
| 2006 | ADD T0AS |
| 2007 | STA AS92 AS92 |
| 2008 | SUB T0AS COMPUTE SIZE OF FLOATING TABLES |
| 2009 | SUB '104 =DP,1 |
| 2010 | SUB DO |
| 2011 | SNZ IF ZERO, ASSIGN TABLE ONLY. |
| 2012 | JMP AS16 |
| 2013 | TCA |
| 2014 | STA T0AS |
| 2015 | CRA |
| 2016 | STA XR |
| 2017 | AS46 LDA* AS92 END-5 |
| 2018 | STA* AS91 END (MOVE TABLES UP) |
| 2019 | LDA 0 |
| 2020 | SUB K101 =1 |
| 2021 | STA 0 REDUCE INDEX |
| 2022 | IRS T0AS = NO. OF WORDS TO MOVE |
| 2023 | JMP AS46 |
| 2024 | JMP AS16 |
| 2025 | AS50 JST ER00 |
| 2026 | BCI 1,MO DATA POOL OVERFLOW |
| 2027 | AS60 LDA DO |
| 2028 | ADD D |
| 2029 | JMP AS41 |
| 2030 | AS91 DAC 0 |
| 2031 | AS92 DAC ** |
| 2032 | * |
| 2033 | * |
| 2034 | * |
| 2035 | * |
| 2036 | * **************** |
| 2037 | * *TAG SUBPROGRAM* |
| 2038 | * **************** |
| 2039 | * TAG ITEM AS A SUBPROGRAM, CHECK TO SEE IF |
| 2040 | * NAME IS IN IMPLICIT MODE TABLE AND SET |
| 2041 | * MODE ACCORDINGLY |
| 2042 | * |
| 2043 | TG00 DAC ** |
| 2044 | LDA IU |
| 2045 | SUB K101 IF IU = SUB |
| 2046 | SNZ |
| 2047 | JMP* TG00 RETURN, ELSE |
| 2048 | JST NU00 NO * USAGE TEST |
| 2049 | LDA TG22 =-21 |
| 2050 | STA 0 SET INDEX |
| 2051 | TG04 LDA ID+1 CHARACTERS 3 AND 4 |
| 2052 | CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE |
| 2053 | JMP *+2 |
| 2054 | JMP TG10 |
| 2055 | TG06 IRS 0 |
| 2056 | JMP TG04 NOT DONE WITH TABLE |
| 2057 | TG08 LDA K101 =1 (IU=SUBR.) |
| 2058 | STA IU |
| 2059 | JST STXA |
| 2060 | LDA DP+1,1 IU(A) = SUB |
| 2061 | LGL 1 |
| 2062 | SSM |
| 2063 | LGR 1 |
| 2064 | STA DP+1,1 |
| 2065 | JMP* TG00 RETURN |
| 2066 | * |
| 2067 | TG10 LDA ID CHARACTERS 1 AND 2 |
| 2068 | ANA K111 ='37777 |
| 2069 | ADD HBIT ='140000 |
| 2070 | SUB TGT1+21,1 |
| 2071 | SZE |
| 2072 | JMP TG06 CONTINUE SEARCH |
| 2073 | LDA ID+2 CHARACTERS 5 AND 6 |
| 2074 | SUB TGT3+21,1 |
| 2075 | SZE |
| 2076 | JMP TG06 CONTINUE SEARCH |
| 2077 | LDA TGT1+21,1 |
| 2078 | LGR 8 |
| 2079 | ANA K107 =7 (=3 IF CPX, 4 IF DBL) |
| 2080 | ADD K102 =2 (=5 IF CPX, 6 IF DBL) |
| 2081 | JST DM00 DEFINE IM |
| 2082 | JMP TG08 |
| 2083 | * |
| 2084 | TG22 OCT 177753 =-21 |
| 2085 | * |
| 2086 | *...........IMPLICIT MODE SUBROUTINE NAME TABLE |
| 2087 | TGT1 BCI 6,DECEDLCLDLDS |
| 2088 | BCI 6,CSDCCCDSCSDA |
| 2089 | BCI 6,DADMDADMDMDS |
| 2090 | BCI 3,DBCMCO |
| 2091 | TGT2 BCI 6,XPXPOGOGOGIN |
| 2092 | BCI 6,INOSOSQRQRTA |
| 2093 | BCI 6,TAODBSAXINIG |
| 2094 | BCI 3,LEPLNJ |
| 2095 | TGT3 BCI 6, 10 / |
| 2096 | BCI 6, T T N / |
| 2097 | BCI 6,N2 1 1 N / |
| 2098 | BCI 3, X G / |
| 2099 | * |
| 2100 | * |
| 2101 | TIDA BSS 3 |
| 2102 | TIDB BSS 3 |
| 2103 | * |
| 2104 | * - TV00 TAG VARIABLE |
| 2105 | TV00 DAC ** |
| 2106 | LDA IU IF IU = 'VAR', |
| 2107 | SUB K102 |
| 2108 | SNZ |
| 2109 | JMP* TV00 RETURN |
| 2110 | JST NU00 ELSE, NO USAGE TEST |
| 2111 | JST STXA |
| 2112 | LDA DP+1,1 |
| 2113 | ANA K111 IU (A) = 'VAR' |
| 2114 | SSM |
| 2115 | STA DP+1,1 |
| 2116 | JMP* TV00 RETURN |
| 2117 | * |
| 2118 | * |
| 2119 | * |
| 2120 | * |
| 2121 | * |
| 2122 | * ************** |
| 2123 | * *FETCH ASSIGN* |
| 2124 | * ************** |
| 2125 | * SET ASSIGNMENT DATA FROM ASSIGN (EXCEPT ID) |
| 2126 | * EXPAND DIMENSION INFO IF ARRAY |
| 2127 | * |
| 2128 | FA00 DAC ** |
| 2129 | JST STXA |
| 2130 | LDA DP,1 |
| 2131 | LRL 15 |
| 2132 | STA NT NT=NT(A) |
| 2133 | CRA |
| 2134 | LLL 3 |
| 2135 | STA AT AT=AT(A) |
| 2136 | CRA |
| 2137 | LLL 3 IM = IM(A) |
| 2138 | STA IM |
| 2139 | STA 0 |
| 2140 | LDA KM92-1,1 |
| 2141 | STA D0 D0 = NUMBER OF WORDS |
| 2142 | ALS 2 |
| 2143 | ADD D0 |
| 2144 | STA X X = POINTER TO CONSTANT NUMBER OF WORDS |
| 2145 | JST STXA |
| 2146 | LDA DP+1,1 |
| 2147 | LRL 14 |
| 2148 | STA IU |
| 2149 | SUB K103 IF IU NOT 'ARR' |
| 2150 | SNZ |
| 2151 | JMP FA10 |
| 2152 | CRA |
| 2153 | LLL 14 AF = GF(A) |
| 2154 | STA AF |
| 2155 | JMP* FA00 |
| 2156 | FA10 LLL 14 |
| 2157 | STA 0 INDEX = GF(A) |
| 2158 | LDA DP+4,1 |
| 2159 | STA X1 POINTER OF DIMENSION 1 |
| 2160 | LDA DP+3,1 |
| 2161 | STA X2 POINTER OF DIMENSION 2 |
| 2162 | LDA DP+2,1 |
| 2163 | STA X3 POINTER OF DIMENSION 3 |
| 2164 | LDA DP+1,1 |
| 2165 | ANA K111 ='37777 |
| 2166 | STA AF AF = GF(GF(A)) |
| 2167 | LDA DP,1 |
| 2168 | LGR 9 |
| 2169 | ANA K107 =7 |
| 2170 | STA ND NUMBER OF DIMENSIONS |
| 2171 | STA 0 |
| 2172 | LDA K101 =1 |
| 2173 | STA D2 |
| 2174 | STA D3 |
| 2175 | JMP* FA91-1,1 |
| 2176 | FA22 LDA X3 FETCH 3RD DIMENSION SIZE |
| 2177 | STA XR |
| 2178 | JST FA40 |
| 2179 | STA D3 STORE D3 |
| 2180 | FA24 LDA X2 |
| 2181 | STA XR |
| 2182 | JST FA40 |
| 2183 | STA D2 D2 = 2ND DIMENSION SIZE |
| 2184 | FA26 LDA X1 |
| 2185 | STA XR |
| 2186 | JST FA40 |
| 2187 | STA D1 D1 = 1ST DIMENSION SIZE |
| 2188 | JST STXA EXIT WITH AF IN A |
| 2189 | LDA AF |
| 2190 | JMP* FA00 |
| 2191 | FA40 DAC ** |
| 2192 | LDA DP,1 IM OF SUBSCRIPT VALUE |
| 2193 | SSP |
| 2194 | LGR 12 |
| 2195 | SUB K105 =5 |
| 2196 | SZE SKIP IF DUMMY SUBSCRIPT |
| 2197 | LDA DP+4,1 FETCH VALUE OF SUBSCRIPT |
| 2198 | JMP* FA40 |
| 2199 | FA91 DAC FA26 |
| 2200 | DAC FA24 |
| 2201 | DAC FA22 |
| 2202 | * |
| 2203 | * |
| 2204 | * ************ |
| 2205 | * *FETCH LINK* |
| 2206 | * ************ |
| 2207 | * EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE |
| 2208 | * LINKED ITEM |
| 2209 | * |
| 2210 | FL00 DAC ** |
| 2211 | JST STXA |
| 2212 | LDA DP,1 A = 5 * CL(A) |
| 2213 | ANA K118 |
| 2214 | STA FLT1 |
| 2215 | ALS 2 |
| 2216 | ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC) |
| 2217 | STA A |
| 2218 | JST FA00 FETCH ASSIGN |
| 2219 | JST KT00 D0 = = WDS /ITEM |
| 2220 | LDA A |
| 2221 | SUB F (A) = A-F |
| 2222 | JMP* FL00 RETURN |
| 2223 | * |
| 2224 | * |
| 2225 | * ******************* |
| 2226 | * *D0=WORDS FOR LINK* |
| 2227 | * ******************* |
| 2228 | * D = ITEM MODE SIZE TIMES THE TOTAL SIZE IF |
| 2229 | * THE ITEM IS AN ARRAY |
| 2230 | * |
| 2231 | KT00 DAC ** |
| 2232 | LDA IU IF IU NOT 'ARR' |
| 2233 | SUB K103 |
| 2234 | SZE |
| 2235 | JMP* KT00 RETURN |
| 2236 | LDA D0 |
| 2237 | IAB D0 = D0 * D1 * D2 * D3 |
| 2238 | LDA D1 |
| 2239 | JST IM00 MULTIPLY A BY B |
| 2240 | IAB |
| 2241 | LDA D2 |
| 2242 | JST IM00 MULTIPLY A BY B |
| 2243 | IAB |
| 2244 | LDA D3 |
| 2245 | JST IM00 MULTIPLY A BY B |
| 2246 | STA D0 |
| 2247 | JMP* KT00 RETURN |
| 2248 | * |
| 2249 | * |
| 2250 | * |
| 2251 | * *********** |
| 2252 | * *DEFINE IM* |
| 2253 | * *********** |
| 2254 | * IM SUBA = IM (SET FROM A REG) |
| 2255 | * |
| 2256 | DM00 DAC ** |
| 2257 | STA IM IM = (A) |
| 2258 | JST STXA ESTABLISH A |
| 2259 | LDA DP,1 |
| 2260 | LRL 9 |
| 2261 | LGR 3 IM(A) = IM |
| 2262 | LGL 3 |
| 2263 | ADD IM |
| 2264 | LLL 9 |
| 2265 | STA DP,1 |
| 2266 | JMP* DM00 |
| 2267 | * |
| 2268 | * |
| 2269 | * *********** |
| 2270 | * *DEFINE AF* |
| 2271 | * *********** |
| 2272 | * AF SUBA = AF (SET FROM A REG) |
| 2273 | * |
| 2274 | DA00 DAC ** |
| 2275 | STA AF AF = (A) |
| 2276 | LRL 14 |
| 2277 | JST STXA |
| 2278 | DA10 LDA DP+1,1 IF IU (A) NOT ARR |
| 2279 | LGR 14 |
| 2280 | CAS K103 GF (A) = AF |
| 2281 | JMP *+2 |
| 2282 | JMP DA20 ELSE, GF (GF (A)) = AF |
| 2283 | LLL 14 |
| 2284 | STA DP+1,1 |
| 2285 | JMP* DA00 RETURN |
| 2286 | DA20 LDA DP+1,1 |
| 2287 | ANA K111 |
| 2288 | STA GFA |
| 2289 | STA 0 |
| 2290 | JMP DA10 |
| 2291 | NXT DAC ** GET NEXT ENTRY |
| 2292 | LDA A FROM ASSIGNMENT |
| 2293 | ADD K105 =5 |
| 2294 | STA A |
| 2295 | STA 0 |
| 2296 | CAS ABAR |
| 2297 | JMP* NXT |
| 2298 | NOP |
| 2299 | IRS NXT |
| 2300 | LDA DP,1 |
| 2301 | LRL 15 |
| 2302 | STA NTA NT(A) = NT FROM (A) |
| 2303 | CRA |
| 2304 | LLL 3 |
| 2305 | STA ATA AT(A) = AT FROM (A) |
| 2306 | CRA |
| 2307 | LLL 3 |
| 2308 | STA IMA IM(A) = IM FROM (A) |
| 2309 | CRA |
| 2310 | LLL 9 |
| 2311 | STA CLA CL(A) = CL FROM (A) |
| 2312 | LDA DP+1,1 |
| 2313 | LRL 14 |
| 2314 | STA IUA IU(A) = IU FROM (A) |
| 2315 | CRA |
| 2316 | LLL 14 |
| 2317 | STA GFA GF(A) = GF FROM (A) |
| 2318 | LDA DP+2,1 |
| 2319 | STA TIDA+2 TID(A) = TID FROM (A) |
| 2320 | LDA DP+3,1 |
| 2321 | STA TIDA+1 |
| 2322 | LDA DP+4,1 |
| 2323 | STA TIDA |
| 2324 | LRL 15 |
| 2325 | STA DTA DT(A) = DT FROM (A) |
| 2326 | CRA |
| 2327 | LLL 1 |
| 2328 | STA TTA TT(A) = TT FROM (A) |
| 2329 | LDA NTA NT(A) = NT FROM (A) |
| 2330 | SZE |
| 2331 | JMP* NXT |
| 2332 | LDA DP+4,1 |
| 2333 | SSM |
| 2334 | ALR 1 |
| 2335 | SSM |
| 2336 | ARR 1 |
| 2337 | STA TIDA |
| 2338 | JMP* NXT |
| 2339 | * |
| 2340 | * |
| 2341 | BUD DAC ** BUILD ASSIGNMENT |
| 2342 | JST STXA |
| 2343 | STA ABAR |
| 2344 | LDA TID TABLE ENTRY |
| 2345 | STA DP+4,1 |
| 2346 | LDA TID+1 |
| 2347 | STA DP+3,1 |
| 2348 | LDA TID+2 |
| 2349 | STA DP+2,1 |
| 2350 | LDA IU |
| 2351 | STA IUA |
| 2352 | LGL 14 |
| 2353 | STA DP+1,1 |
| 2354 | LDA NT |
| 2355 | LGL 3 |
| 2356 | ADD K102 AT = STR/+BS |
| 2357 | LGL 3 |
| 2358 | ADD IM |
| 2359 | LRL 16 |
| 2360 | STA CL |
| 2361 | LDA K102 |
| 2362 | STA AT |
| 2363 | LDA A CL(A) = A/5 |
| 2364 | SUB K105 |
| 2365 | SPL |
| 2366 | JMP *+3 |
| 2367 | IRS CL |
| 2368 | JMP *-4 |
| 2369 | LLL 25 |
| 2370 | ADD CL |
| 2371 | STA DP,1 |
| 2372 | SPL |
| 2373 | JMP* BUD |
| 2374 | LDA DT |
| 2375 | LGL 1 |
| 2376 | ADD TT |
| 2377 | LGL 14 |
| 2378 | IMA DP+4,1 |
| 2379 | ANA K111 |
| 2380 | ADD DP+4,1 |
| 2381 | STA DP+4,1 |
| 2382 | JMP* BUD |
| 2383 | * |
| 2384 | * |
| 2385 | * |
| 2386 | * |
| 2387 | * |
| 2388 | * ************ |
| 2389 | * *DEFINE AFT* |
| 2390 | * ************ |
| 2391 | * AT SUBA = AT (FROM B REG), THEN DEFINE AF |
| 2392 | * |
| 2393 | AF00 DAC ** |
| 2394 | IAB |
| 2395 | STA AF90 |
| 2396 | JST STXA |
| 2397 | LDA AF90 |
| 2398 | LGL 12 |
| 2399 | IMA DP,1 |
| 2400 | ANA AF91 |
| 2401 | ADD DP,1 |
| 2402 | STA DP,1 AT(A) = CONTENTS OF B INPUT |
| 2403 | IAB |
| 2404 | JST DA00 DEFINE AF |
| 2405 | JMP* AF00 |
| 2406 | AF90 PZE 0 |
| 2407 | AF91 OCT 107777 |
| 2408 | * |
| 2409 | * |
| 2410 | * ***************** |
| 2411 | * *DEFINE LOCATION* |
| 2412 | * ***************** |
| 2413 | * SET AF = RPL, AT = REL |
| 2414 | LO00 DAC ** |
| 2415 | LDA K101 REL |
| 2416 | IAB |
| 2417 | LDA RPL |
| 2418 | JST AF00 DEFINE AF |
| 2419 | JMP* LO00 |
| 2420 | * ************************* |
| 2421 | * *ASSIGN INTEGER CONSTANT* |
| 2422 | * ************************* |
| 2423 | * IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL |
| 2424 | AI00 DAC ** |
| 2425 | CRA |
| 2426 | STA ID+1 |
| 2427 | STA ID+2 |
| 2428 | LDA K101 (B) = INT |
| 2429 | IAB |
| 2430 | LDA K102 (A) = VAR |
| 2431 | JST AA00 ASSIGN SPECIAL |
| 2432 | JMP* AI00 RETURN |
| 2433 | * |
| 2434 | * |
| 2435 | * **************** |
| 2436 | * *ASSIGN SPECIAL* |
| 2437 | * **************** |
| 2438 | * B REG TO IM, A REG TO IU, 1 TO NT (CONSTANT), THEN |
| 2439 | * ASSIGN ITEM |
| 2440 | AA00 DAC ** |
| 2441 | STA IU IU = (A) |
| 2442 | IAB |
| 2443 | STA IM IM = (B) |
| 2444 | LDA K101 |
| 2445 | STA NT NT = 1 |
| 2446 | JST AS00 ASSIGN ITEM |
| 2447 | JMP* AA00 RETURN |
| 2448 | * |
| 2449 | * |
| 2450 | * ********** |
| 2451 | * *JUMP * |
| 2452 | * *ILL TERM* |
| 2453 | * ********** |
| 2454 | * |
| 2455 | * CLEAR LAST OP FLAG FOR NO PATH TESTING |
| 2456 | * |
| 2457 | B6 CRA |
| 2458 | STA LSTP LSTP = 0 |
| 2459 | * SET ILLEGAL DO TERM FLAG |
| 2460 | C5 LDA K101 |
| 2461 | STA LSTF LSTF =1 |
| 2462 | A1 LDA CRET |
| 2463 | JST TS00 IF TC NOT C/R, ERROR |
| 2464 | JMP C6 |
| 2465 | * |
| 2466 | * |
| 2467 | * ********** |
| 2468 | * *CONTINUE* |
| 2469 | * ********** |
| 2470 | * WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH |
| 2471 | * DO TABLE FOR DO TERMINATION |
| 2472 | C6 LDA LIF |
| 2473 | SZE IF LIF NON-ZERO, |
| 2474 | JMP C6H GO TO |
| 2475 | C6A LDA LSTN IF LSTN NON-ZERO, |
| 2476 | SZE GO TO |
| 2477 | JMP C6C |
| 2478 | C6B STA LSTF LSTF = 0 |
| 2479 | JMP C7 GO TO STATEMENT INPUT |
| 2480 | C6C SUB TRF TRACE FLAG |
| 2481 | SNZ SMP IF NOT END OF TRACE ZONE |
| 2482 | STA TRF SET TRF TO ZERO (TURN FLAG OFF) |
| 2483 | LDA DO START OF DO TABLE |
| 2484 | ADD D |
| 2485 | C6D STA I I = DO + D |
| 2486 | JST STXI |
| 2487 | SUB DO |
| 2488 | SNZ |
| 2489 | JMP C6B GO TO C6B - FINISHED DO |
| 2490 | LDA DP-4,1 |
| 2491 | SUB LSTN |
| 2492 | SZE |
| 2493 | JMP C6E |
| 2494 | LDA LSTF |
| 2495 | SZE |
| 2496 | JMP C6K |
| 2497 | JST DQ00 DO TERMINATION |
| 2498 | LDA D |
| 2499 | SUB K105 |
| 2500 | STA D D = D-5 |
| 2501 | LDA LSTF |
| 2502 | C6E STA LSTF |
| 2503 | LDA I |
| 2504 | SUB K105 |
| 2505 | JMP C6D I = I-5 - CONTINUE DO LOOP |
| 2506 | C6H LDA IFF |
| 2507 | STA A |
| 2508 | SNZ |
| 2509 | JMP C6J |
| 2510 | LLL 16 |
| 2511 | LDA OMI5 (A) = JMP INSTRUCTION |
| 2512 | JST OB00 OUTPUT OA |
| 2513 | CRA |
| 2514 | STA IFF IFF = 0 |
| 2515 | C6J STA A A = 0 |
| 2516 | LDA LIF |
| 2517 | STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG |
| 2518 | JST OS00 OUTPUT STRING - RPL |
| 2519 | JMP C6A |
| 2520 | * |
| 2521 | C6K JST ER00 |
| 2522 | BCI 1,DT |
| 2523 | * |
| 2524 | * ***************** |
| 2525 | * *STATEMENT INPUT* |
| 2526 | * ***************** |
| 2527 | * SET UP PROCESSING OF NEXT SOURCE STATEMENT |
| 2528 | * PROCESS STATEMENT NUMBER IF PRESENT |
| 2529 | * WRAPUP ANY OUTSTANDING ARITHMETIC IF |
| 2530 | C7 CRA |
| 2531 | STA LSTN LSTN = 0 |
| 2532 | STA IFLG IFLG = 0 |
| 2533 | STA LIF LIF = 0 |
| 2534 | LDA L0 L = L (0) |
| 2535 | STA L |
| 2536 | LDA CI CHECK CARD COLUMN 1 |
| 2537 | LGR 8 FOR $ CHARACTER |
| 2538 | SUB K15 =($) |
| 2539 | SNZ |
| 2540 | JMP CCRD CONTROL CARD |
| 2541 | JST XN00 EXAMINE NEXT CHAR |
| 2542 | SZE |
| 2543 | JMP C71 |
| 2544 | JST IS00 INPUT STATEMENT = |
| 2545 | LDA A |
| 2546 | STA LSTN LSTN = A |
| 2547 | STA LSTP |
| 2548 | C71 LDA IFF CHECK FOR IFF=0 |
| 2549 | LDA IFF IF IFF = 0, |
| 2550 | SNZ |
| 2551 | JMP C7B GO TO C7B |
| 2552 | SUB LSTN IF = LSTN |
| 2553 | SZE |
| 2554 | JMP C7C |
| 2555 | C7A STA IFF IFF = 0 |
| 2556 | C7B JST C7LT LINE TEST |
| 2557 | JMP C8 |
| 2558 | C7C LDA IFF IFF = A |
| 2559 | STA A |
| 2560 | LRL 32 |
| 2561 | LDA K201 (A) = JMP INSTRUCTION |
| 2562 | JST OB00 OUTPUT OA |
| 2563 | CRA |
| 2564 | JMP C7A GO TO C7A |
| 2565 | C7LT DAC ** LINE TEST |
| 2566 | LDA CI+2 CI = BLANK |
| 2567 | ANA K116 LIST LINE |
| 2568 | ADD K8 RETURN |
| 2569 | STA CI+2 |
| 2570 | LDA TC |
| 2571 | SUB HC2 IF TC = SPECIAL |
| 2572 | SZE |
| 2573 | JMP C7LU |
| 2574 | JST LIST |
| 2575 | JMP* C7LT |
| 2576 | C7LU JST ER00 CONSTRUCTION ERROR |
| 2577 | BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD |
| 2578 | * |
| 2579 | * |
| 2580 | * |
| 2581 | * ************************ |
| 2582 | * *CONTROL CARD PROCESSOR* |
| 2583 | * ************************ |
| 2584 | CCRD JST FS00 FLUSH BUFFER IF NECESSARY |
| 2585 | JST LIST LIST CARD |
| 2586 | LDA CI WORD CONTAINING COLUMN 1 |
| 2587 | LGL 12 |
| 2588 | SNZ |
| 2589 | LDA CCRK ='030000 (EOJ CODE = 3) |
| 2590 | LGR 6 TRUNCATE TO A DIGIT |
| 2591 | STA OCI |
| 2592 | LDA K106 =6 |
| 2593 | STA OCNT SET BUFFER WORD COUNT TO 3 |
| 2594 | JST FS00 FLUSH BUFFER |
| 2595 | LDA CI |
| 2596 | LGL 12 CHECK COLUMN 1 FOR CONTROL CODE 0 |
| 2597 | SZE |
| 2598 | JMP ER20 SKIP TO NEXT CARD (NOT CONTROL CARD) |
| 2599 | CALL F4$END CLOSE-OUT I/0 DEVICES AND STOP |
| 2600 | JMP A0 RESTART NEW COMPILATION |
| 2601 | CCRK OCT 030000 EOJ CONTROL CODE |
| 2602 | * |
| 2603 | * **************** |
| 2604 | * *STATEMENT SCAN* |
| 2605 | * **************** |
| 2606 | * DETERMINE THE CLASS OF THE STATEMENT |
| 2607 | * IF AN = IS FOUND WITH A FOLLOWING , |
| 2608 | * THE STATEMENT IS A DO |
| 2609 | * IF NO FOLLOWING COMMA, THE PAREN FLAG |
| 2610 | * IS TESTED, IF NO PARENS, THE STATEMENT |
| 2611 | * IS ARITHMETIC ASSIGNMENT |
| 2612 | * IF PARENS WERE DETECTED AND THE FIRST |
| 2613 | * NAME IS AN ARRAY, THE STATEMENT IS |
| 2614 | * ARITHMETIC ASSIGNMENT |
| 2615 | * OTHERWISE, IT IS A STATEMENT FUNCTION |
| 2616 | * IF NO = IS FOUND, THE STATEMENT IS |
| 2617 | * PROCESSED FURTHER IN STATEMENT ID |
| 2618 | C8T1 PZE 0 |
| 2619 | C8 LDA CC SAVE CC |
| 2620 | STA C8X9 |
| 2621 | LDA K101 |
| 2622 | STA C8T1 T (1) = 1 |
| 2623 | CRA |
| 2624 | STA ICSW ICSW = SIR |
| 2625 | C8A JST CH00 INPUT CHARACTER |
| 2626 | C8B LDA TC IF TC = ) |
| 2627 | SUB K4 |
| 2628 | SZE |
| 2629 | JMP C8C |
| 2630 | JST CH00 INPUT CHAR |
| 2631 | C8B2 LDA DFL IF DFL NOT ZERO |
| 2632 | SZE |
| 2633 | JMP C8B GO TO C8B |
| 2634 | C8B4 LDA C8X9 RESTORE CC |
| 2635 | STA CC |
| 2636 | LDA K101 IPL |
| 2637 | STA ICSW ICSW = IPL |
| 2638 | JMP A9 GO TO STATEMENT ID |
| 2639 | C8C LDA TC IF TC NOT (, |
| 2640 | SUB K17 |
| 2641 | SZE |
| 2642 | JMP C8D GO TO C8D |
| 2643 | LDA C8T1 T1 = T1 - 1 |
| 2644 | SUB K101 |
| 2645 | STA C8T1 |
| 2646 | C8C4 SZE IF T1 = 0 |
| 2647 | JMP C8B4 |
| 2648 | JST DN00 INPUT DNA |
| 2649 | JMP C8B2 GO TO C8B2 |
| 2650 | C8D LDA TC IF TC = , |
| 2651 | CAS K134 ='17 ('FINISHED' CODE FOR COMMA) |
| 2652 | JMP *+2 |
| 2653 | JMP C8D2 TC = COMMA |
| 2654 | SUB K5 |
| 2655 | SZE |
| 2656 | JMP C8E |
| 2657 | C8D2 LDA C8T1 GO TO C8C4, |
| 2658 | JMP C8C4 |
| 2659 | C8E LDA TC ELSE, IF TC = '/' |
| 2660 | SUB K9 |
| 2661 | SNZ |
| 2662 | JMP C8B4 GO TO C8B4 |
| 2663 | LDA TC |
| 2664 | SUB K18 IF NOT = , |
| 2665 | SZE |
| 2666 | JMP C8A GO TO C8A |
| 2667 | LDA K107 INPUT 7 CHARACTERS |
| 2668 | JST IA00 |
| 2669 | LDA C8X9 RESTORE CC |
| 2670 | STA CC |
| 2671 | LDA K101 IPL |
| 2672 | STA ICSW ICSW = IPL |
| 2673 | LDA TC |
| 2674 | SUB K5 IF TC NOT, |
| 2675 | SZE |
| 2676 | JMP C8G GO TO C8G |
| 2677 | LDA K102 ELSE, INPUT 2 CHARS |
| 2678 | JST IA00 |
| 2679 | LDA IBUF IF (A) = 'DO' |
| 2680 | SUB K19 |
| 2681 | SNZ |
| 2682 | JMP *+3 |
| 2683 | JST ER00 |
| 2684 | BCI 1,CM COMMA OUTSIDE PARENTHESES, NOT IN DO STMNT. |
| 2685 | LDA K104 |
| 2686 | JST NP00 FIRST NON-SPEC CHECK |
| 2687 | JMP C9 GO TO DO |
| 2688 | C8G LDA C8T1 1 IF NO ( TO LEFT OF EQUALS |
| 2689 | SZE |
| 2690 | JMP G2 ARITHMETIC ASSIGNMENT STATEMENT |
| 2691 | JST SY00 INPUT SYMBOL |
| 2692 | LDA C8X9 |
| 2693 | STA CC RESTORE CC |
| 2694 | LDA IU IF IU = SUBR |
| 2695 | SUB K103 |
| 2696 | SZE |
| 2697 | JMP G1 GO TO ARITH ST. FUNCT, |
| 2698 | JMP G2 OTHERWISE = ASSIGNMENT STATEMENT |
| 2699 | C8X9 PZE 0 |
| 2700 | * |
| 2701 | * |
| 2702 | * ************************** |
| 2703 | * *STATEMENT IDENTIFICATION* |
| 2704 | * ************************** |
| 2705 | * READ FOUR CHARACTERS AND DETERMINE CORRECT ROUTINE |
| 2706 | * FOR PROCESSING, THEN CHECK SPELLING ON REST |
| 2707 | A9T1 PZE 0 |
| 2708 | A9T2 PZE 0 |
| 2709 | A9T3 PZE 0 |
| 2710 | A9 LDA K104 |
| 2711 | JST IA00 INPUT (4) CHARS |
| 2712 | LDA IBUF |
| 2713 | STA NAMF NAMF = IBUF |
| 2714 | LDA IBUF+1 |
| 2715 | STA NAMF+1 |
| 2716 | LDA A9Z9 INITIALIZE INDEX FOR LOOP |
| 2717 | STA XR THROUGH THE STATEMENT NAMES |
| 2718 | A9A LDA NAMF |
| 2719 | SUB A9X1+30,1 |
| 2720 | SZE |
| 2721 | JMP A9F READ IN REST OF |
| 2722 | LDA NAMF+1 CHECK REST OF SPELLING FOR |
| 2723 | SUB A9X2+30,1 |
| 2724 | SZE A MATCH ON 4 CHARACTERS |
| 2725 | JMP A9F NOT FOUND |
| 2726 | LDA A9X4+30,1 |
| 2727 | ANA K133 |
| 2728 | STA A9T1 T1 = NUMBER OF REMAINING CHARACTERS |
| 2729 | LDA A9X3+30,1 LEFT TO CHECK |
| 2730 | LRL 13 |
| 2731 | IAB |
| 2732 | LGR 3 |
| 2733 | STA A9T2 T2 = ADDRESS OF ROUTINE |
| 2734 | IAB |
| 2735 | JST NP00 FIRST NON-SPECIFIC. CHECK -(A) = |
| 2736 | A9B LDA A9T1 HIERARCHY CODE |
| 2737 | SZE |
| 2738 | JMP A9C MUST CHECK MORE CHARACTERS |
| 2739 | JMP* A9T2 FINISHED CHARACTER CHECK, EXIT TO |
| 2740 | * SPECIFIC ANALYZER. |
| 2741 | A9C SUB K106 |
| 2742 | SPL |
| 2743 | JMP A9E |
| 2744 | STA A9T1 |
| 2745 | LDA K106 REMAINING SPELLING 1S CHECKED. |
| 2746 | A9D STA A9T3 |
| 2747 | JST IA00 |
| 2748 | SUB A9T3 |
| 2749 | SNZ |
| 2750 | JMP A9B |
| 2751 | JST ER00 |
| 2752 | BCI 1,SP STATEMENT NAME MISSPELLED |
| 2753 | A9E ADD K106 |
| 2754 | IMA A9T1 |
| 2755 | CRA |
| 2756 | IMA A9T1 |
| 2757 | JMP A9D |
| 2758 | A9F IRS XR LOOP CONTROL FOR STATEMENT NAMES. |
| 2759 | JMP A9A MORE NAMES - CONTINUE LOOP |
| 2760 | LDA TC |
| 2761 | SUB CRET |
| 2762 | SZE |
| 2763 | JMP A9G |
| 2764 | LDA LSTN TC = C/R |
| 2765 | SNZ |
| 2766 | JMP C7 AND LSTN = 0 - INPUT NEW STATEMENT |
| 2767 | A9G JST ER00 |
| 2768 | BCI 1,ID UNRECOGNIZED STATEMENT |
| 2769 | A9X1 BCI 10,INREDOCOLOFUSUBLEXDI |
| 2770 | BCI 10,COEQGOCARECOFOIFWRRE |
| 2771 | BCI 7,BAENREENASSTPA |
| 2772 | BCI 2,DATR |
| 2773 | BCI 1,PR |
| 2774 | A9X2 BCI 10,TEALUBMPGINCBROCTEME |
| 2775 | BCI 10,MMUITOLLTUNTRM( ITAD |
| 2776 | BCI 3,CKDFWI |
| 2777 | OCT 142215 D, C/R |
| 2778 | BCI 3,SIOPUS |
| 2779 | BCI 2,TAAC |
| 2780 | BCI 1,IN |
| 2781 | A9X3 DAC A3 |
| 2782 | DAC A4 |
| 2783 | DAC A5 |
| 2784 | DAC A6 |
| 2785 | DAC A7 |
| 2786 | DAC R1 |
| 2787 | DAC R2 |
| 2788 | DAC R3 |
| 2789 | DAC B2 |
| 2790 | DAC B3 |
| 2791 | DAC B4 |
| 2792 | DAC B5 |
| 2793 | DAC* R7 |
| 2794 | DAC* R8 |
| 2795 | DAC* R9 |
| 2796 | DAC* CONT |
| 2797 | DAC* V2 |
| 2798 | DAC* V3 |
| 2799 | DAC* V4 |
| 2800 | DAC* V5 |
| 2801 | DAC* V6 |
| 2802 | DAC* V7 |
| 2803 | DAC* V8 |
| 2804 | DAC W5+'20000 |
| 2805 | DAC* W3 |
| 2806 | DAC* W7 |
| 2807 | DAC* W8 |
| 2808 | DAC W4,1 |
| 2809 | DAC* TRAC+'20000,1 TRACE STATEMENT |
| 2810 | DAC* V10 |
| 2811 | * |
| 2812 | * ****************************** |
| 2813 | * *CONTINUE STATEMENT PROCESS0R* |
| 2814 | * ****************************** |
| 2815 | CONT LDA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR |
| 2816 | ADD LSTN ACCOUNTS FOR POSSIBLE PATH ERROR |
| 2817 | STA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR |
| 2818 | JMP C6 |
| 2819 | * |
| 2820 | *-------------THE FOLLOWING TABLE IS USED BY STATEMENT ID |
| 2821 | *-------------(RIGHT 6 BITS) AND OUTPUT ITEM, |
| 2822 | A9X4 OCT 000003 (00) |
| 2823 | OCT 030100 (01) + (A$--) |
| 2824 | OCT 032313 (02) - (S$--) |
| 2825 | OCT 031503 (03) * (M$--) |
| 2826 | OCT 030403 (04) / (D$--) |
| 2827 | OCT 000004 (05) .NOT. |
| 2828 | OCT 000006 (06) .AND. |
| 2829 | OCT 031405 (07) .OR. (L$-. |
| 2830 | OCT 000004 (10) .LT. |
| 2831 | OCT 000005 (11) .LE. |
| 2832 | OCT 000002 (12) .EQ. |
| 2833 | OCT 000007 (13) .GE. |
| 2834 | OCT 000000 (14) .GT. |
| 2835 | OCT 000000 (15) .NE. |
| 2836 | OCT 031003 (16) = (H$--) |
| 2837 | OCT 000005 (17) , |
| 2838 | OCT 030503 (20) 'E' (E$--) |
| 2839 | OCT 031600 (21) 'C' NC$--) |
| 2840 | OCT 000001 (22) 'A' |
| 2841 | OCT 000000 (23) |
| 2842 | OCT 000005 (24) 'X' |
| 2843 | OCT 000003 (25) 'H' |
| 2844 | OCT 000002 (26) 'L' |
| 2845 | OCT 000000 (27) 'I' |
| 2846 | OCT 000002 (30) 'T' |
| 2847 | OCT 031400 (31) 'F' (L$--) |
| 2848 | OCT 000001 (32) 'Q' |
| 2849 | OCT 000000 |
| 2850 | OCT 000001 |
| 2851 | OCT 000001 |
| 2852 | A9Z9 DAC* -30,1 NO. OF ITEMS IN STMNT NAME TABLE |
| 2853 | * |
| 2854 | * |
| 2855 | * ********************** |
| 2856 | * *FIRST NON-SPEC CHECK* |
| 2857 | * ********************** |
| 2858 | * AT FIRST SHIFT IN LEVEL FROM ZERO, WRAP-UP |
| 2859 | * SPECIFICATION STATEMENTS |
| 2860 | T0NP PZE 0 |
| 2861 | NPT0 EQU T0NP |
| 2862 | T2NP PZE 0 |
| 2863 | T1NP PZE 0 |
| 2864 | NP00 DAC ** |
| 2865 | STA NPT0 T0 = (A) |
| 2866 | LDA A |
| 2867 | STA T1NP T1 = A |
| 2868 | LDA NPT0 |
| 2869 | CAS K107 =7 |
| 2870 | JMP *+2 |
| 2871 | JMP NP10 TRACE STMNT. (MAY OCCUR ANYWHERE) |
| 2872 | CAS SPF T0 , G.R. SPF, GO TO NP30 |
| 2873 | JMP NP30 T0 = SPF, G0 TO NP25 |
| 2874 | JMP NP25 |
| 2875 | LDA TC IF TC = C/R |
| 2876 | SUB CRET GO TO NP10 |
| 2877 | SNZ |
| 2878 | JMP NP10 |
| 2879 | JST ER00 ELSE, ILLEGAL STATEMENT |
| 2880 | BCI 1,EX SPECIFICATION STATEMENT APPEARS AFTER |
| 2881 | * SPECIFICATION STATEMENT CLEAN-UP |
| 2882 | NP10 LDA LSTN |
| 2883 | STA A A = LSTN |
| 2884 | SNZ |
| 2885 | JMP NP16 IF ZERO, RETURN |
| 2886 | JST FA00 FETCH ASSIGNS |
| 2887 | LDA K103 STR-REL |
| 2888 | SUB AT |
| 2889 | SZE |
| 2890 | JMP NP20 |
| 2891 | LDA AF |
| 2892 | JST OS00 OUTPUT STRING RPL |
| 2893 | NP15 JST LO00 DEFINE LOCATION |
| 2894 | LDA NAMF |
| 2895 | SUB A9X1+16 |
| 2896 | SZE |
| 2897 | JST TRSE OUTPUT TRACE COUPLING |
| 2898 | NP16 LDA T1NP |
| 2899 | STA A |
| 2900 | JMP* NP00 |
| 2901 | NP20 JST NR00 NON-REL TEST |
| 2902 | JMP NP15 |
| 2903 | NP25 LDA LIF |
| 2904 | SZE |
| 2905 | JMP NP16 |
| 2906 | LDA LSTP IF LSTP + LSTN =0 |
| 2907 | ADD LSTN |
| 2908 | SZE |
| 2909 | JMP NP10 |
| 2910 | IRS LSTP |
| 2911 | JST ER00 'NO PATH' ERROR |
| 2912 | BCI 1,PH NO PATH LEADING TO THE STATEMENT |
| 2913 | NP30 LDA SPF IF SPF 0 0 |
| 2914 | SZE |
| 2915 | JMP NP37 |
| 2916 | NP32 LDA TC |
| 2917 | STA T2NP T2 = TC |
| 2918 | LDA RPL |
| 2919 | STA XST XST = RPL |
| 2920 | LDA BDF BLOCK DATA SUBPROGRAM FLAG |
| 2921 | SZE SKIP IF NOT BLOCK DATA SUBPROGRAM |
| 2922 | JMP C2 GO TO RELATE COMMON |
| 2923 | STA A SET LISTING FOR OCTAL ADDR. |
| 2924 | LDA OMI5 JMP INSTRUCTION |
| 2925 | STA DF SET LISTING FOR SYMBOLIC INSTR. |
| 2926 | JST OA00 OUTPUT ABSOLUTE |
| 2927 | JMP C2 GO TO RELATE COMMON |
| 2928 | NP35 LDA T2NP |
| 2929 | STA TC |
| 2930 | NP37 LDA T0NP |
| 2931 | STA SPF SPF = T0 |
| 2932 | SUB K104 |
| 2933 | SZE |
| 2934 | JMP NP10 |
| 2935 | NP40 STA A SET LISTING FOR OCTAL ADDR. |
| 2936 | LDA XST LOCATION OF INITIAL JUMP |
| 2937 | JST OS00 OUTPUT STRING |
| 2938 | LDA RPL |
| 2939 | STA XST XST = RPL |
| 2940 | JMP NP10 GO TO NP10 |
| 2941 | * |
| 2942 | * ***************** |
| 2943 | * *IF( PROCESSOR* |
| 2944 | * ***************** |
| 2945 | * ARITHMETIC IF ($1 $2 $3) |
| 2946 | * IF $2 NOT = $3, JZE $2 |
| 2947 | * IF $3 NOT = $1, JPL $3 |
| 2948 | * (IF $1 NOT = NEXT ST NO., JMP $1) LATER |
| 2949 | * LOGICAL IF |
| 2950 | * OUTPUT JZE 77777 (FOR STRINGING AROUND |
| 2951 | * IMBEDDED STATEMENT) |
| 2952 | V3 JST II00 INPUT ITEM |
| 2953 | SNZ |
| 2954 | JMP V310 IM=0 (POSSI8LE UNARY + OR -) |
| 2955 | LDA DFL |
| 2956 | SZE |
| 2957 | JMP V310 FIRST ITEM IN EXPRESSION 0.K. |
| 2958 | V308 JST ER00 ERROR.....IF(SENSE SWITCH,.ETC)..... |
| 2959 | BCI 1,IF ILLEGAL IF STATEMENT TYPE |
| 2960 | V310 CRA (A)=0 |
| 2961 | JST EX00 EXPRESSION EVALUATOR |
| 2962 | LDA K4 |
| 2963 | JST TS00 )-TEST |
| 2964 | CRA |
| 2965 | STA A SET A TO SPECIAL (IF) ENTRY IN DATA POOL |
| 2966 | STA 0 |
| 2967 | LDA MFL SET MODE OF EXPRESSION INTO SPECIAL (IF) |
| 2968 | LGL 9 |
| 2969 | STA DP,1 |
| 2970 | JST TRSE OUTPUT TRACE COUPLING (IF NECESSARY) |
| 2971 | LDA MFL CHECK MODE FLAG FOR LOGICAL |
| 2972 | SUB K103 |
| 2973 | SZE |
| 2974 | JMP V320 ARITHMETIC IF |
| 2975 | LDA LIF |
| 2976 | SZE |
| 2977 | JMP V308 |
| 2978 | STA AF SET ADDR OF SNZ AND JMP INSTR TO 00000 |
| 2979 | LDA OMJ2 =SNZ INSTR. |
| 2980 | JST OA00 OUTPUT ABSOLUTE |
| 2981 | LDA RPL SET LIF=CURRENT +DDR, (STRING BACK) |
| 2982 | STA LIF |
| 2983 | LDA OMI5 =JMP 0 INSTR. |
| 2984 | JST OA00 OUTPUT ABSOLUTE |
| 2985 | JST XN00 GO TO NEXT INPUT LINE |
| 2986 | JMP C8 GO TO STATEMENT SCAN |
| 2987 | * |
| 2988 | V320 SUB K102 CHECK FOR MODE = COMPLEX |
| 2989 | SNZ |
| 2990 | JMP V308 ERROR,...COMPLEX MODE EXPRESSION |
| 2991 | LDA V356 =-3 |
| 2992 | STA I |
| 2993 | V324 JST IS00 INPUT STATEMENT NUMBER |
| 2994 | JST STXI SET INDEX TO I |
| 2995 | LDA A |
| 2996 | STA T1V3+3,1 SAVE BRANCH ADDRESSES |
| 2997 | IRS I I=I+1 |
| 2998 | JMP V350 CHECK FOR TERMINAL COMMA |
| 2999 | LDA T3V3 |
| 3000 | CAS T2V3 CHECK FOR ADDR-2 = ADDR-3 |
| 3001 | JMP *+2 |
| 3002 | JMP V330 ADDR-2 = ADDR-3 |
| 3003 | CRA |
| 3004 | STA A |
| 3005 | LDA OMJ2 =SNZ INSTR. |
| 3006 | STA DF |
| 3007 | JST OA00 OUTPUT ABSOLUTE |
| 3008 | LDA T2V3 |
| 3009 | JST V360 OUTPUT A JMP(ADDR-2) INSTR. |
| 3010 | LDA T3V3 |
| 3011 | V330 CAS T1V3 CHECK FOR ADDR-3 = ADDR-2 |
| 3012 | JMP *+2 |
| 3013 | JMP V340 ADDR-3 = ADDR-1 |
| 3014 | CRA |
| 3015 | STA A |
| 3016 | LDA OMJ3 =SMI INSTR. |
| 3017 | JST OA00 OUTPUT ABSOLUTE |
| 3018 | LDA T3V3 |
| 3019 | JST V360 OUTPUT A JMP (ADDR-3) INSTR. |
| 3020 | V340 LDA T1V3 |
| 3021 | STA IFF SET IFF ' ADDR-1 |
| 3022 | JMP C5 GO TO ILL-TERM |
| 3023 | * |
| 3024 | V350 LDA K5 |
| 3025 | JST TS00 COMMA TEST |
| 3026 | JMP V324 INPUT NEXT STATEMENT NO. |
| 3027 | * |
| 3028 | V356 OCT 177775 -3 |
| 3029 | * |
| 3030 | *---------------SUBROUTINE TO OUTPUT A RELATIVE JMP |
| 3031 | V360 DAC ** |
| 3032 | STA A SET ADDR. OF JUMP REF. TO A |
| 3033 | CRA |
| 3034 | IAB SET (B) = 0 |
| 3035 | LDA OMI5 SET (A) = JMP INSTR. |
| 3036 | JST OB00 OUTPUT OA |
| 3037 | JMP* V360 EXIT |
| 3038 | * |
| 3039 | T1V3 *** ** ADDR-1 |
| 3040 | T2V3 *** ** ADDR-2 |
| 3041 | T3V3 *** ** ADDR-3 |
| 3042 | * |
| 3043 | * ******* |
| 3044 | * *GO TO* |
| 3045 | * ******* |
| 3046 | * CHECK FOR NORMAL (R740), COMPUTED (R710) OR |
| 3047 | * ASSIGNED (R730). INPUT BRANCH LIST USED BY BOTH |
| 3048 | * R710 AND R730 FOR STATEMENT NO. LIST. |
| 3049 | * |
| 3050 | * |
| 3051 | R7 JST XN00 EXAMINE NEXT CHAR |
| 3052 | SZE |
| 3053 | JMP R78 GO TO TEST DFL |
| 3054 | JST IS00 INPUT STMNT = |
| 3055 | LDA A (GO TO 20) |
| 3056 | STA IFF IFF = A |
| 3057 | JMP C5 G0 TO ILLTERM |
| 3058 | R78 LDA DFL |
| 3059 | SZE |
| 3060 | JMP R7D |
| 3061 | JST IR00 GO TO I (10, 20, 30} |
| 3062 | LRL 32 |
| 3063 | LDA K206 OUTPUT JMP* INSTRUCTION |
| 3064 | JST OB00 OUTPUT OA |
| 3065 | LDA K134 |
| 3066 | JST TS00 , TEST |
| 3067 | JST IB00 INPUT BRANCH LIST |
| 3068 | JMP B6 GO TO JUMP |
| 3069 | R7D JST IB00 INPUT BRANCH LIST GO TO (10,11,12), I |
| 3070 | LDA K134 |
| 3071 | JST TS00 , TEST |
| 3072 | JST IR00 INPUT INT VAR |
| 3073 | LRL 32 |
| 3074 | LDA K200 OUTPUT LDA |
| 3075 | JST OB00 OUTPUT OA |
| 3076 | CRA |
| 3077 | STA A |
| 3078 | STA AF CAUSE OCTAL ADDRESS IN LISTING |
| 3079 | LDA K75 |
| 3080 | JST OA00 OUTPUT ABS (STA 0) - INDEX LOAD |
| 3081 | LDA RPL |
| 3082 | STA AF CAUSE RPL T0 BE IN LISTING |
| 3083 | LDA K207 |
| 3084 | JST OR00 OUTPUT RELATIVE (JMP RPL,1) |
| 3085 | LDA L0 |
| 3086 | R7F SUB K101 |
| 3087 | STA I I = L (0) |
| 3088 | JST STXI |
| 3089 | LDA DP,1 |
| 3090 | STA A |
| 3091 | JST STXA |
| 3092 | SNZ |
| 3093 | JMP B6 FINISHED LOOPING ON LIST |
| 3094 | LLL 16 |
| 3095 | LDA K201 OUTPUT JMP INSTRUCTIONS |
| 3096 | JST OB00 OUTPUT OA (JMP 0) |
| 3097 | LDA I |
| 3098 | JMP R7F |
| 3099 | * ******************* |
| 3100 | * *INPUT BRANCH LIST* |
| 3101 | * ******************* |
| 3102 | * INPUT STATEMENT NO. LISTS FOR GO TO PROCESSOR |
| 3103 | IB00 DAC ** |
| 3104 | LDA L0 |
| 3105 | SUB K101 |
| 3106 | STA I I = L0-1 |
| 3107 | JST CH00 INPUT CHAR |
| 3108 | LDA K17 |
| 3109 | JST TS00 (- TEST |
| 3110 | IB10 JST IS00 INPUT STMNT = |
| 3111 | JST STXI |
| 3112 | LDA A |
| 3113 | STA DP,1 SET POINTER OF ST. N0. INTO TRIAD TABLE |
| 3114 | * AREA |
| 3115 | LDA I DP (J) = A |
| 3116 | SUB K101 |
| 3117 | STA I I = I-1 |
| 3118 | LDA TC IF TC = , GO TO IB10 |
| 3119 | SUB K5 |
| 3120 | SNZ |
| 3121 | JMP IB10 CONTINUE LOOP |
| 3122 | CRA |
| 3123 | STA DP-1,1 SET END FLAG INTO TABLE |
| 3124 | JST IP00 )- INPUT OPEN |
| 3125 | JMP* IB00 EXIT |
| 3126 | K75 STA 0 |
| 3127 | * |
| 3128 | * |
| 3129 | * ******** |
| 3130 | * *ASSIGN* |
| 3131 | * ******** |
| 3132 | * CHECK TO SEE THAT 'TO' IS INCLUDED PROPERLY |
| 3133 | W3 JST IS00 INPUT STMNT = |
| 3134 | LDA A |
| 3135 | STA T1W3 SAVE A |
| 3136 | LDA TC |
| 3137 | SUB K34 CHECK FOR TO |
| 3138 | SZE |
| 3139 | JMP W305 CLEAR A FOR OUTPUT REL |
| 3140 | STA A CAUSE OCTAL ADDRESS IN LIST |
| 3141 | JST CH00 INPUT CHAR |
| 3142 | LDA TC |
| 3143 | SUB K35 |
| 3144 | SNZ |
| 3145 | JMP *+3 |
| 3146 | W305 JST ER00 ERROR |
| 3147 | BCI 1,TO GO TO IN ASSIGN STATEMENT |
| 3148 | LDA RPL |
| 3149 | ADD K102 |
| 3150 | STA AF OUTPUT REL LDA *+2 |
| 3151 | LDA K200 OUTPUT LDA *+2 |
| 3152 | JST OR00 OUTPUT REL |
| 3153 | LDA RPL |
| 3154 | ADD K102 |
| 3155 | STA AF OUTPUT REL JMP *+2 |
| 3156 | LDA K201 |
| 3157 | JST OR00 OUTPUT OA |
| 3158 | LRL 32 |
| 3159 | LDA T1W3 |
| 3160 | STA A RESTORE A |
| 3161 | CRA |
| 3162 | JST OB00 OUTPUT DAC ST. NO. |
| 3163 | JST IR00 INPUT INTEGER VARIABLE |
| 3164 | LRL 32 |
| 3165 | LDA K202 OUTPUT STA INSTRUCTION |
| 3166 | JST OB00 OUTPUT OA |
| 3167 | JMP A1 GO TO C/R TEST |
| 3168 | T1W3 PZE ** TEMP STORE |
| 3169 | * |
| 3170 | * |
| 3171 | * ************************ |
| 3172 | * *DO STATEMENT PROCESSOR* |
| 3173 | * ************************ |
| 3174 | * STACK INFO IN DO TABLE, OUTPUT DO INITIAL |
| 3175 | * CODE |
| 3176 | C9T0 PZE ** |
| 3177 | C9 JST IS00 INPUT STATEMENT = |
| 3178 | JST NR00 NON-REL TEST |
| 3179 | LDA A |
| 3180 | STA C9T0 T0 = A |
| 3181 | JST UC00 UNINPUT COLUMN |
| 3182 | JST IR00 |
| 3183 | LDA C951 |
| 3184 | JST TS00 |
| 3185 | LDA C9T0 (A) = T0 |
| 3186 | IAB |
| 3187 | JST DP00 DO INPUT |
| 3188 | JST DS00 DO INITIALIZE |
| 3189 | JMP C5 GO TO ILLTERM |
| 3190 | C951 OCT 16 = |
| 3191 | * |
| 3192 | * |
| 3193 | * ********** |
| 3194 | * *END FILE* |
| 3195 | * ********** |
| 3196 | * *********** |
| 3197 | * *BACKSPACE* |
| 3198 | * *REWIND * |
| 3199 | * *********** |
| 3200 | V6 LDA K71 |
| 3201 | V6A STA NAMF+1 |
| 3202 | JST NF00 SET UP NAMF |
| 3203 | JST OI00 OUTPUT I/0 LINK |
| 3204 | JMP A1 GO TO C/R TEST |
| 3205 | V7 LDA K72 |
| 3206 | JMP V6A |
| 3207 | V8 LDA K73 |
| 3208 | JMP V6A |
| 3209 | K71 BCI 1,FN FN |
| 3210 | K72 BCI 1,DN |
| 3211 | K73 BCI 1,BN BN |
| 3212 | * |
| 3213 | * |
| 3214 | * ************** |
| 3215 | * *READ * |
| 3216 | * *WRITE * |
| 3217 | * *INPUT FORMAT* |
| 3218 | * ************** |
| 3219 | * LIST ELEMENT DATA AND IMPLIED DO CONTROL |
| 3220 | * STACKED IN TRIAD TABLE. PROCESSED BY |
| 3221 | * OUTPUT TRIAD ROUTINE, SPECIAL OPERATORS |
| 3222 | * ARE -I = DO INITIALIZATION |
| 3223 | * T = DO TERMINATION |
| 3224 | * Q = I/0 ARG TRANSFER |
| 3225 | T0V5 PZE ** |
| 3226 | V5 LDA K41 F$RN |
| 3227 | STA NAMF+1 |
| 3228 | JST XN00 EXAM NEXT CHAR |
| 3229 | SZE |
| 3230 | JMP V5A GENERAL READ |
| 3231 | LDA V5K4 |
| 3232 | JMP V10A CARD READ |
| 3233 | V4 LDA K40 NAWF = F$WN |
| 3234 | STA NAMF+1 |
| 3235 | V5A JST NF00 SET UP REMAINING NAME |
| 3236 | LDA D |
| 3237 | STA V5T1 |
| 3238 | JST CH00 INPUT CHARACTER |
| 3239 | LDA K17 ='250......( |
| 3240 | JST TS00 (-TEST |
| 3241 | JST OI00 OUTPUT I0 LINK |
| 3242 | LDA TC IF TC .NE. , |
| 3243 | SUB K134 ='17 (,) |
| 3244 | SZE GO TO V5J |
| 3245 | JMP V5J |
| 3246 | JST V5X INPUT FORMAT |
| 3247 | V5B JST IP00 ) - INPUT OPERATOR |
| 3248 | LDA TC |
| 3249 | SUB CRET TEST FOR TC=C/R |
| 3250 | SZE |
| 3251 | JMP V5C NO, GO TO V5C |
| 3252 | V5B2 LDA K42 YES. NAMF = ND |
| 3253 | STA NAMF+1 |
| 3254 | JST CN00 CALL NAME |
| 3255 | LDA V5T1 |
| 3256 | STA D |
| 3257 | JMP A1 GO TO C/R TEST |
| 3258 | V5C JST UC00 |
| 3259 | V5C5 CRA |
| 3260 | STA IOF IOF = 0 |
| 3261 | V5D JST II00 INPUT ITEM |
| 3262 | SZE |
| 3263 | JMP V5E IF (A) NOT 0, GO TO V5E |
| 3264 | LDA K17 |
| 3265 | JST TS00 (-TEST |
| 3266 | CRA |
| 3267 | STA O2 O2 = 0 |
| 3268 | LDA IOF |
| 3269 | STA O1 O1 = IOF |
| 3270 | LDA V5K1 ='27 |
| 3271 | STA P |
| 3272 | JST ET00 |
| 3273 | LDA L |
| 3274 | STA IOF IOF = L |
| 3275 | JMP V5D GO TO V5D |
| 3276 | V5E JST NC00 NON-CONSTANT TEST |
| 3277 | LDA IU IF IU NOT ARR |
| 3278 | SUB K103 |
| 3279 | SZE |
| 3280 | JMP V5H GO TO V5H |
| 3281 | LDA TC |
| 3282 | SUB K17 IF TC NOT -(, |
| 3283 | SZE |
| 3284 | JMP V5G GO TO V5G |
| 3285 | LDA D0 |
| 3286 | STA T0V5 T5 = DO |
| 3287 | LDA K103 |
| 3288 | TCA |
| 3289 | JST EX00 EXPRESSION |
| 3290 | LDA T0V5 |
| 3291 | STA D0 D0 = T5 |
| 3292 | V5E5 LDA A |
| 3293 | STA O2 |
| 3294 | LDA D0 O2 = D0 |
| 3295 | STA O1 |
| 3296 | LDA V5K2 ='32 |
| 3297 | STA P |
| 3298 | JST ET00 ENTER TRIAD |
| 3299 | V5E7 LDA TC IF TC = COMMA |
| 3300 | SUB K134 GO TO V5D |
| 3301 | SNZ |
| 3302 | JMP V5D |
| 3303 | LDA IOF I = IOF |
| 3304 | STA I |
| 3305 | SZE IF NOT ZERO, |
| 3306 | JMP V5F GO TO V5F |
| 3307 | JST OT00 OUTPUT TRIADS |
| 3308 | JMP V5B2 GO TO V5B2 |
| 3309 | V5F JST IP00 )-INPUT OPERATOR |
| 3310 | JST STXI |
| 3311 | LDA DP+1,1 |
| 3312 | STA IOF IOF = O1 (I) |
| 3313 | JMP V5E7 |
| 3314 | V5G JST KT00 K = = WDS/ITEM |
| 3315 | JMP V5E5 GO TO V5E5 |
| 3316 | V5H JST TV00 TAG VARIABLE |
| 3317 | LDA TC |
| 3318 | SUB K16X ='16 (=) |
| 3319 | SZE GO TO V5E5 |
| 3320 | JMP V5E5 ELSE, |
| 3321 | JST IT00 INTEGER TEST |
| 3322 | LDA IOF |
| 3323 | SNZ IF IOF = ZERO OR L |
| 3324 | JMP V5H7 |
| 3325 | SUB L |
| 3326 | SZE |
| 3327 | JMP *+3 ERROR |
| 3328 | V5H7 JST ER00 |
| 3329 | BCI 1,PR PARENTHESES MISSING IN DO STATEMENT |
| 3330 | JST DP00 DO INPUT |
| 3331 | LDA IOF |
| 3332 | STA I |
| 3333 | JST STXI |
| 3334 | LDA D |
| 3335 | STA DP,1 02(IOF) = D |
| 3336 | STA O2 O2 = D |
| 3337 | LDA V5K3 ='30 |
| 3338 | STA P |
| 3339 | JST ET00 ENTER TRIAD 'T'. |
| 3340 | JMP V5F |
| 3341 | V5J CRA |
| 3342 | STA A A = 0 |
| 3343 | JST OA00 OUTPUT ABSOLUTE |
| 3344 | JMP V5B |
| 3345 | V5T1 PZE 0 |
| 3346 | V5K1 OCT 27 |
| 3347 | V5K2 OCT 32 |
| 3348 | V5K3 OCT 30 |
| 3349 | V5K4 BCI 1,R3 |
| 3350 | V5K5 BCI 1,W4 |
| 3351 | V5X DAC ** INPUT FORMAT |
| 3352 | JST XN00 EXAM NEXT CHARACTER |
| 3353 | SZE |
| 3354 | JMP V5X5 GO TO INPUT ARRAY NAME |
| 3355 | JST IS00 INPUT STMNT NO. |
| 3356 | V5X2 LRL 32 OUTPUT DAC A |
| 3357 | JST OB00 OUTPUT OA |
| 3358 | JMP* V5X RETURN |
| 3359 | V5X5 JST NA00 INPUT NAME |
| 3360 | JST AT00 ARRAY TEST |
| 3361 | JMP V5X2 |
| 3362 | * PRINT |
| 3363 | V10 LDA V5K5 PRINTER |
| 3364 | V10A STA NAMF+1 |
| 3365 | JST NF00 SET UP REST OF NAME |
| 3366 | JST CN00 CALL NAME |
| 3367 | JST V5X INPUT FORMAT |
| 3368 | LDA TC |
| 3369 | SUB K134 |
| 3370 | SZE SKIP IF COMMA |
| 3371 | JMP V5B2 |
| 3372 | LDA D |
| 3373 | STA V5T1 |
| 3374 | JMP V5C5 |
| 3375 | * |
| 3376 | * |
| 3377 | * ************************** |
| 3378 | * *FORMAT * |
| 3379 | * *INPUT FORMAT STRING * |
| 3380 | * *INPUT NUMERIC FORMAT STR* |
| 3381 | * *NON ZERO TEST STRING * |
| 3382 | * ************************** |
| 3383 | T0V2 PZE 0 |
| 3384 | T2V2 PZE 0 |
| 3385 | V2T0 EQU T0V2 |
| 3386 | V2T2 EQU T2V2 |
| 3387 | V2 LDA K17 |
| 3388 | JST OK00 OUTPUT RACK |
| 3389 | CRA |
| 3390 | STA T0V2 T0 = 0 |
| 3391 | LDA LSTP IF LSTOP .NE. 0 |
| 3392 | SZE |
| 3393 | JMP V2K GO TO V2K |
| 3394 | V2A JST SI00 INPUT FORMAT STRING |
| 3395 | SZE |
| 3396 | JMP V2B |
| 3397 | V2A1 LDA TC |
| 3398 | SUB K12 IF TC NOT MINUS |
| 3399 | SZE |
| 3400 | JMP V2F GO TO V2F |
| 3401 | JST IN00 INPUT NUMERIC FORMAT STRING |
| 3402 | CRA |
| 3403 | STA TID TID = 0 |
| 3404 | V2B LDA TC IF TC .NE. P |
| 3405 | SUB K46 |
| 3406 | SZE |
| 3407 | JMP V2H GO TO V2H |
| 3408 | JST SI00 INPUT FORMAT STRING |
| 3409 | SZE |
| 3410 | JST NZ00 IF (A) .NE. 0 |
| 3411 | V2C LDA TC |
| 3412 | CAS K52 IF TC = D,E,F, OR G |
| 3413 | NOP |
| 3414 | JMP *+2 |
| 3415 | JMP V2DA |
| 3416 | CAS K53 |
| 3417 | JMP V2E5-2 |
| 3418 | NOP |
| 3419 | JST IN00 INPUT NUMERIC FORMAT STRING |
| 3420 | JST NZ00 NON-ZERO STRING TEST |
| 3421 | LDA K10 |
| 3422 | JST TS00 PERIOD TEST |
| 3423 | V2D JST IN00 INPUT NUMERIC FORMAT STRING |
| 3424 | V2DA LDA TC IF TC = ) |
| 3425 | SUB K4 |
| 3426 | SZE |
| 3427 | JMP V2E |
| 3428 | JST CH00 |
| 3429 | JST OK00 INPUT CHAR AND OUTPUT PACK |
| 3430 | LDA T0V2 IF F4 + ( = ( |
| 3431 | SUB K101 GO TO V2E |
| 3432 | STA T0V2 |
| 3433 | SPL |
| 3434 | JMP V2N ELSE, |
| 3435 | JMP V2DA |
| 3436 | * GO TO C/R TEST |
| 3437 | V2E LDA TC IF TC =, |
| 3438 | SUB K5 |
| 3439 | SNZ |
| 3440 | JMP V2A GO TO V2A |
| 3441 | LDA K9 |
| 3442 | JST TS00 / TEST |
| 3443 | JMP V2A |
| 3444 | V2E5 JST SI00 INPUT FORMAT STRING |
| 3445 | SZE IF (A) NOT 0, |
| 3446 | JMP V2B GO TO V2B |
| 3447 | LDA DFL IF DFL .NE. ZERO, |
| 3448 | SZE |
| 3449 | JMP V2DA GO TO V2DA |
| 3450 | JMP V2A1 |
| 3451 | V2F LDA TC IF TC = H |
| 3452 | CAS K48 |
| 3453 | JMP *+2 |
| 3454 | JMP V2P GO TO V2P |
| 3455 | V2FB CAS K47 |
| 3456 | JMP *+2 |
| 3457 | JMP V2E5 |
| 3458 | CAS K17 IF TC = (, |
| 3459 | JMP *+2 |
| 3460 | JMP V2Q GO TO V2Q |
| 3461 | LDA TC IF TC .NE. A,I, OR L |
| 3462 | CAS K49 A |
| 3463 | JMP *+2 |
| 3464 | JMP V2G |
| 3465 | CAS K50 I |
| 3466 | JMP *+2 |
| 3467 | JMP V2G |
| 3468 | SUB K51 L |
| 3469 | SZE |
| 3470 | JMP V2C |
| 3471 | V2G JST IN00 INPUT NUMERIC FORMAT STRING |
| 3472 | JST NZ00 NON-ZERO STRING TEST |
| 3473 | JMP V2DA |
| 3474 | V2H JST NZ00 NON-ZERO STRING TEST |
| 3475 | LDA TC IF TC = H, |
| 3476 | SUB K48 |
| 3477 | SZE |
| 3478 | JMP V2F |
| 3479 | V2J JST HS00 TRANSMIT HOLLERITH STRING |
| 3480 | JMP V2E5 GO TO V2E5 |
| 3481 | V2K LDA LSTN IF LSTN = 0, |
| 3482 | SZE |
| 3483 | JMP *+3 |
| 3484 | JST ER00 ERR0R, NO PATH |
| 3485 | BCI 1,NF NO REFERENCE TO FORMAT STATEMENT |
| 3486 | LDA RPL LIF = RPL |
| 3487 | STA LIF |
| 3488 | CRA |
| 3489 | STA A |
| 3490 | STA AF |
| 3491 | AOA |
| 3492 | STA DF |
| 3493 | LDA K201 = JMP 0 |
| 3494 | JST OA00 OUTPUT ABS |
| 3495 | JMP V2A GO TO V2A |
| 3496 | * |
| 3497 | NZ00 DAC ** |
| 3498 | LDA TID |
| 3499 | SZE |
| 3500 | JMP* NZ00 |
| 3501 | NZ10 JST ER00 |
| 3502 | BCI 1,NZ NON-ZERO STRING TEST FAILED |
| 3503 | IN00 DAC ** |
| 3504 | JST SI00 (A) = 0 IS ERROR CONDITION |
| 3505 | SZE |
| 3506 | JMP* IN00 |
| 3507 | JMP NZ10 |
| 3508 | SI00 DAC ** |
| 3509 | CRA |
| 3510 | STA TID ID = T2 = 0 |
| 3511 | SI05 STA V2T2 |
| 3512 | JST CH00 INPUT CHAR |
| 3513 | JST OK00 OUTPUT PACK |
| 3514 | LDA TC |
| 3515 | SUB K60 ASC-2 ZERO |
| 3516 | CAS K124 |
| 3517 | JMP SI10 |
| 3518 | NOP |
| 3519 | SPL |
| 3520 | JMP SI10 |
| 3521 | STA TC |
| 3522 | LDA TID TID = 10*TID+TC |
| 3523 | ALS 3 |
| 3524 | ADD TID |
| 3525 | ADD TID |
| 3526 | ADD TC |
| 3527 | STA TID |
| 3528 | LDA K101 T2 =1 |
| 3529 | JMP SI05 |
| 3530 | SI10 LDA V2T2 (A) = ERROR CONDITION OR NOT |
| 3531 | JMP* SI00 |
| 3532 | V2M JST ER00 |
| 3533 | BCI 1,FR FORMAT STATEMENT ERROR |
| 3534 | V2N EQU A1 |
| 3535 | V2P LDA K101 |
| 3536 | STA ID ID = 1 |
| 3537 | JMP V2J GO TO V2J |
| 3538 | V2Q LDA T0V2 |
| 3539 | AOA |
| 3540 | STA T0V2 |
| 3541 | SUB K103 |
| 3542 | SZE |
| 3543 | JMP V2A |
| 3544 | JMP V2M |
| 3545 | K46 OCT 320 0P |
| 3546 | K47 OCT 330 0X |
| 3547 | K48 EQU K14 0H |
| 3548 | K49 OCT 301 0A |
| 3549 | K51 OCT 314 0L |
| 3550 | K52 EQU K11 0D |
| 3551 | K53 OCT 307 0G |
| 3552 | K50 EQU K43 0I |
| 3553 | * |
| 3554 | * |
| 3555 | * ******* |
| 3556 | * *STOP * |
| 3557 | * *PAUSE* |
| 3558 | * ******* |
| 3559 | * PAUSE AND STOP GENERATE CALLS TO F$HT |
| 3560 | T1W7 PZE 0 |
| 3561 | T2W7 PZE 0 |
| 3562 | W7 LDA K55 |
| 3563 | STA T1W7 |
| 3564 | W7A LDA K74 |
| 3565 | STA NAMF+1 NAMF = F$HT |
| 3566 | JST NF00 SET-UP REMAINING CHAR 0F NAME |
| 3567 | JST XN00 EXAMINE NEXT CHAR |
| 3568 | LDA TC |
| 3569 | SUB CRET |
| 3570 | SNZ |
| 3571 | JMP W7C TC = C/R - NOTING FOLLOWING |
| 3572 | JST IV00 INPUT INTEGER/VARIA8LE |
| 3573 | LRL 32 |
| 3574 | LDA K200 OUTPUT LDA |
| 3575 | JST OB00 OUTPUT OA |
| 3576 | W7C JST CN00 CALL NAME |
| 3577 | CRA |
| 3578 | STA DF DF = 0 |
| 3579 | LDA T1W7 |
| 3580 | STA ID |
| 3581 | JST AI00 ASSIGN INTEGER CONSTANT |
| 3582 | CRA OUTPUT DAC |
| 3583 | JST OB00 OUTPUT OA OF ST/PA OR HT |
| 3584 | LDA T1W7 |
| 3585 | SUB K54 |
| 3586 | SNZ |
| 3587 | JMP C5 PA-NOT THE CASE |
| 3588 | LDA RPL |
| 3589 | STA AF OUTPUT JMP * |
| 3590 | CRA |
| 3591 | STA A CAUSE LISTING TO HAVE OCTAL ADDRESS |
| 3592 | LDA K201 |
| 3593 | JST OR00 OUTPUT RELATWE |
| 3594 | JMP B6 |
| 3595 | W8 LDA K54 |
| 3596 | JMP W7+1 |
| 3597 | K74 BCI 1,HT HT |
| 3598 | K54 BCI 1,PA PA |
| 3599 | K55 BCI 1,ST ST |
| 3600 | * |
| 3601 | * |
| 3602 | * - R8 CALL |
| 3603 | * GENERATES CALL DIRECTLY OR USES EXPRESSION TO |
| 3604 | * ANALYZE AN ARGUMENT LIST. |
| 3605 | R8 JST SY00 INPUT SYMBOL |
| 3606 | LDA IU |
| 3607 | SUB K101 =1 (SUB) |
| 3608 | SZE SKIP IF IU=SUBR, |
| 3609 | JST TG00 TAG SUB PROCRAM |
| 3610 | LDA TC |
| 3611 | SUB K17 ='250 ( ( ) |
| 3612 | SZE |
| 3613 | JMP *+3 |
| 3614 | G2B LDA K101 SET A=1 BEFORE EXPRESSION |
| 3615 | JMP G2A |
| 3616 | CRA |
| 3617 | IAB (B)=0 |
| 3618 | LDA OMI2 =JST INSTR, |
| 3619 | JST OB00 OUTPUT OA |
| 3620 | JMP A1 CR TEST |
| 3621 | * ********************** |
| 3622 | * *ASSIGNMENT STATEMENT* |
| 3623 | * ********************** |
| 3624 | G2 LDA K104 |
| 3625 | JST NP00 FIRST NON-SPEC CHECK |
| 3626 | JST II00 INPUT ITEM |
| 3627 | LDA K102 SET A = 2 BEFORE EXPRESSION |
| 3628 | G2A TCA |
| 3629 | JST EX00 |
| 3630 | JMP A1 |
| 3631 | * |
| 3632 | * |
| 3633 | * ******** |
| 3634 | * *RETURN* |
| 3635 | * ******** |
| 3636 | * OPTIMIZES EXIT CODING FOR FUNCTIONS TO MINIMIZE |
| 3637 | * FETCHES OF THE FUNCTION VALUE. |
| 3638 | R9 LDA SBF A = SBF. |
| 3639 | STA A IF ZERO, GO TO ERROR |
| 3640 | SZE |
| 3641 | JMP *+3 |
| 3642 | JST ER00 |
| 3643 | BCI 1,RT RETURN NOT ALLOWED IN MAIN PROGRAM |
| 3644 | LDA SFF ELSE, IF SFF = 0, |
| 3645 | SNZ |
| 3646 | JMP R9C GO TO R9C |
| 3647 | CAS K101 IF SFF = 1, GO TO R98 |
| 3648 | JMP *+2 |
| 3649 | JMP R9B |
| 3650 | STA AF OUTPUT REL JMP TO 1ST RETN |
| 3651 | LRL 32 |
| 3652 | STA A SET A=0 TO OUTPUT OCTAL ADDR ON LISTING |
| 3653 | LDA K201 |
| 3654 | JMP R9A |
| 3655 | R9B IAB |
| 3656 | LDA RPL SFF = RPL |
| 3657 | STA SFF |
| 3658 | LDA K56 OUTPUT ITEM (F,A) |
| 3659 | JST OM00 |
| 3660 | R9C LRL 32 |
| 3661 | STA A SET FOR OCTAL ADDHESS IN LISTING |
| 3662 | STA AF SET RELATIVE ADDRESS TO ZERO |
| 3663 | LDA K206 JUMP I, 0 |
| 3664 | R9A JST OR00 OUTPUT REL |
| 3665 | JMP B6 EXIT |
| 3666 | K56 OCT 31 P CODE FOR 'F' (FETCH) |
| 3667 | * |
| 3668 | * |
| 3669 | * ******************** |
| 3670 | * *STATEMENT FUNCTION* |
| 3671 | * ******************** |
| 3672 | * OLD ASSIGN VALUES ARE SAVED IN SFTB AND ARE |
| 3673 | * RESTORED AT COMPLETION. |
| 3674 | G1T0 PZE 0 |
| 3675 | G1T1 PZE 0 |
| 3676 | G1 LDA K103 (A) = 3 |
| 3677 | JST NP00 FIRST NON-SPEC CHECK |
| 3678 | JST SY00 INPUT SYMBOL |
| 3679 | JST LO00 DEFINE LOCATION |
| 3680 | LDA K103 |
| 3681 | STA I |
| 3682 | JST GE00 GENERATE SUBPROGRAM ENTRANCE |
| 3683 | LDA I |
| 3684 | STA G1T1 T1 = I |
| 3685 | LDA K16X '=' TEST |
| 3686 | JST TS00 |
| 3687 | JST II00 INPUT ITEM |
| 3688 | CRA |
| 3689 | JST EX00 EXPRESSION |
| 3690 | LDA G1T1 |
| 3691 | STA I I = T1 |
| 3692 | IRS TCF TCF = TCF+1 |
| 3693 | G1A JST STXI |
| 3694 | LDA SFTB+2,1 |
| 3695 | STA A |
| 3696 | LDA SFTB+0,1 |
| 3697 | IAB |
| 3698 | JST STXA SET R TO A |
| 3699 | IAB |
| 3700 | STA DP,1 |
| 3701 | JST STXI SET R TO I |
| 3702 | LDA SFTB+1,1 |
| 3703 | IAB |
| 3704 | JST STXA SET R TO A |
| 3705 | IAB |
| 3706 | STA DP+1,1 |
| 3707 | LDA I |
| 3708 | SUB K103 I = I-3 = 0 |
| 3709 | STA I |
| 3710 | SUB K103 |
| 3711 | SZE |
| 3712 | JMP G1A NO, GO TO G1A |
| 3713 | LDA T1NP |
| 3714 | STA A |
| 3715 | LLL 16 |
| 3716 | LDA OMJ1 |
| 3717 | JST OB00 |
| 3718 | JST TG00 TAG SUBPROGRAM |
| 3719 | JMP A1 GO TO C/R TEST |
| 3720 | * - W5 END |
| 3721 | * *************** |
| 3722 | * *END PROC6SSOR* |
| 3723 | * *************** |
| 3724 | * FIRST CHECK SUBPROGRAMS FOR CORRECT USAGE, THEN |
| 3725 | * GENERATE MAP AND STRING BACK VARIABLES |
| 3726 | * AND CONSTANTS. |
| 3727 | T1W5 PZE |
| 3728 | W5 LDA BDF IF BLOCK DATA, |
| 3729 | SZE |
| 3730 | JMP W5K GO TO W5K |
| 3731 | LDA SBF IF SBF NOT ZERO |
| 3732 | STA A INDICATES SUBROUTINES |
| 3733 | SZE OR FUNCTION, |
| 3734 | JMP W5M GO TO W5M |
| 3735 | W5B CRA |
| 3736 | STA A A=J=0 |
| 3737 | JMP W5H |
| 3738 | W5D JST FA00 FETCH ASSIGNS |
| 3739 | JST STXA |
| 3740 | LDA NT |
| 3741 | SZE IF NT=1 (CONSTANT) |
| 3742 | JMP W5O GO TO W5O |
| 3743 | LDA IU |
| 3744 | SUB K101 IF IU=1 |
| 3745 | SZE INDICATES VARIABLE, |
| 3746 | JMP W5T GO TO W5T |
| 3747 | W5F LDA RPL SAVE RPL |
| 3748 | STA T1W5 RPL=-AF (INHIBIT LISTING) |
| 3749 | LDA AF |
| 3750 | SSM |
| 3751 | STA RPL |
| 3752 | CRA |
| 3753 | JST OR00 OUTPUT REL |
| 3754 | LDA T1W5 RESTORE RPL |
| 3755 | STA RPL |
| 3756 | W5H LDA A A=A+5 |
| 3757 | ADD K105 |
| 3758 | STA A |
| 3759 | SUB ABAR IF A=ABAR, (DONE) |
| 3760 | SUB K105 |
| 3761 | SZE |
| 3762 | JMP W5D ELSE, GO TO W5D |
| 3763 | W5J JST FS00 FLUSH BUFFER |
| 3764 | LDA SBF |
| 3765 | SZE |
| 3766 | LDA W5Z1 |
| 3767 | ERA W5Z2 |
| 3768 | STA OCI |
| 3769 | LDA SBF |
| 3770 | SZE |
| 3771 | LDA W5Z3 |
| 3772 | STA OCI+1 |
| 3773 | LDA K106 |
| 3774 | STA OCNT |
| 3775 | JST FS00 |
| 3776 | JMP A051 GO TO INITIALIZE |
| 3777 | W5K LDA RPL IF RPL NOT ZERO, |
| 3778 | SNZ |
| 3779 | JMP W5J |
| 3780 | JST ER00 ERROR-CODE GENERATED |
| 3781 | BCI 1,BD IN A BLOCK DATA SUBPROGRAM |
| 3782 | W5M JST FA00 FETCH ASSIGNS |
| 3783 | LDA SFF IF FUNCTION, |
| 3784 | SZE |
| 3785 | JMP W5N GO TO W5N |
| 3786 | JST NU00 NO USE TEST |
| 3787 | JST STXA |
| 3788 | LDA DP,1 IF NO ERROR, |
| 3789 | SSM NT(A)=1 |
| 3790 | STA DP,1 |
| 3791 | JMP W5B GO TO W5B |
| 3792 | W5N LDA IU |
| 3793 | SUB K102 IU MUST BE VAR/CON, |
| 3794 | SNZ ELSE, |
| 3795 | JMP W5B |
| 3796 | JST ER00 ERROR-FUNCTION |
| 3797 | BCI 1,FD NAME NOT DEFINED BY AN ARITHM. STATEMENT |
| 3798 | W5O LDA IU IF IU=VAR/CON |
| 3799 | SUB K102 |
| 3800 | SZE |
| 3801 | JMP W5H |
| 3802 | LDA AT AND AT = STR/REL |
| 3803 | SUB K103 A "STRING" REQ'D. |
| 3804 | SZE |
| 3805 | JMP W5H |
| 3806 | W5P LDA D0 IF D0 IS 4, THE |
| 3807 | SUB K104 CONSTANT IS COMPLEX, |
| 3808 | SZE OTHERWISE |
| 3809 | JMP W5Q GO TO W5Q |
| 3810 | LDA AF |
| 3811 | JST OS00 OUTPUT STRING |
| 3812 | JST STXA |
| 3813 | LDA DP+2,1 OUTPUT 4 WORDS |
| 3814 | JST W5X OF CONSTANT |
| 3815 | LDA DP+3,1 |
| 3816 | JST W5X |
| 3817 | LDA NT |
| 3818 | SNZ |
| 3819 | JMP W5S |
| 3820 | LDA A INCREMENT A |
| 3821 | ADD K105 |
| 3822 | STA A |
| 3823 | JST STXA |
| 3824 | JMP W5S |
| 3825 | W5Q LDA AF |
| 3826 | JST OS00 OUTPUT STRING |
| 3827 | JST STXA |
| 3828 | LDA D0 IF DO=1, |
| 3829 | SUB K101 INDICATES INTEGER, |
| 3830 | SNZ |
| 3831 | JMP W5R GO TO W5R |
| 3832 | W5S LDA DP+2,1 OUTPUT TWO WORDS |
| 3833 | JST W5X FLOATING POINT CONSTANT |
| 3834 | LDA DP+3,1 |
| 3835 | JST W5X |
| 3836 | LDA D0 IF DOUBLE PRECISION, |
| 3837 | SUB K103 |
| 3838 | SZE |
| 3839 | JMP W5H |
| 3840 | W5R LDA DP+4,1 OUTPUT THE 3RD WORD |
| 3841 | JST W5X |
| 3842 | JMP W5H GO TO W5H |
| 3843 | W5T LDA AT |
| 3844 | CAS K103 |
| 3845 | JMP W5F STRUNG VARIABLE (IU=NON 0) |
| 3846 | JMP W5T5 |
| 3847 | CAS K102 TEST FOR STG ABS ADDRESS |
| 3848 | OCT 17400 |
| 3849 | JMP *+2 |
| 3850 | JMP W5F NO |
| 3851 | LDA DP+4,1 TEST FOR PREFIX G |
| 3852 | ANA *-4 |
| 3853 | SUB *-5 |
| 3854 | SZE |
| 3855 | JMP W5F STRUNG VARIABLE (IU=NON 0) |
| 3856 | W5T5 LDA IU |
| 3857 | SZE |
| 3858 | JMP W5P |
| 3859 | JST ER00 |
| 3860 | BCI 1,US |
| 3861 | W5X DAC ** |
| 3862 | LRL 16 |
| 3863 | STA DF |
| 3864 | IAB |
| 3865 | JST OA00 OUTPUT ABS |
| 3866 | JST STXA REST "A" |
| 3867 | JMP* W5X EXIT |
| 3868 | W5Z1 EQU K100 000377 |
| 3869 | W5Z2 EQU K122 040000 |
| 3870 | W5Z3 EQU K116 177400 |
| 3871 | * |
| 3872 | * |
| 3873 | * |
| 3874 | * |
| 3875 | * |
| 3876 | * ************************ |
| 3877 | * *INPUT CHAR/OUTPUT PACK* |
| 3878 | * ************************ |
| 3879 | PO00 DAC ** |
| 3880 | JST CH00 INPUT CHAR |
| 3881 | JST OK00 OUTPUT PACK |
| 3882 | JMP* PO00 RETURN |
| 3883 | * ************************ |
| 3884 | * *TRANS HOLLERITH STRING* |
| 3885 | * ************************ |
| 3886 | * FORM HOLLERITH STRING, CHARACTER COUNT IN ID 0N |
| 3887 | * ENTRY. C/R WILL ALSO TERMINATE STRING. |
| 3888 | HS00 DAC ** |
| 3889 | HS10 JST IC00 INPUT 1 CHARACTER |
| 3890 | CAS CRET CHECK FOR CHAR = C/R |
| 3891 | JMP *+2 |
| 3892 | JMP HS15 HOLLERITH STRING EXTENDS PAST END 0F CARD |
| 3893 | JST OK00 OUTPUT PACK THE CHARACTER |
| 3894 | LDA ID |
| 3895 | SUB K101 REDUCE CHARACTER COUNT BY 1 |
| 3896 | STA ID |
| 3897 | SZE |
| 3898 | JMP HS10 INPUT MORE CHARACTERS |
| 3899 | JMP* HS00 |
| 3900 | HS15 JST ER00 |
| 3901 | BCI 1,HS HOLLERITH STRING EXTENDS OVER STATEMENT |
| 3902 | * |
| 3903 | * |
| 3904 | * ********** |
| 3905 | * *DO INPUT* |
| 3906 | * ********** |
| 3907 | * SET UP DO TABLE ENTRIES. |
| 3908 | DP00 DAC ** |
| 3909 | LDA D D = D+5 |
| 3910 | ADD K105 IFLG = NON-ZERO |
| 3911 | STA IFLG |
| 3912 | STA D |
| 3913 | ADD DO I = DO+D |
| 3914 | STA I |
| 3915 | JST STXI |
| 3916 | LDA A DP (1-4) = (B) |
| 3917 | STA DP-2,1 DP (1-2) = A |
| 3918 | IAB |
| 3919 | STA DP-4,1 |
| 3920 | JST IV00 INPUT INT VAR/CON |
| 3921 | LDA K134 = , |
| 3922 | JST TS00 COMMA TEST |
| 3923 | JST STXI |
| 3924 | LDA A |
| 3925 | STA DP,1 DP(I) = INITIAL VALUE POINTER |
| 3926 | JST IV00 INPUT INT VAR/CON |
| 3927 | JST STXI |
| 3928 | LDA A |
| 3929 | STA DP-1,1 DP (I-1) = A - FINAL VALUE POINTER |
| 3930 | LDA TC |
| 3931 | SUB K134 = , |
| 3932 | SZE IF THIRD TERM |
| 3933 | JMP DP20 |
| 3934 | JST IV00 READ AND ASSIGN, |
| 3935 | DP10 JST STXI |
| 3936 | LDA A |
| 3937 | STA DP-3,1 DP(I-3) = INCREMENT POINTER |
| 3938 | CRA |
| 3939 | STA IFLG CLEAR IFLAG |
| 3940 | JMP* DP00 EXIT |
| 3941 | DP20 LDA K101 |
| 3942 | STA ID THIRD TERM = 1 |
| 3943 | JST AI00 ASSIGN CONSTANT |
| 3944 | JMP DP10 |
| 3945 | * *************** |
| 3946 | * *DO INITIALIZE* |
| 3947 | * *************** |
| 3948 | * GENERATE DO INITIALIZATION CODE. |
| 3949 | DS00 DAC ** |
| 3950 | JST STXI ESTABLISH I |
| 3951 | LDA DP,1 A = DP (I) |
| 3952 | STA A |
| 3953 | LDA K200 |
| 3954 | JST DS20 LOAD - LDA INITIAL VALUE |
| 3955 | LDA DP-2,1 |
| 3956 | STA A A = DP (I-2) |
| 3957 | LDA RPL |
| 3958 | STA DP,1 SET RETURN ADDRESS INTO DP(I) |
| 3959 | LDA K202 |
| 3960 | JST DS20 STORE - STA VARIABLE NAME |
| 3961 | JMP* DS00 |
| 3962 | * OUTPUT OA SUBROUTINE |
| 3963 | DS20 DAC ** |
| 3964 | IAB |
| 3965 | LLL 16 SET B = 0 |
| 3966 | JST OB00 OUTPUT OA |
| 3967 | JST STXI RESTORE I |
| 3968 | JMP* DS20 RETURN |
| 3969 | * |
| 3970 | DS90 PZE 0 |
| 3971 | * |
| 3972 | * **************** |
| 3973 | * *DO TERMINATION* |
| 3974 | * **************** |
| 3975 | * GENERATE DO TERMINATION CODE. |
| 3976 | DQ00 DAC ** |
| 3977 | JST STXI |
| 3978 | LDA DP-2,1 |
| 3979 | STA A |
| 3980 | LDA K200 |
| 3981 | JST DS20 OUTPUT LDA VARIABLE NAME |
| 3982 | LDA DP-3,1 |
| 3983 | STA A |
| 3984 | LDA K203 |
| 3985 | JST DS20 OUTPUT ADD INCREMENT |
| 3986 | LDA DP-1,1 |
| 3987 | STA A |
| 3988 | LDA OMK9 |
| 3989 | JST DS20 OUTPUT CAS FINAL VALUE |
| 3990 | CRA |
| 3991 | STA A |
| 3992 | LDA RPL |
| 3993 | ADD K103 |
| 3994 | STA AF |
| 3995 | LDA DP,1 |
| 3996 | STA DS90 |
| 3997 | LDA OMI5 JUMP *+3 |
| 3998 | JST OR00 OUTPUT REL |
| 3999 | LDA DS90 |
| 4000 | STA AF |
| 4001 | LDA OMI5 JMP RPL (SAVED) - POINTS TO 'STA' INST. |
| 4002 | JST OR00 OUTPUT REL |
| 4003 | LDA OMI5 OUTPUT JMP RPL (SAVED) |
| 4004 | JST OR00 OUTPUT REL |
| 4005 | JMP* DQ00 |
| 4006 | * ************ |
| 4007 | * *EXPRESSION* |
| 4008 | * ************ |
| 4009 | * THE RESULTANT OUTPUT IS A BUILT UP AOIN |
| 4010 | * TABLE THAT IS FURTHER PROCESSED BY SCAN. |
| 4011 | T0EX PZE 0 |
| 4012 | EXT0 EQU T0EX |
| 4013 | T1EX PZE 0 |
| 4014 | T2EX PZE 0 |
| 4015 | T3EX PZE 0 |
| 4016 | T5EX PZE 0 |
| 4017 | T6EX PZE 0 |
| 4018 | EXT7 PZE 0 |
| 4019 | T9EX PZE 0 |
| 4020 | EX00 DAC ** |
| 4021 | STA F F = (A) |
| 4022 | LDA A SAVE POINTER TO FIRST VARIABLE |
| 4023 | STA TRFA FOR LATER POSSIBLE TRACING |
| 4024 | LDA D I = D+DO+10 |
| 4025 | ADD DO |
| 4026 | ADD K125 =8 |
| 4027 | STA I |
| 4028 | JST EX99 DATA POOL CHECK |
| 4029 | JST STXI |
| 4030 | CRA |
| 4031 | STA EXT0 T0 = 0 |
| 4032 | STA B B = 0 |
| 4033 | STA EXT7 T7 = 0 |
| 4034 | ADD EX92+12 |
| 4035 | LGL 9 O(1-2) = '=' |
| 4036 | STA DP-1,1 O (I) = 0 |
| 4037 | CMA |
| 4038 | STA IFLG IFLG NOT 0 |
| 4039 | LDA L0 |
| 4040 | STA DP-2,1 O(I-2) = LO |
| 4041 | EX10 JST STXI |
| 4042 | CRA |
| 4043 | STA T1EX T1 = 0 |
| 4044 | STA DP,1 AOIN(I) = T(1) = 0 |
| 4045 | STA DP+1,1 |
| 4046 | LDA IM IF IM NOT ZERO, |
| 4047 | SZE |
| 4048 | JMP EX50 GO TO EX50 |
| 4049 | LDA K106 |
| 4050 | TCA |
| 4051 | STA 0 |
| 4052 | * PERFORM TABLE SEARCH |
| 4053 | EX11 LDA TC GO TO ROUTINE ACCORDING |
| 4054 | SUB EX90+6,1 TO TC. |
| 4055 | SNZ IF NO MATCH, ERROR |
| 4056 | JMP EXI1 |
| 4057 | IRS XR |
| 4058 | JMP EX11 |
| 4059 | JST STXI |
| 4060 | LDA LIBF SPECIAL LIBRARY FLAG |
| 4061 | SZE |
| 4062 | JMP EX39 |
| 4063 | JMP EX95 ERROR CONDITION |
| 4064 | EXI1 LDA EX91+6,1 |
| 4065 | STA 0 |
| 4066 | JMP 0,1 PROCESS LEADING OPERATOR |
| 4067 | * SPECIAL OPERATOR FLAG SET WHEN COMPILING THE FORTRAN |
| 4068 | * LIBRARY IN WHICH CASE THE OPERATIONS ( A= ) AND |
| 4069 | * ( =A ) ARE REQUIRED. THIS LOGIC WILL ALLOW THESE |
| 4070 | * TO BE PROCESSED WITHOUT GIVING AN ERROR MESSAGE IF THE |
| 4071 | * SPECIAL LIBRARY FLAG (LIBF) IS SET TO NON-ZERO. |
| 4072 | * |
| 4073 | EX12 LDA B TC = ( |
| 4074 | ADD K109 B = B+16 |
| 4075 | STA B SXF = NON-ZERO |
| 4076 | STA SXF |
| 4077 | EX14 JST II00 INPUT ITEM |
| 4078 | JST STXI |
| 4079 | JMP EX10 GO TO EX10 |
| 4080 | EX16 JST STXI TC = * |
| 4081 | LDA TC |
| 4082 | LGL 9 OI (I-2) = *, B+13 |
| 4083 | ADD B |
| 4084 | ADD K129 |
| 4085 | ERA DP-1,1 |
| 4086 | SSP |
| 4087 | SNZ |
| 4088 | JMP *+3 |
| 4089 | JST ER00 NO, CONSTR ERROR |
| 4090 | BCI 1,PW * NOT PRECEDED BY ANOTHER * |
| 4091 | LDA K109 (E = '20) |
| 4092 | LGL 9 |
| 4093 | IMA DP-1,1 |
| 4094 | ANA K118 ='777 |
| 4095 | ADD K101 |
| 4096 | ERA DP-1,1 CHANGE * TO ** |
| 4097 | STA DP-1,1 |
| 4098 | JMP EX14 GO TO EX14 |
| 4099 | EX18 LDA K102 =2 |
| 4100 | STA TC SET TC TO - |
| 4101 | LDA K125 =8 |
| 4102 | STA T1EX T1 = 8 |
| 4103 | JST STXI |
| 4104 | LDA DP-1,1 |
| 4105 | ANA K118 |
| 4106 | SUB B 8 .GT. I (I-2) -B |
| 4107 | SUB T1EX |
| 4108 | SPL |
| 4109 | JMP *+3 |
| 4110 | EX19 JST ER00 NO, ERROR |
| 4111 | BCI 1,NT LOGICAL .NOT. NOT A UNARY OPERATOR |
| 4112 | EX20 LDA T0EX YES |
| 4113 | SZE T (0) = 0 |
| 4114 | JMP EX34 |
| 4115 | EX22 LDA B YES, |
| 4116 | ADD F B + + (5) .GT. 0 |
| 4117 | SPL NO, ERROR |
| 4118 | JMP EX96 |
| 4119 | EX24 JST STXI |
| 4120 | LDA TC |
| 4121 | LGL 9 |
| 4122 | ADD T1EX |
| 4123 | ADD B |
| 4124 | STA DP+1,1 OI(I) = TC , T1+B |
| 4125 | JST EX99 DATA POOL CHECK |
| 4126 | JMP EX14 |
| 4127 | EX26 JST STXI |
| 4128 | LDA DP-1,1 |
| 4129 | ANA K118 IF I (I-2) .LT. B |
| 4130 | CAS B |
| 4131 | JMP EX97 ERROR-----MULTIPLE + OR - SIGNS |
| 4132 | NOP |
| 4133 | EX30 LDA K131 SET INDEX TO |
| 4134 | STA 0 SEARCH OPERATOR TABLE FOR TRAILING |
| 4135 | EX31 LDA EX92+14,1 OPERATOR AFTER HAVING ENCOUNTERED AN |
| 4136 | SUB TC ITEM 0R A NEGATE. |
| 4137 | SZE |
| 4138 | JMP EX32 |
| 4139 | LDA EX93+14,1 |
| 4140 | STA *+3 |
| 4141 | JST STXI |
| 4142 | JMP* *+1 |
| 4143 | DAC ** |
| 4144 | EX32 IRS XR CONTROL OPERATOR LOOP |
| 4145 | JMP EX31 CONTINUE |
| 4146 | EX34 LDA B IF B = 0 |
| 4147 | SUB EXT7 |
| 4148 | SZE |
| 4149 | JMP EX40 NO, GO TO EX40 |
| 4150 | LDA T0EX IF T (0) = 0 |
| 4151 | SZE |
| 4152 | JMP EX38 NO, GO TO EX38 |
| 4153 | EX35 CRA |
| 4154 | STA IFLG IFLG = 0 |
| 4155 | LDA F |
| 4156 | AOA |
| 4157 | SMI F . GE. -1 |
| 4158 | JMP EX36 YES |
| 4159 | JMP* EX00 RETURN - NO |
| 4160 | EX36 JST CA00 SCAN |
| 4161 | JST OT00 OUTPUT TRIADS |
| 4162 | JMP* EX00 RETURN |
| 4163 | EX38 JST STXI |
| 4164 | LDA B |
| 4165 | SUB K109 |
| 4166 | STA B |
| 4167 | LDA K103 |
| 4168 | STA MFL |
| 4169 | LDA T0EX |
| 4170 | LGL 9 O (I) = T (0) |
| 4171 | ADD B I (I) = B+9 |
| 4172 | ADD K124 I = I+2 |
| 4173 | STA DP+1,1 |
| 4174 | JST EX99 DATA POOL CHECK |
| 4175 | CRA |
| 4176 | STA T0EX T0 = 0 |
| 4177 | STA EXT7 T7 = 0 |
| 4178 | EX39 LDA L0 |
| 4179 | STA A A = LO |
| 4180 | STA IM IM NOT EQ 0 |
| 4181 | JMP EX10 |
| 4182 | EX40 LDA TC TC 0 , |
| 4183 | CAS K5 ='254 (,) IN BCD MODE |
| 4184 | JMP *+2 |
| 4185 | JMP EX41 |
| 4186 | SUB K134 =17 |
| 4187 | SZE |
| 4188 | JMP EX44 NO, GO TO EX44 |
| 4189 | EX41 LDA I |
| 4190 | EX42 SUB K102 |
| 4191 | STA XR B VS. I (J) |
| 4192 | LDA DP+1,1 |
| 4193 | ANA K118 |
| 4194 | CAS B |
| 4195 | JMP *+3 |
| 4196 | JMP EX24 EQUAL, GO TO EX24 |
| 4197 | JMP* EX00 LESS, RETURN |
| 4198 | LDA XR GREATER, REPEAT LOOP |
| 4199 | JMP EX42 |
| 4200 | EX44 JST IP00 ) - INPUT OPERATOR |
| 4201 | JMP EX30 GO TO EX30 |
| 4202 | EX46 LDA* A |
| 4203 | STA T6EX IF O1(O1(A)) = L(0) |
| 4204 | LDA* T6EX |
| 4205 | CAS L0 |
| 4206 | JMP *+2 |
| 4207 | JMP EX34 GO TO EX34 |
| 4208 | STA O2 O2 = LO |
| 4209 | EX48 JST ET00 ENTER TRIAD |
| 4210 | JMP EX34 |
| 4211 | EX50 JST STXI |
| 4212 | LDA A A(I) = A |
| 4213 | STA DP,1 |
| 4214 | LDA IU IU = SUB OR ARR |
| 4215 | SLN |
| 4216 | JMP EX30 NO, GO TO EX30 |
| 4217 | LDA TC |
| 4218 | SUB K17 TC = ( |
| 4219 | SZE |
| 4220 | JMP EX76 NO, GO TO EX76 |
| 4221 | LDA B YES, B = B+16 |
| 4222 | ADD K109 |
| 4223 | STA B |
| 4224 | LDA IU IU = ARR |
| 4225 | SUB K103 |
| 4226 | SZE |
| 4227 | JMP EX75 NO, GO TO EX75 |
| 4228 | CRA |
| 4229 | STA DP,1 A(I) = 0 |
| 4230 | STA X4 X4 = 0 |
| 4231 | STA T3EX T3 = 0 |
| 4232 | STA K T5 = A |
| 4233 | LDA D0 |
| 4234 | STA T9EX T9 = D0 |
| 4235 | LDA A |
| 4236 | STA T5EX T5 = A |
| 4237 | LDA AT |
| 4238 | SUB K105 AT = DUM |
| 4239 | SZE |
| 4240 | JMP EX74 NO, GO TO EX74 |
| 4241 | CRA |
| 4242 | STA T2EX YES, T (0) = 0 |
| 4243 | JST EX99 DATA POOL CHECK |
| 4244 | JST STXI |
| 4245 | LDA A |
| 4246 | STA DP,1 A(I) = A |
| 4247 | LDA K132 OI (I) = A, 11 |
| 4248 | LGL 9 |
| 4249 | ADD K124 |
| 4250 | STA DP+1,1 I=9 |
| 4251 | EX54 LDA D0 IF D0 = 1, GO TO EX56 |
| 4252 | SUB K101 |
| 4253 | SNZ |
| 4254 | JMP EX56 |
| 4255 | JST EX99 DATA POOL CHECK |
| 4256 | JMP *+2 |
| 4257 | EX55 IRS K K = K+1 |
| 4258 | LDA K |
| 4259 | STA XR |
| 4260 | LDA X,1 |
| 4261 | STA T6EX T6 = X (K) |
| 4262 | JST STXI |
| 4263 | LDA T6EX |
| 4264 | STA DP,1 O(I) = * |
| 4265 | LDA K103 I (I) = T3+13 |
| 4266 | LGL 9 T3 = T3+16 |
| 4267 | ADD T3EX A (A) = T6 |
| 4268 | ADD K129 =13 |
| 4269 | STA DP+1,1 |
| 4270 | ANA K118 |
| 4271 | ADD K103 |
| 4272 | STA T3EX T3 = A(A) |
| 4273 | EX56 JST IV00 INPUT INTEGER VARIABLE |
| 4274 | JST EX99 DATA POOL CHECK |
| 4275 | JST STXI |
| 4276 | LDA A A(I) = A |
| 4277 | STA DP,1 |
| 4278 | LDA NT |
| 4279 | SZE |
| 4280 | JMP EX68 CONSTANT ENCOUNTERED |
| 4281 | JST UC00 UNINPUT COLUMN |
| 4282 | JST DN00 INPUT DO NOT ASSIGN |
| 4283 | SNZ |
| 4284 | JMP EX57 IM = 0 |
| 4285 | SUB K101 |
| 4286 | SNZ |
| 4287 | JMP EX57 IM * INTEGEH |
| 4288 | JST ER00 |
| 4289 | BCI 1,SU SUBSCRIPT INCREMENTER NOT A CONSTANT |
| 4290 | EX57 JST STXI |
| 4291 | LDA K101 |
| 4292 | LGL 9 |
| 4293 | ADD T3EX |
| 4294 | ADD K127 |
| 4295 | STA DP+1,1 O(1) = +, I(I) = T3+11 |
| 4296 | JST EX99 DATA POOL CHECK |
| 4297 | EX58 LDA T9EX |
| 4298 | STA D0 RESET D(0) |
| 4299 | LDA ID SUBSCRIPT SIZE |
| 4300 | SUB K101 ID = ID-1 |
| 4301 | STA ID |
| 4302 | SNZ IF ZERO, GO TO EX60 |
| 4303 | JMP EX60 |
| 4304 | LDA K |
| 4305 | STA 0 |
| 4306 | LDA D0,1 D(K) = 0 |
| 4307 | SNZ |
| 4308 | JMP EX67 YES - (DUMMY DIMENSION) |
| 4309 | IAB |
| 4310 | LDA ID |
| 4311 | JST IM00 |
| 4312 | ADD T2EX |
| 4313 | STA T2EX T2 = T2+ID*D(K) |
| 4314 | EX60 LDA T9EX |
| 4315 | STA D0 RESET D(0) |
| 4316 | LDA K |
| 4317 | STA 0 |
| 4318 | LDA X+2,1 X(K+2) = 0 |
| 4319 | SNZ |
| 4320 | JMP EX62 YES - FINISHED |
| 4321 | LDA K134 =17 |
| 4322 | JST TS00 COMMA TEST |
| 4323 | LDA D0+1,1 |
| 4324 | IAB |
| 4325 | LDA D0,1 |
| 4326 | JST IM00 |
| 4327 | STA D0+1,1 D(K+1) = D(K+1)*D(K) |
| 4328 | JMP EX55 |
| 4329 | EX62 JST STXI |
| 4330 | LDA DP-1,1 DOES O(I-2) = * |
| 4331 | SSP |
| 4332 | LGR 9 |
| 4333 | CAS K103 |
| 4334 | JMP *+2 |
| 4335 | JMP EX66 YES. |
| 4336 | SNZ NO. |
| 4337 | JMP EX64 O(I-2) = 0 - YES |
| 4338 | CAS K132 DOES O(I-2) = A |
| 4339 | JMP EX63 |
| 4340 | JMP *+2 YES |
| 4341 | JMP EX63 |
| 4342 | LDA T2EX IS T2 = 0 |
| 4343 | SNZ |
| 4344 | JMP EX65 YES (DUMMY ARRAY (1,1,1)) |
| 4345 | EX63 LDA K101 |
| 4346 | STA DP-1,1 OI(I-2) = 1 |
| 4347 | LDA T2EX A(I) = T2 |
| 4348 | STA DP,1 |
| 4349 | LDA K137 0='X' ('24), I=2 |
| 4350 | STA DP+1,1 |
| 4351 | CRA |
| 4352 | STA DP+3,1 OI(I+2) = 0 |
| 4353 | LDA T5EX |
| 4354 | STA DP+2,1 A(I+2) = T5 |
| 4355 | JST EX99 DATA POOL CHECK |
| 4356 | JST CA00 SCAN |
| 4357 | LDA O1 |
| 4358 | STA A A = O1 |
| 4359 | JST STXA |
| 4360 | LDA DP+2,1 S(A) = NON-ZERO |
| 4361 | SSM |
| 4362 | STA DP+2,1 S(A) = 1 |
| 4363 | JMP EX44 |
| 4364 | EX64 LDA L0 |
| 4365 | STA DP,1 A(I) = L0 |
| 4366 | JST EX99 DATA POOL CHECK |
| 4367 | JST STXI |
| 4368 | JMP EX63 |
| 4369 | EX65 LDA I |
| 4370 | SUB K104 |
| 4371 | STA I I = I-4 |
| 4372 | LDA T5EX |
| 4373 | STA DP-4,1 A (I) = T5 |
| 4374 | JMP EX44 |
| 4375 | EX66 LDA I |
| 4376 | SUB K102 |
| 4377 | STA I I = I-2 |
| 4378 | JMP EX62 ASSIGN INT CONSTANT |
| 4379 | EX67 JST AI00 |
| 4380 | JST STXI SET XR TO I |
| 4381 | LDA A |
| 4382 | STA DP,1 A(I) = A |
| 4383 | LDA K101 |
| 4384 | LGL 9 |
| 4385 | ADD T3EX |
| 4386 | ADD K127 |
| 4387 | STA DP+1,1 OI(I) = +, T3+11 |
| 4388 | JST EX99 DATA POOL CHECK |
| 4389 | JMP EX60 |
| 4390 | EX68 LDA TC IS TC |
| 4391 | CAS K103 = * |
| 4392 | JMP *+2 |
| 4393 | JMP *+2 |
| 4394 | JMP EX58 NO |
| 4395 | LGL 9 |
| 4396 | ADD T3EX |
| 4397 | ADD K129 =13 |
| 4398 | STA DP+1,1 OI(I) = *, T3+13 |
| 4399 | JST IR00 INPUT INTEGER VAR/CON |
| 4400 | JMP EX56+1 |
| 4401 | EX69 CRA SET LISTING FOR OCTAL ADDR |
| 4402 | STA A |
| 4403 | LDA OMI5 JMP 0 INSTRUCTION |
| 4404 | STA DF SET LISTING FOR SYMBOLIC A INSTR. |
| 4405 | JST OA00 OUTPUT ABSOLUTE |
| 4406 | LDA RPL |
| 4407 | STA O2 |
| 4408 | LDA K138 |
| 4409 | STA P P = H |
| 4410 | JST ET00 ENTER TRIAD |
| 4411 | JST HS00 TRANSFER HOLLERITH STRING |
| 4412 | LDA CRET (A) = C/R |
| 4413 | JST OK00 OUTPUT PACK |
| 4414 | CRA |
| 4415 | STA 0 SET LISTING FOR OCTAL ADDR. |
| 4416 | STA A SET LISTING FOR OCTAL ADDR. |
| 4417 | LDA O2 |
| 4418 | SUB K101 |
| 4419 | JST OS00 OUTPUT STRING RPL-1 |
| 4420 | JST CH00 INPUT CHARACTER |
| 4421 | JST FN00 |
| 4422 | JST STXI RESET INDEX TO I |
| 4423 | LDA L |
| 4424 | STA DP,1 A(I) = L |
| 4425 | JMP EX76 |
| 4426 | EX74 LDA AF |
| 4427 | STA T2EX T2 = AF |
| 4428 | JMP EX54 GO TO EX54 |
| 4429 | EX75 LDA K134 |
| 4430 | STA TC TC = , |
| 4431 | JMP EX24 GO TO EX24 |
| 4432 | EX76 LDA DP-1,1 |
| 4433 | LGR 9 |
| 4434 | ANA K133 |
| 4435 | SUB K134 |
| 4436 | SNZ |
| 4437 | JMP EX34 WITHIN AN ARGUMENT LIST |
| 4438 | JST ER00 |
| 4439 | BCI 1,AG SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST |
| 4440 | EX78 LDA K127 |
| 4441 | EX79 STA T1EX T (1) = 11 |
| 4442 | JMP EX22 |
| 4443 | EX80 LDA K129 T (1) = 13 |
| 4444 | JMP EX79 |
| 4445 | EX81 LDA K106 |
| 4446 | STA T1EX T (1) = 6 |
| 4447 | JMP EX20 |
| 4448 | EX82 LDA K104 T (1) = 4 |
| 4449 | JMP EX81+1 |
| 4450 | EX83 LDA T0EX T (0) =0 |
| 4451 | SZE |
| 4452 | JMP EX84 |
| 4453 | LDA TC YES, |
| 4454 | STA T0EX T (0) = TC |
| 4455 | LDA EX92+1 |
| 4456 | STA TC TC = - |
| 4457 | LDA B |
| 4458 | ADD K109 |
| 4459 | STA B |
| 4460 | STA EXT7 |
| 4461 | LDA *+2 |
| 4462 | JMP EX79 |
| 4463 | DEC -5 |
| 4464 | EX84 JST ER00 ERROR |
| 4465 | BCI 1,RL MORE THAN 1 RELATIONAL OPERATOR |
| 4466 | EX85 LDA F |
| 4467 | ADD K102 T (5) = T (5) +2 = B = 0 |
| 4468 | STA F |
| 4469 | ADD B |
| 4470 | SNZ |
| 4471 | JMP EX24 |
| 4472 | JST ER00 ERROR |
| 4473 | BCI 1,EQ MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF = |
| 4474 | EX90 OCT 250 ( |
| 4475 | OCT 3 * |
| 4476 | OCT 5 NOT |
| 4477 | OCT 1 + |
| 4478 | OCT 2 - |
| 4479 | OCT 310 H |
| 4480 | EX91 DAC EX12 ( |
| 4481 | DAC EX16 * |
| 4482 | DAC EX18 NOT |
| 4483 | DAC EX26 + |
| 4484 | DAC EX26 - |
| 4485 | DAC EX69 H |
| 4486 | EX92 OCT 1 + |
| 4487 | OCT 2 - |
| 4488 | OCT 3 * |
| 4489 | OCT 4 / |
| 4490 | OCT 6 AND |
| 4491 | OCT 7 OR |
| 4492 | OCT 15 NE |
| 4493 | OCT 12 EQ |
| 4494 | OCT 14 GT |
| 4495 | OCT 10 LT |
| 4496 | OCT 13 GE |
| 4497 | OCT 11 LE |
| 4498 | OCT 16 = |
| 4499 | OCT 16 = (ERROR) |
| 4500 | EX93 DAC EX78 + |
| 4501 | DAC EX78 |
| 4502 | DAC EX80 * |
| 4503 | DAC EX80 / |
| 4504 | DAC EX81 AND |
| 4505 | DAC EX82 OR |
| 4506 | DAC EX83 NE |
| 4507 | DAC EX83 EQ |
| 4508 | DAC EX83 GT |
| 4509 | DAC EX83 LT |
| 4510 | DAC EX83 GE |
| 4511 | DAC EX83 LE |
| 4512 | DAC EX85 = |
| 4513 | DAC EX34 NONE OF THESE |
| 4514 | EX95 JST ER00 |
| 4515 | BCI 1,OP MURE THAN ONE OPERATOR IN A ROW |
| 4516 | EX96 JST ER00 ERROR |
| 4517 | BCI 1,PA OPERATOR MUST BE WITHIN PARENTHESES |
| 4518 | EX97 JST ER00 ERROR |
| 4519 | BCI 1,UO MULTIPLE + OR - SIGNS NOT AS UNARY OPS |
| 4520 | * BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW |
| 4521 | EX99 DAC ** |
| 4522 | IRS I |
| 4523 | IRS I |
| 4524 | LDA I |
| 4525 | AOA |
| 4526 | CAS L |
| 4527 | NOP |
| 4528 | JMP AS50 |
| 4529 | JMP* EX99 |
| 4530 | K133 OCT 77 |
| 4531 | K130 DEC -6 |
| 4532 | K141 DEC 33 |
| 4533 | K PZE 0 |
| 4534 | KM8 DEC -8 |
| 4535 | * |
| 4536 | * |
| 4537 | * |
| 4538 | * |
| 4539 | * ****************** |
| 4540 | * *SCAN * |
| 4541 | * *TRIAD SEARCH * |
| 4542 | * *TEMP STORE CHECK* |
| 4543 | * ****************** |
| 4544 | T0CA PZE 0 |
| 4545 | T1CA PZE 0 |
| 4546 | T2CA PZE 0 |
| 4547 | T9CA PZE 0 |
| 4548 | * THE AOIN TABLE IS PROCESSED FROM THE BOTTOM |
| 4549 | * UP AND ENTRIES ARE FORMED FOR INCLUSION |
| 4550 | * IN THE TRIAD TABLE. LEVELS ARE USED |
| 4551 | * TO CONTROL THE ORDER OF ENTRY INTO |
| 4552 | * THE TRIADS. SIGN CONTROL IS ALSO |
| 4553 | * ACCOMPLISHED IN THIS ROUTINE. |
| 4554 | CA00 DAC ** |
| 4555 | LDA L0 |
| 4556 | STA ACCP INDICATE EMPTY ACCUM |
| 4557 | CA04 JST STXI ESTABLISH I |
| 4558 | STA T1CA T1 = I |
| 4559 | LDA DP-1,1 |
| 4560 | ANA K118 IF I (I-2) = 0, |
| 4561 | * OR .LT. I (I) |
| 4562 | STA T9CA |
| 4563 | LDA DP+1,1 |
| 4564 | ANA K118 |
| 4565 | CAS T9CA |
| 4566 | JMP CA08 GO TO CA08 |
| 4567 | NOP |
| 4568 | LDA I |
| 4569 | SUB K102 |
| 4570 | STA I I = I-2 |
| 4571 | STA 0 |
| 4572 | CA08 LDA DP+3,1 |
| 4573 | ERA DP+1,1 |
| 4574 | STA T0CA |
| 4575 | LDA DP+1,1 |
| 4576 | ANA K118 |
| 4577 | STA T2CA |
| 4578 | LDA DP+1,1 |
| 4579 | SSP |
| 4580 | LGR 9 P = O (I) |
| 4581 | STA P |
| 4582 | CAS K102 IF P IS NOT * OR /, GO TO CCA10 |
| 4583 | CAS K105 |
| 4584 | JMP CA10 |
| 4585 | JMP CA10 |
| 4586 | JMP CA14 GO TO CA14 |
| 4587 | CA10 LDA T0CA |
| 4588 | SMI |
| 4589 | JMP CA13 |
| 4590 | LDA KM8 |
| 4591 | IMA XR |
| 4592 | IAB |
| 4593 | LDA P |
| 4594 | CAS CA90+8,1 |
| 4595 | JMP *+2 |
| 4596 | JMP *+4 |
| 4597 | IRS XR |
| 4598 | JMP *-4 |
| 4599 | JMP CA45 |
| 4600 | LDA CA91+8,1 |
| 4601 | STA P |
| 4602 | IAB |
| 4603 | STA XR |
| 4604 | CA13 LDA K130 |
| 4605 | IMA XR |
| 4606 | IAB |
| 4607 | LDA P |
| 4608 | CAS CA90+8,1 |
| 4609 | JMP *+2 |
| 4610 | JMP CA50 |
| 4611 | IRS XR |
| 4612 | JMP *-4 |
| 4613 | IAB |
| 4614 | STA XR |
| 4615 | IAB |
| 4616 | LDA DP+1,1 |
| 4617 | JMP *+2 |
| 4618 | CA50 CRA |
| 4619 | STA T0CA |
| 4620 | IAB |
| 4621 | STA XR |
| 4622 | CA14 LDA DP,1 |
| 4623 | STA O1 O1=A(I) |
| 4624 | LDA DP+2,1 |
| 4625 | STA O2 O2 = A (I+2) |
| 4626 | LDA T2CA |
| 4627 | SNZ |
| 4628 | JMP CA37 IF ZERO, GO TO CA37 |
| 4629 | LDA DP-1,1 |
| 4630 | SSP |
| 4631 | LGR 9 |
| 4632 | STA T1CA |
| 4633 | LDA DP-1,1 |
| 4634 | ANA K118 IF T2 .GT. I (I-2) |
| 4635 | SUB T2CA |
| 4636 | SPL |
| 4637 | JMP CA18 |
| 4638 | SZE |
| 4639 | JMP CA04 |
| 4640 | LDA O2 |
| 4641 | SUB ACCP |
| 4642 | SZE |
| 4643 | JMP CA04 |
| 4644 | LDA P |
| 4645 | SUB K103 |
| 4646 | SMI |
| 4647 | JMP CA39 |
| 4648 | LDA T1CA |
| 4649 | SUB P |
| 4650 | SZE |
| 4651 | LDA K101 GO TO |
| 4652 | ADD K101 P = - OR + |
| 4653 | STA P |
| 4654 | CA18 LDA I |
| 4655 | STA 0 J=I |
| 4656 | CA20 LDA DP+2,1 |
| 4657 | STA DP,1 AOIN(J) = AOIN(J+2) |
| 4658 | LDA DP+3,1 |
| 4659 | STA DP+1,1 |
| 4660 | SSP |
| 4661 | SNZ |
| 4662 | JMP CA22 |
| 4663 | IRS XR J = J+2 |
| 4664 | IRS XR |
| 4665 | JMP CA20 |
| 4666 | CA22 JST STXI |
| 4667 | LDA DP+1,1 |
| 4668 | SSP IF O (I) = , |
| 4669 | LGR 9 |
| 4670 | CAS P |
| 4671 | JMP CA24 |
| 4672 | CAS K134 |
| 4673 | JMP CA24 |
| 4674 | JMP CA30 GO TO CA30 |
| 4675 | CA24 JST ST00 TRIAD SEARCH |
| 4676 | LDA P |
| 4677 | CAS K132 IF P = +,*, AND, OR |
| 4678 | JMP CA28 |
| 4679 | JMP CA37 GO TO CA37 |
| 4680 | CAS K107 |
| 4681 | JMP CA28 ELSE, GO TO CA26 |
| 4682 | JMP CA37 |
| 4683 | CAS K106 |
| 4684 | JMP CA28 |
| 4685 | JMP CA37 |
| 4686 | CAS K103 |
| 4687 | JMP CA28 |
| 4688 | JMP CA37 |
| 4689 | CAS K101 |
| 4690 | JMP CA26 |
| 4691 | * |
| 4692 | * |
| 4693 | * |
| 4694 | JMP CA37 |
| 4695 | CA26 CAS K102 |
| 4696 | JMP *+2 IF P = - |
| 4697 | JMP CA35 GO TO |
| 4698 | CA28 LDA O1 |
| 4699 | JST TC00 TEMP STORE CHECK |
| 4700 | CA30 LDA O2 |
| 4701 | JST TC00 TEMP STORE CHECK |
| 4702 | CA31 JST ET00 ENTER TRIAD |
| 4703 | CA32 JST STXI |
| 4704 | LDA O1 |
| 4705 | STA DP,1 |
| 4706 | LDA DP+1,1 |
| 4707 | LRL 15 |
| 4708 | LDA T0CA |
| 4709 | LGR 15 |
| 4710 | LLL 15 |
| 4711 | STA DP+1,1 |
| 4712 | LDA T2CA IF T2 NOT ZERO, |
| 4713 | SZE |
| 4714 | JMP CA04 GO TO CA04 |
| 4715 | JMP* CA00 ELSE, RETURN |
| 4716 | CA35 LDA T0CA |
| 4717 | ERA ='100000 |
| 4718 | STA T0CA |
| 4719 | CA37 LDA O2 |
| 4720 | IMA O1 O1 * = O2 |
| 4721 | STA O2 |
| 4722 | SNZ IF O2 = 0, |
| 4723 | JMP CA32 GO TO CA32 |
| 4724 | * |
| 4725 | * |
| 4726 | * |
| 4727 | JST ST00 TRIAD SEARCH |
| 4728 | LDA T0CA |
| 4729 | SMI |
| 4730 | JMP CA28 GO TO CA28 |
| 4731 | LDA P |
| 4732 | JMP CA26 ELSE, GO TO CA26 |
| 4733 | CA39 SUB K128 |
| 4734 | SNZ IF P = , OR |
| 4735 | JMP CA04 |
| 4736 | LDA T1CA |
| 4737 | SUB K104 |
| 4738 | SZE ELSE, |
| 4739 | JMP CA18 GO TO CA18 |
| 4740 | JMP CA04 |
| 4741 | CA45 LDA T1CA |
| 4742 | STA I I = T1 |
| 4743 | STA T2CA |
| 4744 | CRA |
| 4745 | STA T0CA * * * * * * * * * * * |
| 4746 | STA O2 O2 = C = 0 |
| 4747 | SUB K110 P = C |
| 4748 | STA P |
| 4749 | JMP CA24 GO TO CA24 |
| 4750 | * IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES |
| 4751 | * ANY TRIAD TABLE ENTRY, EXIT WITH THE |
| 4752 | * POINTER VALUE OF THE MATCHING ENTRY |
| 4753 | * (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT |
| 4754 | * SUBEXPRESSION CALCULATIONS. |
| 4755 | ST00 DAC ** TRIAD SEARCH |
| 4756 | LDA F |
| 4757 | ADD K103 |
| 4758 | SZE |
| 4759 | JMP ST10 GO TO ST10 |
| 4760 | ST05 LDA P ELSE, IF P = X |
| 4761 | SUB K139 |
| 4762 | SNZ |
| 4763 | JMP CA31 GO TO CA31 |
| 4764 | LDA O1 ELSE, IF O1=ACCP |
| 4765 | SUB ACCP |
| 4766 | SNZ |
| 4767 | JMP CA30 GO TO CA30 |
| 4768 | JMP* ST00 ELSE, RETURN |
| 4769 | ST10 LDA L0 |
| 4770 | STA XR |
| 4771 | ST20 LDA XR |
| 4772 | SUB K103 |
| 4773 | STA XR J = J-2 |
| 4774 | SUB L IF J .LT. L |
| 4775 | SPL |
| 4776 | JMP ST05 GO TO ST05 |
| 4777 | LDA O2 |
| 4778 | SUB DP,1 IF O1/P/O2 .NE. O1/P/O2(J) |
| 4779 | SZE |
| 4780 | JMP ST20 GO TO ST20 |
| 4781 | LDA DP+2,1 |
| 4782 | SSP EXTRACT OFF STORE BIT |
| 4783 | SUB P |
| 4784 | SZE |
| 4785 | JMP ST20 |
| 4786 | LDA O1 |
| 4787 | SUB DP+1,1 |
| 4788 | SZE |
| 4789 | JMP ST20 O1 = J |
| 4790 | LDA XR |
| 4791 | STA O1 |
| 4792 | JST STXI ESTABLISH I |
| 4793 | JMP CA32 GO TO CA32 |
| 4794 | * IF J IS A REFERENCE TO A TRIAD , THE TEMP |
| 4795 | * STORE BIT OF THE REFERENCED TRIAD IS SET.) |
| 4796 | TC00 DAC ** TEMP STORE CHECK |
| 4797 | STA XR |
| 4798 | LDA ABAR |
| 4799 | SUB XR |
| 4800 | SMI IS J .GR. ABAR |
| 4801 | JMP* TC00 NO. |
| 4802 | LDA DP+2,1 YES. |
| 4803 | SSM |
| 4804 | STA DP+2,1 S(J) = 1 |
| 4805 | JMP* TC00 |
| 4806 | CA90 OCT 1,2,11,10,13,14,12,15 |
| 4807 | CA91 OCT 2,1,13,14,11,10,12,15 |
| 4808 | * |
| 4809 | * |
| 4810 | * ************* |
| 4811 | * *ENTER TRIAD* |
| 4812 | * ************* |
| 4813 | * STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY |
| 4814 | * LOCATION. |
| 4815 | ET00 DAC ** |
| 4816 | JST SAV |
| 4817 | LDA L |
| 4818 | SUB K103 =3 |
| 4819 | STA L L=L-3 |
| 4820 | STA ACCP SET ACCUM PTR TO LAST TRIAD ENTRY |
| 4821 | STA 0 J=L |
| 4822 | LDA P |
| 4823 | STA DP+2,1 P(J) = P |
| 4824 | LDA O1 |
| 4825 | STA DP+1,1 01(J) = 01 |
| 4826 | LDA O2 |
| 4827 | STA DP,1 02(J) = 02 |
| 4828 | LDA 0 |
| 4829 | STA O1 O1=J |
| 4830 | JST RST |
| 4831 | JMP* ET00 |
| 4832 | ACCP DAC ** ACCUM POINTER |
| 4833 | * |
| 4834 | * |
| 4835 | SFTB BSS 36 SUBFUNCTION TABLE |
| 4836 | * ************************** |
| 4837 | * *GENERATE SUBPRO ENTRANCE* |
| 4838 | * ************************** |
| 4839 | * OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE |
| 4840 | * CALL TO ARGUMENT ADDRESS TRANSFER. |
| 4841 | T0GE PZE 0 |
| 4842 | GE00 DAC ** |
| 4843 | CRA |
| 4844 | STA T0GE |
| 4845 | LDA K17 ( TEST |
| 4846 | JST TS00 |
| 4847 | GE10 JST NA00 INPUT NAME |
| 4848 | LDA I IFF I=0, |
| 4849 | SNZ |
| 4850 | JMP GE20 GO TO GE20 |
| 4851 | CAS K141 |
| 4852 | NOP |
| 4853 | JMP GE30 MAKE ENTRY IN SFTB TABLE |
| 4854 | ADD K103 |
| 4855 | STA I IF FULL, GO TO GE30 |
| 4856 | JST STXA SET XR TO A |
| 4857 | LDA DP,1 |
| 4858 | IAB |
| 4859 | JST STXI ESTABLISH I |
| 4860 | IAB |
| 4861 | STA SFTB,1 |
| 4862 | JST STXA SET XR TO A |
| 4863 | LDA DP+1,1 |
| 4864 | IAB |
| 4865 | JST STXI SET XR TO I |
| 4866 | IAB |
| 4867 | STA SFTB+1,1 |
| 4868 | LDA A |
| 4869 | STA SFTB+2,1 |
| 4870 | JST STXA SET XR TO A |
| 4871 | CRA |
| 4872 | STA DP+1,1 CLEAR OLD USACE |
| 4873 | GE20 LDA K105 |
| 4874 | IAB |
| 4875 | LDA RPL |
| 4876 | ADD T0GE |
| 4877 | ADD K103 (B) = DUM |
| 4878 | JST AF00 DEFINE AFT (A=RPL+T0+3) |
| 4879 | IRS T0GE T0 = T0+1 |
| 4880 | LDA K134 |
| 4881 | SUB TC IF TC = , |
| 4882 | SNZ |
| 4883 | JMP GE10 GO TO GE10 |
| 4884 | JST IP00 INPUT OPERATOR |
| 4885 | CRA |
| 4886 | STA DF |
| 4887 | JST OA00 OUTPUT ABS (0) |
| 4888 | LDA T0GE |
| 4889 | STA ID ID = T0 |
| 4890 | LDA K69 |
| 4891 | STA NAMF+1 NAMF = AT |
| 4892 | JST NF00 FILL IN REMAINING NAME |
| 4893 | JST OL00 OUTPUT OBJECT LINK |
| 4894 | LDA T0GE |
| 4895 | TCA |
| 4896 | STA T0GE |
| 4897 | CRA |
| 4898 | JST OA00 OUTPUT NUMBER OF ARGS |
| 4899 | IRS T0GE OUTPUT SPACE FOR ARG. ADDR. |
| 4900 | JMP *-3 |
| 4901 | JMP* GE00 RETURN |
| 4902 | GE30 JST ER00 CONSTR, ERROR |
| 4903 | BCI 1,AE |
| 4904 | K69 BCI 1,AT AT |
| 4905 | * |
| 4906 | * **************** |
| 4907 | * *EXCHANGE LINKS* |
| 4908 | * **************** |
| 4909 | * CL SUBA IS INTERCHANGED WITH CL SUBF |
| 4910 | EL00 DAC ** |
| 4911 | JST STXA |
| 4912 | LDA DP,1 |
| 4913 | STA EL90 CL (F) == CL (A) |
| 4914 | LDA F |
| 4915 | STA 0 |
| 4916 | JST EL40 |
| 4917 | JST STXA |
| 4918 | JST EL40 |
| 4919 | JMP* EL00 |
| 4920 | EL40 DAC ** |
| 4921 | LDA DP,1 |
| 4922 | IMA EL90 |
| 4923 | ANA K118 |
| 4924 | IMA DP,1 |
| 4925 | ANA K119 |
| 4926 | ADD DP,1 |
| 4927 | STA DP,1 |
| 4928 | JMP* EL40 |
| 4929 | EL90 PZE 0 |
| 4930 | * |
| 4931 | * |
| 4932 | * ***************** |
| 4933 | * *NON COMMON TEST* |
| 4934 | * ***************** |
| 4935 | NM00 DAC ** NON-COMMON TEST |
| 4936 | LDA AT |
| 4937 | SUB K104 |
| 4938 | SZE |
| 4939 | JMP* NM00 |
| 4940 | JST ER00 |
| 4941 | BCI 1,CR ILLEGAL COMMON REFERENCE |
| 4942 | * |
| 4943 | * |
| 4944 | * ************************** |
| 4945 | * *NON DUMMY OR SUBPRO TEST* |
| 4946 | * ************************** |
| 4947 | ND00 DAC ** |
| 4948 | LDA AT TEST |
| 4949 | SUB K105 |
| 4950 | SZE |
| 4951 | JMP ND10 |
| 4952 | JST ER00 |
| 4953 | BCI 1,DA ILLEGAL USE OF A DUMMY ARGUMENT |
| 4954 | JMP* ND00 |
| 4955 | ND10 JST NS00 |
| 4956 | JMP* ND00 |
| 4957 | * |
| 4958 | * |
| 4959 | * ***************** |
| 4960 | * *INPUT SUBSCRIPT* |
| 4961 | * ***************** |
| 4962 | SCT0 PZE 0 |
| 4963 | SC00 DAC ** |
| 4964 | STA SCT0 T0 = (A) |
| 4965 | CRA |
| 4966 | STA NS |
| 4967 | STA S2 NS = S2 = S3 = 0 |
| 4968 | STA S3 |
| 4969 | LDA K17 (-TEST |
| 4970 | JST TS00 |
| 4971 | SC10 LDA EBAR |
| 4972 | SMI |
| 4973 | JMP SC15 EBAR .GR. 0 |
| 4974 | JST XN00 EXAMINE NEXT CHAR. |
| 4975 | SZE |
| 4976 | JMP SC70 IF (A) NON ZERO, |
| 4977 | SC15 JST IG00 GO TO SC70 |
| 4978 | LDA SCT0 INPUT INTEGER |
| 4979 | SZE |
| 4980 | SPL |
| 4981 | JMP SC60 |
| 4982 | LDA ID |
| 4983 | SUB K101 |
| 4984 | JMP SC30 |
| 4985 | SC60 JST AS00 ASSIGN ITEM |
| 4986 | SC20 LDA A S (NS+1) = A |
| 4987 | SC30 IAB |
| 4988 | LDA SC90 |
| 4989 | ADD NS |
| 4990 | STA SC91 |
| 4991 | IAB S(NS+1) = A |
| 4992 | STA* SC91 |
| 4993 | LDA NS |
| 4994 | AOA |
| 4995 | STA NS NS = NS + 1 |
| 4996 | SUB K103 |
| 4997 | SZE |
| 4998 | JMP SC50 MORE SUBSCRIPTS PERMITTED |
| 4999 | SC40 JST IP00 )-INPUT OPERATOR |
| 5000 | JMP* SC00 RETURN |
| 5001 | SC50 LDA TC |
| 5002 | SUB K134 |
| 5003 | SZE |
| 5004 | JMP SC40 TERMINATOR NOT A COMMA |
| 5005 | JMP SC10 G0 TO SC10 |
| 5006 | SC70 JST IR00 INPUT INT VARIABLE |
| 5007 | LDA SCT0 CHECK FOR NON-DUMMY |
| 5008 | SNZ VARIABLE DIMENSIONS |
| 5009 | JMP SC20 |
| 5010 | LDA AT |
| 5011 | SUB K105 |
| 5012 | SNZ |
| 5013 | JMP SC20 |
| 5014 | JST ER00 |
| 5015 | BCI 1,VD ILLEGAL SYMBOLIC SUBSCRIPT |
| 5016 | SC90 DAC S1 |
| 5017 | SC91 DAC ** |
| 5018 | * |
| 5019 | * |
| 5020 | * ******************** |
| 5021 | * *INPUT LIST ELEMENT* |
| 5022 | * ******************** |
| 5023 | * IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT |
| 5024 | IL00 DAC ** |
| 5025 | JST NA00 INPUT NAME |
| 5026 | LDA AT |
| 5027 | SUB K105 NON-DUMMY TEST |
| 5028 | SZE |
| 5029 | JMP *+3 |
| 5030 | JST ER00 USAGE ERROR |
| 5031 | BCI 1,DD DUMMY ITEM IN AN EQUIV. OR DATA LIST |
| 5032 | LDA IU IF IU NOT ARR, |
| 5033 | SUB K103 |
| 5034 | SZE |
| 5035 | JMP IL30 GO TO IL30 |
| 5036 | LDA K103 |
| 5037 | JST SC00 INPUT SUBSCRIPTS |
| 5038 | JST FA00 FETCH ASSIGNS |
| 5039 | LDA ND IF ND = NS |
| 5040 | SUB NS |
| 5041 | SZE S1 = D* (S1 + D1* (S2+D2*S3) |
| 5042 | JMP IL10 ELSE, GO TO IL10 |
| 5043 | LDA S3 |
| 5044 | IAB |
| 5045 | LDA D2 |
| 5046 | JST IM00 |
| 5047 | ADD S2 |
| 5048 | IAB |
| 5049 | LDA D1 |
| 5050 | JST IM00 |
| 5051 | ADD S1 |
| 5052 | IAB |
| 5053 | LDA D0 |
| 5054 | JST IM00 |
| 5055 | STA S1 |
| 5056 | JMP* IL00 RETURN |
| 5057 | IL10 LDA NS IF NS NOT 1 |
| 5058 | SUB K101 |
| 5059 | SZE |
| 5060 | JMP IL20 GO TO IL20 |
| 5061 | LDA S1 ELSE, 20 |
| 5062 | IAB S1 * D0*S1 |
| 5063 | LDA D0 |
| 5064 | JST IM00 |
| 5065 | IL18 STA S1 |
| 5066 | JMP* IL00 RETURN |
| 5067 | IL20 JST ER00 |
| 5068 | BCI 1,ND WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT |
| 5069 | JMP* IL00 RETURN |
| 5070 | IL30 JST TV00 TAG VARIABLE |
| 5071 | CRA S1 = 0 |
| 5072 | JMP IL18 RETURN |
| 5073 | * |
| 5074 | * |
| 5075 | * ************ |
| 5076 | * *FUNCTION * |
| 5077 | * *SUBROUTINE* |
| 5078 | * ************ |
| 5079 | * IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER |
| 5080 | * FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS |
| 5081 | R1 LDA K101 |
| 5082 | STA SFF SFF = 1 |
| 5083 | R2 LDA LSTF |
| 5084 | SZE IF LSTF = 0 |
| 5085 | JMP R2A |
| 5086 | JST ER00 ILLEGAL STATEMENT |
| 5087 | BCI 1,FS NOT FIRST STATEMENT IN SUBPROGRAM |
| 5088 | R2A JST NA00 INPUT NAME |
| 5089 | LDA A |
| 5090 | STA SBF SBF = A |
| 5091 | CRA ADDR=0, S/C CODE =0 |
| 5092 | JST ON00 OUTPUT NAME BLOCK TO THE LOADER |
| 5093 | LDA MFL |
| 5094 | SZE |
| 5095 | JST DM00 DEFINE IM |
| 5096 | LDA TC |
| 5097 | SUB CRET IF TC NOT C/R |
| 5098 | SZE |
| 5099 | JMP R2C GO T0 |
| 5100 | LDA SFF IF SFF = 0 |
| 5101 | SNZ |
| 5102 | JMP R2D GO TO R2D |
| 5103 | JST ER00 ERROR |
| 5104 | BCI 1,FA FUNCTION HAS NO ARGUMENTS |
| 5105 | R2C CRA |
| 5106 | STA I I = 0 |
| 5107 | JST GE00 GENERATE SUBPROGRAM ENTRY |
| 5108 | JMP A1 GO TO C/R TEST |
| 5109 | R2D CRA |
| 5110 | JST OA00 OUTPUT ABS |
| 5111 | JMP C6 GO TO CONTINUE |
| 5112 | * |
| 5113 | * |
| 5114 | * ****************** |
| 5115 | * *INTEGER * |
| 5116 | * *REAL * |
| 5117 | * *DOUBLE PRECISION* |
| 5118 | * *COMPLEX * |
| 5119 | * *LOGICAL * |
| 5120 | * ****************** |
| 5121 | * THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE |
| 5122 | * VALUE AND ANY ARRAY INFO IS PROCESSED |
| 5123 | A3 LDA K101 INTEGER |
| 5124 | JMP A7A TMFL = INT |
| 5125 | A4 LDA K102 REAL |
| 5126 | JMP A7A TMFL = REAL |
| 5127 | A5 LDA K106 DOUBLE PRECISION |
| 5128 | JMP A7A TMFL = DBL |
| 5129 | A6 LDA K105 COMPLEX |
| 5130 | JMP A7A TMFL = CPX |
| 5131 | A7 LDA K103 LOGICAL |
| 5132 | A7A STA MFL TMFL = LOG |
| 5133 | LDA LSTF IF LSTF = 0, GO TO A7B (2) |
| 5134 | SNZ |
| 5135 | JMP A7B ELSE, |
| 5136 | LDA CC SAVE CC |
| 5137 | STA A790 |
| 5138 | CRA |
| 5139 | STA ICSW |
| 5140 | JST DN00 INPUT DNA |
| 5141 | LDA A790 RESTORE CC |
| 5142 | STA CC |
| 5143 | STA ICSW ICSW = IPL |
| 5144 | LDA DFL IF DFL NOT = 0, GO TO A7B |
| 5145 | SZE |
| 5146 | JMP A7B |
| 5147 | LDA TID IF ID = FUNCTI, |
| 5148 | SUB A7K GO TO A9 |
| 5149 | SNZ SKIP IF NOT 'FUNCTION' |
| 5150 | JMP A9 FUNCTION PROCESSOR |
| 5151 | A7A5 JST ER00 CONSTRUCTION ERROR |
| 5152 | BCI 1,TF 'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST |
| 5153 | A7K BCI 1,FU CONSTANT FOR 'FUNCTION' CHECK |
| 5154 | A7B JST NA00 INPUT NAME |
| 5155 | LDA MFL |
| 5156 | JST DM00 DEFINE IM |
| 5157 | JMP B7 GO TO INPUT DIMENSION |
| 5158 | A790 PZE 0 |
| 5159 | * |
| 5160 | * |
| 5161 | * - B2 EXTERNAL |
| 5162 | * TAGS NAME AS SUBPROGRAM |
| 5163 | B2 JST NA00 EXTERNAL, INPUT NAME |
| 5164 | JST TG00 TAG SUBPROGRAM |
| 5165 | JMP B1 GO T0 , OR C/R TEST |
| 5166 | * |
| 5167 | * |
| 5168 | * ***************** |
| 5169 | * *DIMENSION * |
| 5170 | * *INPUT DIMENSION* |
| 5171 | * ***************** |
| 5172 | * PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL |
| 5173 | * ARRAY POINTER ITEM |
| 5174 | B3T0 PZE 0 |
| 5175 | B3T1 PZE 0 |
| 5176 | B3T2 PZE 0 |
| 5177 | B3T3 PZE 0 |
| 5178 | B3 JST NA00 |
| 5179 | B3A LDA AT IF AT = DUM |
| 5180 | SUB K105 (A) = 0 |
| 5181 | SZE ELSE (A) = .LT. 0 |
| 5182 | SSM |
| 5183 | B3B STA B3T0 T0 = (A) |
| 5184 | LDA AF |
| 5185 | STA B3T3 T3 = AF |
| 5186 | LDA A |
| 5187 | STA B3T1 T1 = A |
| 5188 | LDA AT TEST FOR AT=DUMMY |
| 5189 | SUB K105 =5 |
| 5190 | SZE SKIP NO-USAGE TEST IF DUMMY |
| 5191 | JST NU00 NO USAGE TEST |
| 5192 | JST STXA |
| 5193 | LDA DP+1,1 IU (A) = ARR |
| 5194 | LRL 14 |
| 5195 | LDA K103 |
| 5196 | LLL 14 |
| 5197 | STA DP+1,1 |
| 5198 | LDA B3T0 (A) = T0 |
| 5199 | JST SC00 INPUT SUBSCRIPT |
| 5200 | LDA S1 |
| 5201 | STA ID |
| 5202 | LDA S2 PLACE SUBSCRIPTS IN ID |
| 5203 | STA ID+1 |
| 5204 | LDA S3 |
| 5205 | STA ID+2 |
| 5206 | LDA NS (A) = 0, B = NS |
| 5207 | LRL 16 |
| 5208 | JST AA00 ASSIGN SPECIAL |
| 5209 | JST STXA |
| 5210 | LDA DP+1,1 |
| 5211 | LLR 2 |
| 5212 | LDA B3T3 |
| 5213 | LGL 2 |
| 5214 | LRR 2 |
| 5215 | STA DP+1,1 DEFINE GF TO GF(A) |
| 5216 | LDA A |
| 5217 | STA B3T2 T2 = A |
| 5218 | LDA B3T1 |
| 5219 | STA A A = T1 |
| 5220 | JST STXA |
| 5221 | LDA DP+1,1 |
| 5222 | LLR 2 |
| 5223 | LDA B3T2 |
| 5224 | LGL 2 |
| 5225 | LRR 2 |
| 5226 | STA DP+1,1 DEFINE GF TO GF(A) |
| 5227 | B3D LDA TC |
| 5228 | SUB K104 IF TC NOT SLASH |
| 5229 | SZE |
| 5230 | JMP B1 GO TO ,-C/R TEST |
| 5231 | LDA A9T2 IF SIDSW = COMMON-4 |
| 5232 | SUB B4Z9 |
| 5233 | SZE GO TO B4 (COMMON-0) |
| 5234 | JMP B1 ELSE, GO TO ,-C/R TEST |
| 5235 | JMP B40 |
| 5236 | B7 LDA TC IF TC = ( |
| 5237 | SUB K17 |
| 5238 | SZE |
| 5239 | JMP B3D |
| 5240 | JMP B3A |
| 5241 | * |
| 5242 | * |
| 5243 | * ******** |
| 5244 | * *COMMON* |
| 5245 | * ******** |
| 5246 | * INPUT BLOCK NAMES AND LINK THEM WITH THE |
| 5247 | * FOLLOWING VAR/ARRAY NAMES. BLOCK NAMES |
| 5248 | * ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS |
| 5249 | B4 LDA K81 |
| 5250 | STA ID |
| 5251 | STA ID+1 |
| 5252 | STA ID+2 |
| 5253 | LDA B4Z9 SET SWITCH IN INPUT DIMENSION |
| 5254 | STA A9T2 |
| 5255 | JST CH00 INPUT CHAR |
| 5256 | SUB K9 IF NOT SLASH |
| 5257 | SZE GO TO |
| 5258 | JMP B4E |
| 5259 | B40 JST DN00 INPUT DNA |
| 5260 | LDA K104 SLASH TEST |
| 5261 | JST TS00 |
| 5262 | B4B LRL 32 |
| 5263 | LDA K101 (A) = SUB, (B) = 0 |
| 5264 | JST AA00 ASSIGN SPECIAL |
| 5265 | LDA CFL |
| 5266 | SNZ |
| 5267 | LDA A |
| 5268 | STA CFL |
| 5269 | LDA A |
| 5270 | STA F |
| 5271 | JST FL00 FETCH LINK |
| 5272 | SZE |
| 5273 | JMP B4D |
| 5274 | LDA CFL |
| 5275 | STA 0 |
| 5276 | LDA DP+1,1 GF(CFL) |
| 5277 | IMA A |
| 5278 | STA 0 INDEX = A |
| 5279 | IMA A |
| 5280 | STA DP+1,1 GF(A) = GF(CFL) |
| 5281 | LDA CFL |
| 5282 | STA 0 INDEX = CFL |
| 5283 | LDA A |
| 5284 | ADD K122 ='040000 |
| 5285 | STA DP+1,1 GF(CFL) = A |
| 5286 | B4D JST NA00 INPUT NAME |
| 5287 | JST ND00 NON DUMMY/SUBPROG TEST |
| 5288 | JST NM00 NON-COMMON TEST |
| 5289 | JST EL00 EXCHANGE LINKS |
| 5290 | LDA DP,1 |
| 5291 | ANA B4F ='107777 |
| 5292 | ADD K122 AT(A) = COM (='040000) |
| 5293 | STA DP,1 |
| 5294 | JMP B7 |
| 5295 | B4E JST UC00 UNINPUT COLUMN |
| 5296 | JMP B4B |
| 5297 | B4Z9 DAC B4D GO TO INPUT DIMENSION |
| 5298 | B4F OCT 107777 EXTRACT MASK TO STRIP OFF AT FIELD |
| 5299 | * |
| 5300 | * |
| 5301 | * ************* |
| 5302 | * *EQUIVALENCE* |
| 5303 | * ************* |
| 5304 | * STORE EQUIV INFO IN THE DATA POOL FOR LATER |
| 5305 | * PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP) |
| 5306 | B5 LDA E0 L=NEXT WORD IN EQUIVALENCE TABLE |
| 5307 | STA I I=L |
| 5308 | SUB K101 (=1) |
| 5309 | STA E0 L=L-1 |
| 5310 | SUB ABAR |
| 5311 | SMI |
| 5312 | JMP *+3 |
| 5313 | JST ER00 DATA POOL FULL |
| 5314 | BCI 1,MO MEMORY OVERFLOW |
| 5315 | JST STXI ESTABLISH I |
| 5316 | CRA |
| 5317 | STA DP,1 DP (I) = 0 |
| 5318 | B5B JST CH00 |
| 5319 | LDA DP,1 INPUT CHAR |
| 5320 | SZE |
| 5321 | JMP B5D |
| 5322 | LDA TC PUT IN FIRST CHARACTER |
| 5323 | LGL 8 PACK INTO DP (I) |
| 5324 | B5C STA DP,1 |
| 5325 | LDA TC |
| 5326 | SUB CRET |
| 5327 | SNZ |
| 5328 | JMP C6 CHARACTER E C/R - EXIT |
| 5329 | LDA DP,1 |
| 5330 | ANA K100 |
| 5331 | SNZ |
| 5332 | JMP B5B WORD NOT FULL |
| 5333 | JMP B5 OBTAIN NEW WORD |
| 5334 | B5D LDA TC PUT IN SECOND CHARACTER |
| 5335 | ERA DP,1 |
| 5336 | JMP B5C |
| 5337 | * |
| 5338 | * |
| 5339 | * ********************* |
| 5340 | * *RELATE COMMON ITEMS* |
| 5341 | * ********************* |
| 5342 | * ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED |
| 5343 | * AND THEIR INVERSE OFFSETS CALCULATED. THESE |
| 5344 | * WILL BE INVERTED LATER TO GIVE TRUE |
| 5345 | * POSITION IN THE BLOCK. |
| 5346 | C2T0 PZE 0 |
| 5347 | C2 LDA CFL |
| 5348 | STA A A = F = CFL |
| 5349 | C2A CRA |
| 5350 | STA C2T0 T0 = 0 |
| 5351 | LDA A |
| 5352 | STA F F = A |
| 5353 | C2B JST FL00 FETCH LINK |
| 5354 | SNZ |
| 5355 | JMP C2D |
| 5356 | LDA D0 |
| 5357 | ADD C2T0 T0 = T0 + D0 |
| 5358 | STA C2T0 |
| 5359 | JST DA00 DEFINE ADDRESS FIELD |
| 5360 | JMP C2B |
| 5361 | C2D JST FL00 FETCH LINK |
| 5362 | SZE |
| 5363 | JMP C2F |
| 5364 | LDA AF |
| 5365 | STA A A = AF |
| 5366 | SUB CFL |
| 5367 | SZE |
| 5368 | JMP C2A AF = CFL, NO |
| 5369 | JMP C3 YES - GROUP EQUIVALENCE |
| 5370 | C2F LDA C2T0 |
| 5371 | SUB AF (A) = T0 - AF |
| 5372 | JST DA00 DEFINE AF |
| 5373 | LDA IU |
| 5374 | SZE |
| 5375 | JMP C2D |
| 5376 | JST TV00 TAG VARIABLE |
| 5377 | JMP C2D |
| 5378 | * |
| 5379 | * |
| 5380 | * ******************* |
| 5381 | * *GROUP EQUIVALENCE* |
| 5382 | * ******************* |
| 5383 | * THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON |
| 5384 | * USAGE IS CHECKED TO SEE THAT THE ORIGIN |
| 5385 | * IS NOT MOVED AND THAT ONLY ONE ITEM IS |
| 5386 | * COMMON. |
| 5387 | C3T0 PZE 0 |
| 5388 | C3T1 PZE 0 |
| 5389 | C3T2 PZE 0 |
| 5390 | C3T3 PZE 0 |
| 5391 | C3T4 PZE 0 |
| 5392 | C3T5 PZE 0 |
| 5393 | T0C3 EQU C3T0 |
| 5394 | T1C3 EQU C3T1 |
| 5395 | T2C3 EQU C3T2 |
| 5396 | T3C3 EQU C3T3 |
| 5397 | T4C3 EQU C3T4 |
| 5398 | C3 LDA E0 |
| 5399 | STA EBAR EBAR=E(0) = END OF EQUIVALENCE TABLE |
| 5400 | LDA L0 |
| 5401 | STA E E=L(0) = START OF EUUIVALENCE TABLE |
| 5402 | LDA CRET |
| 5403 | STA TC |
| 5404 | C3B LDA E |
| 5405 | STA EP E-PRIME = E |
| 5406 | CRA |
| 5407 | STA F I = 0 |
| 5408 | LDA K102 T4 = STR-ABS |
| 5409 | STA C3T4 |
| 5410 | JST CH00 INPUT CHARACTER |
| 5411 | LDA K17 |
| 5412 | JST TS00 (TEST |
| 5413 | C3D JST IL00 INPUT LIST ELEMENT |
| 5414 | JST SAF |
| 5415 | LDA S1 |
| 5416 | SUB AF TL = S1-AF |
| 5417 | STA C3T1 |
| 5418 | LDA A T2 = A |
| 5419 | STA C3T2 |
| 5420 | C3F LDA F IF I=0, GO TO C3P |
| 5421 | SNZ |
| 5422 | JMP C3P |
| 5423 | C3G LDA F ELSE, |
| 5424 | SUB A IF A = I, GO TO C3N |
| 5425 | SNZ |
| 5426 | JMP C3N |
| 5427 | C3H LDA AT ELSE, |
| 5428 | SUB K104 IF AT = COM, GO TO C3O |
| 5429 | SNZ |
| 5430 | JMP C3O |
| 5431 | C3H2 LDA T1C3 |
| 5432 | ADD AF T(0) = AF +T (1) |
| 5433 | STA T0C3 |
| 5434 | LDA T4C3 IF T(4) = 0, GO TO C3K |
| 5435 | SUB K104 |
| 5436 | SZE |
| 5437 | JMP C3K |
| 5438 | LDA T3C3 ELSE, |
| 5439 | SUB T0C3 T(0) = T(3)-T(0) |
| 5440 | STA T0C3 |
| 5441 | SMI |
| 5442 | JMP C3K IF T(0)<0, |
| 5443 | JST ER00 |
| 5444 | BCI 1,IC IMPOSSIBLE COMMON EQUIVALENCING |
| 5445 | C3K LDA C3T4 |
| 5446 | IAB AT (A) = COM |
| 5447 | LDA T0C3 |
| 5448 | ALS 2 |
| 5449 | LGR 2 |
| 5450 | JST AF00 DEFINE AF |
| 5451 | JST FL00 FETCH LINK |
| 5452 | JST SAF |
| 5453 | LDA A |
| 5454 | SUB C3T2 IF A .NE. T (2), |
| 5455 | SZE GO TO C3G (5) |
| 5456 | JMP C3G |
| 5457 | * EXCHANGE CL(A) == CL(I) |
| 5458 | JST EL00 EXCHANGE LINKS (CL(A) WITH CL(F) ) |
| 5459 | C3M LDA TC IF TC = , |
| 5460 | SUB K134 |
| 5461 | SNZ |
| 5462 | JMP C3D ELSE, |
| 5463 | JST IP00 )-INPUT OPERATOR |
| 5464 | LDA TC |
| 5465 | SUB K134 IF TC = , OR C/R |
| 5466 | SNZ GO TO C3B (1) |
| 5467 | JMP C3B |
| 5468 | LDA TC |
| 5469 | SUB CRET |
| 5470 | SNZ |
| 5471 | JMP C3B ELSE, |
| 5472 | JST ER00 |
| 5473 | BCI 1,EC EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR |
| 5474 | JMP C3B |
| 5475 | C3N LDA T1C3 IF T1 = 0, GO TO C3M |
| 5476 | SNZ |
| 5477 | JMP C3M |
| 5478 | C3N5 JST ER00 ERROR IMPOSSIBLE GROUP |
| 5479 | BCI 1,IE IMPOSSIBLE EQUIVALENCE GROUPING |
| 5480 | C3O LDA S1 |
| 5481 | ADD AF |
| 5482 | STA T3C3 |
| 5483 | LDA K104 =4 |
| 5484 | CAS T4C3 |
| 5485 | JMP *+2 |
| 5486 | JMP C3N5 |
| 5487 | STA T4C3 |
| 5488 | LDA F |
| 5489 | CAS A IF A = F, GO TO C3M (B) |
| 5490 | JMP *+2 |
| 5491 | JMP C3M ELSE, |
| 5492 | STA A A = I |
| 5493 | IMA C3T2 |
| 5494 | STA F |
| 5495 | CRA T1 = 0 |
| 5496 | STA C3T1 |
| 5497 | JST FA00 FETCH ASSIGNS |
| 5498 | JST SAF |
| 5499 | JMP C3H2 GO TO C3H2 |
| 5500 | C3P LDA A |
| 5501 | STA F |
| 5502 | JMP C3H |
| 5503 | * |
| 5504 | * |
| 5505 | * *********************** |
| 5506 | * *ASSIGN SPECIFICATIONS* |
| 5507 | * *********************** |
| 5508 | * NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER |
| 5509 | * COMMON BLOCKS ARE OUTPUT (WITH SIZE). |
| 5510 | C4T0 PZE 0 |
| 5511 | C4T1 PZE 0 |
| 5512 | C4B STA A A = 0 |
| 5513 | C4C LDA A |
| 5514 | ADD K105 I = A = A+5 |
| 5515 | STA A |
| 5516 | STA F |
| 5517 | CAS ABAR |
| 5518 | JMP NP35 RETURN TO FIRST NON-SPEC CHECK (POINT 1) |
| 5519 | NOP |
| 5520 | JST FA00 ELSE, FETCH ASSIGN |
| 5521 | LDA AT |
| 5522 | SUB K102 IF AT = STR-ABS |
| 5523 | SZE IU=VAR. OR ARR, AND |
| 5524 | JMP C4C NT = 0 |
| 5525 | LDA IU GO TO C4E |
| 5526 | SUB K102 ELSE, GO TO C4C |
| 5527 | SPL |
| 5528 | JMP C4C |
| 5529 | LDA NT |
| 5530 | SZE |
| 5531 | JMP C4C |
| 5532 | C4E CRA |
| 5533 | STA C4T0 T0 = 0. T1 =-MAX |
| 5534 | SUB K111 |
| 5535 | STA C4T1 |
| 5536 | JST KT00 SET D(0) = NO. OF WORDS PER ITEM |
| 5537 | C4F JST SAF |
| 5538 | CAS C4T0 |
| 5539 | STA C4T0 |
| 5540 | NOP |
| 5541 | LDA D0 |
| 5542 | SUB AF (A) = D(0) - AF |
| 5543 | CAS C4T1 |
| 5544 | STA C4T1 |
| 5545 | NOP |
| 5546 | JST FL00 FETCH LINK ( (A)=A - F ) |
| 5547 | SZE |
| 5548 | JMP C4F GO TO C4F |
| 5549 | LDA RPL |
| 5550 | ADD C4T0 RPL * RPL + T0 + TL |
| 5551 | STA C4T0 |
| 5552 | ADD C4T1 TO = RPL-T1 |
| 5553 | STA RPL |
| 5554 | C4I JST SAF |
| 5555 | LDA K101 |
| 5556 | IAB (B) = REL |
| 5557 | LDA C4T0 (A) = T0-AF |
| 5558 | SUB AF |
| 5559 | JST AF00 DEFINE AFT |
| 5560 | JST FL00 FETCH LINK |
| 5561 | SZE IF (A) NOT ZERO, |
| 5562 | JMP C4I NOT END OF EQUIVALENCE GROUP |
| 5563 | JMP C4C CHECK NEXT ITEM IN ASSIGNMENT TABLE |
| 5564 | * |
| 5565 | C4L2 LDA FLT1 = LINK LOCATION TO COMMON BLOCK NAME |
| 5566 | STA C4T1 |
| 5567 | C4L3 LDA A |
| 5568 | STA I SAVE A FOR LATER MODIFICATION |
| 5569 | JST FL00 FETCH LINK |
| 5570 | SNZ |
| 5571 | JMP C4M END OF COMMON GROUP |
| 5572 | JST STXI SET INDEX TO POINT TO CURRENT ITEM IN |
| 5573 | * COMMON GROUP. |
| 5574 | LDA DP,1 SET CL FIELD TO POINT AT COMMON BLOCK |
| 5575 | * NAME. |
| 5576 | ANA K119 (='177000) |
| 5577 | ADD C4T1 (= LINK LOCATION OF COMMON BLOCK NAME) |
| 5578 | STA DP,1 |
| 5579 | JMP C4L3 PROCESS NEXT ITEM IN COMMON BLOCK |
| 5580 | * |
| 5581 | C4 LDA CFL LOC. OF FIRST (BLANK) COMMON BLOCK |
| 5582 | STA F |
| 5583 | C4L6 STA A |
| 5584 | CRA |
| 5585 | STA C4T0 |
| 5586 | C4L JST FL00 FETCH LINK |
| 5587 | SNZ |
| 5588 | JMP C4L2 NO MORE ITEMS IN COMMON BLOCK |
| 5589 | LDA D0 ELSE, IF TO .LT. D0+AF, |
| 5590 | ADD AF |
| 5591 | CAS C4T0 T0 = D0 + AF |
| 5592 | STA C4T0 |
| 5593 | NOP |
| 5594 | JMP C4L GO TO C4L |
| 5595 | C4M LDA AF |
| 5596 | STA F I=AF |
| 5597 | LDA C4T0 (A) = T0 |
| 5598 | JST DA00 DEFINE AF |
| 5599 | *....OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER |
| 5600 | LDA AF LENGTH OF COMMON BLOCK |
| 5601 | ANA K111 ='37777 |
| 5602 | ADD K122 ='40000 (S/C CODE = 1) |
| 5603 | JST ON00 OUTPUT NAME BLOCK TO LOADER |
| 5604 | LDA F |
| 5605 | SUB CFL IF I = CFL |
| 5606 | SNZ |
| 5607 | JMP C4B |
| 5608 | LDA F |
| 5609 | JMP C4L6 |
| 5610 | * |
| 5611 | SAF DAC ** |
| 5612 | LDA AF |
| 5613 | LGL 2 |
| 5614 | ARS 2 |
| 5615 | STA AF |
| 5616 | JMP* SAF |
| 5617 | * |
| 5618 | * ************************** |
| 5619 | * *DATA STATEMENT PROCESSOR* |
| 5620 | * ************************** |
| 5621 | * PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS |
| 5622 | * TO APPROPRIATE LOCATIONS. MODES MUST AGREE |
| 5623 | T0W4 PZE 0 |
| 5624 | T1W4 PZE 0 |
| 5625 | G PZE 0 LOWEST INDEX POINT IN LIST |
| 5626 | W4 LDA L0 |
| 5627 | STA I I=END OF DATA POOL |
| 5628 | W4B JST IL00 INPUT LIST ELEMENT |
| 5629 | LDA AT D (0) = =WDS/ITEM |
| 5630 | SUB K102 |
| 5631 | SNZ IF AT = 'STR-ABS' |
| 5632 | JMP W4T GO TO |
| 5633 | LDA I |
| 5634 | STA 0 |
| 5635 | LDA S1 S1 * DEFLECTION IF AN ARRAY |
| 5636 | ADD AF |
| 5637 | STA DP,1 DP(E) = AF + S1 |
| 5638 | W4C LDA A |
| 5639 | STA DP-1,1 DP (E-1) = A |
| 5640 | LDA I |
| 5641 | SUB K102 |
| 5642 | STA I |
| 5643 | STA G |
| 5644 | LDA TC IF TC = , |
| 5645 | SUB K134 |
| 5646 | SNZ |
| 5647 | JMP W4B GO TO W4B |
| 5648 | LDA K104 |
| 5649 | JST TS00 TEST FOR SLASH TERMINATOR |
| 5650 | LDA RPL |
| 5651 | STA T1W4 |
| 5652 | LDA L0 |
| 5653 | STA I I= END OF DATA POOL |
| 5654 | W4E CRA |
| 5655 | STA KPRM K' = KBAR = 0 |
| 5656 | STA KBAR |
| 5657 | W4F JST DN00 INPUT, DNA |
| 5658 | LDA NT |
| 5659 | SZE IF NT = 0 |
| 5660 | JMP W4G VARIABLE OR ARRAY |
| 5661 | LDA TC LAST CHARACTER |
| 5662 | CAS K17 ='250 ( =( ) |
| 5663 | JMP *+2 |
| 5664 | JMP *+3 START OF COMPLEX CONSTANT |
| 5665 | JST ER00 ERROR |
| 5666 | BCI 1,CN NON-CON DATA |
| 5667 | STA SXF SET SXF TO NON-ZERO |
| 5668 | JMP W4F FINISH INPUT OF COMPLEX CONSTANT |
| 5669 | W4G LDA KBAR MULTIPLY COUNT |
| 5670 | SZE |
| 5671 | JMP W4K GO TO W4K |
| 5672 | LDA TC IF TC NOT * |
| 5673 | SUB K103 |
| 5674 | SZE |
| 5675 | JMP W4L |
| 5676 | LDA ID |
| 5677 | SUB K101 |
| 5678 | STA KBAR KBAR = ID-1 |
| 5679 | JST IT00 INTEGER TEST |
| 5680 | JMP W4F |
| 5681 | W4K LDA KPRM IF K NOT ZERO |
| 5682 | SZE |
| 5683 | JMP W4M GO TO W4M |
| 5684 | W4L LDA KBAR |
| 5685 | ALS 1 K ' = E-3* KBAR |
| 5686 | TCA |
| 5687 | ADD I |
| 5688 | STA KPRM |
| 5689 | W4M JST STXI SET INDEX = I |
| 5690 | LDA DP-1,1 |
| 5691 | STA A A = DP (E-1) |
| 5692 | LDA IM |
| 5693 | STA T0W4 T0 = IM |
| 5694 | JST FA00 |
| 5695 | LDA BDF IF BDF NOT ZERO |
| 5696 | SZE |
| 5697 | JMP W4S GO TO W4S |
| 5698 | JST NM00 NON-COMMON TEST |
| 5699 | W4O JST STXI SET INDEX = I |
| 5700 | LDA DP,1 |
| 5701 | STA RPL RPL = AF |
| 5702 | JST FS00 FLUSH |
| 5703 | CRA |
| 5704 | STA DF DF = 0 |
| 5705 | LDA HOLF IS IT HOLLERITH DATA |
| 5706 | SZE NO |
| 5707 | JMP WHOW YES, GO TO OUTPUT IT |
| 5708 | LDA D0 |
| 5709 | STA 0 |
| 5710 | JMP *,1 SWITCH ON NUMBER OF WORDS TO OUTPUT |
| 5711 | JMP W405 |
| 5712 | JMP W403 |
| 5713 | JMP W404 |
| 5714 | LDA TID+2 |
| 5715 | JST OA00 |
| 5716 | LDA TID+1 |
| 5717 | JST OA00 |
| 5718 | LDA TIDB+2 |
| 5719 | JST OA00 |
| 5720 | LDA TIDB+1 |
| 5721 | JMP W406 |
| 5722 | WHOW LDA D0 (A)=NO. OF WORDS PER ITEM |
| 5723 | ALS 1 (A)=NO. OF CHARS. PER ITEM |
| 5724 | STA NTID NTID=NO. OF CHARS. TO BE OUTPUT |
| 5725 | SUB HOLF |
| 5726 | SPL |
| 5727 | JMP WERR |
| 5728 | LDA ID FIRST WORD |
| 5729 | JST WSNG OUTPUT IT |
| 5730 | LDA ID+1 2ND WORD |
| 5731 | JST WSNG OUTPUT IT |
| 5732 | LDA ID+2 3RD WORD |
| 5733 | JST WSNG OUTPUT IT |
| 5734 | LDA ID+3 4TH WORD |
| 5735 | JST OA00 OUTPUT IT |
| 5736 | JMP W420 TO CHECK NEXT DATA |
| 5737 | * |
| 5738 | WSNG PZE 0 |
| 5739 | JST OA00 OUTPUT (A) |
| 5740 | LDA NTID NO. OF CHARS. REMAINED TO BE OUTPUT |
| 5741 | SUB K102 |
| 5742 | STA NTID NTID=NTID-2 |
| 5743 | SNZ |
| 5744 | JMP W420 ALL FINISHED, CHECK NEXT ITEM |
| 5745 | JMP* WSNG SOME HOLLERITH CHARS. REMAINED |
| 5746 | W403 LDA TID+2 REAL OUTPUT |
| 5747 | JST OA00 |
| 5748 | LDA TID+1 |
| 5749 | JMP W406 |
| 5750 | W404 LDA TID+2 DOUBLE PRECISION OUTPUT |
| 5751 | JST OA00 |
| 5752 | LDA TID+1 |
| 5753 | JST OA00 |
| 5754 | W405 LDA TID INTEGER OUTPUT |
| 5755 | W406 JST OA00 |
| 5756 | LDA T0W4 |
| 5757 | ERA IM |
| 5758 | ANA K105 |
| 5759 | SNZ |
| 5760 | JMP *+3 |
| 5761 | * TO BE OUTPUT, RETURN |
| 5762 | WERR JST ER00 |
| 5763 | BCI 1,DM DATA AND DATA NAME MODE DO NOT AGREE |
| 5764 | W420 LDA I |
| 5765 | SUB K102 |
| 5766 | STA I I = I-2 |
| 5767 | CAS KPRM |
| 5768 | NOP |
| 5769 | JMP W4M MORE TO DO |
| 5770 | SUB G TEST FOR COMPLETE |
| 5771 | SZE |
| 5772 | JMP W4P |
| 5773 | LDA K104 |
| 5774 | JST TS00 |
| 5775 | LDA T1W4 |
| 5776 | STA RPL |
| 5777 | JST CH00 INPUT NEXT CHARACTER |
| 5778 | SUB K5 ='254 (,) |
| 5779 | SZE SKIP IF CHAR = COMMA |
| 5780 | JMP A1 CHECK FOR (CR) |
| 5781 | JMP W4 PROCESS NEXT DATA GROUP |
| 5782 | W4P LDA K134 |
| 5783 | JST TS00 |
| 5784 | JMP W4E |
| 5785 | W4S JST FS00 FLUSH BUFFER IF NECESSARY |
| 5786 | LDA AF POSITION WITHIN COMMON BLOCK |
| 5787 | LRL 14 |
| 5788 | LDA K106 FORMAT BCD OUTPUT |
| 5789 | LGL 6 |
| 5790 | LLL 6 |
| 5791 | STA OCI |
| 5792 | IAB |
| 5793 | ANA K116 |
| 5794 | STA OCI+1 |
| 5795 | JST FL00 FETCH LINK |
| 5796 | LDA DP+4,1 |
| 5797 | SSM |
| 5798 | ALR 1 |
| 5799 | SSM |
| 5800 | ARR 1 |
| 5801 | LRL 8 |
| 5802 | ERA OCI+1 |
| 5803 | STA OCI+1 |
| 5804 | LDA DP+3,1 |
| 5805 | IAB |
| 5806 | LDA DP+4,1 |
| 5807 | LLL 8 |
| 5808 | STA OCI+2 |
| 5809 | LDA DP+2,1 |
| 5810 | IAB |
| 5811 | LDA DP+3,1 |
| 5812 | LLL 8 |
| 5813 | STA OCI+3 |
| 5814 | LDA DP+2,1 |
| 5815 | LGL 2 |
| 5816 | ADD K103 |
| 5817 | LGL 6 |
| 5818 | STA OCI+4 |
| 5819 | LDA K128 |
| 5820 | STA OCNT |
| 5821 | JST STXI I POINTS TO DATA TABLE |
| 5822 | LDA DP-1,1 SET A TO VARIABLE |
| 5823 | STA A |
| 5824 | JST FA00 |
| 5825 | JMP W4O |
| 5826 | W4T LDA K101 =1 (=REL) |
| 5827 | IAB |
| 5828 | LDA RPL |
| 5829 | JST AF00 DEFINE AFT (AT=REL, AF=RPL) |
| 5830 | LDA I SET POINTER IN DATA POOL |
| 5831 | STA 0 |
| 5832 | LDA RPL |
| 5833 | STA DP,1 DP(I) = RPL OF VARIABLE |
| 5834 | ADD D0 |
| 5835 | STA RPL |
| 5836 | JMP W4C |
| 5837 | * |
| 5838 | * |
| 5839 | * ********************************* |
| 5840 | * *BLOCK DATA SUBPROGRAM PROCESSOR* |
| 5841 | * ********************************* |
| 5842 | * SET BLOCK DATA FLAG AND OUTPUT FORCE LOAD CODE |
| 5843 | R3 LDA LSTF =0 IF FIRST STATEMENT IN THE SUBPROGRAM |
| 5844 | SZE |
| 5845 | JMP *+3 |
| 5846 | JST ER00 ERROR...NOT FIRST STATEMENT |
| 5847 | BCI 1,BL 'BLOCK DATA' NOT FIRST STATEMENT |
| 5848 | STA BDF SET BLOCK DATA FLAG ON (NON-ZERO) |
| 5849 | JST CH00 INPUT NEXT CHARACTER |
| 5850 | JMP A1 CHECK FOR (CR) AND EXIT |
| 5851 | * |
| 5852 | * |
| 5853 | * |
| 5854 | * |
| 5855 | * |
| 5856 | * |
| 5857 | * |
| 5858 | * *************************** |
| 5859 | * *TRACE STATEMENT PROCESSOR* |
| 5860 | * *************************** |
| 5861 | * SETS TRACE TAG ON VARIABLES OR SETS TRACE FLAG |
| 5862 | TRAC JST XN00 EXAMINE NEXT CHARACTER |
| 5863 | SZE SKIP IF CHAR. WAS A DIGIT |
| 5864 | JMP TRAD JUMP IF CHAR. WAS A LETTER |
| 5865 | JST IS00 INPUT STATEMENT NO. |
| 5866 | LDA A STATEMENT NO. POINTER |
| 5867 | STA TRF SET TRACE FLAG ON |
| 5868 | JMP A1 TEST FOR (CR) AND EXIT |
| 5869 | * |
| 5870 | TRAD JST NA00 INPUT NAME |
| 5871 | JST STXA SET INDEX TO NAME ENTRY |
| 5872 | LDA DP+4,1 TT(A) TRACE TAG |
| 5873 | CHS |
| 5874 | STA DP+4,1 |
| 5875 | JMP B1 (,) OR (CR) TEST |
| 5876 | * (RETURN TO TRAC IF (,) ) |
| 5877 | * |
| 5878 | * |
| 5879 | * |
| 5880 | * ******************** |
| 5881 | * *OUTPUT OBJECT LINK* |
| 5882 | * ******************** |
| 5883 | OL00 DAC ** |
| 5884 | JST CN00 CALL NAME |
| 5885 | CRA |
| 5886 | STA DF DF = 0 |
| 5887 | LDA ID (A) = IP |
| 5888 | JST OA00 OUTPUT +BS |
| 5889 | * |
| 5890 | JMP* OL00 |
| 5891 | * |
| 5892 | * ***************** |
| 5893 | * *OUTPUT I/O LINK* |
| 5894 | * ***************** |
| 5895 | * GENERATE I/O DRIVER LINKAGE CODE. NAME OF |
| 5896 | * CALLED ROUTINE IS CHANGED IF UNIT DESIGNATOR |
| 5897 | * IS A CONSTANT. |
| 5898 | OI00 DAC ** |
| 5899 | JST IV00 INPUT INT VAR/CON |
| 5900 | LDA NT |
| 5901 | SNZ IF NT = 0 |
| 5902 | JMP OI20 GO TO 0I20 |
| 5903 | LDA ID IF ID CR 9 |
| 5904 | SUB K126 G0 TU OI20 |
| 5905 | SMI |
| 5906 | JMP OI20 |
| 5907 | * FORM F$RN OR F$WN |
| 5908 | LDA NAMF+1 |
| 5909 | ANA K116 |
| 5910 | ADD ID |
| 5911 | ADD K60 ='260 (SP) |
| 5912 | STA NAMF+1 |
| 5913 | OI10 JST CN00 CALL NAME |
| 5914 | JMP* OI00 RETURN |
| 5915 | OI20 LRL 32 |
| 5916 | LDA OMI7 OUTPUT OA |
| 5917 | JST OB00 (LOAD A (UNIT N0.)) |
| 5918 | JMP OI10 FO TO OI10 |
| 5919 | * |
| 5920 | * |
| 5921 | * *********** |
| 5922 | * *CALL NAME* |
| 5923 | * *********** |
| 5924 | * SET UP NAME AND GENERATE CODE FOR CALLING IT. |
| 5925 | CN00 DAC ** |
| 5926 | JST FS00 FLUSH |
| 5927 | JST PRSP SET PRINT BUFFER TO SPACES |
| 5928 | LDA K147 SET UP OCI FOR CALL |
| 5929 | STA OCI |
| 5930 | LDA NAMF+1 OCI = NAMF |
| 5931 | STA PRI+9 |
| 5932 | IAB ALSO TO PRINT BUFFER |
| 5933 | LDA NAMF |
| 5934 | STA PRI+8 |
| 5935 | LRL 8 |
| 5936 | STA OCI+1 |
| 5937 | LLL 16 |
| 5938 | STA OCI+2 |
| 5939 | LDA NAMF+2 |
| 5940 | STA PRI+10 |
| 5941 | IAB |
| 5942 | LDA NAMF+1 |
| 5943 | LLL 8 |
| 5944 | STA OCI+3 |
| 5945 | LLL 16 |
| 5946 | STA OCI+4 |
| 5947 | LDA K128 ='14 |
| 5948 | STA OCNT OCNT = 6 |
| 5949 | LDA CN90 |
| 5950 | STA PRI+5 |
| 5951 | LDA CN90+1 |
| 5952 | STA PRI+6 |
| 5953 | LDA RPL |
| 5954 | JST OR80 |
| 5955 | DAC PRI |
| 5956 | SR2 |
| 5957 | JMP *+3 INHIBIT SYMBOLIC OUTPUT |
| 5958 | CALL F4$SYM OUTPUT SYMBOLIC LINE. |
| 5959 | DAC PRI |
| 5960 | IRS RPL RPL = RPL + 1 |
| 5961 | JST PRSP SET PRINT BUFFER TO SPACES |
| 5962 | JST FS00 FLUSH |
| 5963 | JMP* CN00 RETURN |
| 5964 | K147 OCT 55000 |
| 5965 | CN90 BCI 2,CALL |
| 5966 | * ************* |
| 5967 | * *OUTPUT PACK* |
| 5968 | * ************* |
| 5969 | * OUTPUT THE PACK WORD WHEN IT IS FULL. |
| 5970 | PKF PZE 0 PACK FLAG |
| 5971 | T0OK PZE 0 |
| 5972 | OK00 DAC ** |
| 5973 | CAS CRET IF (A) = C/R |
| 5974 | JMP *+2 |
| 5975 | JMP OK30 GO TO OK30 |
| 5976 | IRS PKF PKF = PKF + 1 |
| 5977 | JMP OK20 IF NON-ZERO, GO TO OK20 |
| 5978 | OK10 ADD T0OK (A) = (A) + T0 |
| 5979 | LRL 16 |
| 5980 | STA DF |
| 5981 | IAB |
| 5982 | JST OA00 OUTPUT ABS |
| 5983 | JMP* OK00 |
| 5984 | OK20 LGL 8 |
| 5985 | STA T0OK |
| 5986 | LDA K123 PKF = - 1 |
| 5987 | STA PKF |
| 5988 | JMP* OK00 RETURN |
| 5989 | OK30 LDA PKF IF PKF = 0 |
| 5990 | SNZ |
| 5991 | JMP* OK00 RETURN |
| 5992 | LDA K8 ELSE (A) = SPACE, |
| 5993 | STA PKF |
| 5994 | JMP OK10 GO TO OK10 |
| 5995 | * |
| 5996 | * |
| 5997 | * *********** |
| 5998 | * *OUTPUT OA* |
| 5999 | * *********** |
| 6000 | * GENERAL OUTPUT ROUTINE. MAKES CHECKS AGAINST |
| 6001 | * THE ASSIGNMENT TABLE ENTRY TO PROCESS DUMMY, |
| 6002 | * EXTERNAL, RELATIVE, ABSOLUTE OR STRING |
| 6003 | * REFERENCES PROPERLY. |
| 6004 | T1OB PZE 0 |
| 6005 | OB00 DAC ** |
| 6006 | STA FTOP FTOP = (A) |
| 6007 | IAB |
| 6008 | STA T1OB |
| 6009 | JST STXA ESTABLISH A |
| 6010 | SNZ IF A = 0 |
| 6011 | JMP OB08 GO TO OB08 |
| 6012 | JST FA00 FETCH ASSIGNS |
| 6013 | LDA SOF SPECIAL OUTPUT FLAT |
| 6014 | SZE |
| 6015 | JMP OB60 SUBSCRIPT CONSTANT DEFLECTION |
| 6016 | LDA AF |
| 6017 | STA T1OB T0 = AF |
| 6018 | LDA AT |
| 6019 | SUB K105 IF AT = 'DUM' |
| 6020 | SNZ |
| 6021 | JMP OB15 GO TO OB15 |
| 6022 | LDA IU |
| 6023 | SUB K101 IF IU = 'SUB' |
| 6024 | SNZ |
| 6025 | JMP OB40 GO TO OB40 |
| 6026 | OB06 LDA AT |
| 6027 | CAS K104 IF AT = 'COM' |
| 6028 | JMP *+2 |
| 6029 | JMP OB20 GO TO OB20 |
| 6030 | CAS K101 |
| 6031 | JMP *+2 IF AT = 'REL' |
| 6032 | JMP OB10 GO TO OB10 |
| 6033 | LDA K103 |
| 6034 | IAB |
| 6035 | LDA RPL |
| 6036 | JST AF00 DEFINE AF AND AT |
| 6037 | LDA AT IF AT = 'STR-RE' |
| 6038 | SUB K103 |
| 6039 | SNZ |
| 6040 | JMP OB10 GO TO OB10 |
| 6041 | CRA |
| 6042 | STA AF AF = 0 |
| 6043 | OB08 LDA K102 |
| 6044 | STA DF SET FLAG TO OUTPUT SYMBOLIC |
| 6045 | LDA FTOP |
| 6046 | JST OA00 OUTPUT ABSOLUTE |
| 6047 | JMP* OB00 RETURN |
| 6048 | OB10 LDA T1OB |
| 6049 | STA AF |
| 6050 | LDA FTOP |
| 6051 | JST OR00 OUTPUT REL |
| 6052 | JMP* OB00 RETURN |
| 6053 | OB15 LDA FTOP |
| 6054 | CHS REVERSE INDIRECT BIT |
| 6055 | STA FTOP |
| 6056 | JMP OB10 GO TO OB10 |
| 6057 | OB20 JST FS00 OUTPUT COMMON REOUEST |
| 6058 | LDA T1OB PACK ADDRESS INTO BLOCK |
| 6059 | LRL 14 |
| 6060 | LDA FTOP |
| 6061 | LGR 10 |
| 6062 | ADD K150 |
| 6063 | LLL 6 |
| 6064 | STA OCI |
| 6065 | LLL 8 |
| 6066 | STA OCI+1 |
| 6067 | JST SAV |
| 6068 | JST FL00 |
| 6069 | LDA DP+2,1 |
| 6070 | STA PRI+13 SET COMMON NAME INTO PRINT BUFFER |
| 6071 | LLR 8 |
| 6072 | STA OCI+4 |
| 6073 | LLL 8 |
| 6074 | LDA DP+3,1 |
| 6075 | STA PRI+12 SET COMMON NAME INTO PRINT BUFFER |
| 6076 | LLR 8 |
| 6077 | STA OCI+3 |
| 6078 | LLL 8 |
| 6079 | LDA DP+4,1 |
| 6080 | ANA K111 ='037777 |
| 6081 | CAS *+1 LOOK FOR BLANK COMMON |
| 6082 | OCT 020240 |
| 6083 | ERA K122 |
| 6084 | ERA HBIT |
| 6085 | STA PRI+11 SET NAME INTO PRINT BUFFER |
| 6086 | LLR 8 |
| 6087 | STA OCI+2 |
| 6088 | LLL 8 |
| 6089 | LDA OCI+1 |
| 6090 | LLL 8 |
| 6091 | STA OCI+1 |
| 6092 | LDA K128 ='14 |
| 6093 | STA OCNT |
| 6094 | JST RST |
| 6095 | LDA 0 |
| 6096 | STA A RESTORE A TO POINT AT NAME |
| 6097 | LDA RPL SET RPL MINUS |
| 6098 | SSM TO DISABLE WORD OUTPUT |
| 6099 | STA RPL |
| 6100 | LDA FTOP OUTPUT WORD TO LIST |
| 6101 | JST OR00 SYMBOLIC COMMAND |
| 6102 | LDA RPL RESTORE AND |
| 6103 | SSP INCREMENT PROGRAM |
| 6104 | AOA COUNTER FOR COMMON |
| 6105 | STA RPL OUTPUT |
| 6106 | JST FS00 CLOSE OUT BLOCK |
| 6107 | JMP* OB00 EXIT |
| 6108 | OB30 LDA DP+4,1 |
| 6109 | SSM |
| 6110 | ALR 1 |
| 6111 | SSM |
| 6112 | ARR 1 |
| 6113 | STA NAMF |
| 6114 | LDA DP+3,1 |
| 6115 | STA NAMF+1 |
| 6116 | LDA DP+2,1 |
| 6117 | STA NAMF+2 |
| 6118 | JST CN00 |
| 6119 | JMP* OB00 |
| 6120 | OB40 LDA AT |
| 6121 | SUB K102 |
| 6122 | SNZ |
| 6123 | JMP OB30 |
| 6124 | JMP OB06 |
| 6125 | OB50 OCT 140000 |
| 6126 | * |
| 6127 | OB60 CRA |
| 6128 | STA SOF RESET SPECIAL OUTPUT FLAG |
| 6129 | LDA AT ADDRESS TYPE |
| 6130 | CAS K105 TEST FOR DUMMY |
| 6131 | JMP OB06 PROCESS NORMALLY |
| 6132 | JMP OB61 |
| 6133 | JMP OB06 PROCESS NORMALLY |
| 6134 | OB61 LDA T1OB |
| 6135 | STA FTOP |
| 6136 | CRA |
| 6137 | JMP OB08+1 |
| 6138 | * |
| 6139 | K150 OCT 700 |
| 6140 | * |
| 6141 | * |
| 6142 | * ************** |
| 6143 | * OUTPUT TRIADS* |
| 6144 | * ************** |
| 6145 | * PROCESSES THE TRIAD TABLE. HANDLES FETCH |
| 6146 | * GENERATION AND RELATIONAL OPERATOR CODE |
| 6147 | * GENERATION. DRIVES OUTPUT ITEM. ASSIGNS |
| 6148 | * AND OUTPUT TEMP STORES. |
| 6149 | T0OT PZE 0 |
| 6150 | T2OT PZE 0 |
| 6151 | T1OT PZE 0 |
| 6152 | T3OT PZE 0 TEMP STORE FOR P |
| 6153 | OT00 DAC ** |
| 6154 | JST SAV |
| 6155 | LDA L0 |
| 6156 | STA I I = L0 |
| 6157 | CRA |
| 6158 | STA T0OT T0 = 0 |
| 6159 | STA IFLG |
| 6160 | OT06 STA T1OT T1 = I |
| 6161 | OT10 LDA I |
| 6162 | SUB K103 I = I-3 |
| 6163 | STA I |
| 6164 | STA T2OT T2 = I |
| 6165 | SUB L |
| 6166 | SPL |
| 6167 | JMP OT60 IF FINISHED, GO TO OT60 |
| 6168 | JST STXI |
| 6169 | LDA DP+2,1 |
| 6170 | SSP CHECK P (I) |
| 6171 | CAS K139 X |
| 6172 | JMP *+2 |
| 6173 | JMP OT10 |
| 6174 | CAS K138 H |
| 6175 | JMP *+2 |
| 6176 | JMP OT10 |
| 6177 | CAS K142 I |
| 6178 | JMP *+2 |
| 6179 | JMP OT50 |
| 6180 | CAS K143 T |
| 6181 | JMP *+2 |
| 6182 | JMP OT40 |
| 6183 | CAS K151 Q |
| 6184 | JMP *+2 |
| 6185 | JMP OT35 |
| 6186 | STA T3OT SAVE P |
| 6187 | LDA DP+1,1 |
| 6188 | STA A A = O1(I) |
| 6189 | CAS T1OT |
| 6190 | JMP *+2 |
| 6191 | JMP OT30 |
| 6192 | CAS L0 |
| 6193 | JMP OT16 |
| 6194 | JMP OT99 MAYBE SPECIAL LOAD FOR (A=) STATEMENT |
| 6195 | JMP OT16 |
| 6196 | OT18 JST STXI |
| 6197 | LDA DP,1 |
| 6198 | STA A A = O2 (I) |
| 6199 | LDA DP+2,1 |
| 6200 | SSP |
| 6201 | JST OM00 OUTPUT ITEM(P(I),A = 02(I)) |
| 6202 | OT22 JST STXI |
| 6203 | LDA DP+2,1 |
| 6204 | SMI |
| 6205 | JMP OT28 |
| 6206 | CRA ASSIGN TEMP STOR |
| 6207 | STA NT NT = 0 |
| 6208 | LDA K102 |
| 6209 | STA IU IU = VAR |
| 6210 | LDA T0OT |
| 6211 | LRL 6 |
| 6212 | LDA TCF ID = |
| 6213 | LRL 3 TS-IM-TCF-T0 |
| 6214 | LDA MFL |
| 6215 | STA IM |
| 6216 | LLL 9 |
| 6217 | JST OR80 |
| 6218 | DAC ID |
| 6219 | LDA K77 |
| 6220 | STA ID |
| 6221 | IRS T0OT T0 = T0+1 |
| 6222 | JST AS00 ASSIGN ITEM |
| 6223 | JST STXI |
| 6224 | LDA A |
| 6225 | STA DP,1 O2(I) = A |
| 6226 | LDA K153 |
| 6227 | SSM SURPRESS TRACE OF TEMPORARY STORAGE |
| 6228 | JST OM00 OUTPUT ITEM (=,A) |
| 6229 | OT28 LDA I |
| 6230 | JMP OT06 |
| 6231 | OT30 JST STXA |
| 6232 | LDA DP+2,1 |
| 6233 | SSP IF P (A) = 0 |
| 6234 | SZE |
| 6235 | JMP OT32 |
| 6236 | OT16 LDA K152 GENERATE FETCH |
| 6237 | JST OM00 OUTPUT ITEM |
| 6238 | OT32 LDA T3OT CHECK FOR RELATIONALS |
| 6239 | SUB K125 ='10 |
| 6240 | SPL |
| 6241 | JMP OT18 NOT LOGICAL OR6RATOR |
| 6242 | SUB K106 =6 |
| 6243 | SMI |
| 6244 | JMP OT18 NOT A LOGICAL QPERATOR |
| 6245 | STA 0 SET INDEX = -1 TO -6 |
| 6246 | LDA K103 =3 (LOG) |
| 6247 | STA MFL SET MODE TO LOGICAL |
| 6248 | CRA |
| 6249 | STA A SET FOR OCTAL ADDRESS |
| 6250 | JMP *+7,1 BRANCH TO OPERATOR PROCESSOR |
| 6251 | JMP OT3G .LT. |
| 6252 | JMP OT3E .LE. |
| 6253 | JMP OT3C .EQ. |
| 6254 | JMP OT3B .GE. |
| 6255 | JMP OT3A .GT. |
| 6256 | LDA OMJ4 .NE. =ALS 16 |
| 6257 | JST OA00 OUTPUT ABSOLUTE |
| 6258 | LDA OMJ6 =ACA |
| 6259 | JMP OT3D |
| 6260 | OT3A LDA OMJ7 =TCA |
| 6261 | JMP OT3F |
| 6262 | OT3B LDA OMK1 =CMA |
| 6263 | JMP OT3F |
| 6264 | OT3C LDA OMJ4 = ALS 16 |
| 6265 | JST OA00 |
| 6266 | LDA OMK2 =SSC |
| 6267 | JST OA00 OUTPUT ABSOLUTE |
| 6268 | LDA OMK3 =AOA |
| 6269 | OT3D JST OA00 OUTPUT ABSOLUTE |
| 6270 | JMP OT22 |
| 6271 | OT3E LDA OMJ2 =SNZ |
| 6272 | JST OA00 OUTPUT ABSOLUTE |
| 6273 | LDA OMK4 =SSM |
| 6274 | OT3F JST OA00 OUTPUT ABSOLUTE |
| 6275 | OT3G LDA OMJ5 =LGR 15 |
| 6276 | JMP OT3D |
| 6277 | * |
| 6278 | OT35 LDA DP+1,1 |
| 6279 | STA ID |
| 6280 | JST NF00 |
| 6281 | LDA K78 NAMF = F $AR |
| 6282 | STA NAMF+1 |
| 6283 | JST OL00 OUTPUT OBJECT LINK |
| 6284 | JMP OT18 GO TO OT18 |
| 6285 | OT40 LDA DP,1 |
| 6286 | ADD DO |
| 6287 | STA I I = O2 (I) + DO |
| 6288 | JST DQ00 DO TERMINATION |
| 6289 | OT45 LDA T2OT |
| 6290 | STA I I = T2 |
| 6291 | JMP OT28 |
| 6292 | OT50 LDA DP,1 |
| 6293 | ADD DO I=O2(I)+DO |
| 6294 | STA I IF I = DO |
| 6295 | SUB DO |
| 6296 | SZE GO TO OT45 |
| 6297 | JST DS00 DO INITIALIZE |
| 6298 | JMP OT45 GO TO OT45 |
| 6299 | OT60 JST RST |
| 6300 | LDA L0 RESET TRIAD TABLE |
| 6301 | STA L |
| 6302 | JMP* OT00 |
| 6303 | * |
| 6304 | OT99 LDA T3OT |
| 6305 | SUB K153 CODE FOR = |
| 6306 | SZE |
| 6307 | JMP OT16 NOT SPECIAL LOAD |
| 6308 | STA MFL SPECIAL LOAD, SET MFL=0 |
| 6309 | JMP OT18 OUTPUT A STORE |
| 6310 | K77 BCI 1,T$ T$ |
| 6311 | K78 BCI 1,AR AR |
| 6312 | K142 OCT 27 |
| 6313 | K143 OCT 30 |
| 6314 | K151 OCT 32 |
| 6315 | K152 OCT 31 |
| 6316 | * ************* |
| 6317 | * *OUTPUT ITEM* |
| 6318 | * ************* |
| 6319 | * |
| 6320 | * DRIVES BASIC OUTPUT ROUTINES. HANDLES SPECIAL |
| 6321 | * SUBSCRIPT PROCESSING, GENERATES NECESSARY |
| 6322 | * MODE CONVERSION CALLS AND HANDLES MODE |
| 6323 | * CHECKING. IN-LINE ARITHMETIC CODE IS |
| 6324 | * GENERATED WHERE POSSIBLE. OTHERWISE CALLS |
| 6325 | * TO ARITHMETIC ROUTINES ARE GENERATED. |
| 6326 | * |
| 6327 | T0OM PZE 0 |
| 6328 | T1OM PZE 0 |
| 6329 | T2OM PZE 0 |
| 6330 | T8OM PZE 0 |
| 6331 | T9OM PZE 0 |
| 6332 | TXOM PZE 0 |
| 6333 | * |
| 6334 | *-------------OUTPUT ITEM |
| 6335 | OM00 DAC ** RETURN ADDR |
| 6336 | STA T8OM |
| 6337 | SSP |
| 6338 | STA T0OM R(0)=(A)='P' CODE |
| 6339 | CAS K134 |
| 6340 | JMP *+2 |
| 6341 | JMP OMD1 |
| 6342 | LDA TXOM |
| 6343 | CAS K101 |
| 6344 | JMP OME1 |
| 6345 | JMP OME5 |
| 6346 | OM05 CRA |
| 6347 | STA T1OM T(1)=0 |
| 6348 | STA T9OM T(9)=0 |
| 6349 | LDA A |
| 6350 | STA T2OM T(2)=A |
| 6351 | SZE |
| 6352 | JMP OM07 |
| 6353 | LDA MFL |
| 6354 | JMP OM13 |
| 6355 | OM07 CAS L0 |
| 6356 | JMP *+2 |
| 6357 | JMP OML1 |
| 6358 | CAS ABAR |
| 6359 | JMP OM76 A .LE. ABAR....WITHIN TRIAD TABLE |
| 6360 | JMP *+1 |
| 6361 | OM10 JST STXA SET INDEX=A |
| 6362 | LDA DP,1 |
| 6363 | ARS 9 SES IM=MODE OF ITEM |
| 6364 | ANA K107 |
| 6365 | OM13 STA IM |
| 6366 | OM14 LDA MFL SET MFL,IM AS DIGITS INTO NAMF |
| 6367 | ALS 8 |
| 6368 | ADD IM |
| 6369 | ERA OM90 ADD '0''0' |
| 6370 | STA NAMF+1 |
| 6371 | LDA K130 |
| 6372 | STA 0 INDEX=-6 |
| 6373 | LDA T0OM |
| 6374 | CAS OM50+6,1 CHECK FOR SPECIAL OPERATOR |
| 6375 | JMP *+2 '1 |
| 6376 | JMP* OM52+6,1 'P'='Q',',','0','A'F', OR 'E' |
| 6377 | IRS 0 |
| 6378 | JMP *-4 |
| 6379 | LDA MFL |
| 6380 | SNZ |
| 6381 | JMP OM62 SPECIAL LIBRARY FIX FOR ( A= ) |
| 6382 | CAS IM CHECK FOR MODE MIXING |
| 6383 | JMP *+2 |
| 6384 | JMP OMA1 ITEM MODE SAME AS CURRENT MODE |
| 6385 | OM20 LDA K103 |
| 6386 | JST OM44 CHECK MODE FOR LOG |
| 6387 | LDA K102 =2 (MODE CODE FOR REAL) |
| 6388 | CAS MFL MODE OF EXPRESSION |
| 6389 | JMP *+2 |
| 6390 | JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING |
| 6391 | CAS IM MODE OF ITEM |
| 6392 | JMP *+2 |
| 6393 | JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING |
| 6394 | LDA K105 |
| 6395 | JST OM44 TEST FOR MODE= COMPLEX |
| 6396 | OM26 LDA T0OM OPERATOR BEING PROCESSED |
| 6397 | CAS K153 |
| 6398 | JMP *+2 |
| 6399 | JMP OM36 T(0)='=' (ALLOW INTEGER MODE) |
| 6400 | LDA K101 |
| 6401 | JST OM44 TEST FOR MODE=INTEGER |
| 6402 | LDA IM |
| 6403 | CAS MFL |
| 6404 | JMP OM38 CONVERT MODE OF ACCUMULATOR |
| 6405 | JMP *+1 |
| 6406 | OM30 JST NF00 SET LBUF+2 TO SPACES |
| 6407 | LDA T0OM |
| 6408 | STA 0 |
| 6409 | LDA A9X4,1 PICK-UP PRINT CODE FOR 'P' OPERATOR |
| 6410 | ARS 6 |
| 6411 | ANA K100 ='377 |
| 6412 | SNZ |
| 6413 | JMP OM46 MODE MIXING ERROR |
| 6414 | LGL 8 |
| 6415 | ERA OM91 ADD '$' |
| 6416 | STA NAMF |
| 6417 | LDA K134 |
| 6418 | STA T0OM T(0)=',' |
| 6419 | JMP OM40 |
| 6420 | * |
| 6421 | OM36 LDA K105 |
| 6422 | JST OM44 CHECK FOR MODE=COMPLEX |
| 6423 | OM38 LDA IM |
| 6424 | STA MFL |
| 6425 | JST NF00 SET LBUF+2 TO SPACES |
| 6426 | LDA OM92 'C$' |
| 6427 | STA NAMF |
| 6428 | OM40 JST CN00 OUTPUT....CALL NAMF |
| 6429 | LDA MFL |
| 6430 | STA IM SET ITEM MODE TO CURRENT MODE |
| 6431 | LDA NAMF |
| 6432 | CAS OM96 |
| 6433 | JMP OM14 |
| 6434 | JMP* OM00 |
| 6435 | JMP OM14 OUTPUT ARGUMENT ADDRESS |
| 6436 | * |
| 6437 | *-----SUBROUTINE TO CHECK FOR ILLEGAL IM OR MFL MODES. |
| 6438 | OM44 DAC ** RETURN ADDR. |
| 6439 | CAS IM CHECK FOR IM0(A) |
| 6440 | JMP *+2 |
| 6441 | JMP OM46 ERROR |
| 6442 | CAS MFL CHECK FOR MFL=(A) |
| 6443 | JMP* OM44 |
| 6444 | JMP OM46 ERROR |
| 6445 | JMP* OM44 |
| 6446 | OM46 JST ER00 NON-RECOVERABLE ERROR...... |
| 6447 | BCI 1,MM MODE MIXING ERROR |
| 6448 | * |
| 6449 | *------SPECIAL 'P' OPERATOR TABLE |
| 6450 | OM50 OCT 32 'Q' |
| 6451 | OCT 17 ',' |
| 6452 | OCT 00 '0' |
| 6453 | OCT 22 'A' |
| 6454 | OCT 31 *F' |
| 6455 | OCT 20 'E' |
| 6456 | OM52 DAC OMB3 ('Q') |
| 6457 | DAC OMB3 (',') |
| 6458 | DAC OMB3 ('0') |
| 6459 | DAC OM56 ('A') |
| 6460 | DAC OM60 ('F') |
| 6461 | DAC OM70 ('E') |
| 6462 | * |
| 6463 | * |
| 6464 | OM56 LDA OMI1 SET T(1) = ADD* |
| 6465 | JMP OMB1 |
| 6466 | * |
| 6467 | OM60 JST STXA SET INDEX = A |
| 6468 | LDA DP+1,1 |
| 6469 | LGR 14 SET UV=IU(A) |
| 6470 | STA IU |
| 6471 | JST STXI SET INDEX=I |
| 6472 | LDA DP+2,1 P(I) |
| 6473 | ANA K133 ='77 |
| 6474 | SNZ |
| 6475 | JMP OM64 (POSSIBLE DUMMY ARRAY FETCH) |
| 6476 | OM62 LDA IM |
| 6477 | STA MFL SET CURRENT MODE TO ITEM MODE |
| 6478 | LGL 8 |
| 6479 | ADD IM |
| 6480 | ERA OM90 |
| 6481 | STA NAMF+1 |
| 6482 | LDA IU |
| 6483 | SUB K101 CHECK FOR IU=1 (SUBROUTINE) |
| 6484 | SZE |
| 6485 | JMP OMA1 |
| 6486 | LDA OMI2 SET T(1) = JST |
| 6487 | JMP OM66 |
| 6488 | OM64 LDA IU |
| 6489 | SUB K103 CHECK FOR IV=3 (ARRAY) |
| 6490 | SZE |
| 6491 | JMP OM62 |
| 6492 | LDA K101 SET CURRENT MODE TO INTEGER |
| 6493 | STA MFL |
| 6494 | LDA OMI3 SET T(1) = LDA* |
| 6495 | OM66 STA T1OM |
| 6496 | JMP OMB3 |
| 6497 | * |
| 6498 | OM70 LDA K101 |
| 6499 | CAS IM CHECK ITEM MODE EQUALS INTEGER |
| 6500 | JMP *+2 |
| 6501 | JMP OM74 |
| 6502 | LDA K105 CHECK FOR MODE = COMPLEX |
| 6503 | JST OM44 |
| 6504 | JMP OM20 |
| 6505 | OM74 LDA K103 CHECK FOR MODE = LOGICAL |
| 6506 | JST OM44 |
| 6507 | JMP OM30 OUTPUT SUBROUTINE CALL |
| 6508 | * |
| 6509 | OM76 JST STXA INDEX=A |
| 6510 | LDA DP,1 O2(A) |
| 6511 | STA T2OM T(2)=O2(A) |
| 6512 | LDA DP+2,1 P(A) |
| 6513 | ANA K133 ='77 |
| 6514 | SNZ |
| 6515 | JMP OM84 P(A)='0' (SUBSCRIPTED VARIABLE) |
| 6516 | CAS K139 |
| 6517 | JMP *+2 |
| 6518 | JMP OM80 P(A) = 'X' (END OF ARRAY CALCULATION) |
| 6519 | CAS K138 |
| 6520 | JMP *+2 |
| 6521 | JMP OMHW P(4)= 'H' (HOLLERITH DATA) |
| 6522 | OM78 LDA T2OM |
| 6523 | STA A RESET A |
| 6524 | JMP OM10 |
| 6525 | * |
| 6526 | OM80 JST STXI INDEX=I |
| 6527 | LDA T2OM |
| 6528 | STA DP+1,1 O1(I) = T(2) |
| 6529 | CRA |
| 6530 | STA T1OT SET T(1) OF OUTPUT TRIADS TO ZERO |
| 6531 | LDA A SAVE A |
| 6532 | STA T1OM |
| 6533 | CRA SET A=0 (NOT SYMBOLIC) |
| 6534 | STA A |
| 6535 | LDA RPL |
| 6536 | ADD K102 AF=RPL+2 |
| 6537 | STA AF |
| 6538 | LDA OMI4 =ADD INSTRUCTION |
| 6539 | JST OR00 OUTPUT RELATIVE |
| 6540 | LDA RPL |
| 6541 | ADD K102 AF = RPL P+ 2 |
| 6542 | STA AF |
| 6543 | LDA OMI5 = JMP INSTR. |
| 6544 | JST OR00 OUTPUT RELATIVE |
| 6545 | LDA T1OM |
| 6546 | STA A RESTORE A |
| 6547 | STA SOF SET SPECIAL OUTPUT FLAG TO NON-ZERO |
| 6548 | CRA = DAC INSTR. |
| 6549 | STA T1OM |
| 6550 | LDA K101 |
| 6551 | STA AT |
| 6552 | JMP OM88 |
| 6553 | OM84 LDA DP+1,1 O1(A) |
| 6554 | STA A A=O1(A) |
| 6555 | CAS L0 |
| 6556 | JMP *+2 |
| 6557 | JMP OM86 A=L(0)....CONSTANT SUBSCRIPT ONLY |
| 6558 | LDA OMI0 T(1) = INDIRECT BIT |
| 6559 | STA T1OM |
| 6560 | JMP OM10 |
| 6561 | * |
| 6562 | OM86 LDA T2OM A=T(2) |
| 6563 | STA A |
| 6564 | STA 0 |
| 6565 | STA SOF |
| 6566 | LDA DP,1 T(2) = O2(A) |
| 6567 | STA T2OM |
| 6568 | OM88 JST STXA INDEX=A |
| 6569 | LDA DP+1,1 O1(A) |
| 6570 | STA T9OM T(9)=O1(A) |
| 6571 | JMP OM78 |
| 6572 | OMHW LDA T2OM |
| 6573 | STA AF |
| 6574 | CRA |
| 6575 | STA A |
| 6576 | JST OR00 |
| 6577 | JMP* OM00 |
| 6578 | * |
| 6579 | OM90 OCT 130260 '00' |
| 6580 | OM91 OCT 000244 ' $' |
| 6581 | OM92 OCT 141644 'C$' |
| 6582 | OM93 OCT 152322 'TR' |
| 6583 | OM94 OCT 000021 'C' CODE |
| 6584 | OM95 OCT 017777 (MASK) |
| 6585 | OM96 BCI 1,N$ |
| 6586 | OM97 BCI 1,-1 |
| 6587 | * |
| 6588 | OMA1 LDA IM CHECK FOR IM=LOGICAL |
| 6589 | CAS K103 |
| 6590 | JMP *+2 |
| 6591 | JMP OMC1 IM=LOGICAL |
| 6592 | CAS K101 CHECK FOR IM=INTEGER |
| 6593 | JMP *+2 |
| 6594 | JMP OMA3 IM=INTEGER |
| 6595 | JMP OM30 |
| 6596 | * |
| 6597 | OMA3 LDA T0OM CHECK FOR T,0) = '+' |
| 6598 | CAS K103 =3 |
| 6599 | JMP *+2 |
| 6600 | JMP OMA4 T(0)= '*' |
| 6601 | CAS OM94 T(0) = 'C |
| 6602 | JMP *+2 |
| 6603 | JMP OMA6 OUTPUT 'TCA' |
| 6604 | CAS K101 |
| 6605 | JMP OMA5 |
| 6606 | LDA OMI4 =ADD INSTR. |
| 6607 | JMP OMB1 |
| 6608 | OMA4 LDA T2OM VALUE OF A |
| 6609 | SUB K126 ='12 KNOWN LOCATION OF A FOR 2 |
| 6610 | SZE SKIP IF MULTIPLIER IS A CONSTANT OF 2 |
| 6611 | JMP OM30 COUPLE TO THE MULTIPLY SUBROUTINE |
| 6612 | STA A SET A AND AF TO ZERO (FOR LISTING FLAGS) |
| 6613 | STA AF |
| 6614 | LDA *+3 ALS 1 INSTRUCTION |
| 6615 | JST OA00 OUTPUT ABSOLUTE |
| 6616 | JMP* OM00 EXIT UUTPUT ITEM |
| 6617 | ALS 1 (INSTRUCTION TO BE OUTPUT) |
| 6618 | OMA5 CAS K102 CHECK FOR T(0) = '-' |
| 6619 | JMP OMA7 |
| 6620 | LDA OMI6 =SUB INSTR. |
| 6621 | JMP OMB1 |
| 6622 | OMA6 CRA |
| 6623 | STA A CAUSE OCTAL ADDR LISTING |
| 6624 | STA AF |
| 6625 | LDA *+3 TCA |
| 6626 | JST OA00 OUTPUT ABSOLUTE |
| 6627 | JMP* OM00 EXIT |
| 6628 | TCA |
| 6629 | OMA7 CAS K153 CHECK FOR T(0) = '=' |
| 6630 | JMP *+2 |
| 6631 | JMP OMA9 OUTPUT A STA INSTR. |
| 6632 | SUB K152 CHECK FOR T(0) = 'F' |
| 6633 | SZE |
| 6634 | JMP OM30 |
| 6635 | OMA8 LDA OMI7 =LDA INSTR. |
| 6636 | JMP OMB1 |
| 6637 | OMA9 LDA OMI8 =STA INSTR. |
| 6638 | OMB1 ADD T1OM T(1) = T(1) + INSTR. |
| 6639 | STA T1OM |
| 6640 | OMB3 LDA T2OM SET A=T(2) |
| 6641 | STA A |
| 6642 | LDA T9OM OUTPUT INSTR. WITH T(1) AND T(9) |
| 6643 | IAB |
| 6644 | LDA T1OM |
| 6645 | JST OB00 OUTPUT OA |
| 6646 | LDA T8OM CHECK FOR T(8) = '=' |
| 6647 | CAS K153 ='16 |
| 6648 | JMP* OM00 |
| 6649 | JMP *+2 |
| 6650 | JMP* OM00 EXIT |
| 6651 | LDA TRFA POINTER TO FIRST VARIABLE OR ARRAY |
| 6652 | STA A PROCESSED IN EXPRESSION |
| 6653 | JST TRSE OUTPUT TRACE COUPLING IF REQUIRED |
| 6654 | JMP* OM00 EXIT OUTPUT ITEM |
| 6655 | * |
| 6656 | * |
| 6657 | OMC1 LDA T0OM |
| 6658 | CAS K152 CHECK FOR T(0) = 'F' |
| 6659 | JMP *+2 |
| 6660 | JMP OMA8 OUTPUT A LDA INSTR. |
| 6661 | CAS K153 CHECK FOR T(0) = '=' |
| 6662 | JMP *+2 |
| 6663 | JMP OMA9 OUTPUT A STA INSTR. |
| 6664 | CAS OM94 CHECK FOR T(0) = 'C' |
| 6665 | JMP *+2 |
| 6666 | JMP OM30 OUTPUT COMPLEMENT CODING |
| 6667 | CAS K106 |
| 6668 | JMP *+2 |
| 6669 | JMP OMC5 OUTPUT AN ANA INSTR. |
| 6670 | CAS K107 |
| 6671 | JMP OM46 ERROR |
| 6672 | JMP OM30 |
| 6673 | JMP OM46 ERR0R |
| 6674 | OMC5 LDA OMI9 =ANA INSTR. |
| 6675 | JMP OMB1 |
| 6676 | OMD1 IRS TXOM T0 = T0+1 |
| 6677 | JMP OM05 |
| 6678 | OME1 CRA |
| 6679 | STA DF DF = 0 |
| 6680 | JST OA00 OUTPUT ABSOLUTE |
| 6681 | OME5 CRA |
| 6682 | STA TXOM T0 = 0 |
| 6683 | JMP OM05 |
| 6684 | * |
| 6685 | TRSE DAC 0 SUBROUTINE TO OUTPUT TRACE COUPLING |
| 6686 | JST STXA SET INDEX = A |
| 6687 | SZE |
| 6688 | LDA DP+4,1 CHECK STATUS OF TRACE TAG |
| 6689 | SPL |
| 6690 | JMP TRS7 |
| 6691 | SR4 |
| 6692 | JMP TRS7 |
| 6693 | LDA TRF CHECK STATUS OF TRACE FLAG |
| 6694 | SNZ |
| 6695 | JMP* TRSE |
| 6696 | TRS7 JST NF00 SET LBUF TO 'F$', LSUF+2 TO SPACES |
| 6697 | LDA OM93 ='TR' |
| 6698 | STA NAMF+1 |
| 6699 | JST CN00 OUTPUT.....CALL NAMF |
| 6700 | JST STXA SET INDEX = A |
| 6701 | LDA DP+4,1 |
| 6702 | ANA OM95 |
| 6703 | STA T1OM |
| 6704 | LDA DP+3,1 |
| 6705 | STA T8OM |
| 6706 | LDA DP+2,1 |
| 6707 | STA T9OM |
| 6708 | CRA |
| 6709 | STA DF |
| 6710 | LDA DP,1 MERGE IM WITH ITEM NAME |
| 6711 | ARS 9 |
| 6712 | LGL 13 |
| 6713 | ERA T1OM |
| 6714 | JST OA00 OUTPUT ABSOLUTE (FIRST 2 CHAR.) |
| 6715 | LDA T8OM |
| 6716 | JST OA00 OUTPUT ABSOLUTE (NEXT 2 CHAR.) |
| 6717 | LDA T9OM |
| 6718 | JST OA00 OUTPUT ABSOLUTE (LAST 2 CHAR.) |
| 6719 | JMP* TRSE |
| 6720 | * |
| 6721 | *.................INSTRUCTION TABLE |
| 6722 | OMI0 OCT 100000 INDIRECT BIT |
| 6723 | OMI1 OCT 114000 ADD* |
| 6724 | OMI2 OCT 020000 JST |
| 6725 | OMI3 OCT 104000 LDA* |
| 6726 | OMI4 OCT 014000 ADD |
| 6727 | OMI5 OCT 002000 JMP |
| 6728 | OMI6 OCT 016000 SUB |
| 6729 | OMI7 OCT 004000 LDA |
| 6730 | OMI8 OCT 010000 STA |
| 6731 | OMI9 OCT 006000 ANA |
| 6732 | OMJ1 OCT 102000 JMP* |
| 6733 | OMJ2 OCT 101040 SNZ |
| 6734 | OMJ3 OCT 101400 SMI |
| 6735 | OMJ4 ALS 16 |
| 6736 | OMJ5 OCT 040461 LGR 15 |
| 6737 | OMJ6 OCT 141216 ACA |
| 6738 | OMJ7 OCT 140407 TCA |
| 6739 | OMK1 OCT 140401 CMA |
| 6740 | OMK2 OCT 101001 SSC |
| 6741 | OMK3 OCT 141206 AOA |
| 6742 | OMK4 OCT 140500 SSM |
| 6743 | OMK5 OCT 042000 JMP 0,1 |
| 6744 | OMK6 OCT 000000 DAC ** |
| 6745 | ALS 1 ALS1 |
| 6746 | TCA TCA |
| 6747 | OMK7 OCT 176000 STG |
| 6748 | OMK9 CAS 0 CAS |
| 6749 | STA* 0 |
| 6750 | SUB* 0 |
| 6751 | DAC* ** |
| 6752 | OCT 131001 |
| 6753 | OCT 030000 SUBR |
| 6754 | CAS* 0 |
| 6755 | OMK8 OCT 0 (///) |
| 6756 | OML1 LDA K101 |
| 6757 | STA AT |
| 6758 | JMP OT10 |
| 6759 | * |
| 6760 | * ************ |
| 6761 | * *OUTPUT REL* |
| 6762 | * ************ |
| 6763 | * ALSO DRIVES SYMBOLIC INSTRUCTION OUTPUT. |
| 6764 | OR00 DAC ** |
| 6765 | STA FTOP |
| 6766 | LDA K102 DF = NON ZER0 |
| 6767 | STA DF CODE = 2 |
| 6768 | OR10 STA CODE |
| 6769 | LDA RPL LIST RPL |
| 6770 | SSP |
| 6771 | JST OR80 |
| 6772 | DAC PRI |
| 6773 | OR12 LDA DF IF DF NOT ZERO |
| 6774 | SZE |
| 6775 | JMP OR20 GO TO OR20 |
| 6776 | LDA OR18 ='147703 |
| 6777 | STA PRI+5 |
| 6778 | LDA OR19 SET 'OCT' INTO PRINT IMAGE |
| 6779 | STA PRI+6 |
| 6780 | LDA FTOP |
| 6781 | OR13 JST OR80 |
| 6782 | DAC PRI+8 |
| 6783 | OR15 LDA RPL IF RPL PLUS |
| 6784 | SMI |
| 6785 | JST OW00 OUTPUT WORD |
| 6786 | SR2 |
| 6787 | JMP *+3 SURPRESS SYMBOLIC OUTPUT |
| 6788 | CALL F4$SYM LIST LINE |
| 6789 | DAC PRI |
| 6790 | JST PRSP SET PRINT BUFFER TO SPACES |
| 6791 | JMP* OR00 RETURN |
| 6792 | OR18 OCT 147703 (O)(C) |
| 6793 | OR19 OCT 152240 (T)(SP) |
| 6794 | OR20 JST SAV |
| 6795 | LDA OR90 SEARCH OP-CODE LIST |
| 6796 | TCA |
| 6797 | STA XR PUT BCI IN PRINT IMAGE |
| 6798 | LDA FTOP |
| 6799 | SSP |
| 6800 | SZE |
| 6801 | JMP OR24 |
| 6802 | LDA AT |
| 6803 | CAS K103 |
| 6804 | SUB K106 |
| 6805 | ADD K102 |
| 6806 | CMA |
| 6807 | ANA K107 |
| 6808 | STA CODE |
| 6809 | OR24 LDA FTOP |
| 6810 | CAS OR91+NINS,1 |
| 6811 | JMP *+2 |
| 6812 | JMP *+3 |
| 6813 | IRS XR |
| 6814 | JMP *-4 |
| 6815 | LDA OR92+NINS,1 |
| 6816 | STA PRI+5 |
| 6817 | LDA OR93+NINS,1 |
| 6818 | STA PRI+6 |
| 6819 | JST RST |
| 6820 | LDA A |
| 6821 | SZE |
| 6822 | JMP OR30 |
| 6823 | LDA AF |
| 6824 | ANA K111 MASK OUT HIGH BITS OF ADDRESS |
| 6825 | JMP OR13 |
| 6826 | OR30 JST STXA |
| 6827 | LDA DP,1 |
| 6828 | SMI |
| 6829 | JMP OR40 |
| 6830 | LDA K149 |
| 6831 | STA PRI+8 SET =' INTO LISTING |
| 6832 | LDA DP,1 CHECK IM (A) |
| 6833 | LGL 4 |
| 6834 | SPL SKIP IF NOT COMPLEX |
| 6835 | JMP *+4 |
| 6836 | LGL 2 |
| 6837 | SPL SKIP IF INTEGER OR LOGICAL |
| 6838 | JMP *+3 |
| 6839 | LDA DP+2,1 |
| 6840 | JMP *+2 LIST EXPONENT AND PART OF FRACTION |
| 6841 | LDA DP+4,1 LIST INTEGER VALUE |
| 6842 | JST OR80 CONVERT OCTAL |
| 6843 | DAC PRI+9 |
| 6844 | JMP OR15 |
| 6845 | OR40 LDA DP+4,1 CONVERT AND PACK INTO |
| 6846 | ALR 1 |
| 6847 | SSM SYMBOLIC IMAGE |
| 6848 | ARR 1 |
| 6849 | SSM |
| 6850 | STA PRI+8 |
| 6851 | LDA DP+3,1 |
| 6852 | STA PRI+9 |
| 6853 | LDA DP+2,1 |
| 6854 | STA PRI+10 |
| 6855 | JMP OR15 |
| 6856 | * *********** |
| 6857 | * *OUTPUT ABS* |
| 6858 | * *********** |
| 6859 | OA00 DAC ** |
| 6860 | STA FTOP |
| 6861 | LDA OA00 |
| 6862 | STA OR00 |
| 6863 | CRA |
| 6864 | JMP OR10 |
| 6865 | * ******************* |
| 6866 | * *OUTPUT STRING-RPL* |
| 6867 | * ******************* |
| 6868 | OS00 DAC 00 |
| 6869 | STA AF |
| 6870 | LDA OMK7 |
| 6871 | STA FTOP |
| 6872 | LDA OS00 |
| 6873 | STA OR00 SET RETURN INTO OUTPUT REL |
| 6874 | LDA K104 |
| 6875 | STA CODE |
| 6876 | STA STFL STRING FLAG = NON ZERO |
| 6877 | JST PRSP SET PRINT BUF. TO SPACES |
| 6878 | JMP OR20 JMP-OUTPUT REL FOR SYMBOLIC AND BINARY |
| 6879 | OR80 DAC ** |
| 6880 | IAB |
| 6881 | LDA* OR80 |
| 6882 | STA OR89 |
| 6883 | CRA |
| 6884 | LRR 2 |
| 6885 | IRS OR80 |
| 6886 | JST OR85 |
| 6887 | JST OR85 |
| 6888 | JST OR85 |
| 6889 | JMP* OR80 |
| 6890 | OR85 DAC ** |
| 6891 | ADD K140 |
| 6892 | LLR 3 |
| 6893 | LGL 5 |
| 6894 | ADD K140 |
| 6895 | LLL 3 |
| 6896 | STA* OR89 |
| 6897 | IRS OR89 |
| 6898 | CRA |
| 6899 | JMP* OR85 |
| 6900 | OR89 PZE 0 |
| 6901 | OR90 DAC NINS |
| 6902 | K200 EQU OMI7 |
| 6903 | K201 EQU OMI5 |
| 6904 | K202 EQU OMI8 |
| 6905 | K203 EQU OMI4 |
| 6906 | K204 EQU OMI6 |
| 6907 | K205 EQU OMJ3 |
| 6908 | K206 EQU OMJ1 |
| 6909 | K207 EQU OMK5 |
| 6910 | OR91 EQU OMI1 |
| 6911 | OR92 BCI 22,ADJSLDADJMSULDSTANJMSNSMLLLRACTCCMSSAOSSJMDA |
| 6912 | BCI 2,ALTC |
| 6913 | BCI 9,STCASTSUDAERSUCA// |
| 6914 | OR93 BCI 22,D*T A*D P B A A A P*Z I 1515A A A C A M PXC |
| 6915 | BCI 2,S1A |
| 6916 | BCI 9,G S A*B*C*R/BRS*/ |
| 6917 | NINS EQU 32 |
| 6918 | * |
| 6919 | PRSP DAC ** SUBR. T0 SET PRINT BUF. T0 SPACES |
| 6920 | LDA PRSK =-40 |
| 6921 | STA 0 |
| 6922 | LDA KASP (SP)(SP) |
| 6923 | STA PRI+40,1 |
| 6924 | IRS 0 |
| 6925 | JMP *-2 |
| 6926 | JMP* PRSP EXIT |
| 6927 | PRSK OCT 177730 =-40 |
| 6928 | * |
| 6929 | * ************************************* |
| 6930 | * *OUTPUT SUBROUTINE/COMMON BLOCK NAME* |
| 6931 | * ************************************ |
| 6932 | * OUTPUT AN EXTERNAL REFERENCE NAME. |
| 6933 | * |
| 6934 | ON00 DAC ** |
| 6935 | STA ONT1 SAVE ADDRESS |
| 6936 | JST FS00 FLUSH BUFFER IF NECESSARY |
| 6937 | JST STXA SET INDEX=A |
| 6938 | LDA ONT1 SUBR. ENTRY ADDR. |
| 6939 | LRL 14 |
| 6940 | STA ONT1 SAVE S/C BITS |
| 6941 | LDA ON02 ='600 (=BLOCK CODE NO.) |
| 6942 | LLL 6 |
| 6943 | STA OCI FILL BUFFER |
| 6944 | LRL 8 |
| 6945 | JST STXA SET INDEX=A |
| 6946 | LDA DP+4,1 FIRST 2 CHAR. 0F NAME |
| 6947 | ANA K111 ='037777 |
| 6948 | CAS *+1 |
| 6949 | OCT 020240 |
| 6950 | ERA K122 |
| 6951 | ERA HBIT ='140000 |
| 6952 | LRR 8 |
| 6953 | STA OCI+1 BUFFER |
| 6954 | LRL 8 |
| 6955 | LDA DP+3,1 SECOND 2 CHAR. OF NAME |
| 6956 | LRR 8 |
| 6957 | STA OCI+2 BUFFER |
| 6958 | LRL 8 |
| 6959 | LDA DP+2,1 LAST 2 CHAR. OF NAME |
| 6960 | LRR B |
| 6961 | STA OCI+3 BUFFER |
| 6962 | LLL 8 |
| 6963 | LGL 2 |
| 6964 | ADD ONT1 S/C BITS |
| 6965 | LGL 6 |
| 6966 | STA OCI+4 BUFFER |
| 6967 | CRA SET SIZE = 0 |
| 6968 | STA OCI+5 8UFFER |
| 6969 | LDA K128 ='14 |
| 6970 | STA OCNT SET 8LOCK SIZE (DOUBLED) |
| 6971 | JST FS00 FLUSH BUFFER |
| 6972 | JMP* ON00 EXIT |
| 6973 | ON02 OCT 600 BLOCK CODE NUMBER (6) |
| 6974 | ONT1 OCT 0 TEMP STORE |
| 6975 | * |
| 6976 | K149 BCI 1,=' |
| 6977 | K140 OCT 26 |
| 6978 | * |
| 6979 | OW00 DAC ** |
| 6980 | JST SAV |
| 6981 | LDA RPL |
| 6982 | SUB ORPL |
| 6983 | SPL |
| 6984 | TCA |
| 6985 | CAS K101 |
| 6986 | JST FS00 FLUSH BUFFER IF DIFFERENCE IN RPL'S N0T 1 |
| 6987 | NOP |
| 6988 | LDA OCNT |
| 6989 | ADD K103 |
| 6990 | CAS K146 |
| 6991 | NOP |
| 6992 | JST FS00 FLUSH BUFFER |
| 6993 | LDA OCNT |
| 6994 | ADD K103 |
| 6995 | STA OCNT OCNT = OCNT+3 |
| 6996 | SUB K103 |
| 6997 | ARR 1 OCI (OUTPUT CARD IMAGE) |
| 6998 | STA XR |
| 6999 | SMI LEFT OR RIGHT POS. |
| 7000 | JMP OW20 |
| 7001 | JST PU00 |
| 7002 | LRL 8 IF BUFFER FULL |
| 7003 | IMA OCI,1 |
| 7004 | ANA K116 CALL FLUSH (FS0O) |
| 7005 | ERA OCI,1 |
| 7006 | OW10 STA OCI,1 |
| 7007 | IAB |
| 7008 | STA OCI+1,1 |
| 7009 | LDA PRI+16 |
| 7010 | IAB |
| 7011 | LDA PRI+14 USE LOW BIT OF PRI+14 DATA |
| 7012 | LLL 9 |
| 7013 | LGR 1 STRIP OFF HIGH BIT OF BLOCK CODE TYPE NO. |
| 7014 | LLL 3 SET DIGITS IN PRI+17, PRI+19 |
| 7015 | JST OR80 |
| 7016 | DAC PRI+16 |
| 7017 | LDA PRI+14 |
| 7018 | LRL 6 |
| 7019 | LGL 1 SHIFT ADDR. TO RIGHT BY 1 BIT |
| 7020 | LLL 5 |
| 7021 | JST OR80 SET DIGITS IN PRI+15, PRI+16 |
| 7022 | DAC PRI+14 |
| 7023 | LDA KASP (SP)(SP) |
| 7024 | SR1 |
| 7025 | JMP OW14 |
| 7026 | STA PRI+15 OVERWRITE BINARY DATA IN |
| 7027 | STA PRI+16 PRINT BUFFER WITH SPACES |
| 7028 | STA PRI+17 IF NO BINARY LISTING IS WANTED |
| 7029 | STA PRI+18 |
| 7030 | OW14 STA PRI+14 |
| 7031 | JST RST |
| 7032 | LDA RPL |
| 7033 | STA ORPL ORPL=RPL |
| 7034 | CRA |
| 7035 | IMA STFL INDICATE WORD WAS KEY TO LOADER |
| 7036 | SNZ THEN LEAVE RPL ALONE |
| 7037 | IRS RPL RPL = RPL+1 |
| 7038 | JMP* OW00 |
| 7039 | STFL PZE 0 |
| 7040 | OW20 JST PU00 |
| 7041 | JMP OW10 |
| 7042 | ORPL PZE 0 |
| 7043 | PU00 DAC ** |
| 7044 | LDA CODE COMBINE CODES TO |
| 7045 | CAS K104 =4 |
| 7046 | NOP |
| 7047 | JMP PU10 |
| 7048 | SZE SKIP IF ABS |
| 7049 | JMP PU10 JUMP IF REL. |
| 7050 | LRL 8 |
| 7051 | LDA FTOP |
| 7052 | PU08 LRL 4 |
| 7053 | STA PRI+14 SAVE FOR LISTING |
| 7054 | IAB |
| 7055 | STA PRI+16 |
| 7056 | LRR 12 RESTORE POSITION |
| 7057 | JMP* PU00 |
| 7058 | PU10 LRL 4 |
| 7059 | LDA AF |
| 7060 | LRL 4 |
| 7061 | ERA FTOP |
| 7062 | JMP PU08 |
| 7063 | PU20 LRL 4 |
| 7064 | LDA AF |
| 7065 | ANA K111 |
| 7066 | LRL 4 |
| 7067 | IMA AF |
| 7068 | ANA K114 |
| 7069 | ERA AF |
| 7070 | JMP PU08 |
| 7071 | K114 OCT 14000 |
| 7072 | K146 OCT 117 |
| 7073 | * |
| 7074 | * |
| 7075 | * ****************** |
| 7076 | * *FLUSH SUBROUTINE* |
| 7077 | * ****************** |
| 7078 | FS00 DAC ** |
| 7079 | LDA OCNT BUFFER OCCUPANCY SIZE |
| 7080 | JST SAV SAVE INDEX REGESTER |
| 7081 | SUB K104 CHECK FOR OCNT .GT. 4 |
| 7082 | SPL |
| 7083 | JMP FS20 SKIP OUTPUT IF BUFFER IS EMPTY |
| 7084 | ADD K105 ADD 1/2 AT B14 |
| 7085 | ARS 1 DIVIDE BY 2 |
| 7086 | TCA |
| 7087 | STA OCNT OCNT = -WORDS/BUFFER |
| 7088 | SUB K101 =1 |
| 7089 | STA PCNT BUFFER SIZE INCLUDING CHECKSUM |
| 7090 | LDA OCI FIRST WORD IN BUFFER |
| 7091 | LRL 12 |
| 7092 | CAS K102 =2 |
| 7093 | JMP *+2 |
| 7094 | JMP FS30 BLOCK TYPE = 2 (RELOCATABLE CODE) |
| 7095 | * EVERY TIME A BLOCK OF OBJECT OUTPUT IS DUMPED, THE FIRST |
| 7096 | * 3 WORDS OF THE BLOCK IS INSERTED IN THE SYMBOLIC OUTPUT |
| 7097 | * ALONG WITH AN EOB OPERATOR CODE IF SENSE SWITCH 1 1S DOWN. |
| 7098 | * TO INHIBIT THIS LINE, REPLACE FROM FS10 TO AND INCLUDING |
| 7099 | * FS11 WITH (FS10 CRA ). |
| 7100 | FS10 SS1 |
| 7101 | JMP FS11 N0 BINARY LISTING UNLESS SSW-1 IS DOWN |
| 7102 | CALL F4$SYM OUTPUT WHATEVER MIGHT BE IN SYMBOLIC BUF. |
| 7103 | DAC PRI |
| 7104 | LDA FS41 =(E)(O) |
| 7105 | STA PRI+5 ENTER 'EOB' INTO LISTING |
| 7106 | LDA FS41+1 =(B)(SP) |
| 7107 | STA PRI+6 |
| 7108 | LDA OCI |
| 7109 | JST OR80 ENTER FIRST WORD FROM BUFFER INTO LISTING |
| 7110 | DAC PRI+8 |
| 7111 | LDA OCI+1 |
| 7112 | JST OR80 ENTER WORD 2 FROM BUFFER INTO LISTING |
| 7113 | DAC PRI+12 |
| 7114 | LDA OCI+2 |
| 7115 | JST OR80 ENTER WORD 3 FROM BUFFER INTO LISTING |
| 7116 | DAC PRI+16 |
| 7117 | CALL F4$SYM OUTPUT SYMBOLIC BUFFER |
| 7118 | DAC PRI |
| 7119 | JST PRSP RESET SYMBOLIC BUFFER TO SPACES |
| 7120 | FS11 CRA |
| 7121 | STA 0 COMPUTE CHECKSUM |
| 7122 | FS12 ERA OCI,1 MERGE BUFFER WORD INTO CHECKSUM |
| 7123 | IRS 0 INCREMENT BUFFER POSITION |
| 7124 | IRS OCNT DECREMENT BUFFER SIZE |
| 7125 | JMP FS12 |
| 7126 | STA OCI,1 SET CHECKSUM INTO BUFFER |
| 7127 | LDA PCNT = NO. OF WORDS IN BUFFER |
| 7128 | IMA 0 |
| 7129 | ADD FS40 = OCI+1,1 |
| 7130 | CALL F4$OUT PUNCH BUFFER |
| 7131 | FS20 LDA RPL SET UP BUFFER FOR NEXT OUTPUT |
| 7132 | LRL 8 |
| 7133 | ADD K145 ='2000 (BLOCK CODE 2) |
| 7134 | STA OCI |
| 7135 | IAB |
| 7136 | STA OCI+1 SET FIRST 2 WORDS OF BUFFER |
| 7137 | LDA K103 =O |
| 7138 | STA OCNT RESET BUFFER OCCUPANCY SIZE |
| 7139 | JST RST RESET INDEX REGISTER |
| 7140 | JMP* FS00 EXIT |
| 7141 | * |
| 7142 | FS30 LGL 6 MERGE BUFFER SIZE INTO BLOCK HEADER |
| 7143 | SUB OCNT BUFFER SIZE |
| 7144 | ADD K101 =1 (ACCOUNT FOR CHECKSUM) |
| 7145 | LLR 6 |
| 7146 | LGR 6 |
| 7147 | LLL 6 BRING IN UPPER HALF OF ADDRESSES |
| 7148 | STA OCI STORE INTO BUFFER |
| 7149 | JMP FS10 COMPUTE CHECKSUM |
| 7150 | * |
| 7151 | FS40 DAC OCI+1,1 |
| 7152 | FS41 BCI 2,EOB 'EOB' |
| 7153 | K145 OCT 20000 BLOCK TYPE 2 CODE |
| 7154 | C499 OCT 060000 |
| 7155 | * |
| 7156 | OCI BSS 40 40 WORD CARD IMAGE INPUT BUFFER |
| 7157 | PRI BSS 40 40 WORD PRINT BUFFER |
| 7158 | BCI 20, |
| 7159 | BSS 30 COMPILER PATCH AREA |
| 7160 | * |
| 7161 | * *********************** |
| 7162 | * *IOS (AND IOL) GO HERE* |
| 7163 | * *********************** |
| 7164 | * |
| 7165 | END A0 |