5 JMP DN67 GO TO DN67 (18)
9 STA NT NAME TAG = 1 (CONSTANT)
15 DN67 JST FN00 FINISH OPERATOR
16 DN68 LDA F6 IF F6 = 0,
26 DN72 LDA F1 IF F1 = 0, GO TO DN74
31 JMP DN58 GO TO DN58 (14)
32 DN74 LDA TC IF TC = -, GO TO DN82
36 ADD K102 CHECK FOR TC = +
39 LDA DFL IF DFL = NON-ZERO
41 JMP DN63 GO TO DN63 (15)
50 DN78 LDA K101 IM < INT
52 DN80 LDA TC PACK TC TO ID
55 LDA DFL IF DFL IS NOT ZERO,
58 LDA NTID IF NTID = 6, GO TO DN67
64 STA F1 F1 = CONVERTED TC
65 JMP DN06 GO TO DN06 (2)
66 DN84 LDA F1 IF F1 = -,
67 SUB K102 GO TO DN85(13)
71 SUB TID COMPLEMENT THREE WORDS AT TID
85 DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18)
88 LDA IM IF IM NOT = REA,
93 SNZ IF F6 = 0, GO TO DN87
106 JST IP00 )-INPUT OPERATOR
107 JMP DN70 GO TO DN70 (21)
108 DN87 LDA TC IF TC = ,
111 JMP DN67 TID-BAR = TID
113 STA TIDB GO TO DN01 (1)
115 STA TIDB+1 ELSE, GO TO DN67 (18)
121 DN90 LDA F2 IF F2= 0, GO TO DN9A (10)
127 DN9A LDA F3 F4 = F3 - F4
130 LDA K12 F2 = EXP, BIAS + MANTISSA
134 ADD TID+2 GO TO DN85(13)
140 JMP DN9D ID IS NORMALIZED
147 JMP DN9C CONTINUE NORMALIZE LOOP
151 JMP DN9G FINISHED E FACTOR LOOP
154 LDA K155 DIVIDE LOOP COUNTER
169 JMP DND1 REDUCE DIVIDE COUNTER
188 JST AD3 ADD THREE WORD INTEGERS
190 * CONVERT THREE WORD INTEGER TO INTERNAL FORMAT
198 BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW)
207 LDA TID PACK UP TRIPLE PRECISION
214 JMP DN69 GO TO DN69 (20)
215 JMP DN84 ELSE. GO TO DN84 (12)
226 STA HOLF HOLF=NO.OF HOLLERITH CHARS,
230 JMP DN9K FIELD WIDTH OF ZERO
231 STA F2 F2= -1(1 CHAR) OR -2(2 CHAR)
232 JST BLNK SET ID,ID+1(ID+2 TO ZERO
234 DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS)
235 JST PACK PACK CHARACTERS 2 PER WORD
236 IRS F2 REDUCE CHARACTER COUNT
237 JMP DN9J INPUT AND PACK MORE CHARACTERS
238 LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT
243 JST PACK SHIFT A SPACE INTO THE LAST WORD
245 DN9M JST CH00 INPUT THE TERMINATING CHARACTER
246 JMP DN67 FINISH OPERATOR AND EXIT
249 DN9N LDA K105 SET .NOT. OPERATOR (TC=5)
250 STA TC SET .NOT. OPERATOR (TC=5)
252 STA IM IM=0 = UNDEFINED
255 DNX2 DAC ** OVERFLOW FLAG
262 * INPUTS AND ASSIGNS ITEM (IF ONE EXISTS)
268 JST AS00 NO, ASSIGN ITEM
270 JMP* II00 RETURN (A) = IM
276 * EXIT WITH ITEM MODE IN A (TC SET TO . IF NO
279 OP00 DAC ** INPUT OPERAND
282 JMP* OP00 ELSE (A) = IM, RETURN
292 * INPUT OPERAND AND ENSURE THAT IT IS A NAME
294 NA00 DAC ** INPUT NAME
295 JST OP00 INPUT OPERAND
308 * INPUT ITEM AND ENSURE THAT IT IS AN INTEGER CONSTANT
311 IG00 DAC ** INPUT INTEGER
319 LDA IM LSE, GO TO IG20
332 BCI 1,IN INTEGER REQUIRED
335 * ***********************
336 * *INPUT INTEGER VAR/CON*
337 * ***********************
340 JST OP00 INPUT OPERAND
342 JST TV00 TAG VARIABLE
346 * ************************
347 * *INPUT INTEGER VARIABLE*
348 * ************************
350 IR00 DAC ** INPUT INT VAR
351 JST IV00 INPUT INT VAR/CON
352 JST NC00 NON-CONSTANT TEST
356 * ************************
357 * *INPUT STATEMENT NUMBER*
358 * ************************
359 * NUMBER IS FORMED AS SPECIAL NAME , NOT CONVERTED
366 STA IU IU = IM = IT = 0
367 STA NTID PUT LEADING 'S' IN STATEMENT NO,
370 IS10 JST ID00 INPUT DIGIT
372 JMP IS20 NOT A DIGIT GO TO IS20
378 JST PACK PACK TC TO ID - LEGAL ST, NO, CHAR
382 JMP IS04 IGNORE LEAD ZERO ON ST. NO,
389 BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT
390 IS25 JST AS00 ASSIGN ITEM
395 LDA AF ADDRESS FIELD IS
396 CAS XST LE XST - ALREADY ASSIGNED
398 JMP* IS00 OK - OTHERWISE
399 LDA AT MUST HAVE STR-ABS OTHERWISE
404 BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER
408 SY00 DAC ** INPUT SYMBOL
410 STA NTF NTF NOT 0 - DON'T SET IU IN AS00
414 * ************************
415 * *EXAMINE NEXT CHARACTER*
416 * ************************
417 * CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT)
421 JST UC00 UNINPUT COLUMM
426 KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST
433 * ********************
434 * *ALL CHARACTER TEST*
435 * ********************
437 TS00 DAC ** TEST (A) AGAINST TC
441 JST ER00 TO ERROR TEST
442 BCI 1,CH IMPROPER TERMINATING CHARACTER
445 * *******************
446 * *)- INPUT OPERATOR*
447 * *******************
453 JST FN00 FINISH OPERATOR
462 * B1 COMMA OR C/R TST
463 B1 LDA K134 IF TC = ','(CONVERTED TO 17)
466 JMP* A9T2 GO TO SIDSW
467 JMP A1 ELSE, GO TO C/R TEST
470 NR00 DAC ** NON-REL TEST
472 SUB K101 IF AT = 1 GO TO ERROR-
475 JST ER00 ERROR TEST ROUTINE
476 BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER
483 NU00 DAC ** N0 USAGE TEST
485 SNZ IF IU NOT = 0, TO ERROR
488 BCI 1,NU NAME ALREADY BEING USED
491 * *******************
492 * *NON-CONSTANT TEST*
493 * *******************
495 NC00 DAC ** NON CONSTANT TEST
497 SNZ IF NT NOT = 0, TO ERROR TEST
500 BCI 1,NC CONSTANT MUST BE PRESENT
503 * *********************
504 * *NON SUBPROGRAM TEST*
505 * *********************
507 NS00 DAC ** NON SUBPROGRAM TEST
509 SUB K101 IF IU = 1, GO TO-
513 BCI 1,NS SUBPROGRAM NAME NOT ALLOWED
520 AT00 DAC ** ARRAY TEST
522 SUB K103 IF IU = 3, GO TO
526 BCI 1,AR ITEM NOT AN ARRAY NAME
533 IT00 DAC ** INTEGER TEST
535 SUB K101 IF IM = 1, GO TO-
536 SNZ ERROR ROUTINE, ELSE
538 JST ER00 TO ERROR TEST
539 BCI 1,IT ITEM NOT AN INTEGER
543 LDA AT STRING-ABS TEST
548 BCI 1,NR ITEM NOT A RELATIVE VARIABLE
557 AD3 DAC ** ADD TWO THREE WORD INTEGERS,
574 * ***********************
575 * *ASSIGN INDEX REGISTER*
576 * ***********************
588 STA T1IM MULTIPLY A BY B
593 IM10 LRL 1 LOW BIT OF B INTO C
599 JMP* IM00 RETURN, RESULT IN A
604 NF00 DAC ** CONSTRUCT EXTERNAL NAME
605 LDA K80 ENTRY FOR FORTRAN GENERATER
607 LDA K81 SUBROUTINE CALLS,
621 BLNK DAC ** CLEAR A 3/36
622 JST SAV AREA TO ZEROS
625 CRA CLEAR 3 WORDS OF MEMORY
626 STA 1,1 PARAMETER INPUT ADDRESS TO 0
634 MOV3 DAC ** MOVE 3-WORDS
635 LDA TID TO TEMO STORE
646 CIB DAC ** COMPARE IBUF TO A CONSTANT
648 LDA* CIB +DDR OF CON+3,0
660 JST RST RESTORE INDEX
669 SAV DAC ** SAVE INDEX REGISTER
670 STA SAVY STACKED IN PUSH DOWN LIST
676 RST DAC ** RESTORE INDEX REGISTER
678 LDA SAV9 UNSTACK PUSH DOWN LIST
686 SAV9 DAC SAVX IS INITIATED BY A092
690 PACK DAC ** PLACE CHARACTER IN A
692 LDA NTID INTO ID - UPDATE 3 WORDS OF
729 ER00 DAC ** ERROR ROUTINE
735 STA PRI+35,1 SET ** INTO PRINT BUFFER
736 IRS 0 SET COMPLETE PRINT BUFFER TO ********
744 LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.)
745 SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT
747 LDA KAEQ ='142721 (=(E)(Q) )
750 STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER
751 CALL F4$SYM PRINT THE BUFFER
753 JST PRSP SET PRINT BUFFER TO SPACES
755 ER20 CAS CRET INPUT CHARACTERS UNTIL C/R
757 JMP C7 GO TO STATEMENT INPUT
766 LDA* SRT SHIFT RIGHT ONE PLACE
767 STA XR TRIPLE PRECISION
785 SFT DAC ** TRIPLE PRECISION
786 JST SAV SHIFT LEFT ONE PLACE
811 CALL F4$SYM PRINT BLANK LINE
813 CALL F4$SYM PRINT SOURCE INPUT LINE
819 * CHECKS ASSIGNMENT AREA OF DATA POOL (A0 TO ABAR)
820 * FOR ITEM DEFINED BY ID, IM, IU, ETC.
821 * IF FOUND, EXIT WITH POINTER AND
822 * ASSIGNMENTS DATA SET, OTHERWISE
832 JST NXT GET NEXT ENTRY
833 JMP AS30 AT END, GO TO AS30
837 JMP AS04 NO, G0 TO AS04
841 JMP AS04 TID = TID(A)
845 JMP AS04 NO, GO TO AS04
850 LDA NT IF NT (A) .NE. 0,
852 JMP AS16 GO TO AS16 (4)
853 AS10 LDA IM IF IM .NE. IM (A),
854 SUB IMA GO TO AS04 (1)
858 SNZ OR NOT EQUAL IU (A)
859 JMP AS04 GO T0 AS04 (1)
864 SUB K105 GO TO AS16 (4)
867 JST NXT ELSE, GET NEXT ENTRY
869 LDA TIDA IF IU (A) = TIDB
870 SUB TIDB GO TO AS16 (4)
871 SZE ELSE, GO TO AS04 (1)
884 AS16 LDA IUA IF IU (A) .NE. 0
887 JMP AS18 GO TO AS18 (5)
888 LDA SPF IF SPF = 0, GO TO AS18 (5)
895 JST TG00 TAG SUBPROGRAM
896 AS18 CRA SET NTF TO 0
898 JST FA00 GO TO FETCH ASSIGNS
902 AS19 JST TV00 TAG VARIABLE
904 AS30 JST BUD BUILD ASSIGNMENT ENTRY
907 JMP AS32 OR IV = VAR,
912 AS32 LDA IM IF IM = CPX,
916 STA IU MOVE 1ST PART OF
917 LDA TIDB COMPLEX ENTRY TO
918 STA TID TID AND BUILD
919 LDA TIDB+1 ASSIGNMENT ENTRY
931 SUB A TO = -(ABAR-A+5)
932 ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP
938 LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE
943 STA I I = I - T0(T0 IS NEGATIVE)
945 AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE
949 STA AS91 AS91 = NEW TABLE TOP
952 SUB T0AS COMPUTE SIZE OF FLOATING TABLES
955 SNZ IF ZERO, ASSIGN TABLE ONLY,
962 STA* AS91 END (MOVE TABLES UP)
966 IRS T0AS = NO, OF WORDS TO MOVE
970 BCI 1,MO DATA POOL OVERFLOW
983 * TAG ITEM AS A SUBPROGRAM, CHECK TO SEE IF
984 * NAME IS IN IMPLICIT MODE TABLE AND SET
991 JMP* TG00 RETURN, ELSE
992 JST NU00 NO * USAGE TEST
995 TG04 LDA ID+1 CHARACTERS 3 AND 4
996 CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE
1000 JMP TG04 NOT DONE WITH TABLE
1001 TG08 LDA K101 =1 (IU=SUBR.)
1004 LDA DP+1,1 IU(A) = SUB
1011 TG10 LDA ID CHARACTERS 1 AND 2
1016 JMP TG06 CONTINUE SEARCH
1017 LDA ID+2 CHARACTERS 5 AND 6
1020 JMP TG06 CONTINUE SEARCH
1023 ANA K107 =7 (=3 IF CPX, 4 IF DBL)
1024 ADD K102 =2 (=5 IF CPX, 6 IF DBL)
1028 TG22 OCT 177753 =-21
1030 *...........IMPLICIT MODE SUBROUTINE NAME TABLE
1031 TGT1 BCI 6,DECEDLCLDLDS
1035 TGT2 BCI 6,XPXPOGOGOGIN
1048 * - TV00 TAG VARIABLE
1050 LDA IU IF IU = 'VAR',
1054 JST NU00 ELSE, NO USAGE TEST
1057 ANA K111 IU (A) = 'VAR'
1069 * SET ASSIGNMENT DATA FROM ASSIGN (EXCEPT ID)
1070 * EXPAND DIMENSION INFO IF ARRAY
1085 STA D0 D0 = NUMBER OF WORDS
1088 STA X X = POINTER TO CONSTANT NUMBER OF WORDS
1093 SUB K103 IF IU NOT 'ARR'
1103 STA X1 POINTER OF DIMENSION 1
1105 STA X2 POINTER OF DIMENSION 2
1107 STA X3 POINTER OF DIMENSION 3
1110 STA AF AF = GF(GF(A))
1114 STA ND NUMBER OF DIMENSIONS
1120 FA22 LDA X3 FETCH 3RD DIMENSION SIZE
1127 STA D2 D2 = 2ND DIMENSION SIZE
1131 STA D1 D1 = 1ST DIMENSION SIZE
1132 JST STXA EXIT WITH AF IN A
1136 LDA DP,1 IM OF SUBSCRIPT VALUE
1140 SZE SKIP IF DUMMY SUBSCRIPT
1141 LDA DP+4,1 FETCH VALUE OF SUBSCRIPT
1151 * EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE
1156 LDA DP,1 A = 5 * CL(A)
1160 ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC)
1162 JST FA00 FETCH ASSIGN
1163 JST KT00 D0 = = WDS /ITEM
1169 * *******************
1170 * *D0=WORDS FOR LINK*
1171 * *******************
1172 * D = ITEM MODE SIZE TIMES THE TOTAL SIZE IF
1173 * THE ITEM IS AN ARRAY
1176 LDA IU IF IU NOT 'ARR'
1181 IAB D0 = D0 * D1 * D2 * D3
1183 JST IM00 MULTIPLY A BY B
1186 JST IM00 MULTIPLY A BY B
1189 JST IM00 MULTIPLY A BY B
1198 * IM SUBA = IM (SET FROM A REG)
1202 JST STXA ESTABLISH A
1216 * AF SUBA = AF (SET FROM A REG)
1222 DA10 LDA DP+1,1 IF IU (A) NOT ARR
1224 CAS K103 GF (A) : AF
1226 JMP DA20 ELSE, GF (GF (A)) = AF
1235 NXT DAC ** GET NEXT ENTRY
1236 LDA A FROM ASSIGNMENT
1246 STA NTA NT(A) = NT FROM (A)
1249 STA ATA AT(A) = AT FROM (A)
1252 STA IMA IM(A) = IM FROM (A)
1255 STA CLA CL(A) = CL FROM (A)
1258 STA IUA IU(A) = IU FROM (A)
1261 STA GFA GF(A) = GF FROM (A)
1263 STA TIDA+2 TID(A) = TID FROM (A)
1269 STA DTA DT(A) = DT FROM (A)
1272 STA TTA TT(A) = TT FROM (A)
1273 LDA NTA NT(A) = NT FROM (A)
1285 BUD DAC ** BUILD ASSIGNMENT
1300 ADD K102 AT = STR/+BS
1335 * AT SUBA = AT (FROM B REG), THEN DEFINE AF
1346 STA DP,1 AT(A) = CONTENTS OF B INPUT
1357 * SET AF = RPL, AT = REL
1364 * *************************
1365 * *ASSIGN INTEGER CONSTANT*
1366 * *************************
1367 * IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL
1375 JST AA00 ASSIGN SPECIAL
1382 * B REG TO IM, A REG TO IU, 1 TO NT (CONSTANT), THEN
1390 JST AS00 ASSIGN ITEM
1399 * CLEAR LAST OP FLAG FOR NO PATH TESTING
1403 * SET ILLEGAL DO TERM FLAG
1407 JST TS00 IF TC NOT C/R, ERROR
1414 * WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH
1415 * DO TABLE FOR DO TERMINATION
1417 SZE IF LIF NON-ZERO,
1419 C6A LDA LSTN IF LSTN NON-ZERO,
1422 C6B STA LSTF LSTF = 0
1423 JMP C7 GO TO STATEMENT INPUT
1424 C6C SUB TRF TRACE FLAG
1425 SNZ SMP IF NOT END OF TRACE ZONE
1426 STA TRF SET TRF TO ZERO (TURN FLAG OFF)
1427 LDA DO START OF DO TABLE
1429 C6D STA I I = DO + D
1433 JMP C6B GO TO C6B - FINISHED DO
1441 JST DQ00 DO TERMINATION
1449 JMP C6D I = I-5 - CONTINUE DO LOOP
1455 LDA OMI5 (A) = JMP INSTRUCTION
1461 STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG
1462 JST OS00 OUTPUT STRING - RPL
1473 * SET UP PROCESSING OF NEXT SOURCE STATEMENT
1474 * PROCESS STATEMENT NUMBER IF PRESENT
1475 * WRAPUP ANY OUTSTANDING ARITHMETIC IF
1482 LDA CI CHECK CARD COLUMN 1
1483 LGR 8 FOR $ CHARACTER
1486 JMP CCRD CONTROL CARD
1487 JST XN00 EXAMINE NEXT CHAR
1490 JST IS00 INPUT STATEMENT =
1494 C71 LDA IFF CHECK FOR IFF=0
1502 C7B JST C7LT LINE TEST
1507 LDA K201 (A) = JMP INSTRUCTION
1511 C7LT DAC ** LINE TEST
1517 SUB HC2 IF TC : SPECIAL
1522 C7LU JST ER00 CONSTRUCTION ERROR
1523 BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD
1527 * ************************
1528 * *CONTROL CARD PROCESSOR*
1529 * ************************
1530 CCRD JST FS00 FLUSH BUFFER IF NECESSARY
1532 LDA CI WORD CONTAINING COLUMN 1
1535 LDA CCRK ='030000 (EOJ CODE = 3)
1536 LGR 6 TRUNCATE TO A DIGIT
1539 STA OCNT SET BUFFER WORD COUNT TO 3
1540 JST FS00 FLUSH BUFFER
1542 LGL 12 CHECK COLUMN 1 FOR CONTROL CODE 0
1544 JMP ER20 SKIP TO NEXT CARD (NOT CONTROL CARD)
1545 CALL F4$END CLOSE-OUT I/0 DEVICES AND STOP
1546 JMP A0 RESTART NEW COMPILATION
1547 CCRK OCT 030000 EOJ CONTROL CODE
1552 * DETERMINE THE CLASS OF THE STATEMENT
1553 * IF AN = IS FOUND WITH A FOLLOWING ,
1554 * THE STATEMENT IS A DO
1555 * IF NO FOLLOWING COMMA, THE PAREN FLAG
1556 * IS TESTED, IF NO PARENS, THE STATEMENT
1557 * IS ARITHMETIC ASSIGNMENT
1558 * IF PARENS WERE DETECTED AND THE FIRST
1559 * NAME IS AN ARRAY, THE STATEMENT IS
1560 * ARITHMETIC ASSIGNMENT
1561 * OTHERWISE, IT IS A STATEMENT FUNCTION
1562 * IF NO = IS FOUND, THE STATEMENT IS
1563 * PROCESSED FURTHER IN STATEMENT ID
1571 C8A JST CH00 INPUT CHARACTER
1572 C8B LDA TC IF TC = )
1577 C8B2 LDA DFL IF DFL NOT ZERO
1580 C8B4 LDA C8X9 RESTORE CC
1584 JMP A9 GO TO STATEMENT ID
1585 C8C LDA TC IF TC NOT (,
1589 LDA C8T1 T1 = T1 - 1
1596 C8D LDA TC IF TC = ,
1597 CAS K134 ='17 ('FINISHED' CODE FOR COMMA)
1603 C8D2 LDA C8T1 GO TO C8C4,
1605 C8E LDA TC ELSE, IF TC = '/'
1613 LDA K107 INPUT 7 CHARACTERS
1623 LDA K102 ELSE, INPUT 2 CHARS
1625 LDA IBUF IF (A) = 'DO'
1630 BCI 1,CM COMMA OUTSIDE PARENTHESES, NOT IN DO STMNT,
1632 JST NP00 FIRST NON-SPEC CHECK
1634 C8G LDA C8T1 1 IF NO ( TO LEFT OF EQUALS
1636 JMP G2 ARITHMETIC ASSIGNMENT STATEMENT
1637 JST SY00 INPUT SYMBOL
1643 JMP G1 GO TO ARITH ST. FUNCT,
1644 JMP G2 OTHERWISE = ASSIGNMENT STATEMENT