| Previous File | Multiple Pages | Next File |
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 1
0001 * C210-001-6601 (FRTN) 3C NO.180463000 REV. D 0002 * 0003 * 0004 * 0005 * COMPUTER. DDP-116,516 0006 * 0007 * 0008 * 0009 * 0010 * PROGRAM CATEGORY- COMPILER 0011 * 0012 * 0013 * 0014 * 0015 * PROGRAM TITLE. FRTN 0016 * EXPANDED FORTRAN IV COMPILER 0017 * FOR DDP-116,516 0018 * 0019 * 0020 * 0021 * 0022 * 0023 * 0024 * 0025 * APPROVAL DATE 0026 * 0027 * 0028 * PROG--------------------- ------------ 0029 * 0030 * 0031 * SUPR---------------------- ------------ 0032 * 0033 * 0034 * QUAL---------------------- ------------ 0035 * 0036 * 0037 * NO. OF PAGES ------------ 0038 * 0039 * REVISIONS 0040 * 0041 * REV. D ECO 5249 0042 * REV. C ECO 3824 10-31-66 0043 * REV. B ECO 3476 09-19-66 0044 * REV. A 06-08-66 0045 * 0046 * AUTHOR 0047 * 0048 * HONEYWELL. INC. - COMPUTER CONTROL DIVISION 0049 * 0050 *
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 2
0051 * PURPOSE 0052 * 0053 * THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV 0054 * PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE 0055 * DDP-116 OR DDP-516. 0056 * 0057 * 0058 * RESTRICTIONS 0059 * 0060 * MINIMUM 8K CORE STORAGE 0061 * 0062 * 0063 * STORAGE 0064 * 0065 * 6682 (DECIMAL) 0066 * 15034 (OCTAL) 0067 * 0068 * 0069 * USE 0070 * 0071 * 0072 * ******************************** 0073 * 0074 * *FORTRAN-IV OPERATING PROCEDURE* 0075 * ******************************** 0076 * 0077 * 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE' 0078 * (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES 0079 * 0080 * 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE 0081 * SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE 0082 * SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START. 0083 * 0084 * 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY)..... 0085 * 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS 0086 * OPTION IS USED WHEN COMPILING THOSE PARTS OF THE 0087 * LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE 0088 * LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO 0089 * GENERATE SPECIAL CODING. 0090 * 0091 * 2-7....NOT ASSIGNED 0092 * 0093 * 8-10...INPUT DEVICE SELECTION 0094 * 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER) 0095 * 2 = NCR CARD READER 0096 * 3 = DIGITRONICS PAPER TAPE READER 0097 * 4 = MAGNETIC TAPE ( UNIT 1 ) 0098 * 5-7 = (SPARES) 0099 * 0100 * 11-13..SYMBOLIC LISTING SELECTION
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 3
0101 * 0. SUPPRESS ALL SYMBOLIC LISTINGS 0102 * 1. ASR-33/35 TYPEWRITER 0103 * 2. LINE PRINTER 0104 * 3 = ( SPARE ) 0105 * 4 = LISTING ON MAGNETIC TAPE UNIT 2 0106 * 5-7 = (SPARES) 0107 * 0108 * 14-16..BINARY OUTPUT SELECTION 0109 * 0. SUPPRESS BINARY OUTPUT. 0110 * 1. BRPE HIGH SPEED PAPER TAPE PUNCH 0111 * 2. ASR BINARY OUTPUT ASR/33 0112 * 3. ASR BINARY OUTPUT ASR/35 0113 * 4 = MAGNETIC TAPE OUTPUT 0114 * 5-7 (SPARES) 0115 * 0116 * 0117 * 4. SENSE SWITCH SETTINGS AND MEANINGS....... 0118 * 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE 0119 * SIDE-BY-SIDE OCTAL INFORMATION. 0120 * 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET). 0121 * 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING 0122 * THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT 0123 * STATUS OF THE I/O KEYBOARD, IT MAY BE 0124 * CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING 0125 * SSW-3 AND PRESSING START TO CONTINUE. 0126 * 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED 0127 * IN THE OBJECT CODING BEING GENERATED REGARDLESS OF 0128 * ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR 0129 * OVERRIDE). 0130 * 0131 * 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER 0132 * AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A 0133 * LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF 0134 * TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE 0135 * PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START' 0136 * TO PROCESS THE NEXT PROGRAM (BATCH COMPILING). 0137 * 0138 * FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS 0139 * PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT 0140 * THE COMPILATION. 0141 * 0142 * 0143 * ERRORS 0144 * 0145 * THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A 0146 * SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION. 0147 * ************************* 0148 * *DATA POOL ENTRY FORMATS* 0149 * ************************* 0150 *
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 4
0151 * THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION 0152 * 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS 0153 * AT THE END OF THE COMPILER AND EXTENDS TOWARD THE 0154 * END OF MEMORY. 0155 * 0156 * TDCCCCCCCCCCCCCC....DP(A+4) 0157 * CCCCCCCCCCCCCCCC....DP(A+3) 0158 * CCCCCCCCCCCCCCCC....DP(A+2) 0159 * IIAAAAAAAAAAAAAA....DP(A+1) 0160 * NRRRMMMLLLLLLLLL....DP(A) 0161 * 0162 * T = TRACE TAG 0163 * D = DATA TAG 0164 * C = SIX 8-BIT CHAR. OR BINARY CONSTANT 0165 * I = ITEM USAGE (IU) 0166 * 0 = NO USAGE 2 = VAR/CONSTAN^ 0167 * 1 = SUBPROGRAM 3 = ARRAY 0168 * A = ASSIGNMENT ADDRESS 0169 * N = NAME TAG (NT) 0170 * 0 = NAME 1 = CONSTANT 0171 * R = ADDRESS TYPE (AT) 0172 * 0 = ABSOLUTE 3 = STRING-REL 0173 * 1 = RELATIVE 4 = COMMON 0174 * 2 = STRING-ABS 5 = DUMMT 0175 * M = ITEM MODE (IM) 0176 * 1 = INTEGER 5 = COMPLEX 0177 * 2 = REAL 6 = DOUBLE 0178 * 3 = LOGICAL 0179 * 4=COM/EQU LINK 0180 * 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT 0181 * TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT 0182 * A DO-LOOP, EACH ENTRY IS 5 WORDS. 0183 * 00IIIIIIIIIIIII 0184 * 00TTTITTTTTTTTT 0185 * 00XXXXXXXXXXXXX 0186 * 00UUUUUUUUUUUUUU 0187 * 00NNNNNNNNNNNNNN 0188 * I = INITIAL VALUE/OR RPL 0189 * T = TERMINAL VALUE 0190 * X = INDEX 0191 * U = INCREMENT 0192 * N = STATEMENT NUMBER 0193 * 0194 * 3. THE EXPRESSION TABLE (A0I TABLE) 'FLOATS' ON TOP 0195 * THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES. 0196 * 0197 * NOOOOOOOOIIIIIII.....DP(I+1) 0198 * 00AAAAAAAAAAAAAAAA...DP(I) 0199 * N = NEGATION INDICATOR 0200 * O = OPERATOR
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 5
0201 * I = INDEX (OPERATOR LEVEL) 0202 * A = ASSIGNMENT TABLE REFERENCE 0203 * 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND 0204 * IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE 0205 * COMPILER. EACH ENTRY IS THREE WORDS LONG. 0206 * 0207 * S000000000PPPPPP.....DP(L+2) 0208 * 0011111111111111.....DP(L+1) 0209 * 0022222222222222.....DP(L) 0210 * S = TEMP STORAGE INDICATOR 0211 * P = OPERATOR 0212 * 1 = FIRST OPERAND ADDRESS 0213 * 2 = SECOND OPERAND ADDRESS 0214 ABS 0215 ORG '100 0216 * 0217 * ************************************ 0218 * * DIRECTORY OF FORTRAN IV COMPILER * 0219 * ************************************ 0220 * 0221 * 0222 * 0223 *..............ENTRANCE GROUP 0224 00100 0 011101 DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE 0225 00101 0 015400 DAC DP DATA POOL START 0226 * 0227 *..............INPUT GROUP 0228 00102 0 001066 DAC IC00 (IPG1) INPUT COLUMN 0229 00103 0 001251 DAC UC00 (IPG2) UNINPUT COLUMN 0230 00104 0 001256 DAC CH00 (IPG3) INPUT CHARACTER 0231 00105 0 001342 DAC ID00 (IPG4) INPUT DIGIT 0232 00106 0 001355 DAC IA00 (IPG5) INPUT (A) CHARACTERS 0233 00107 0 001412 DAC FN00 (IPG6) FINISH OPERATOR 0234 00110 0 001521 DAC DN00 (IPG7) INPUT DNA 0235 00111 0 002354 DAC II00 (IPG8) INPUT ITEM 0236 00112 0 002363 DAC OP00 (IPG9) INPUT OPERAND 0237 00113 0 002373 DAC NA00 (IPG10) INPUT NAME 0238 00114 0 002404 DAC IG00 (IPG11) INPUT INTEGER 0239 00115 0 002432 DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT 0240 00116 0 002437 DAC IR00 (IPG13) INPUT INTEGER VARIABLE 0241 00117 0 002443 DAC IS00 (IPG14) INPUT STATEMENT NUMBER 0242 00120 0 002525 DAC XN00 (IPG15) EXAMINE NEXT CHARACTER 0243 00121 0 002520 DAC SY00 INPUT STMBOL 0244 * 0245 *..............TEST GROUP 0246 00122 0 002547 DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R) 0247 00123 0 002555 DAC IP00 (TSG2) )-INPUT OPERATOR 0248 00124 0 004266 DAC A1 (TSG3) C/R TEST 0249 00125 0 002567 DAC B1 (TSG4) , OR C/R TEST 0250 00126 0 002603 DAC NU00 (TSG5) NO USAGE TEST
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 6
0251 00127 0 002611 DAC NC00 (TSG6) NON CONSTANT TEST 0252 00130 0 002617 DAC NS00 (TSG7) NON SUBPROGRAM TEST 0253 00131 0 002626 DAC AT00 (TSG8) ARRAY TEST 0254 00132 0 002635 DAC IT00 (TSG9) INTEGER TEST 0255 00133 0 002574 DAC NR00 (TSG10) NON REL TEST 0256 * 0257 *..............ASSIGNMENT GROUP 0258 00134 0 003241 DAC AS00 (ASG1) ASSIGN ITEM 0259 00135 0 003465 DAC TG00 (ASG2) TAG SUBPROGRAM 0260 00136 0 003642 DAC TV00 (ASG3) TAG VARIABLE 0261 00137 0 003656 DAC FA00 (ASG4) FETCH ASSIGN 0262 00140 0 003770 DAC FL00 (ASG5) FETCH LINK 0263 00141 0 004005 DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION 0264 00142 0 004026 DAC DM00 (ASG7) DEFINE IM 0265 00143 0 004041 DAC DA00 (ASG8) DEFINE AF 0266 00144 0 004214 DAC AF00 (ASG9) DEFINE AFT 0267 00145 0 004233 DAC LO00 (ASG10) DEFINE LOCATION 0268 00146 0 004241 DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT 0269 00147 0 004252 DAC AA00 (ASG12) ASSIGN SPECIAL 0270 00150 0 004062 DAC NXT GET NEXT ENTRY FROM ASSGN TABLE 0271 00151 0 004142 DAC BUD BUILD ASSIGNMENT TABLE ENTRT 0272 * 0273 *..............CONTROL GROUP 0274 00152 0 004262 DAC B6 (CNG1) JUMP 0275 00153 0 004264 DAC C5 ILL TERM 0276 00154 0 004271 DAC C6 (CNG2) CONTINUE 0277 00155 0 004353 DAC C7 (CNG3) STATEMENT INPUT 0278 00156 0 004456 DAC C8 (CNG4) STATEMENT SCAN 0279 00157 0 004602 DAC A9 (CNG5) STATEMENT IDENTIFICATION 0280 00160 0 005074 DAC NP00 (CNG6) FIRST NON-SPEC CHECK 0281 * 0282 *..............SPECIFICATIONS GROUP 0283 00161 0 010624 DAC EL00 (SPG1) EXCHANGE LINKS 0284 00162 0 010650 DAC NM00 (SPG2) NON COMM0N TEST 0285 00163 0 010657 DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST 0286 00164 0 010672 DAC SC00 (SPG4) INPUT SUBSCRIPT 0287 00165 0 010761 DAC IL00 (SPG5) INPUT LIST ELEMENT 0288 00166 0 011042 DAC R1 (SPG6) FUNCTION 0289 00167 0 011044 DAC R2 SUBROUTINE 0290 00170 0 011101 DAC A3 (SPG7) INTEGER 0291 00171 0 011103 DAC A4 REAL 0292 00172 0 011105 DAC A5 DOUBLE PRECISION 0293 00173 0 011107 DAC A6 COMPLEX 0294 00174 0 011111 DAC A7 LOGICAL 0295 00175 0 011145 DAC B2 (SPG8) EXTERNAL 0296 00176 0 011154 DAC B3 (SPG9) DIMENSION 0297 00177 0 011246 DAC B7 INPUT DIMENSION 0298 00200 0 011253 DAC B4 (SPG10) COMMON 0299 00201 0 011335 DAC B5 (SPG11) EQUIVALENCE 0300 00202 0 011375 DAC C2 (SPG12) RELATE COMMON ITEMS
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 7
0301 00203 0 011442 DAC C3 (SPG13) GROUP EOUIVALENCE 0302 00204 0 011715 DAC C4 (SPG14) ASSIGN SPECIFICATIONS 0303 00205 0 011762 DAC W4 (SPG15) DATA 0304 00206 0 012303 DAC R3 (SPG16) BLOCK DATA 0305 00207 0 012313 DAC TRAC (SPG17) TRACE 0306 * 0307 *..............PROCESSOR GROUP 0308 00210 0 005210 DAC V3 (PRG1) IF 0309 00211 0 005334 DAC R7 (PRG2) GO TO 0310 00212 0 005414 DAC IB00 INPUT BRANCH LIST 0311 00213 0 005443 DAC W3 (PRG3) ASSIGN 0312 00214 0 005510 DAC C9 (PRG5) DO 0313 00215 0 005533 DAC V7 (PRG6) END FILE 0314 00216 0 005526 DAC V6 BACKSPACE 0315 00217 0 005535 DAC V8 REWIND 0316 00220 0 005543 DAC V5 (PRG7) READ 0317 00221 0 005552 DAC V4 WRITE 0318 00222 0 005771 DAC V2 (PRG8) FORMAT 0319 00223 0 006160 DAC SI00 INPUT FORMAT STRING 0320 00224 0 006153 DAC IN00 INPUT NUMERIC FORMAT STRING 0321 00225 0 006145 DAC NZ00 NON ZERO STRING TEST 0322 00226 0 006274 DAC W8 (PRG9) PAUSE 0323 00227 0 006233 DAC W7 STOP 0324 00230 0 006301 DAC R8 (PRG10) CALL 0325 00231 0 006321 DAC G2 ASSIGNMENT STATEMENT 0326 00232 0 006330 DAC R9 (PRG11) RETURN 0327 00233 0 006367 DAC G1 (PRG12) STATEMENT FUNCTION 0328 00234 0 006444 DAC W5 (PRG13) END 0329 * 0330 *..............PROCESSOR SUBROUTINES GROUP 0331 00235 0 006660 DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK 0332 00236 0 006664 DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING 0333 00237 0 006702 DAC DP00 (PSG3) DO INPUT 0334 00240 0 006747 DAC DS00 (PSG4) DO INITIALIZE 0335 00241 0 006773 DAC DQ00 (PSG5) DO TERMINATION 0336 00242 0 007041 DAC EX00 (PSG6) EXPRESSION 0337 00243 0 010040 DAC CA00 (PSG7) SCAN 0338 00244 0 010335 DAC ST00 TRIAD SEARCH 0339 00245 0 010404 DAC TC00 TEMP STORE CHECK 0340 00246 0 010436 DAC ET00 (PSG8) ENTER TRIAD 0341 00247 0 010525 DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE 0342 * 0343 *..............OUTPUT GROUP 0344 00250 0 012330 DAC OL00 (OPG1) OUTPUT OBJECT LINK 0345 00251 0 012337 DAC OI00 (OPG2) OUTPUT I/O LINK 0346 00252 0 012363 DAC CN00 (OPG3) CALL NAME 0347 00253 0 012437 DAC OK00 (OPG4) OUTPUT PACK 0348 00254 0 012467 DAC OB00 (OPG5) OUTPUT OA 0349 00255 0 012700 DAC OT00 (OPG6) OUTPUT TRIADS 0350 00256 0 013147 DAC OM00 (OPG7) OUTPUT ITEM
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 8
0351 00257 0 013773 DAC OR00 (OPG8) OUTPUT REL 0352 00260 0 014127 DAC OA00 OUTPUT ABS 0353 00261 0 014135 DAC OS00 OUTPUT STRING 0354 00262 0 014365 DAC OW00 (OPG9) OUTPUT WORD 0355 00263 0 014465 DAC PU00 PICKUP 0356 00264 0 014523 DAC FS00 (OPG10) FLUSH 0357 00265 0 013663 DAC TRSE (OPG11) OUTPUT TRACE COUPLING 0358 00266 0 014301 DAC PRSP SET BUFFER TO SPACES 0359 * 0360 *..............MISC. GROUP 0361 00267 0 002653 DAC AD3 ADD TWO 3 WORD INTEGERS 0362 00270 0 002703 DAC IM00 MULTIPLY (A) BY (B) 0363 00271 0 002672 DAC STXA SET A INTO INDEX 0364 00272 0 002676 DAC STXI SET I INTO INDEX 0365 00273 0 002722 DAC NF00 SET FS INTO NAMF 0366 00274 0 002741 DAC BLNK SET AREA TO ZEROS 0367 00275 0 002754 DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE 0368 00276 0 002764 DAC CIB COMPARE IBUF TO A CONSTANT 0369 00277 0 003007 DAC SAV SAVE INDEX IN PUSH-DOWN STACK 0370 00300 0 003016 DAC RST RESET INDEX FROM PUSH-DOWN STACK 0371 00301 0 003055 DAC PACK 0372 00302 0 003116 DAC ER00 ERROR OUTPUT 0373 00303 0 003157 DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.) 0374 00304 0 003202 DAC SFT SHIFT LEFT 1 (TRIPLE PRES.) 0375 00305 0 003227 DAC LIST 0376 * 0377 * 0378 * **************************** 0379 * *CONSTANT AND VARIABLE POOL* 0380 * **************************** 0381 * 0382 000000 XR EQU 0 INDEX REGISTER 0383 * THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING 0384 * PROGRAM INITIALIZATION 0385 000040 A EQU '40 ASSIGNMENT TABLE INDEX 0386 000041 I EQU A+1 EXPRESSION TABLE INDEX 0387 000042 C EQU A+2 0388 000043 ASAV EQU A+3 0389 000044 L EQU A+4 0390 000045 MFL EQU A+5 MODE FLAG 0391 000046 SFF EQU A+6 FUNCTION FLAG 0392 000047 SBF EQU A+7 SUBFUNCTION FLAG 0393 000050 SXF EQU A+8 POSSIBLE CPX FLAG 0394 000051 SPF EQU A+9 PEC. FLAG 0395 000052 TCF EQU A+10 TEMP STORE COUNT 0396 000053 IFF EQU A+11 0397 000054 ABAR EQU A+12 BASE OF ASSIGN TABLE 0398 000055 XST EQU A+13 FIRST EXECUTABLE STMNT. 0399 000056 CFL EQU A+14 MON FLAG 0400 000057 D EQU A+15 DO INDEX
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 9
0401 000060 RPL EQU A+16 RELATE PROGRAM LOCATION 0402 000061 BDF EQU A+17 LOCK DATA FLAG 0403 000062 SLST EQU A+18 SOURCE LIST 0404 000063 OBLS EQU A+19 OUTPUT BINARY LIST 0405 000064 BNOT EQU A+20 BINART OUTPUT FLAG 0406 000065 TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.) 0407 000066 TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN 0408 * AN EXPRESSION (FOR USE BY TRACE). 0409 000067 SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET) 0410 000070 LIF EQU A+24 LOGICAL IF FLAG 0411 000071 LSTN EQU A+25 LAST STATEMENT NO. 0412 000072 LSTF EQU A+26 LAST STATEMENT FLAG 0413 000073 LSTP EQU A+27 LAST STATEMENT STOP 0414 000074 SDSW EQU A+28 STATEMENT I0 SWITCH 0415 * 0416 000570 NAMF EQU '570 NAME FUNCTION 0417 000571 ND EQU NAMF+1 NO OF DIMENSIONS 0418 000572 NS EQU '572 NO OF SUBSCRIPTS 0419 000573 NT EQU NS+1 NAME TAG 0420 000574 NTF EQU NS+2 NAME TAG FLAG 0421 000575 NTID EQU NS+3 NO. WORDS IN TID 0422 000576 O1 EQU NS+4 OPERATOR 1 0423 000577 O2 EQU NS+5 OPERATOR 2 0424 000600 P EQU NS+6 0425 000601 PCNT EQU NS+7 0426 000602 OCNT EQU NS+8 OUTPUT COUNT 0427 000603 S0 EQU NS+9 0428 000604 S1 EQU NS+10 SUBSCRIPT NO.1 0429 000605 S2 EQU NS+11 SUBSCRIPT NO.2 0430 000606 S3 EQU NS+12 SUBSCRIPT NO.3 0431 000607 TC EQU NS+13 TERMINAL CHAR 0432 000610 TT EQU NS+14 0433 000611 TYPE EQU NS+15 0434 000612 X EQU NS+16 ARRAY INDICES 0435 000613 X1 EQU NS+17 0436 000614 X2 EQU NS+18 0437 000615 X3 EQU NS+19 0438 000616 X4 EQU NS+20 0439 000617 NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS 0440 000620 ATA EQU NS+22 0441 000621 IMA EQU NS+23 0442 000622 CLA EQU NS+24 0443 000623 IUA EQU NS+25 0444 000624 DTA EQU NS+26 0445 000625 TTA EQU NS+27 0446 *..........ADJUST THIS ORG IF THE SIZE OF THE CONSTAST POOL IS MODIFIED 0447 ORG '630 0448 00630 0 00 00000 AF PZE 0 ADDRESS FIELD 0449 000630 GF EQU AF 0450 00631 0 00 00000 AT PZE 0 ADDRESS TYPE
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 10
0451 00632 0 00 00000 CODE PZE 0 OUTPUT CODE 0452 00633 0 00 00000 D0 PZE 0 DIMENSIONS 0453 00634 0 00 00000 D1 PZE 0 0454 00635 0 00 00000 D2 PZE 0 0455 00636 0 00 00000 D3 PZE 0 0456 00637 0 00 00000 D4 PZE 0 0457 00640 0 00 00000 DF PZE 0 DATA FLAG 0458 00641 0 00 00000 NF PZE 0 0459 00642 0 00 00000 B PZE 0 0460 00643 0 00 00000 DFL PZE 0 DELIMITER FLAG 0461 00644 000000 E OCT 0 EQUIVALENCE INDEX 0462 00645 0 00 00000 EP PZE 0 E-PRIME 0463 00646 0 00 00000 E0 PZE 0 E-ZERO 0464 00647 0 00 00000 FTOP PZE 0 OUTPUT COMMAND 0465 00650 0 00 00000 GFA PZE 0 0466 00651 0 00 00001 ICSW PZE 1 INPUT CONTROL SWITCH 0467 00652 0 00 00000 IFLG PZE 0 I-FLAG 0468 00653 0 00 00000 IM PZE 0 ITEM MODE 0469 00654 0 00 00000 IOF PZE 0 I-0 FLAG 0470 00655 0 00 00000 IU PZE 0 ITEM USAGE 0471 00656 0 00 00000 KBAR PZE 0 TEM STORE 0472 00657 0 00 00000 KPRM PZE 0 TEM STORE 0473 00660 177777 EBAR OCT -1 E-BAR 0474 00661 000017 DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT) 0475 00662 0 00 00111 CC PZE '111 CARD COLUMN COUNTER 0476 00663 0 00 00000 DCT PZE 0 DUMMY ARGUMENT COUNT 0477 00664 0 00 00000 F PZE 0 TRIAD TABLE INDEX 0478 00665 0 00 00000 CL PZE 0 ASSIGNMENT ITEMS UNPACKED 0479 00666 0 00 00000 DT PZE 0 0480 00667 0 00 00000 FLT1 PZE 0 FETCH LINK CL POINTER LOCATION 0481 00670 0 00 00000 LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET) 0482 *..........CONSTANTS USED BY THE COMPILER 0483 00671 000251 K4 OCT 251 0) 0484 00672 000254 K5 OCT 254 0, 0485 00673 000240 K8 OCT 240 0-SPACE 0486 00674 000257 K9 OCT 257 0/ 0487 00675 000256 K10 OCT 256 0. 0488 00676 000255 K12 OCT 255 0- 0489 00677 000253 K13 OCT 253 0+ 0490 00700 000244 K15 OCT 244 0$ 0491 00701 000016 K16X OCT 16 0492 00702 000250 K17 OCT 250 0( 0493 00703 000275 K18 OCT 275 0= 0494 00704 142317 K19 BCI 1,DO DO 0495 00705 000324 K34 OCT 324 0T 0496 00706 000317 K35 OCT 317 0O 0497 00707 153716 K40 BCI 1,WN 0498 00710 151316 K41 BCI 1,RN RN 0499 00711 141702 K42 BCI 1,CB 0500 00712 000311 K43 OCT 311 0I
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 11
0501 00713 000321 K44 OCT 321 0Q 0502 000705 K45 EQU K34 0T 0503 00714 000252 K57 OCT 252 0* 0504 00715 000260 K60 OCT 260 00 (BCI ZERO) 0505 00716 000271 K61 OCT 271 09 0506 000704 K68 EQU K19 0507 00717 000001 K101 OCT 1 0508 00720 000002 K102 OCT 2 0509 00721 000003 K103 OCT 3 0510 00722 000004 K104 OCT 4 0511 00723 000005 K105 OCT 5 0512 00724 000006 K106 OCT 6 0513 00725 000007 K107 OCT 7 0514 00726 000020 K109 DEC 16 0515 00727 000377 K100 OCT 377 0516 00730 037777 K111 OCT 37777 0517 00731 177757 K110 DEC -17 0518 00732 170777 K115 OCT 170777 0519 00733 177400 K116 OCT 177400 0520 00734 177745 K117 DEC -27 0521 00735 000777 K118 OCT 777 0522 00736 177000 K119 OCT 177000 0523 00737 177761 K120 DEC -15 0524 00740 040000 K122 OCT 040000 0525 00741 177777 K123 DEC -1 0526 00742 000011 K124 DEC 9 0527 00743 000010 K125 DEC 8 0528 00744 000012 K126 DEC 10 0529 00745 000013 K127 DEC 11 0530 00746 000014 K128 DEC 12 0531 00747 000015 K129 DEC 13 0532 00750 177762 K131 DEC -14 0533 00751 000022 K132 OCT 22 0534 00752 000017 K134 OCT 17 0535 00753 024002 K137 OCT 24002 0536 00754 000025 K138 OCT 25 0537 00755 000024 K139 OCT 24 0538 00756 000215 CRET OCT 215 0 C/R 0539 00757 000000 ZERO OCT 0 0540 00760 140000 HBIT OCT 140000 HIGH BITS FOR ALPHA DATA 0541 00761 142721 KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT 0542 00762 177776 MIN2 DEC -2 -2 0543 00763 000340 HC2 OCT 340 0544 00764 000357 K357 OCT 357 0545 * 0546 * 0547 015400 DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET 0548 * BY THE FORTRAN IOS SUBROUTINE.) 0549 000113 L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS) 0550 * THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 12
0551 * TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS 0552 * 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL 0553 * CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL 0554 * LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER 0555 * CONFIGURATION. 0556 ORG '1000 0557 01000 1 00 15374 PZE DP-4,1 (100) 0558 01001 1 00 15375 PZE DP-3,1 (101) DATA POOL REFERENCES 0559 01002 1 00 15376 PZE DP-2,1 (102) 0560 01003 1 00 15377 PZE DP-1,1 (103) 0561 01004 1 00 15400 PZE DP,1 (104) 0562 01005 1 00 15401 PZE DP+1,1 (105) 0563 01006 1 00 15402 PZE DP+2,1 (106) 0564 01007 1 00 15403 PZE DP+3,1 (107) 0565 01010 1 00 15404 PZE DP+4,1 (108) 0566 01011 1 00 15411 PZE DP+9,1 (111) 0567 01012 1 00 15406 PZE DP+6,1 (112) 0568 01013 0 00 15407 PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS 0569 * 0570 * 0571 ORG 1 0572 00001 0 10 03116 JST ER00 THIS INSTRUCTION REACHED ONLY IF THE 0573 00002 141707 BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE. 0574 * 0575 * 0576 * 0577 * 0578 * ******************* 0579 * *START OF COMPILER* 0580 * ******************* 0581 * 0582 ORG '1000 0583 * 0584 * 0585 * 0586 * - A0 COMP ENT EMPTY BUFFERS 0587 01000 0400 61 LRL 15 0588 01001 0 04 00670 STA LIBF SET SPECIAL LIBRARY FLAG 0589 01002 0410 61 LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS) 0590 01003 0 10 00000 A0 CALL F4$INT INITIALIZE I/O DEVICES 0591 01004 0 02 01153 LDA K108 0592 01005 0 04 00662 STA CC CC = 73 0593 01006 0 10 01066 JST IC00 INPUT COLUMN 0594 01007 0 02 01063 A051 LDA A090 0595 01010 0 04 00000 STA XR 0596 01011 0 02 01065 LDA A092 LOC, OF INDEX PUSH-DOWN BUFFER 0597 01012 0 04 03030 STA SAV9 INITIALIZE PUSH-DOWN BUFR, 0598 01013 140040 CRA 0599 01014 1 04 00076 STA A+M,1 SET M VARIABLES TO ZERO 0600 01015 1 04 00626 STA NAMF+M,1
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 13
0601 01016 0 12 00000 IRS XR 0602 01017 0 01 01014 JMP *-3 0603 01020 0 04 00652 STA IFLG 0604 01021 0 04 12435 STA PKF 0605 01022 0 10 14523 JST FS00 INITIALIZE OUTPUT BUFFER 0606 01023 140401 CMA 0607 01024 0 04 00072 STA LSTF LSTF NOT EQ 0 0608 01025 0 04 00073 STA LSTP LSTP NOT EQ 0 0609 01026 0 04 00660 STA EBAR EBAR SET NEGATIVE 0610 01027 0 02 00113 LDA L0 0611 01030 0 04 00651 STA ICSW 0612 01031 0 04 00646 STA E0 INITIALIZE EQUIVALENCE TABLE 0613 01032 0 04 00044 STA L INITIALIZE TRIAD TABLE POINTER 0614 01033 0 10 14301 JST PRSP SET PRINT BUFFER TO SPACES 0615 01034 0 02 00752 LDA K134 0616 01035 0 04 00661 STA DO INITIALIZE DO TABLE POINTER 0617 01036 0 07 00754 SUB K138 0618 01037 0 04 01064 STA A091 0619 01040 140040 CRA 0620 01041 0 04 01475 STA ID 0621 01042 0 12 01475 A055 IRS ID ESTABLISH CONSTANTS 0622 01043 0 10 04241 JST AI00 0623 01044 0 12 01064 IRS A091 0624 01045 0 01 01042 JMP A055 0625 01046 0 02 02731 LDA K81 0626 01047 0 04 01475 STA ID 0627 01050 0 04 01476 STA ID+1 0628 01051 0 04 01477 STA ID+2 0629 01052 140040 CRA 0630 01053 0400 40 LRL 32 (B)=0 IM=NO USAGE 0631 01054 0 02 00717 LDA K101 (A)=1 IU=SUBR 0632 01055 0 10 04252 JST AA00 ASSIGN (SPECIAL) 0633 01056 0 10 02672 JST STXA SET POINTER A INTO INDEX AND (A) 0634 01057 0 04 00056 STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK) 0635 01060 0 06 00740 ADD K122 ='40000 (IU=SUBR) 0636 01061 1 04 15401 STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFI 0637 01062 0 01 04353 JMP C7 GO TO STMNT INPUT 0638 000036 M EQU 30 0639 01063 -1 177742 A090 DAC* -M,1 0640 01064 0 00 00000 A091 PZE 0 0641 01065 0 003031 A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER 0642 * 0643 * 0644 * 0645 * ************** 0646 * *INPUT COLUMN* 0647 * ************** 0648 * 0649 * INPUT NEXT CHARACTER 0650 * IGNORE BLANKS
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 14
0651 * CHECK FOR COMMENTS 0652 * IC02 SET AS FOLLOWS - 0653 * NORMAL - ICIP 0654 * INITIAL SCAN -ICSR 0655 01066 0 000000 IC00 DAC ** LINK STORE 0656 01067 0 10 03007 JST SAV SAVE INDEX 0657 01070 0 02 00662 LDA CC IF CC = 73, GO TO IC 10 0658 01071 0 07 01153 SUB K108 0659 01072 100040 SZE 0660 01073 0 01 01125 JMP IC19 ELSE, GO TO IC 0661 01074 0 02 00651 IC10 LDA ICSW IF ICSW. GO TO IC12 0662 01075 101040 SNZ 0663 01076 0 01 01141 JMP IC24 ELSE, GO TO IC24 0664 01077 0 10 00000 IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE 0665 01100 0 001155 DAC CI 0666 01101 0 02 01155 LDA CI 0667 01102 0404 70 LGR 8 GO 70 IC 14 0668 01103 0 11 01152 CAS K16 =(C) 0669 01104 0 01 01106 JMP *+2 0670 01105 0 01 01150 JMP IC30 COMMENT CARD (IGNORE) 0671 01106 0 07 00700 SUB K15 =($) 0672 01107 101040 SNZ 0673 01110 0 01 01116 JMP IC18 CONTROL CARD (IGNORE COLUMN 6) 0674 01111 0 02 00764 LDA K357 IF CARD COL, SIX IS 0675 01112 0 03 01157 ANA CI+2 ZERO OR BLANK, GO TO IC18 0676 01113 0 07 00673 SUB K8 0677 01114 100040 SZE 0678 01115 0 01 01144 JMP IC26 ELSE, GO TO IC26 0679 01116 0 04 00662 IC18 STA CC CC = 0. 0680 01117 0 02 01157 LDA CI+2 CI(6) = SPECIAL 0681 01120 0 03 00733 ANA K116 0682 01121 0 06 00763 ADD HC2 ='340 0683 01122 0 04 01157 STA CI+2 0684 01123 0 02 00756 LDA CRET 0685 01124 0 01 01135 JMP IC20 TC = C.R. 0686 01125 0 02 00662 IC19 LDA CC TC = CI(CC) 0687 01126 0 07 00717 SUB K101 0688 01127 0404 77 LGR 1 0689 01130 0 04 00000 STA XR 0690 01131 1 02 01155 LDA CI,1 0691 01132 101001 SSC 0692 01133 0404 70 LGR 8 0693 01134 0 03 00727 ANA K100 0694 01135 0 04 00607 IC20 STA TC 0695 01136 0 12 00662 IRS CC CC = CC+1 0696 01137 0 10 03016 IC22 JST RST RESTORE INDEX 0697 01140 -0 01 01066 JMP* IC00 RETURN 0698 01141 0 02 00674 IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN 0699 01142 0 04 00607 STA TC 0700 01143 0 01 01137 JMP IC22 GO TO IC22
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 15
0701 01144 0 10 03227 IC26 JST LIST LIST, CONTINUATION CARD 0702 01145 0 02 00725 LDA K107 CC = 7. IGNORE STATEMENT NO. 0703 01146 0 04 00662 STA CC 0704 01147 0 01 01125 JMP IC19 G0 TO IC19 0705 01150 0 10 03227 IC30 JST LIST PRINT CARD IMAGE 0706 01151 0 01 01077 JMP IC12 READ IN NEW CARD 0707 01152 000303 K16 OCT 303 0C 0708 01153 000111 K108 DEC 73 0709 01154 120240 KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER 0710 01155 CI BSS 40 0711 01225 120240 BCI 20, 01226 120240 01227 120240 01230 120240 01231 120240 01232 120240 01233 120240 01234 120240 01235 120240 01236 120240 01237 120240 01240 120240 01241 120240 01242 120240 01243 120240 01244 120240 01245 120240 01246 120240 01247 120240 01250 120240 0712 * 0713 * 0714 * 0715 * **************** 0716 * *UNINPUT COLUMN* 0717 * **************** 0718 * BACK UP ONE COLUMN 0719 * 0720 01251 0 000000 UC00 DAC ** 0721 01252 0 13 00662 IMA CC CC= CC-1 0722 01253 0 07 00717 SUB K101 RETAIN (A) 0723 01254 0 13 00662 IMA CC 0724 01255 -0 01 01251 JMP* UC00 0725 * 0726 * 0727 * ***************** 0728 * *INPUT CHARACTER* 0729 * ***************** 0730 * INPUT ONE CHARACTER FROM EITHER 0731 * 1, INPUT BUFFER (EBAR POSITIVE) OR
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 16
0732 * 2, EQUIVALENCE BUFFER (EBAR NEGATIVE) 0733 * 0734 01256 0 000000 CH00 DAC ** 0735 01257 0 02 00660 LDA EBAR IF EBAR 7 0, 0736 01260 101400 SMI 0737 01261 0 01 01314 JMP CH10 G0 10 CH10 0738 01262 0 10 01066 CH03 JST IC00 INPUT COLUMN 0739 01263 0 07 00673 SUB K8 IF BLANK, REPEAT 0740 01264 101040 SNZ 0741 01265 0 01 01262 JMP CH03 0742 01266 0 02 00607 LDA TC ELSE, 0743 * 0744 01267 0 11 01341 CH04 CAS CH13 ='301 0745 01270 101000 NOP 0746 01271 0 01 01306 JMP CH06 0747 01272 0 11 00716 CAS K61 ='271 0748 01273 0 01 01303 JMP CH05 0749 01274 101000 NOP 0750 01275 0 11 00700 CAS K15 ='244 0751 01276 0 01 01300 JMP *+2 0752 01277 0 01 01302 JMP CH05-1 0753 01300 0 11 00715 CAS K60 ='260 0754 01301 101000 NOP 0755 01302 140040 CRA ALPHA NUMERIC CHARACTER 0756 01303 0 04 00643 CH05 STA DFL DELIMITER ENTRY 0757 01304 0 02 00607 LDA TC EXIT WITH TC IN A 0758 01305 -0 01 01256 JMP* CH00 0759 01306 0 11 01340 CH06 CAS K63 ='332 0760 01307 0 01 01303 JMP CH05 0761 01310 101000 NOP 0762 01311 0 01 01302 JMP CH05-1 0763 01312 0 04 00643 CH08 STA DFL 0764 01313 -0 01 01256 JMP* CH00 0765 01314 0 02 00644 CH10 LDA E IF E = EBAR 0766 01315 0 11 00660 CAS EBAR 0767 01316 0 01 01320 JMP *+2 0768 01317 0 01 01335 JMP CH12 GO TO CH12 0769 01320 0 04 00000 STA 0 SET E INTO INDEX 0770 01321 0410 60 LLL 16 SET (B) TO ZERO 0771 01322 1 02 15400 LDA DP,1 CURRENT CHARACTER WORD 0772 01323 0412 70 LLR 8 0773 01324 1 04 15400 STA DP,1 SAVE REMAINING CHARACTER IF ANY 0774 01325 000201 IAB 0775 01326 0 04 00607 STA TC TC=LEFTMOST CHARACTER 0776 01327 100040 SZE SKIP IF NEW CHARACTER WORD NEEDED 0777 01330 0 01 01267 JMP CH04 0778 01331 0 02 00644 LDA E E=E-1 0779 01332 0 07 00717 SUB K101 =1 0780 01333 0 04 00644 STA E 0781 01334 0 01 01314 JMP CH10 PICK UP NEXT CHARACTER WORD
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 17
0782 01335 140500 CH12 SSM MAKE E MINUS 0783 01336 0 04 00660 STA EBAR 0784 01337 0 01 11715 JMP C4 GO TO ASSIGN SPEC 0785 01340 000332 K63 OCT 332 0Z 0786 01341 000301 CH13 OCT 301 0787 * 0788 * 0789 * ************* 0790 * *INPUT DIGIT* 0791 * ************* 0792 * A IS ZERO IF NOT DIGIT 0793 * 0794 01342 0 000000 ID00 DAC ** INPUT DIGIT 0795 01343 0 10 01256 JST CH00 INPUT A CHAR 0796 01344 0 11 00716 CAS K61 ='271 (9) 0797 01345 -0 01 01342 JMP* ID00 (A) = TC 0798 01346 0 01 01353 JMP ID10 ELSE, (A) = 0 0799 01347 0 11 00715 CAS K60 RETURN 0800 01350 101000 NOP 0801 01351 0 01 01353 JMP *+2 0802 01352 -0 01 01342 JMP* ID00 0803 01353 140040 ID10 CRA 0804 01354 -0 01 01342 JMP* ID00 0805 * 0806 * 0807 * ********************** 0808 * *INPUT (A) CHARACTERS* 0809 * ********************** 0810 * CHAR COUNT IN XR, TERMINATES WITH EITHER 0811 * 1, CHAR COUNT -1 = ZERO OR 0812 * 2, LAST CHAR IS A DELIMITER 0813 * 0814 01355 0 000000 IA00 DAC ** 0815 01356 140407 TCA SET COUNTER 0816 01357 0 04 01411 STA IA99 0817 01360 0 10 01374 JST IA50 EXCHANGE IBUF AND ID 0818 01361 140040 CRA 0819 01362 0 04 00575 STA NTID NTID = 0 0820 01363 0 10 01256 IA10 JST CH00 INPUT A CHARACTER 0821 01364 0 10 03055 JST PACK 0822 01365 0 02 00643 LDA DFL IF DFL NOT ZERO, 0823 01366 100040 SZE CONTINUE 0824 01367 0 01 01372 JMP IA20 ELSE, 0825 01370 0 12 01411 IRS IA99 TEST COUNTER 0826 01371 0 01 01363 JMP IA10 MORE CHARACTERS TO INPUT 0827 01372 0 10 01374 IA20 JST IA50 EXCHANGE ID AND IBUF 0828 01373 -0 01 01355 JMP* IA00 RETURN 0829 01374 0 000000 IA50 DAC ** EXCHANGE IBUF AND ID 0830 01375 0 10 03007 JST SAV SAVE INDEX 0831 01376 0 02 01410 LDA IA90
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 18
0832 01377 0 04 00000 STA XR 0833 01400 1 02 01504 LDA IBUF+3,1 0834 01401 1 13 01500 IMA ID+3,1 0835 01402 1 04 01504 STA IBUF+3,1 0836 01403 0 12 00000 IRS XR 0837 01404 0 01 01400 JMP *-4 0838 01405 0 10 03016 JST RST RESTORE INDEX 0839 01406 0 02 00575 LDA NTID 0840 01407 -0 01 01374 JMP* IA50 0841 01410 177775 IA90 OCT -3 0842 01411 0 00 00000 IA99 PZE 0 0843 * 0844 * 0845 * ***************** 0846 * *FINISH OPERATOR* 0847 * ***************** 0848 * WRAP UP LOGICAL/RELATIONAL OPERATORS 0849 * 0850 01412 0 000000 FN00 DAC ** 0851 01413 0 02 00643 LDA DFL IF DFL NOT . , 0852 01414 0 04 01501 STA IBUF 0853 01415 0 07 00675 SUB K10 0854 01416 100040 SZE 0855 01417 0 01 01422 JMP FN05 GO TO FN05 0856 01420 0 02 00722 LDA K104 0857 01421 0 10 01355 JST IA00 0858 01422 0 02 00731 FN05 LDA K110 USE TABLE TO CONVERT 0859 01423 0 04 00000 STA XR OPERATOR 0860 01424 1 02 01460 FN10 LDA FN90+17,1 0861 01425 0 11 01501 CAS IBUF 0862 01426 0 01 01430 JMP *+2 0863 01427 0 01 01434 JMP FN20 0864 01430 0 12 00000 IRS XR 0865 01431 0 01 01424 JMP FN10 0866 01432 0 02 00607 LDA TC 0867 01433 -0 01 01412 JMP* FN00 0868 01434 1 02 01477 FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR 0869 01435 0 04 00607 STA TC SET INTO TC 0870 01436 -0 01 01412 JMP* FN00 0871 01437 000253 FN90 OCT 253,255,252,257 +-*/ 01440 000255 01441 000252 01442 000257 0872 01443 147317 BCI 9,NOANORLTLEEQGEGTNE 01444 140716 01445 147722 01446 146324 01447 146305 01450 142721 01451 143705
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 19
01452 143724 01453 147305 0873 01454 000275 OCT 275,254 =, 01455 000254 0874 01456 000001 FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17 01457 000002 01460 000003 01461 000004 01462 000005 01463 000006 01464 000007 01465 000010 01466 000011 01467 000012 01470 000013 01471 000014 01472 000015 01473 000016 01474 000017 0875 * 0876 * 0877 * *********** 0878 * *INPUT DNA* 0879 * *********** 0880 * BASIC INPUT ROUTINE, HANDLES FOLLOWING - 0881 * CONSTANT CONVERSION 0882 * MODE TYPING (CONSTANTS, IMPLIED/VARIABLES) 0883 * ALL OPERATORS (TERMINATE ITEM) 0884 * 0885 01475 ID BSS 4 0886 001475 TID EQU ID TEMP STORE FOR ID 0887 01501 IBUF BSS 3 3-WORD BUF 0888 01504 0 00 00000 TIDN PZE 0 0889 01505 177727 K155 OCT 177727 -41 0890 01506 024000 K156 OCT 024000 1085 0891 01507 007777 K157 OCT 007777 0892 01510 074000 K158 OCT 074000 0893 01511 0 00 00000 F1 PZE 0 SIGN FLAG 0894 01512 0 00 00000 F2 PZE 0 0895 01513 0 00 00000 F3 PZE 0 INPUT EXPONENT 0896 01514 0 00 00000 F4 PZE 0 NO, FRAC. POSITIONS 0897 01515 0 00 00000 F5 PZE 0 TEMP DELIMITER STORE 0898 01516 0 00 00000 F6 PZE 0 0899 01517 0 00 00000 L4 PZE 0 0900 01520 0 00 00000 HOLF PZE 0 HOLLERITH FLAG 0901 01521 0 000000 DN00 DAC ** 0902 01522 140040 DN01 CRA 0903 01523 0 04 01520 STA HOLF SET HOLF =0 0904 01524 0 04 01514 STA F4 F4 = 0 0905 01525 0 04 00655 STA IU
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 20
0906 01526 0 04 00573 STA NT IU=NT=NTID=0 0907 01527 0 04 00575 STA NTID 0908 01530 0 10 02741 JST BLNK CLEAR OUT TID = ID 0909 01531 0 001475 DAC TID 0910 01532 0 10 02741 JST BLNK 0911 01533 0 001511 DAC F1 F1,F2,F3 = 0 0912 01534 140040 DN06 CRA 0913 01535 0 04 00653 STA IM 0914 01536 0 04 02352 STA DNX2 0915 01537 0 10 01342 DN07 JST ID00 INPUT DIGIT 0916 01540 100040 SZE 0917 01541 0 01 01603 JMP DN14 (A) NON-ZERO, G0 T0 DN14 0918 01542 0 02 01477 DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST 0919 01543 0 03 01510 ANA K158 POSITION COUNT IF NECESSARY, 0920 01544 100040 SZE 0921 01545 0 01 01575 JMP SKIP 0922 01546 0 06 00653 ADD IM 0923 01547 0405 77 ARS 1 0924 01550 0 06 01514 ADD F4 F4 = F4+1 IF NO OVERFLOW 0925 01551 0 04 01514 STA F4 AND IM ALREADY SET TO REAL 0926 01552 0 02 00717 LDA K101 0927 01553 0 04 00573 STA NT NT=1 0928 01554 0 06 00717 ADD K101 0929 01555 0 04 00655 STA IU IU = VAR/COD 0930 01556 0 10 03202 JST SFT SHIFT ID LEFT 0931 01557 0 001475 DAC ID 0932 01560 0 10 02754 JST MOV3 MOVE TO TEMP STORE 0933 01561 0 10 03202 JST SFT 0934 01562 0 001475 DAC ID 0935 01563 0 10 03202 JST SFT 0936 01564 0 001475 DAC ID 0937 01565 0 10 02653 JST AD3 ID = 10*ID+TC 0938 01566 0 10 02741 JST BLNK 0939 01567 0 002347 DAC DNX1 0940 01570 0 02 00607 LDA TC 0941 01571 0 07 00715 SUB K60 0942 01572 0 04 02347 STA DNX1 0943 01573 0 10 02653 JST AD3 0944 01574 0 01 01537 JMP DN07 0945 01575 0 02 00762 SKIP LDA MIN2 0946 01576 0 06 00653 ADD IM 0947 01577 0405 77 ARS 1 0948 01600 0 06 01514 ADD F4 0949 01601 0 04 01514 STA F4 0950 01602 0 01 01537 JMP DN07 0951 01603 0 02 00653 DN14 LDA IM IM = REAL 0952 01604 0 07 00720 SUB K102 0953 01605 100040 SZE 0954 01606 0 01 01704 JMP DN50 NO, GO TO DN50 0955 01607 0 02 00675 DN16 LDA K10 YES,
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 21
0956 01610 0 04 01515 DN17 STA F5 F5 = '.' 0957 01611 0 02 00643 LDA DFL IF DFL =0, GO SO DN20 (5) 0958 01612 100040 SZE 0959 01613 0 01 02144 JMP DN90 ELSE GO TO DN90 (9) 0960 01614 0 02 00607 DN20 LDA TC IF TC = D, GO TO DN26 0961 01615 0 07 02543 SUB K11 0962 01616 101040 SNZ 0963 01617 0 01 01660 JMP DN26 0964 01620 0 07 00717 SUB K101 ELSE, IF TC = E, GO TO DN22 0965 01621 101040 SNZ 0966 01622 0 01 01631 JMP DN22 TERMINATOR = E 0967 01623 0 10 01251 JST UC00 0968 01624 0 02 00675 LDA K10 ='256 (,) 0969 01625 0 04 00643 STA DFL SET DELIMITER FLAG 0970 01626 0 02 00717 LDA K101 =1 0971 01627 0 04 00653 STA IM SET ITEM MODE TO INTEGER 0972 01630 0 01 01772 JMP DN67 FINISH OPERATOR AND EXIT 0973 * 0974 01631 0 10 01342 DN22 JST ID00 INPUT DIGIT 0975 01632 101040 SNZ IF (A) = 0, GO TO DN30 0976 01633 0 01 01670 JMP DN30 0977 01634 0 02 00607 LDA TC IF TC = -, GO TO DN28 0978 01635 0 07 00676 SUB K12 0979 01636 101040 SNZ 0980 01637 0 01 01663 JMP DN28 0981 01640 0 06 00720 ADD K102 0982 01641 101040 SNZ 0983 01642 0 01 01665 JMP DN29 0984 01643 0 02 01515 LDA F5 0985 01644 0 04 00643 STA DFL 0986 01645 0 10 01251 JST UC00 UN-INPUT COL 0987 01646 0 10 01412 DN24 JST FN00 FINISH OPERATOR 0988 01647 0 02 00717 DN25 LDA K101 IM = INT 0989 01650 0 04 00653 STA IM 0990 01651 0 02 01476 LDA ID+1 IF ID IS TOO BIG TO 0991 01652 100040 SZE BE AN INTEGER (>L2), 0992 01653 0 01 01776 JMP DN69 GO TO DN69 (20) 0993 01654 0 02 01477 LDA ID+2 0994 01655 100040 SZE 0995 01656 0 01 01776 JMP DN69 0996 01657 0 01 02055 JMP DN84 OTHERWISE, GO TO DN84(12) 0997 01660 0 02 00724 DN26 LDA K106 IM = DBL 0998 01661 0 04 00653 STA IM 0999 01662 0 01 01631 JMP DN22 1000 01663 0 02 00717 DN28 LDA K101 F2 = 1 1001 01664 0 04 01512 STA F2 1002 01665 0 10 01342 DN29 JST ID00 INPUT DIGIT 1003 01666 100040 SZE IF (A) = 0, GO TO DN30 (8.5) 1004 01667 0 01 01776 JMP DN69 ELSE, GO TO DN69 (20) 1005 01670 0 02 01513 DN30 LDA F3 F3 = 10 * F3
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 22
1006 01671 0415 75 ALS 3 1007 01672 0 13 01513 IMA F3 F3 = F3 +TC 1008 01673 0415 77 ALS 1 1009 01674 0 06 01513 ADD F3 1010 01675 0 06 00607 ADD TC INPUT DIGIT 1011 01676 0 07 00715 SUB K60 1012 01677 0 04 01513 STA F3 IF (A) = 0, GO TO DN30 (8.5) 1013 01700 0 10 01342 JST ID00 ELSE, GO TO DN90 (9) 1014 01701 100040 SZE 1015 01702 0 01 02144 JMP DN90 1016 01703 0 01 01670 JMP DN30 1017 01704 0 02 00720 DN50 LDA K102 IM=REA 1018 01705 0 04 00653 STA IM 1019 01706 0 02 00607 LDA TC IF TC = ., GO TO DN54 1020 01707 0 07 00675 SUB K10 1021 01710 101040 SNZ 1022 01711 0 01 01725 JMP DN54 ELSE, 1023 01712 0 02 00573 LDA NT 1024 01713 101040 SNZ IF NT = 0, GO TO DN72 1025 01714 0 01 02005 JMP DN72 1026 01715 0 02 00607 LDA TC IF TC = H, GO TO DN9H (22) 1027 01716 0 07 02544 SUB K14 1028 01717 101040 SNZ 1029 01720 0 01 02301 JMP DN9H 1030 01721 0 02 00643 LDA DFL IF DFL = 0, 1031 01722 100040 SZE GO TO DN16 (4.9) 1032 01723 0 01 01647 JMP DN25 ELSE, GO TO DN25 1033 01724 0 01 01607 JMP DN16 1034 01725 0 10 01342 DN54 JST ID00 INPUT DIGIT 1035 01726 101040 SNZ 1036 01727 0 01 01542 JMP DN10 IF (A) = 0, GO TO DN10 (3) 1037 01730 0 02 00573 LDA NT 1038 01731 101040 SNZ IF NT = 0, GO TO DN56 1039 01732 0 01 01735 JMP DN56 1040 01733 0 02 00607 LDA TC F5 = TC 1041 01734 0 01 01607 JMP DN16 GO TO DN16 (4) 1042 01735 140040 DN56 CRA 1043 01736 0 04 00607 STA TC TC = ) 1044 01737 0 10 01251 DN58 JST UC00 UN-INPUT A COLUMN, 1045 01740 0 02 01511 LDA F1 IF F1 = 0, GO TO DN60 1046 01741 100040 SZE 1047 01742 0 01 01756 JMP DN63 ELSE, GO TO DN63 (15) 1048 01743 0 02 00724 DN60 LDA K106 1049 01744 0 10 01355 JST IA00 INPUT (6) CHARS 1050 01745 0 10 02764 JST CIB IF IBUF = TRUE., 1051 01746 1 002534 DAC K1+3,1 1052 01747 0 01 01761 JMP DN64 1053 01750 0 10 02764 JST CIB IF IBUF = FALSE., 1054 01751 1 002537 DAC K2+3,1 GO TO DN66 (16) 1055 01752 0 01 01763 JMP DN66
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 23
1056 01753 0 10 02764 JST CIB CHECK FOR .NOT. OPERATOR 1057 01754 1 002543 DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR 1058 01755 0 01 02342 JMP DN9N OPERATOR IS .NOT. 1059 01756 140040 DN63 CRA IM = 0 1060 01757 0 04 00653 STA IM 1061 01760 0 01 01772 JMP DN67 GO TO DN67 (18) 1062 01761 0 02 00717 DN64 LDA K101 1063 01762 0 04 01475 STA TID 1064 01763 0 02 00717 DN66 LDA K101 1065 01764 0 04 00573 STA NT NAME TAG = 1 (CONSTANT) 1066 01765 0 02 00720 LDA K102 IU=VAR 1067 01766 0 04 00655 STA IU 1068 01767 0 02 00721 LDA K103 1069 01770 0 04 00653 STA IM IM = LOG 1070 01771 0 10 01256 JST CH00 1071 01772 0 10 01412 DN67 JST FN00 FINISH OPERATOR 1072 01773 0 02 01516 DN68 LDA F6 IF F6 = 0, 1073 01774 101040 SNZ GO TO DN70 (21) 1074 01775 0 01 02000 JMP DN70 1075 01776 0 02 00675 DN69 LDA K10 1076 01777 0 04 00607 STA TC TC = . 1077 02000 140040 DN70 CRA 1078 02001 0 04 01516 STA F6 F6 = SXF = 0 1079 02002 0 04 00050 STA SXF 1080 02003 0 02 00653 LDA IM (A) = IM 1081 02004 -0 01 01521 JMP* DN00 RETURN 1082 02005 0 02 01511 DN72 LDA F1 IF F1 = 0, GO TO DN74 1083 02006 101040 SNZ 1084 02007 0 01 02013 JMP DN74 1085 02010 0 02 01511 LDA F1 ELSE, TC = F1 1086 02011 0 04 00607 STA TC 1087 02012 0 01 01737 JMP DN58 GO TO DN58 (14) 1088 02013 0 02 00607 DN74 LDA TC IF TC = -, GO TO DN82 1089 02014 0 07 00676 SUB K12 1090 02015 101040 SNZ 1091 02016 0 01 02052 JMP DN82 1092 02017 0 06 00720 ADD K102 CHECK FOR TC = + 1093 02020 101040 SNZ 1094 02021 0 01 02052 JMP DN82 1095 02022 0 02 00643 LDA DFL IF DFL = NON-ZERO 1096 02023 100040 SZE 1097 02024 0 01 01756 JMP DN63 GO TO DN63 (15) 1098 02025 0 02 00607 LDA TC 1099 02026 0 11 00712 CAS K43 1100 02027 0 01 02032 JMP *+3 1101 02030 0 01 02035 JMP DN78 1102 02031 0 01 02037 JMP DN80 1103 02032 0 11 02545 CAS K62 1104 02033 0 01 02037 JMP DN80 1105 02034 101000 NOP
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 24
1106 02035 0 02 00717 DN78 LDA K101 IM < INT 1107 02036 0 04 00653 STA IM 1108 02037 0 02 00607 DN80 LDA TC PACK TC TO ID 1109 02040 0 10 03055 JST PACK 1110 02041 0 10 01256 JST CH00 INPUT CHAR 1111 02042 0 02 00643 LDA DFL IF DFL IS NOT ZERO, 1112 02043 100040 SZE GO TO DN67 (18) 1113 02044 0 01 01772 JMP DN67 1114 02045 0 02 00575 LDA NTID IF NTID = 6, GO TO DN67 1115 02046 0 07 00724 SUB K106 1116 02047 100040 SZE 1117 02050 0 01 02037 JMP DN80 1118 02051 0 01 01772 JMP DN67 1119 02052 0 10 01412 DN82 JST FN00 1120 02053 0 04 01511 STA F1 F1 = CONVERTED TC 1121 02054 0 01 01534 JMP DN06 GO TO DN06 (2) 1122 02055 0 02 01511 DN84 LDA F1 IF F1 = -, 1123 02056 0 07 00720 SUB K102 GO TO DN85(13) 1124 02057 100040 SZE 1125 02060 0 01 02100 JMP DN85 1126 02061 140040 CRA 1127 02062 0 07 01475 SUB TID COMPLEMENT THREE WORDS AT TID 1128 02063 100040 SZE 1129 02064 0 01 02071 JMP DN8A 1130 02065 0 07 01476 SUB TID+1 1131 02066 100040 SZE 1132 02067 0 01 02074 JMP DN8B 1133 02070 0 01 02076 JMP DN8C 1134 02071 0 04 01475 DN8A STA TID 1135 02072 0 02 00741 LDA K123 1136 02073 0 07 01476 SUB TID+1 1137 02074 0 04 01476 DN8B STA TID+1 1138 02075 0 02 00741 LDA K123 1139 02076 0 07 01477 DN8C SUB TID+2 1140 02077 0 04 01477 STA TID+2 1141 02100 0 02 00050 DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18) 1142 02101 101040 SNZ 1143 02102 0 01 01772 JMP DN67 ELSE, 1144 02103 0 02 00653 LDA IM IF IM NOT = REA, 1145 02104 0 07 00720 SUB K102 1146 02105 100040 SZE GO TO DN67 (18) 1147 02106 0 01 01772 JMP DN67 1148 02107 0 02 01516 LDA F6 ELSE, 1149 02110 101040 SNZ IF F6 = 0, GO TO DN87 1150 02111 0 01 02127 JMP DN87 1151 02112 0 02 00723 LDA K105 1152 02113 0 04 00653 STA IM IM = CPX 1153 02114 0 02 01475 LDA TID INTERCHANGE 1154 02115 0 13 03637 IMA TIDB 3 CELLS 1155 02116 0 04 01475 STA TID TID
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 25
1156 02117 0 02 01476 LDA TID+1 WITH 1157 02120 0 13 03640 IMA TIDB+1 3 CELLS 1158 02121 0 04 01476 STA TID+1 OF 1159 02122 0 02 01477 LDA TID+2 TIDB 1160 02123 0 13 03641 IMA TIDB+2 1161 02124 0 04 01477 STA TID+2 1162 02125 0 10 02555 JST IP00 )-INPUT OPERATOR 1163 02126 0 01 02000 JMP DN70 GO TO DN70 (21) 1164 02127 0 02 00607 DN87 LDA TC IF TC = , 1165 02130 0 07 00672 SUB K5 1166 02131 100040 SZE 1167 02132 0 01 01772 JMP DN67 TID-BAR = TID 1168 02133 0 02 01475 LDA TID F6 = 1 1169 02134 0 04 03637 STA TIDB GO TO DN01 (1) 1170 02135 0 02 01476 LDA TID+1 1171 02136 0 04 03640 STA TIDB+1 ELSE, GO TO DN67 (18) 1172 02137 0 02 01477 LDA TID+2 1173 02140 0 04 03641 STA TIDB+2 1174 02141 0 02 00717 LDA K101 1175 02142 0 04 01516 STA F6 1176 02143 0 01 01522 JMP DN01 1177 02144 0 02 01512 DN90 LDA F2 IF F2= 0, GO TO DN9A (10) 1178 02145 101040 SNZ 1179 02146 0 01 02152 JMP DN9A 1180 02147 0 02 01513 LDA F3 F3 = - F3 1181 02150 140407 TCA 1182 02151 0 04 01513 STA F3 1183 02152 0 02 01513 DN9A LDA F3 F4 = F3 - F4 1184 02153 0 07 01514 SUB F4 1185 02154 0 04 01514 STA F4 1186 02155 0 02 00676 LDA K12 F2 = EXP, BIAS + MANTISSA 1187 02156 0 04 01512 STA F2 1188 02157 0 02 01475 LDA TID IF TID = 0, 1189 02160 0 06 01476 ADD TID+1 1190 02161 0 06 01477 ADD TID+2 GO TO DN85(13) 1191 02162 101040 SNZ 1192 02163 0 01 02100 JMP DN85 1193 02164 0 02 01477 DN9C LDA TID+2 1194 02165 0414 77 LGL 1 NORMALIZE ID 1195 02166 100400 SPL 1196 02167 0 01 02176 JMP DN9D ID IS NORMALIZED 1197 02170 0 10 03202 JST SFT 1198 02171 0 001475 DAC ID 1199 * F2 = F2 - = SHIFTS 1200 02172 0 02 01512 LDA F2 1201 02173 0 07 00717 SUB K101 1202 02174 0 04 01512 STA F2 1203 02175 0 01 02164 JMP DN9C CONTINUE NORMALIZE LOOP 1204 02176 0 02 01514 DN9D LDA F4 1205 02177 0 11 00757 CAS ZERO
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 26
1206 02200 0 01 02232 JMP DN9E 1207 02201 0 01 02250 JMP DN9G FINISHED E FACTOR LOOP 1208 02202 0 12 01514 IRS F4 1209 02203 101000 NOP F4 = F4 +1 1210 02204 0 02 01505 LDA K155 DIVIDE LOOP COUNTER 1211 02205 0 04 01504 STA TIDN 1212 02206 0 10 03157 JST SRT 1213 02207 0 001475 DAC TID 1214 02210 0 10 03157 JST SRT 1215 02211 0 001475 DAC TID 1216 02212 0 10 03202 DND1 JST SFT 1217 02213 0 001475 DAC TID 1218 02214 0 02 01477 LDA TID+2 1219 02215 0 07 01506 SUB K156 10 AT B=4 1220 02216 101400 SMI 1221 02217 0 04 01477 STA TID+2 1222 02220 101400 SMI 1223 02221 0 12 01475 IRS TID 1224 02222 0 12 01504 IRS TIDN 1225 02223 0 01 02212 JMP DND1 REDUCE DIVIDE COUNTER 1226 02224 0 10 03202 JST SFT 1227 02225 0 001475 DAC TID 1228 02226 0 02 01477 LDA TID+2 1229 02227 0 03 01507 ANA K157 1230 02230 0 04 01477 STA TID+2 1231 02231 0 01 02164 JMP DN9C 1232 02232 0 07 00717 DN9E SUB K101 1233 02233 0 04 01514 STA F4 F4 = F4-1 1234 02234 0 02 01512 LDA F2 F2 = F2+4 1235 02235 0 06 00722 ADD K104 1236 02236 0 04 01512 STA F2 1237 02237 0 10 03157 JST SRT 1238 02240 0 001475 DAC ID 1239 02241 0 10 02754 JST MOV3 1240 02242 0 10 03157 JST SRT ID = ID*10 1241 02243 0 001475 DAC ID 1242 02244 0 10 03157 JST SRT 1243 02245 0 001475 DAC ID 1244 02246 0 10 02653 JST AD3 ADD THREE WORD INTEGERS 1245 02247 0 01 02164 JMP DN9C 1246 * CONVERT THREE WORD INTEGER TO INTERNAL FORMAT 1247 02250 0 02 01477 DN9G LDA TID+2 1248 02251 000201 IAB 1249 02252 0 02 01512 LDA F2 1250 02253 0401 70 LRS 8 1251 02254 101040 SNZ 1252 02255 0 01 02260 JMP *+3 1253 02256 0 10 03116 JST ER00 1254 02257 141705 BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW) 1255 02260 000201 IAB
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 27
1256 02261 0 13 01477 IMA TID+2 1257 02262 000201 IAB 1258 02263 0 02 01476 LDA TID+1 1259 02264 0414 77 LGL 1 1260 02265 0402 70 LRR 8 1261 02266 0 04 01476 STA TID+1 1262 02267 0402 67 LRR 9 1263 02270 0 02 01475 LDA TID PACK UP TRIPLE PRECISION 1264 02271 0414 77 LGL 1 1265 02272 0402 71 LRR 7 REAL CONSTANT 1266 02273 0 04 01475 STA TID 1267 02274 0 02 01512 LDA F2 1268 02275 0404 70 LGR 8 1269 02276 100040 SZE 1270 02277 0 01 01776 JMP DN69 GO TO DN69 (20) 1271 02300 0 01 02055 JMP DN84 ELSE. GO TO DN84 (12) 1272 02301 0 04 00653 DN9H STA IM 1273 02302 0 02 00051 LDA SPF 1274 02303 0 07 00720 SUB K102 1275 02304 100040 SZE 1276 02305 0 02 00724 LDA K106 1277 02306 0 07 00742 SUB K124 1278 02307 0 06 01475 ADD TID 1279 02310 101400 SMI 1280 02311 0 01 02000 JMP DN70 1281 02312 0 02 01475 LDA TID 1282 02313 0 04 01520 STA HOLF HOLF=NO.OF HOLLERITH CHARS, 1283 02314 0 04 01513 STA F3 1284 02315 140407 TCA 1285 02316 101040 SNZ 1286 02317 0 01 02340 JMP DN9K FIELD WIDTH OF ZERO 1287 02320 0 04 01512 STA F2 F2= -1(1 CHAR) OR -2(2 CHAR) 1288 02321 0 10 02741 JST BLNK SET ID,ID+1(ID+2 TO ZERO 1289 02322 0 001475 DAC TID 1290 02323 0 10 01066 DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS) 1291 02324 0 10 03055 JST PACK PACK CHARACTERS 2 PER WORD 1292 02325 0 12 01512 IRS F2 REDUCE CHARACTER COUNT 1293 02326 0 01 02323 JMP DN9J INPUT AND PACK MORE CHARACTERS 1294 02327 0 02 01513 LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT 1295 02330 0 03 00717 ANA K101 1296 02331 101040 SNZ 1297 02332 0 01 02335 JMP *+3 1298 02333 0 02 00673 LDA K8 ='240 (SP) 1299 02334 0 10 03055 JST PACK SHIFT A SPACE INTO THE LAST WORD 1300 02335 0 12 00653 IRS IM 1301 02336 0 10 01256 DN9M JST CH00 INPUT THE TERMINATING CHARACTER 1302 02337 0 01 01772 JMP DN67 FINISH OPERATOR AND EXIT 1303 02340 0 10 03116 DN9K JST ER00 1304 02341 144306 BCI 1,HF 1305 02342 0 02 00723 DN9N LDA K105 SET .NOT. OPERATOR (TC=5)
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 28
1306 02343 0 04 00607 STA TC SET .NOT. OPERATOR (TC=5) 1307 02344 140040 CRA 1308 02345 0 04 00653 STA IM IM=0 = UNDEFINED 1309 02346 0 01 01773 JMP DN68 1310 02347 DNX1 BSS 3 1311 02352 0 000000 DNX2 DAC ** OVERFLOW FLAG 1312 02353 -0 01 02352 JMP* *-1 1313 * 1314 * 1315 * ************ 1316 * *INPUT ITEM* 1317 * ************ 1318 * INPUTS AND ASSIGNS ITEM (IF ONE EXISTS) 1319 * 1320 02354 0 000000 II00 DAC ** 1321 02355 0 10 01521 JST DN00 INPUT DNA 1322 02356 101040 SNZ IF (A) = 0 1323 02357 -0 01 02354 JMP* II00 RETURN 1324 02360 0 10 03241 JST AS00 NO, ASSIGN ITEM 1325 02361 0 02 00653 LDA IM 1326 02362 -0 01 02354 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 02363 0 000000 OP00 DAC ** INPUT OPERAND 1336 02364 0 10 02354 JST II00 INPUT ITEM 1337 02365 100040 SZE IF IM = 0, SKIP 1338 02366 -0 01 02363 JMP* OP00 ELSE (A) = IM, RETURN 1339 02367 0 02 00675 LDA K10 TC = . 1340 02370 0 04 00607 STA TC (A) = 0 1341 02371 140040 CRA 1342 02372 -0 01 02363 JMP* OP00 RETURN 1343 * 1344 * 1345 * ************ 1346 * *INPUT NAME* 1347 * ************ 1348 * INPUT OPERAND AND ENSURE THAT IT IS A NAME 1349 * 1350 02373 0 000000 NA00 DAC ** INPUT NAME 1351 02374 0 10 02363 JST OP00 INPUT OPERAND 1352 02375 0 02 00573 LDA NT IF NT = 1, 1353 02376 101040 SNZ 1354 02377 0 01 02402 JMP NA10 1355 02400 0 10 03116 JST ER00
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 29
1356 02401 0 00 00011 PZE 9 1357 02402 0 02 00653 NA10 LDA IM (A) = IM 1358 02403 -0 01 02373 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 02404 0 000000 IG00 DAC ** INPUT INTEGER 1368 02405 0 10 01521 JST DN00 INPUT - DNA 1369 02406 0 02 01511 LDA F1 1370 02407 100040 SZE IF F1 = 0, 1371 02410 0 01 02430 JMP IG20 AND NT = 1, 1372 02411 0 02 00573 LDA NT AND IM = INT, 1373 02412 101040 SNZ AND TID L2**15, 1374 02413 0 01 02430 JMP IG20 GO TO IG10 1375 02414 0 02 00653 LDA IM LSE, GO TO IG20 1376 02415 0 07 00717 SUB K101 1377 02416 100040 SZE 1378 02417 0 01 02430 JMP IG20 1379 02420 0 02 01476 LDA TID+1 1380 02421 100040 SZE 1381 02422 0 01 02430 JMP IG20 1382 02423 0 02 01477 LDA TID+2 1383 02424 100040 SZE 1384 02425 0 01 02430 JMP IG20 1385 02426 0 02 01475 IG10 LDA TID 1386 02427 -0 01 02404 JMP* IG00 1387 02430 0 10 03116 IG20 JST ER00 ERROR 1388 02431 144716 BCI 1,IN INTEGER REQUIRED 1389 * 1390 * 1391 * *********************** 1392 * *INPUT INTEGER VAR/CON* 1393 * *********************** 1394 * 1395 02432 0 000000 IV00 DAC ** 1396 02433 0 10 02363 JST OP00 INPUT OPERAND 1397 02434 0 10 02635 JST IT00 INTER TEST 1398 02435 0 10 03642 JST TV00 TAG VARIABLE 1399 02436 -0 01 02432 JMP* IV00 EXIT 1400 * 1401 * 1402 * ************************ 1403 * *INPUT INTEGER VARIABLE* 1404 * ************************ 1405 *
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 30
1406 02437 0 000000 IR00 DAC ** INPUT INT VAR 1407 02440 0 10 02432 JST IV00 INPUT INT VAR/CON 1408 02441 0 10 02611 JST NC00 NON-CONSTANT TEST 1409 02442 -0 01 02437 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 02443 0 000000 IS00 DAC ** 1419 02444 140040 IS04 CRA 1420 02445 0 04 00573 STA NT 1421 02446 0 04 00653 STA IM 1422 02447 0 04 00655 STA IU IU = IM = IT = 0 1423 02450 0 04 00575 STA NTID PUT LEADING 'S' IN STATEMENT NO, 1424 02451 0 02 02516 LDA K79 1425 02452 0 10 03055 JST PACK 1426 02453 0 10 01342 IS10 JST ID00 INPUT DIGIT 1427 02454 100040 SZE 1428 02455 0 01 02471 JMP IS20 NOT A DIGIT GO TO IS20 1429 02456 0 02 00575 LDA NTID 1430 02457 0 07 00724 SUB K106 1431 02460 101400 SMI 1432 02461 0 01 02475 JMP IS22 1433 02462 0 02 00607 LDA TC 1434 02463 0 10 03055 JST PACK PACK TC TO ID - LEGAL ST, NO, CHAR 1435 02464 0 02 01475 LDA TID 1436 02465 0 11 02517 CAS K79X 1437 02466 0 01 02453 JMP IS10 1438 02467 0 01 02444 JMP IS04 IGNORE LEAD ZERO ON ST. NO, 1439 02470 0 01 02453 JMP IS10 1440 02471 0 02 00575 IS20 LDA NTID 1441 02472 0 07 00717 SUB K101 1442 02473 101400 SMI 1443 02474 0 01 02477 JMP IS25 1444 02475 0 10 03116 IS22 JST ER00 1445 02476 151724 BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT 1446 02477 0 10 03241 IS25 JST AS00 ASSIGN ITEM 1447 02500 0 10 02672 JST STXA 1448 02501 1 02 15401 LDA DP+1,1 1449 02502 0 03 00730 ANA K111 1450 02503 1 04 15401 STA DP+1,1 IU = 0 1451 02504 0 02 00630 LDA AF ADDRESS FIELD IS 1452 02505 0 11 00055 CAS XST LE XST - ALREADY ASSIGNED 1453 02506 -0 01 02443 JMP* IS00 1454 02507 -0 01 02443 JMP* IS00 OK - OTHERWISE 1455 02510 0 02 00631 LDA AT MUST HAVE STR-ABS OTHERWISE
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 31
1456 02511 0 11 00720 CAS K102 1457 02512 0 01 02514 JMP *+2 1458 02513 -0 01 02443 JMP* IS00 !!! 1459 02514 0 10 03116 JST ER00 1460 02515 151316 BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER 1461 02516 000337 K79 OCT 337 1462 02517 157660 K79X OCT 157660 1463 * 1464 02520 0 000000 SY00 DAC ** INPUT SYMBOL 1465 02521 0 02 00717 LDA K101 1466 02522 0 04 00574 STA NTF NTF NOT 0 - DON'T SET IU IN AS00 1467 02523 0 10 02373 JST NA00 INPUT NAME 1468 02524 -0 01 02520 JMP* SY00 EXIT 1469 * 1470 * ************************ 1471 * *EXAMINE NEXT CHARACTER* 1472 * ************************ 1473 * CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT) 1474 * 1475 02525 0 000000 XN00 DAC ** 1476 02526 0 10 01342 JST ID00 INPUT DIGIT 1477 02527 0 10 01251 JST UC00 UNINPUT COLUMM 1478 02530 -0 01 02525 JMP* XN00 1479 02531 152322 K1 BCI 3,TRUE. 02532 152705 02533 127240 1480 02534 143301 K2 BCI 3,FALSE. 02535 146323 02536 142656 1481 02537 000247 K3 OCT 247 1482 02540 147317 KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST 02541 152256 02542 120240 1483 02543 000304 K11 OCT 304 0D 1484 02544 000310 K14 OCT 310 0H 1485 02545 000316 K62 OCT 316 0N 1486 02546 000336 K64 OCT 336 0) 1487 * 1488 * 1489 * ******************** 1490 * *ALL CHARACTER TEST* 1491 * ******************** 1492 * 1493 02547 0 000000 TS00 DAC ** TEST (A) AGAINST TC 1494 02550 0 07 00607 SUB TC 1495 02551 101040 SNZ 1496 02552 -0 01 02547 JMP* TS00 RETURN 1497 02553 0 10 03116 JST ER00 TO ERROR TEST 1498 02554 141710 BCI 1,CH IMPROPER TERMINATING CHARACTER 1499 *
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 32
1500 * 1501 * ******************* 1502 * *)- INPUT OPERATOR* 1503 * ******************* 1504 * 1505 02555 0 000000 IP00 DAC ** 1506 02556 0 02 00671 LDA K4 TEST - ) 1507 02557 0 10 02547 JST TS00 1508 02560 0 10 01256 JST CH00 INPUT CHAR 1509 02561 0 10 01412 JST FN00 FINISH OPERATOR 1510 02562 0 02 00642 LDA B B = B-16 1511 02563 0 07 00726 SUB K109 1512 02564 0 04 00642 STA B 1513 02565 140040 CRA (A) = 0 1514 02566 -0 01 02555 JMP* IP00 RETURN 1515 * 1516 * 1517 * 1518 * B1 COMMA OR C/R TST 1519 02567 0 02 00752 B1 LDA K134 IF TC = ','(CONVERTED TO 17) 1520 02570 0 07 00607 SUB TC 1521 02571 101040 SNZ 1522 02572 -0 01 04600 JMP* A9T2 GO TO SIDSW 1523 02573 0 01 04266 JMP A1 ELSE, GO TO C/R TEST 1524 * 1525 * 1526 02574 0 000000 NR00 DAC ** NON-REL TEST 1527 02575 0 02 00631 LDA AT 1528 02576 0 07 00717 SUB K101 IF AT = 1 GO TO ERROR- 1529 02577 100040 SZE TEST 1530 02600 -0 01 02574 JMP* NR00 RETURN 1531 02601 0 10 03116 JST ER00 ERROR TEST ROUTINE 1532 02602 146723 BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER 1533 * 1534 * 1535 * *************** 1536 * *NO USAGE TEST* 1537 * *************** 1538 * 1539 02603 0 000000 NU00 DAC ** N0 USAGE TEST 1540 02604 0 02 00655 LDA IU 1541 02605 101040 SNZ IF IU NOT = 0, TO ERROR 1542 02606 -0 01 02603 JMP* NU00 RETURN 1543 02607 0 10 03116 JST ER00 ERROR TEST 1544 02610 147325 BCI 1,NU NAME ALREADY BEING USED 1545 * 1546 * 1547 * ******************* 1548 * *NON-CONSTANT TEST* 1549 * *******************
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 33
1550 * 1551 02611 0 000000 NC00 DAC ** NON CONSTANT TEST 1552 02612 0 02 00573 LDA NT 1553 02613 101040 SNZ IF NT NOT = 0, TO ERROR TEST 1554 02614 -0 01 02611 JMP* NC00 RETURN 1555 02615 0 10 03116 JST ER00 ERROR TEST 1556 02616 147303 BCI 1,NC CONSTANT MUST BE PRESENT 1557 * 1558 * 1559 * ********************* 1560 * *NON SUBPROGRAM TEST* 1561 * ********************* 1562 * 1563 02617 0 000000 NS00 DAC ** NON SUBPROGRAM TEST 1564 02620 0 02 00655 LDA IU 1565 02621 0 07 00717 SUB K101 IF IU = 1, GO TO- 1566 02622 100040 SZE ERROR TEST 1567 02623 -0 01 02617 JMP* NS00 RETURN 1568 02624 0 10 03116 JST ER00 ERROR TEST 1569 02625 147323 BCI 1,NS SUBPROGRAM NAME NOT ALLOWED 1570 * 1571 * 1572 * ********** 1573 * *ARR TEST* 1574 * ********** 1575 * 1576 02626 0 000000 AT00 DAC ** ARRAY TEST 1577 02627 0 02 00655 LDA IU 1578 02630 0 07 00721 SUB K103 IF IU = 3, GO TO 1579 02631 101040 SNZ 1580 02632 -0 01 02626 JMP* AT00 RETURN 1581 02633 0 10 03116 JST ER00 ERROR TEST 1582 02634 140722 BCI 1,AR ITEM NOT AN ARRAY NAME 1583 * 1584 * 1585 * ************** 1586 * *INTEGER TEST* 1587 * ************** 1588 * 1589 02635 0 000000 IT00 DAC ** INTEGER TEST 1590 02636 0 02 00653 LDA IM 1591 02637 0 07 00717 SUB K101 IF IM = 1, GO TO- 1592 02640 101040 SNZ ERROR ROUTINE, ELSE 1593 02641 -0 01 02635 JMP* IT00 RETURN 1594 02642 0 10 03116 JST ER00 TO ERROR TEST 1595 02643 144724 BCI 1,IT ITEM NOT AN INTEGER 1596 * 1597 * 1598 02644 0 000000 TA00 DAC ** 1599 02645 0 02 00631 LDA AT STRING-ABS TEST
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 34
1600 02646 0 07 00720 SUB K102 1601 02647 101040 SNZ 1602 02650 -0 01 02644 JMP* TA00 1603 02651 0 10 03116 JST ER00 1604 02652 147322 BCI 1,NR ITEM NOT A RELATIVE VARIABLE 1605 * 1606 * 1607 * 1608 * 1609 * 1610 * 1611 * 1612 * 1613 02653 0 000000 AD3 DAC ** ADD TWO THREE WORD INTEGERS, 1614 02654 0 02 01475 LDA TID 1615 02655 0 06 02347 ADD DNX1 1616 02656 140320 CSA 1617 02657 0 04 01475 STA TID 1618 02660 0 02 01476 LDA TID+1 1619 02661 141216 ACA 1620 02662 0 06 02350 ADD DNX1+1 1621 02663 140320 CSA 1622 02664 0 04 01476 STA TID+1 1623 02665 0 02 01477 LDA TID+2 1624 02666 141216 ACA 1625 02667 0 06 02351 ADD DNX1+2 1626 02670 0 04 01477 STA TID+2 1627 02671 -0 01 02653 JMP* AD3 1628 * 1629 * 1630 * *********************** 1631 * *ASSIGN INDEX REGISTER* 1632 * *********************** 1633 * 1634 02672 0 000000 STXA DAC ** 1635 02673 0 02 00040 LDA A 1636 02674 0 04 00000 STA 0 1637 02675 -0 01 02672 JMP* STXA 1638 02676 0 000000 STXI DAC ** 1639 02677 0 02 00041 LDA I 1640 02700 0 04 00000 STA 0 1641 02701 -0 01 02676 JMP* STXI 1642 02702 000016 K153 OCT 16 1643 02703 0 000000 IM00 DAC ** 1644 02704 0 04 02720 STA T1IM MULTIPLY A BY B 1645 02705 0 02 00737 LDA K120 =-15 1646 02706 0 04 02721 STA T2IM 1647 02707 140040 CRA 1648 02710 140200 RCB C BIT = 0 1649 02711 0400 77 IM10 LRL 1 LOW BIT OF B INTO C
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 35
1650 02712 100001 SRC SKIP IF B = 0 1651 02713 0 06 02720 ADD T1IM 1652 02714 0 12 02721 IRS T2IM 1653 02715 0 01 02711 JMP IM10 1654 02716 0410 62 LLL 14 1655 02717 -0 01 02703 JMP* IM00 RETURN, RESULT IN A 1656 02720 0 00 00000 T1IM PZE 0 1657 02721 0 00 00000 T2IM PZE 0 1658 * 1659 * 1660 02722 0 000000 NF00 DAC ** CONSTRUCT EXTERNAL NAME 1661 02723 0 02 02730 LDA K80 ENTRY FOR FORTRAN GENERATER 1662 02724 0 04 00570 STA NAMF 1663 02725 0 02 02731 LDA K81 SUBROUTINE CALLS, 1664 02726 0 04 00572 STA NAMF+2 1665 02727 -0 01 02722 JMP* NF00 1666 02730 143244 K80 BCI 1,F$ 1667 02731 120240 K81 BCI 1, 1668 02732 000001 KM92 DEC 1 001 = INT 1669 02733 000002 DEC 2 010 = REA 1670 02734 000001 DEC 1 011 = LOG 1671 02735 000000 DEC 0 - - 1672 02736 000004 DEC 4 101 = CPX 1673 02737 000003 DEC 3 110 = DSL 1674 02740 000003 OCT 3 111 = HOL 1675 * 1676 * 1677 02741 0 000000 BLNK DAC ** CLEAR A 3/36 1678 02742 0 10 03007 JST SAV AREA TO ZEROS 1679 02743 -0 02 02741 LDA* BLNK 1680 02744 0 04 00000 STA XR 1681 02745 140040 CRA CLEAR 3 WORDS OF MEMORY 1682 02746 1 04 00001 STA 1,1 PARAMETER INPUT ADDRESS TO 0 1683 02747 1 04 00002 STA 2,1 1684 02750 1 04 00000 STA 0,1 1685 02751 0 10 03016 JST RST 1686 02752 0 12 02741 IRS BLNK 1687 02753 -0 01 02741 JMP* BLNK EXIT 1688 * 1689 * 1690 02754 0 000000 MOV3 DAC ** MOVE 3-WORDS 1691 02755 0 02 01475 LDA TID TO TEMO STORE 1692 02756 0 04 02347 STA DNX1 1693 02757 0 02 01476 LDA TID+1 1694 02760 0 04 02350 STA DNX1+1 1695 02761 0 02 01477 LDA TID+2 1696 02762 0 04 02351 STA DNX1+2 1697 02763 -0 01 02754 JMP* MOV3 1698 * 1699 *
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 36
1700 * 1701 * 1702 02764 0 000000 CIB DAC ** COMPARE IBUF TO A CONSTANT 1703 02765 0 10 03007 JST SAV SAVE INDEX 1704 02766 -0 02 02764 LDA* CIB +DDR OF CON+3,0 1705 02767 0 04 03006 STA CIBZ 1706 02770 140040 CRA 1707 02771 0 07 00721 SUB K103 XR=-3 1708 02772 0 04 00000 STA XR 1709 02773 1 02 01504 CIBB LDA IBUF+3,1 1710 02774 -0 07 03006 SUB* CIBZ 1711 02775 100040 SZE 1712 02776 0 01 03004 JMP CIBD 1713 02777 0 12 00000 IRS XR 1714 03000 0 01 02773 JMP CIBB 1715 03001 0 12 02764 CIBC IRS CIB 1716 03002 0 10 03016 JST RST RESTORE INDEX 1717 03003 -0 01 02764 JMP* CIB 1718 03004 0 12 02764 CIBD IRS CIB 1719 03005 0 01 03001 JMP CIBC 1720 03006 0 000000 CIBZ DAC ** 1721 * 1722 * 1723 * 1724 * 1725 03007 0 000000 SAV DAC ** SAVE INDEX REGISTER 1726 03010 0 04 03027 STA SAVY STACKED IN PUSH DOWN LIST 1727 03011 0 02 00000 LDA XR 1728 03012 -0 04 03030 STA* SAV9 1729 03013 0 12 03030 IRS SAV9 1730 03014 0 02 03027 LDA SAVY 1731 03015 -0 01 03007 JMP* SAV 1732 03016 0 000000 RST DAC ** RESTORE INDEX REGISTER 1733 03017 0 04 03027 STA SAVY 1734 03020 0 02 03030 LDA SAV9 UNSTACK PUSH DOWN LIST 1735 03021 0 07 00717 SUB K101 1736 03022 0 04 03030 STA SAV9 1737 03023 -0 02 03030 LDA* SAV9 1738 03024 0 04 00000 STA XR 1739 03025 0 02 03027 LDA SAVY 1740 03026 -0 01 03016 JMP* RST 1741 03027 0 00 00000 SAVY PZE 0 1742 03030 0 003031 SAV9 DAC SAVX IS INITIATED BY A092 1743 03031 SAVX BSS 20 1744 * 1745 * 1746 03055 0 000000 PACK DAC ** PLACE CHARACTER IN A 1747 03056 0 04 03113 STA PAK7 1748 03057 0 02 00575 LDA NTID INTO ID - UPDATE 3 WORDS OF 1749 03060 101040 PAK1 SNZ
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 37
1750 03061 0 01 03103 JMP PAK4 ID 1751 03062 0400 77 LRL 1 1752 03063 0 06 03115 ADD PAK9 1753 03064 0 04 03114 STA PAK8 1754 03065 0 02 03113 LDA PAK7 1755 03066 000201 IAB 1756 03067 100400 SPL 1757 03070 0 01 03076 JMP PAK3 1758 03071 0410 50 LLL 24 1759 03072 0 06 00673 ADD K8 1760 03073 -0 04 03114 PAK2 STA* PAK8 1761 03074 0 12 00575 IRS NTID 1762 03075 -0 01 03055 JMP* PACK 1763 03076 0410 70 PAK3 LLL 8 1764 03077 -0 02 03114 LDA* PAK8 1765 03100 0404 70 LGR 8 1766 03101 0410 70 LLL 8 1767 03102 0 01 03073 JMP PAK2 1768 03103 0 02 03112 PAK4 LDA PAK6 1769 03104 0 04 01475 STA TID 1770 03105 0 04 01476 STA TID+1 1771 03106 0 04 01477 STA TID+2 1772 03107 0 04 01500 STA TID+3 1773 03110 0 02 00575 LDA NTID 1774 03111 0 01 03062 JMP PAK1+2 1775 03112 120240 PAK6 BCI 1, 1776 03113 0 000000 PAK7 DAC ** 1777 03114 0 000000 PAK8 DAC ** 1778 03115 0 001475 PAK9 DAC TID 1779 * 1780 * 1781 * *************** 1782 * *ERROR ROUTINE* 1783 * *************** 1784 * 1785 03116 0 000000 ER00 DAC ** ERROR ROUTINE 1786 03117 0 02 03030 LDA SAV9 1787 03120 0 04 03031 STA SAVX 1788 03121 0 02 03156 LDA ER93 =-35 1789 03122 0 04 00000 STA 0 SET INDEX 1790 03123 0 02 03155 LDA ER91 (*)(*) 1791 03124 1 04 14745 STA PRI+35,1 SET ** INTO PRINT BUFFER 1792 03125 0 12 00000 IRS 0 SET COMPLETE PRINT BUFFER TO ******** 1793 03126 0 01 03124 JMP *-2 1794 03127 0 02 00662 LDA CC 1795 03130 0405 77 ARS 1 CC = CC/2 1796 03131 0 07 00717 SUB K101 =1 1797 03132 100400 SPL 1798 03133 140040 CRA 1799 03134 0 04 00000 STA XR
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 38
1800 03135 0 02 00660 LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.) 1801 03136 100400 SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT 1802 03137 0 01 03142 JMP *+3 1803 03140 0 02 00761 LDA KAEQ ='142721 (=(E)(Q) ) 1804 03141 1 04 14703 STA PRI+1,1 1805 03142 -0 02 03116 LDA* ER00 1806 03143 1 04 14702 STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER 1807 03144 0 10 00000 CALL F4$SYM PRINT THE BUFFER 1808 03145 0 014702 DAC PRI 1809 03146 0 10 14301 JST PRSP SET PRINT BUFFER TO SPACES 1810 03147 0 02 00607 LDA TC 1811 03150 0 11 00756 ER20 CAS CRET INPUT CHARACTERS UNTIL C/R 1812 03151 0 01 03153 JMP *+2 1813 03152 0 01 04353 JMP C7 GO TO STATEMENT INPUT 1814 03153 0 10 01256 JST CH00 1815 03154 0 01 03150 JMP ER20 1816 03155 125252 ER91 BCI 1,** 1817 03156 177735 ER93 OCT 177735 -35 1818 * 1819 * 1820 03157 0 000000 SRT DAC ** 1821 03160 0 10 03007 JST SAV 1822 03161 -0 02 03157 LDA* SRT SHIFT RIGHT ONE PLACE 1823 03162 0 04 00000 STA XR TRIPLE PRECISION 1824 03163 1 02 00000 LDA 0,1 1825 03164 000201 IAB 1826 03165 1 02 00001 LDA 1,1 1827 03166 0401 77 LRS 1 1828 03167 0414 77 LGL 1 1829 03170 000201 IAB 1830 03171 1 04 00000 STA 0,1 1831 03172 1 02 00002 LDA 2,1 1832 03173 0401 77 LRS 1 1833 03174 1 04 00002 STA 2,1 1834 03175 000201 IAB 1835 03176 1 04 00001 STA 1,1 1836 03177 0 10 03016 JST RST 1837 03200 0 12 03157 IRS SRT 1838 03201 -0 01 03157 JMP* SRT 1839 * 1840 * 1841 03202 0 000000 SFT DAC ** TRIPLE PRECISION 1842 03203 0 10 03007 JST SAV SHIFT LEFT ONE PLACE 1843 03204 -0 02 03202 LDA* SFT 1844 03205 0 04 00000 STA XR 1845 03206 1 02 00000 LDA 0,1 1846 03207 000201 IAB 1847 03210 1 02 00001 LDA 1,1 1848 03211 0411 77 LLS 1 1849 03212 140320 CSA
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 39
1850 03213 1 04 00001 STA 1,1 1851 03214 000201 IAB 1852 03215 1 04 00000 STA 0,1 1853 03216 141216 ACA 1854 03217 0401 77 LRS 1 1855 03220 1 02 00002 LDA 2,1 1856 03221 0411 77 LLS 1 1857 03222 140320 CSA 1858 03223 1 04 00002 STA 2,1 1859 03224 0 10 03016 JST RST 1860 03225 0 12 03202 IRS SFT 1861 03226 -0 01 03202 JMP* SFT 1862 * 1863 03227 0 000000 LIST DAC ** 1864 03230 0 10 14301 JST PRSP 1865 03231 100010 SR2 1866 03232 0 01 03235 JMP *+3 1867 03233 0 10 00000 CALL F4$SYM PRINT BLANK LINE 1868 03234 0 014702 DAC PRI 1869 03235 0 10 00000 CALL F4$SYM PRINT SOURCE INPUT LINE 1870 03236 0 001155 DAC CI 1871 03237 -0 01 03227 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 03240 0 00 00000 T0AS PZE 0 1884 03241 0 000000 AS00 DAC ** 1885 03242 140040 CRA 1886 03243 0 04 00040 STA A A = A (0) 1887 03244 0 10 02672 AS04 JST STXA 1888 03245 0 10 04062 JST NXT GET NEXT ENTRY 1889 03246 0 01 03355 JMP AS30 AT END, GO TO AS30 1890 03247 0 02 00573 LDA NT 1891 03250 0 07 00617 SUB NTA NT = NT(A) 1892 03251 100040 SZE 1893 03252 0 01 03244 JMP AS04 NO, G0 TO AS04 1894 03253 0 02 01475 LDA TID 1895 03254 0 07 03634 SUB TIDA 1896 03255 100040 SZE 1897 03256 0 01 03244 JMP AS04 TID = TID(A) 1898 03257 0 02 01476 LDA TID+1 1899 03260 0 07 03635 SUB TIDA+1
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 40
1900 03261 100040 SZE 1901 03262 0 01 03244 JMP AS04 NO, GO TO AS04 1902 03263 0 02 01477 LDA TID+2 1903 03264 0 07 03636 SUB TIDA+2 1904 03265 100040 SZE 1905 03266 0 01 03244 JMP AS04 1906 03267 0 02 00573 LDA NT IF NT (A) .NE. 0, 1907 03270 101040 SNZ GO TO AS10 1908 03271 0 01 03331 JMP AS16 GO TO AS16 (4) 1909 03272 0 02 00653 AS10 LDA IM IF IM .NE. IM (A), 1910 03273 0 07 00621 SUB IMA GO TO AS04 (1) 1911 03274 100040 SZE 1912 03275 0 01 03244 JMP AS04 1913 03276 0 02 00655 LDA IU IF IU = 0, 1914 03277 101040 SNZ OR NOT EQUAL IU (A) 1915 03300 0 01 03244 JMP AS04 GO T0 AS04 (1) 1916 03301 0 07 00623 SUB IUA 1917 03302 100040 SZE 1918 03303 0 01 03244 JMP AS04 ELSE, 1919 03304 0 02 00653 LDA IM 1920 03305 0 07 00723 SUB K105 GO TO AS16 (4) 1921 03306 100040 SZE 1922 03307 0 01 03331 JMP AS16 1923 03310 0 10 04062 JST NXT ELSE, GET NEXT ENTRY 1924 03311 0 01 03355 JMP AS30 1925 03312 0 02 03634 LDA TIDA IF IU (A) = TIDB 1926 03313 0 07 03637 SUB TIDB GO TO AS16 (4) 1927 03314 100040 SZE ELSE, GO TO AS04 (1) 1928 03315 0 01 03244 JMP AS04 1929 03316 0 02 03635 LDA TIDA+1 1930 03317 0 07 03640 SUB TIDB+1 1931 03320 100040 SZE 1932 03321 0 01 03244 JMP AS04 1933 03322 0 02 03636 LDA TIDA+2 1934 03323 0 07 03641 SUB TIDB+2 1935 03324 100040 SZE 1936 03325 0 01 03244 JMP AS04 1937 03326 0 02 00040 LDA A 1938 03327 0 07 00723 SUB K105 1939 03330 0 04 00040 STA A 1940 03331 0 02 00623 AS16 LDA IUA IF IU (A) .NE. 0 1941 03332 0 06 00574 ADD NTF 1942 03333 100040 SZE 1943 03334 0 01 03345 JMP AS18 GO TO AS18 (5) 1944 03335 0 02 00051 LDA SPF IF SPF = 0, GO TO AS18 (5) 1945 03336 101040 SNZ 1946 03337 0 01 03345 JMP AS18 1947 03340 0 02 00607 LDA TC IF TC = ( 1948 03341 0 07 00702 SUB K17 1949 03342 100040 SZE
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 41
1950 03343 0 01 03353 JMP AS19 1951 03344 0 10 03465 JST TG00 TAG SUBPROGRAM 1952 03345 140040 AS18 CRA SET NTF TO 0 1953 03346 0 04 00574 STA NTF SET NTF TO 0 1954 03347 0 10 03656 JST FA00 GO TO FETCH ASSIGNS 1955 03350 0 10 02672 JST STXA 1956 03351 0 02 00653 LDA IM 1957 03352 -0 01 03241 JMP* AS00 RETURN 1958 03353 0 10 03642 AS19 JST TV00 TAG VARIABLE 1959 03354 0 01 03345 JMP AS18 1960 03355 0 10 04142 AS30 JST BUD BUILD ASSIGNMENT ENTRY 1961 03356 0 02 00573 LDA NT IF NT = 1 1962 03357 100040 SZE 1963 03360 0 01 03365 JMP AS32 OR IV = VAR, 1964 03361 0 02 00655 LDA IU 1965 03362 0 07 00720 SUB K102 1966 03363 100040 SZE 1967 03364 0 01 03407 JMP AS40 AMD 1968 03365 0 02 00653 AS32 LDA IM IF IM = CPX, 1969 03366 0 07 00723 SUB K105 1970 03367 100040 SZE 1971 03370 0 01 03407 JMP AS40 1972 03371 0 04 00655 STA IU MOVE 1ST PART OF 1973 03372 0 02 03637 LDA TIDB COMPLEX ENTRY TO 1974 03373 0 04 01475 STA TID TID AND BUILD 1975 03374 0 02 03640 LDA TIDB+1 ASSIGNMENT ENTRY 1976 03375 0 04 01476 STA TID+1 1977 03376 0 02 03641 LDA TIDB+2 1978 03377 0 04 01477 STA TID+2 1979 03400 0 02 00040 LDA A 1980 03401 0 06 00723 ADD K105 1981 03402 0 04 00040 STA A 1982 03403 0 10 04142 JST BUD 1983 03404 0 02 00040 LDA A 1984 03405 0 07 00723 SUB K105 RESTORE A 1985 03406 0 04 00040 STA A 1986 03407 0 02 00054 AS40 LDA ABAR 1987 03410 0 07 00040 SUB A TO = -(ABAR-A+5) 1988 03411 0 06 00723 ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP 1989 03412 140407 TCA 1990 03413 0 04 03240 STA T0AS 1991 03414 140407 TCA 1992 03415 0 06 00661 ADD DO CO=DO+TO 1993 03416 0 04 00661 STA DO 1994 03417 0 02 00652 LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE 1995 03420 101040 SNZ 1996 03421 0 01 03460 JMP AS60 GO TO AS60 1997 03422 0 02 00041 LDA I 1998 03423 0 07 03240 SUB T0AS 1999 03424 0 04 00041 STA I I = I - T0(T0 IS NEGATIVE)
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 42
2000 03425 141206 AOA 2001 03426 0 11 00044 AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE 2002 03427 101000 NOP 2003 03430 0 01 03456 JMP AS50 2004 03431 0 06 00104 ADD '104 =DP,1 2005 03432 0 04 03463 STA AS91 AS91 = NEW TABLE TOP 2006 03433 0 06 03240 ADD T0AS 2007 03434 0 04 03464 STA AS92 AS92 2008 03435 0 07 03240 SUB T0AS COMPUTE SIZE OF FLOATING TABLES 2009 03436 0 07 00104 SUB '104 =DP,1 2010 03437 0 07 00661 SUB DO 2011 03440 101040 SNZ IF ZERO, ASSIGN TABLE ONLY, 2012 03441 0 01 03331 JMP AS16 2013 03442 140407 TCA 2014 03443 0 04 03240 STA T0AS 2015 03444 140040 CRA 2016 03445 0 04 00000 STA XR 2017 03446 -0 02 03464 AS46 LDA* AS92 END-5 2018 03447 -0 04 03463 STA* AS91 END (MOVE TABLES UP) 2019 03450 0 02 00000 LDA 0 2020 03451 0 07 00717 SUB K101 =1 2021 03452 0 04 00000 STA 0 REDUCE INDEX 2022 03453 0 12 03240 IRS T0AS = NO, OF WORDS TO MOVE 2023 03454 0 01 03446 JMP AS46 2024 03455 0 01 03331 JMP AS16 2025 03456 0 10 03116 AS50 JST ER00 2026 03457 146717 BCI 1,MO DATA POOL OVERFLOW 2027 03460 0 02 00661 AS60 LDA DO 2028 03461 0 06 00057 ADD D 2029 03462 0 01 03426 JMP AS41 2030 03463 0 000000 AS91 DAC 0 2031 03464 0 000000 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 03465 0 000000 TG00 DAC ** 2044 03466 0 02 00655 LDA IU 2045 03467 0 07 00717 SUB K101 IF IU = SUB 2046 03470 101040 SNZ 2047 03471 -0 01 03465 JMP* TG00 RETURN, ELSE 2048 03472 0 10 02603 JST NU00 NO * USAGE TEST 2049 03473 0 02 03534 LDA TG22 =-21
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 43
2050 03474 0 04 00000 STA 0 SET INDEX 2051 03475 0 02 01476 TG04 LDA ID+1 CHARACTERS 3 AND 4 2052 03476 1 11 03607 CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE 2053 03477 0 01 03501 JMP *+2 2054 03500 0 01 03514 JMP TG10 2055 03501 0 12 00000 TG06 IRS 0 2056 03502 0 01 03475 JMP TG04 NOT DONE WITH TABLE 2057 03503 0 02 00717 TG08 LDA K101 =1 (IU=SUBR.) 2058 03504 0 04 00655 STA IU 2059 03505 0 10 02672 JST STXA 2060 03506 1 02 15401 LDA DP+1,1 IU(A) = SUB 2061 03507 0414 77 LGL 1 2062 03510 140500 SSM 2063 03511 0404 77 LGR 1 2064 03512 1 04 15401 STA DP+1,1 2065 03513 -0 01 03465 JMP* TG00 RETURN 2066 * 2067 03514 0 02 01475 TG10 LDA ID CHARACTERS 1 AND 2 2068 03515 0 03 00730 ANA K111 ='37777 2069 03516 0 06 00760 ADD HBIT ='140000 2070 03517 1 07 03562 SUB TGT1+21,1 2071 03520 100040 SZE 2072 03521 0 01 03501 JMP TG06 CONTINUE SEARCH 2073 03522 0 02 01477 LDA ID+2 CHARACTERS 5 AND 6 2074 03523 1 07 03634 SUB TGT3+21,1 2075 03524 100040 SZE 2076 03525 0 01 03501 JMP TG06 CONTINUE SEARCH 2077 03526 1 02 03562 LDA TGT1+21,1 2078 03527 0404 70 LGR 8 2079 03530 0 03 00725 ANA K107 =7 (=3 IF CPX, 4 IF DBL) 2080 03531 0 06 00720 ADD K102 =2 (=5 IF CPX, 6 IF DBL) 2081 03532 0 10 04026 JST DM00 DEFINE IM 2082 03533 0 01 03503 JMP TG08 2083 * 2084 03534 177753 TG22 OCT 177753 =-21 2085 * 2086 *...........IMPLICIT MODE SUBROUTINE NAME TABLE 2087 03535 142305 TGT1 BCI 6,DECEDLCLDLDS 03536 141705 03537 142314 03540 141714 03541 142314 03542 142323 2088 03543 141723 BCI 6,CSDCCCDSCSDA 03544 142303 03545 141703 03546 142323 03547 141723 03550 142301 2089 03551 142301 BCI 6,DADMDADMDMDS
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 44
03552 142315 03553 142301 03554 142315 03555 142315 03556 142323 2090 03557 142302 BCI 3,DBCMCO 03560 141715 03561 141717 2091 03562 154320 TGT2 BCI 6,XPXPOGOGOGIN 03563 154320 03564 147707 03565 147707 03566 147707 03567 144716 2092 03570 144716 BCI 6,INOSOSQRQRTA 03571 147723 03572 147723 03573 150722 03574 150722 03575 152301 2093 03576 152301 BCI 6,TAODBSAXINIG 03577 147704 03600 141323 03601 140730 03602 144716 03603 144707 2094 03604 146305 BCI 3,LEPLNJ 03605 150314 03606 147312 2095 03607 120240 TGT3 BCI 6, 10 / 03610 120240 03611 120240 03612 130660 03613 120240 03614 104657 2096 03615 120240 BCI 6, T T N / 03616 120240 03617 120240 03620 152240 03621 152240 03622 147240 2097 03623 147262 BCI 6,N2 1 1 N / 03624 120240 03625 120240 03626 130640 03627 130640 03630 147240 2098 03631 120240 BCI 3, X G / 03632 120240 03633 120240
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 45
2099 * 2100 * 2101 03634 TIDA BSS 3 2102 03637 TIDB BSS 3 2103 * 2104 * - TV00 TAG VARIABLE 2105 03642 0 000000 TV00 DAC ** 2106 03643 0 02 00655 LDA IU IF IU = 'VAR', 2107 03644 0 07 00720 SUB K102 2108 03645 101040 SNZ 2109 03646 -0 01 03642 JMP* TV00 RETURN 2110 03647 0 10 02603 JST NU00 ELSE, NO USAGE TEST 2111 03650 0 10 02672 JST STXA 2112 03651 1 02 15401 LDA DP+1,1 2113 03652 0 03 00730 ANA K111 IU (A) = 'VAR' 2114 03653 140500 SSM 2115 03654 1 04 15401 STA DP+1,1 2116 03655 -0 01 03642 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 03656 0 000000 FA00 DAC ** 2129 03657 0 10 02672 JST STXA 2130 03660 1 02 15400 LDA DP,1 2131 03661 0400 61 LRL 15 2132 03662 0 04 00573 STA NT NT=NT(A) 2133 03663 140040 CRA 2134 03664 0410 75 LLL 3 2135 03665 0 04 00631 STA AT AT=AT(A) 2136 03666 140040 CRA 2137 03667 0410 75 LLL 3 IM = IM(A) 2138 03670 0 04 00653 STA IM 2139 03671 0 04 00000 STA 0 2140 03672 1 02 02731 LDA KM92-1,1 2141 03673 0 04 00633 STA D0 D0 = NUMBER OF WORDS 2142 03674 0415 76 ALS 2 2143 03675 0 06 00633 ADD D0 2144 03676 0 04 00612 STA X X = POINTER TO CONSTANT NUMBER OF WORDS 2145 03677 0 10 02672 JST STXA 2146 03700 1 02 15401 LDA DP+1,1 2147 03701 0400 62 LRL 14 2148 03702 0 04 00655 STA IU
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 46
2149 03703 0 07 00721 SUB K103 IF IU NOT 'ARR' 2150 03704 101040 SNZ 2151 03705 0 01 03712 JMP FA10 2152 03706 140040 CRA 2153 03707 0410 62 LLL 14 AF = GF(A) 2154 03710 0 04 00630 STA AF 2155 03711 -0 01 03656 JMP* FA00 2156 03712 0410 62 FA10 LLL 14 2157 03713 0 04 00000 STA 0 INDEX = GF(A) 2158 03714 1 02 15404 LDA DP+4,1 2159 03715 0 04 00613 STA X1 POINTER OF DIMENSION 1 2160 03716 1 02 15403 LDA DP+3,1 2161 03717 0 04 00614 STA X2 POINTER OF DIMENSION 2 2162 03720 1 02 15402 LDA DP+2,1 2163 03721 0 04 00615 STA X3 POINTER OF DIMENSION 3 2164 03722 1 02 15401 LDA DP+1,1 2165 03723 0 03 00730 ANA K111 ='37777 2166 03724 0 04 00630 STA AF AF = GF(GF(A)) 2167 03725 1 02 15400 LDA DP,1 2168 03726 0404 67 LGR 9 2169 03727 0 03 00725 ANA K107 =7 2170 03730 0 04 00571 STA ND NUMBER OF DIMENSIONS 2171 03731 0 04 00000 STA 0 2172 03732 0 02 00717 LDA K101 =1 2173 03733 0 04 00635 STA D2 2174 03734 0 04 00636 STA D3 2175 03735 -1 01 03764 JMP* FA91-1,1 2176 03736 0 02 00615 FA22 LDA X3 FETCH 3RD DIMENSION SIZE 2177 03737 0 04 00000 STA XR 2178 03740 0 10 03755 JST FA40 2179 03741 0 04 00636 STA D3 STORE D3 2180 03742 0 02 00614 FA24 LDA X2 2181 03743 0 04 00000 STA XR 2182 03744 0 10 03755 JST FA40 2183 03745 0 04 00635 STA D2 D2 = 2ND DIMENSION SIZE 2184 03746 0 02 00613 FA26 LDA X1 2185 03747 0 04 00000 STA XR 2186 03750 0 10 03755 JST FA40 2187 03751 0 04 00634 STA D1 D1 = 1ST DIMENSION SIZE 2188 03752 0 10 02672 JST STXA EXIT WITH AF IN A 2189 03753 0 02 00630 LDA AF 2190 03754 -0 01 03656 JMP* FA00 2191 03755 0 000000 FA40 DAC ** 2192 03756 1 02 15400 LDA DP,1 IM OF SUBSCRIPT VALUE 2193 03757 140100 SSP 2194 03760 0404 64 LGR 12 2195 03761 0 07 00723 SUB K105 =5 2196 03762 100040 SZE SKIP IF DUMMY SUBSCRIPT 2197 03763 1 02 15404 LDA DP+4,1 FETCH VALUE OF SUBSCRIPT 2198 03764 -0 01 03755 JMP* FA40
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 47
2199 03765 0 003746 FA91 DAC FA26 2200 03766 0 003742 DAC FA24 2201 03767 0 003736 DAC FA22 2202 * 2203 * 2204 * ************ 2205 * *FETCH LINK* 2206 * ************ 2207 * EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE 2208 * LINKED ITEM 2209 * 2210 03770 0 000000 FL00 DAC ** 2211 03771 0 10 02672 JST STXA 2212 03772 1 02 15400 LDA DP,1 A = 5 * CL(A) 2213 03773 0 03 00735 ANA K118 2214 03774 0 04 00667 STA FLT1 2215 03775 0415 76 ALS 2 2216 03776 0 06 00667 ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC) 2217 03777 0 04 00040 STA A 2218 04000 0 10 03656 JST FA00 FETCH ASSIGN 2219 04001 0 10 04005 JST KT00 D0 = = WDS /ITEM 2220 04002 0 02 00040 LDA A 2221 04003 0 07 00664 SUB F (A) = A-F 2222 04004 -0 01 03770 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 04005 0 000000 KT00 DAC ** 2232 04006 0 02 00655 LDA IU IF IU NOT 'ARR' 2233 04007 0 07 00721 SUB K103 2234 04010 100040 SZE 2235 04011 -0 01 04005 JMP* KT00 RETURN 2236 04012 0 02 00633 LDA D0 2237 04013 000201 IAB D0 = D0 * D1 * D2 * D3 2238 04014 0 02 00634 LDA D1 2239 04015 0 10 02703 JST IM00 MULTIPLY A BY B 2240 04016 000201 IAB 2241 04017 0 02 00635 LDA D2 2242 04020 0 10 02703 JST IM00 MULTIPLY A BY B 2243 04021 000201 IAB 2244 04022 0 02 00636 LDA D3 2245 04023 0 10 02703 JST IM00 MULTIPLY A BY B 2246 04024 0 04 00633 STA D0 2247 04025 -0 01 04005 JMP* KT00 RETURN 2248 *
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 48
2249 * 2250 * 2251 * *********** 2252 * *DEFINE IM* 2253 * *********** 2254 * IM SUBA = IM (SET FROM A REG) 2255 * 2256 04026 0 000000 DM00 DAC ** 2257 04027 0 04 00653 STA IM IM = (A) 2258 04030 0 10 02672 JST STXA ESTABLISH A 2259 04031 1 02 15400 LDA DP,1 2260 04032 0400 67 LRL 9 2261 04033 0404 75 LGR 3 IM(A) = IM 2262 04034 0414 75 LGL 3 2263 04035 0 06 00653 ADD IM 2264 04036 0410 67 LLL 9 2265 04037 1 04 15400 STA DP,1 2266 04040 -0 01 04026 JMP* DM00 2267 * 2268 * 2269 * *********** 2270 * *DEFINE AF* 2271 * *********** 2272 * AF SUBA = AF (SET FROM A REG) 2273 * 2274 04041 0 000000 DA00 DAC ** 2275 04042 0 04 00630 STA AF AF = (A) 2276 04043 0400 62 LRL 14 2277 04044 0 10 02672 JST STXA 2278 04045 1 02 15401 DA10 LDA DP+1,1 IF IU (A) NOT ARR 2279 04046 0404 62 LGR 14 2280 04047 0 11 00721 CAS K103 GF (A) : AF 2281 04050 0 01 04052 JMP *+2 2282 04051 0 01 04055 JMP DA20 ELSE, GF (GF (A)) = AF 2283 04052 0410 62 LLL 14 2284 04053 1 04 15401 STA DP+1,1 2285 04054 -0 01 04041 JMP* DA00 RETURN 2286 04055 1 02 15401 DA20 LDA DP+1,1 2287 04056 0 03 00730 ANA K111 2288 04057 0 04 00650 STA GFA 2289 04060 0 04 00000 STA 0 2290 04061 0 01 04045 JMP DA10 2291 04062 0 000000 NXT DAC ** GET NEXT ENTRY 2292 04063 0 02 00040 LDA A FROM ASSIGNMENT 2293 04064 0 06 00723 ADD K105 =5 2294 04065 0 04 00040 STA A 2295 04066 0 04 00000 STA 0 2296 04067 0 11 00054 CAS ABAR 2297 04070 -0 01 04062 JMP* NXT 2298 04071 101000 NOP
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 49
2299 04072 0 12 04062 IRS NXT 2300 04073 1 02 15400 LDA DP,1 2301 04074 0400 61 LRL 15 2302 04075 0 04 00617 STA NTA NT(A) = NT FROM (A) 2303 04076 140040 CRA 2304 04077 0410 75 LLL 3 2305 04100 0 04 00620 STA ATA AT(A) = AT FROM (A) 2306 04101 140040 CRA 2307 04102 0410 75 LLL 3 2308 04103 0 04 00621 STA IMA IM(A) = IM FROM (A) 2309 04104 140040 CRA 2310 04105 0410 67 LLL 9 2311 04106 0 04 00622 STA CLA CL(A) = CL FROM (A) 2312 04107 1 02 15401 LDA DP+1,1 2313 04110 0400 62 LRL 14 2314 04111 0 04 00623 STA IUA IU(A) = IU FROM (A) 2315 04112 140040 CRA 2316 04113 0410 62 LLL 14 2317 04114 0 04 00650 STA GFA GF(A) = GF FROM (A) 2318 04115 1 02 15402 LDA DP+2,1 2319 04116 0 04 03636 STA TIDA+2 TID(A) = TID FROM (A) 2320 04117 1 02 15403 LDA DP+3,1 2321 04120 0 04 03635 STA TIDA+1 2322 04121 1 02 15404 LDA DP+4,1 2323 04122 0 04 03634 STA TIDA 2324 04123 0400 61 LRL 15 2325 04124 0 04 00624 STA DTA DT(A) = DT FROM (A) 2326 04125 140040 CRA 2327 04126 0410 77 LLL 1 2328 04127 0 04 00625 STA TTA TT(A) = TT FROM (A) 2329 04130 0 02 00617 LDA NTA NT(A) = NT FROM (A) 2330 04131 100040 SZE 2331 04132 -0 01 04062 JMP* NXT 2332 04133 1 02 15404 LDA DP+4,1 2333 04134 140500 SSM 2334 04135 0416 77 ALR 1 2335 04136 140500 SSM 2336 04137 0406 77 ARR 1 2337 04140 0 04 03634 STA TIDA 2338 04141 -0 01 04062 JMP* NXT 2339 * 2340 * 2341 04142 0 000000 BUD DAC ** BUILD ASSIGNMENT 2342 04143 0 10 02672 JST STXA 2343 04144 0 04 00054 STA ABAR 2344 04145 0 02 01475 LDA TID TABLE ENTRY 2345 04146 1 04 15404 STA DP+4,1 2346 04147 0 02 01476 LDA TID+1 2347 04150 1 04 15403 STA DP+3,1 2348 04151 0 02 01477 LDA TID+2
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 50
2349 04152 1 04 15402 STA DP+2,1 2350 04153 0 02 00655 LDA IU 2351 04154 0 04 00623 STA IUA 2352 04155 0414 62 LGL 14 2353 04156 1 04 15401 STA DP+1,1 2354 04157 0 02 00573 LDA NT 2355 04160 0414 75 LGL 3 2356 04161 0 06 00720 ADD K102 AT = STR/+BS 2357 04162 0414 75 LGL 3 2358 04163 0 06 00653 ADD IM 2359 04164 0400 60 LRL 16 2360 04165 0 04 00665 STA CL 2361 04166 0 02 00720 LDA K102 2362 04167 0 04 00631 STA AT 2363 04170 0 02 00040 LDA A CL(A) = A/5 2364 04171 0 07 00723 SUB K105 2365 04172 100400 SPL 2366 04173 0 01 04176 JMP *+3 2367 04174 0 12 00665 IRS CL 2368 04175 0 01 04171 JMP *-4 2369 04176 0410 47 LLL 25 2370 04177 0 06 00665 ADD CL 2371 04200 1 04 15400 STA DP,1 2372 04201 100400 SPL 2373 04202 -0 01 04142 JMP* BUD 2374 04203 0 02 00666 LDA DT 2375 04204 0414 77 LGL 1 2376 04205 0 06 00610 ADD TT 2377 04206 0414 62 LGL 14 2378 04207 1 13 15404 IMA DP+4,1 2379 04210 0 03 00730 ANA K111 2380 04211 1 06 15404 ADD DP+4,1 2381 04212 1 04 15404 STA DP+4,1 2382 04213 -0 01 04142 JMP* BUD 2383 * 2384 * 2385 * 2386 * 2387 * 2388 * ************ 2389 * *DEFINE AFT* 2390 * ************ 2391 * AT SUBA = AT (FROM B REG), THEN DEFINE AF 2392 * 2393 04214 0 000000 AF00 DAC ** 2394 04215 000201 IAB 2395 04216 0 04 04231 STA AF90 2396 04217 0 10 02672 JST STXA 2397 04220 0 02 04231 LDA AF90 2398 04221 0414 64 LGL 12
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 51
2399 04222 1 13 15400 IMA DP,1 2400 04223 0 03 04232 ANA AF91 2401 04224 1 06 15400 ADD DP,1 2402 04225 1 04 15400 STA DP,1 AT(A) = CONTENTS OF B INPUT 2403 04226 000201 IAB 2404 04227 0 10 04041 JST DA00 DEFINE AF 2405 04230 -0 01 04214 JMP* AF00 2406 04231 0 00 00000 AF90 PZE 0 2407 04232 107777 AF91 OCT 107777 2408 * 2409 * 2410 * ***************** 2411 * *DEFINE LOCATION* 2412 * ***************** 2413 * SET AF = RPL, AT = REL 2414 04233 0 000000 LO00 DAC ** 2415 04234 0 02 00717 LDA K101 REL 2416 04235 000201 IAB 2417 04236 0 02 00060 LDA RPL 2418 04237 0 10 04214 JST AF00 DEFINE AF 2419 04240 -0 01 04233 JMP* LO00 2420 * ************************* 2421 * *ASSIGN INTEGER CONSTANT* 2422 * ************************* 2423 * IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL 2424 04241 0 000000 AI00 DAC ** 2425 04242 140040 CRA 2426 04243 0 04 01476 STA ID+1 2427 04244 0 04 01477 STA ID+2 2428 04245 0 02 00717 LDA K101 (B) = INT 2429 04246 000201 IAB 2430 04247 0 02 00720 LDA K102 (A) = VAR 2431 04250 0 10 04252 JST AA00 ASSIGN SPECIAL 2432 04251 -0 01 04241 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 04252 0 000000 AA00 DAC ** 2441 04253 0 04 00655 STA IU IU = (A) 2442 04254 000201 IAB 2443 04255 0 04 00653 STA IM IM = (B) 2444 04256 0 02 00717 LDA K101 2445 04257 0 04 00573 STA NT NT = 1 2446 04260 0 10 03241 JST AS00 ASSIGN ITEM 2447 04261 -0 01 04252 JMP* AA00 RETURN 2448 *
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 52
2449 * 2450 * ********** 2451 * *JUMP * 2452 * *ILL TERM* 2453 * ********** 2454 * 2455 * CLEAR LAST OP FLAG FOR NO PATH TESTING 2456 * 2457 04262 140040 B6 CRA 2458 04263 0 04 00073 STA LSTP LSTP = 0 2459 * SET ILLEGAL DO TERM FLAG 2460 04264 0 02 00717 C5 LDA K101 2461 04265 0 04 00072 STA LSTF LSTF =1 2462 04266 0 02 00756 A1 LDA CRET 2463 04267 0 10 02547 JST TS00 IF TC NOT C/R, ERROR 2464 04270 0 01 04271 JMP C6 2465 * 2466 * 2467 * ********** 2468 * *CONTINUE* 2469 * ********** 2470 * WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH 2471 * DO TABLE FOR DO TERMINATION 2472 04271 0 02 00070 C6 LDA LIF 2473 04272 100040 SZE IF LIF NON-ZERO, 2474 04273 0 01 04333 JMP C6H GO TO 2475 04274 0 02 00071 C6A LDA LSTN IF LSTN NON-ZERO, 2476 04275 100040 SZE GO TO 2477 04276 0 01 04301 JMP C6C 2478 04277 0 04 00072 C6B STA LSTF LSTF = 0 2479 04300 0 01 04353 JMP C7 GO TO STATEMENT INPUT 2480 04301 0 07 00065 C6C SUB TRF TRACE FLAG 2481 04302 101040 SNZ SMP IF NOT END OF TRACE ZONE 2482 04303 0 04 00065 STA TRF SET TRF TO ZERO (TURN FLAG OFF) 2483 04304 0 02 00661 LDA DO START OF DO TABLE 2484 04305 0 06 00057 ADD D 2485 04306 0 04 00041 C6D STA I I = DO + D 2486 04307 0 10 02676 JST STXI 2487 04310 0 07 00661 SUB DO 2488 04311 101040 SNZ 2489 04312 0 01 04277 JMP C6B GO TO C6B - FINISHED DO 2490 04313 1 02 15374 LDA DP-4,1 2491 04314 0 07 00071 SUB LSTN 2492 04315 100040 SZE 2493 04316 0 01 04327 JMP C6E 2494 04317 0 02 00072 LDA LSTF 2495 04320 100040 SZE 2496 04321 0 01 04351 JMP C6K 2497 04322 0 10 06773 JST DQ00 DO TERMINATION 2498 04323 0 02 00057 LDA D
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 53
2499 04324 0 07 00723 SUB K105 2500 04325 0 04 00057 STA D D = D-5 2501 04326 0 02 00072 LDA LSTF 2502 04327 0 04 00072 C6E STA LSTF 2503 04330 0 02 00041 LDA I 2504 04331 0 07 00723 SUB K105 2505 04332 0 01 04306 JMP C6D I = I-5 - CONTINUE DO LOOP 2506 04333 0 02 00053 C6H LDA IFF 2507 04334 0 04 00040 STA A 2508 04335 101040 SNZ 2509 04336 0 01 04344 JMP C6J 2510 04337 0410 60 LLL 16 2511 04340 0 02 13733 LDA OMI5 (A) = JMP INSTRUCTION 2512 04341 0 10 12467 JST OB00 OUTPUT OA 2513 04342 140040 CRA 2514 04343 0 04 00053 STA IFF IFF = 0 2515 04344 0 04 00040 C6J STA A A = U 2516 04345 0 02 00070 LDA LIF 2517 04346 0 04 00073 STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG 2518 04347 0 10 14135 JST OS00 OUTPUT STRING - RPL 2519 04350 0 01 04274 JMP C6A 2520 * 2521 04351 0 10 03116 C6K JST ER00 2522 04352 142324 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 04353 140040 C7 CRA 2531 04354 0 04 00071 STA LSTN LSTN = 0 2532 04355 0 04 00652 STA IFLG IFLG = 0 2533 04356 0 04 00070 STA LIF LIF = 0 2534 04357 0 02 00113 LDA L0 L = L (0) 2535 04360 0 04 00044 STA L 2536 04361 0 02 01155 LDA CI CHECK CARD COLUMN 1 2537 04362 0404 70 LGR 8 FOR $ CHARACTER 2538 04363 0 07 00700 SUB K15 *($) 2539 04364 101040 SNZ 2540 04365 0 01 04433 JMP CCRD CONTROL CARD 2541 04366 0 10 02525 JST XN00 EXAMINE NEXT CHAR 2542 04367 100040 SZE 2543 04370 0 01 04375 JMP C71 2544 04371 0 10 02443 JST IS00 INPUT STATEMENT = 2545 04372 0 02 00040 LDA A 2546 04373 0 04 00071 STA LSTN LSTN = A 2547 04374 0 04 00073 STA LSTP 2548 04375 0 02 00053 C71 LDA IFF CHECK FOR IFF=0
* C210-001-6601 (FRTN) 3C NO.180463000 REV. D PAGE 54
2549 04376 0 02 00053 LDA IFF IF IFF = 0, 2550 04377 101040 SNZ 2551 04400 0 01 04405 JMP C7B GO TO C7B 2552 04401 0 07 00071 SUB LSTN IF = LSTN 2553 04402 100040 SZE 2554 04403 0 01 04407 JMP C7C 2555 04404 0 04 00053 C7A STA IFF IFF = 0 2556 04405 0 10 04416 C7B JST C7LT LINE TEST 2557 04406 0 01 04456 JMP C8 2558 04407 0 02 00053 C7C LDA IFF IFF = A 2559 04410 0 04 00040 STA A 2560 04411 0400 40 LRL 32 2561 04412 0 02 13733 LDA K201 (A) = JMP INSTRUCTION 2562 04413 0 10 12467 JST OB00 OUTPUT OA 2563 04414 140040 CRA 2564 04415 0 01 04404 JMP C7A GO TO C7A 2565 04416 0 000000 C7LT DAC ** LINE TEST 2566 04417 0 02 01157 LDA CI+2 CI = BLANK 2567 04420 0 03 00733 ANA K116 LIST LINE 2568 04421 0 06 00673 ADD K8 RETURN 2569 04422 0 04 01157 STA CI+2 2570 04423 0 02 00607 LDA TC 2571 04424 0 07 00763 SUB HC2 IF TC : SPECIAL 2572 04425 100040 SZE 2573 04426 0 01 04431 JMP C7LU 2574 04427 0 10 03227 JST LIST 2575 04430 -0 01 04416 JMP* C7LT 2576 04431 0 10 03116 C7LU JST ER00 CONSTRUCTION ERROR 2577 04432 151703 BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD 2578 * 2579 * 2580 * 2581 * ************************ 2582 * *CONTROL CARD PROCESSOR* 2583 * ************************ 2584 04433 0 10 14523 CCRD JST FS00 FLUSH BUFFER IF NECESSARY 2585 04434 0 10 03227 JST LIST LIST CARD 2586 04435 0 02 01155 LDA CI WORD CONTAINING COLUMN 1 2587 04436 0414 64 LGL 12 2588 04437 101040 SNZ 2589 04440 0 02 04454 LDA CCRK ='030000 (EOJ CODE = 3) 2590 04441 0404 72 LGR 6 TRUNCATE TO A DIGIT 2591 04442 0 04 14632 STA OCI 2592 04443 0 02 00724 LDA K106 =6 2593 04444 0 04 00602 STA OCNT SET BUFFER WORD COUNT TO