faae1561 |
1 | * TAPE 4 OF 5 - BEGIN |
2 | * |
3 | EX34 LDA B IF B = 0 |
4 | SUB EXT7 |
5 | SZE |
6 | JMP EX40 NO, GO TO EX40 |
7 | LDA T0EX IF T (0) = 0 |
8 | SZE |
9 | JMP EX38 NO, GO TO EX38 |
10 | EX35 CRA |
11 | STA IFLG IFLG = 0 |
12 | LDA F |
13 | AOA |
14 | SMI F . GE. -1 |
15 | JMP EX36 YES |
16 | JMP* EX00 RETURN - NO |
17 | EX36 JST CA00 SCAN |
18 | JST OT00 OUTPUT TRIADS |
19 | JMP* EX00 RETURN |
20 | EX38 JST STXI |
21 | LDA B |
22 | SUB K109 |
23 | STA B |
24 | LDA K103 |
25 | STA MFL |
26 | LDA T0EX |
27 | LGL 9 O (I) = T (0) |
28 | ADD B I (I) = B+9 |
29 | ADD K124 I = I+2 |
30 | STA DP+1,1 |
31 | JST EX99 DATA POOL CHECK |
32 | CRA |
33 | STA T0EX T0 = 0 |
34 | STA EXT7 T7 = 0 |
35 | EX39 LDA L0 |
36 | STA A A = L0 |
37 | STA IM IM NOT EQ 0 |
38 | JMP EX10 |
39 | EX40 LDA TC TC 0 , |
40 | CAS K5 ='254 (,) IN BCD MODE |
41 | JMP *+2 |
42 | JMP EX41 |
43 | SUB K134 =17 |
44 | SZE |
45 | JMP EX44 NO, GO TO EX44 |
46 | EX41 LDA I |
47 | EX42 SUB K102 |
48 | STA XR B VS. I (J) |
49 | LDA DP+1,1 |
50 | ANA K118 |
51 | CAS B |
52 | JMP *+3 |
53 | JMP EX24 EQUAL, GO TO EX24 |
54 | JMP* EX00 LESS, RETURN |
55 | LDA XR GREATER, REPEAT LOOP |
56 | JMP EX42 |
57 | EX44 JST IP00 ) - INPUT OPERATOR |
58 | JMP EX30 GO TO EX30 |
59 | EX46 LDA* A |
60 | STA T6EX IF O1(O1(A)) = L(0) |
61 | LDA* T6EX |
62 | CAS L0 |
63 | JMP *+2 |
64 | JMP EX34 GO TO EX34 |
65 | STA O2 O2 = L0 |
66 | EX48 JST ET00 ENTER TRIAD |
67 | JMP EX34 |
68 | EX50 JST STXI |
69 | LDA A A(I) = A |
70 | STA DP,1 |
71 | LDA IU IU = SUB OR ARR |
72 | SLN |
73 | JMP EX30 NO, GO TO EX30 |
74 | LDA TC |
75 | SUB K17 TC = ( |
76 | SZE |
77 | JMP EX76 NO, GO TO EX76 |
78 | LDA B YES, B = B+16 |
79 | ADD K109 |
80 | STA B |
81 | LDA IU IU = ARR |
82 | SUB K103 |
83 | SZE |
84 | JMP EX75 NO, GO TO EX75 |
85 | CRA |
86 | STA DP,1 A(I) = 0 |
87 | STA X4 X4 = 0 |
88 | STA T3EX T3 = 0 |
89 | STA K T5 = A |
90 | LDA D0 |
91 | STA T9EX T9 = D0 |
92 | LDA A |
93 | STA T5EX T5 = A |
94 | LDA AT |
95 | SUB K105 AT = DUM |
96 | SZE |
97 | JMP EX74 NO, GO TO EX74 |
98 | CRA |
99 | STA T2EX YES, T (0) = 0 |
100 | JST EX99 DATA POOL CHECK |
101 | JST STXI |
102 | LDA A |
103 | STA DP,1 A(I) = A |
104 | LDA K132 OI (I) = A, 11 |
105 | LGL 9 |
106 | ADD K124 |
107 | STA DP+1,1 I=9 |
108 | EX54 LDA D0 IF D0 = 1, GO TO EX56 |
109 | SUB K101 |
110 | SNZ |
111 | JMP EX56 |
112 | JST EX99 DATA POOL CHECK |
113 | JMP *+2 |
114 | EX55 IRS K K = K+1 |
115 | LDA K |
116 | STA XR |
117 | LDA X,1 |
118 | STA T6EX T6 = X (K) |
119 | JST STXI |
120 | LDA T6EX |
121 | STA DP,1 O(I) = * |
122 | LDA K103 I (I) = T3+13 |
123 | LGL 9 T3 = T3+16 |
124 | ADD T3EX A (A) = T6 |
125 | ADD K129 =13 |
126 | STA DP+1,1 |
127 | ANA K118 |
128 | ADD K103 |
129 | STA T3EX T3 = A(A) |
130 | EX56 JST IV00 INPUT INTEGER VARIABLE |
131 | JST EX99 DATA POOL CHECK |
132 | JST STXI |
133 | LDA A A(I) = A |
134 | STA DP,1 |
135 | LDA NT |
136 | SZE |
137 | JMP EX68 CONSTANT ENCOUNTERED |
138 | JST UC00 UNINPUT COLUMN |
139 | JST DN00 INPUT DO NOT ASSIGN |
140 | SNZ |
141 | JMP EX57 IM = 0 |
142 | SUB K101 |
143 | SNZ |
144 | JMP EX57 IM * INTEGEH |
145 | JST ER00 |
146 | BCI 1,SU SUBSCRIPT INCREMENTER NOT A CONSTANT |
147 | EX57 JST STXI |
148 | LDA K101 |
149 | LGL 9 |
150 | ADD T3EX |
151 | ADD K127 |
152 | STA DP+1,1 O(1) = +, I(I) = T3+11 |
153 | JST EX99 DATA POOL CHECK |
154 | EX58 LDA T9EX |
155 | STA D0 RESET D(0) |
156 | LDA ID SUBSCRIPT SIZE |
157 | SUB K101 ID = ID-1 |
158 | STA ID |
159 | SNZ IF ZERO, GO TO EX60 |
160 | JMP EX60 |
161 | LDA K |
162 | STA 0 |
163 | LDA D0,1 D(K) = 0 |
164 | SNZ |
165 | JMP EX67 YES - (DUMMY DIMENSION) |
166 | IAB |
167 | LDA ID |
168 | JST IM00 |
169 | ADD T2EX |
170 | STA T2EX T2 = T2+ID*D(K) |
171 | EX60 LDA T9EX |
172 | STA D0 RESET D(0) |
173 | LDA K |
174 | STA 0 |
175 | LDA X+2,1 X(K+2) = 0 |
176 | SNZ |
177 | JMP EX62 YES - FINISHED |
178 | LDA K134 =17 |
179 | JST TS00 COMMA TEST |
180 | LDA D0+1,1 |
181 | IAB |
182 | LDA D0,1 |
183 | JST IM00 |
184 | STA D0+1,1 D(K+1) = D(K+1)*D(K) |
185 | JMP EX55 |
186 | EX62 JST STXI |
187 | LDA DP-1,1 DOES O(--2) = * |
188 | SSP |
189 | LGR 9 |
190 | CAS K103 |
191 | JMP *+2 |
192 | JMP EX66 YES. |
193 | SNZ NO. |
194 | JMP EX64 O(I-2) = 0 - YES |
195 | CAS K132 DOES O(I-2) = A |
196 | JMP EX63 |
197 | JMP *+2 YES |
198 | JMP EX63 |
199 | LDA T2EX IS T2 = 0 |
200 | SNZ |
201 | JMP EX65 YES (DUMMY ARRAY (1,1,1)) |
202 | EX63 LDA K101 |
203 | STA DP-1,1 01(I-2) = 1 |
204 | LDA T2EX A(I) = T2 |
205 | STA DP,1 |
206 | LDA K137 0='X' ('24), I=2 |
207 | STA DP+1,1 |
208 | CRA |
209 | STA DP+3,1 O1(1+2) = 0 |
210 | LDA T5EX |
211 | STA DP+2,1 A(I+2) = T5 |
212 | JST EX99 DATA POOL CHECK |
213 | JST CA00 SCAN |
214 | LDA O1 |
215 | STA A A = O1 |
216 | JST STXA |
217 | LDA DP+2,1 S(A) = NON-ZERO |
218 | SSM |
219 | STA DP+2,1 S(A) = 1 |
220 | JMP EX44 |
221 | EX64 LDA L0 |
222 | STA DP,1 A(I) = L0 |
223 | JST EX99 DATA POOL CHECK |
224 | JST STXI |
225 | JMP EX63 |
226 | EX65 LDA I |
227 | SUB K104 |
228 | STA I I = I-4 |
229 | LDA T5EX |
230 | STA DP-4,1 A (I) = T5 |
231 | JMP EX44 |
232 | EX66 LDA I |
233 | SUB K102 |
234 | STA I I = I-2 |
235 | JMP EX62 ASSIGN INT CONSTANT |
236 | EX67 JST AI00 |
237 | JST STXI SET XR TO I |
238 | LDA A |
239 | STA DP,1 A(I) = A |
240 | LDA K101 |
241 | LGL 9 |
242 | ADD T3EX |
243 | ADD K127 |
244 | STA DP+1,1 OI(I) = +, T3+11 |
245 | JST EX99 DATA POOL CHECK |
246 | JMP EX60 |
247 | EX68 LDA TC IS TC |
248 | CAS K103 = * |
249 | JMP *+2 |
250 | JMP *+2 |
251 | JMP EX58 NO |
252 | LGL 9 |
253 | ADD T3EX |
254 | ADD K129 =13 |
255 | STA DP+1,1 OI(I) = *, T3+13 |
256 | JST IR00 INPUT INTEGER VAR/CON |
257 | JMP EX56+1 |
258 | EX69 CRA SET LISTING FOR OCTAL ADDR |
259 | STA A |
260 | LDA OMI5 JMP 0 INSTRUCTION |
261 | STA DF SET LISTING FOR SYMBOLIC A INSTR, |
262 | JST OA00 OUTPUT ABSOLUTE |
263 | LDA RPL |
264 | STA O2 |
265 | LDA K138 |
266 | STA P P = H |
267 | JST ET00 ENTER TRIAD |
268 | JST HS00 TRANSFER HOLLERITH STRING |
269 | LDA CRET (A) = C/R |
270 | JST OK00 OUTPUT PACK |
271 | CRA |
272 | STA 0 SET LISTING FOR OCTAL ADDR. |
273 | STA A SET LISTING FOR OCTAL ADDR. |
274 | LDA O2 |
275 | SUB K101 |
276 | JST OS00 OUTPUT STRING RPL-1 |
277 | JST CH00 INPUT CHARACTER |
278 | JST FN00 |
279 | JST STXI RESET INDEX TO I |
280 | LDA L |
281 | STA DP,1 A(I) = L |
282 | JMP EX76 |
283 | EX74 LDA AF |
284 | STA T2EX T2 = AF |
285 | JMP EX54 GO TO EX54 |
286 | EX75 LDA K134 |
287 | STA TC TC = , |
288 | JMP EX24 GO TO EX24 |
289 | EX76 LDA DP-1,1 |
290 | LGR 9 |
291 | ANA K133 |
292 | SUB K134 |
293 | SNZ |
294 | JMP EX34 WITHIN AN ARGUMENT LIST |
295 | JST ER00 |
296 | BCI 1,AG SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST |
297 | EX78 LDA K127 |
298 | EX79 STA T1EX T (1) = 11 |
299 | JMP EX22 |
300 | EX80 LDA K129 T (1) = 13 |
301 | JMP EX79 |
302 | EX81 LDA K106 |
303 | STA T1EX T (1) = 6 |
304 | JMP EX20 |
305 | EX82 LDA K104 T (1) = 4 |
306 | JMP EX81+1 |
307 | EX83 LDA T0EX T (0) =0 |
308 | SZE |
309 | JMP EX84 |
310 | LDA TC YES, |
311 | STA T0EX T (0) = TC |
312 | LDA EX92+1 |
313 | STA TC TC = - |
314 | LDA B |
315 | ADD K109 |
316 | STA B |
317 | STA EXT7 |
318 | LDA *+2 |
319 | JMP EX79 |
320 | DEC -5 |
321 | EX84 JST ER00 ERROR |
322 | BCI 1,RL MORE THAN 1 RELATIONAL OPERATOR |
323 | EX85 LDA F |
324 | ADD K102 T (5) = T (5) +2 = B = 0 |
325 | STA F |
326 | ADD B |
327 | SNZ |
328 | JMP EX24 |
329 | JST ER00 ERROR |
330 | BCI 1,EQ MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF = |
331 | EX90 OCT 250 ( |
332 | OCT 3 * |
333 | OCT 5 NOT |
334 | OCT 1 + |
335 | OCT 2 - |
336 | OCT 310 H |
337 | EX91 DAC EX12 ( |
338 | DAC EX16 * |
339 | DAC EX18 NOT |
340 | DAC EX26 + |
341 | DAC EX26 - |
342 | DAC EX69 H |
343 | EX92 OCT 1 + |
344 | OCT 2 - |
345 | OCT 3 * |
346 | OCT 4 / |
347 | OCT 6 AND |
348 | OCT 7 OR |
349 | OCT 15 NE |
350 | OCT 12 EQ |
351 | OCT 14 GT |
352 | OCT 10 LT |
353 | OCT 13 GE |
354 | OCT 11 LE |
355 | OCT 16 = |
356 | OCT 16 = (ERROR) |
357 | EX93 DAC EX78 + |
358 | DAC EX78 |
359 | DAC EX80 * |
360 | DAC EX80 / |
361 | DAC EX81 AND |
362 | DAC EX82 OR |
363 | DAC EX83 NE |
364 | DAC EX83 EQ |
365 | DAC EX83 GT |
366 | DAC EX83 LT |
367 | DAC EX83 GE |
368 | DAC EX83 LE |
369 | DAC EX85 = |
370 | DAC EX34 NONE OF THESE |
371 | EX95 JST ER00 |
372 | BCI 1,OP MURE THAN ONE OPERATOR IN A ROW |
373 | EX96 JST ER00 ERROR |
374 | BCI 1,PA OPERATOR MUST BE WITHIN PARENTHESES |
375 | EX97 JST ER00 ERROR |
376 | BCI 1,UO MULTIPLE + OR - SIGNS NOT AS UNARY OPS |
377 | * BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW |
378 | EX99 DAC ** |
379 | IRS I |
380 | IRS I |
381 | LDA I |
382 | AOA |
383 | CAS L |
384 | NOP |
385 | JMP AS50 |
386 | JMP* EX99 |
387 | K133 OCT 77 |
388 | K130 DEC -6 |
389 | K141 DEC 33 |
390 | K PZE 0 |
391 | KM8 DEC -8 |
392 | * |
393 | * |
394 | * |
395 | * |
396 | * ****************** |
397 | * *SCAN * |
398 | * *TRIAD SEARCH * |
399 | * *TEMP STORE CHECK* |
400 | * ****************** |
401 | T0CA PZE 0 |
402 | T1CA PZE 0 |
403 | T2CA PZE 0 |
404 | T9CA PZE 0 |
405 | * THE AOIN TABLE IS PROCESSED FROM THE BOTTOM |
406 | * UP AND ENTRIES ARE FORMED FOR INCLUSION |
407 | * IN THE TRIAD TABLE, LEVELS ARE USED |
408 | * TO CONTROL THE ORDER OF ENTRY INTO |
409 | * THE TRIADS. SIGN CONTROL IS ALSO |
410 | * ACCOMPLISHED IN THIS ROUTINE. |
411 | CA00 DAC ** |
412 | LDA L0 |
413 | STA ACCP INDICATE EMPTY ACCUM |
414 | CA04 JST STXI ESTABLISH I |
415 | STA T1CA T1 = I |
416 | LDA DP-1,1 |
417 | ANA K118 IF I (I-2) = 0, |
418 | * OR .LT. I (I) |
419 | STA T9CA |
420 | LDA DP+1,1 |
421 | ANA K118 |
422 | CAS T9CA |
423 | JMP CA08 GO TO CA08 |
424 | NOP |
425 | LDA I |
426 | SUB K102 |
427 | STA I I = I-2 |
428 | STA 0 |
429 | CA08 LDA DP+3,1 |
430 | ERA DP+1,1 |
431 | STA T0CA |
432 | LDA DP+1,1 |
433 | ANA K118 |
434 | STA T2CA |
435 | LDA DP+1,1 |
436 | SSP |
437 | LGR 9 P = O (I) |
438 | STA P |
439 | CAS K102 IF P IS NOT * OR /, GO TO CCA10 |
440 | CAS K105 |
441 | JMP CA10 |
442 | JMP CA10 |
443 | JMP CA14 GO T0 CA14 |
444 | CA10 LDA T0CA |
445 | SMI |
446 | JMP CA13 |
447 | LDA KM8 |
448 | IMA XR |
449 | IAB |
450 | LDA P |
451 | CAS CA90+8,1 |
452 | JMP *+2 |
453 | JMP *+4 |
454 | IRS XR |
455 | JMP *-4 |
456 | JMP CA45 |
457 | LDA CA91+8,1 |
458 | STA P |
459 | IAB |
460 | STA XR |
461 | CA13 LDA K130 |
462 | IMA XR |
463 | IAB |
464 | LDA P |
465 | CAS CA90+8,1 |
466 | JMP *+2 |
467 | JMP CA50 |
468 | IRS XR |
469 | JMP *-4 |
470 | IAB |
471 | STA XR |
472 | IAB |
473 | LDA DP+1,1 |
474 | JMP *+2 |
475 | CA50 CRA |
476 | STA T0CA |
477 | IAB |
478 | STA XR |
479 | CA14 LDA DP,1 |
480 | STA O1 O1=A(I) |
481 | LDA DP+2,1 |
482 | STA O2 O2 = A (I+2) |
483 | LDA T2CA |
484 | SNZ |
485 | JMP CA37 IF ZER0, GO TO CA37 |
486 | LDA DP-1,1 |
487 | SSP |
488 | LGR 9 |
489 | STA T1CA |
490 | LDA DP-1,1 |
491 | ANA K118 IF T2 .GT. I (I-2) |
492 | SUB T2CA |
493 | SPL |
494 | JMP CA18 |
495 | SZE |
496 | JMP CA04 |
497 | LDA O2 |
498 | SUB ACCP |
499 | SZE |
500 | JMP CA04 |
501 | LDA P |
502 | SUB K103 |
503 | SMI |
504 | JMP CA39 |
505 | LDA T1CA |
506 | SUB P |
507 | SZE |
508 | LDA K101 GO TO |
509 | ADD K101 P = - OR + |
510 | STA P |
511 | CA18 LDA I |
512 | STA 0 J=I |
513 | CA20 LDA DP+2,1 |
514 | STA DP,1 AOIN(J) = AOIN(J+2) |
515 | LDA DP+3,1 |
516 | STA DP+1,1 |
517 | SSP |
518 | SNZ |
519 | JMP CA22 |
520 | IRS XR J = J+2 |
521 | IRS XR |
522 | JMP CA20 |
523 | CA22 JST STXI |
524 | LDA DP+1,1 |
525 | SSP IF O (I) = , |
526 | LGR 9 |
527 | CAS P |
528 | JMP CA24 |
529 | CAS K134 |
530 | JMP CA24 |
531 | JMP CA30 GO TO CA30 |
532 | CA24 JST ST00 TRIAD SEARCH |
533 | LDA P |
534 | CAS K132 IF P = +,*, AND, OR |
535 | JMP CA28 |
536 | JMP CA37 GO TO CA37 |
537 | CAS K107 |
538 | JMP CA28 ELSE, GO TO CA26 |
539 | JMP CA37 |
540 | CAS K106 |
541 | JMP CA28 |
542 | JMP CA37 |
543 | CAS K103 |
544 | JMP CA28 |
545 | JMP CA37 |
546 | CAS K101 |
547 | JMP CA26 |
548 | * |
549 | * |
550 | * |
551 | JMP CA37 |
552 | CA26 CAS K102 |
553 | JMP *+2 IF P = - |
554 | JMP CA35 GO TO |
555 | CA28 LDA O1 |
556 | JST TC00 TEMP STORE CHECK |
557 | CA30 LDA O2 |
558 | JST TC00 TEMP STORE CHECK |
559 | CA31 JST ET00 ENTER TRIAD |
560 | CA32 JST STXI |
561 | LDA O1 |
562 | STA DP,1 |
563 | LDA DP+1,1 |
564 | LRL 15 |
565 | LDA T0CA |
566 | LGR 15 |
567 | LLL 15 |
568 | STA DP+1,1 |
569 | LDA T2CA IF T2 NOT ZERO, |
570 | SZE |
571 | JMP CA04 GO TU CA04 |
572 | JMP* CA00 ELSE, RETURN |
573 | CA35 LDA T0CA |
574 | ERA ='100000 |
575 | STA T0CA |
576 | CA37 LDA O2 |
577 | IMA O1 O1 * = O2 |
578 | STA O2 |
579 | SNZ IF 02 = 0, |
580 | JMP CA32 GO TO CA32 |
581 | * |
582 | * |
583 | * |
584 | JST ST00 TRIAD SEARCH |
585 | LDA T0CA |
586 | SMI |
587 | JMP CA28 GO TO CA28 |
588 | LDA P |
589 | JMP CA26 ELSE, GO TO CA26 |
590 | CA39 SUB K128 |
591 | SNZ IF P = , OR |
592 | JMP CA04 |
593 | LDA T1CA |
594 | SUB K104 |
595 | SZE ELSE, |
596 | JMP CA18 GO TO CA18 |
597 | JMP CA04 |
598 | CA45 LDA T1CA |
599 | STA I I = T1 |
600 | STA T2CA |
601 | CRA |
602 | STA T0CA * * * * * * * * * * * |
603 | STA O2 O2 = C = 0 |
604 | SUB K110 P = C |
605 | STA P |
606 | JMP CA24 GO TO CA24 |
607 | * IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES |
608 | * ANY TRIAD TABLE ENTRY, EXIT WITH THE |
609 | * POINTER VALUE OF THE MATCHING ENTRY |
610 | * (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT |
611 | * SUBEXPRESSION CALCULATIONS. |
612 | ST00 DAC ** TRIAD SEARCH |
613 | LDA F |
614 | ADD K103 |
615 | SZE |
616 | JMP ST10 GO TO ST10 |
617 | ST05 LDA P ELSE, IF P = X |
618 | SUB K139 |
619 | SNZ |
620 | JMP CA31 GO TO CA31 |
621 | LDA O1 ELSE, IF 01=ACCP |
622 | SUB ACCP |
623 | SNZ |
624 | JMP CA30 GO TO CA30 |
625 | JMP* ST00 ELSE, RETURN |
626 | ST10 LDA L0 |
627 | STA XR |
628 | ST20 LDA XR |
629 | SUB K103 |
630 | STA XR J = J-2 |
631 | SUB L IF J .LT. L |
632 | SPL |
633 | JMP ST05 GO TO ST05 |
634 | LDA O2 |
635 | SUB DP,1 IF O1/P/O2 .NE. O1/P/O2(J) |
636 | SZE |
637 | JMP ST20 GO TO ST20 |
638 | LDA DP+2,1 |
639 | SSP EXTRACT OFF STORE BIT |
640 | SUB P |
641 | SZE |
642 | JMP ST20 |
643 | LDA O1 |
644 | SUB DP+1,1 |
645 | SZE |
646 | JMP ST20 O1 = J |
647 | LDA XR |
648 | STA O1 |
649 | JST STXI ESTABLISH I |
650 | JMP CA32 GO T0 CA32 |
651 | * IF J IS A REFERENCE TO A TRIAD , THE TEMP |
652 | * STORE BIT 0F THE REFERENCED TRIAD IS SET.) |
653 | TC00 DAC ** TEMP STORE CHECK |
654 | STA XR |
655 | LDA ABAR |
656 | SUB XR |
657 | SMI IS J .GR. ABAR |
658 | JMP* TC00 NO. |
659 | LDA DP+2,1 YES. |
660 | SSM |
661 | STA DP+2,1 S(J) = 1 |
662 | JMP* TC00 |
663 | CA90 OCT 1,2,11,10,13,14,12,15 |
664 | CA91 OCT 2,1,13,14,11,10,12,15 |
665 | * |
666 | * |
667 | * ************* |
668 | * *ENTER TRIAD* |
669 | * ************* |
670 | * STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY |
671 | * LOCATION. |
672 | ET00 DAC ** |
673 | JST SAV |
674 | LDA L |
675 | SUB K103 =3 |
676 | STA L L=L-3 |
677 | STA ACCP SET ACCUM PTR TO LAST TRIAD ENTRY |
678 | STA 0 J=L |
679 | LDA P |
680 | STA DP+2,1 P(J) = P |
681 | LDA O1 |
682 | STA DP+1,1 O1(J) = O1 |
683 | LDA O2 |
684 | STA DP,1 O2(J) = O2 |
685 | LDA 0 |
686 | STA O1 O1=J |
687 | JST RST |
688 | JMP* ET00 |
689 | ACCP DAC ** ACCUM POINTER |
690 | * |
691 | * |
692 | SFTB BSS 36 SUBFUNCTION TABLE |
693 | * ************************** |
694 | * *GENERATE SUBPRO ENTRANCE* |
695 | * ************************** |
696 | * OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE |
697 | * CALL TO ARGUMENT ADDRESS TRANSFER. |
698 | T0GE PZE 0 |
699 | GE00 DAC ** |
700 | CRA |
701 | STA T0GE |
702 | LDA K17 ( TEST |
703 | JST TS00 |
704 | GE10 JST NA00 INPUT NAME |
705 | LDA I IFF I=0, |
706 | SNZ |
707 | JMP GE20 GO TO GE20 |
708 | CAS K141 |
709 | NOP |
710 | JMP GE30 MAKE ENTRY IN SFTB TABLE |
711 | ADD K103 |
712 | STA I IF FULL, GO TO GE30 |
713 | JST STXA SET XR TO A |
714 | LDA DP,1 |
715 | IAB |
716 | JST STXI ESTABLISH I |
717 | IAB |
718 | STA SFTB,1 |
719 | JST STXA SET XR TO A |
720 | LDA DP+1,1 |
721 | IAB |
722 | JST STXI SET XR TO I |
723 | IAB |
724 | STA SFTB+1,1 |
725 | LDA A |
726 | STA SFTB+2,1 |
727 | JST STXA SET XR TO A |
728 | CRA |
729 | STA DP+1,1 CLEAR OLD USACE |
730 | GE20 LDA K105 |
731 | IAB |
732 | LDA RPL |
733 | ADD T0GE |
734 | ADD K103 (B) = DUM |
735 | JST AF00 DEFINE AFT (A=RPL+T0+3) |
736 | IRS T0GE T0 = T0+1 |
737 | LDA K134 |
738 | SUB TC IF TC = , |
739 | SNZ |
740 | JMP GE10 GO TO GE10 |
741 | JST IP00 INPUT OPERATOR |
742 | CRA |
743 | STA DF |
744 | JST OA00 OUTPUT ABS (0) |
745 | LDA T0GE |
746 | STA ID ID = T0 |
747 | LDA K69 |
748 | STA NAMF+1 NAMF = AT |
749 | JST NF00 FILL IN REMAINING NAME |
750 | JST OL00 OUTPUT OBJECT LINK |
751 | LDA T0GE |
752 | TCA |
753 | STA T0GE |
754 | CRA |
755 | JST OA00 OUTPUT NUMBER OF ARGS |
756 | IRS T0GE OUTPUT SPACE FOR ARG. ADDR. |
757 | JMP *-3 |
758 | JMP* GE00 RETURN |
759 | GE30 JST ER00 CONSTR, ERROR |
760 | BCI 1,AE |
761 | K69 BCI 1,AT AT |
762 | * |
763 | * **************** |
764 | * *EXCHANGE LINKS* |
765 | * **************** |
766 | * CL SUBA IS INTERCHANGED WITH CL SUBF |
767 | EL00 DAC ** |
768 | JST STXA |
769 | LDA DP,1 |
770 | STA EL90 CL (F) == CL (A) |
771 | LDA F |
772 | STA 0 |
773 | JST EL40 |
774 | JST STXA |
775 | JST EL40 |
776 | JMP* EL00 |
777 | EL40 DAC ** |
778 | LDA DP,1 |
779 | IMA EL90 |
780 | ANA K118 |
781 | IMA DP,1 |
782 | ANA K119 |
783 | ADD DP,1 |
784 | STA DP,1 |
785 | JMP* EL40 |
786 | EL90 PZE 0 |
787 | * |
788 | * |
789 | * ***************** |
790 | * *NON COMMON TEST* |
791 | * ***************** |
792 | NM00 DAC ** NON-COMMON TEST |
793 | LDA AT |
794 | SUB K104 |
795 | SZE |
796 | JMP* NM00 |
797 | JST ER00 |
798 | BCI 1,CR ILLEGAL COMMON REFERENCE |
799 | * |
800 | * |
801 | * ************************** |
802 | * *NON DUMMY OR SUBPRO TEST* |
803 | * ************************** |
804 | ND00 DAC ** |
805 | LDA AT TEST |
806 | SUB K105 |
807 | SZE |
808 | JMP ND10 |
809 | JST ER00 |
810 | BCI 1,DA ILLEGAL USE OF A DUMMY ARGUMENT |
811 | JMP* ND00 |
812 | ND10 JST NS00 |
813 | JMP* ND00 |
814 | * |
815 | * |
816 | * ***************** |
817 | * *INPUT SUBSCRIPT* |
818 | * ***************** |
819 | SCT0 PZE 0 |
820 | SC00 DAC ** |
821 | STA SCT0 T0 = (A) |
822 | CRA |
823 | STA NS |
824 | STA S2 NS = S2 = S3 = 0 |
825 | STA S3 |
826 | LDA K17 (-TEST |
827 | JST TS00 |
828 | SC10 LDA EBAR |
829 | SMI |
830 | JMP SC15 EBAR .GR. 0 |
831 | JST XN00 EXAMINE NEXT CHAR, |
832 | SZE |
833 | JMP SC70 IF (A) NON ZERO, |
834 | SC15 JST IG00 GO TO SC70 |
835 | LDA SCT0 INPUT INTEGER |
836 | SZE |
837 | SPL |
838 | JMP SC60 |
839 | LDA ID |
840 | SUB K101 |
841 | JMP SC30 |
842 | SC60 JST AS00 ASSIGN ITEM |
843 | SC20 LDA A S (NS+1) = A |
844 | SC30 IAB |
845 | LDA SC90 |
846 | ADD NS |
847 | STA SC91 |
848 | IAB S(NS + 1) = A |
849 | STA* SC91 |
850 | LDA NS |
851 | AOA |
852 | STA NS NS = NS + 1 |
853 | SUB K103 |
854 | SZE |
855 | JMP SC50 MORE SUBSCRIPTS PERMITTED |
856 | SC40 JST IP00 )-INPUT OPERATOR |
857 | JMP* SC00 RETURN |
858 | SC50 LDA TC |
859 | SUB K134 |
860 | SZE |
861 | JMP SC40 TERMINATOR NOT A COMMA |
862 | JMP SC10 G0 TO SC10 |
863 | SC70 JST IR00 INPUT INT VARIABLE |
864 | LDA SCT0 CHECK FOR NON-DUMMY |
865 | SNZ VARIABLE DIMENSIONS |
866 | JMP SC20 |
867 | LDA AT |
868 | SUB K105 |
869 | SNZ |
870 | JMP SC20 |
871 | JST ER00 |
872 | BCI 1,VD ILLEGAL SYMBOLIC SUBSCRIPT |
873 | SC90 DAC S1 |
874 | SC91 DAC ** |
875 | * |
876 | * |
877 | * ******************** |
878 | * *INPUT LIST ELEMENT* |
879 | * ******************** |
880 | * IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT |
881 | IL00 DAC ** |
882 | JST NA00 INPUT NAME |
883 | LDA AT |
884 | SUB K105 NON-DUMMY TEST |
885 | SZE |
886 | JMP *+3 |
887 | JST ER00 USAGE ERROR |
888 | BCI 1,DD DUMMY ITEM IN AN EQUIV, OR DATA LIST |
889 | LDA IU IF IU NOT ARR, |
890 | SUB K103 |
891 | SZE |
892 | JMP IL30 GO TO IL30 |
893 | LDA K103 |
894 | JST SC00 INPUT SUBSCRIPTS |
895 | JST FA00 FETCH ASSIGNS |
896 | LDA ND IF ND = NS |
897 | SUB NS |
898 | SZE S1 = D* (S1 + D1* (S2+D2*S3) |
899 | JMP IL10 ELSE, GO TO IL10 |
900 | LDA S3 |
901 | IAB |
902 | LDA D2 |
903 | JST IM00 |
904 | ADD S2 |
905 | IAB |
906 | LDA D1 |
907 | JST IM00 |
908 | ADD S1 |
909 | IAB |
910 | LDA D0 |
911 | JST IM00 |
912 | STA S1 |
913 | JMP* IL00 RETURN |
914 | IL10 LDA NS IF NS NOT 1 |
915 | SUB K101 |
916 | SZE |
917 | JMP IL20 GO TO IL20 |
918 | LDA S1 ELSE, 20 |
919 | IAB S1 * D0*S1 |
920 | LDA D0 |
921 | JST IM00 |
922 | IL18 STA S1 |
923 | JMP* IL00 RETURN |
924 | IL20 JST ER00 |
925 | BCI 1,ND WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT |
926 | JMP* IL00 RETURN |
927 | IL30 JST TV00 TAG VARIABLE |
928 | CRA S1 = 0 |
929 | JMP IL18 RETURN |
930 | * |
931 | * |
932 | * ************ |
933 | * *FUNCTION * |
934 | * *SUBROUTINE* |
935 | * ************ |
936 | * IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER |
937 | * FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS |
938 | R1 LDA K101 |
939 | STA SFF SFF = 1 |
940 | R2 LDA LSTF |
941 | SZE IF LSTF = 0 |
942 | JMP R2A |
943 | JST ER00 ILLEGAL STATEMENT |
944 | BCI 1,FS NOT FIRST STATEMENT IN SUBPROGRAM |
945 | R2A JST NA00 INPUT NAME |
946 | LDA A |
947 | STA SBF SBF = A |
948 | CRA ADDR=0, S/C CODE =0 |
949 | JST ON00 OUTPUT NAME BLOCK TO THE LOADER |
950 | LDA MFL |
951 | SZE |
952 | JST DM00 DEFINE IM |
953 | LDA TC |
954 | SUB CRET IF IC NOT C/R |
955 | SZE |
956 | JMP R2C GO TO |
957 | LDA SFF IF SFF = 0 |
958 | SNZ |
959 | JMP R2D GO TO R2D |
960 | JST ER00 ERROR |
961 | BCI 1,FA FUNCTION HAS NO ARGUMENTS |
962 | R2C CRA |
963 | STA I I = 0 |
964 | JST GE00 GENERATE SUBPROGRAM ENTRY |
965 | JMP A1 GO TO C/R TEST |
966 | R2D CRA |
967 | JST OA00 OUTPUT ABS |
968 | JMP C6 GO TO CONTINUE |
969 | * |
970 | * |
971 | * ****************** |
972 | * *INTEGER * |
973 | * *REAL * |
974 | * *DOUBLE PRECISION* |
975 | * *COMPLEX * |
976 | * *LOGICAL * |
977 | * ****************** |
978 | * THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE |
979 | * VALUE AND ANY ARRAY INFO IS PROCESSED |
980 | A3 LDA K101 INTEGER |
981 | JMP A7A TMFL = INT |
982 | A4 LDA K102 REAL |
983 | JMP A7A TMFL = REAL |
984 | A5 LDA K106 DOUBLE PRECISION |
985 | JMP A7A TMFL = DBL |
986 | A6 LDA K105 COMPLEX |
987 | JMP A7A TMFL = CPX |
988 | A7 LDA K103 LOGICAL |
989 | A7A STA MFL TMFL = LOG |
990 | LDA LSTF IF LSTF = 0, GO TO A7B (2) |
991 | SNZ |
992 | JMP A7B ELSE, |
993 | LDA CC SAVE CC |
994 | STA A790 |
995 | CRA |
996 | STA ICSW |
997 | JST DN00 INPUT DNA |
998 | LDA A790 RESTORE CC |
999 | STA CC |
1000 | STA ICSW ICSW = IPL |
1001 | LDA DFL IF DFL NOT = 0, GO TO A7B |
1002 | SZE |
1003 | JMP A7B |
1004 | LDA TID IF ID = FUNCTI, |
1005 | SUB A7K GO TO A9 |
1006 | SNZ SKIP IF NOT 'FUNCTION' |
1007 | JMP A9 FUNCTION PROCESSOR |
1008 | A7A5 JST ER00 CONSTRUCTION ERROR |
1009 | BCI 1,TF 'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST |
1010 | A7K BCI 1,FU CONSTANT FOR 'FUNCTION' CHECK |
1011 | A7B JST NA00 INPUT NAME |
1012 | LDA MFL |
1013 | JST DM00 DEFINE IM |
1014 | JMP B7 GO TO INPUT DIMENSION |
1015 | A790 PZE 0 |
1016 | * |
1017 | * |
1018 | * - B2 EXTERNAL |
1019 | * TAGS NAME AS SUBPROGRAM |
1020 | B2 JST NA00 EXTERNAL, INPUT NAME |
1021 | JST TG00 TAG SUBPROGRAM |
1022 | JMP B1 GO TO , OR C/R TEST |
1023 | * |
1024 | * |
1025 | * ***************** |
1026 | * *DIMENSION * |
1027 | * *INPUT DIMENSION* |
1028 | * ***************** |
1029 | * PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL |
1030 | * ARRAY POINTER ITEM |
1031 | B3T0 PZE 0 |
1032 | B3T1 PZE 0 |
1033 | B3T2 PZE 0 |
1034 | B3T3 PZE 0 |
1035 | B3 JST NA00 |
1036 | B3A LDA AT IF AT = DUM |
1037 | SUB K105 (A) = 0 |
1038 | SZE ELSE (A) = .LT. 0 |
1039 | SSM |
1040 | B3B STA B3T0 T0 = (A) |
1041 | LDA AF |
1042 | STA B3T3 T3 = AF |
1043 | LDA A |
1044 | STA B3T1 T1 = A |
1045 | LDA AT TEST FOR AT=DUMMY |
1046 | SUB K105 =5 |
1047 | SZE SKIP NO-USAGE TEST IF DUMMY |
1048 | JST NU00 NO USAGE TEST |
1049 | JST STXA |
1050 | LDA DP+1,1 IU (A) = ARR |
1051 | LRL 14 |
1052 | LDA K103 |
1053 | LLL 14 |
1054 | STA DP+1,1 |
1055 | LDA B3T0 (A) = T0 |
1056 | JST SC00 INPUT SUBSCRIPT |
1057 | LDA S1 |
1058 | STA ID |
1059 | LDA S2 PLACE SUBSCRIPTS IN ID |
1060 | STA ID+1 |
1061 | LDA S3 |
1062 | STA ID+2 |
1063 | LDA NS (A) = 0, B = NS |
1064 | LRL 16 |
1065 | JST AA00 ASSIGN SPECIAL. |
1066 | JST STXA |
1067 | LDA DP+1,1 |
1068 | LLR 2 |
1069 | LDA B3T3 |
1070 | LGL 2 |
1071 | LRR 2 |
1072 | STA DP+1,1 DEFINE GF T0 GF(A) |
1073 | LDA A |
1074 | STA B3T2 T2 = A |
1075 | LDA B3T1 |
1076 | STA A A = T1 |
1077 | JST STXA |
1078 | LDA DP+1,1 |
1079 | LLR 2 |
1080 | LDA B3T2 |
1081 | LGL 2 |
1082 | LRR 2 |
1083 | STA DP+1,1 DEFINE GF TO GF(A) |
1084 | B3D LDA TC |
1085 | SUB K104 IF TC NOT SLASH |
1086 | SZE |
1087 | JMP B1 GO TO ,-C/R TEST |
1088 | LDA A9T2 IF SIDSW = COMMON-4 |
1089 | SUB B4Z9 |
1090 | SZE GO T0 B4 (COMMON-0) |
1091 | JMP B1 ELSE, GO TO ,-C/R TEST |
1092 | JMP B40 |
1093 | B7 LDA TC IF TC = ( |
1094 | SUB K17 |
1095 | SZE |
1096 | JMP B3D |
1097 | JMP B3A |
1098 | * |
1099 | * |
1100 | * ******** |
1101 | * *COMMON* |
1102 | * ******** |
1103 | * INPUT BLOCK NAMES AND LINK THEM WITH THE |
1104 | * FOLLOWING VAR/ARRAY NAMES, BLOCK NAMES |
1105 | * ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS |
1106 | B4 LDA K81 |
1107 | STA ID |
1108 | STA ID+1 |
1109 | STA ID+2 |
1110 | LDA B4Z9 SET SWITCH IN INPUT DIMENSION |
1111 | STA A9T2 |
1112 | JST CH00 INPUT CHAR |
1113 | SUB K9 IF NOT SLASH |
1114 | SZE GO TO |
1115 | JMP B4E |
1116 | B40 JST DN00 INPUT DNA |
1117 | LDA K104 SLASH TEST |
1118 | JST TS00 |
1119 | B4B LRL 32 |
1120 | LDA K101 (A) = SUB, (B) = 0 |
1121 | JST AA00 ASSIGN SPECIAL |
1122 | LDA CFL |
1123 | SNZ |
1124 | LDA A |
1125 | STA CFL |
1126 | LDA A |
1127 | STA F |
1128 | JST FL00 FETCH LINK |
1129 | SZE |
1130 | JMP B4D |
1131 | LDA CFL |
1132 | STA 0 |
1133 | LDA DP+1,1 GF(CFL) |
1134 | IMA A |
1135 | STA 0 INDEX = A |
1136 | IMA A |
1137 | STA DP+1,1 GF(A) = GF(CFL) |
1138 | LDA CFL |
1139 | STA 0 INDEX = CFL |
1140 | LDA A |
1141 | ADD K122 ='040000 |
1142 | STA DP+1,1 GF(CFL) = A |
1143 | B4D JST NA00 INPUT NAME |
1144 | JST ND00 NON DUMMY/SUBPROG TEST |
1145 | JST NM00 NON-COMMON TEST |
1146 | JST EL00 EXCHANGE LINKS |
1147 | LDA DP,1 |
1148 | ANA B4F ='107777 |
1149 | ADD K122 AT(A) = COM (='040000) |
1150 | STA DP,1 |
1151 | JMP B7 |
1152 | B4E JST UC00 UNINPUT COLUMN |
1153 | JMP B4B |
1154 | B4Z9 DAC B4D GO TO INPUT DIMENSION |
1155 | B4F OCT 107777 EXTRACT MASK TO STRIP OFF AT FIELD |
1156 | * |
1157 | * |
1158 | * ************* |
1159 | * *EQUIVALENCE* |
1160 | * ************* |
1161 | * STORE EQUIV INFO IN THE DATA POOL FOR LATER |
1162 | * PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP) |
1163 | B5 LDA E0 L = NEXT WORD IN EQUIVALENCE TABLE |
1164 | STA I I=L |
1165 | SUB K101 (=1) |
1166 | STA E0 L=L-1 |
1167 | SUB ABAR |
1168 | SMI |
1169 | JMP *+3 |
1170 | JST ER00 DATA POOL FULL |
1171 | BCI 1,MO MEMORY OVERFLOW |
1172 | JST STXI ESTABLISH I |
1173 | CRA |
1174 | STA DP,1 DP (I) = 0 |
1175 | B5B JST CH00 |
1176 | LDA DP,1 INPUT CHAR |
1177 | SZE |
1178 | JMP B5D |
1179 | LDA TC PUT IN FIRST CHARACTER |
1180 | LGL 8 PACK INTO DP (I) |
1181 | B5C STA DP,1 |
1182 | LDA TC |
1183 | SUB CRET |
1184 | SNZ |
1185 | JMP C6 CHARACTER E C/R - EXIT |
1186 | LDA DP,1 |
1187 | ANA K100 |
1188 | SNZ |
1189 | JMP B5B WORD NOT FULL |
1190 | JMP B5 OBTAIN NEW WORD |
1191 | B5D LDA TC PUT IN SECOND CHARACTER |
1192 | ERA DP,1 |
1193 | JMP B5C |
1194 | * |
1195 | * |
1196 | * ********************* |
1197 | * *RELATE COMMON ITEMS* |
1198 | * ********************* |
1199 | * ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED |
1200 | * AND THEIR INVERSE OFFSETS CALCULATED. THESE |
1201 | * WILL BE INVERTED LATER TO GIVE TRUE |
1202 | * POSITION IN THE BLOCK. |
1203 | C2T0 PZE 0 |
1204 | C2 LDA CFL |
1205 | STA A A = F = CFL |
1206 | C2A CRA |
1207 | STA C2T0 T0 = 0 |
1208 | LDA A |
1209 | STA F F = A |
1210 | C2B JST FL00 FETCH LINK |
1211 | SNZ |
1212 | JMP C2D |
1213 | LDA D0 |
1214 | ADD C2T0 T0 = T0 + D0 |
1215 | STA C2T0 |
1216 | JST DA00 DEFINE ADDRESS FIELD |
1217 | JMP C2B |
1218 | C2D JST FL00 FETCH LINK |
1219 | SZE |
1220 | JMP C2F |
1221 | LDA AF |
1222 | STA A A = AF |
1223 | SUB CFL |
1224 | SZE |
1225 | JMP C2A AF = CFL. NO |
1226 | JMP C3 YES - GROUP EQUIVALENCE |
1227 | C2F LDA C2T0 |
1228 | SUB AF (A) = T0 - AF |
1229 | JST DA00 DEFINE AF |
1230 | LDA IU |
1231 | SZE |
1232 | JMP C2D |
1233 | JST TV00 TAG VARIABLE |
1234 | JMP C2D |
1235 | * |
1236 | * |
1237 | * ******************* |
1238 | * *GROUP EQUIVALENCE* |
1239 | * ******************* |
1240 | * THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON |
1241 | * USAGE IS CHECKED TO SEE THAT THE ORIGIN |
1242 | * IS NOT MOVED AND THAT ONLY ONE ITEM IS |
1243 | * COMMON. |
1244 | C3T0 PZE 0 |
1245 | C3T1 PZE 0 |
1246 | C3T2 PZE 0 |
1247 | C3T3 PZE 0 |
1248 | C3T4 PZE 0 |
1249 | C3T5 PZE 0 |
1250 | T0C3 EQU C3T0 |
1251 | T1C3 EQU C3T1 |
1252 | T2C3 EQU C3T2 |
1253 | T3C3 EQU C3T3 |
1254 | T4C3 EQU C3T4 |
1255 | C3 LDA E0 |
1256 | STA EBAR EBAR=E(0) = END OF EQUIVALENCE TABLE |
1257 | LDA L0 |
1258 | STA E E=L(0) = START OF EUUIVALENCE TABLE |
1259 | LDA CRET |
1260 | STA TC |
1261 | C3B LDA E |
1262 | STA EP E-PRIME = E |
1263 | CRA |
1264 | STA F I = 0 |
1265 | LDA K102 T4 = STR-ABS |
1266 | STA C3T4 |
1267 | JST CH00 INPUT CHARACTER |
1268 | LDA K17 |
1269 | JST TS00 (TEST |
1270 | C3D JST IL00 INPUT LIST ELEMENT |
1271 | JST SAF |
1272 | LDA S1 |
1273 | SUB AF TL = S1-AF |
1274 | STA C3T1 |
1275 | LDA A T2 = A |
1276 | STA C3T2 |
1277 | C3F LDA F IF I=0, GO TO C3P |
1278 | SNZ |
1279 | JMP C3P |
1280 | C3G LDA F ELSE, |
1281 | SUB A |
1282 | SNZ IF A = I, GO TO C3N |
1283 | JMP C3N |
1284 | C3H LDA AT |
1285 | SUB K104 ELSE, |
1286 | SNZ IF AT = COM, GO TO C3O |
1287 | JMP C3O |
1288 | C3H2 LDA T1C3 |
1289 | ADD AF |
1290 | STA T0C3 T(0) = AF +T (1) |
1291 | LDA T4C3 |
1292 | SUB K104 IF T(4) = 0, GO T0 C3K |
1293 | SZE |
1294 | JMP C3K |
1295 | LDA T3C3 |
1296 | SUB T0C3 ELSE, |
1297 | STA T0C3 T(0) = T(3)-T(0) |
1298 | SMI |
1299 | JMP C3K |
1300 | JST ER00 IF T(0)<0, |
1301 | BCI 1,IC |
1302 | C3K LDA C3T4 IMPOSSIBLE COMMON EQUIVALENCING |
1303 | IAB |
1304 | LDA T0C3 AT (A) = COM |
1305 | ALS 2 |
1306 | LGR 2 |
1307 | JST AF00 |
1308 | JST FL00 DEFINE AF |
1309 | JST SAF FETCH LINK |
1310 | LDA A |
1311 | SUB C3T2 |
1312 | SZE IF A .NE. T (2), |
1313 | JMP C3G GO TO C3G (5) |
1314 | * |
1315 | JST EL00 EXCHANGE CL(A) == CL(I) |
1316 | C3M LDA TC EXCHANGE LINKS (CL(A) WITH CL(F) ) |
1317 | SUB K134 IF TC = , |
1318 | SNZ |
1319 | JMP C3D ELSE, |
1320 | JST IP00 )-INPUT OPERATOR |
1321 | LDA TC |
1322 | SUB K134 IF TC = , OR C/R |
1323 | SNZ GO TO C3B (1) |
1324 | JMP C3B |
1325 | LDA TC |
1326 | SUB CRET |
1327 | SNZ |
1328 | JMP C3B ELSE, |
1329 | JST ER00 |
1330 | BCI 1,EC EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR |
1331 | JMP C3B |
1332 | C3N LDA T1C3 IF T1 = 0, GO TO C3M |
1333 | SNZ |
1334 | JMP C3M |
1335 | C3N5 JST ER00 ERROR IMPOSSIBLE GROUP |
1336 | BCI 1,IE IMPOSSIBLE EQUIVALENCE GROUPING |
1337 | C3O LDA S1 |
1338 | ADD AF |
1339 | STA T3C3 |
1340 | LDA K104 =4 |
1341 | CAS T4C3 |
1342 | JMP *+2 |
1343 | JMP C3N5 |
1344 | STA T4C3 |
1345 | LDA F |
1346 | CAS A IF A = F, GO TO C3M (B) |
1347 | JMP *+2 |
1348 | JMP C3M ELSE, |
1349 | STA A A = I |
1350 | IMA C3T2 |
1351 | STA F |
1352 | CRA T1 = 0 |
1353 | STA C3T1 |
1354 | JST FA00 FETCH ASSIGNS |
1355 | JST SAF |
1356 | JMP C3H2 GO TO C3H2 |
1357 | C3P LDA A |
1358 | STA F |
1359 | JMP C3H |
1360 | * |
1361 | * |
1362 | * *********************** |
1363 | * *ASSIGN SPECIFICATIONS* |
1364 | * *********************** |
1365 | * NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER |
1366 | * COMMON BLOCKS ARE OUTPUT (WITH SIZE). |
1367 | C4T0 PZE 0 |
1368 | C4T1 PZE 0 |
1369 | C4B STA A A = 0 |
1370 | C4C LDA A |
1371 | ADD K105 I = A = A+5 |
1372 | STA A |
1373 | STA F |
1374 | CAS ABAR |
1375 | JMP NP35 RETURN TO FIRST NON-SPEC CHECK (POINT 1) |
1376 | NOP |
1377 | JST FA00 ELSE, FETCH ASSIGN |
1378 | LDA AT |
1379 | SUB K102 IF AT = STR-ABS |
1380 | SZE IU=VAR, OR ARR, AND |
1381 | JMP C4C NT = 0 |
1382 | LDA IU GO TO C4E |
1383 | SUB K102 ELSE, GO TO C4C |
1384 | SPL |
1385 | JMP C4C |
1386 | LDA NT |
1387 | SZE |
1388 | JMP C4C |
1389 | C4E CRA |
1390 | STA C4T0 T0 = 0. T1 =-MAX |
1391 | SUB K111 |
1392 | STA C4T1 |
1393 | JST KT00 SET D(0) = NO. OF WORDS PER ITEM |
1394 | C4F JST SAF |
1395 | CAS C4T0 |
1396 | STA C4T0 |
1397 | NOP |
1398 | LDA D0 |
1399 | SUB AF (A) = D(0) - AF |
1400 | CAS C4T1 |
1401 | STA C4T1 |
1402 | NOP |
1403 | JST FL00 FETCH LINK ( (A)=A - F ) |
1404 | SZE |
1405 | JMP C4F GO TO C4F |
1406 | LDA RPL |
1407 | ADD C4T0 RPL * RPL + T0 + TL |
1408 | STA C4T0 |
1409 | ADD C4T1 TO = RPL-T1 |
1410 | STA RPL |
1411 | C4I JST SAF |
1412 | LDA K101 |
1413 | IAB (B) = REL |
1414 | LDA C4T0 (A) = TO-AF |
1415 | SUB AF |
1416 | JST AF00 DEFIME AFT |
1417 | JST FL00 FETCH LINK |
1418 | SZE IF (A) NOT ZERO, |
1419 | JMP C4I NOT END OF EQUIVALENCE GROUP |
1420 | JMP C4C CHECK NEXT ITEM IN ASSIGNMENI TABLE |
1421 | * |
1422 | C4L2 LDA FLT1 = LINK LOCATION TO COMMON BLOCK NAME |
1423 | STA C4T1 |
1424 | C4L3 LDA A |
1425 | STA I SAVE A FOR LATER MODIFICATION |
1426 | JST FL00 FETCH LINK |
1427 | SNZ |
1428 | JMP C4M END OF COMMON GROUP |
1429 | JST STXI SET INDEX TO POINT TO CURRENT ITEM IN |
1430 | * COMMON GROUP. |
1431 | LDA DP,1 SET CL FIELD TO POINT AT COMMON BLOCK |
1432 | * NAME. |
1433 | ANA K119 ( = '177000) |
1434 | ADD C4T1 (= LINK LOCATION OF COMMON BLOCK NAME) |
1435 | STA DP,1 |
1436 | JMP C4L3 PROCESS NEXT ITEM IN COMMON BLOCK |
1437 | * |
1438 | C4 LDA CFL LOC, OF FIRST (BLANK) COMMON BLOCK |
1439 | STA F |
1440 | C4L6 STA A |
1441 | CRA |
1442 | STA C4T0 |
1443 | C4L JST FL00 FETCH LINK |
1444 | SNZ |
1445 | JMP C4L2 NO MORE ITEMS IN COMMON BLOCK |
1446 | LDA D0 ELSE, IF TO .LT. DO+AF, |
1447 | ADD AF |
1448 | CAS C4T0 T0 = D0 + AF |
1449 | STA C4T0 |
1450 | NOP |
1451 | JMP C4L GO TO C4L |
1452 | C4M LDA AF |
1453 | STA F I=AF |
1454 | LDA C4T0 (A) = T0 |
1455 | JST DA00 DEFINE AF |
1456 | * OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER |
1457 | LDA AF LENGTH OF COMMON BLOCK |
1458 | ANA K111 ='37777 |
1459 | ADD K122 ='40000 (S/C CODE = 1) |
1460 | JST ON00 OUTPUT NAME BLOCK TO LOADER |
1461 | LDA F |
1462 | SUB CFL IF I = CFL |
1463 | SNZ |
1464 | JMP C4B |
1465 | LDA F |
1466 | JMP C4L6 |
1467 | * |
1468 | SAF DAC ** |
1469 | LDA AF |
1470 | LGL 2 |
1471 | ARS 2 |
1472 | STA AF |
1473 | JMP* SAF |
1474 | * |
1475 | * ************************** |
1476 | * *DATA STATEMENT PROCESSOR* |
1477 | * ************************** |
1478 | * PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS |
1479 | * TO APPROPRIATE LOCATIONS. MODES MUST AGREE |
1480 | T0W4 PZE 0 |
1481 | T1W4 PZE 0 |
1482 | G PZE 0 LOWEST INDEX POINT IN LIST |
1483 | W4 LDA L0 |
1484 | STA I I=END OF DATA POOL |
1485 | W4B JST IL00 INPUT LIST ELEMENT |
1486 | LDA AT D (0) = =WDS/ITEM |
1487 | SUB K102 |
1488 | SNZ IF AT = 'STR-ABS' |
1489 | JMP W4T GO TO |
1490 | LDA I |
1491 | STA 0 |
1492 | LDA S1 S1 * DEFLECTION IF AN ARRAY |
1493 | ADD AF |
1494 | STA DP,1 DP(E) = AF + S1 |
1495 | W4C LDA A |
1496 | STA DP-1,1 DP (E-1) = A |
1497 | LDA I |
1498 | SUB K102 |
1499 | STA I |
1500 | STA G |
1501 | LDA TC IF TC = , |
1502 | SUB K134 |
1503 | SNZ |
1504 | JMP W4B GO TO W4B |
1505 | LDA K104 |
1506 | JST TS00 TEST FOR SLASH TERMINATOR |
1507 | LDA RPL |
1508 | STA T1W4 |
1509 | LDA L0 |
1510 | STA I I= END OF DATA POOL |
1511 | W4E CRA |
1512 | STA KPRM K' = KBAR = 0 |
1513 | STA KBAR |
1514 | W4F JST DN00 INPUT, DNA |
1515 | LDA NT |
1516 | SZE IF NT = 0 |
1517 | JMP W4G VARIABLE OR ARRAY |
1518 | LDA TC LAST CHARACTER |
1519 | CAS K17 ='250 ( =( ) |
1520 | JMP *+2 |
1521 | JMP *+3 START OF COMPLEX CONSTANT |
1522 | JST ER00 ERROR |
1523 | BCI 1,CN NON-CON DATA |
1524 | STA SXF SET SXF TO NON-ZERO |
1525 | JMP W4F FINISH INPUT OF COMPLEX CONSTANT |
1526 | W4G LDA KBAR MULTIPLY COUNT |
1527 | SZE |
1528 | JMP W4K GO TO W4K |
1529 | LDA TC IF TC NOT * |
1530 | SUB K103 |
1531 | SZE |
1532 | JMP W4L |
1533 | LDA ID |
1534 | SUB K101 |
1535 | STA KBAR KBAR = ID-1 |
1536 | JST IT00 INTEGER TEST |
1537 | JMP W4F |
1538 | W4K LDA KPRM IF K NOT ZERO |
1539 | SZE |
1540 | JMP W4M GO TO W4M |
1541 | W4L LDA KBAR |
1542 | ALS 1 K ' = E-3* KBAR |
1543 | TCA |
1544 | ADD I |
1545 | STA KPRM |
1546 | W4M JST STXI SET INDEX = I |
1547 | LDA DP-1,1 |
1548 | STA A A = DP (E-1) |
1549 | LDA IM |
1550 | STA T0W4 TO = IM |
1551 | JST FA00 |
1552 | LDA BDF IF BDF NOT ZERO |
1553 | SZE |
1554 | JMP W4S GO TO W4S |
1555 | JST NM00 NON-COMMON TEST |
1556 | W4O JST STXI SET INDEX = I |
1557 | LDA DP,1 |
1558 | STA RPL RPL = AF |
1559 | JST FS00 FLUSH |
1560 | CRA |
1561 | STA DF DF = 0 |
1562 | LDA HOLF IS IT HOLLERITH DATA |
1563 | SZE NO |
1564 | JMP WHOW YES, GO TO OUTPUT IT |
1565 | LDA D0 |
1566 | STA 0 |
1567 | JMP *,1 SWITCH ON NUMBER OF WORDS TO OUTPUT |
1568 | JMP W405 |
1569 | JMP W403 |
1570 | JMP W404 |
1571 | LDA TID+2 |
1572 | JST OA00 |
1573 | LDA TID+1 |
1574 | JST OA00 |
1575 | LDA TIDB+2 |
1576 | JST OA00 |
1577 | LDA TIDB+1 |
1578 | JMP W406 |
1579 | * |
1580 | * TAPE 4 OF 5 - END |
1581 | MOR |