faae1561 |
1 | * TAPE 2 OF 5 - BEGIN |
2 | * |
3 | DN63 CRA IM = 0 |
4 | STA IM |
5 | JMP DN67 GO TO DN67 (18) |
6 | DN64 LDA K101 |
7 | STA TID |
8 | DN66 LDA K101 |
9 | STA NT NAME TAG = 1 (CONSTANT) |
10 | LDA K102 IU=VAR |
11 | STA IU |
12 | LDA K103 |
13 | STA IM IM = LOG |
14 | JST CH00 |
15 | DN67 JST FN00 FINISH OPERATOR |
16 | DN68 LDA F6 IF F6 = 0, |
17 | SNZ GO TO DN70 (21) |
18 | JMP DN70 |
19 | DN69 LDA K10 |
20 | STA TC TC = . |
21 | DN70 CRA |
22 | STA F6 F6 = SXF = 0 |
23 | STA SXF |
24 | LDA IM (A) = IM |
25 | JMP* DN00 RETURN |
26 | DN72 LDA F1 IF F1 = 0, GO TO DN74 |
27 | SNZ |
28 | JMP DN74 |
29 | LDA F1 ELSE, TC = F1 |
30 | STA TC |
31 | JMP DN58 GO TO DN58 (14) |
32 | DN74 LDA TC IF TC = -, GO TO DN82 |
33 | SUB K12 |
34 | SNZ |
35 | JMP DN82 |
36 | ADD K102 CHECK FOR TC = + |
37 | SNZ |
38 | JMP DN82 |
39 | LDA DFL IF DFL = NON-ZERO |
40 | SZE |
41 | JMP DN63 GO TO DN63 (15) |
42 | LDA TC |
43 | CAS K43 |
44 | JMP *+3 |
45 | JMP DN78 |
46 | JMP DN80 |
47 | CAS K62 |
48 | JMP DN80 |
49 | NOP |
50 | DN78 LDA K101 IM < INT |
51 | STA IM |
52 | DN80 LDA TC PACK TC TO ID |
53 | JST PACK |
54 | JST CH00 INPUT CHAR |
55 | LDA DFL IF DFL IS NOT ZERO, |
56 | SZE GO TO DN67 (18) |
57 | JMP DN67 |
58 | LDA NTID IF NTID = 6, GO TO DN67 |
59 | SUB K106 |
60 | SZE |
61 | JMP DN80 |
62 | JMP DN67 |
63 | DN82 JST FN00 |
64 | STA F1 F1 = CONVERTED TC |
65 | JMP DN06 GO TO DN06 (2) |
66 | DN84 LDA F1 IF F1 = -, |
67 | SUB K102 GO TO DN85(13) |
68 | SZE |
69 | JMP DN85 |
70 | CRA |
71 | SUB TID COMPLEMENT THREE WORDS AT TID |
72 | SZE |
73 | JMP DN8A |
74 | SUB TID+1 |
75 | SZE |
76 | JMP DN8B |
77 | JMP DN8C |
78 | DN8A STA TID |
79 | LDA K123 |
80 | SUB TID+1 |
81 | DN8B STA TID+1 |
82 | LDA K123 |
83 | DN8C SUB TID+2 |
84 | STA TID+2 |
85 | DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18) |
86 | SNZ |
87 | JMP DN67 ELSE, |
88 | LDA IM IF IM NOT = REA, |
89 | SUB K102 |
90 | SZE GO TO DN67 (18) |
91 | JMP DN67 |
92 | LDA F6 ELSE, |
93 | SNZ IF F6 = 0, GO TO DN87 |
94 | JMP DN87 |
95 | LDA K105 |
96 | STA IM IM = CPX |
97 | LDA TID INTERCHANGE |
98 | IMA TIDB 3 CELLS |
99 | STA TID TID |
100 | LDA TID+1 WITH |
101 | IMA TIDB+1 3 CELLS |
102 | STA TID+1 OF |
103 | LDA TID+2 TIDB |
104 | IMA TIDB+2 |
105 | STA TID+2 |
106 | JST IP00 )-INPUT OPERATOR |
107 | JMP DN70 GO TO DN70 (21) |
108 | DN87 LDA TC IF TC = , |
109 | SUB K5 |
110 | SZE |
111 | JMP DN67 TID-BAR = TID |
112 | LDA TID F6 = 1 |
113 | STA TIDB GO TO DN01 (1) |
114 | LDA TID+1 |
115 | STA TIDB+1 ELSE, GO TO DN67 (18) |
116 | LDA TID+2 |
117 | STA TIDB+2 |
118 | LDA K101 |
119 | STA F6 |
120 | JMP DN01 |
121 | DN90 LDA F2 IF F2= 0, GO TO DN9A (10) |
122 | SNZ |
123 | JMP DN9A |
124 | LDA F3 F3 = - F3 |
125 | TCA |
126 | STA F3 |
127 | DN9A LDA F3 F4 = F3 - F4 |
128 | SUB F4 |
129 | STA F4 |
130 | LDA K12 F2 = EXP, BIAS + MANTISSA |
131 | STA F2 |
132 | LDA TID IF TID = 0, |
133 | ADD TID+1 |
134 | ADD TID+2 GO TO DN85(13) |
135 | SNZ |
136 | JMP DN85 |
137 | DN9C LDA TID+2 |
138 | LGL 1 NORMALIZE ID |
139 | SPL |
140 | JMP DN9D ID IS NORMALIZED |
141 | JST SFT |
142 | DAC ID |
143 | * F2 = F2 - = SHIFTS |
144 | LDA F2 |
145 | SUB K101 |
146 | STA F2 |
147 | JMP DN9C CONTINUE NORMALIZE LOOP |
148 | DN9D LDA F4 |
149 | CAS ZERO |
150 | JMP DN9E |
151 | JMP DN9G FINISHED E FACTOR LOOP |
152 | IRS F4 |
153 | NOP F4 = F4 +1 |
154 | LDA K155 DIVIDE LOOP COUNTER |
155 | STA TIDN |
156 | JST SRT |
157 | DAC TID |
158 | JST SRT |
159 | DAC TID |
160 | DND1 JST SFT |
161 | DAC TID |
162 | LDA TID+2 |
163 | SUB K156 10 AT B=4 |
164 | SMI |
165 | STA TID+2 |
166 | SMI |
167 | IRS TID |
168 | IRS TIDN |
169 | JMP DND1 REDUCE DIVIDE COUNTER |
170 | JST SFT |
171 | DAC TID |
172 | LDA TID+2 |
173 | ANA K157 |
174 | STA TID+2 |
175 | JMP DN9C |
176 | DN9E SUB K101 |
177 | STA F4 F4 = F4-1 |
178 | LDA F2 F2 = F2+4 |
179 | ADD K104 |
180 | STA F2 |
181 | JST SRT |
182 | DAC ID |
183 | JST MOV3 |
184 | JST SRT ID = ID*10 |
185 | DAC ID |
186 | JST SRT |
187 | DAC ID |
188 | JST AD3 ADD THREE WORD INTEGERS |
189 | JMP DN9C |
190 | * CONVERT THREE WORD INTEGER TO INTERNAL FORMAT |
191 | DN9G LDA TID+2 |
192 | IAB |
193 | LDA F2 |
194 | LRS 8 |
195 | SNZ |
196 | JMP *+3 |
197 | JST ER00 |
198 | BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW) |
199 | IAB |
200 | IMA TID+2 |
201 | IAB |
202 | LDA TID+1 |
203 | LGL 1 |
204 | LRR 8 |
205 | STA TID+1 |
206 | LRR 9 |
207 | LDA TID PACK UP TRIPLE PRECISION |
208 | LGL 1 |
209 | LRR 7 REAL CONSTANT |
210 | STA TID |
211 | LDA F2 |
212 | LGR 8 |
213 | SZE |
214 | JMP DN69 GO TO DN69 (20) |
215 | JMP DN84 ELSE. GO TO DN84 (12) |
216 | DN9H STA IM |
217 | LDA SPF |
218 | SUB K102 |
219 | SZE |
220 | LDA K106 |
221 | SUB K124 |
222 | ADD TID |
223 | SMI |
224 | JMP DN70 |
225 | LDA TID |
226 | STA HOLF HOLF=NO.OF HOLLERITH CHARS, |
227 | STA F3 |
228 | TCA |
229 | SNZ |
230 | JMP DN9K FIELD WIDTH OF ZERO |
231 | STA F2 F2= -1(1 CHAR) OR -2(2 CHAR) |
232 | JST BLNK SET ID,ID+1(ID+2 TO ZERO |
233 | DAC TID |
234 | DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS) |
235 | JST PACK PACK CHARACTERS 2 PER WORD |
236 | IRS F2 REDUCE CHARACTER COUNT |
237 | JMP DN9J INPUT AND PACK MORE CHARACTERS |
238 | LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT |
239 | ANA K101 |
240 | SNZ |
241 | JMP *+3 |
242 | LDA K8 ='240 (SP) |
243 | JST PACK SHIFT A SPACE INTO THE LAST WORD |
244 | IRS IM |
245 | DN9M JST CH00 INPUT THE TERMINATING CHARACTER |
246 | JMP DN67 FINISH OPERATOR AND EXIT |
247 | DN9K JST ER00 |
248 | BCI 1,HF |
249 | DN9N LDA K105 SET .NOT. OPERATOR (TC=5) |
250 | STA TC SET .NOT. OPERATOR (TC=5) |
251 | CRA |
252 | STA IM IM=0 = UNDEFINED |
253 | JMP DN68 |
254 | DNX1 BSS 3 |
255 | DNX2 DAC ** OVERFLOW FLAG |
256 | JMP* *-1 |
257 | * |
258 | * |
259 | * ************ |
260 | * *INPUT ITEM* |
261 | * ************ |
262 | * INPUTS AND ASSIGNS ITEM (IF ONE EXISTS) |
263 | * |
264 | II00 DAC ** |
265 | JST DN00 INPUT DNA |
266 | SNZ IF (A) = 0 |
267 | JMP* II00 RETURN |
268 | JST AS00 NO, ASSIGN ITEM |
269 | LDA IM |
270 | JMP* II00 RETURN (A) = IM |
271 | * |
272 | * |
273 | * *************** |
274 | * *INPUT OPERAND* |
275 | * *************** |
276 | * EXIT WITH ITEM MODE IN A (TC SET TO . IF NO |
277 | * OPERAND) |
278 | * |
279 | OP00 DAC ** INPUT OPERAND |
280 | JST II00 INPUT ITEM |
281 | SZE IF IM = 0, SKIP |
282 | JMP* OP00 ELSE (A) = IM, RETURN |
283 | LDA K10 TC = . |
284 | STA TC (A) = 0 |
285 | CRA |
286 | JMP* OP00 RETURN |
287 | * |
288 | * |
289 | * ************ |
290 | * *INPUT NAME* |
291 | * ************ |
292 | * INPUT OPERAND AND ENSURE THAT IT IS A NAME |
293 | * |
294 | NA00 DAC ** INPUT NAME |
295 | JST OP00 INPUT OPERAND |
296 | LDA NT IF NT = 1, |
297 | SNZ |
298 | JMP NA10 |
299 | JST ER00 |
300 | PZE 9 |
301 | NA10 LDA IM (A) = IM |
302 | JMP* NA00 RETURN |
303 | * |
304 | * |
305 | * *************** |
306 | * *INPUT INTEGER* |
307 | * *************** |
308 | * INPUT ITEM AND ENSURE THAT IT IS AN INTEGER CONSTANT |
309 | * GREATER THAN ZERO |
310 | * |
311 | IG00 DAC ** INPUT INTEGER |
312 | JST DN00 INPUT - DNA |
313 | LDA F1 |
314 | SZE IF F1 = 0, |
315 | JMP IG20 AND NT = 1, |
316 | LDA NT AND IM = INT, |
317 | SNZ AND TID L2**15, |
318 | JMP IG20 GO TO IG10 |
319 | LDA IM LSE, GO TO IG20 |
320 | SUB K101 |
321 | SZE |
322 | JMP IG20 |
323 | LDA TID+1 |
324 | SZE |
325 | JMP IG20 |
326 | LDA TID+2 |
327 | SZE |
328 | JMP IG20 |
329 | IG10 LDA TID |
330 | JMP* IG00 |
331 | IG20 JST ER00 ERROR |
332 | BCI 1,IN INTEGER REQUIRED |
333 | * |
334 | * |
335 | * *********************** |
336 | * *INPUT INTEGER VAR/CON* |
337 | * *********************** |
338 | * |
339 | IV00 DAC ** |
340 | JST OP00 INPUT OPERAND |
341 | JST IT00 INTER TEST |
342 | JST TV00 TAG VARIABLE |
343 | JMP* IV00 EXIT |
344 | * |
345 | * |
346 | * ************************ |
347 | * *INPUT INTEGER VARIABLE* |
348 | * ************************ |
349 | * |
350 | IR00 DAC ** INPUT INT VAR |
351 | JST IV00 INPUT INT VAR/CON |
352 | JST NC00 NON-CONSTANT TEST |
353 | JMP* IR00 RETURN |
354 | * |
355 | * |
356 | * ************************ |
357 | * *INPUT STATEMENT NUMBER* |
358 | * ************************ |
359 | * NUMBER IS FORMED AS SPECIAL NAME , NOT CONVERTED |
360 | * TO NUMERIC |
361 | * |
362 | IS00 DAC ** |
363 | IS04 CRA |
364 | STA NT |
365 | STA IM |
366 | STA IU IU = IM = IT = 0 |
367 | STA NTID PUT LEADING 'S' IN STATEMENT NO, |
368 | LDA K79 |
369 | JST PACK |
370 | IS10 JST ID00 INPUT DIGIT |
371 | SZE |
372 | JMP IS20 NOT A DIGIT GO TO IS20 |
373 | LDA NTID |
374 | SUB K106 |
375 | SMI |
376 | JMP IS22 |
377 | LDA TC |
378 | JST PACK PACK TC TO ID - LEGAL ST, NO, CHAR |
379 | LDA TID |
380 | CAS K79X |
381 | JMP IS10 |
382 | JMP IS04 IGNORE LEAD ZERO ON ST. NO, |
383 | JMP IS10 |
384 | IS20 LDA NTID |
385 | SUB K101 |
386 | SMI |
387 | JMP IS25 |
388 | IS22 JST ER00 |
389 | BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT |
390 | IS25 JST AS00 ASSIGN ITEM |
391 | JST STXA |
392 | LDA DP+1,1 |
393 | ANA K111 |
394 | STA DP+1,1 IU = 0 |
395 | LDA AF ADDRESS FIELD IS |
396 | CAS XST LE XST - ALREADY ASSIGNED |
397 | JMP* IS00 |
398 | JMP* IS00 OK - OTHERWISE |
399 | LDA AT MUST HAVE STR-ABS OTHERWISE |
400 | CAS K102 |
401 | JMP *+2 |
402 | JMP* IS00 !!! |
403 | JST ER00 |
404 | BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER |
405 | K79 OCT 337 |
406 | K79X OCT 157660 |
407 | * |
408 | SY00 DAC ** INPUT SYMBOL |
409 | LDA K101 |
410 | STA NTF NTF NOT 0 - DON'T SET IU IN AS00 |
411 | JST NA00 INPUT NAME |
412 | JMP* SY00 EXIT |
413 | * |
414 | * ************************ |
415 | * *EXAMINE NEXT CHARACTER* |
416 | * ************************ |
417 | * CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT) |
418 | * |
419 | XN00 DAC ** |
420 | JST ID00 INPUT DIGIT |
421 | JST UC00 UNINPUT COLUMM |
422 | JMP* XN00 |
423 | K1 BCI 3,TRUE. |
424 | K2 BCI 3,FALSE. |
425 | K3 OCT 247 |
426 | KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST |
427 | K11 OCT 304 0D |
428 | K14 OCT 310 0H |
429 | K62 OCT 316 0N |
430 | K64 OCT 336 0) |
431 | * |
432 | * |
433 | * ******************** |
434 | * *ALL CHARACTER TEST* |
435 | * ******************** |
436 | * |
437 | TS00 DAC ** TEST (A) AGAINST TC |
438 | SUB TC |
439 | SNZ |
440 | JMP* TS00 RETURN |
441 | JST ER00 TO ERROR TEST |
442 | BCI 1,CH IMPROPER TERMINATING CHARACTER |
443 | * |
444 | * |
445 | * ******************* |
446 | * *)- INPUT OPERATOR* |
447 | * ******************* |
448 | * |
449 | IP00 DAC ** |
450 | LDA K4 TEST - ) |
451 | JST TS00 |
452 | JST CH00 INPUT CHAR |
453 | JST FN00 FINISH OPERATOR |
454 | LDA B B = B-16 |
455 | SUB K109 |
456 | STA B |
457 | CRA (A) = 0 |
458 | JMP* IP00 RETURN |
459 | * |
460 | * |
461 | * |
462 | * B1 COMMA OR C/R TST |
463 | B1 LDA K134 IF TC = ','(CONVERTED TO 17) |
464 | SUB TC |
465 | SNZ |
466 | JMP* A9T2 GO TO SIDSW |
467 | JMP A1 ELSE, GO TO C/R TEST |
468 | * |
469 | * |
470 | NR00 DAC ** NON-REL TEST |
471 | LDA AT |
472 | SUB K101 IF AT = 1 GO TO ERROR- |
473 | SZE TEST |
474 | JMP* NR00 RETURN |
475 | JST ER00 ERROR TEST ROUTINE |
476 | BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER |
477 | * |
478 | * |
479 | * *************** |
480 | * *NO USAGE TEST* |
481 | * *************** |
482 | * |
483 | NU00 DAC ** N0 USAGE TEST |
484 | LDA IU |
485 | SNZ IF IU NOT = 0, TO ERROR |
486 | JMP* NU00 RETURN |
487 | JST ER00 ERROR TEST |
488 | BCI 1,NU NAME ALREADY BEING USED |
489 | * |
490 | * |
491 | * ******************* |
492 | * *NON-CONSTANT TEST* |
493 | * ******************* |
494 | * |
495 | NC00 DAC ** NON CONSTANT TEST |
496 | LDA NT |
497 | SNZ IF NT NOT = 0, TO ERROR TEST |
498 | JMP* NC00 RETURN |
499 | JST ER00 ERROR TEST |
500 | BCI 1,NC CONSTANT MUST BE PRESENT |
501 | * |
502 | * |
503 | * ********************* |
504 | * *NON SUBPROGRAM TEST* |
505 | * ********************* |
506 | * |
507 | NS00 DAC ** NON SUBPROGRAM TEST |
508 | LDA IU |
509 | SUB K101 IF IU = 1, GO TO- |
510 | SZE ERROR TEST |
511 | JMP* NS00 RETURN |
512 | JST ER00 ERROR TEST |
513 | BCI 1,NS SUBPROGRAM NAME NOT ALLOWED |
514 | * |
515 | * |
516 | * ********** |
517 | * *ARR TEST* |
518 | * ********** |
519 | * |
520 | AT00 DAC ** ARRAY TEST |
521 | LDA IU |
522 | SUB K103 IF IU = 3, GO TO |
523 | SNZ |
524 | JMP* AT00 RETURN |
525 | JST ER00 ERROR TEST |
526 | BCI 1,AR ITEM NOT AN ARRAY NAME |
527 | * |
528 | * |
529 | * ************** |
530 | * *INTEGER TEST* |
531 | * ************** |
532 | * |
533 | IT00 DAC ** INTEGER TEST |
534 | LDA IM |
535 | SUB K101 IF IM = 1, GO TO- |
536 | SNZ ERROR ROUTINE, ELSE |
537 | JMP* IT00 RETURN |
538 | JST ER00 TO ERROR TEST |
539 | BCI 1,IT ITEM NOT AN INTEGER |
540 | * |
541 | * |
542 | TA00 DAC ** |
543 | LDA AT STRING-ABS TEST |
544 | SUB K102 |
545 | SNZ |
546 | JMP* TA00 |
547 | JST ER00 |
548 | BCI 1,NR ITEM NOT A RELATIVE VARIABLE |
549 | * |
550 | * |
551 | * |
552 | * |
553 | * |
554 | * |
555 | * |
556 | * |
557 | AD3 DAC ** ADD TWO THREE WORD INTEGERS, |
558 | LDA TID |
559 | ADD DNX1 |
560 | CSA |
561 | STA TID |
562 | LDA TID+1 |
563 | ACA |
564 | ADD DNX1+1 |
565 | CSA |
566 | STA TID+1 |
567 | LDA TID+2 |
568 | ACA |
569 | ADD DNX1+2 |
570 | STA TID+2 |
571 | JMP* AD3 |
572 | * |
573 | * |
574 | * *********************** |
575 | * *ASSIGN INDEX REGISTER* |
576 | * *********************** |
577 | * |
578 | STXA DAC ** |
579 | LDA A |
580 | STA 0 |
581 | JMP* STXA |
582 | STXI DAC ** |
583 | LDA I |
584 | STA 0 |
585 | JMP* STXI |
586 | K153 OCT 16 |
587 | IM00 DAC ** |
588 | STA T1IM MULTIPLY A BY B |
589 | LDA K120 =-15 |
590 | STA T2IM |
591 | CRA |
592 | RCB C BIT = 0 |
593 | IM10 LRL 1 LOW BIT OF B INTO C |
594 | SRC SKIP IF B = 0 |
595 | ADD T1IM |
596 | IRS T2IM |
597 | JMP IM10 |
598 | LLL 14 |
599 | JMP* IM00 RETURN, RESULT IN A |
600 | T1IM PZE 0 |
601 | T2IM PZE 0 |
602 | * |
603 | * |
604 | NF00 DAC ** CONSTRUCT EXTERNAL NAME |
605 | LDA K80 ENTRY FOR FORTRAN GENERATER |
606 | STA NAMF |
607 | LDA K81 SUBROUTINE CALLS, |
608 | STA NAMF+2 |
609 | JMP* NF00 |
610 | K80 BCI 1,F$ |
611 | K81 BCI 1, |
612 | KM92 DEC 1 001 = INT |
613 | DEC 2 010 = REA |
614 | DEC 1 011 = LOG |
615 | DEC 0 - - |
616 | DEC 4 101 = CPX |
617 | DEC 3 110 = DSL |
618 | OCT 3 111 = HOL |
619 | * |
620 | * |
621 | BLNK DAC ** CLEAR A 3/36 |
622 | JST SAV AREA TO ZEROS |
623 | LDA* BLNK |
624 | STA XR |
625 | CRA CLEAR 3 WORDS OF MEMORY |
626 | STA 1,1 PARAMETER INPUT ADDRESS TO 0 |
627 | STA 2,1 |
628 | STA 0,1 |
629 | JST RST |
630 | IRS BLNK |
631 | JMP* BLNK EXIT |
632 | * |
633 | * |
634 | MOV3 DAC ** MOVE 3-WORDS |
635 | LDA TID TO TEMO STORE |
636 | STA DNX1 |
637 | LDA TID+1 |
638 | STA DNX1+1 |
639 | LDA TID+2 |
640 | STA DNX1+2 |
641 | JMP* MOV3 |
642 | * |
643 | * |
644 | * |
645 | * |
646 | CIB DAC ** COMPARE IBUF TO A CONSTANT |
647 | JST SAV SAVE INDEX |
648 | LDA* CIB +DDR OF CON+3,0 |
649 | STA CIBZ |
650 | CRA |
651 | SUB K103 XR=-3 |
652 | STA XR |
653 | CIBB LDA IBUF+3,1 |
654 | SUB* CIBZ |
655 | SZE |
656 | JMP CIBD |
657 | IRS XR |
658 | JMP CIBB |
659 | CIBC IRS CIB |
660 | JST RST RESTORE INDEX |
661 | JMP* CIB |
662 | CIBD IRS CIB |
663 | JMP CIBC |
664 | CIBZ DAC ** |
665 | * |
666 | * |
667 | * |
668 | * |
669 | SAV DAC ** SAVE INDEX REGISTER |
670 | STA SAVY STACKED IN PUSH DOWN LIST |
671 | LDA XR |
672 | STA* SAV9 |
673 | IRS SAV9 |
674 | LDA SAVY |
675 | JMP* SAV |
676 | RST DAC ** RESTORE INDEX REGISTER |
677 | STA SAVY |
678 | LDA SAV9 UNSTACK PUSH DOWN LIST |
679 | SUB K101 |
680 | STA SAV9 |
681 | LDA* SAV9 |
682 | STA XR |
683 | LDA SAVY |
684 | JMP* RST |
685 | SAVY PZE 0 |
686 | SAV9 DAC SAVX IS INITIATED BY A092 |
687 | SAVX BSS 20 |
688 | * |
689 | * |
690 | PACK DAC ** PLACE CHARACTER IN A |
691 | STA PAK7 |
692 | LDA NTID INTO ID - UPDATE 3 WORDS OF |
693 | PAK1 SNZ |
694 | JMP PAK4 ID |
695 | LRL 1 |
696 | ADD PAK9 |
697 | STA PAK8 |
698 | LDA PAK7 |
699 | IAB |
700 | SPL |
701 | JMP PAK3 |
702 | LLL 24 |
703 | ADD K8 |
704 | PAK2 STA* PAK8 |
705 | IRS NTID |
706 | JMP* PACK |
707 | PAK3 LLL 8 |
708 | LDA* PAK8 |
709 | LGR 8 |
710 | LLL 8 |
711 | JMP PAK2 |
712 | PAK4 LDA PAK6 |
713 | STA TID |
714 | STA TID+1 |
715 | STA TID+2 |
716 | STA TID+3 |
717 | LDA NTID |
718 | JMP PAK1+2 |
719 | PAK6 BCI 1, |
720 | PAK7 DAC ** |
721 | PAK8 DAC ** |
722 | PAK9 DAC TID |
723 | * |
724 | * |
725 | * *************** |
726 | * *ERROR ROUTINE* |
727 | * *************** |
728 | * |
729 | ER00 DAC ** ERROR ROUTINE |
730 | LDA SAV9 |
731 | STA SAVX |
732 | LDA ER93 =-35 |
733 | STA 0 SET INDEX |
734 | LDA ER91 (*)(*) |
735 | STA PRI+35,1 SET ** INTO PRINT BUFFER |
736 | IRS 0 SET COMPLETE PRINT BUFFER TO ******** |
737 | JMP *-2 |
738 | LDA CC |
739 | ARS 1 CC = CC/2 |
740 | SUB K101 =1 |
741 | SPL |
742 | CRA |
743 | STA XR |
744 | LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.) |
745 | SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT |
746 | JMP *+3 |
747 | LDA KAEQ ='142721 (=(E)(Q) ) |
748 | STA PRI+1,1 |
749 | LDA* ER00 |
750 | STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER |
751 | CALL F4$SYM PRINT THE BUFFER |
752 | DAC PRI |
753 | JST PRSP SET PRINT BUFFER TO SPACES |
754 | LDA TC |
755 | ER20 CAS CRET INPUT CHARACTERS UNTIL C/R |
756 | JMP *+2 |
757 | JMP C7 GO TO STATEMENT INPUT |
758 | JST CH00 |
759 | JMP ER20 |
760 | ER91 BCI 1,** |
761 | ER93 OCT 177735 -35 |
762 | * |
763 | * |
764 | SRT DAC ** |
765 | JST SAV |
766 | LDA* SRT SHIFT RIGHT ONE PLACE |
767 | STA XR TRIPLE PRECISION |
768 | LDA 0,1 |
769 | IAB |
770 | LDA 1,1 |
771 | LRS 1 |
772 | LGL 1 |
773 | IAB |
774 | STA 0,1 |
775 | LDA 2,1 |
776 | LRS 1 |
777 | STA 2,1 |
778 | IAB |
779 | STA 1,1 |
780 | JST RST |
781 | IRS SRT |
782 | JMP* SRT |
783 | * |
784 | * |
785 | SFT DAC ** TRIPLE PRECISION |
786 | JST SAV SHIFT LEFT ONE PLACE |
787 | LDA* SFT |
788 | STA XR |
789 | LDA 0,1 |
790 | IAB |
791 | LDA 1,1 |
792 | LLS 1 |
793 | CSA |
794 | STA 1,1 |
795 | IAB |
796 | STA 0,1 |
797 | ACA |
798 | LRS 1 |
799 | LDA 2,1 |
800 | LLS 1 |
801 | CSA |
802 | STA 2,1 |
803 | JST RST |
804 | IRS SFT |
805 | JMP* SFT |
806 | * |
807 | LIST DAC ** |
808 | JST PRSP |
809 | SR2 |
810 | JMP *+3 |
811 | CALL F4$SYM PRINT BLANK LINE |
812 | DAC PRI |
813 | CALL F4$SYM PRINT SOURCE INPUT LINE |
814 | DAC CI |
815 | JMP* LIST |
816 | * ************* |
817 | * *ASSIGN ITEM* |
818 | * ************* |
819 | * CHECKS ASSIGNMENT AREA OF DATA POOL (A0 TO ABAR) |
820 | * FOR ITEM DEFINED BY ID, IM, IU, ETC. |
821 | * IF FOUND, EXIT WITH POINTER AND |
822 | * ASSIGNMENTS DATA SET, OTHERWISE |
823 | * ASSIGN THE ITEM. |
824 | * |
825 | * |
826 | * |
827 | T0AS PZE 0 |
828 | AS00 DAC ** |
829 | CRA |
830 | STA A A = A (0) |
831 | AS04 JST STXA |
832 | JST NXT GET NEXT ENTRY |
833 | JMP AS30 AT END, GO TO AS30 |
834 | LDA NT |
835 | SUB NTA NT = NT(A) |
836 | SZE |
837 | JMP AS04 NO, G0 TO AS04 |
838 | LDA TID |
839 | SUB TIDA |
840 | SZE |
841 | JMP AS04 TID = TID(A) |
842 | LDA TID+1 |
843 | SUB TIDA+1 |
844 | SZE |
845 | JMP AS04 NO, GO TO AS04 |
846 | LDA TID+2 |
847 | SUB TIDA+2 |
848 | SZE |
849 | JMP AS04 |
850 | LDA NT IF NT (A) .NE. 0, |
851 | SNZ GO TO AS10 |
852 | JMP AS16 GO TO AS16 (4) |
853 | AS10 LDA IM IF IM .NE. IM (A), |
854 | SUB IMA GO TO AS04 (1) |
855 | SZE |
856 | JMP AS04 |
857 | LDA IU IF IU = 0, |
858 | SNZ OR NOT EQUAL IU (A) |
859 | JMP AS04 GO T0 AS04 (1) |
860 | SUB IUA |
861 | SZE |
862 | JMP AS04 ELSE, |
863 | LDA IM |
864 | SUB K105 GO TO AS16 (4) |
865 | SZE |
866 | JMP AS16 |
867 | JST NXT ELSE, GET NEXT ENTRY |
868 | JMP AS30 |
869 | LDA TIDA IF IU (A) = TIDB |
870 | SUB TIDB GO TO AS16 (4) |
871 | SZE ELSE, GO TO AS04 (1) |
872 | JMP AS04 |
873 | LDA TIDA+1 |
874 | SUB TIDB+1 |
875 | SZE |
876 | JMP AS04 |
877 | LDA TIDA+2 |
878 | SUB TIDB+2 |
879 | SZE |
880 | JMP AS04 |
881 | LDA A |
882 | SUB K105 |
883 | STA A |
884 | AS16 LDA IUA IF IU (A) .NE. 0 |
885 | ADD NTF |
886 | SZE |
887 | JMP AS18 GO TO AS18 (5) |
888 | LDA SPF IF SPF = 0, GO TO AS18 (5) |
889 | SNZ |
890 | JMP AS18 |
891 | LDA TC IF TC = ( |
892 | SUB K17 |
893 | SZE |
894 | JMP AS19 |
895 | JST TG00 TAG SUBPROGRAM |
896 | AS18 CRA SET NTF TO 0 |
897 | STA NTF SET NTF TO 0 |
898 | JST FA00 GO TO FETCH ASSIGNS |
899 | JST STXA |
900 | LDA IM |
901 | JMP* AS00 RETURN |
902 | AS19 JST TV00 TAG VARIABLE |
903 | JMP AS18 |
904 | AS30 JST BUD BUILD ASSIGNMENT ENTRY |
905 | LDA NT IF NT = 1 |
906 | SZE |
907 | JMP AS32 OR IV = VAR, |
908 | LDA IU |
909 | SUB K102 |
910 | SZE |
911 | JMP AS40 AMD |
912 | AS32 LDA IM IF IM = CPX, |
913 | SUB K105 |
914 | SZE |
915 | JMP AS40 |
916 | STA IU MOVE 1ST PART OF |
917 | LDA TIDB COMPLEX ENTRY TO |
918 | STA TID TID AND BUILD |
919 | LDA TIDB+1 ASSIGNMENT ENTRY |
920 | STA TID+1 |
921 | LDA TIDB+2 |
922 | STA TID+2 |
923 | LDA A |
924 | ADD K105 |
925 | STA A |
926 | JST BUD |
927 | LDA A |
928 | SUB K105 RESTORE A |
929 | STA A |
930 | AS40 LDA ABAR |
931 | SUB A TO = -(ABAR-A+5) |
932 | ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP |
933 | TCA |
934 | STA T0AS |
935 | TCA |
936 | ADD DO CO=DO+TO |
937 | STA DO |
938 | LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE |
939 | SNZ |
940 | JMP AS60 GO TO AS60 |
941 | LDA I |
942 | SUB T0AS |
943 | STA I I = I - T0(T0 IS NEGATIVE) |
944 | AOA |
945 | AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE |
946 | NOP |
947 | JMP AS50 |
948 | ADD '104 =DP,1 |
949 | STA AS91 AS91 = NEW TABLE TOP |
950 | ADD T0AS |
951 | STA AS92 AS92 |
952 | SUB T0AS COMPUTE SIZE OF FLOATING TABLES |
953 | SUB '104 =DP,1 |
954 | SUB DO |
955 | SNZ IF ZERO, ASSIGN TABLE ONLY, |
956 | JMP AS16 |
957 | TCA |
958 | STA T0AS |
959 | CRA |
960 | STA XR |
961 | AS46 LDA* AS92 END-5 |
962 | STA* AS91 END (MOVE TABLES UP) |
963 | LDA 0 |
964 | SUB K101 =1 |
965 | STA 0 REDUCE INDEX |
966 | IRS T0AS = NO, OF WORDS TO MOVE |
967 | JMP AS46 |
968 | JMP AS16 |
969 | AS50 JST ER00 |
970 | BCI 1,MO DATA POOL OVERFLOW |
971 | AS60 LDA DO |
972 | ADD D |
973 | JMP AS41 |
974 | AS91 DAC 0 |
975 | AS92 DAC ** |
976 | * |
977 | * |
978 | * |
979 | * |
980 | * **************** |
981 | * *TAG SUBPROGRAM* |
982 | * **************** |
983 | * TAG ITEM AS A SUBPROGRAM, CHECK TO SEE IF |
984 | * NAME IS IN IMPLICIT MODE TABLE AND SET |
985 | * MODE ACCORDINGLY |
986 | * |
987 | TG00 DAC ** |
988 | LDA IU |
989 | SUB K101 IF IU = SUB |
990 | SNZ |
991 | JMP* TG00 RETURN, ELSE |
992 | JST NU00 NO * USAGE TEST |
993 | LDA TG22 =-21 |
994 | STA 0 SET INDEX |
995 | TG04 LDA ID+1 CHARACTERS 3 AND 4 |
996 | CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE |
997 | JMP *+2 |
998 | JMP TG10 |
999 | TG06 IRS 0 |
1000 | JMP TG04 NOT DONE WITH TABLE |
1001 | TG08 LDA K101 =1 (IU=SUBR.) |
1002 | STA IU |
1003 | JST STXA |
1004 | LDA DP+1,1 IU(A) = SUB |
1005 | LGL 1 |
1006 | SSM |
1007 | LGR 1 |
1008 | STA DP+1,1 |
1009 | JMP* TG00 RETURN |
1010 | * |
1011 | TG10 LDA ID CHARACTERS 1 AND 2 |
1012 | ANA K111 ='37777 |
1013 | ADD HBIT ='140000 |
1014 | SUB TGT1+21,1 |
1015 | SZE |
1016 | JMP TG06 CONTINUE SEARCH |
1017 | LDA ID+2 CHARACTERS 5 AND 6 |
1018 | SUB TGT3+21,1 |
1019 | SZE |
1020 | JMP TG06 CONTINUE SEARCH |
1021 | LDA TGT1+21,1 |
1022 | LGR 8 |
1023 | ANA K107 =7 (=3 IF CPX, 4 IF DBL) |
1024 | ADD K102 =2 (=5 IF CPX, 6 IF DBL) |
1025 | JST DM00 DEFINE IM |
1026 | JMP TG08 |
1027 | * |
1028 | TG22 OCT 177753 =-21 |
1029 | * |
1030 | *...........IMPLICIT MODE SUBROUTINE NAME TABLE |
1031 | TGT1 BCI 6,DECEDLCLDLDS |
1032 | BCI 6,CSDCCCDSCSDA |
1033 | BCI 6,DADMDADMDMDS |
1034 | BCI 3,DBCMCO |
1035 | TGT2 BCI 6,XPXPOGOGOGIN |
1036 | BCI 6,INOSOSQRQRTA |
1037 | BCI 6,TAODBSAXINIG |
1038 | BCI 3,LEPLNJ |
1039 | TGT3 BCI 6, 10 / |
1040 | BCI 6, T T N / |
1041 | BCI 6,N2 1 1 N / |
1042 | BCI 3, X G / |
1043 | * |
1044 | * |
1045 | TIDA BSS 3 |
1046 | TIDB BSS 3 |
1047 | * |
1048 | * - TV00 TAG VARIABLE |
1049 | TV00 DAC ** |
1050 | LDA IU IF IU = 'VAR', |
1051 | SUB K102 |
1052 | SNZ |
1053 | JMP* TV00 RETURN |
1054 | JST NU00 ELSE, NO USAGE TEST |
1055 | JST STXA |
1056 | LDA DP+1,1 |
1057 | ANA K111 IU (A) = 'VAR' |
1058 | SSM |
1059 | STA DP+1,1 |
1060 | JMP* TV00 RETURN |
1061 | * |
1062 | * |
1063 | * |
1064 | * |
1065 | * |
1066 | * ************** |
1067 | * *FETCH ASSIGN* |
1068 | * ************** |
1069 | * SET ASSIGNMENT DATA FROM ASSIGN (EXCEPT ID) |
1070 | * EXPAND DIMENSION INFO IF ARRAY |
1071 | * |
1072 | FA00 DAC ** |
1073 | JST STXA |
1074 | LDA DP,1 |
1075 | LRL 15 |
1076 | STA NT NT=NT(A) |
1077 | CRA |
1078 | LLL 3 |
1079 | STA AT AT=AT(A) |
1080 | CRA |
1081 | LLL 3 IM = IM(A) |
1082 | STA IM |
1083 | STA 0 |
1084 | LDA KM92-1,1 |
1085 | STA D0 D0 = NUMBER OF WORDS |
1086 | ALS 2 |
1087 | ADD D0 |
1088 | STA X X = POINTER TO CONSTANT NUMBER OF WORDS |
1089 | JST STXA |
1090 | LDA DP+1,1 |
1091 | LRL 14 |
1092 | STA IU |
1093 | SUB K103 IF IU NOT 'ARR' |
1094 | SNZ |
1095 | JMP FA10 |
1096 | CRA |
1097 | LLL 14 AF = GF(A) |
1098 | STA AF |
1099 | JMP* FA00 |
1100 | FA10 LLL 14 |
1101 | STA 0 INDEX = GF(A) |
1102 | LDA DP+4,1 |
1103 | STA X1 POINTER OF DIMENSION 1 |
1104 | LDA DP+3,1 |
1105 | STA X2 POINTER OF DIMENSION 2 |
1106 | LDA DP+2,1 |
1107 | STA X3 POINTER OF DIMENSION 3 |
1108 | LDA DP+1,1 |
1109 | ANA K111 ='37777 |
1110 | STA AF AF = GF(GF(A)) |
1111 | LDA DP,1 |
1112 | LGR 9 |
1113 | ANA K107 =7 |
1114 | STA ND NUMBER OF DIMENSIONS |
1115 | STA 0 |
1116 | LDA K101 =1 |
1117 | STA D2 |
1118 | STA D3 |
1119 | JMP* FA91-1,1 |
1120 | FA22 LDA X3 FETCH 3RD DIMENSION SIZE |
1121 | STA XR |
1122 | JST FA40 |
1123 | STA D3 STORE D3 |
1124 | FA24 LDA X2 |
1125 | STA XR |
1126 | JST FA40 |
1127 | STA D2 D2 = 2ND DIMENSION SIZE |
1128 | FA26 LDA X1 |
1129 | STA XR |
1130 | JST FA40 |
1131 | STA D1 D1 = 1ST DIMENSION SIZE |
1132 | JST STXA EXIT WITH AF IN A |
1133 | LDA AF |
1134 | JMP* FA00 |
1135 | FA40 DAC ** |
1136 | LDA DP,1 IM OF SUBSCRIPT VALUE |
1137 | SSP |
1138 | LGR 12 |
1139 | SUB K105 =5 |
1140 | SZE SKIP IF DUMMY SUBSCRIPT |
1141 | LDA DP+4,1 FETCH VALUE OF SUBSCRIPT |
1142 | JMP* FA40 |
1143 | FA91 DAC FA26 |
1144 | DAC FA24 |
1145 | DAC FA22 |
1146 | * |
1147 | * |
1148 | * ************ |
1149 | * *FETCH LINK* |
1150 | * ************ |
1151 | * EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE |
1152 | * LINKED ITEM |
1153 | * |
1154 | FL00 DAC ** |
1155 | JST STXA |
1156 | LDA DP,1 A = 5 * CL(A) |
1157 | ANA K118 |
1158 | STA FLT1 |
1159 | ALS 2 |
1160 | ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC) |
1161 | STA A |
1162 | JST FA00 FETCH ASSIGN |
1163 | JST KT00 D0 = = WDS /ITEM |
1164 | LDA A |
1165 | SUB F (A) = A-F |
1166 | JMP* FL00 RETURN |
1167 | * |
1168 | * |
1169 | * ******************* |
1170 | * *D0=WORDS FOR LINK* |
1171 | * ******************* |
1172 | * D = ITEM MODE SIZE TIMES THE TOTAL SIZE IF |
1173 | * THE ITEM IS AN ARRAY |
1174 | * |
1175 | KT00 DAC ** |
1176 | LDA IU IF IU NOT 'ARR' |
1177 | SUB K103 |
1178 | SZE |
1179 | JMP* KT00 RETURN |
1180 | LDA D0 |
1181 | IAB D0 = D0 * D1 * D2 * D3 |
1182 | LDA D1 |
1183 | JST IM00 MULTIPLY A BY B |
1184 | IAB |
1185 | LDA D2 |
1186 | JST IM00 MULTIPLY A BY B |
1187 | IAB |
1188 | LDA D3 |
1189 | JST IM00 MULTIPLY A BY B |
1190 | STA D0 |
1191 | JMP* KT00 RETURN |
1192 | * |
1193 | * |
1194 | * |
1195 | * *********** |
1196 | * *DEFINE IM* |
1197 | * *********** |
1198 | * IM SUBA = IM (SET FROM A REG) |
1199 | * |
1200 | DM00 DAC ** |
1201 | STA IM IM = (A) |
1202 | JST STXA ESTABLISH A |
1203 | LDA DP,1 |
1204 | LRL 9 |
1205 | LGR 3 IM(A) = IM |
1206 | LGL 3 |
1207 | ADD IM |
1208 | LLL 9 |
1209 | STA DP,1 |
1210 | JMP* DM00 |
1211 | * |
1212 | * |
1213 | * *********** |
1214 | * *DEFINE AF* |
1215 | * *********** |
1216 | * AF SUBA = AF (SET FROM A REG) |
1217 | * |
1218 | DA00 DAC ** |
1219 | STA AF AF = (A) |
1220 | LRL 14 |
1221 | JST STXA |
1222 | DA10 LDA DP+1,1 IF IU (A) NOT ARR |
1223 | LGR 14 |
1224 | CAS K103 GF (A) : AF |
1225 | JMP *+2 |
1226 | JMP DA20 ELSE, GF (GF (A)) = AF |
1227 | LLL 14 |
1228 | STA DP+1,1 |
1229 | JMP* DA00 RETURN |
1230 | DA20 LDA DP+1,1 |
1231 | ANA K111 |
1232 | STA GFA |
1233 | STA 0 |
1234 | JMP DA10 |
1235 | NXT DAC ** GET NEXT ENTRY |
1236 | LDA A FROM ASSIGNMENT |
1237 | ADD K105 =5 |
1238 | STA A |
1239 | STA 0 |
1240 | CAS ABAR |
1241 | JMP* NXT |
1242 | NOP |
1243 | IRS NXT |
1244 | LDA DP,1 |
1245 | LRL 15 |
1246 | STA NTA NT(A) = NT FROM (A) |
1247 | CRA |
1248 | LLL 3 |
1249 | STA ATA AT(A) = AT FROM (A) |
1250 | CRA |
1251 | LLL 3 |
1252 | STA IMA IM(A) = IM FROM (A) |
1253 | CRA |
1254 | LLL 9 |
1255 | STA CLA CL(A) = CL FROM (A) |
1256 | LDA DP+1,1 |
1257 | LRL 14 |
1258 | STA IUA IU(A) = IU FROM (A) |
1259 | CRA |
1260 | LLL 14 |
1261 | STA GFA GF(A) = GF FROM (A) |
1262 | LDA DP+2,1 |
1263 | STA TIDA+2 TID(A) = TID FROM (A) |
1264 | LDA DP+3,1 |
1265 | STA TIDA+1 |
1266 | LDA DP+4,1 |
1267 | STA TIDA |
1268 | LRL 15 |
1269 | STA DTA DT(A) = DT FROM (A) |
1270 | CRA |
1271 | LLL 1 |
1272 | STA TTA TT(A) = TT FROM (A) |
1273 | LDA NTA NT(A) = NT FROM (A) |
1274 | SZE |
1275 | JMP* NXT |
1276 | LDA DP+4,1 |
1277 | SSM |
1278 | ALR 1 |
1279 | SSM |
1280 | ARR 1 |
1281 | STA TIDA |
1282 | JMP* NXT |
1283 | * |
1284 | * |
1285 | BUD DAC ** BUILD ASSIGNMENT |
1286 | JST STXA |
1287 | STA ABAR |
1288 | LDA TID TABLE ENTRY |
1289 | STA DP+4,1 |
1290 | LDA TID+1 |
1291 | STA DP+3,1 |
1292 | LDA TID+2 |
1293 | STA DP+2,1 |
1294 | LDA IU |
1295 | STA IUA |
1296 | LGL 14 |
1297 | STA DP+1,1 |
1298 | LDA NT |
1299 | LGL 3 |
1300 | ADD K102 AT = STR/+BS |
1301 | LGL 3 |
1302 | ADD IM |
1303 | LRL 16 |
1304 | STA CL |
1305 | LDA K102 |
1306 | STA AT |
1307 | LDA A CL(A) = A/5 |
1308 | SUB K105 |
1309 | SPL |
1310 | JMP *+3 |
1311 | IRS CL |
1312 | JMP *-4 |
1313 | LLL 25 |
1314 | ADD CL |
1315 | STA DP,1 |
1316 | SPL |
1317 | JMP* BUD |
1318 | LDA DT |
1319 | LGL 1 |
1320 | ADD TT |
1321 | LGL 14 |
1322 | IMA DP+4,1 |
1323 | ANA K111 |
1324 | ADD DP+4,1 |
1325 | STA DP+4,1 |
1326 | JMP* BUD |
1327 | * |
1328 | * |
1329 | * |
1330 | * |
1331 | * |
1332 | * ************ |
1333 | * *DEFINE AFT* |
1334 | * ************ |
1335 | * AT SUBA = AT (FROM B REG), THEN DEFINE AF |
1336 | * |
1337 | AF00 DAC ** |
1338 | IAB |
1339 | STA AF90 |
1340 | JST STXA |
1341 | LDA AF90 |
1342 | LGL 12 |
1343 | IMA DP,1 |
1344 | ANA AF91 |
1345 | ADD DP,1 |
1346 | STA DP,1 AT(A) = CONTENTS OF B INPUT |
1347 | IAB |
1348 | JST DA00 DEFINE AF |
1349 | JMP* AF00 |
1350 | AF90 PZE 0 |
1351 | AF91 OCT 107777 |
1352 | * |
1353 | * |
1354 | * ***************** |
1355 | * *DEFINE LOCATION* |
1356 | * ***************** |
1357 | * SET AF = RPL, AT = REL |
1358 | LO00 DAC ** |
1359 | LDA K101 REL |
1360 | IAB |
1361 | LDA RPL |
1362 | JST AF00 DEFINE AF |
1363 | JMP* LO00 |
1364 | * ************************* |
1365 | * *ASSIGN INTEGER CONSTANT* |
1366 | * ************************* |
1367 | * IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL |
1368 | AI00 DAC ** |
1369 | CRA |
1370 | STA ID+1 |
1371 | STA ID+2 |
1372 | LDA K101 (B) = INT |
1373 | IAB |
1374 | LDA K102 (A) = VAR |
1375 | JST AA00 ASSIGN SPECIAL |
1376 | JMP* AI00 RETURN |
1377 | * |
1378 | * |
1379 | * **************** |
1380 | * *ASSIGN SPECIAL* |
1381 | * **************** |
1382 | * B REG TO IM, A REG TO IU, 1 TO NT (CONSTANT), THEN |
1383 | * ASSIGN ITEM |
1384 | AA00 DAC ** |
1385 | STA IU IU = (A) |
1386 | IAB |
1387 | STA IM IM = (B) |
1388 | LDA K101 |
1389 | STA NT NT = 1 |
1390 | JST AS00 ASSIGN ITEM |
1391 | JMP* AA00 RETURN |
1392 | * |
1393 | * |
1394 | * ********** |
1395 | * *JUMP * |
1396 | * *ILL TERM* |
1397 | * ********** |
1398 | * |
1399 | * CLEAR LAST OP FLAG FOR NO PATH TESTING |
1400 | * |
1401 | B6 CRA |
1402 | STA LSTP LSTP = 0 |
1403 | * SET ILLEGAL DO TERM FLAG |
1404 | C5 LDA K101 |
1405 | STA LSTF LSTF =1 |
1406 | A1 LDA CRET |
1407 | JST TS00 IF TC NOT C/R, ERROR |
1408 | JMP C6 |
1409 | * |
1410 | * |
1411 | * ********** |
1412 | * *CONTINUE* |
1413 | * ********** |
1414 | * WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH |
1415 | * DO TABLE FOR DO TERMINATION |
1416 | C6 LDA LIF |
1417 | SZE IF LIF NON-ZERO, |
1418 | JMP C6H GO TO |
1419 | C6A LDA LSTN IF LSTN NON-ZERO, |
1420 | SZE GO TO |
1421 | JMP C6C |
1422 | C6B STA LSTF LSTF = 0 |
1423 | JMP C7 GO TO STATEMENT INPUT |
1424 | C6C SUB TRF TRACE FLAG |
1425 | SNZ SMP IF NOT END OF TRACE ZONE |
1426 | STA TRF SET TRF TO ZERO (TURN FLAG OFF) |
1427 | LDA DO START OF DO TABLE |
1428 | ADD D |
1429 | C6D STA I I = DO + D |
1430 | JST STXI |
1431 | SUB DO |
1432 | SNZ |
1433 | JMP C6B GO TO C6B - FINISHED DO |
1434 | LDA DP-4,1 |
1435 | SUB LSTN |
1436 | SZE |
1437 | JMP C6E |
1438 | LDA LSTF |
1439 | SZE |
1440 | JMP C6K |
1441 | JST DQ00 DO TERMINATION |
1442 | LDA D |
1443 | SUB K105 |
1444 | STA D D = D-5 |
1445 | LDA LSTF |
1446 | C6E STA LSTF |
1447 | LDA I |
1448 | SUB K105 |
1449 | JMP C6D I = I-5 - CONTINUE DO LOOP |
1450 | C6H LDA IFF |
1451 | STA A |
1452 | SNZ |
1453 | JMP C6J |
1454 | LLL 16 |
1455 | LDA OMI5 (A) = JMP INSTRUCTION |
1456 | JST OB00 OUTPUT OA |
1457 | CRA |
1458 | STA IFF IFF = 0 |
1459 | C6J STA A A = U |
1460 | LDA LIF |
1461 | STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG |
1462 | JST OS00 OUTPUT STRING - RPL |
1463 | JMP C6A |
1464 | * |
1465 | C6K JST ER00 |
1466 | BCI 1,DT |
1467 | * |
1468 | * |
1469 | * |
1470 | * ***************** |
1471 | * *STATEMENT INPUT* |
1472 | * ***************** |
1473 | * SET UP PROCESSING OF NEXT SOURCE STATEMENT |
1474 | * PROCESS STATEMENT NUMBER IF PRESENT |
1475 | * WRAPUP ANY OUTSTANDING ARITHMETIC IF |
1476 | C7 CRA |
1477 | STA LSTN LSTN = 0 |
1478 | STA IFLG IFLG = 0 |
1479 | STA LIF LIF = 0 |
1480 | LDA L0 L = L (0) |
1481 | STA L |
1482 | LDA CI CHECK CARD COLUMN 1 |
1483 | LGR 8 FOR $ CHARACTER |
1484 | SUB K15 *($) |
1485 | SNZ |
1486 | JMP CCRD CONTROL CARD |
1487 | JST XN00 EXAMINE NEXT CHAR |
1488 | SZE |
1489 | JMP C71 |
1490 | JST IS00 INPUT STATEMENT = |
1491 | LDA A |
1492 | STA LSTN LSTN = A |
1493 | STA LSTP |
1494 | C71 LDA IFF CHECK FOR IFF=0 |
1495 | LDA IFF IF IFF = 0, |
1496 | SNZ |
1497 | JMP C7B GO TO C7B |
1498 | SUB LSTN IF = LSTN |
1499 | SZE |
1500 | JMP C7C |
1501 | C7A STA IFF IFF = 0 |
1502 | C7B JST C7LT LINE TEST |
1503 | JMP C8 |
1504 | C7C LDA IFF IFF = A |
1505 | STA A |
1506 | LRL 32 |
1507 | LDA K201 (A) = JMP INSTRUCTION |
1508 | JST OB00 OUTPUT OA |
1509 | CRA |
1510 | JMP C7A GO TO C7A |
1511 | C7LT DAC ** LINE TEST |
1512 | LDA CI+2 CI = BLANK |
1513 | ANA K116 LIST LINE |
1514 | ADD K8 RETURN |
1515 | STA CI+2 |
1516 | LDA TC |
1517 | SUB HC2 IF TC : SPECIAL |
1518 | SZE |
1519 | JMP C7LU |
1520 | JST LIST |
1521 | JMP* C7LT |
1522 | C7LU JST ER00 CONSTRUCTION ERROR |
1523 | BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD |
1524 | * |
1525 | * |
1526 | * |
1527 | * ************************ |
1528 | * *CONTROL CARD PROCESSOR* |
1529 | * ************************ |
1530 | CCRD JST FS00 FLUSH BUFFER IF NECESSARY |
1531 | JST LIST LIST CARD |
1532 | LDA CI WORD CONTAINING COLUMN 1 |
1533 | LGL 12 |
1534 | SNZ |
1535 | LDA CCRK ='030000 (EOJ CODE = 3) |
1536 | LGR 6 TRUNCATE TO A DIGIT |
1537 | STA OCI |
1538 | LDA K106 =6 |
1539 | STA OCNT SET BUFFER WORD COUNT TO 3 |
1540 | JST FS00 FLUSH BUFFER |
1541 | LDA CI |
1542 | LGL 12 CHECK COLUMN 1 FOR CONTROL CODE 0 |
1543 | SZE |
1544 | JMP ER20 SKIP TO NEXT CARD (NOT CONTROL CARD) |
1545 | CALL F4$END CLOSE-OUT I/0 DEVICES AND STOP |
1546 | JMP A0 RESTART NEW COMPILATION |
1547 | CCRK OCT 030000 EOJ CONTROL CODE |
1548 | * |
1549 | * **************** |
1550 | * *STATEMENT SCAN* |
1551 | * **************** |
1552 | * DETERMINE THE CLASS OF THE STATEMENT |
1553 | * IF AN = IS FOUND WITH A FOLLOWING , |
1554 | * THE STATEMENT IS A DO |
1555 | * IF NO FOLLOWING COMMA, THE PAREN FLAG |
1556 | * IS TESTED, IF NO PARENS, THE STATEMENT |
1557 | * IS ARITHMETIC ASSIGNMENT |
1558 | * IF PARENS WERE DETECTED AND THE FIRST |
1559 | * NAME IS AN ARRAY, THE STATEMENT IS |
1560 | * ARITHMETIC ASSIGNMENT |
1561 | * OTHERWISE, IT IS A STATEMENT FUNCTION |
1562 | * IF NO = IS FOUND, THE STATEMENT IS |
1563 | * PROCESSED FURTHER IN STATEMENT ID |
1564 | C8T1 PZE 0 |
1565 | C8 LDA CC SAVE CC |
1566 | STA C8X9 |
1567 | LDA K101 |
1568 | STA C8T1 T (1) = 1 |
1569 | CRA |
1570 | STA ICSW ICSW = SIR |
1571 | C8A JST CH00 INPUT CHARACTER |
1572 | C8B LDA TC IF TC = ) |
1573 | SUB K4 |
1574 | SZE |
1575 | JMP C8C |
1576 | JST CH00 INPUT CHAR |
1577 | C8B2 LDA DFL IF DFL NOT ZERO |
1578 | SZE |
1579 | JMP C8B GO TO C8B |
1580 | C8B4 LDA C8X9 RESTORE CC |
1581 | STA CC |
1582 | LDA K101 IPL |
1583 | STA ICSW ICSW = IPL |
1584 | JMP A9 GO TO STATEMENT ID |
1585 | C8C LDA TC IF TC NOT (, |
1586 | SUB K17 |
1587 | SZE |
1588 | JMP C8D GO TO C8D |
1589 | LDA C8T1 T1 = T1 - 1 |
1590 | SUB K101 |
1591 | STA C8T1 |
1592 | C8C4 SZE IF T1 = 0 |
1593 | JMP C8B4 |
1594 | JST DN00 INPUT DNA |
1595 | JMP C8B2 GO TO C8B2 |
1596 | C8D LDA TC IF TC = , |
1597 | CAS K134 ='17 ('FINISHED' CODE FOR COMMA) |
1598 | JMP *+2 |
1599 | JMP C8D2 TC = COMMA |
1600 | SUB K5 |
1601 | SZE |
1602 | JMP C8E |
1603 | C8D2 LDA C8T1 GO TO C8C4, |
1604 | JMP C8C4 |
1605 | C8E LDA TC ELSE, IF TC = '/' |
1606 | SUB K9 |
1607 | SNZ |
1608 | JMP C8B4 GO TO C8B4 |
1609 | LDA TC |
1610 | SUB K18 IF NOT = , |
1611 | SZE |
1612 | JMP C8A GO TO C8A |
1613 | LDA K107 INPUT 7 CHARACTERS |
1614 | JST IA00 |
1615 | LDA C8X9 RESTORE CC |
1616 | STA CC |
1617 | LDA K101 IPL |
1618 | STA ICSW ICSW = IPL |
1619 | LDA TC |
1620 | SUB K5 IF TC NOT, |
1621 | SZE |
1622 | JMP C8G GO TO C8G |
1623 | LDA K102 ELSE, INPUT 2 CHARS |
1624 | JST IA00 |
1625 | LDA IBUF IF (A) = 'DO' |
1626 | SUB K19 |
1627 | SNZ |
1628 | JMP *+3 |
1629 | JST ER00 |
1630 | BCI 1,CM COMMA OUTSIDE PARENTHESES, NOT IN DO STMNT, |
1631 | LDA K104 |
1632 | JST NP00 FIRST NON-SPEC CHECK |
1633 | JMP C9 GO TO DO |
1634 | C8G LDA C8T1 1 IF NO ( TO LEFT OF EQUALS |
1635 | SZE |
1636 | JMP G2 ARITHMETIC ASSIGNMENT STATEMENT |
1637 | JST SY00 INPUT SYMBOL |
1638 | LDA C8X9 |
1639 | STA CC RESTORE CC |
1640 | LDA IU IF IU = SUBR |
1641 | SUB K103 |
1642 | SZE |
1643 | JMP G1 GO TO ARITH ST. FUNCT, |
1644 | JMP G2 OTHERWISE = ASSIGNMENT STATEMENT |
1645 | C8X9 PZE 0 |
1646 | * |
1647 | * TAPE 2 OF 5 - END |
1648 | MOR |