| faae1561 |
1 | * C210-001-6601 (FRTN) 3C NO.180463000 REV. D |
| 2 | * |
| 3 | * TAPE 1 OF 5 - BEGIN |
| 4 | * |
| 5 | * |
| 6 | * COMPUTER. DDP-116,516 |
| 7 | * |
| 8 | * |
| 9 | * |
| 10 | * |
| 11 | * PROGRAM CATEGORY- COMPILER |
| 12 | * |
| 13 | * |
| 14 | * |
| 15 | * |
| 16 | * PROGRAM TITLE. FRTN |
| 17 | * EXPANDED FORTRAN IV COMPILER |
| 18 | * FOR DDP-116,516 |
| 19 | * |
| 20 | * |
| 21 | * |
| 22 | * |
| 23 | * |
| 24 | * |
| 25 | * |
| 26 | * APPROVAL DATE |
| 27 | * |
| 28 | * |
| 29 | * PROG--------------------- ------------ |
| 30 | * |
| 31 | * |
| 32 | * SUPR---------------------- ------------ |
| 33 | * |
| 34 | * |
| 35 | * QUAL---------------------- ------------ |
| 36 | * |
| 37 | * |
| 38 | * NO. OF PAGES ------------ |
| 39 | * |
| 40 | * REVISIONS |
| 41 | * |
| 42 | * REV. D ECO 5249 |
| 43 | * REV. C ECO 3824 10-31-66 |
| 44 | * REV. B ECO 3476 09-19-66 |
| 45 | * REV. A 06-08-66 |
| 46 | * |
| 47 | * AUTHOR |
| 48 | * |
| 49 | * HONEYWELL. INC. - COMPUTER CONTROL DIVISION |
| 50 | * |
| 51 | * |
| 52 | * PURPOSE |
| 53 | * |
| 54 | * THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV |
| 55 | * PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE |
| 56 | * DDP-116 OR DDP-516. |
| 57 | * |
| 58 | * |
| 59 | * RESTRICTIONS |
| 60 | * |
| 61 | * MINIMUM 8K CORE STORAGE |
| 62 | * |
| 63 | * |
| 64 | * STORAGE |
| 65 | * |
| 66 | * 6682 (DECIMAL) |
| 67 | * 15034 (OCTAL) |
| 68 | * |
| 69 | * |
| 70 | * USE |
| 71 | * |
| 72 | * |
| 73 | * ******************************** |
| 74 | * |
| 75 | * *FORTRAN-IV OPERATING PROCEDURE* |
| 76 | * ******************************** |
| 77 | * |
| 78 | * 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE' |
| 79 | * (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES |
| 80 | * |
| 81 | * 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE |
| 82 | * SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE |
| 83 | * SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START. |
| 84 | * |
| 85 | * 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY)..... |
| 86 | * 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS |
| 87 | * OPTION IS USED WHEN COMPILING THOSE PARTS OF THE |
| 88 | * LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE |
| 89 | * LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO |
| 90 | * GENERATE SPECIAL CODING. |
| 91 | * |
| 92 | * 2-7....NOT ASSIGNED |
| 93 | * |
| 94 | * 8-10...INPUT DEVICE SELECTION |
| 95 | * 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER) |
| 96 | * 2 = NCR CARD READER |
| 97 | * 3 = DIGITRONICS PAPER TAPE READER |
| 98 | * 4 = MAGNETIC TAPE ( UNIT 1 ) |
| 99 | * 5-7 = (SPARES) |
| 100 | * |
| 101 | * 11-13..SYMBOLIC LISTING SELECTION |
| 102 | * 0. SUPPRESS ALL SYMBOLIC LISTINGS |
| 103 | * 1. ASR-33/35 TYPEWRITER |
| 104 | * 2. LINE PRINTER |
| 105 | * 3 = ( SPARE ) |
| 106 | * 4 = LISTING ON MAGNETIC TAPE UNIT 2 |
| 107 | * 5-7 = (SPARES) |
| 108 | * |
| 109 | * 14-16..BINARY OUTPUT SELECTION |
| 110 | * 0. SUPPRESS BINARY OUTPUT. |
| 111 | * 1. BRPE HIGH SPEED PAPER TAPE PUNCH |
| 112 | * 2. ASR BINARY OUTPUT ASR/33 |
| 113 | * 3. ASR BINARY OUTPUT ASR/35 |
| 114 | * 4 = MAGNETIC TAPE OUTPUT |
| 115 | * 5-7 (SPARES) |
| 116 | * |
| 117 | * |
| 118 | * 4. SENSE SWITCH SETTINGS AND MEANINGS....... |
| 119 | * 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE |
| 120 | * SIDE-BY-SIDE OCTAL INFORMATION. |
| 121 | * 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET). |
| 122 | * 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING |
| 123 | * THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT |
| 124 | * STATUS OF THE I/O KEYBOARD, IT MAY BE |
| 125 | * CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING |
| 126 | * SSW-3 AND PRESSING START TO CONTINUE. |
| 127 | * 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED |
| 128 | * IN THE OBJECT CODING BEING GENERATED REGARDLESS OF |
| 129 | * ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR |
| 130 | * OVERRIDE). |
| 131 | * |
| 132 | * 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER |
| 133 | * AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A |
| 134 | * LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF |
| 135 | * TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE |
| 136 | * PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START' |
| 137 | * TO PROCESS THE NEXT PROGRAM (BATCH COMPILING). |
| 138 | * |
| 139 | * FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS |
| 140 | * PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT |
| 141 | * THE COMPILATION. |
| 142 | * |
| 143 | * |
| 144 | * ERRORS |
| 145 | * |
| 146 | * THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A |
| 147 | * SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION. |
| 148 | * ************************* |
| 149 | * *DATA POOL ENTRY FORMATS* |
| 150 | * ************************* |
| 151 | * |
| 152 | * THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION |
| 153 | * 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS |
| 154 | * AT THE END OF THE COMPILER AND EXTENDS TOWARD THE |
| 155 | * END OF MEMORY. |
| 156 | * |
| 157 | * TDCCCCCCCCCCCCCC....DP(A+4) |
| 158 | * CCCCCCCCCCCCCCCC....DP(A+3) |
| 159 | * CCCCCCCCCCCCCCCC....DP(A+2) |
| 160 | * IIAAAAAAAAAAAAAA....DP(A+1) |
| 161 | * NRRRMMMLLLLLLLLL....DP(A) |
| 162 | * |
| 163 | * T = TRACE TAG |
| 164 | * D = DATA TAG |
| 165 | * C = SIX 8-BIT CHAR. OR BINARY CONSTANT |
| 166 | * I = ITEM USAGE (IU) |
| 167 | * 0 = NO USAGE 2 = VAR/CONSTAN^ |
| 168 | * 1 = SUBPROGRAM 3 = ARRAY |
| 169 | * A = ASSIGNMENT ADDRESS |
| 170 | * N = NAME TAG (NT) |
| 171 | * 0 = NAME 1 = CONSTANT |
| 172 | * R = ADDRESS TYPE (AT) |
| 173 | * 0 = ABSOLUTE 3 = STRING-REL |
| 174 | * 1 = RELATIVE 4 = COMMON |
| 175 | * 2 = STRING-ABS 5 = DUMMT |
| 176 | * M = ITEM MODE (IM) |
| 177 | * 1 = INTEGER 5 = COMPLEX |
| 178 | * 2 = REAL 6 = DOUBLE |
| 179 | * 3 = LOGICAL |
| 180 | * 4=COM/EQU LINK |
| 181 | * 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT |
| 182 | * TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT |
| 183 | * A DO-LOOP, EACH ENTRY IS 5 WORDS. |
| 184 | * 00IIIIIIIIIIIII |
| 185 | * 00TTTITTTTTTTTT |
| 186 | * 00XXXXXXXXXXXXX |
| 187 | * 00UUUUUUUUUUUUUU |
| 188 | * 00NNNNNNNNNNNNNN |
| 189 | * I = INITIAL VALUE/OR RPL |
| 190 | * T = TERMINAL VALUE |
| 191 | * X = INDEX |
| 192 | * U = INCREMENT |
| 193 | * N = STATEMENT NUMBER |
| 194 | * |
| 195 | * 3. THE EXPRESSION TABLE (A0I TABLE) 'FLOATS' ON TOP |
| 196 | * THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES. |
| 197 | * |
| 198 | * NOOOOOOOOIIIIIII.....DP(I+1) |
| 199 | * 00AAAAAAAAAAAAAAAA...DP(I) |
| 200 | * N = NEGATION INDICATOR |
| 201 | * O = OPERATOR |
| 202 | * I = INDEX (OPERATOR LEVEL) |
| 203 | * A = ASSIGNMENT TABLE REFERENCE |
| 204 | * 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND |
| 205 | * IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE |
| 206 | * COMPILER. EACH ENTRY IS THREE WORDS LONG. |
| 207 | * |
| 208 | * S000000000PPPPPP.....DP(L+2) |
| 209 | * 0011111111111111.....DP(L+1) |
| 210 | * 0022222222222222.....DP(L) |
| 211 | * S = TEMP STORAGE INDICATOR |
| 212 | * P = OPERATOR |
| 213 | * 1 = FIRST OPERAND ADDRESS |
| 214 | * 2 = SECOND OPERAND ADDRESS |
| 215 | ABS |
| 216 | ORG '100 |
| 217 | * |
| 218 | * ************************************ |
| 219 | * * DIRECTORY OF FORTRAN IV COMPILER * |
| 220 | * ************************************ |
| 221 | * |
| 222 | * |
| 223 | * |
| 224 | *..............ENTRANCE GROUP |
| 225 | DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE |
| 226 | DAC DP DATA POOL START |
| 227 | * |
| 228 | *..............INPUT GROUP |
| 229 | DAC IC00 (IPG1) INPUT COLUMN |
| 230 | DAC UC00 (IPG2) UNINPUT COLUMN |
| 231 | DAC CH00 (IPG3) INPUT CHARACTER |
| 232 | DAC ID00 (IPG4) INPUT DIGIT |
| 233 | DAC IA00 (IPG5) INPUT (A) CHARACTERS |
| 234 | DAC FN00 (IPG6) FINISH OPERATOR |
| 235 | DAC DN00 (IPG7) INPUT DNA |
| 236 | DAC II00 (IPG8) INPUT ITEM |
| 237 | DAC OP00 (IPG9) INPUT OPERAND |
| 238 | DAC NA00 (IPG10) INPUT NAME |
| 239 | DAC IG00 (IPG11) INPUT INTEGER |
| 240 | DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT |
| 241 | DAC IR00 (IPG13) INPUT INTEGER VARIABLE |
| 242 | DAC IS00 (IPG14) INPUT STATEMENT NUMBER |
| 243 | DAC XN00 (IPG15) EXAMINE NEXT CHARACTER |
| 244 | DAC SY00 INPUT STMBOL |
| 245 | * |
| 246 | *..............TEST GROUP |
| 247 | DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R) |
| 248 | DAC IP00 (TSG2) )-INPUT OPERATOR |
| 249 | DAC A1 (TSG3) C/R TEST |
| 250 | DAC B1 (TSG4) , OR C/R TEST |
| 251 | DAC NU00 (TSG5) NO USAGE TEST |
| 252 | DAC NC00 (TSG6) NON CONSTANT TEST |
| 253 | DAC NS00 (TSG7) NON SUBPROGRAM TEST |
| 254 | DAC AT00 (TSG8) ARRAY TEST |
| 255 | DAC IT00 (TSG9) INTEGER TEST |
| 256 | DAC NR00 (TSG10) NON REL TEST |
| 257 | * |
| 258 | *..............ASSIGNMENT GROUP |
| 259 | DAC AS00 (ASG1) ASSIGN ITEM |
| 260 | DAC TG00 (ASG2) TAG SUBPROGRAM |
| 261 | DAC TV00 (ASG3) TAG VARIABLE |
| 262 | DAC FA00 (ASG4) FETCH ASSIGN |
| 263 | DAC FL00 (ASG5) FETCH LINK |
| 264 | DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION |
| 265 | DAC DM00 (ASG7) DEFINE IM |
| 266 | DAC DA00 (ASG8) DEFINE AF |
| 267 | DAC AF00 (ASG9) DEFINE AFT |
| 268 | DAC LO00 (ASG10) DEFINE LOCATION |
| 269 | DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT |
| 270 | DAC AA00 (ASG12) ASSIGN SPECIAL |
| 271 | DAC NXT GET NEXT ENTRY FROM ASSGN TABLE |
| 272 | DAC BUD BUILD ASSIGNMENT TABLE ENTRT |
| 273 | * |
| 274 | *..............CONTROL GROUP |
| 275 | DAC B6 (CNG1) JUMP |
| 276 | DAC C5 ILL TERM |
| 277 | DAC C6 (CNG2) CONTINUE |
| 278 | DAC C7 (CNG3) STATEMENT INPUT |
| 279 | DAC C8 (CNG4) STATEMENT SCAN |
| 280 | DAC A9 (CNG5) STATEMENT IDENTIFICATION |
| 281 | DAC NP00 (CNG6) FIRST NON-SPEC CHECK |
| 282 | * |
| 283 | *..............SPECIFICATIONS GROUP |
| 284 | DAC EL00 (SPG1) EXCHANGE LINKS |
| 285 | DAC NM00 (SPG2) NON COMM0N TEST |
| 286 | DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST |
| 287 | DAC SC00 (SPG4) INPUT SUBSCRIPT |
| 288 | DAC IL00 (SPG5) INPUT LIST ELEMENT |
| 289 | DAC R1 (SPG6) FUNCTION |
| 290 | DAC R2 SUBROUTINE |
| 291 | DAC A3 (SPG7) INTEGER |
| 292 | DAC A4 REAL |
| 293 | DAC A5 DOUBLE PRECISION |
| 294 | DAC A6 COMPLEX |
| 295 | DAC A7 LOGICAL |
| 296 | DAC B2 (SPG8) EXTERNAL |
| 297 | DAC B3 (SPG9) DIMENSION |
| 298 | DAC B7 INPUT DIMENSION |
| 299 | DAC B4 (SPG10) COMMON |
| 300 | DAC B5 (SPG11) EQUIVALENCE |
| 301 | DAC C2 (SPG12) RELATE COMMON ITEMS |
| 302 | DAC C3 (SPG13) GROUP EOUIVALENCE |
| 303 | DAC C4 (SPG14) ASSIGN SPECIFICATIONS |
| 304 | DAC W4 (SPG15) DATA |
| 305 | DAC R3 (SPG16) BLOCK DATA |
| 306 | DAC TRAC (SPG17) TRACE |
| 307 | * |
| 308 | *..............PROCESSOR GROUP |
| 309 | DAC V3 (PRG1) IF |
| 310 | DAC R7 (PRG2) GO TO |
| 311 | DAC IB00 INPUT BRANCH LIST |
| 312 | DAC W3 (PRG3) ASSIGN |
| 313 | DAC C9 (PRG5) DO |
| 314 | DAC V7 (PRG6) END FILE |
| 315 | DAC V6 BACKSPACE |
| 316 | DAC V8 REWIND |
| 317 | DAC V5 (PRG7) READ |
| 318 | DAC V4 WRITE |
| 319 | DAC V2 (PRG8) FORMAT |
| 320 | DAC SI00 INPUT FORMAT STRING |
| 321 | DAC IN00 INPUT NUMERIC FORMAT STRING |
| 322 | DAC NZ00 NON ZERO STRING TEST |
| 323 | DAC W8 (PRG9) PAUSE |
| 324 | DAC W7 STOP |
| 325 | DAC R8 (PRG10) CALL |
| 326 | DAC G2 ASSIGNMENT STATEMENT |
| 327 | DAC R9 (PRG11) RETURN |
| 328 | DAC G1 (PRG12) STATEMENT FUNCTION |
| 329 | DAC W5 (PRG13) END |
| 330 | * |
| 331 | *..............PROCESSOR SUBROUTINES GROUP |
| 332 | DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK |
| 333 | DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING |
| 334 | DAC DP00 (PSG3) DO INPUT |
| 335 | DAC DS00 (PSG4) DO INITIALIZE |
| 336 | DAC DQ00 (PSG5) DO TERMINATION |
| 337 | DAC EX00 (PSG6) EXPRESSION |
| 338 | DAC CA00 (PSG7) SCAN |
| 339 | DAC ST00 TRIAD SEARCH |
| 340 | DAC TC00 TEMP STORE CHECK |
| 341 | DAC ET00 (PSG8) ENTER TRIAD |
| 342 | DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE |
| 343 | * |
| 344 | *..............OUTPUT GROUP |
| 345 | DAC OL00 (OPG1) OUTPUT OBJECT LINK |
| 346 | DAC OI00 (OPG2) OUTPUT I/O LINK |
| 347 | DAC CN00 (OPG3) CALL NAME |
| 348 | DAC OK00 (OPG4) OUTPUT PACK |
| 349 | DAC OB00 (OPG5) OUTPUT OA |
| 350 | DAC OT00 (OPG6) OUTPUT TRIADS |
| 351 | DAC OM00 (OPG7) OUTPUT ITEM |
| 352 | DAC OR00 (OPG8) OUTPUT REL |
| 353 | DAC OA00 OUTPUT ABS |
| 354 | DAC OS00 OUTPUT STRING |
| 355 | DAC OW00 (OPG9) OUTPUT WORD |
| 356 | DAC PU00 PICKUP |
| 357 | DAC FS00 (OPG10) FLUSH |
| 358 | DAC TRSE (OPG11) OUTPUT TRACE COUPLING |
| 359 | DAC PRSP SET BUFFER TO SPACES |
| 360 | * |
| 361 | *..............MISC. GROUP |
| 362 | DAC AD3 ADD TWO 3 WORD INTEGERS |
| 363 | DAC IM00 MULTIPLY (A) BY (B) |
| 364 | DAC STXA SET A INTO INDEX |
| 365 | DAC STXI SET I INTO INDEX |
| 366 | DAC NF00 SET FS INTO NAMF |
| 367 | DAC BLNK SET AREA TO ZEROS |
| 368 | DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE |
| 369 | DAC CIB COMPARE IBUF TO A CONSTANT |
| 370 | DAC SAV SAVE INDEX IN PUSH-DOWN STACK |
| 371 | DAC RST RESET INDEX FROM PUSH-DOWN STACK |
| 372 | DAC PACK |
| 373 | DAC ER00 ERROR OUTPUT |
| 374 | DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.) |
| 375 | DAC SFT SHIFT LEFT 1 (TRIPLE PRES.) |
| 376 | DAC LIST |
| 377 | * |
| 378 | * |
| 379 | * **************************** |
| 380 | * *CONSTANT AND VARIABLE POOL* |
| 381 | * **************************** |
| 382 | * |
| 383 | XR EQU 0 INDEX REGISTER |
| 384 | * THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING |
| 385 | * PROGRAM INITIALIZATION |
| 386 | A EQU '40 ASSIGNMENT TABLE INDEX |
| 387 | I EQU A+1 EXPRESSION TABLE INDEX |
| 388 | C EQU A+2 |
| 389 | ASAV EQU A+3 |
| 390 | L EQU A+4 |
| 391 | MFL EQU A+5 MODE FLAG |
| 392 | SFF EQU A+6 FUNCTION FLAG |
| 393 | SBF EQU A+7 SUBFUNCTION FLAG |
| 394 | SXF EQU A+8 POSSIBLE CPX FLAG |
| 395 | SPF EQU A+9 PEC. FLAG |
| 396 | TCF EQU A+10 TEMP STORE COUNT |
| 397 | IFF EQU A+11 |
| 398 | ABAR EQU A+12 BASE OF ASSIGN TABLE |
| 399 | XST EQU A+13 FIRST EXECUTABLE STMNT. |
| 400 | CFL EQU A+14 MON FLAG |
| 401 | D EQU A+15 DO INDEX |
| 402 | RPL EQU A+16 RELATE PROGRAM LOCATION |
| 403 | BDF EQU A+17 LOCK DATA FLAG |
| 404 | SLST EQU A+18 SOURCE LIST |
| 405 | OBLS EQU A+19 OUTPUT BINARY LIST |
| 406 | BNOT EQU A+20 BINART OUTPUT FLAG |
| 407 | TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.) |
| 408 | TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN |
| 409 | * AN EXPRESSION (FOR USE BY TRACE). |
| 410 | SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET) |
| 411 | LIF EQU A+24 LOGICAL IF FLAG |
| 412 | LSTN EQU A+25 LAST STATEMENT NO. |
| 413 | LSTF EQU A+26 LAST STATEMENT FLAG |
| 414 | LSTP EQU A+27 LAST STATEMENT STOP |
| 415 | SDSW EQU A+28 STATEMENT I0 SWITCH |
| 416 | * |
| 417 | NAMF EQU '570 NAME FUNCTION |
| 418 | ND EQU NAMF+1 NO OF DIMENSIONS |
| 419 | NS EQU '572 NO OF SUBSCRIPTS |
| 420 | NT EQU NS+1 NAME TAG |
| 421 | NTF EQU NS+2 NAME TAG FLAG |
| 422 | NTID EQU NS+3 NO. WORDS IN TID |
| 423 | O1 EQU NS+4 OPERATOR 1 |
| 424 | O2 EQU NS+5 OPERATOR 2 |
| 425 | P EQU NS+6 |
| 426 | PCNT EQU NS+7 |
| 427 | OCNT EQU NS+8 OUTPUT COUNT |
| 428 | S0 EQU NS+9 |
| 429 | S1 EQU NS+10 SUBSCRIPT NO.1 |
| 430 | S2 EQU NS+11 SUBSCRIPT NO.2 |
| 431 | S3 EQU NS+12 SUBSCRIPT NO.3 |
| 432 | TC EQU NS+13 TERMINAL CHAR |
| 433 | TT EQU NS+14 |
| 434 | TYPE EQU NS+15 |
| 435 | X EQU NS+16 ARRAY INDICES |
| 436 | X1 EQU NS+17 |
| 437 | X2 EQU NS+18 |
| 438 | X3 EQU NS+19 |
| 439 | X4 EQU NS+20 |
| 440 | NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS |
| 441 | ATA EQU NS+22 |
| 442 | IMA EQU NS+23 |
| 443 | CLA EQU NS+24 |
| 444 | IUA EQU NS+25 |
| 445 | DTA EQU NS+26 |
| 446 | TTA EQU NS+27 |
| 447 | *..........ADJUST THIS ORG IF THE SIZE OF THE CONSTAST POOL IS MODIFIED |
| 448 | ORG '630 |
| 449 | AF PZE 0 ADDRESS FIELD |
| 450 | GF EQU AF |
| 451 | AT PZE 0 ADDRESS TYPE |
| 452 | CODE PZE 0 OUTPUT CODE |
| 453 | D0 PZE 0 DIMENSIONS |
| 454 | D1 PZE 0 |
| 455 | D2 PZE 0 |
| 456 | D3 PZE 0 |
| 457 | D4 PZE 0 |
| 458 | DF PZE 0 DATA FLAG |
| 459 | NF PZE 0 |
| 460 | B PZE 0 |
| 461 | DFL PZE 0 DELIMITER FLAG |
| 462 | E OCT 0 EQUIVALENCE INDEX |
| 463 | EP PZE 0 E-PRIME |
| 464 | E0 PZE 0 E-ZERO |
| 465 | FTOP PZE 0 OUTPUT COMMAND |
| 466 | GFA PZE 0 |
| 467 | ICSW PZE 1 INPUT CONTROL SWITCH |
| 468 | IFLG PZE 0 I-FLAG |
| 469 | IM PZE 0 ITEM MODE |
| 470 | IOF PZE 0 I-0 FLAG |
| 471 | IU PZE 0 ITEM USAGE |
| 472 | KBAR PZE 0 TEM STORE |
| 473 | KPRM PZE 0 TEM STORE |
| 474 | EBAR OCT -1 E-BAR |
| 475 | DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT) |
| 476 | CC PZE '111 CARD COLUMN COUNTER |
| 477 | DCT PZE 0 DUMMY ARGUMENT COUNT |
| 478 | F PZE 0 TRIAD TABLE INDEX |
| 479 | CL PZE 0 ASSIGNMENT ITEMS UNPACKED |
| 480 | DT PZE 0 |
| 481 | FLT1 PZE 0 FETCH LINK CL POINTER LOCATION |
| 482 | LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET) |
| 483 | *..........CONSTANTS USED BY THE COMPILER |
| 484 | K4 OCT 251 0) |
| 485 | K5 OCT 254 0, |
| 486 | K8 OCT 240 0-SPACE |
| 487 | K9 OCT 257 0/ |
| 488 | K10 OCT 256 0. |
| 489 | K12 OCT 255 0- |
| 490 | K13 OCT 253 0+ |
| 491 | K15 OCT 244 0$ |
| 492 | K16X OCT 16 |
| 493 | K17 OCT 250 0( |
| 494 | K18 OCT 275 0= |
| 495 | K19 BCI 1,DO DO |
| 496 | K34 OCT 324 0T |
| 497 | K35 OCT 317 0O |
| 498 | K40 BCI 1,WN |
| 499 | K41 BCI 1,RN RN |
| 500 | K42 BCI 1,CB |
| 501 | K43 OCT 311 0I |
| 502 | K44 OCT 321 0Q |
| 503 | K45 EQU K34 0T |
| 504 | K57 OCT 252 0* |
| 505 | K60 OCT 260 00 (BCI ZERO) |
| 506 | K61 OCT 271 09 |
| 507 | K68 EQU K19 |
| 508 | K101 OCT 1 |
| 509 | K102 OCT 2 |
| 510 | K103 OCT 3 |
| 511 | K104 OCT 4 |
| 512 | K105 OCT 5 |
| 513 | K106 OCT 6 |
| 514 | K107 OCT 7 |
| 515 | K109 DEC 16 |
| 516 | K100 OCT 377 |
| 517 | K111 OCT 37777 |
| 518 | K110 DEC -17 |
| 519 | K115 OCT 170777 |
| 520 | K116 OCT 177400 |
| 521 | K117 DEC -27 |
| 522 | K118 OCT 777 |
| 523 | K119 OCT 177000 |
| 524 | K120 DEC -15 |
| 525 | K122 OCT 040000 |
| 526 | K123 DEC -1 |
| 527 | K124 DEC 9 |
| 528 | K125 DEC 8 |
| 529 | K126 DEC 10 |
| 530 | K127 DEC 11 |
| 531 | K128 DEC 12 |
| 532 | K129 DEC 13 |
| 533 | K131 DEC -14 |
| 534 | K132 OCT 22 |
| 535 | K134 OCT 17 |
| 536 | K137 OCT 24002 |
| 537 | K138 OCT 25 |
| 538 | K139 OCT 24 |
| 539 | CRET OCT 215 0 C/R |
| 540 | ZERO OCT 0 |
| 541 | HBIT OCT 140000 HIGH BITS FOR ALPHA DATA |
| 542 | KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT |
| 543 | MIN2 DEC -2 -2 |
| 544 | HC2 OCT 340 |
| 545 | K357 OCT 357 |
| 546 | * |
| 547 | * |
| 548 | DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET |
| 549 | * BY THE FORTRAN IOS SUBROUTINE.) |
| 550 | L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS) |
| 551 | * THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER |
| 552 | * TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS |
| 553 | * 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL |
| 554 | * CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL |
| 555 | * LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER |
| 556 | * CONFIGURATION. |
| 557 | ORG '1000 |
| 558 | PZE DP-4,1 (100) |
| 559 | PZE DP-3,1 (101) DATA POOL REFERENCES |
| 560 | PZE DP-2,1 (102) |
| 561 | PZE DP-1,1 (103) |
| 562 | PZE DP,1 (104) |
| 563 | PZE DP+1,1 (105) |
| 564 | PZE DP+2,1 (106) |
| 565 | PZE DP+3,1 (107) |
| 566 | PZE DP+4,1 (108) |
| 567 | PZE DP+9,1 (111) |
| 568 | PZE DP+6,1 (112) |
| 569 | PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS |
| 570 | * |
| 571 | * |
| 572 | ORG 1 |
| 573 | JST ER00 THIS INSTRUCTION REACHED ONLY IF THE |
| 574 | BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE. |
| 575 | * |
| 576 | * |
| 577 | * |
| 578 | * |
| 579 | * ******************* |
| 580 | * *START OF COMPILER* |
| 581 | * ******************* |
| 582 | * |
| 583 | ORG '1000 |
| 584 | * |
| 585 | * |
| 586 | * |
| 587 | * - A0 COMP ENT EMPTY BUFFERS |
| 588 | LRL 15 |
| 589 | STA LIBF SET SPECIAL LIBRARY FLAG |
| 590 | LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS) |
| 591 | A0 CALL F4$INT INITIALIZE I/O DEVICES |
| 592 | LDA K108 |
| 593 | STA CC CC = 73 |
| 594 | JST IC00 INPUT COLUMN |
| 595 | A051 LDA A090 |
| 596 | STA XR |
| 597 | LDA A092 LOC, OF INDEX PUSH-DOWN BUFFER |
| 598 | STA SAV9 INITIALIZE PUSH-DOWN BUFR, |
| 599 | CRA |
| 600 | STA A+M,1 SET M VARIABLES TO ZERO |
| 601 | STA NAMF+M,1 |
| 602 | IRS XR |
| 603 | JMP *-3 |
| 604 | STA IFLG |
| 605 | STA PKF |
| 606 | JST FS00 INITIALIZE OUTPUT BUFFER |
| 607 | CMA |
| 608 | STA LSTF LSTF NOT EQ 0 |
| 609 | STA LSTP LSTP NOT EQ 0 |
| 610 | STA EBAR EBAR SET NEGATIVE |
| 611 | LDA L0 |
| 612 | STA ICSW |
| 613 | STA E0 INITIALIZE EQUIVALENCE TABLE |
| 614 | STA L INITIALIZE TRIAD TABLE POINTER |
| 615 | JST PRSP SET PRINT BUFFER TO SPACES |
| 616 | LDA K134 |
| 617 | STA DO INITIALIZE DO TABLE POINTER |
| 618 | SUB K138 |
| 619 | STA A091 |
| 620 | CRA |
| 621 | STA ID |
| 622 | A055 IRS ID ESTABLISH CONSTANTS |
| 623 | JST AI00 |
| 624 | IRS A091 |
| 625 | JMP A055 |
| 626 | LDA K81 |
| 627 | STA ID |
| 628 | STA ID+1 |
| 629 | STA ID+2 |
| 630 | CRA |
| 631 | LRL 32 (B)=0 IM=NO USAGE |
| 632 | LDA K101 (A)=1 IU=SUBR |
| 633 | JST AA00 ASSIGN (SPECIAL) |
| 634 | JST STXA SET POINTER A INTO INDEX AND (A) |
| 635 | STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK) |
| 636 | ADD K122 ='40000 (IU=SUBR) |
| 637 | STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFI |
| 638 | JMP C7 GO TO STMNT INPUT |
| 639 | M EQU 30 |
| 640 | A090 DAC* -M,1 |
| 641 | A091 PZE 0 |
| 642 | A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER |
| 643 | * |
| 644 | * |
| 645 | * |
| 646 | * ************** |
| 647 | * *INPUT COLUMN* |
| 648 | * ************** |
| 649 | * |
| 650 | * INPUT NEXT CHARACTER |
| 651 | * IGNORE BLANKS |
| 652 | * CHECK FOR COMMENTS |
| 653 | * IC02 SET AS FOLLOWS - |
| 654 | * NORMAL - ICIP |
| 655 | * INITIAL SCAN -ICSR |
| 656 | IC00 DAC ** LINK STORE |
| 657 | JST SAV SAVE INDEX |
| 658 | LDA CC IF CC = 73, GO TO IC 10 |
| 659 | SUB K108 |
| 660 | SZE |
| 661 | JMP IC19 ELSE, GO TO IC |
| 662 | IC10 LDA ICSW IF ICSW. GO TO IC12 |
| 663 | SNZ |
| 664 | JMP IC24 ELSE, GO TO IC24 |
| 665 | IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE |
| 666 | DAC CI |
| 667 | LDA CI |
| 668 | LGR 8 GO 70 IC 14 |
| 669 | CAS K16 =(C) |
| 670 | JMP *+2 |
| 671 | JMP IC30 COMMENT CARD (IGNORE) |
| 672 | SUB K15 =($) |
| 673 | SNZ |
| 674 | JMP IC18 CONTROL CARD (IGNORE COLUMN 6) |
| 675 | LDA K357 IF CARD COL, SIX IS |
| 676 | ANA CI+2 ZERO OR BLANK, GO TO IC18 |
| 677 | SUB K8 |
| 678 | SZE |
| 679 | JMP IC26 ELSE, GO TO IC26 |
| 680 | IC18 STA CC CC = 0. |
| 681 | LDA CI+2 CI(6) = SPECIAL |
| 682 | ANA K116 |
| 683 | ADD HC2 ='340 |
| 684 | STA CI+2 |
| 685 | LDA CRET |
| 686 | JMP IC20 TC = C.R. |
| 687 | IC19 LDA CC TC = CI(CC) |
| 688 | SUB K101 |
| 689 | LGR 1 |
| 690 | STA XR |
| 691 | LDA CI,1 |
| 692 | SSC |
| 693 | LGR 8 |
| 694 | ANA K100 |
| 695 | IC20 STA TC |
| 696 | IRS CC CC = CC+1 |
| 697 | IC22 JST RST RESTORE INDEX |
| 698 | JMP* IC00 RETURN |
| 699 | IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN |
| 700 | STA TC |
| 701 | JMP IC22 GO TO IC22 |
| 702 | IC26 JST LIST LIST, CONTINUATION CARD |
| 703 | LDA K107 CC = 7. IGNORE STATEMENT NO. |
| 704 | STA CC |
| 705 | JMP IC19 G0 TO IC19 |
| 706 | IC30 JST LIST PRINT CARD IMAGE |
| 707 | JMP IC12 READ IN NEW CARD |
| 708 | K16 OCT 303 0C |
| 709 | K108 DEC 73 |
| 710 | KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER |
| 711 | CI BSS 40 |
| 712 | BCI 20, |
| 713 | * |
| 714 | * |
| 715 | * |
| 716 | * **************** |
| 717 | * *UNINPUT COLUMN* |
| 718 | * **************** |
| 719 | * BACK UP ONE COLUMN |
| 720 | * |
| 721 | UC00 DAC ** |
| 722 | IMA CC CC= CC-1 |
| 723 | SUB K101 RETAIN (A) |
| 724 | IMA CC |
| 725 | JMP* UC00 |
| 726 | * |
| 727 | * |
| 728 | * ***************** |
| 729 | * *INPUT CHARACTER* |
| 730 | * ***************** |
| 731 | * INPUT ONE CHARACTER FROM EITHER |
| 732 | * 1, INPUT BUFFER (EBAR POSITIVE) OR |
| 733 | * 2, EQUIVALENCE BUFFER (EBAR NEGATIVE) |
| 734 | * |
| 735 | CH00 DAC ** |
| 736 | LDA EBAR IF EBAR 7 0, |
| 737 | SMI |
| 738 | JMP CH10 G0 10 CH10 |
| 739 | CH03 JST IC00 INPUT COLUMN |
| 740 | SUB K8 IF BLANK, REPEAT |
| 741 | SNZ |
| 742 | JMP CH03 |
| 743 | LDA TC ELSE, |
| 744 | * |
| 745 | CH04 CAS CH13 ='301 |
| 746 | NOP |
| 747 | JMP CH06 |
| 748 | CAS K61 ='271 |
| 749 | JMP CH05 |
| 750 | NOP |
| 751 | CAS K15 ='244 |
| 752 | JMP *+2 |
| 753 | JMP CH05-1 |
| 754 | CAS K60 ='260 |
| 755 | NOP |
| 756 | CRA ALPHA NUMERIC CHARACTER |
| 757 | CH05 STA DFL DELIMITER ENTRY |
| 758 | LDA TC EXIT WITH TC IN A |
| 759 | JMP* CH00 |
| 760 | CH06 CAS K63 ='332 |
| 761 | JMP CH05 |
| 762 | NOP |
| 763 | JMP CH05-1 |
| 764 | CH08 STA DFL |
| 765 | JMP* CH00 |
| 766 | CH10 LDA E IF E = EBAR |
| 767 | CAS EBAR |
| 768 | JMP *+2 |
| 769 | JMP CH12 GO TO CH12 |
| 770 | STA 0 SET E INTO INDEX |
| 771 | LLL 16 SET (B) TO ZERO |
| 772 | LDA DP,1 CURRENT CHARACTER WORD |
| 773 | LLR 8 |
| 774 | STA DP,1 SAVE REMAINING CHARACTER IF ANY |
| 775 | IAB |
| 776 | STA TC TC=LEFTMOST CHARACTER |
| 777 | SZE SKIP IF NEW CHARACTER WORD NEEDED |
| 778 | JMP CH04 |
| 779 | LDA E E=E-1 |
| 780 | SUB K101 =1 |
| 781 | STA E |
| 782 | JMP CH10 PICK UP NEXT CHARACTER WORD |
| 783 | CH12 SSM MAKE E MINUS |
| 784 | STA EBAR |
| 785 | JMP C4 GO TO ASSIGN SPEC |
| 786 | K63 OCT 332 0Z |
| 787 | CH13 OCT 301 |
| 788 | * |
| 789 | * |
| 790 | * ************* |
| 791 | * *INPUT DIGIT* |
| 792 | * ************* |
| 793 | * A IS ZERO IF NOT DIGIT |
| 794 | * |
| 795 | ID00 DAC ** INPUT DIGIT |
| 796 | JST CH00 INPUT A CHAR |
| 797 | CAS K61 ='271 (9) |
| 798 | JMP* ID00 (A) = TC |
| 799 | JMP ID10 ELSE, (A) = 0 |
| 800 | CAS K60 RETURN |
| 801 | NOP |
| 802 | JMP *+2 |
| 803 | JMP* ID00 |
| 804 | ID10 CRA |
| 805 | JMP* ID00 |
| 806 | * |
| 807 | * |
| 808 | * ********************** |
| 809 | * *INPUT (A) CHARACTERS* |
| 810 | * ********************** |
| 811 | * CHAR COUNT IN XR, TERMINATES WITH EITHER |
| 812 | * 1, CHAR COUNT -1 = ZERO OR |
| 813 | * 2, LAST CHAR IS A DELIMITER |
| 814 | * |
| 815 | IA00 DAC ** |
| 816 | TCA SET COUNTER |
| 817 | STA IA99 |
| 818 | JST IA50 EXCHANGE IBUF AND ID |
| 819 | CRA |
| 820 | STA NTID NTID = 0 |
| 821 | IA10 JST CH00 INPUT A CHARACTER |
| 822 | JST PACK |
| 823 | LDA DFL IF DFL NOT ZERO, |
| 824 | SZE CONTINUE |
| 825 | JMP IA20 ELSE, |
| 826 | IRS IA99 TEST COUNTER |
| 827 | JMP IA10 MORE CHARACTERS TO INPUT |
| 828 | IA20 JST IA50 EXCHANGE ID AND IBUF |
| 829 | JMP* IA00 RETURN |
| 830 | IA50 DAC ** EXCHANGE IBUF AND ID |
| 831 | JST SAV SAVE INDEX |
| 832 | LDA IA90 |
| 833 | STA XR |
| 834 | LDA IBUF+3,1 |
| 835 | IMA ID+3,1 |
| 836 | STA IBUF+3,1 |
| 837 | IRS XR |
| 838 | JMP *-4 |
| 839 | JST RST RESTORE INDEX |
| 840 | LDA NTID |
| 841 | JMP* IA50 |
| 842 | IA90 OCT -3 |
| 843 | IA99 PZE 0 |
| 844 | * |
| 845 | * |
| 846 | * ***************** |
| 847 | * *FINISH OPERATOR* |
| 848 | * ***************** |
| 849 | * WRAP UP LOGICAL/RELATIONAL OPERATORS |
| 850 | * |
| 851 | FN00 DAC ** |
| 852 | LDA DFL IF DFL NOT . , |
| 853 | STA IBUF |
| 854 | SUB K10 |
| 855 | SZE |
| 856 | JMP FN05 GO TO FN05 |
| 857 | LDA K104 |
| 858 | JST IA00 |
| 859 | FN05 LDA K110 USE TABLE TO CONVERT |
| 860 | STA XR OPERATOR |
| 861 | FN10 LDA FN90+17,1 |
| 862 | CAS IBUF |
| 863 | JMP *+2 |
| 864 | JMP FN20 |
| 865 | IRS XR |
| 866 | JMP FN10 |
| 867 | LDA TC |
| 868 | JMP* FN00 |
| 869 | FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR |
| 870 | STA TC SET INTO TC |
| 871 | JMP* FN00 |
| 872 | FN90 OCT 253,255,252,257 +-*/ |
| 873 | BCI 9,NOANORLTLEEQGEGTNE |
| 874 | OCT 275,254 =, |
| 875 | FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17 |
| 876 | * |
| 877 | * |
| 878 | * *********** |
| 879 | * *INPUT DNA* |
| 880 | * *********** |
| 881 | * BASIC INPUT ROUTINE, HANDLES FOLLOWING - |
| 882 | * CONSTANT CONVERSION |
| 883 | * MODE TYPING (CONSTANTS, IMPLIED/VARIABLES) |
| 884 | * ALL OPERATORS (TERMINATE ITEM) |
| 885 | * |
| 886 | ID BSS 4 |
| 887 | TID EQU ID TEMP STORE FOR ID |
| 888 | IBUF BSS 3 3-WORD BUF |
| 889 | TIDN PZE 0 |
| 890 | K155 OCT 177727 -41 |
| 891 | K156 OCT 024000 1085 |
| 892 | K157 OCT 007777 |
| 893 | K158 OCT 074000 |
| 894 | F1 PZE 0 SIGN FLAG |
| 895 | F2 PZE 0 |
| 896 | F3 PZE 0 INPUT EXPONENT |
| 897 | F4 PZE 0 NO, FRAC. POSITIONS |
| 898 | F5 PZE 0 TEMP DELIMITER STORE |
| 899 | F6 PZE 0 |
| 900 | L4 PZE 0 |
| 901 | HOLF PZE 0 HOLLERITH FLAG |
| 902 | DN00 DAC ** |
| 903 | DN01 CRA |
| 904 | STA HOLF SET HOLF =0 |
| 905 | STA F4 F4 = 0 |
| 906 | STA IU |
| 907 | STA NT IU=NT=NTID=0 |
| 908 | STA NTID |
| 909 | JST BLNK CLEAR OUT TID = ID |
| 910 | DAC TID |
| 911 | JST BLNK |
| 912 | DAC F1 F1,F2,F3 = 0 |
| 913 | DN06 CRA |
| 914 | STA IM |
| 915 | STA DNX2 |
| 916 | DN07 JST ID00 INPUT DIGIT |
| 917 | SZE |
| 918 | JMP DN14 (A) NON-ZERO, G0 T0 DN14 |
| 919 | DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST |
| 920 | ANA K158 POSITION COUNT IF NECESSARY, |
| 921 | SZE |
| 922 | JMP SKIP |
| 923 | ADD IM |
| 924 | ARS 1 |
| 925 | ADD F4 F4 = F4+1 IF NO OVERFLOW |
| 926 | STA F4 AND IM ALREADY SET TO REAL |
| 927 | LDA K101 |
| 928 | STA NT NT=1 |
| 929 | ADD K101 |
| 930 | STA IU IU = VAR/COD |
| 931 | JST SFT SHIFT ID LEFT |
| 932 | DAC ID |
| 933 | JST MOV3 MOVE TO TEMP STORE |
| 934 | JST SFT |
| 935 | DAC ID |
| 936 | JST SFT |
| 937 | DAC ID |
| 938 | JST AD3 ID = 10*ID+TC |
| 939 | JST BLNK |
| 940 | DAC DNX1 |
| 941 | LDA TC |
| 942 | SUB K60 |
| 943 | STA DNX1 |
| 944 | JST AD3 |
| 945 | JMP DN07 |
| 946 | SKIP LDA MIN2 |
| 947 | ADD IM |
| 948 | ARS 1 |
| 949 | ADD F4 |
| 950 | STA F4 |
| 951 | JMP DN07 |
| 952 | DN14 LDA IM IM = REAL |
| 953 | SUB K102 |
| 954 | SZE |
| 955 | JMP DN50 NO, GO TO DN50 |
| 956 | DN16 LDA K10 YES, |
| 957 | DN17 STA F5 F5 = '.' |
| 958 | LDA DFL IF DFL =0, GO SO DN20 (5) |
| 959 | SZE |
| 960 | JMP DN90 ELSE GO TO DN90 (9) |
| 961 | DN20 LDA TC IF TC = D, GO TO DN26 |
| 962 | SUB K11 |
| 963 | SNZ |
| 964 | JMP DN26 |
| 965 | SUB K101 ELSE, IF TC = E, GO TO DN22 |
| 966 | SNZ |
| 967 | JMP DN22 TERMINATOR = E |
| 968 | JST UC00 |
| 969 | LDA K10 ='256 (,) |
| 970 | STA DFL SET DELIMITER FLAG |
| 971 | LDA K101 =1 |
| 972 | STA IM SET ITEM MODE TO INTEGER |
| 973 | JMP DN67 FINISH OPERATOR AND EXIT |
| 974 | * |
| 975 | DN22 JST ID00 INPUT DIGIT |
| 976 | SNZ IF (A) = 0, GO TO DN30 |
| 977 | JMP DN30 |
| 978 | LDA TC IF TC = -, GO TO DN28 |
| 979 | SUB K12 |
| 980 | SNZ |
| 981 | JMP DN28 |
| 982 | ADD K102 |
| 983 | SNZ |
| 984 | JMP DN29 |
| 985 | LDA F5 |
| 986 | STA DFL |
| 987 | JST UC00 UN-INPUT COL |
| 988 | DN24 JST FN00 FINISH OPERATOR |
| 989 | DN25 LDA K101 IM = INT |
| 990 | STA IM |
| 991 | LDA ID+1 IF ID IS TOO BIG TO |
| 992 | SZE BE AN INTEGER (>L2), |
| 993 | JMP DN69 GO TO DN69 (20) |
| 994 | LDA ID+2 |
| 995 | SZE |
| 996 | JMP DN69 |
| 997 | JMP DN84 OTHERWISE, GO TO DN84(12) |
| 998 | DN26 LDA K106 IM = DBL |
| 999 | STA IM |
| 1000 | JMP DN22 |
| 1001 | DN28 LDA K101 F2 = 1 |
| 1002 | STA F2 |
| 1003 | DN29 JST ID00 INPUT DIGIT |
| 1004 | SZE IF (A) = 0, GO TO DN30 (8.5) |
| 1005 | JMP DN69 ELSE, GO TO DN69 (20) |
| 1006 | DN30 LDA F3 F3 = 10 * F3 |
| 1007 | ALS 3 |
| 1008 | IMA F3 F3 = F3 +TC |
| 1009 | ALS 1 |
| 1010 | ADD F3 |
| 1011 | ADD TC INPUT DIGIT |
| 1012 | SUB K60 |
| 1013 | STA F3 IF (A) = 0, GO TO DN30 (8.5) |
| 1014 | JST ID00 ELSE, GO TO DN90 (9) |
| 1015 | SZE |
| 1016 | JMP DN90 |
| 1017 | JMP DN30 |
| 1018 | DN50 LDA K102 IM=REA |
| 1019 | STA IM |
| 1020 | LDA TC IF TC = ., GO TO DN54 |
| 1021 | SUB K10 |
| 1022 | SNZ |
| 1023 | JMP DN54 ELSE, |
| 1024 | LDA NT |
| 1025 | SNZ IF NT = 0, GO TO DN72 |
| 1026 | JMP DN72 |
| 1027 | LDA TC IF TC = H, GO TO DN9H (22) |
| 1028 | SUB K14 |
| 1029 | SNZ |
| 1030 | JMP DN9H |
| 1031 | LDA DFL IF DFL = 0, |
| 1032 | SZE GO TO DN16 (4.9) |
| 1033 | JMP DN25 ELSE, GO TO DN25 |
| 1034 | JMP DN16 |
| 1035 | DN54 JST ID00 INPUT DIGIT |
| 1036 | SNZ |
| 1037 | JMP DN10 IF (A) = 0, GO TO DN10 (3) |
| 1038 | LDA NT |
| 1039 | SNZ IF NT = 0, GO TO DN56 |
| 1040 | JMP DN56 |
| 1041 | LDA TC F5 = TC |
| 1042 | JMP DN16 GO TO DN16 (4) |
| 1043 | DN56 CRA |
| 1044 | STA TC TC = ) |
| 1045 | DN58 JST UC00 UN-INPUT A COLUMN, |
| 1046 | LDA F1 IF F1 = 0, GO TO DN60 |
| 1047 | SZE |
| 1048 | JMP DN63 ELSE, GO TO DN63 (15) |
| 1049 | DN60 LDA K106 |
| 1050 | JST IA00 INPUT (6) CHARS |
| 1051 | JST CIB IF IBUF = TRUE., |
| 1052 | DAC K1+3,1 |
| 1053 | JMP DN64 |
| 1054 | JST CIB IF IBUF = FALSE., |
| 1055 | DAC K2+3,1 GO TO DN66 (16) |
| 1056 | JMP DN66 |
| 1057 | JST CIB CHECK FOR .NOT. OPERATOR |
| 1058 | DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR |
| 1059 | JMP DN9N OPERATOR IS .NOT. |
| 1060 | * |
| 1061 | * TAPE 1 OF 5 - END |
| 1062 | MOR |
projects / h316.git / blame