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