040533c5 |
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 | * 00IIIIIIIIIIIII |
184 | * 00TTTITTTTTTTTT |
185 | * 00XXXXXXXXXXXXX |
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 (A0I TABLE) 'FLOATS' ON TOP |
195 | * THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES. |
196 | * |
197 | * NOOOOOOOOIIIIIII.....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 CONSTAST 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 SPECIFI |
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 |
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 LSE, 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 'S' 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 T0 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 IU (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 TO = -(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+TO |
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 = U |
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 | * |
2882 | NP10 LDA LSTN SPECIFICATION STATEMENT CLEAN-UP |
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 T0 |
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 FSRN |
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 G0 10 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 N0, G0 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 G0 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 01 = 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 = D0 |
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 T0 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 O2(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 0A |
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 0F 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 TO = 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 + ( Z ( |
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 |
3476 | SUB K48 |
3477 | SZE |
3478 | JMP V2F |
3479 | V2J JST HS00 TRANSMIT HOLLERITH STRING |
3480 | JMP V2E5 GO T0 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 T0 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 T0 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 T0 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 CENERATE 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 0A |
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 0UTPUT ITEM (F,A) |
3659 | JST OM00 |
3660 | R9C LRL 32 |
3661 | STA A SET FOR OCTAL ADDHESS IW 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=L (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 T0 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 D0=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 STRONG 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 STRONG 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 = D0+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+D0+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 0 (I) = 0 |
4037 | CMA |
4038 | STA IFLG IFLM NOT 0 |
4039 | LDA L0 |
4040 | STA DP-2,1 O(I-2) = L0 |
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 CHAJNE * 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 = L0 |
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 = L0 |
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(--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 01(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 O1(1+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 T0 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 ZER0, 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 TU 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 02 = 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 01=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 T0 CA32 |
4794 | * IF J IS A REFERENCE TO A TRIAD , THE TEMP |
4795 | * STORE BIT 0F THE REFERENCED TRIAD IS SET.) |
4796 | TC00 DAC ** TEMP STORE CHECK |
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 O1(J) = O1 |
4826 | LDA O2 |
4827 | STA DP,1 O2(J) = O2 |
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 IC NOT C/R |
5098 | SZE |
5099 | JMP R2C GO TO |
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 TO , 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 T0 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 T0 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 |
5425 | SNZ IF A = I, GO TO C3N |
5426 | JMP C3N |
5427 | C3H LDA AT |
5428 | SUB K104 ELSE, |
5429 | SNZ IF AT = COM, GO TO C3O |
5430 | JMP C3O |
5431 | C3H2 LDA T1C3 |
5432 | ADD AF |
5433 | STA T0C3 T(0) = AF +T (1) |
5434 | LDA T4C3 |
5435 | SUB K104 IF T(4) = 0, GO T0 C3K |
5436 | SZE |
5437 | JMP C3K |
5438 | LDA T3C3 |
5439 | SUB T0C3 ELSE, |
5440 | STA T0C3 T(0) = T(3)-T(0) |
5441 | SMI |
5442 | JMP C3K |
5443 | JST ER00 IF T(0)<0, |
5444 | BCI 1,IC |
5445 | C3K LDA C3T4 IMPOSSIBLE COMMON EQUIVALENCING |
5446 | IAB |
5447 | LDA T0C3 AT (A) = COM |
5448 | ALS 2 |
5449 | LGR 2 |
5450 | JST AF00 |
5451 | JST FL00 DEFINE AF |
5452 | JST SAF FETCH LINK |
5453 | LDA A |
5454 | SUB C3T2 |
5455 | SZE IF A .NE. T (2), |
5456 | JMP C3G GO TO C3G (5) |
5457 | * |
5458 | JST EL00 EXCHANGE CL(A) == CL(I) |
5459 | C3M LDA TC EXCHANGE LINKS (CL(A) WITH CL(F) ) |
5460 | SUB K134 IF TC = , |
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) = TO-AF |
5558 | SUB AF |
5559 | JST AF00 DEFIME 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 ASSIGNMENI 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. DO+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 TO = 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 = 02 (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 02(A) |
6511 | STA T2OM T(2)=02(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 |
6522 | OM78 LDA T2OM P(4)= 'H' (HOLLERITH DATA) |
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) = 02(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 SMP IF MULTIPLIER IS A CONSTANT OF 2 |
6611 | JMP OM30 COUPLE TO THE MULTIPLY SUBROUTINE |
6612 | STA A SET A AND AF TO ZERO (FOR LISTING FLAGS) |
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 (0)(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 FIHST 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 8 |
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 |
7103 | DAC PRI OUTPUT WHATEVER MIGHT BE IN SYMBOLIC BUF. |
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 |