1 * C210-001-6601 (FRTN) 3C NO.180463000 REV. D
5 * COMPUTER. DDP-116,516
10 * PROGRAM CATEGORY- COMPILER
16 * EXPANDED FORTRAN IV COMPILER
28 * PROG--------------------- ------------
31 * SUPR---------------------- ------------
34 * QUAL---------------------- ------------
37 * NO. OF PAGES ------------
42 * REV. C ECO 3824 10-31-66
43 * REV. B ECO 3476 09-19-66
48 * HONEYWELL. INC. - COMPUTER CONTROL DIVISION
53 * THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV
54 * PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE
60 * MINIMUM 8K CORE STORAGE
72 * ********************************
74 * *FORTRAN-IV OPERATING PROCEDURE*
75 * ********************************
77 * 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE'
78 * (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES
80 * 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE
81 * SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE
82 * SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START.
84 * 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY).....
85 * 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS
86 * OPTION IS USED WHEN COMPILING THOSE PARTS OF THE
87 * LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE
88 * LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO
89 * GENERATE SPECIAL CODING.
93 * 8-10...INPUT DEVICE SELECTION
94 * 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER)
96 * 3 = DIGITRONICS PAPER TAPE READER
97 * 4 = MAGNETIC TAPE ( UNIT 1 )
100 * 11-13..SYMBOLIC LISTING SELECTION
101 * 0. SUPPRESS ALL SYMBOLIC LISTINGS
102 * 1. ASR-33/35 TYPEWRITER
105 * 4 = LISTING ON MAGNETIC TAPE UNIT 2
108 * 14-16..BINARY OUTPUT SELECTION
109 * 0. SUPPRESS BINARY OUTPUT.
110 * 1. BRPE HIGH SPEED PAPER TAPE PUNCH
111 * 2. ASR BINARY OUTPUT ASR/33
112 * 3. ASR BINARY OUTPUT ASR/35
113 * 4 = MAGNETIC TAPE OUTPUT
117 * 4. SENSE SWITCH SETTINGS AND MEANINGS.......
118 * 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE
119 * SIDE-BY-SIDE OCTAL INFORMATION.
120 * 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET).
121 * 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING
122 * THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT
123 * STATUS OF THE I/O KEYBOARD, IT MAY BE
124 * CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING
125 * SSW-3 AND PRESSING START TO CONTINUE.
126 * 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED
127 * IN THE OBJECT CODING BEING GENERATED REGARDLESS OF
128 * ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR
131 * 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER
132 * AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A
133 * LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF
134 * TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE
135 * PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START'
136 * TO PROCESS THE NEXT PROGRAM (BATCH COMPILING).
138 * FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS
139 * PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT
145 * THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A
146 * SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION.
147 * *************************
148 * *DATA POOL ENTRY FORMATS*
149 * *************************
151 * THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION
152 * 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS
153 * AT THE END OF THE COMPILER AND EXTENDS TOWARD THE
156 * TDCCCCCCCCCCCCCC....DP(A+4)
157 * CCCCCCCCCCCCCCCC....DP(A+3)
158 * CCCCCCCCCCCCCCCC....DP(A+2)
159 * IIAAAAAAAAAAAAAA....DP(A+1)
160 * NRRRMMMLLLLLLLLL....DP(A)
164 * C = SIX 8-BIT CHAR. OR BINARY CONSTANT
165 * I = ITEM USAGE (IU)
166 * 0 = NO USAGE 2 = VAR/CONSTAN^
167 * 1 = SUBPROGRAM 3 = ARRAY
168 * A = ASSIGNMENT ADDRESS
170 * 0 = NAME 1 = CONSTANT
171 * R = ADDRESS TYPE (AT)
172 * 0 = ABSOLUTE 3 = STRING-REL
173 * 1 = RELATIVE 4 = COMMON
174 * 2 = STRING-ABS 5 = DUMMT
176 * 1 = INTEGER 5 = COMPLEX
177 * 2 = REAL 6 = DOUBLE
180 * 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT
181 * TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT
182 * A DO-LOOP, EACH ENTRY IS 5 WORDS.
188 * I = INITIAL VALUE/OR RPL
192 * N = STATEMENT NUMBER
194 * 3. THE EXPRESSION TABLE (A0I TABLE) 'FLOATS' ON TOP
195 * THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES.
197 * NOOOOOOOOIIIIIII.....DP(I+1)
198 * 00AAAAAAAAAAAAAAAA...DP(I)
199 * N = NEGATION INDICATOR
201 * I = INDEX (OPERATOR LEVEL)
202 * A = ASSIGNMENT TABLE REFERENCE
203 * 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND
204 * IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE
205 * COMPILER. EACH ENTRY IS THREE WORDS LONG.
207 * S000000000PPPPPP.....DP(L+2)
208 * 0011111111111111.....DP(L+1)
209 * 0022222222222222.....DP(L)
210 * S = TEMP STORAGE INDICATOR
212 * 1 = FIRST OPERAND ADDRESS
213 * 2 = SECOND OPERAND ADDRESS
217 * ************************************
218 * * DIRECTORY OF FORTRAN IV COMPILER *
219 * ************************************
223 *..............ENTRANCE GROUP
224 DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE
225 DAC DP DATA POOL START
227 *..............INPUT GROUP
228 DAC IC00 (IPG1) INPUT COLUMN
229 DAC UC00 (IPG2) UNINPUT COLUMN
230 DAC CH00 (IPG3) INPUT CHARACTER
231 DAC ID00 (IPG4) INPUT DIGIT
232 DAC IA00 (IPG5) INPUT (A) CHARACTERS
233 DAC FN00 (IPG6) FINISH OPERATOR
234 DAC DN00 (IPG7) INPUT DNA
235 DAC II00 (IPG8) INPUT ITEM
236 DAC OP00 (IPG9) INPUT OPERAND
237 DAC NA00 (IPG10) INPUT NAME
238 DAC IG00 (IPG11) INPUT INTEGER
239 DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT
240 DAC IR00 (IPG13) INPUT INTEGER VARIABLE
241 DAC IS00 (IPG14) INPUT STATEMENT NUMBER
242 DAC XN00 (IPG15) EXAMINE NEXT CHARACTER
243 DAC SY00 INPUT STMBOL
245 *..............TEST GROUP
246 DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R)
247 DAC IP00 (TSG2) )-INPUT OPERATOR
248 DAC A1 (TSG3) C/R TEST
249 DAC B1 (TSG4) , OR C/R TEST
250 DAC NU00 (TSG5) NO USAGE TEST
251 DAC NC00 (TSG6) NON CONSTANT TEST
252 DAC NS00 (TSG7) NON SUBPROGRAM TEST
253 DAC AT00 (TSG8) ARRAY TEST
254 DAC IT00 (TSG9) INTEGER TEST
255 DAC NR00 (TSG10) NON REL TEST
257 *..............ASSIGNMENT GROUP
258 DAC AS00 (ASG1) ASSIGN ITEM
259 DAC TG00 (ASG2) TAG SUBPROGRAM
260 DAC TV00 (ASG3) TAG VARIABLE
261 DAC FA00 (ASG4) FETCH ASSIGN
262 DAC FL00 (ASG5) FETCH LINK
263 DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION
264 DAC DM00 (ASG7) DEFINE IM
265 DAC DA00 (ASG8) DEFINE AF
266 DAC AF00 (ASG9) DEFINE AFT
267 DAC LO00 (ASG10) DEFINE LOCATION
268 DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT
269 DAC AA00 (ASG12) ASSIGN SPECIAL
270 DAC NXT GET NEXT ENTRY FROM ASSGN TABLE
271 DAC BUD BUILD ASSIGNMENT TABLE ENTRT
273 *..............CONTROL GROUP
276 DAC C6 (CNG2) CONTINUE
277 DAC C7 (CNG3) STATEMENT INPUT
278 DAC C8 (CNG4) STATEMENT SCAN
279 DAC A9 (CNG5) STATEMENT IDENTIFICATION
280 DAC NP00 (CNG6) FIRST NON-SPEC CHECK
282 *..............SPECIFICATIONS GROUP
283 DAC EL00 (SPG1) EXCHANGE LINKS
284 DAC NM00 (SPG2) NON COMM0N TEST
285 DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST
286 DAC SC00 (SPG4) INPUT SUBSCRIPT
287 DAC IL00 (SPG5) INPUT LIST ELEMENT
288 DAC R1 (SPG6) FUNCTION
290 DAC A3 (SPG7) INTEGER
292 DAC A5 DOUBLE PRECISION
295 DAC B2 (SPG8) EXTERNAL
296 DAC B3 (SPG9) DIMENSION
297 DAC B7 INPUT DIMENSION
298 DAC B4 (SPG10) COMMON
299 DAC B5 (SPG11) EQUIVALENCE
300 DAC C2 (SPG12) RELATE COMMON ITEMS
301 DAC C3 (SPG13) GROUP EOUIVALENCE
302 DAC C4 (SPG14) ASSIGN SPECIFICATIONS
304 DAC R3 (SPG16) BLOCK DATA
305 DAC TRAC (SPG17) TRACE
307 *..............PROCESSOR GROUP
310 DAC IB00 INPUT BRANCH LIST
313 DAC V7 (PRG6) END FILE
319 DAC SI00 INPUT FORMAT STRING
320 DAC IN00 INPUT NUMERIC FORMAT STRING
321 DAC NZ00 NON ZERO STRING TEST
325 DAC G2 ASSIGNMENT STATEMENT
326 DAC R9 (PRG11) RETURN
327 DAC G1 (PRG12) STATEMENT FUNCTION
330 *..............PROCESSOR SUBROUTINES GROUP
331 DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK
332 DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING
333 DAC DP00 (PSG3) DO INPUT
334 DAC DS00 (PSG4) DO INITIALIZE
335 DAC DQ00 (PSG5) DO TERMINATION
336 DAC EX00 (PSG6) EXPRESSION
338 DAC ST00 TRIAD SEARCH
339 DAC TC00 TEMP STORE CHECK
340 DAC ET00 (PSG8) ENTER TRIAD
341 DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE
343 *..............OUTPUT GROUP
344 DAC OL00 (OPG1) OUTPUT OBJECT LINK
345 DAC OI00 (OPG2) OUTPUT I/O LINK
346 DAC CN00 (OPG3) CALL NAME
347 DAC OK00 (OPG4) OUTPUT PACK
348 DAC OB00 (OPG5) OUTPUT OA
349 DAC OT00 (OPG6) OUTPUT TRIADS
350 DAC OM00 (OPG7) OUTPUT ITEM
351 DAC OR00 (OPG8) OUTPUT REL
353 DAC OS00 OUTPUT STRING
354 DAC OW00 (OPG9) OUTPUT WORD
356 DAC FS00 (OPG10) FLUSH
357 DAC TRSE (OPG11) OUTPUT TRACE COUPLING
358 DAC PRSP SET BUFFER TO SPACES
360 *..............MISC. GROUP
361 DAC AD3 ADD TWO 3 WORD INTEGERS
362 DAC IM00 MULTIPLY (A) BY (B)
363 DAC STXA SET A INTO INDEX
364 DAC STXI SET I INTO INDEX
365 DAC NF00 SET FS INTO NAMF
366 DAC BLNK SET AREA TO ZEROS
367 DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE
368 DAC CIB COMPARE IBUF TO A CONSTANT
369 DAC SAV SAVE INDEX IN PUSH-DOWN STACK
370 DAC RST RESET INDEX FROM PUSH-DOWN STACK
372 DAC ER00 ERROR OUTPUT
373 DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.)
374 DAC SFT SHIFT LEFT 1 (TRIPLE PRES.)
378 * ****************************
379 * *CONSTANT AND VARIABLE POOL*
380 * ****************************
382 XR EQU 0 INDEX REGISTER
383 * THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING
384 * PROGRAM INITIALIZATION
385 A EQU '40 ASSIGNMENT TABLE INDEX
386 I EQU A+1 EXPRESSION TABLE INDEX
390 MFL EQU A+5 MODE FLAG
391 SFF EQU A+6 FUNCTION FLAG
392 SBF EQU A+7 SUBFUNCTION FLAG
393 SXF EQU A+8 POSSIBLE CPX FLAG
394 SPF EQU A+9 PEC. FLAG
395 TCF EQU A+10 TEMP STORE COUNT
397 ABAR EQU A+12 BASE OF ASSIGN TABLE
398 XST EQU A+13 FIRST EXECUTABLE STMNT.
399 CFL EQU A+14 MON FLAG
401 RPL EQU A+16 RELATE PROGRAM LOCATION
402 BDF EQU A+17 LOCK DATA FLAG
403 SLST EQU A+18 SOURCE LIST
404 OBLS EQU A+19 OUTPUT BINARY LIST
405 BNOT EQU A+20 BINART OUTPUT FLAG
406 TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.)
407 TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN
408 * AN EXPRESSION (FOR USE BY TRACE).
409 SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET)
410 LIF EQU A+24 LOGICAL IF FLAG
411 LSTN EQU A+25 LAST STATEMENT NO.
412 LSTF EQU A+26 LAST STATEMENT FLAG
413 LSTP EQU A+27 LAST STATEMENT STOP
414 SDSW EQU A+28 STATEMENT I0 SWITCH
416 NAMF EQU '570 NAME FUNCTION
417 ND EQU NAMF+1 NO OF DIMENSIONS
418 NS EQU '572 NO OF SUBSCRIPTS
420 NTF EQU NS+2 NAME TAG FLAG
421 NTID EQU NS+3 NO. WORDS IN TID
422 O1 EQU NS+4 OPERATOR 1
423 O2 EQU NS+5 OPERATOR 2
426 OCNT EQU NS+8 OUTPUT COUNT
428 S1 EQU NS+10 SUBSCRIPT NO.1
429 S2 EQU NS+11 SUBSCRIPT NO.2
430 S3 EQU NS+12 SUBSCRIPT NO.3
431 TC EQU NS+13 TERMINAL CHAR
434 X EQU NS+16 ARRAY INDICES
439 NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS
446 *..........ADJUST THIS ORG IF THE SIZE OF THE CONSTAST POOL IS MODIFIED
448 AF PZE 0 ADDRESS FIELD
450 AT PZE 0 ADDRESS TYPE
451 CODE PZE 0 OUTPUT CODE
460 DFL PZE 0 DELIMITER FLAG
461 E OCT 0 EQUIVALENCE INDEX
464 FTOP PZE 0 OUTPUT COMMAND
466 ICSW PZE 1 INPUT CONTROL SWITCH
474 DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT)
475 CC PZE '111 CARD COLUMN COUNTER
476 DCT PZE 0 DUMMY ARGUMENT COUNT
477 F PZE 0 TRIAD TABLE INDEX
478 CL PZE 0 ASSIGNMENT ITEMS UNPACKED
480 FLT1 PZE 0 FETCH LINK CL POINTER LOCATION
481 LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET)
482 *..........CONSTANTS USED BY THE COMPILER
504 K60 OCT 260 00 (BCI ZERO)
540 HBIT OCT 140000 HIGH BITS FOR ALPHA DATA
541 KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT
547 DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET
548 * BY THE FORTRAN IOS SUBROUTINE.)
549 L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS)
550 * THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER
551 * TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS
552 * 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL
553 * CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL
554 * LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER
558 PZE DP-3,1 (101) DATA POOL REFERENCES
568 PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS
572 JST ER00 THIS INSTRUCTION REACHED ONLY IF THE
573 BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE.
578 * *******************
579 * *START OF COMPILER*
580 * *******************
586 * - A0 COMP ENT EMPTY BUFFERS
588 STA LIBF SET SPECIAL LIBRARY FLAG
589 LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS)
590 A0 CALL F4$INT INITIALIZE I/O DEVICES
593 JST IC00 INPUT COLUMN
596 LDA A092 LOC, OF INDEX PUSH-DOWN BUFFER
597 STA SAV9 INITIALIZE PUSH-DOWN BUFR,
599 STA A+M,1 SET M VARIABLES TO ZERO
605 JST FS00 INITIALIZE OUTPUT BUFFER
607 STA LSTF LSTF NOT EQ 0
608 STA LSTP LSTP NOT EQ 0
609 STA EBAR EBAR SET NEGATIVE
612 STA E0 INITIALIZE EQUIVALENCE TABLE
613 STA L INITIALIZE TRIAD TABLE POINTER
614 JST PRSP SET PRINT BUFFER TO SPACES
616 STA DO INITIALIZE DO TABLE POINTER
621 A055 IRS ID ESTABLISH CONSTANTS
630 LRL 32 (B)=0 IM=NO USAGE
631 LDA K101 (A)=1 IU=SUBR
632 JST AA00 ASSIGN (SPECIAL)
633 JST STXA SET POINTER A INTO INDEX AND (A)
634 STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK)
635 ADD K122 ='40000 (IU=SUBR)
636 STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFI
637 JMP C7 GO TO STMNT INPUT
641 A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER
649 * INPUT NEXT CHARACTER
652 * IC02 SET AS FOLLOWS -
655 IC00 DAC ** LINK STORE
657 LDA CC IF CC = 73, GO TO IC 10
660 JMP IC19 ELSE, GO TO IC
661 IC10 LDA ICSW IF ICSW. GO TO IC12
663 JMP IC24 ELSE, GO TO IC24
664 IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE
670 JMP IC30 COMMENT CARD (IGNORE)
673 JMP IC18 CONTROL CARD (IGNORE COLUMN 6)
674 LDA K357 IF CARD COL, SIX IS
675 ANA CI+2 ZERO OR BLANK, GO TO IC18
678 JMP IC26 ELSE, GO TO IC26
680 LDA CI+2 CI(6) = SPECIAL
686 IC19 LDA CC TC = CI(CC)
696 IC22 JST RST RESTORE INDEX
698 IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN
701 IC26 JST LIST LIST, CONTINUATION CARD
702 LDA K107 CC = 7. IGNORE STATEMENT NO.
705 IC30 JST LIST PRINT CARD IMAGE
706 JMP IC12 READ IN NEW CARD
709 KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER
730 * INPUT ONE CHARACTER FROM EITHER
731 * 1, INPUT BUFFER (EBAR POSITIVE) OR
732 * 2, EQUIVALENCE BUFFER (EBAR NEGATIVE)
735 LDA EBAR IF EBAR 7 0,
738 CH03 JST IC00 INPUT COLUMN
739 SUB K8 IF BLANK, REPEAT
755 CRA ALPHA NUMERIC CHARACTER
756 CH05 STA DFL DELIMITER ENTRY
757 LDA TC EXIT WITH TC IN A
765 CH10 LDA E IF E = EBAR
769 STA 0 SET E INTO INDEX
770 LLL 16 SET (B) TO ZERO
771 LDA DP,1 CURRENT CHARACTER WORD
773 STA DP,1 SAVE REMAINING CHARACTER IF ANY
775 STA TC TC=LEFTMOST CHARACTER
776 SZE SKIP IF NEW CHARACTER WORD NEEDED
781 JMP CH10 PICK UP NEXT CHARACTER WORD
782 CH12 SSM MAKE E MINUS
784 JMP C4 GO TO ASSIGN SPEC
792 * A IS ZERO IF NOT DIGIT
794 ID00 DAC ** INPUT DIGIT
795 JST CH00 INPUT A CHAR
798 JMP ID10 ELSE, (A) = 0
807 * **********************
808 * *INPUT (A) CHARACTERS*
809 * **********************
810 * CHAR COUNT IN XR, TERMINATES WITH EITHER
811 * 1, CHAR COUNT -1 = ZERO OR
812 * 2, LAST CHAR IS A DELIMITER
817 JST IA50 EXCHANGE IBUF AND ID
820 IA10 JST CH00 INPUT A CHARACTER
822 LDA DFL IF DFL NOT ZERO,
825 IRS IA99 TEST COUNTER
826 JMP IA10 MORE CHARACTERS TO INPUT
827 IA20 JST IA50 EXCHANGE ID AND IBUF
829 IA50 DAC ** EXCHANGE IBUF AND ID
838 JST RST RESTORE INDEX
848 * WRAP UP LOGICAL/RELATIONAL OPERATORS
851 LDA DFL IF DFL NOT . ,
858 FN05 LDA K110 USE TABLE TO CONVERT
868 FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR
871 FN90 OCT 253,255,252,257 +-*/
872 BCI 9,NOANORLTLEEQGEGTNE
874 FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17
880 * BASIC INPUT ROUTINE, HANDLES FOLLOWING -
881 * CONSTANT CONVERSION
882 * MODE TYPING (CONSTANTS, IMPLIED/VARIABLES)
883 * ALL OPERATORS (TERMINATE ITEM)
886 TID EQU ID TEMP STORE FOR ID
887 IBUF BSS 3 3-WORD BUF
895 F3 PZE 0 INPUT EXPONENT
896 F4 PZE 0 NO, FRAC. POSITIONS
897 F5 PZE 0 TEMP DELIMITER STORE
900 HOLF PZE 0 HOLLERITH FLAG
908 JST BLNK CLEAR OUT TID = ID
915 DN07 JST ID00 INPUT DIGIT
917 JMP DN14 (A) NON-ZERO, G0 T0 DN14
918 DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST
919 ANA K158 POSITION COUNT IF NECESSARY,
924 ADD F4 F4 = F4+1 IF NO OVERFLOW
925 STA F4 AND IM ALREADY SET TO REAL
930 JST SFT SHIFT ID LEFT
932 JST MOV3 MOVE TO TEMP STORE
937 JST AD3 ID = 10*ID+TC
951 DN14 LDA IM IM = REAL
954 JMP DN50 NO, GO TO DN50
957 LDA DFL IF DFL =0, GO SO DN20 (5)
959 JMP DN90 ELSE GO TO DN90 (9)
960 DN20 LDA TC IF TC = D, GO TO DN26
964 SUB K101 ELSE, IF TC = E, GO TO DN22
966 JMP DN22 TERMINATOR = E
969 STA DFL SET DELIMITER FLAG
971 STA IM SET ITEM MODE TO INTEGER
972 JMP DN67 FINISH OPERATOR AND EXIT
974 DN22 JST ID00 INPUT DIGIT
975 SNZ IF (A) = 0, GO TO DN30
977 LDA TC IF TC = -, GO TO DN28
986 JST UC00 UN-INPUT COL
987 DN24 JST FN00 FINISH OPERATOR
988 DN25 LDA K101 IM = INT
990 LDA ID+1 IF ID IS TOO BIG TO
991 SZE BE AN INTEGER (>L2),
992 JMP DN69 GO TO DN69 (20)
996 JMP DN84 OTHERWISE, GO TO DN84(12)
997 DN26 LDA K106 IM = DBL
1000 DN28 LDA K101 F2 = 1
1002 DN29 JST ID00 INPUT DIGIT
1003 SZE IF (A) = 0, GO TO DN30 (8.5)
1004 JMP DN69 ELSE, GO TO DN69 (20)
1005 DN30 LDA F3 F3 = 10 * F3
1012 STA F3 IF (A) = 0, GO TO DN30 (8.5)
1013 JST ID00 ELSE, GO TO DN90 (9)
1017 DN50 LDA K102 IM=REA
1019 LDA TC IF TC = ., GO TO DN54
1024 SNZ IF NT = 0, GO TO DN72
1026 LDA TC IF TC = H, GO TO DN9H (22)
1031 SZE GO TO DN16 (4.9)
1032 JMP DN25 ELSE, GO TO DN25
1034 DN54 JST ID00 INPUT DIGIT
1036 JMP DN10 IF (A) = 0, GO TO DN10 (3)
1038 SNZ IF NT = 0, GO TO DN56
1041 JMP DN16 GO TO DN16 (4)
1044 DN58 JST UC00 UN-INPUT A COLUMN,
1045 LDA F1 IF F1 = 0, GO TO DN60
1047 JMP DN63 ELSE, GO TO DN63 (15)
1049 JST IA00 INPUT (6) CHARS
1050 JST CIB IF IBUF = TRUE.,
1053 JST CIB IF IBUF = FALSE.,
1054 DAC K2+3,1 GO TO DN66 (16)
1056 JST CIB CHECK FOR .NOT. OPERATOR
1057 DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR
1058 JMP DN9N OPERATOR IS .NOT.
1061 JMP DN67 GO TO DN67 (18)
1065 STA NT NAME TAG = 1 (CONSTANT)
1071 DN67 JST FN00 FINISH OPERATOR
1072 DN68 LDA F6 IF F6 = 0,
1082 DN72 LDA F1 IF F1 = 0, GO TO DN74
1085 LDA F1 ELSE, TC = F1
1087 JMP DN58 GO TO DN58 (14)
1088 DN74 LDA TC IF TC = -, GO TO DN82
1092 ADD K102 CHECK FOR TC = +
1095 LDA DFL IF DFL = NON-ZERO
1097 JMP DN63 GO TO DN63 (15)
1106 DN78 LDA K101 IM < INT
1108 DN80 LDA TC PACK TC TO ID
1111 LDA DFL IF DFL IS NOT ZERO,
1114 LDA NTID IF NTID = 6, GO TO DN67
1120 STA F1 F1 = CONVERTED TC
1121 JMP DN06 GO TO DN06 (2)
1122 DN84 LDA F1 IF F1 = -,
1123 SUB K102 GO TO DN85(13)
1127 SUB TID COMPLEMENT THREE WORDS AT TID
1141 DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18)
1144 LDA IM IF IM NOT = REA,
1149 SNZ IF F6 = 0, GO TO DN87
1162 JST IP00 )-INPUT OPERATOR
1163 JMP DN70 GO TO DN70 (21)
1164 DN87 LDA TC IF TC = ,
1167 JMP DN67 TID-BAR = TID
1169 STA TIDB GO TO DN01 (1)
1171 STA TIDB+1 ELSE, GO TO DN67 (18)
1177 DN90 LDA F2 IF F2= 0, GO TO DN9A (10)
1183 DN9A LDA F3 F4 = F3 - F4
1186 LDA K12 F2 = EXP, BIAS + MANTISSA
1190 ADD TID+2 GO TO DN85(13)
1196 JMP DN9D ID IS NORMALIZED
1199 * F2 = F2 - = SHIFTS
1203 JMP DN9C CONTINUE NORMALIZE LOOP
1207 JMP DN9G FINISHED E FACTOR LOOP
1210 LDA K155 DIVIDE LOOP COUNTER
1225 JMP DND1 REDUCE DIVIDE COUNTER
1244 JST AD3 ADD THREE WORD INTEGERS
1246 * CONVERT THREE WORD INTEGER TO INTERNAL FORMAT
1254 BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW)
1263 LDA TID PACK UP TRIPLE PRECISION
1270 JMP DN69 GO TO DN69 (20)
1271 JMP DN84 ELSE. GO TO DN84 (12)
1282 STA HOLF HOLF=NO.OF HOLLERITH CHARS,
1286 JMP DN9K FIELD WIDTH OF ZERO
1287 STA F2 F2= -1(1 CHAR) OR -2(2 CHAR)
1288 JST BLNK SET ID,ID+1(ID+2 TO ZERO
1290 DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS)
1291 JST PACK PACK CHARACTERS 2 PER WORD
1292 IRS F2 REDUCE CHARACTER COUNT
1293 JMP DN9J INPUT AND PACK MORE CHARACTERS
1294 LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT
1299 JST PACK SHIFT A SPACE INTO THE LAST WORD
1301 DN9M JST CH00 INPUT THE TERMINATING CHARACTER
1302 JMP DN67 FINISH OPERATOR AND EXIT
1305 DN9N LDA K105 SET .NOT. OPERATOR (TC=5)
1306 STA TC SET .NOT. OPERATOR (TC=5)
1308 STA IM IM=0 = UNDEFINED
1311 DNX2 DAC ** OVERFLOW FLAG
1318 * INPUTS AND ASSIGNS ITEM (IF ONE EXISTS)
1324 JST AS00 NO, ASSIGN ITEM
1326 JMP* II00 RETURN (A) = IM
1332 * EXIT WITH ITEM MODE IN A (TC SET TO . IF NO
1335 OP00 DAC ** INPUT OPERAND
1338 JMP* OP00 ELSE (A) = IM, RETURN
1348 * INPUT OPERAND AND ENSURE THAT IT IS A NAME
1350 NA00 DAC ** INPUT NAME
1351 JST OP00 INPUT OPERAND
1357 NA10 LDA IM (A) = IM
1364 * INPUT ITEM AND ENSURE THAT IT IS AN INTEGER CONSTANT
1367 IG00 DAC ** INPUT INTEGER
1368 JST DN00 INPUT - DNA
1371 JMP IG20 AND NT = 1,
1372 LDA NT AND IM = INT,
1375 LDA IM LSE, GO TO IG20
1388 BCI 1,IN INTEGER REQUIRED
1391 * ***********************
1392 * *INPUT INTEGER VAR/CON*
1393 * ***********************
1396 JST OP00 INPUT OPERAND
1398 JST TV00 TAG VARIABLE
1402 * ************************
1403 * *INPUT INTEGER VARIABLE*
1404 * ************************
1406 IR00 DAC ** INPUT INT VAR
1407 JST IV00 INPUT INT VAR/CON
1408 JST NC00 NON-CONSTANT TEST
1412 * ************************
1413 * *INPUT STATEMENT NUMBER*
1414 * ************************
1415 * NUMBER IS FORMED AS SPECIAL NAME , NOT CONVERTED
1422 STA IU IU = IM = IT = 0
1423 STA NTID PUT LEADING 'S' IN STATEMENT NO,
1426 IS10 JST ID00 INPUT DIGIT
1428 JMP IS20 NOT A DIGIT GO TO IS20
1434 JST PACK PACK TC TO ID - LEGAL ST, NO, CHAR
1438 JMP IS04 IGNORE LEAD ZERO ON ST. NO,
1445 BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT
1446 IS25 JST AS00 ASSIGN ITEM
1451 LDA AF ADDRESS FIELD IS
1452 CAS XST LE XST - ALREADY ASSIGNED
1454 JMP* IS00 OK - OTHERWISE
1455 LDA AT MUST HAVE STR-ABS OTHERWISE
1460 BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER
1464 SY00 DAC ** INPUT SYMBOL
1466 STA NTF NTF NOT 0 - DON'T SET IU IN AS00
1470 * ************************
1471 * *EXAMINE NEXT CHARACTER*
1472 * ************************
1473 * CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT)
1476 JST ID00 INPUT DIGIT
1477 JST UC00 UNINPUT COLUMM
1482 KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST
1489 * ********************
1490 * *ALL CHARACTER TEST*
1491 * ********************
1493 TS00 DAC ** TEST (A) AGAINST TC
1497 JST ER00 TO ERROR TEST
1498 BCI 1,CH IMPROPER TERMINATING CHARACTER
1501 * *******************
1502 * *)- INPUT OPERATOR*
1503 * *******************
1509 JST FN00 FINISH OPERATOR
1518 * B1 COMMA OR C/R TST
1519 B1 LDA K134 IF TC = ','(CONVERTED TO 17)
1522 JMP* A9T2 GO TO SIDSW
1523 JMP A1 ELSE, GO TO C/R TEST
1526 NR00 DAC ** NON-REL TEST
1528 SUB K101 IF AT = 1 GO TO ERROR-
1531 JST ER00 ERROR TEST ROUTINE
1532 BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER
1539 NU00 DAC ** N0 USAGE TEST
1541 SNZ IF IU NOT = 0, TO ERROR
1544 BCI 1,NU NAME ALREADY BEING USED
1547 * *******************
1548 * *NON-CONSTANT TEST*
1549 * *******************
1551 NC00 DAC ** NON CONSTANT TEST
1553 SNZ IF NT NOT = 0, TO ERROR TEST
1556 BCI 1,NC CONSTANT MUST BE PRESENT
1559 * *********************
1560 * *NON SUBPROGRAM TEST*
1561 * *********************
1563 NS00 DAC ** NON SUBPROGRAM TEST
1565 SUB K101 IF IU = 1, GO TO-
1569 BCI 1,NS SUBPROGRAM NAME NOT ALLOWED
1576 AT00 DAC ** ARRAY TEST
1578 SUB K103 IF IU = 3, GO TO
1582 BCI 1,AR ITEM NOT AN ARRAY NAME
1589 IT00 DAC ** INTEGER TEST
1591 SUB K101 IF IM = 1, GO TO-
1592 SNZ ERROR ROUTINE, ELSE
1594 JST ER00 TO ERROR TEST
1595 BCI 1,IT ITEM NOT AN INTEGER
1599 LDA AT STRING-ABS TEST
1604 BCI 1,NR ITEM NOT A RELATIVE VARIABLE
1613 AD3 DAC ** ADD TWO THREE WORD INTEGERS,
1630 * ***********************
1631 * *ASSIGN INDEX REGISTER*
1632 * ***********************
1644 STA T1IM MULTIPLY A BY B
1649 IM10 LRL 1 LOW BIT OF B INTO C
1655 JMP* IM00 RETURN, RESULT IN A
1660 NF00 DAC ** CONSTRUCT EXTERNAL NAME
1661 LDA K80 ENTRY FOR FORTRAN GENERATER
1663 LDA K81 SUBROUTINE CALLS,
1668 KM92 DEC 1 001 = INT
1677 BLNK DAC ** CLEAR A 3/36
1678 JST SAV AREA TO ZEROS
1681 CRA CLEAR 3 WORDS OF MEMORY
1682 STA 1,1 PARAMETER INPUT ADDRESS TO 0
1690 MOV3 DAC ** MOVE 3-WORDS
1691 LDA TID TO TEMO STORE
1702 CIB DAC ** COMPARE IBUF TO A CONSTANT
1704 LDA* CIB +DDR OF CON+3,0
1716 JST RST RESTORE INDEX
1725 SAV DAC ** SAVE INDEX REGISTER
1726 STA SAVY STACKED IN PUSH DOWN LIST
1732 RST DAC ** RESTORE INDEX REGISTER
1734 LDA SAV9 UNSTACK PUSH DOWN LIST
1742 SAV9 DAC SAVX IS INITIATED BY A092
1746 PACK DAC ** PLACE CHARACTER IN A
1748 LDA NTID INTO ID - UPDATE 3 WORDS OF
1785 ER00 DAC ** ERROR ROUTINE
1791 STA PRI+35,1 SET ** INTO PRINT BUFFER
1792 IRS 0 SET COMPLETE PRINT BUFFER TO ********
1800 LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.)
1801 SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT
1803 LDA KAEQ ='142721 (=(E)(Q) )
1806 STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER
1807 CALL F4$SYM PRINT THE BUFFER
1809 JST PRSP SET PRINT BUFFER TO SPACES
1811 ER20 CAS CRET INPUT CHARACTERS UNTIL C/R
1813 JMP C7 GO TO STATEMENT INPUT
1822 LDA* SRT SHIFT RIGHT ONE PLACE
1823 STA XR TRIPLE PRECISION
1841 SFT DAC ** TRIPLE PRECISION
1842 JST SAV SHIFT LEFT ONE PLACE
1867 CALL F4$SYM PRINT BLANK LINE
1869 CALL F4$SYM PRINT SOURCE INPUT LINE
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
1888 JST NXT GET NEXT ENTRY
1889 JMP AS30 AT END, GO TO AS30
1893 JMP AS04 NO, G0 TO AS04
1897 JMP AS04 TID = TID(A)
1901 JMP AS04 NO, GO TO AS04
1906 LDA NT IF NT (A) .NE. 0,
1908 JMP AS16 GO TO AS16 (4)
1909 AS10 LDA IM IF IM .NE. IM (A),
1910 SUB IMA GO TO AS04 (1)
1914 SNZ OR NOT EQUAL IU (A)
1915 JMP AS04 GO T0 AS04 (1)
1920 SUB K105 GO TO AS16 (4)
1923 JST NXT ELSE, GET NEXT ENTRY
1925 LDA TIDA IF IU (A) = TIDB
1926 SUB TIDB GO TO AS16 (4)
1927 SZE ELSE, GO TO AS04 (1)
1940 AS16 LDA IUA IF IU (A) .NE. 0
1943 JMP AS18 GO TO AS18 (5)
1944 LDA SPF IF SPF = 0, GO TO AS18 (5)
1951 JST TG00 TAG SUBPROGRAM
1952 AS18 CRA SET NTF TO 0
1953 STA NTF SET NTF TO 0
1954 JST FA00 GO TO FETCH ASSIGNS
1958 AS19 JST TV00 TAG VARIABLE
1960 AS30 JST BUD BUILD ASSIGNMENT ENTRY
1963 JMP AS32 OR IV = VAR,
1968 AS32 LDA IM IF IM = CPX,
1972 STA IU MOVE 1ST PART OF
1973 LDA TIDB COMPLEX ENTRY TO
1974 STA TID TID AND BUILD
1975 LDA TIDB+1 ASSIGNMENT ENTRY
1987 SUB A TO = -(ABAR-A+5)
1988 ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP
1994 LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE
1999 STA I I = I - T0(T0 IS NEGATIVE)
2001 AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE
2005 STA AS91 AS91 = NEW TABLE TOP
2008 SUB T0AS COMPUTE SIZE OF FLOATING TABLES
2011 SNZ IF ZERO, ASSIGN TABLE ONLY,
2017 AS46 LDA* AS92 END-5
2018 STA* AS91 END (MOVE TABLES UP)
2022 IRS T0AS = NO, OF WORDS TO MOVE
2026 BCI 1,MO DATA POOL OVERFLOW
2039 * TAG ITEM AS A SUBPROGRAM, CHECK TO SEE IF
2040 * NAME IS IN IMPLICIT MODE TABLE AND SET
2045 SUB K101 IF IU = SUB
2047 JMP* TG00 RETURN, ELSE
2048 JST NU00 NO * USAGE TEST
2051 TG04 LDA ID+1 CHARACTERS 3 AND 4
2052 CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE
2056 JMP TG04 NOT DONE WITH TABLE
2057 TG08 LDA K101 =1 (IU=SUBR.)
2060 LDA DP+1,1 IU(A) = SUB
2067 TG10 LDA ID CHARACTERS 1 AND 2
2072 JMP TG06 CONTINUE SEARCH
2073 LDA ID+2 CHARACTERS 5 AND 6
2076 JMP TG06 CONTINUE SEARCH
2079 ANA K107 =7 (=3 IF CPX, 4 IF DBL)
2080 ADD K102 =2 (=5 IF CPX, 6 IF DBL)
2084 TG22 OCT 177753 =-21
2086 *...........IMPLICIT MODE SUBROUTINE NAME TABLE
2087 TGT1 BCI 6,DECEDLCLDLDS
2091 TGT2 BCI 6,XPXPOGOGOGIN
2104 * - TV00 TAG VARIABLE
2106 LDA IU IF IU = 'VAR',
2110 JST NU00 ELSE, NO USAGE TEST
2113 ANA K111 IU (A) = 'VAR'
2125 * SET ASSIGNMENT DATA FROM ASSIGN (EXCEPT ID)
2126 * EXPAND DIMENSION INFO IF ARRAY
2141 STA D0 D0 = NUMBER OF WORDS
2144 STA X X = POINTER TO CONSTANT NUMBER OF WORDS
2149 SUB K103 IF IU NOT 'ARR'
2159 STA X1 POINTER OF DIMENSION 1
2161 STA X2 POINTER OF DIMENSION 2
2163 STA X3 POINTER OF DIMENSION 3
2166 STA AF AF = GF(GF(A))
2170 STA ND NUMBER OF DIMENSIONS
2176 FA22 LDA X3 FETCH 3RD DIMENSION SIZE
2183 STA D2 D2 = 2ND DIMENSION SIZE
2187 STA D1 D1 = 1ST DIMENSION SIZE
2188 JST STXA EXIT WITH AF IN A
2192 LDA DP,1 IM OF SUBSCRIPT VALUE
2196 SZE SKIP IF DUMMY SUBSCRIPT
2197 LDA DP+4,1 FETCH VALUE OF SUBSCRIPT
2207 * EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE
2212 LDA DP,1 A = 5 * CL(A)
2216 ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC)
2218 JST FA00 FETCH ASSIGN
2219 JST KT00 D0 = = WDS /ITEM
2225 * *******************
2226 * *D0=WORDS FOR LINK*
2227 * *******************
2228 * D = ITEM MODE SIZE TIMES THE TOTAL SIZE IF
2229 * THE ITEM IS AN ARRAY
2232 LDA IU IF IU NOT 'ARR'
2237 IAB D0 = D0 * D1 * D2 * D3
2239 JST IM00 MULTIPLY A BY B
2242 JST IM00 MULTIPLY A BY B
2245 JST IM00 MULTIPLY A BY B
2254 * IM SUBA = IM (SET FROM A REG)
2258 JST STXA ESTABLISH A
2272 * AF SUBA = AF (SET FROM A REG)
2278 DA10 LDA DP+1,1 IF IU (A) NOT ARR
2280 CAS K103 GF (A) : AF
2282 JMP DA20 ELSE, GF (GF (A)) = AF
2291 NXT DAC ** GET NEXT ENTRY
2292 LDA A FROM ASSIGNMENT
2302 STA NTA NT(A) = NT FROM (A)
2305 STA ATA AT(A) = AT FROM (A)
2308 STA IMA IM(A) = IM FROM (A)
2311 STA CLA CL(A) = CL FROM (A)
2314 STA IUA IU(A) = IU FROM (A)
2317 STA GFA GF(A) = GF FROM (A)
2319 STA TIDA+2 TID(A) = TID FROM (A)
2325 STA DTA DT(A) = DT FROM (A)
2328 STA TTA TT(A) = TT FROM (A)
2329 LDA NTA NT(A) = NT FROM (A)
2341 BUD DAC ** BUILD ASSIGNMENT
2356 ADD K102 AT = STR/+BS
2391 * AT SUBA = AT (FROM B REG), THEN DEFINE AF
2402 STA DP,1 AT(A) = CONTENTS OF B INPUT
2413 * SET AF = RPL, AT = REL
2420 * *************************
2421 * *ASSIGN INTEGER CONSTANT*
2422 * *************************
2423 * IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL
2431 JST AA00 ASSIGN SPECIAL
2438 * B REG TO IM, A REG TO IU, 1 TO NT (CONSTANT), THEN
2446 JST AS00 ASSIGN ITEM
2455 * CLEAR LAST OP FLAG FOR NO PATH TESTING
2459 * SET ILLEGAL DO TERM FLAG
2463 JST TS00 IF TC NOT C/R, ERROR
2470 * WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH
2471 * DO TABLE FOR DO TERMINATION
2473 SZE IF LIF NON-ZERO,
2475 C6A LDA LSTN IF LSTN NON-ZERO,
2478 C6B STA LSTF LSTF = 0
2479 JMP C7 GO TO STATEMENT INPUT
2480 C6C SUB TRF TRACE FLAG
2481 SNZ SMP IF NOT END OF TRACE ZONE
2482 STA TRF SET TRF TO ZERO (TURN FLAG OFF)
2483 LDA DO START OF DO TABLE
2485 C6D STA I I = DO + D
2489 JMP C6B GO TO C6B - FINISHED DO
2497 JST DQ00 DO TERMINATION
2505 JMP C6D I = I-5 - CONTINUE DO LOOP
2511 LDA OMI5 (A) = JMP INSTRUCTION
2517 STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG
2518 JST OS00 OUTPUT STRING - RPL
2527 * SET UP PROCESSING OF NEXT SOURCE STATEMENT
2528 * PROCESS STATEMENT NUMBER IF PRESENT
2529 * WRAPUP ANY OUTSTANDING ARITHMETIC IF
2536 LDA CI CHECK CARD COLUMN 1
2537 LGR 8 FOR $ CHARACTER
2540 JMP CCRD CONTROL CARD
2541 JST XN00 EXAMINE NEXT CHAR
2544 JST IS00 INPUT STATEMENT =
2548 C71 LDA IFF CHECK FOR IFF=0
2556 C7B JST C7LT LINE TEST
2561 LDA K201 (A) = JMP INSTRUCTION
2565 C7LT DAC ** LINE TEST
2571 SUB HC2 IF TC : SPECIAL
2576 C7LU JST ER00 CONSTRUCTION ERROR
2577 BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD
2581 * ************************
2582 * *CONTROL CARD PROCESSOR*
2583 * ************************
2584 CCRD JST FS00 FLUSH BUFFER IF NECESSARY
2586 LDA CI WORD CONTAINING COLUMN 1
2589 LDA CCRK ='030000 (EOJ CODE = 3)
2590 LGR 6 TRUNCATE TO A DIGIT
2593 STA OCNT SET BUFFER WORD COUNT TO 3
2594 JST FS00 FLUSH BUFFER
2596 LGL 12 CHECK COLUMN 1 FOR CONTROL CODE 0
2598 JMP ER20 SKIP TO NEXT CARD (NOT CONTROL CARD)
2599 CALL F4$END CLOSE-OUT I/0 DEVICES AND STOP
2600 JMP A0 RESTART NEW COMPILATION
2601 CCRK OCT 030000 EOJ CONTROL CODE
2606 * DETERMINE THE CLASS OF THE STATEMENT
2607 * IF AN = IS FOUND WITH A FOLLOWING ,
2608 * THE STATEMENT IS A DO
2609 * IF NO FOLLOWING COMMA, THE PAREN FLAG
2610 * IS TESTED, IF NO PARENS, THE STATEMENT
2611 * IS ARITHMETIC ASSIGNMENT
2612 * IF PARENS WERE DETECTED AND THE FIRST
2613 * NAME IS AN ARRAY, THE STATEMENT IS
2614 * ARITHMETIC ASSIGNMENT
2615 * OTHERWISE, IT IS A STATEMENT FUNCTION
2616 * IF NO = IS FOUND, THE STATEMENT IS
2617 * PROCESSED FURTHER IN STATEMENT ID
2625 C8A JST CH00 INPUT CHARACTER
2626 C8B LDA TC IF TC = )
2631 C8B2 LDA DFL IF DFL NOT ZERO
2634 C8B4 LDA C8X9 RESTORE CC
2638 JMP A9 GO TO STATEMENT ID
2639 C8C LDA TC IF TC NOT (,
2643 LDA C8T1 T1 = T1 - 1
2650 C8D LDA TC IF TC = ,
2651 CAS K134 ='17 ('FINISHED' CODE FOR COMMA)
2657 C8D2 LDA C8T1 GO TO C8C4,
2659 C8E LDA TC ELSE, IF TC = '/'
2667 LDA K107 INPUT 7 CHARACTERS
2677 LDA K102 ELSE, INPUT 2 CHARS
2679 LDA IBUF IF (A) = 'DO'
2684 BCI 1,CM COMMA OUTSIDE PARENTHESES, NOT IN DO STMNT,
2686 JST NP00 FIRST NON-SPEC CHECK
2688 C8G LDA C8T1 1 IF NO ( TO LEFT OF EQUALS
2690 JMP G2 ARITHMETIC ASSIGNMENT STATEMENT
2691 JST SY00 INPUT SYMBOL
2697 JMP G1 GO TO ARITH ST. FUNCT,
2698 JMP G2 OTHERWISE = ASSIGNMENT STATEMENT
2702 * **************************
2703 * *STATEMENT IDENTIFICATION*
2704 * **************************
2705 * READ FOUR CHARACTERS AND DETERMINE CORRECT ROUTINE
2706 * FOR PROCESSING, THEN CHECK SPELLING ON REST
2711 JST IA00 INPUT (4) CHARS
2713 STA NAMF NAMF = IBUF
2716 LDA A9Z9 INITIALIZE INDEX FOR LOOP
2717 STA XR THROUGH THE STATEMENT NAMES
2721 JMP A9F READ IN REST OF
2722 LDA NAMF+1 CHECK REST OF SPELLING FOR
2724 SZE A MATCH ON 4 CHARACTERS
2728 STA A9T1 T1 = NUMBER OF REMAINING CHARACTERS
2729 LDA A9X3+30,1 LEFT TO CHECK
2733 STA A9T2 T2 = ADDRESS OF ROUTINE
2735 JST NP00 FIRST NON-SPECIFIC. CHECK -(A) =
2736 A9B LDA A9T1 HIERARCHY CODE
2738 JMP A9C MUST CHECK MORE CHARACTERS
2739 JMP* A9T2 FINISHED CHARACTER CHECK, EXIT TO
2740 * SPECIFIC ANALYZER.
2745 LDA K106 REMAINING SPELLING 1S CHECKED.
2752 BCI 1,SP STATEMENT NAME MISSPELLED
2758 A9F IRS XR LOOP CONTROL FOR STATEMENT NAMES.
2759 JMP A9A MORE NAMES - CONTINUE LOOP
2766 JMP C7 AND LSTN = 0 - INPUT NEW STATEMENT
2768 BCI 1,ID UNRECOGNIZED STATEMENT
2769 A9X1 BCI 10,INREDOCOLOFUSUBLEXDI
2770 BCI 10,COEQGOCARECOFOIFWRRE
2771 BCI 7,BAENREENASSTPA
2774 A9X2 BCI 10,TEALUBMPGINCBROCTEME
2775 BCI 10,MMUITOLLTUNTRM( ITAD
2809 DAC* TRAC+'20000,1 TRACE STATEMENT
2812 * ******************************
2813 * *CONTINUE STATEMENT PROCESS0R*
2814 * ******************************
2815 CONT LDA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR
2816 ADD LSTN ACCOUNTS FOR POSSIBLE PATH ERROR
2817 STA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR
2820 *-------------THE FOLLOWING TABLE IS USED BY STATEMENT ID
2821 *-------------(RIGHT 6 BITS) AND OUTPUT ITEM,
2822 A9X4 OCT 000003 (00)
2823 OCT 030100 (01) + (A$--)
2824 OCT 032313 (02) - (S$--)
2825 OCT 031503 (03) * (M$--)
2826 OCT 030403 (04) / (D$--)
2827 OCT 000004 (05) .NOT.
2828 OCT 000006 (06) .AND.
2829 OCT 031405 (07) .OR. (L$-,
2830 OCT 000004 (10) .LT.
2831 OCT 000005 (11) .LE.
2832 OCT 000002 (12) .EQ.
2833 OCT 000007 (13) .GE.
2834 OCT 000000 (14) .GT.
2835 OCT 000000 (15) .NE.
2836 OCT 031003 (16) = (H$--)
2838 OCT 030503 (20) 'E' (E$--)
2839 OCT 031600 (21) 'C' NC$--)
2847 OCT 031400 (31) 'F' (L$--)
2852 A9Z9 DAC* -30,1 NO. OF ITEMS IN STMNT NAME TABLE
2855 * **********************
2856 * *FIRST NON-SPEC CHECK*
2857 * **********************
2858 * AT FIRST SHIFT IN LEVEL FROM ZERO, WRAP-UP
2859 * SPECIFICATION STATEMENTS
2871 JMP NP10 TRACE STMNT. (MAY OCCUR ANYWHERE)
2872 CAS SPF T0 , G.R. SPF, GO TO NP30
2873 JMP NP30 T0 = SPF, G0 TO NP25
2879 JST ER00 ELSE, ILLEGAL STATEMENT
2880 BCI 1,EX SPECIFICATION STATEMENT APPEARS AFTER
2882 NP10 LDA LSTN SPECIFICATION STATEMENT CLEAN-UP
2885 JMP NP16 IF ZERO, RETURN
2886 JST FA00 FETCH ASSIGNS
2892 JST OS00 OUTPUT STRING RPL
2893 NP15 JST LO00 DEFINE LOCATION
2897 JST TRSE OUTPUT TRACE COUPLING
2901 NP20 JST NR00 NON-REL TEST
2906 LDA LSTP IF LSTP + LSTN =0
2911 JST ER00 'NO PATH' ERROR
2912 BCI 1,PH NO PATH LEADING TO THE STATEMENT
2913 NP30 LDA SPF IF SPF 0 0
2920 LDA BDF BLOCK DATA SUBPROGRAM FLAG
2921 SZE SKIP IF NOT BLOCK DATA SUBPROGRAM
2922 JMP C2 GO TO RELATE COMMON
2923 STA A SET LISTING FOR OCTAL ADDR.
2924 LDA OMI5 JMP INSTRUCTION
2925 STA DF SET LISTING FOR SYMBOLIC INSTR.
2926 JST OA00 OUTPUT ABSOLUTE
2927 JMP C2 GO TO RELATE COMMON
2935 NP40 STA A SET LISTING FOR OCTAL ADDR.
2936 LDA XST LOCATION OF INITIAL JUMP
2937 JST OS00 OUTPUT STRING
2945 * ARITHMETIC IF ($1 $2 $3)
2946 * IF $2 NOT = $3, JZE $2
2947 * IF $3 NOT = $1, JPL $3
2948 * (IF $1 NOT = NEXT ST NO., JMP $1) LATER
2950 * OUTPUT JZE 77777 (FOR STRINGING AROUND
2951 * IMBEDDED STATEMENT)
2952 V3 JST II00 INPUT ITEM
2954 JMP V310 IM=0 (POSSI8LE UNARY + OR -)
2957 JMP V310 FIRST ITEM IN EXPRESSION 0.K.
2958 V308 JST ER00 ERROR.....IF(SENSE SWITCH,.ETC).....
2959 BCI 1,IF ILLEGAL IF STATEMENT TYPE
2961 JST EX00 EXPRESSION EVALUATOR
2965 STA A SET A TO SPECIAL (IF) ENTRY IN DATA POOL
2967 LDA MFL SET MODE OF EXPRESSION INTO SPECIAL (IF)
2970 JST TRSE OUTPUT TRACE COUPLING (IF NECESSARY)
2971 LDA MFL CHECK MODE FLAG FOR LOGICAL
2974 JMP V320 ARITHMETIC IF
2978 STA AF SET ADDR OF SNZ AND JMP INSTR TO 00000
2979 LDA OMJ2 =SNZ INSTR.
2980 JST OA00 OUTPUT ABSOLUTE
2981 LDA RPL SET LIF=CURRENT +DDR, (STRING BACK)
2983 LDA OMI5 =JMP 0 INSTR.
2984 JST OA00 OUTPUT ABSOLUTE
2985 JST XN00 GO TO NEXT INPUT LINE
2986 JMP C8 GO TO STATEMENT SCAN
2988 V320 SUB K102 CHECK FOR MODE = COMPLEX
2990 JMP V308 ERROR,...COMPLEX MODE EXPRESSION
2993 V324 JST IS00 INPUT STATEMENT NUMBER
2994 JST STXI SET INDEX TO I
2996 STA T1V3+3,1 SAVE BRANCH ADDRESSES
2998 JMP V350 CHECK FOR TERMINAL COMMA
3000 CAS T2V3 CHECK FOR ADDR-2 = ADDR-3
3002 JMP V330 ADDR-2 = ADDR-3
3005 LDA OMJ2 =SNZ INSTR.
3007 JST OA00 OUTPUT ABSOLUTE
3009 JST V360 OUTPUT A JMP(ADDR-2) INSTR.
3011 V330 CAS T1V3 CHECK FOR ADDR-3 = ADDR-2
3013 JMP V340 ADDR-3 = ADDR-1
3016 LDA OMJ3 =SMI INSTR.
3017 JST OA00 OUTPUT ABSOLUTE
3019 JST V360 OUTPUT A JMP (ADDR-3) INSTR.
3021 STA IFF SET IFF ' ADDR-1
3022 JMP C5 GO TO ILL-TERM
3026 JMP V324 INPUT NEXT STATEMENT NO.
3030 *---------------SUBROUTINE TO OUTPUT A RELATIVE JMP
3032 STA A SET ADDR. OF JUMP REF. TO A
3035 LDA OMI5 SET (A) = JMP INSTR.
3046 * CHECK FOR NORMAL (R740), COMPUTED (R710) OR
3047 * ASSIGNED (R730). INPUT BRANCH LIST USED BY BOTH
3048 * R710 AND R730 FOR STATEMENT NO. LIST.
3051 R7 JST XN00 EXAMINE NEXT CHAR
3053 JMP R78 GO TO TEST DFL
3054 JST IS00 INPUT STMNT =
3057 JMP C5 G0 TO ILLTERM
3061 JST IR00 GO TO I (10, 20, 30}
3063 LDA K206 OUTPUT JMP* INSTRUCTION
3067 JST IB00 INPUT BRANCH LIST
3069 R7D JST IB00 INPUT BRANCH LIST GO TO (10,11,12), I
3072 JST IR00 INPUT INT VAR
3078 STA AF CAUSE OCTAL ADDRESS IN LISTING
3080 JST OA00 OUTPUT ABS (STA 0) - INDEX LOAD
3082 STA AF CAUSE RPL T0 BE IN LISTING
3084 JST OR00 OUTPUT RELATIVE (JMP RPL,1)
3093 JMP B6 FINISHED LOOPING ON LIST
3095 LDA K201 OUTPUT JMP INSTRUCTIONS
3096 JST OB00 OUTPUT OA (JMP 0)
3099 * *******************
3100 * *INPUT BRANCH LIST*
3101 * *******************
3102 * INPUT STATEMENT NO. LISTS FOR GO TO PROCESSOR
3110 IB10 JST IS00 INPUT STMNT =
3113 STA DP,1 SET POINTER OF ST. N0. INTO TRIAD TABLE
3118 LDA TC IF TC = , GO TO IB10
3121 JMP IB10 CONTINUE LOOP
3123 STA DP-1,1 SET END FLAG INTO TABLE
3124 JST IP00 )- INPUT OPEN
3132 * CHECK TO SEE THAT 'TO' IS INCLUDED PROPERLY
3133 W3 JST IS00 INPUT STMNT =
3137 SUB K34 CHECK FOR T0
3139 JMP W305 CLEAR A FOR OUTPUT REL
3140 STA A CAUSE OCTAL ADDRESS IN LIST
3147 BCI 1,TO GO TO IN ASSIGN STATEMENT
3150 STA AF OUTPUT REL LDA *+2
3151 LDA K200 OUTPUT LDA *+2
3155 STA AF OUTPUT REL JMP *+2
3162 JST OB00 OUTPUT DAC ST. NO.
3163 JST IR00 INPUT INTEGER VARIABLE
3165 LDA K202 OUTPUT STA INSTRUCTION
3167 JMP A1 GO TO C/R TEST
3168 T1W3 PZE ** TEMP STORE
3171 * ************************
3172 * *DO STATEMENT PROCESSOR*
3173 * ************************
3174 * STACK INFO IN DO TABLE. OUTPUT DO INITIAL
3177 C9 JST IS00 INPUT STATEMENT =
3178 JST NR00 NON-REL TEST
3181 JST UC00 UNINPUT COLUMN
3188 JST DS00 DO INITIALIZE
3189 JMP C5 GO TO ILLTERM
3202 JST NF00 SET UP NAMF
3203 JST OI00 OUTPUT I/0 LINK
3204 JMP A1 GO TO C/R TEST
3219 * LIST ELEMENT DATA AND IMPLIED DO CONTROL
3220 * STACKED IN TRIAD TABLE. PROCESSED BY
3221 * OUTPUT TRIAD ROUTINE, SPECIAL OPERATORS
3222 * ARE -I = DO INITIALIZATION
3223 * T = DO TERMINATION
3224 * Q = I/0 ARG TRANSFER
3228 JST XN00 EXAM NEXT CHAR
3230 JMP V5A GENERAL READ
3233 V4 LDA K40 NAWF = F$WN
3235 V5A JST NF00 SET UP REMAINING NAME
3238 JST CH00 INPUT CHARACTER
3239 LDA K17 ='250......(
3241 JST OI00 OUTPUT I0 LINK
3246 JST V5X INPUT FORMAT
3247 V5B JST IP00 ) - INPUT OPERATOR
3249 SUB CRET TEST FOR TC=C/R
3251 JMP V5C N0, G0 TO V5C
3252 V5B2 LDA K42 YES. NAMF = ND
3257 JMP A1 G0 TO C/R TEST
3261 V5D JST II00 INPUT ITEM
3263 JMP V5E IF (A) NOT 0, GO TO V5E
3276 V5E JST NC00 NON-CONSTANT TEST
3277 LDA IU IF IU NOT ARR
3282 SUB K17 IF TC NOT -(,
3298 JST ET00 ENTER TRIAD
3299 V5E7 LDA TC IF TC = COMMA
3307 JST OT00 OUTPUT TRIADS
3309 V5F JST IP00 )-INPUT OPERATOR
3312 STA IOF IOF = O1 (I)
3314 V5G JST KT00 K = = WDS/ITEM
3316 V5H JST TV00 TAG VARIABLE
3321 JST IT00 INTEGER TEST
3323 SNZ IF IOF = ZERO OR L
3329 BCI 1,PR PARENTHESES MISSING IN DO STATEMENT
3335 STA DP,1 O2(IOF) = D
3339 JST ET00 ENTER TRIAD 'T'.
3343 JST OA00 OUTPUT ABSOLUTE
3351 V5X DAC ** INPUT FORMAT
3352 JST XN00 EXAM NEXT CHARACTER
3354 JMP V5X5 GO TO INPUT ARRAY NAME
3355 JST IS00 INPUT STMNT NO.
3356 V5X2 LRL 32 OUTPUT DAC A
3359 V5X5 JST NA00 INPUT NAME
3363 V10 LDA V5K5 PRINTER
3365 JST NF00 SET UP REST 0F NAME
3367 JST V5X INPUT FORMAT
3377 * **************************
3379 * *INPUT FORMAT STRING *
3380 * *INPUT NUMERIC FORMAT STR*
3381 * *NON ZERO TEST STRING *
3382 * **************************
3388 JST OK00 OUTPUT RACK
3391 LDA LSTP IF LSTOP .NE. 0
3394 V2A JST SI00 INPUT FORMAT STRING
3398 SUB K12 IF TC NOT MINUS
3401 JST IN00 INPUT NUMERIC FORMAT STRING
3404 V2B LDA TC IF TC .NE. P
3408 JST SI00 INPUT FORMAT STRING
3410 JST NZ00 IF (A) .NE. 0
3412 CAS K52 IF TC = D,E,F, OR G
3419 JST IN00 INPUT NUMERIC FORMAT STRING
3420 JST NZ00 NON-ZERO STRING TEST
3422 JST TS00 PERIOD TEST
3423 V2D JST IN00 INPUT NUMERIC FORMAT STRING
3424 V2DA LDA TC IF TC = )
3429 JST OK00 INPUT CHAR AND OUTPUT PACK
3430 LDA T0V2 IF F4 + ( Z (
3444 V2E5 JST SI00 INPUT FORMAT STRING
3447 LDA DFL IF DFL .NE. ZERO,
3451 V2F LDA TC IF TC = H
3461 LDA TC IF TC .NE. A,I, OR L
3471 V2G JST IN00 INPUT NUMERIC FORMAT STRING
3472 JST NZ00 NON-ZERO STRING TEST
3474 V2H JST NZ00 NON-ZERO STRING TEST
3479 V2J JST HS00 TRANSMIT HOLLERITH STRING
3481 V2K LDA LSTN IF LSTN = 0,
3484 JST ER00 ERR0R, NO PATH
3485 BCI 1,NF NO REFERENCE T0 FORMAT STATEMENT
3502 BCI 1,NZ NON-ZERO STRING TEST FAILED
3504 JST SI00 (A) = 0 IS ERROR CONDITION
3513 JST OK00 OUTPUT PACK
3522 LDA TID TID = 10*TID+TC
3530 SI10 LDA V2T2 (A) = ERROR CONDITION OR NOT
3533 BCI 1,FR FORMAT STATEMENT ERROR
3559 * PAUSE AND STOP CENERATE CALLS TO F$HT
3565 STA NAMF+1 NAMF = F$HT
3566 JST NF00 SET-UP REMAINING CHAR 0F NAME
3567 JST XN00 EXAMINE NEXT CHAR
3571 JMP W7C TC = C/R - NOTING FOLLOWING
3572 JST IV00 INPUT INTEGER/VARIA8LE
3576 W7C JST CN00 CALL NAME
3581 JST AI00 ASSIGN INTEGER CONSTANT
3583 JST OB00 OUTPUT OA OF ST/PA OR HT
3587 JMP C5 PA-NOT THE CASE
3591 STA A CAUSE LISTING TO HAVE OCTAL ADDRESS
3593 JST OR00 OUTPUT RELATWE
3603 * GENERATES CALL DIRECTLY OR USES EXPRESSION TO
3604 * ANALYZE AN ARGUMENT LIST.
3605 R8 JST SY00 INPUT SYMBOL
3608 SZE SKIP IF IU=SUBR,
3609 JST TG00 TAG SUB PROCRAM
3614 G2B LDA K101 SET A=1 BEFORE EXPRESSION
3618 LDA OMI2 =JST INSTR,
3621 * **********************
3622 * *ASSIGNMENT STATEMENT*
3623 * **********************
3625 JST NP00 FIRST NON-SPEC CHECK
3627 LDA K102 SET A = 2 BEFORE EXPRESSION
3636 * OPTIMIZES EXIT CODING FOR FUNCTIONS TO MINIMIZE
3637 * FETCHES OF THE FUNCTION VALUE.
3639 STA A IF ZERO, GO TO ERROR
3643 BCI 1,RT RETURN NOT ALLOWED IN MAIN PROGRAM
3644 LDA SFF ELSE, IF SFF = 0,
3647 CAS K101 IF SFF = 1, GO TO R98
3650 STA AF OUTPUT REL JMP TO 1ST RETN
3652 STA A SET A=0 TO OUTPUT OCTAL ADDR ON LISTING
3658 LDA K56 0UTPUT ITEM (F,A)
3661 STA A SET FOR OCTAL ADDHESS IW LISTING
3662 STA AF SET RELATIVE ADDRESS TO ZERO
3664 R9A JST OR00 OUTPUT REL
3666 K56 OCT 31 P CODE FOR 'F' (FETCH)
3669 * ********************
3670 * *STATEMENT FUNCTION*
3671 * ********************
3672 * OLD ASSIGN VALUES ARE SAVED IN SFTB AND ARE
3673 * RESTORED AT COMPLETION.
3677 JST NP00 FIRST NON-SPEC CHECK
3678 JST SY00 INPUT SYMBOL
3679 JST LO00 DEFINE LOCATION
3682 JST GE00 GENERATE SUBPROGRAM ENTRANCE
3708 SUB K103 I = I-3 = 0
3712 JMP G1A NO, GO TO G1A
3718 JST TG00 TAG SUBPROGRAM
3719 JMP A1 GO TO C/R TEST
3724 * FIRST CHECK SUBPROGRAMS FOR CORRECT USAGE, THEN
3725 * GENERATE MAP AND STRING BACK VARIABLES
3728 W5 LDA BDF IF BLOCK DATA,
3731 LDA SBF IF SBF NOT ZERO
3732 STA A INDICATES SUBROUTINES
3738 W5D JST FA00 FETCH ASSIGNS
3741 SZE IF NT=L (CONSTANT)
3745 SZE INDICATES VARIABLE,
3747 W5F LDA RPL SAVE RPL
3748 STA T1W5 RPL=-AF (INHIBIT LISTING)
3754 LDA T1W5 RESTORE RPL
3759 SUB ABAR IF A=ABAR, (DONE)
3762 JMP W5D ELSE, GO TO W5D
3763 W5J JST FS00 FLUSH BUFFER
3776 JMP A051 GO TO INITIALIZE
3777 W5K LDA RPL IF RPL NOT ZERO,
3780 JST ER00 ERROR-CODE GENERATED
3781 BCI 1,BD IN A BLOCK DATA SUBPROGRAM
3782 W5M JST FA00 FETCH ASSIGNS
3783 LDA SFF IF FUNCTION,
3786 JST NU00 NO USE TEST
3788 LDA DP,1 IF NO ERROR,
3793 SUB K102 IU MUST BE VAR/CON,
3796 JST ER00 ERROR-FUNCTION
3797 BCI 1,FD NAME NOT DEFINED BY AN ARITHM, STATEMENT
3798 W5O LDA IU IF IU=VAR/CON
3802 LDA AT AND AT = STR/REL
3803 SUB K103 A "STRING" REQ'D.
3806 W5P LDA D0 IF D0 IS 4, THE
3807 SUB K104 CONSTANT IS COMPLEX,
3811 JST OS00 OUTPUT STRING
3813 LDA DP+2,1 OUTPUT 4 WORDS
3826 JST OS00 OUTPUT STRING
3829 SUB K101 INDICATES INTEGER,
3832 W5S LDA DP+2,1 OUTPUT TWO WORDS
3833 JST W5X FLOATING POINT CONSTANT
3836 LDA D0 IF DOUBLE PRECISION,
3840 W5R LDA DP+4,1 OUTPUT THE 3RD WORD
3845 JMP W5F STRONG VARIABLE (IU = NON 0)
3847 CAS K102 TEST FOR STG ABS ADDRESS
3851 LDA DP+4,1 TEST FOR PREFIX G
3855 JMP W5F STRONG VARIABLE (IU = NON 0)
3868 W5Z1 EQU K100 000377
3869 W5Z2 EQU K122 040000
3870 W5Z3 EQU K116 177400
3876 * ************************
3877 * *INPUT CHAR/OUTPUT PACK*
3878 * ************************
3881 JST OK00 OUTPUT PACK
3883 * ************************
3884 * *TRANS HOLLERITH STRING*
3885 * ************************
3886 * FORM HOLLERITH STRING, CHARACTER COUNT IN ID 0N
3887 * ENTRY. C/R WILL ALSO TERMINATE STRING.
3889 HS10 JST IC00 INPUT 1 CHARACTER
3890 CAS CRET CHECK FOR CHAR = C/R
3892 JMP HS15 HOLLERITH STRING EXTENDS PAST END 0F CARD
3893 JST OK00 OUTPUT PACK THE CHARACTER
3895 SUB K101 REDUCE CHARACTER COUNT BY 1
3898 JMP HS10 INPUT MORE CHARACTERS
3901 BCI 1,HS HOLLERITH STRING EXTENDS OVER STATEMENT
3907 * SET UP DO TABLE ENTRIES.
3910 ADD K105 IFLG = NON-ZERO
3916 LDA A DP (1-4) = (B)
3917 STA DP-2,1 DP (1-2) = A
3920 JST IV00 INPUT INT VAR/CON
3925 STA DP,1 DP(I) = INITIAL VALUE POINTER
3926 JST IV00 INPUT INT VAR/CON
3929 STA DP-1,1 DP (I-1) = A - FINAL VALUE POINTER
3934 JST IV00 READ AND ASSIGN,
3937 STA DP-3,1 DP(I-3) = INCREMENT POINTER
3939 STA IFLG CLEAR IFLAG
3942 STA ID THIRD TERM = 1
3943 JST AI00 ASSIGN CONSTANT
3948 * GENERATE DO INITIALIZATION CODE.
3950 JST STXI ESTABLISH I
3954 JST DS20 LOAD - LDA INITIAL VALUE
3958 STA DP,1 SET RETURN ADDRESS INTO DP(I)
3960 JST DS20 STORE - STA VARIABLE NAME
3962 * OUTPUT OA SUBROUTINE
3975 * GENERATE DO TERMINATION CODE.
3981 JST DS20 OUTPUT LDA VARIABLE NAME
3985 JST DS20 OUTPUT ADD INCREMENT
3989 JST DS20 OUTPUT CAS FINAL VALUE
4001 LDA OMI5 JMP RPL (SAVED) - POINTS TO 'STA' INST.
4003 LDA OMI5 OUTPUT JMP RPL (SAVED)
4009 * THE RESULTANT OUTPUT IS A BUILT UP AOIN
4010 * TABLE THAT IS FURTHER PROCESSED BY SCAN.
4022 LDA A SAVE POINTER TO FIRST VARIABLE
4023 STA TRFA FOR LATER POSSIBLE TRACING
4028 JST EX99 DATA POOL CHECK
4036 STA DP-1,1 0 (I) = 0
4040 STA DP-2,1 O(I-2) = L0
4044 STA DP,1 AOIN(I) = T(1) = 0
4046 LDA IM IF IM NOT ZERO,
4052 * PERFORM TABLE SEARCH
4053 EX11 LDA TC GO TO ROUTINE ACCORDING
4055 SNZ IF NO MATCH, ERROR
4060 LDA LIBF SPECIAL LIBRARY FLAG
4063 JMP EX95 ERROR CONDITION
4066 JMP 0,1 PROCESS LEADING OPERATOR
4067 * SPECIAL OPERATOR FLAG SET WHEN COMPILING THE FORTRAN
4068 * LIBRARY IN WHICH CASE THE OPERATIONS ( A= ) AND
4069 * ( =A ) ARE REQUIRED, THIS LOGIC WILL ALLOW THESE
4070 * TO BE PROCESSED WITHOUT GIVING AN ERROR MESSAGE IF THE
4071 * SPECIAL LIBRARY FLAG, (LIBF) IS SET TO NON-ZERO,
4075 STA B SXF = NON-ZERO
4077 EX14 JST II00 INPUT ITEM
4080 EX16 JST STXI TC = *
4082 LGL 9 OI (I-2) = *, B+13
4089 JST ER00 NO, CONSTR ERROR
4090 BCI 1,PW * NOT PRECEDED BY ANOTHER *
4096 ERA DP-1,1 CHAJNE * TO **
4106 SUB B 8 .GT. I (I-2) -B
4110 EX19 JST ER00 NO, ERROR
4111 BCI 1,NT LOGICAL .NOT. NOT A UNARY OPERATOR
4116 ADD F B + + (5) .GT. 0
4124 STA DP+1,1 OI(I) = TC , T1+B
4125 JST EX99 DATA POOL CHECK
4129 ANA K118 IF I (I-2) .LT. B
4131 JMP EX97 ERROR-----MULTIPLE + OR - SIGNS
4133 EX30 LDA K131 SET INDEX TO
4134 STA 0 SEARCH OPERATOR TABLE FOR TRAILING
4135 EX31 LDA EX92+14,1 OPERATOR AFTER HAVING ENCOUNTERED AN
4136 SUB TC ITEM 0R A NEGATE,
4144 EX32 IRS XR CONTROL OPERATOR LOOP
4149 JMP EX40 NO, GO TO EX40
4150 LDA T0EX IF T (0) = 0
4152 JMP EX38 NO, GO TO EX38
4159 JMP* EX00 RETURN - NO
4161 JST OT00 OUTPUT TRIADS
4174 JST EX99 DATA POOL CHECK
4183 CAS K5 ='254 (,) IN BCD MODE
4188 JMP EX44 NO, GO TO EX44
4196 JMP EX24 EQUAL, GO TO EX24
4197 JMP* EX00 LESS, RETURN
4198 LDA XR GREATER, REPEAT LOOP
4200 EX44 JST IP00 ) - INPUT OPERATOR
4203 STA T6EX IF O1(O1(A)) = L(0)
4209 EX48 JST ET00 ENTER TRIAD
4214 LDA IU IU = SUB OR ARR
4216 JMP EX30 NO, GO TO EX30
4220 JMP EX76 NO, GO TO EX76
4227 JMP EX75 NO, GO TO EX75
4240 JMP EX74 NO, GO TO EX74
4242 STA T2EX YES, T (0) = 0
4243 JST EX99 DATA POOL CHECK
4247 LDA K132 OI (I) = A, 11
4251 EX54 LDA D0 IF D0 = 1, GO TO EX56
4255 JST EX99 DATA POOL CHECK
4265 LDA K103 I (I) = T3+13
4273 EX56 JST IV00 INPUT INTEGER VARIABLE
4274 JST EX99 DATA POOL CHECK
4280 JMP EX68 CONSTANT ENCOUNTERED
4281 JST UC00 UNINPUT COLUMN
4282 JST DN00 INPUT DO NOT ASSIGN
4287 JMP EX57 IM * INTEGEH
4289 BCI 1,SU SUBSCRIPT INCREMENTER NOT A CONSTANT
4295 STA DP+1,1 O(1) = +, I(I) = T3+11
4296 JST EX99 DATA POOL CHECK
4299 LDA ID SUBSCRIPT SIZE
4302 SNZ IF ZERO, GO TO EX60
4308 JMP EX67 YES - (DUMMY DIMENSION)
4313 STA T2EX T2 = T2+ID*D(K)
4318 LDA X+2,1 X(K+2) = 0
4320 JMP EX62 YES - FINISHED
4327 STA D0+1,1 D(K+1) = D(K+1)*D(K)
4330 LDA DP-1,1 DOES O(--2) = *
4337 JMP EX64 O(I-2) = 0 - YES
4338 CAS K132 DOES O(I-2) = A
4344 JMP EX65 YES (DUMMY ARRAY (1,1,1))
4346 STA DP-1,1 01(I-2) = 1
4349 LDA K137 0='X' ('24), I=2
4352 STA DP+3,1 O1(1+2) = 0
4354 STA DP+2,1 A(I+2) = T5
4355 JST EX99 DATA POOL CHECK
4360 LDA DP+2,1 S(A) = NON-ZERO
4366 JST EX99 DATA POOL CHECK
4373 STA DP-4,1 A (I) = T5
4378 JMP EX62 ASSIGN INT CONSTANT
4380 JST STXI SET XR TO I
4387 STA DP+1,1 OI(I) = +, T3+11
4388 JST EX99 DATA POOL CHECK
4398 STA DP+1,1 OI(I) = *, T3+13
4399 JST IR00 INPUT INTEGER VAR/CON
4401 EX69 CRA SET LISTING FOR OCTAL ADDR
4403 LDA OMI5 JMP 0 INSTRUCTION
4404 STA DF SET LISTING FOR SYMBOLIC A INSTR,
4405 JST OA00 OUTPUT ABSOLUTE
4410 JST ET00 ENTER TRIAD
4411 JST HS00 TRANSFER HOLLERITH STRING
4413 JST OK00 OUTPUT PACK
4415 STA 0 SET LISTING FOR OCTAL ADDR.
4416 STA A SET LISTING FOR OCTAL ADDR.
4419 JST OS00 OUTPUT STRING RPL-1
4420 JST CH00 INPUT CHARACTER
4422 JST STXI RESET INDEX TO I
4437 JMP EX34 WITHIN AN ARGUMENT LIST
4439 BCI 1,AG SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST
4441 EX79 STA T1EX T (1) = 11
4443 EX80 LDA K129 T (1) = 13
4448 EX82 LDA K104 T (1) = 4
4450 EX83 LDA T0EX T (0) =0
4465 BCI 1,RL MORE THAN 1 RELATIONAL OPERATOR
4467 ADD K102 T (5) = T (5) +2 = B = 0
4473 BCI 1,EQ MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF =
4513 DAC EX34 NONE OF THESE
4515 BCI 1,OP MURE THAN ONE OPERATOR IN A ROW
4517 BCI 1,PA OPERATOR MUST BE WITHIN PARENTHESES
4519 BCI 1,UO MULTIPLE + OR - SIGNS NOT AS UNARY OPS
4520 * BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW
4539 * ******************
4542 * *TEMP STORE CHECK*
4543 * ******************
4548 * THE AOIN TABLE IS PROCESSED FROM THE BOTTOM
4549 * UP AND ENTRIES ARE FORMED FOR INCLUSION
4550 * IN THE TRIAD TABLE, LEVELS ARE USED
4551 * TO CONTROL THE ORDER OF ENTRY INTO
4552 * THE TRIADS. SIGN CONTROL IS ALSO
4553 * ACCOMPLISHED IN THIS ROUTINE.
4556 STA ACCP INDICATE EMPTY ACCUM
4557 CA04 JST STXI ESTABLISH I
4560 ANA K118 IF I (I-2) = 0,
4582 CAS K102 IF P IS NOT * OR /, GO TO CCA10
4628 JMP CA37 IF ZER0, GO TO CA37
4634 ANA K118 IF T2 .GT. I (I-2)
4657 STA DP,1 AOIN(J) = AOIN(J+2)
4675 CA24 JST ST00 TRIAD SEARCH
4677 CAS K132 IF P = +,*, AND, OR
4681 JMP CA28 ELSE, GO TO CA26
4699 JST TC00 TEMP STORE CHECK
4701 JST TC00 TEMP STORE CHECK
4702 CA31 JST ET00 ENTER TRIAD
4712 LDA T2CA IF T2 NOT ZERO,
4715 JMP* CA00 ELSE, RETURN
4727 JST ST00 TRIAD SEARCH
4732 JMP CA26 ELSE, GO TO CA26
4745 STA T0CA * * * * * * * * * * *
4750 * IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES
4751 * ANY TRIAD TABLE ENTRY, EXIT WITH THE
4752 * POINTER VALUE OF THE MATCHING ENTRY
4753 * (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT
4754 * SUBEXPRESSION CALCULATIONS.
4755 ST00 DAC ** TRIAD SEARCH
4760 ST05 LDA P ELSE, IF P = X
4764 LDA O1 ELSE, IF 01=ACCP
4768 JMP* ST00 ELSE, RETURN
4778 SUB DP,1 IF O1/P/O2 .NE. O1/P/O2(J)
4782 SSP EXTRACT OFF STORE BIT
4792 JST STXI ESTABLISH I
4794 * IF J IS A REFERENCE TO A TRIAD , THE TEMP
4795 * STORE BIT 0F THE REFERENCED TRIAD IS SET.)
4796 TC00 DAC ** TEMP STORE CHECK
4806 CA90 OCT 1,2,11,10,13,14,12,15
4807 CA91 OCT 2,1,13,14,11,10,12,15
4813 * STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY
4820 STA ACCP SET ACCUM PTR TO LAST TRIAD ENTRY
4825 STA DP+1,1 O1(J) = O1
4832 ACCP DAC ** ACCUM POINTER
4835 SFTB BSS 36 SUBFUNCTION TABLE
4836 * **************************
4837 * *GENERATE SUBPRO ENTRANCE*
4838 * **************************
4839 * OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE
4840 * CALL TO ARGUMENT ADDRESS TRANSFER.
4847 GE10 JST NA00 INPUT NAME
4853 JMP GE30 MAKE ENTRY IN SFTB TABLE
4855 STA I IF FULL, GO TO GE30
4856 JST STXA SET XR TO A
4859 JST STXI ESTABLISH I
4862 JST STXA SET XR TO A
4865 JST STXI SET XR TO I
4870 JST STXA SET XR TO A
4872 STA DP+1,1 CLEAR OLD USACE
4878 JST AF00 DEFINE AFT (A=RPL+T0+3)
4884 JST IP00 INPUT OPERATOR
4887 JST OA00 OUTPUT ABS (0)
4891 STA NAMF+1 NAMF = AT
4892 JST NF00 FILL IN REMAINING NAME
4893 JST OL00 OUTPUT OBJECT LINK
4898 JST OA00 OUTPUT NUMBER OF ARGS
4899 IRS T0GE OUTPUT SPACE FOR ARG. ADDR.
4902 GE30 JST ER00 CONSTR, ERROR
4909 * CL SUBA IS INTERCHANGED WITH CL SUBF
4913 STA EL90 CL (F) == CL (A)
4935 NM00 DAC ** NON-COMMON TEST
4941 BCI 1,CR ILLEGAL COMMON REFERENCE
4944 * **************************
4945 * *NON DUMMY OR SUBPRO TEST*
4946 * **************************
4953 BCI 1,DA ILLEGAL USE OF A DUMMY ARGUMENT
4967 STA S2 NS = S2 = S3 = 0
4973 JMP SC15 EBAR .GR. 0
4974 JST XN00 EXAMINE NEXT CHAR,
4976 JMP SC70 IF (A) NON ZERO,
4977 SC15 JST IG00 GO TO SC70
4978 LDA SCT0 INPUT INTEGER
4985 SC60 JST AS00 ASSIGN ITEM
4986 SC20 LDA A S (NS+1) = A
4998 JMP SC50 MORE SUBSCRIPTS PERMITTED
4999 SC40 JST IP00 )-INPUT OPERATOR
5004 JMP SC40 TERMINATOR NOT A COMMA
5006 SC70 JST IR00 INPUT INT VARIABLE
5007 LDA SCT0 CHECK FOR NON-DUMMY
5008 SNZ VARIABLE DIMENSIONS
5015 BCI 1,VD ILLEGAL SYMBOLIC SUBSCRIPT
5020 * ********************
5021 * *INPUT LIST ELEMENT*
5022 * ********************
5023 * IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT
5027 SUB K105 NON-DUMMY TEST
5030 JST ER00 USAGE ERROR
5031 BCI 1,DD DUMMY ITEM IN AN EQUIV, OR DATA LIST
5032 LDA IU IF IU NOT ARR,
5037 JST SC00 INPUT SUBSCRIPTS
5038 JST FA00 FETCH ASSIGNS
5041 SZE S1 = D* (S1 + D1* (S2+D2*S3)
5042 JMP IL10 ELSE, GO TO IL10
5057 IL10 LDA NS IF NS NOT 1
5068 BCI 1,ND WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT
5070 IL30 JST TV00 TAG VARIABLE
5079 * IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER
5080 * FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS
5086 JST ER00 ILLEGAL STATEMENT
5087 BCI 1,FS NOT FIRST STATEMENT IN SUBPROGRAM
5088 R2A JST NA00 INPUT NAME
5091 CRA ADDR=0, S/C CODE =0
5092 JST ON00 OUTPUT NAME BLOCK TO THE LOADER
5097 SUB CRET IF IC NOT C/R
5104 BCI 1,FA FUNCTION HAS NO ARGUMENTS
5107 JST GE00 GENERATE SUBPROGRAM ENTRY
5108 JMP A1 GO TO C/R TEST
5111 JMP C6 GO TO CONTINUE
5114 * ******************
5117 * *DOUBLE PRECISION*
5120 * ******************
5121 * THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE
5122 * VALUE AND ANY ARRAY INFO IS PROCESSED
5127 A5 LDA K106 DOUBLE PRECISION
5132 A7A STA MFL TMFL = LOG
5133 LDA LSTF IF LSTF = 0, GO TO A7B (2)
5144 LDA DFL IF DFL NOT = 0, GO TO A7B
5147 LDA TID IF ID = FUNCTI,
5149 SNZ SKIP IF NOT 'FUNCTION'
5150 JMP A9 FUNCTION PROCESSOR
5151 A7A5 JST ER00 CONSTRUCTION ERROR
5152 BCI 1,TF 'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST
5153 A7K BCI 1,FU CONSTANT FOR 'FUNCTION' CHECK
5154 A7B JST NA00 INPUT NAME
5157 JMP B7 GO TO INPUT DIMENSION
5162 * TAGS NAME AS SUBPROGRAM
5163 B2 JST NA00 EXTERNAL, INPUT NAME
5164 JST TG00 TAG SUBPROGRAM
5165 JMP B1 GO TO , OR C/R TEST
5172 * PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL
5173 * ARRAY POINTER ITEM
5179 B3A LDA AT IF AT = DUM
5181 SZE ELSE (A) = .LT. 0
5183 B3B STA B3T0 T0 = (A)
5188 LDA AT TEST FOR AT=DUMMY
5190 SZE SKIP NO-USAGE TEST IF DUMMY
5191 JST NU00 NO USAGE TEST
5193 LDA DP+1,1 IU (A) = ARR
5199 JST SC00 INPUT SUBSCRIPT
5202 LDA S2 PLACE SUBSCRIPTS IN ID
5206 LDA NS (A) = 0, B = NS
5208 JST AA00 ASSIGN SPECIAL.
5215 STA DP+1,1 DEFINE GF T0 GF(A)
5226 STA DP+1,1 DEFINE GF TO GF(A)
5228 SUB K104 IF TC NOT SLASH
5230 JMP B1 GO TO ,-C/R TEST
5231 LDA A9T2 IF SIDSW = COMMON-4
5233 SZE GO T0 B4 (COMMON-0)
5234 JMP B1 ELSE, GO TO ,-C/R TEST
5246 * INPUT BLOCK NAMES AND LINK THEM WITH THE
5247 * FOLLOWING VAR/ARRAY NAMES, BLOCK NAMES
5248 * ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS
5253 LDA B4Z9 SET SWITCH IN INPUT DIMENSION
5259 B40 JST DN00 INPUT DNA
5263 LDA K101 (A) = SUB, (B) = 0
5264 JST AA00 ASSIGN SPECIAL
5280 STA DP+1,1 GF(A) = GF(CFL)
5285 STA DP+1,1 GF(CFL) = A
5286 B4D JST NA00 INPUT NAME
5287 JST ND00 NON DUMMY/SUBPROG TEST
5288 JST NM00 NON-COMMON TEST
5289 JST EL00 EXCHANGE LINKS
5292 ADD K122 AT(A) = COM (='040000)
5295 B4E JST UC00 UNINPUT COLUMN
5297 B4Z9 DAC B4D GO TO INPUT DIMENSION
5298 B4F OCT 107777 EXTRACT MASK TO STRIP OFF AT FIELD
5304 * STORE EQUIV INFO IN THE DATA POOL FOR LATER
5305 * PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP)
5306 B5 LDA E0 L = NEXT WORD IN EQUIVALENCE TABLE
5313 JST ER00 DATA POOL FULL
5314 BCI 1,MO MEMORY OVERFLOW
5315 JST STXI ESTABLISH I
5322 LDA TC PUT IN FIRST CHARACTER
5323 LGL 8 PACK INTO DP (I)
5328 JMP C6 CHARACTER E C/R - EXIT
5332 JMP B5B WORD NOT FULL
5333 JMP B5 OBTAIN NEW WORD
5334 B5D LDA TC PUT IN SECOND CHARACTER
5339 * *********************
5340 * *RELATE COMMON ITEMS*
5341 * *********************
5342 * ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED
5343 * AND THEIR INVERSE OFFSETS CALCULATED. THESE
5344 * WILL BE INVERTED LATER TO GIVE TRUE
5345 * POSITION IN THE BLOCK.
5353 C2B JST FL00 FETCH LINK
5357 ADD C2T0 T0 = T0 + D0
5359 JST DA00 DEFINE ADDRESS FIELD
5361 C2D JST FL00 FETCH LINK
5368 JMP C2A AF = CFL. NO
5369 JMP C3 YES - GROUP EQUIVALENCE
5371 SUB AF (A) = T0 - AF
5376 JST TV00 TAG VARIABLE
5380 * *******************
5381 * *GROUP EQUIVALENCE*
5382 * *******************
5383 * THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON
5384 * USAGE IS CHECKED TO SEE THAT THE ORIGIN
5385 * IS NOT MOVED AND THAT ONLY ONE ITEM IS
5399 STA EBAR EBAR=E(0) = END OF EQUIVALENCE TABLE
5401 STA E E=L(0) = START OF EUUIVALENCE TABLE
5408 LDA K102 T4 = STR-ABS
5410 JST CH00 INPUT CHARACTER
5413 C3D JST IL00 INPUT LIST ELEMENT
5420 C3F LDA F IF I=0, GO TO C3P
5425 SNZ IF A = I, GO TO C3N
5429 SNZ IF AT = COM, GO TO C3O
5433 STA T0C3 T(0) = AF +T (1)
5435 SUB K104 IF T(4) = 0, GO T0 C3K
5440 STA T0C3 T(0) = T(3)-T(0)
5445 C3K LDA C3T4 IMPOSSIBLE COMMON EQUIVALENCING
5447 LDA T0C3 AT (A) = COM
5455 SZE IF A .NE. T (2),
5456 JMP C3G GO TO C3G (5)
5458 JST EL00 EXCHANGE CL(A) == CL(I)
5459 C3M LDA TC EXCHANGE LINKS (CL(A) WITH CL(F) )
5463 JST IP00 )-INPUT OPERATOR
5465 SUB K134 IF TC = , OR C/R
5473 BCI 1,EC EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR
5475 C3N LDA T1C3 IF T1 = 0, GO TO C3M
5478 C3N5 JST ER00 ERROR IMPOSSIBLE GROUP
5479 BCI 1,IE IMPOSSIBLE EQUIVALENCE GROUPING
5489 CAS A IF A = F, GO TO C3M (B)
5497 JST FA00 FETCH ASSIGNS
5505 * ***********************
5506 * *ASSIGN SPECIFICATIONS*
5507 * ***********************
5508 * NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER
5509 * COMMON BLOCKS ARE OUTPUT (WITH SIZE).
5514 ADD K105 I = A = A+5
5518 JMP NP35 RETURN TO FIRST NON-SPEC CHECK (POINT 1)
5520 JST FA00 ELSE, FETCH ASSIGN
5522 SUB K102 IF AT = STR-ABS
5523 SZE IU=VAR, OR ARR, AND
5526 SUB K102 ELSE, GO TO C4C
5533 STA C4T0 T0 = 0. T1 =-MAX
5536 JST KT00 SET D(0) = NO. OF WORDS PER ITEM
5542 SUB AF (A) = D(0) - AF
5546 JST FL00 FETCH LINK ( (A)=A - F )
5550 ADD C4T0 RPL * RPL + T0 + TL
5552 ADD C4T1 TO = RPL-T1
5557 LDA C4T0 (A) = TO-AF
5561 SZE IF (A) NOT ZERO,
5562 JMP C4I NOT END OF EQUIVALENCE GROUP
5563 JMP C4C CHECK NEXT ITEM IN ASSIGNMENI TABLE
5565 C4L2 LDA FLT1 = LINK LOCATION TO COMMON BLOCK NAME
5568 STA I SAVE A FOR LATER MODIFICATION
5571 JMP C4M END OF COMMON GROUP
5572 JST STXI SET INDEX TO POINT TO CURRENT ITEM IN
5574 LDA DP,1 SET CL FIELD TO POINT AT COMMON BLOCK
5576 ANA K119 ( = '177000)
5577 ADD C4T1 (= LINK LOCATION OF COMMON BLOCK NAME)
5579 JMP C4L3 PROCESS NEXT ITEM IN COMMON BLOCK
5581 C4 LDA CFL LOC, OF FIRST (BLANK) COMMON BLOCK
5586 C4L JST FL00 FETCH LINK
5588 JMP C4L2 NO MORE ITEMS IN COMMON BLOCK
5589 LDA D0 ELSE, IF TO .LT. DO+AF,
5591 CAS C4T0 T0 = D0 + AF
5599 *....OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER
5600 LDA AF LENGTH OF COMMON BLOCK
5602 ADD K122 ='40000 (S/C CODE = 1)
5603 JST ON00 OUTPUT NAME BLOCK TO LOADER
5618 * **************************
5619 * *DATA STATEMENT PROCESSOR*
5620 * **************************
5621 * PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS
5622 * TO APPROPRIATE LOCATIONS. MODES MUST AGREE
5625 G PZE 0 LOWEST INDEX POINT IN LIST
5627 STA I I=END OF DATA POOL
5628 W4B JST IL00 INPUT LIST ELEMENT
5629 LDA AT D (0) = =WDS/ITEM
5631 SNZ IF AT = 'STR-ABS'
5635 LDA S1 S1 * DEFLECTION IF AN ARRAY
5637 STA DP,1 DP(E) = AF + S1
5639 STA DP-1,1 DP (E-1) = A
5649 JST TS00 TEST FOR SLASH TERMINATOR
5653 STA I I= END OF DATA POOL
5655 STA KPRM K' = KBAR = 0
5657 W4F JST DN00 INPUT, DNA
5660 JMP W4G VARIABLE OR ARRAY
5661 LDA TC LAST CHARACTER
5662 CAS K17 ='250 ( =( )
5664 JMP *+3 START OF COMPLEX CONSTANT
5666 BCI 1,CN NON-CON DATA
5667 STA SXF SET SXF TO NON-ZERO
5668 JMP W4F FINISH INPUT OF COMPLEX CONSTANT
5669 W4G LDA KBAR MULTIPLY COUNT
5678 STA KBAR KBAR = ID-1
5679 JST IT00 INTEGER TEST
5681 W4K LDA KPRM IF K NOT ZERO
5685 ALS 1 K ' = E-3* KBAR
5689 W4M JST STXI SET INDEX = I
5695 LDA BDF IF BDF NOT ZERO
5698 JST NM00 NON-COMMON TEST
5699 W4O JST STXI SET INDEX = I
5705 LDA HOLF IS IT HOLLERITH DATA
5707 JMP WHOW YES, GO TO OUTPUT IT
5710 JMP *,1 SWITCH ON NUMBER OF WORDS TO OUTPUT
5722 WHOW LDA D0 (A)=NO. OF WORDS PER ITEM
5723 ALS 1 (A)=NO. OF CHARS, PER ITEM
5724 STA NTID NTID=NO. OF CHARS. TO BE OUTPUT
5736 JMP W420 TO CHECK NEXT DATA
5740 LDA NTID NO. OF CHARS, REMAINED TO BE OUTPUT
5742 STA NTID NTID=NTID-2
5744 JMP W420 ALL FINISHED, CHECK NEXT ITEM
5745 JMP* WSNG SOME HOLLERITH CHARS, REMAINED
5746 W403 LDA TID+2 REAL OUTPUT
5750 W404 LDA TID+2 DOUBLE PRECISION OUTPUT
5754 W405 LDA TID INTEGER OUTPUT
5761 * TO BE OUTPUT, RETURN
5763 BCI 1,DM DATA AND DATA NAME MODE DO NOT AGREE
5770 SUB G TEST FOR COMPLETE
5777 JST CH00 INPUT NEXT CHARACTER
5779 SZE SKIP IF CHAR = COMMA
5780 JMP A1 CHECK FOR (CR)
5781 JMP W4 PROCESS NEXT DATA GROUP
5785 W4S JST FS00 FLUSH BUFFER IF NECESSARY
5786 LDA AF POSITION WITHIN COMMON BLOCK
5788 LDA K106 FORMAT BCD OUTPUT
5821 JST STXI I POINTS TO DATA TABLE
5822 LDA DP-1,1 SET A TO VARIABLE
5826 W4T LDA K101 =1 (=REL)
5829 JST AF00 DEFINE AFT (AT=REL. AF=RPL)
5830 LDA I SET POINTER IN DATA POOL
5833 STA DP,1 DP(I) = RPL OF VARIABLE
5839 * *********************************
5840 * *BLOCK DATA SUBPROGRAM PROCESSOR*
5841 * *********************************
5842 * SET BLOCK DATA FLAG AND OUTPUT FORCE LOAD CODE
5843 R3 LDA LSTF =0 IF FIRST STATEMENT IN THE SUBPROGRAM
5846 JST ER00 ERROR...NOT FIRST STATEMENT
5847 BCI 1,BL 'BLOCK DATA' NOT FIRST STATEMENT
5848 STA BDF SET BLOCK DATA FLAG ON (NON-ZERO)
5849 JST CH00 INPUT NEXT CHARACTER
5850 JMP A1 CHECK FOR (CR) AND EXIT
5858 * ***************************
5859 * *TRACE STATEMENT PROCESSOR*
5860 * ***************************
5861 * SETS TRACE TAG ON VARIABLES OR SETS TRACE FLAG
5862 TRAC JST XN00 EXAMINE NEXT CHARACTER
5863 SZE SKIP IF CHAR, WAS A DIGIT
5864 JMP TRAD JUMP IF CHAR. WAS A LETTER
5865 JST IS00 INPUT STATEMENT NO.
5866 LDA A STATEMENT NO. POINTER
5867 STA TRF SET TRACE FLAG ON
5868 JMP A1 TEST FOR (CR) AND EXIT
5870 TRAD JST NA00 INPUT NAME
5871 JST STXA SET INDEX TO NAME ENTRY
5872 LDA DP+4,1 TT(A) TRACE TAG
5875 JMP B1 (,) OR (CR) TEST
5876 * (RETURN TO TRAC IF (,) )
5880 * ********************
5881 * *OUTPUT OBJECT LINK*
5882 * ********************
5895 * GENERATE I/O DRIVER LINKAGE CODE. NAME OF
5896 * CALLED ROUTINE IS CHANGED IF UNIT DESIGNATOR
5899 JST IV00 INPUT INT VAR/CON
5913 OI10 JST CN00 CALL NAME
5917 JST OB00 (LOAD A (UNIT N0.))
5924 * SET UP NAME AND GENERATE CODE FOR CALLING IT.
5927 JST PRSP SET PRINT BUFFER TO SPACES
5928 LDA K147 SET UP OCI FOR CALL
5930 LDA NAMF+1 OCI = NAMF
5932 IAB ALSO TO PRINT BUFFER
5957 JMP *+3 INHIBIT SYMBOLIC OUTPUT
5958 CALL F4$SYM OUTPUT SYMBOLIC LINE,
5960 IRS RPL RPL = RPL + 1
5961 JST PRSP SET PRINT BUFFER TO SPACES
5969 * OUTPUT THE PACK WORD WHEN IT IS FULL.
5973 CAS CRET IF (A) = C/R
5976 IRS PKF PKF = PKF + 1
5977 JMP OK20 IF NON-ZERO, GO TO OK20
5978 OK10 ADD T0OK (A) = (A) + T0
5989 OK30 LDA PKF IF PKF = 0
5992 LDA K8 ELSE (A) = SPACE,
6000 * GENERAL OUTPUT ROUTINE. MAKES CHECKS AGAINST
6001 * THE ASSIGNMENT TABLE ENTRY TO PROCESS DUMMY,
6002 * EXTERNAL, RELATIVE, ABSOLUTE OR STRING
6003 * REFERENCES PROPERLY.
6009 JST STXA ESTABLISH A
6012 JST FA00 FETCH ASSIGNS
6013 LDA SOF SPECIAL OUTPUT FLAT
6015 JMP OB60 SUBSCRIPT CONSTANT DEFLECTION
6019 SUB K105 IF AT = 'DUM'
6023 SUB K101 IF IU = 'SUB'
6027 CAS K104 IF AT = 'COM'
6031 JMP *+2 IF AT = 'REL'
6036 JST AF00 DEFINE AF AND AT
6037 LDA AT IF AT = 'STR-RE'
6044 STA DF SET FLAG TO OUTPUT SYMBOLIC
6046 JST OA00 OUTPUT ABSOLUTE
6054 CHS REVERSE INDIRECT BIT
6057 OB20 JST FS00 OUTPUT COMMON REOUEST
6058 LDA T1OB PACK ADDRESS INTO BLOCK
6070 STA PRI+13 SET COMMON NAME INTO PRINT BUFFER
6075 STA PRI+12 SET COMMON NAME INTO PRINT BUFFER
6081 CAS *+1 LOOK FOR BLANK COMMON
6085 STA PRI+11 SET NAME INTO PRINT BUFFER
6096 STA A RESTORE A TO POINT AT NAME
6097 LDA RPL SET RPL MINUS
6098 SSM TO DISABLE WORD OUTPUT
6100 LDA FTOP OUTPUT WORD TO LIST
6101 JST OR00 SYMBOLIC COMMAND
6103 SSP INCREMENT PROGRAM
6104 AOA COUNTER FOR COMMON
6106 JST FS00 CLOSE OUT BLOCK
6128 STA SOF RESET SPECIAL OUTPUT FLAG
6130 CAS K105 TEST FOR DUMMY
6131 JMP OB06 PROCESS NORMALLY
6133 JMP OB06 PROCESS NORMALLY
6145 * PROCESSES THE TRIAD TABLE, HANDLES FETCH
6146 * GENERATION AND RELATIONAL OPERATOR CODE
6147 * GENERATION, DRIVES OUTPUT ITEM. ASSIGNS
6148 * AND OUTPUT TEMP STORES.
6152 T3OT PZE 0 TEMP STORE FOR P
6160 OT06 STA T1OT T1 = I
6167 JMP OT60 IF FINISHED, GO TO OT60
6194 JMP OT99 MAYBE SPECIAL LOAD FOR (A=) STATEMENT
6201 JST OM00 OUTPUT ITEM(P(I),A = 02(I))
6206 CRA ASSIGN TEMP STOR
6222 JST AS00 ASSIGN ITEM
6227 SSM SURPRESS TRACE OF TEMPORARY STORAGE
6228 JST OM00 OUTPUT ITEM (=,A)
6236 OT16 LDA K152 GENERATE FETCH
6237 JST OM00 OUTPUT ITEM
6238 OT32 LDA T3OT CHECK FOR RELATIONALS
6241 JMP OT18 NOT LOGICAL OR6RATOR
6244 JMP OT18 NOT A LOGICAL QPERATOR
6245 STA 0 SET INDEX = -1 TO -6
6247 STA MFL SET MODE TO LOGICAL
6249 STA A SET FOR OCTAL ADDRESS
6250 JMP *+7,1 BRANCH TO OPERATOR PROCESSOR
6256 LDA OMJ4 .NE. =ALS 16
6257 JST OA00 OUTPUT ABSOLUTE
6264 OT3C LDA OMJ4 = ALS 16
6267 JST OA00 OUTPUT ABSOLUTE
6269 OT3D JST OA00 OUTPUT ABSOLUTE
6272 JST OA00 OUTPUT ABSOLUTE
6274 OT3F JST OA00 OUTPUT ABSOLUTE
6275 OT3G LDA OMJ5 =LGR 15
6281 LDA K78 NAMF = F $AR
6283 JST OL00 OUTPUT OBJECT LINK
6287 STA I I = 02 (I) + DO
6288 JST DQ00 DO TERMINATION
6297 JST DS00 DO INITIALIZE
6300 LDA L0 RESET TRIAD TABLE
6307 JMP OT16 NOT SPECIAL LOAD
6308 STA MFL SPECIAL LOAD, SET MFL=0
6309 JMP OT18 OUTPUT A STORE
6320 * DRIVES BASIC OUTPUT ROUTINES. HANDLES SPECIAL
6321 * SUBSCRIPT PROCESSING, GENERATES NECESSARY
6322 * MODE CONVERSION CALLS AND HANDLES MODE
6323 * CHECKING. IN-LINE ARITHMETIC CODE IS
6324 * GENERATED WHERE POSSIBLE. OTHERWISE CALLS
6325 * TO ARITHMETIC ROUTINES ARE GENERATED.
6334 *-------------OUTPUT ITEM
6335 OM00 DAC ** RETURN ADDR
6338 STA T0OM R(0)=(A)='P' CODE
6359 JMP OM76 A .LE. ABAR....WITHIN TRIAD TABLE
6361 OM10 JST STXA SET INDEX=A
6363 ARS 9 SES IM=MODE OF ITEM
6366 OM14 LDA MFL SET MFL,IM AS DIGITS INTO NAMF
6374 CAS OM50+6,1 CHECK FOR SPECIAL OPERATOR
6376 JMP* OM52+6,1 'P'='Q',',','0','A'F', OR 'E'
6381 JMP OM62 SPECIAL LIBRARY FIX FOR ( A= )
6382 CAS IM CHECK FOR MODE MIXING
6384 JMP OMA1 ITEM MODE SAME AS CURRENT MODE
6386 JST OM44 CHECK MODE FOR LOG
6387 LDA K102 =2 (MODE CODE FOR REAL)
6388 CAS MFL MODE OF EXPRESSION
6390 JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING
6393 JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING
6395 JST OM44 TEST FOR MODE = COMPLEX
6396 OM26 LDA T0OM OPERATOR BEING PROCESSED
6399 JMP OM36 T(0)='=' (ALLOW INTEGER MODE)
6401 JST OM44 TEST FOR MODE=INTEGER
6404 JMP OM38 CONVERT MODE OF ACCUMULATOR
6406 OM30 JST NF00 SET LBUF+2 TO SPACES
6409 LDA A9X4,1 PICK-UP PRINT CODE FOR 'P' OPERATOR
6413 JMP OM46 MODE MIXING ERROR
6422 JST OM44 CHECK FOR MODE=COMPLEX
6425 JST NF00 SET LBUF+2 TO SPACES
6428 OM40 JST CN00 OUTPUT....CALL NAMF
6430 STA IM SET ITEM MODE TO CURRENT MODE
6435 JMP OM14 OUTPUT ARGUMENT ADDRESS
6437 *-----SUBROUTINE TO CHECK FOR ILLEGAL IM OR MFL MODES,
6438 OM44 DAC ** RETURN ADDR,
6439 CAS IM CHECK FOR IM0(A)
6442 CAS MFL CHECK FOR MFL=(A)
6446 OM46 JST ER00 NON-RECOVERABLE ERROR......
6447 BCI 1,MM MODE MIXING ERROR
6449 *------SPECIAL 'P' OPERATOR TABLE
6464 OM56 LDA OMI1 SET T(1) = ADD*
6467 OM60 JST STXA SET INDEX = A
6471 JST STXI SET INDEX=I
6475 JMP OM64 (POSSIBLE DUMMY ARRAY FETCH)
6477 STA MFL SET CURRENT MODE TO ITEM MODE
6483 SUB K101 CHECK FOR IU=1 (SUBROUTINE)
6486 LDA OMI2 SET T(1) = JST
6489 SUB K103 CHECK FOR IV=3 (ARRAY)
6492 LDA K101 SET CURRENT MODE TO INTEGER
6494 LDA OMI3 SET T(1) = LDA*
6499 CAS IM CHECK ITEM MODE EQUALS INTEGER
6502 LDA K105 CHECK FOR MODE = COMPLEX
6505 OM74 LDA K103 CHECK FOR MODE = LOGICAL
6507 JMP OM30 OUTPUT SUBROUTINE CALL
6509 OM76 JST STXA INDEX=A
6515 JMP OM84 P(A)='0' (SUBSCRIPTED VARIABLE)
6518 JMP OM80 P(A) = 'X' (END OF ARRAY CALCULATION)
6522 OM78 LDA T2OM P(4)= 'H' (HOLLERITH DATA)
6526 OM80 JST STXI INDEX=I
6528 STA DP+1,1 O1(I) = T(2)
6530 STA T1OT SET T(1) OF OUTPUT TRIADS TO ZERO
6533 CRA SET A=0 (NOT SYMBOLIC)
6536 ADD K102 AF = RPL+ 2
6538 LDA OMI4 =ADD INSTRUCTION
6539 JST OR00 OUTPUT RELATIVE
6541 ADD K102 AF = RPL P+ 2
6543 LDA OMI5 = JMP INSTR,
6544 JST OR00 OUTPUT RELATIVE
6547 STA SOF SET SPECIAL OUTPUT FLAG TO NON-ZERO
6553 OM84 LDA DP+1,1 O1(A)
6557 JMP OM86 A=L(0)....CONSTANT SUBSCRIPT ONLY
6558 LDA OMI0 T(1) = INDIRECT BIT
6562 OM86 LDA T2OM A=T(2)
6566 LDA DP,1 T(2) = 02(A)
6568 OM88 JST STXA INDEX=A
6579 OM90 OCT 130260 '00'
6580 OM91 OCT 000244 ' $'
6581 OM92 OCT 141644 'C$'
6582 OM93 OCT 152322 'TR'
6583 OM94 OCT 000021 'C' CODE
6584 OM95 OCT 017777 (MASK)
6588 OMA1 LDA IM CHECK FOR IM=LOGICAL
6592 CAS K101 CHECK FOR IM=INTEGER
6597 OMA3 LDA T0OM CHECK FOR T,0) = '+'
6603 JMP OMA6 OUTPUT 'TCA'
6606 LDA OMI4 =ADD INSTR.
6608 OMA4 LDA T2OM VALUE OF A
6609 SUB K126 ='12 KNOWN LOCATION OF A FOR 2
6610 SZE SMP IF MULTIPLIER IS A CONSTANT OF 2
6611 JMP OM30 COUPLE TO THE MULTIPLY SUBROUTINE
6612 STA A SET A AND AF TO ZERO (FOR LISTING FLAGS)
6614 LDA *+3 ALS 1 INSTRUCTION
6615 JST OA00 OUTPUT ABSOLUTE
6616 JMP* OM00 EXIT UUTPUT ITEM
6617 ALS 1 (INSTRUCTION TO BE OUTPUT)
6618 OMA5 CAS K102 CHECK FOR T(0) = '-'
6620 LDA OMI6 =SUB INSTR,
6623 STA A CAUSE OCTAL ADDR LISTING
6626 JST OA00 OUTPUT ABSOLUTE
6629 OMA7 CAS K153 CHECK FOR T(0) = '='
6631 JMP OMA9 OUTPUT A STA INSTR,
6632 SUB K152 CHECK FOR T(0) = 'F'
6635 OMA8 LDA OMI7 =LDA INSTR,
6637 OMA9 LDA OMI8 =STA INSTR,
6638 OMB1 ADD T1OM T(1) = T(1) + INSTR.
6640 OMB3 LDA T2OM SET A=T(2)
6642 LDA T9OM OUTPUT INSTR. WITH T(1) AND T(9)
6646 LDA T8OM CHECK FOR T(8) = '='
6651 LDA TRFA POINTER TO FIRST VARIABLE OR ARRAY
6652 STA A PROCESSED IN EXPRESSION
6653 JST TRSE OUTPUT TRACE COUPLING IF REQUIRED
6654 JMP* OM00 EXIT OUTPUT ITEM
6658 CAS K152 CHECK FOR T(0) = 'F'
6660 JMP OMA8 OUTPUT A LDA INSTR.
6661 CAS K153 CHECK FOR T(0) = '='
6663 JMP OMA9 OUTPUT A STA INSTR,
6664 CAS OM94 CHECK FOR T(0) = 'C'
6666 JMP OM30 OUTPUT COMPLEMENT CODING
6669 JMP OMC5 OUTPUT AN ANA INSTR.
6674 OMC5 LDA OMI9 =ANA INSTR.
6676 OMD1 IRS TXOM T0 = T0+1
6680 JST OA00 OUTPUT ABSOLUTE
6685 TRSE DAC 0 SUBROUTINE TO OUTPUT TRACE COUPLING
6686 JST STXA SET INDEX = A
6688 LDA DP+4,1 CHECK STATUS OF TRACE TAG
6693 LDA TRF CHECK STATUS OF TRACE FLAG
6696 TRS7 JST NF00 SET LBUF TO 'F$', LSUF+2 TO SPACES
6699 JST CN00 OUTPUT.....CALL NAMF
6700 JST STXA SET INDEX = A
6710 LDA DP,1 MERGE IM WITH ITEM NAME
6714 JST OA00 OUTPUT ABSOLUTE (FIRST 2 CHAR.)
6716 JST OA00 OUTPUT ABSOLUTE (NEXT 2 CHAR.)
6718 JST OA00 OUTPUT ABSOLUTE (LAST 2 CHAR.)
6721 *.................INSTRUCTION TABLE
6722 OMI0 OCT 100000 INDIRECT BIT
6723 OMI1 OCT 114000 ADD*
6725 OMI3 OCT 104000 LDA*
6732 OMJ1 OCT 102000 JMP*
6736 OMJ5 OCT 040461 LGR 15
6743 OMK5 OCT 042000 JMP 0,1
6744 OMK6 OCT 000000 DAC **
6763 * ALSO DRIVES SYMBOLIC INSTRUCTION OUTPUT.
6766 LDA K102 DF = NON ZER0
6773 OR12 LDA DF IF DF NOT ZERO
6778 LDA OR19 SET 'OCT' INTO PRINT IMAGE
6783 OR15 LDA RPL IF RPL PLUS
6785 JST OW00 OUTPUT WORD
6787 JMP *+3 SURPRESS SYMBOLIC OUTPUT
6788 CALL F4$SYM LIST LINE
6790 JST PRSP SET PRINT BUFFER TO SPACES
6792 OR18 OCT 147703 (0)(C)
6793 OR19 OCT 152240 (T)(SP)
6795 LDA OR90 SEARCH OP-CODE LIST
6797 STA XR PUT BCI IN PRINT IMAGE
6824 ANA K111 MASK OUT HIGH BITS OF ADDRESS
6831 STA PRI+8 SET =' INTO LISTING
6832 LDA DP,1 CHECK IM (A)
6834 SPL SKIP IF NOT COMPLEX
6837 SPL SKIP IF INTEGER OR LOGICAL
6840 JMP *+2 LIST EXPONENT AND PART OF FRACTION
6841 LDA DP+4,1 LIST INTEGER VALUE
6842 JST OR80 CONVERT OCTAL
6845 OR40 LDA DP+4,1 CONVERT AND PACK INTO
6865 * *******************
6866 * *OUTPUT STRING-RPL*
6867 * *******************
6873 STA OR00 SET RETURN INTO OUTPUT REL
6876 STA STFL STRING FLAG = NON ZERO
6877 JST PRSP SET PRINT BUF. TO SPACES
6878 JMP OR20 JMP-OUTPUT REL FOR SYMBOLIC AND BINARY
6911 OR92 BCI 22,ADJSLDADJMSULDSTANJMSNSMLLLRACTCCMSSAOSSJMDA
6913 BCI 9,STCASTSUDAERSUCA//
6914 OR93 BCI 22,D*T A*D P B A A A P*Z I 1515A A A C A M PXC
6916 BCI 9,G S A*B*C*R/BRS*/
6919 PRSP DAC ** SUBR. T0 SET PRINT BUF. T0 SPACES
6927 PRSK OCT 177730 =-40
6929 * *************************************
6930 * *OUTPUT SUBROUTINE/COMMON BLOCK NAME*
6931 * ************************************
6932 * OUTPUT AN EXTERNAL REFERENCE NAME.
6935 STA ONT1 SAVE ADDRESS
6936 JST FS00 FLUSH BUFFER IF NECESSARY
6937 JST STXA SET INDEX=A
6938 LDA ONT1 SUBR. ENTRY ADDR.
6940 STA ONT1 SAVE S/C BITS
6941 LDA ON02 ='600 (=BLOCK CODE NO.)
6945 JST STXA SET INDEX=A
6946 LDA DP+4,1 FIHST 2 CHAR. 0F NAME
6955 LDA DP+3,1 SECOND 2 CHAR. OF NAME
6959 LDA DP+2,1 LAST 2 CHAR. OF NAME
6970 STA OCNT SET 8LOCK SIZE (DOUBLED)
6971 JST FS00 FLUSH BUFFER
6973 ON02 OCT 600 BLOCK CODE NUMBER (6)
6974 ONT1 OCT 0 TEMP STORE
6986 JST FS00 FLUSH BUFFER IF DIFFERENCE IN RPL'S N0T 1
6992 JST FS00 FLUSH BUFFER
6995 STA OCNT OCNT = OCNT+3
6997 ARR 1 OCI (OUTPUT CARD IMAGE)
6999 SMI LEFT OR RIGHT POS,
7002 LRL 8 IF BUFFER FULL
7004 ANA K116 CALL FLUSH (FS0O)
7011 LDA PRI+14 USE LOW BIT OF PRI+14 DATA
7013 LGR 1 STRIP OFF HIGH BIT OF BLOCK CODE TYPE NO,
7014 LLL 3 SET DIGITS IN PRI+17, PRI+19
7019 LGL 1 SHIFT ADDR. TO RIGHT BY 1 BIT
7021 JST OR80 SET DIGITS IN PRI+15, PRI+16
7026 STA PRI+15 OVERWRITE BINARY DATA IN
7027 STA PRI+16 PRINT BUFFER WITH SPACES
7028 STA PRI+17 IF NO BINARY LISTING IS WANTED
7035 IMA STFL INDICATE WORD WAS KEY TO LOADER
7036 SNZ THEN LEAVE RPL ALONE
7044 LDA CODE COMBINE CODES TO
7049 JMP PU10 JUMP IF REL.
7053 STA PRI+14 SAVE FOR LISTING
7056 LRR 12 RESTORE POSITION
7075 * ******************
7076 * *FLUSH SUBROUTINE*
7077 * ******************
7079 LDA OCNT BUFFER OCCUPANCY SIZE
7080 JST SAV SAVE INDEX REGESTER
7081 SUB K104 CHECK FOR OCNT .GT. 4
7083 JMP FS20 SKIP OUTPUT IF BUFFER IS EMPTY
7084 ADD K105 ADD 1/2 AT B14
7087 STA OCNT OCNT = -WORDS/BUFFER
7089 STA PCNT BUFFER SIZE INCLUDING CHECKSUM
7090 LDA OCI FIRST WORD IN BUFFER
7094 JMP FS30 BLOCK TYPE = 2 (RELOCATABLE CODE)
7095 * EVERY TIME A BLOCK OF OBJECT OUTPUT IS DUMPED, THE FIRST
7096 * 3 WORDS OF THE BLOCK IS INSERTED IN THE SYMBOLIC OUTPUT
7097 * ALONG WITH AN EOB OPERATOR CODE IF SENSE SWITCH 1 1S DOWN.
7098 * TO INHIBIT THIS LINE, REPLACE FROM FS10 TO AND INCLUDING
7099 * FS11 WITH (FS10 CRA ).
7101 JMP FS11 N0 BINARY LISTING UNLESS SSW-1 IS DOWN
7103 DAC PRI OUTPUT WHATEVER MIGHT BE IN SYMBOLIC BUF.
7105 STA PRI+5 ENTER 'EOB' INTO LISTING
7109 JST OR80 ENTER FIRST WORD FROM BUFFER INTO LISTING
7112 JST OR80 ENTER WORD 2 FROM BUFFER INTO LISTING
7115 JST OR80 ENTER WORD 3 FROM BUFFER INTO LISTING
7117 CALL F4$SYM OUTPUT SYMBOLIC BUFFER
7119 JST PRSP RESET SYMBOLIC BUFFER TO SPACES
7121 STA 0 COMPUTE CHECKSUM
7122 FS12 ERA OCI,1 MERGE BUFFER WORD INTO CHECKSUM
7123 IRS 0 INCREMENT BUFFER POSITION
7124 IRS OCNT DECREMENT BUFFER SIZE
7126 STA OCI,1 SET CHECKSUM INTO BUFFER
7127 LDA PCNT = NO. OF WORDS IN BUFFER
7130 CALL F4$OUT PUNCH BUFFER
7131 FS20 LDA RPL SET UP BUFFER FOR NEXT OUTPUT
7133 ADD K145 =#'2000 (BLOCK CODE 2)
7136 STA OCI+1 SET FIRST 2 WORDS OF BUFFER
7138 STA OCNT RESET BUFFER OCCUPANCY SIZE
7139 JST RST RESET INDEX REGISTER
7142 FS30 LGL 6 MERGE BUFFER SIZE INTO BLOCK HEADER
7143 SUB OCNT BUFFER SIZE
7144 ADD K101 =1 (ACCOUNT FOR CHECKSUM)
7147 LLL 6 BRING IN UPPER HALF OF ADDRESSES
7148 STA OCI STORE INTO BUFFER
7149 JMP FS10 COMPUTE CHECKSUM
7152 FS41 BCI 2,EOB 'EOB'
7153 K145 OCT 20000 BLOCK TYPE 2 CODE
7156 OCI BSS 40 40 WORD CARD IMAGE INPUT BUFFER
7157 PRI BSS 40 40 WORD PRINT BUFFER
7159 BSS 30 COMPILER PATCH AREA
7161 * ***********************
7162 * *IOS (AND IOL) GO HERE*
7163 * ***********************