faae1561 |
1 | * TAPE 3 OF 5 - BEGIN |
2 | * |
3 | * |
4 | * ************************** |
5 | * *STATEMENT IDENTIFICATION* |
6 | * ************************** |
7 | * READ FOUR CHARACTERS AND DETERMINE CORRECT ROUTINE |
8 | * FOR PROCESSING, THEN CHECK SPELLING ON REST |
9 | A9T1 PZE 0 |
10 | A9T2 PZE 0 |
11 | A9T3 PZE 0 |
12 | A9 LDA K104 |
13 | JST IA00 INPUT (4) CHARS |
14 | LDA IBUF |
15 | STA NAMF NAMF = IBUF |
16 | LDA IBUF+1 |
17 | STA NAMF+1 |
18 | LDA A9Z9 INITIALIZE INDEX FOR LOOP |
19 | STA XR THROUGH THE STATEMENT NAMES |
20 | A9A LDA NAMF |
21 | SUB A9X1+30,1 |
22 | SZE |
23 | JMP A9F READ IN REST OF |
24 | LDA NAMF+1 CHECK REST OF SPELLING FOR |
25 | SUB A9X2+30,1 |
26 | SZE A MATCH ON 4 CHARACTERS |
27 | JMP A9F NOT FOUND |
28 | LDA A9X4+30,1 |
29 | ANA K133 |
30 | STA A9T1 T1 = NUMBER OF REMAINING CHARACTERS |
31 | LDA A9X3+30,1 LEFT TO CHECK |
32 | LRL 13 |
33 | IAB |
34 | LGR 3 |
35 | STA A9T2 T2 = ADDRESS OF ROUTINE |
36 | IAB |
37 | JST NP00 FIRST NON-SPECIFIC. CHECK -(A) = |
38 | A9B LDA A9T1 HIERARCHY CODE |
39 | SZE |
40 | JMP A9C MUST CHECK MORE CHARACTERS |
41 | JMP* A9T2 FINISHED CHARACTER CHECK, EXIT TO |
42 | * SPECIFIC ANALYZER. |
43 | A9C SUB K106 |
44 | SPL |
45 | JMP A9E |
46 | STA A9T1 |
47 | LDA K106 REMAINING SPELLING 1S CHECKED. |
48 | A9D STA A9T3 |
49 | JST IA00 |
50 | SUB A9T3 |
51 | SNZ |
52 | JMP A9B |
53 | JST ER00 |
54 | BCI 1,SP STATEMENT NAME MISSPELLED |
55 | A9E ADD K106 |
56 | IMA A9T1 |
57 | CRA |
58 | IMA A9T1 |
59 | JMP A9D |
60 | A9F IRS XR LOOP CONTROL FOR STATEMENT NAMES. |
61 | JMP A9A MORE NAMES - CONTINUE LOOP |
62 | LDA TC |
63 | SUB CRET |
64 | SZE |
65 | JMP A9G |
66 | LDA LSTN TC = C/R |
67 | SNZ |
68 | JMP C7 AND LSTN = 0 - INPUT NEW STATEMENT |
69 | A9G JST ER00 |
70 | BCI 1,ID UNRECOGNIZED STATEMENT |
71 | A9X1 BCI 10,INREDOCOLOFUSUBLEXDI |
72 | BCI 10,COEQGOCARECOFOIFWRRE |
73 | BCI 7,BAENREENASSTPA |
74 | BCI 2,DATR |
75 | BCI 1,PR |
76 | A9X2 BCI 10,TEALUBMPGINCBROCTEME |
77 | BCI 10,MMUITOLLTUNTRM( ITAD |
78 | BCI 3,CKDFWI |
79 | OCT 142215 D, C/R |
80 | BCI 3,SIOPUS |
81 | BCI 2,TAAC |
82 | BCI 1,IN |
83 | A9X3 DAC A3 |
84 | DAC A4 |
85 | DAC A5 |
86 | DAC A6 |
87 | DAC A7 |
88 | DAC R1 |
89 | DAC R2 |
90 | DAC R3 |
91 | DAC B2 |
92 | DAC B3 |
93 | DAC B4 |
94 | DAC B5 |
95 | DAC* R7 |
96 | DAC* R8 |
97 | DAC* R9 |
98 | DAC* CONT |
99 | DAC* V2 |
100 | DAC* V3 |
101 | DAC* V4 |
102 | DAC* V5 |
103 | DAC* V6 |
104 | DAC* V7 |
105 | DAC* V8 |
106 | DAC W5+'20000 |
107 | DAC* W3 |
108 | DAC* W7 |
109 | DAC* W8 |
110 | DAC W4,1 |
111 | DAC* TRAC+'20000,1 TRACE STATEMENT |
112 | DAC* V10 |
113 | * |
114 | * ****************************** |
115 | * *CONTINUE STATEMENT PROCESS0R* |
116 | * ****************************** |
117 | CONT LDA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR |
118 | ADD LSTN ACCOUNTS FOR POSSIBLE PATH ERROR |
119 | STA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR |
120 | JMP C6 |
121 | * |
122 | *-------------THE FOLLOWING TABLE IS USED BY STATEMENT ID |
123 | *-------------(RIGHT 6 BITS) AND OUTPUT ITEM, |
124 | A9X4 OCT 000003 (00) |
125 | OCT 030100 (01) + (A$--) |
126 | OCT 032313 (02) - (S$--) |
127 | OCT 031503 (03) * (M$--) |
128 | OCT 030403 (04) / (D$--) |
129 | OCT 000004 (05) .NOT. |
130 | OCT 000006 (06) .AND. |
131 | OCT 031405 (07) .OR. (L$-, |
132 | OCT 000004 (10) .LT. |
133 | OCT 000005 (11) .LE. |
134 | OCT 000002 (12) .EQ. |
135 | OCT 000007 (13) .GE. |
136 | OCT 000000 (14) .GT. |
137 | OCT 000000 (15) .NE. |
138 | OCT 031003 (16) = (H$--) |
139 | OCT 000005 (17) , |
140 | OCT 030503 (20) 'E' (E$--) |
141 | OCT 031600 (21) 'C' NC$--) |
142 | OCT 000001 (22) 'A' |
143 | OCT 000000 (23) |
144 | OCT 000005 (24) 'X' |
145 | OCT 000003 (25) 'H' |
146 | OCT 000002 (26) 'L' |
147 | OCT 000000 (27) 'I' |
148 | OCT 000002 (30) 'T' |
149 | OCT 031400 (31) 'F' (L$--) |
150 | OCT 000001 (32) 'Q' |
151 | OCT 000000 |
152 | OCT 000001 |
153 | OCT 000001 |
154 | A9Z9 DAC* -30,1 NO. OF ITEMS IN STMNT NAME TABLE |
155 | * |
156 | * |
157 | * ********************** |
158 | * *FIRST NON-SPEC CHECK* |
159 | * ********************** |
160 | * AT FIRST SHIFT IN LEVEL FROM ZERO, WRAP-UP |
161 | * SPECIFICATION STATEMENTS |
162 | T0NP PZE 0 |
163 | NPT0 EQU T0NP |
164 | T2NP PZE 0 |
165 | T1NP PZE 0 |
166 | NP00 DAC ** |
167 | STA NPT0 T0 = (A) |
168 | LDA A |
169 | STA T1NP T1 = A |
170 | LDA NPT0 |
171 | CAS K107 =7 |
172 | JMP *+2 |
173 | JMP NP10 TRACE STMNT. (MAY OCCUR ANYWHERE) |
174 | CAS SPF T0 , G.R. SPF, GO TO NP30 |
175 | JMP NP30 T0 = SPF, G0 TO NP25 |
176 | JMP NP25 |
177 | LDA TC IF TC = C/R |
178 | SUB CRET GO TO NP10 |
179 | SNZ |
180 | JMP NP10 |
181 | JST ER00 ELSE, ILLEGAL STATEMENT |
182 | BCI 1,EX SPECIFICATION STATEMENT APPEARS AFTER |
183 | * |
184 | NP10 LDA LSTN SPECIFICATION STATEMENT CLEAN-UP |
185 | STA A A = LSTN |
186 | SNZ |
187 | JMP NP16 IF ZERO, RETURN |
188 | JST FA00 FETCH ASSIGNS |
189 | LDA K103 STR-REL |
190 | SUB AT |
191 | SZE |
192 | JMP NP20 |
193 | LDA AF |
194 | JST OS00 OUTPUT STRING RPL |
195 | NP15 JST LO00 DEFINE LOCATION |
196 | LDA NAMF |
197 | SUB A9X1+16 |
198 | SZE |
199 | JST TRSE OUTPUT TRACE COUPLING |
200 | NP16 LDA T1NP |
201 | STA A |
202 | JMP* NP00 |
203 | NP20 JST NR00 NON-REL TEST |
204 | JMP NP15 |
205 | NP25 LDA LIF |
206 | SZE |
207 | JMP NP16 |
208 | LDA LSTP IF LSTP + LSTN =0 |
209 | ADD LSTN |
210 | SZE |
211 | JMP NP10 |
212 | IRS LSTP |
213 | JST ER00 'NO PATH' ERROR |
214 | BCI 1,PH NO PATH LEADING TO THE STATEMENT |
215 | NP30 LDA SPF IF SPF 0 0 |
216 | SZE |
217 | JMP NP37 |
218 | NP32 LDA TC |
219 | STA T2NP T2 = TC |
220 | LDA RPL |
221 | STA XST XST = RPL |
222 | LDA BDF BLOCK DATA SUBPROGRAM FLAG |
223 | SZE SKIP IF NOT BLOCK DATA SUBPROGRAM |
224 | JMP C2 GO TO RELATE COMMON |
225 | STA A SET LISTING FOR OCTAL ADDR. |
226 | LDA OMI5 JMP INSTRUCTION |
227 | STA DF SET LISTING FOR SYMBOLIC INSTR. |
228 | JST OA00 OUTPUT ABSOLUTE |
229 | JMP C2 GO TO RELATE COMMON |
230 | NP35 LDA T2NP |
231 | STA TC |
232 | NP37 LDA T0NP |
233 | STA SPF SPF = T0 |
234 | SUB K104 |
235 | SZE |
236 | JMP NP10 |
237 | NP40 STA A SET LISTING FOR OCTAL ADDR. |
238 | LDA XST LOCATION OF INITIAL JUMP |
239 | JST OS00 OUTPUT STRING |
240 | LDA RPL |
241 | STA XST XST = RPL |
242 | JMP NP10 GO TO NP10 |
243 | * |
244 | * ***************** |
245 | * *IF( PROCESSOR* |
246 | * ***************** |
247 | * ARITHMETIC IF ($1 $2 $3) |
248 | * IF $2 NOT = $3, JZE $2 |
249 | * IF $3 NOT = $1, JPL $3 |
250 | * (IF $1 NOT = NEXT ST NO., JMP $1) LATER |
251 | * LOGICAL IF |
252 | * OUTPUT JZE 77777 (FOR STRINGING AROUND |
253 | * IMBEDDED STATEMENT) |
254 | V3 JST II00 INPUT ITEM |
255 | SNZ |
256 | JMP V310 IM=0 (POSSI8LE UNARY + OR -) |
257 | LDA DFL |
258 | SZE |
259 | JMP V310 FIRST ITEM IN EXPRESSION 0.K. |
260 | V308 JST ER00 ERROR.....IF(SENSE SWITCH,.ETC)..... |
261 | BCI 1,IF ILLEGAL IF STATEMENT TYPE |
262 | V310 CRA (A)=0 |
263 | JST EX00 EXPRESSION EVALUATOR |
264 | LDA K4 |
265 | JST TS00 )-TEST |
266 | CRA |
267 | STA A SET A TO SPECIAL (IF) ENTRY IN DATA POOL |
268 | STA 0 |
269 | LDA MFL SET MODE OF EXPRESSION INTO SPECIAL (IF) |
270 | LGL 9 |
271 | STA DP,1 |
272 | JST TRSE OUTPUT TRACE COUPLING (IF NECESSARY) |
273 | LDA MFL CHECK MODE FLAG FOR LOGICAL |
274 | SUB K103 |
275 | SZE |
276 | JMP V320 ARITHMETIC IF |
277 | LDA LIF |
278 | SZE |
279 | JMP V308 |
280 | STA AF SET ADDR OF SNZ AND JMP INSTR TO 00000 |
281 | LDA OMJ2 =SNZ INSTR. |
282 | JST OA00 OUTPUT ABSOLUTE |
283 | LDA RPL SET LIF=CURRENT +DDR, (STRING BACK) |
284 | STA LIF |
285 | LDA OMI5 =JMP 0 INSTR. |
286 | JST OA00 OUTPUT ABSOLUTE |
287 | JST XN00 GO TO NEXT INPUT LINE |
288 | JMP C8 GO TO STATEMENT SCAN |
289 | * |
290 | V320 SUB K102 CHECK FOR MODE = COMPLEX |
291 | SNZ |
292 | JMP V308 ERROR,...COMPLEX MODE EXPRESSION |
293 | LDA V356 =-3 |
294 | STA I |
295 | V324 JST IS00 INPUT STATEMENT NUMBER |
296 | JST STXI SET INDEX TO I |
297 | LDA A |
298 | STA T1V3+3,1 SAVE BRANCH ADDRESSES |
299 | IRS I I=I+1 |
300 | JMP V350 CHECK FOR TERMINAL COMMA |
301 | LDA T3V3 |
302 | CAS T2V3 CHECK FOR ADDR-2 = ADDR-3 |
303 | JMP *+2 |
304 | JMP V330 ADDR-2 = ADDR-3 |
305 | CRA |
306 | STA A |
307 | LDA OMJ2 =SNZ INSTR. |
308 | STA DF |
309 | JST OA00 OUTPUT ABSOLUTE |
310 | LDA T2V3 |
311 | JST V360 OUTPUT A JMP(ADDR-2) INSTR. |
312 | LDA T3V3 |
313 | V330 CAS T1V3 CHECK FOR ADDR-3 = ADDR-2 |
314 | JMP *+2 |
315 | JMP V340 ADDR-3 = ADDR-1 |
316 | CRA |
317 | STA A |
318 | LDA OMJ3 =SMI INSTR. |
319 | JST OA00 OUTPUT ABSOLUTE |
320 | LDA T3V3 |
321 | JST V360 OUTPUT A JMP (ADDR-3) INSTR. |
322 | V340 LDA T1V3 |
323 | STA IFF SET IFF ' ADDR-1 |
324 | JMP C5 GO TO ILL-TERM |
325 | * |
326 | V350 LDA K5 |
327 | JST TS00 COMMA TEST |
328 | JMP V324 INPUT NEXT STATEMENT NO. |
329 | * |
330 | V356 OCT 177775 -3 |
331 | * |
332 | *---------------SUBROUTINE TO OUTPUT A RELATIVE JMP |
333 | V360 DAC ** |
334 | STA A SET ADDR. OF JUMP REF. TO A |
335 | CRA |
336 | IAB SET (B) = 0 |
337 | LDA OMI5 SET (A) = JMP INSTR. |
338 | JST OB00 OUTPUT OA |
339 | JMP* V360 EXIT |
340 | * |
341 | T1V3 *** ** ADDR-1 |
342 | T2V3 *** ** ADDR-2 |
343 | T3V3 *** ** ADDR-3 |
344 | * |
345 | * ******* |
346 | * *GO TO* |
347 | * ******* |
348 | * CHECK FOR NORMAL (R740), COMPUTED (R710) OR |
349 | * ASSIGNED (R730). INPUT BRANCH LIST USED BY BOTH |
350 | * R710 AND R730 FOR STATEMENT NO. LIST. |
351 | * |
352 | * |
353 | R7 JST XN00 EXAMINE NEXT CHAR |
354 | SZE |
355 | JMP R78 GO TO TEST DFL |
356 | JST IS00 INPUT STMNT = |
357 | LDA A (GO TO 20) |
358 | STA IFF IFF = A |
359 | JMP C5 G0 TO ILLTERM |
360 | R78 LDA DFL |
361 | SZE |
362 | JMP R7D |
363 | JST IR00 GO TO I (10, 20, 30} |
364 | LRL 32 |
365 | LDA K206 OUTPUT JMP* INSTRUCTION |
366 | JST OB00 OUTPUT OA |
367 | LDA K134 |
368 | JST TS00 , TEST |
369 | JST IB00 INPUT BRANCH LIST |
370 | JMP B6 GO TO JUMP |
371 | R7D JST IB00 INPUT BRANCH LIST GO TO (10,11,12), I |
372 | LDA K134 |
373 | JST TS00 , TEST |
374 | JST IR00 INPUT INT VAR |
375 | LRL 32 |
376 | LDA K200 OUTPUT LDA |
377 | JST OB00 OUTPUT OA |
378 | CRA |
379 | STA A |
380 | STA AF CAUSE OCTAL ADDRESS IN LISTING |
381 | LDA K75 |
382 | JST OA00 OUTPUT ABS (STA 0) - INDEX LOAD |
383 | LDA RPL |
384 | STA AF CAUSE RPL T0 BE IN LISTING |
385 | LDA K207 |
386 | JST OR00 OUTPUT RELATIVE (JMP RPL,1) |
387 | LDA L0 |
388 | R7F SUB K101 |
389 | STA I I = L (0) |
390 | JST STXI |
391 | LDA DP,1 |
392 | STA A |
393 | JST STXA |
394 | SNZ |
395 | JMP B6 FINISHED LOOPING ON LIST |
396 | LLL 16 |
397 | LDA K201 OUTPUT JMP INSTRUCTIONS |
398 | JST OB00 OUTPUT OA (JMP 0) |
399 | LDA I |
400 | JMP R7F |
401 | * ******************* |
402 | * *INPUT BRANCH LIST* |
403 | * ******************* |
404 | * INPUT STATEMENT NO. LISTS FOR GO TO PROCESSOR |
405 | IB00 DAC ** |
406 | LDA L0 |
407 | SUB K101 |
408 | STA I I = L0-1 |
409 | JST CH00 INPUT CHAR |
410 | LDA K17 |
411 | JST TS00 (- TEST |
412 | IB10 JST IS00 INPUT STMNT = |
413 | JST STXI |
414 | LDA A |
415 | STA DP,1 SET POINTER OF ST. N0. INTO TRIAD TABLE |
416 | * AREA |
417 | LDA I DP (J) = A |
418 | SUB K101 |
419 | STA I I = I-1 |
420 | LDA TC IF TC = , GO TO IB10 |
421 | SUB K5 |
422 | SNZ |
423 | JMP IB10 CONTINUE LOOP |
424 | CRA |
425 | STA DP-1,1 SET END FLAG INTO TABLE |
426 | JST IP00 )- INPUT OPEN |
427 | JMP* IB00 EXIT |
428 | K75 STA 0 |
429 | * |
430 | * |
431 | * ******** |
432 | * *ASSIGN* |
433 | * ******** |
434 | * CHECK TO SEE THAT 'TO' IS INCLUDED PROPERLY |
435 | W3 JST IS00 INPUT STMNT = |
436 | LDA A |
437 | STA T1W3 SAVE A |
438 | LDA TC |
439 | SUB K34 CHECK FOR T0 |
440 | SZE |
441 | JMP W305 CLEAR A FOR OUTPUT REL |
442 | STA A CAUSE OCTAL ADDRESS IN LIST |
443 | JST CH00 INPUT CHAR |
444 | LDA TC |
445 | SUB K35 |
446 | SNZ |
447 | JMP *+3 |
448 | W305 JST ER00 ERROR |
449 | BCI 1,TO GO TO IN ASSIGN STATEMENT |
450 | LDA RPL |
451 | ADD K102 |
452 | STA AF OUTPUT REL LDA *+2 |
453 | LDA K200 OUTPUT LDA *+2 |
454 | JST OR00 OUTPUT REL |
455 | LDA RPL |
456 | ADD K102 |
457 | STA AF OUTPUT REL JMP *+2 |
458 | LDA K201 |
459 | JST OR00 OUTPUT OA |
460 | LRL 32 |
461 | LDA T1W3 |
462 | STA A RESTORE A |
463 | CRA |
464 | JST OB00 OUTPUT DAC ST. NO. |
465 | JST IR00 INPUT INTEGER VARIABLE |
466 | LRL 32 |
467 | LDA K202 OUTPUT STA INSTRUCTION |
468 | JST OB00 OUTPUT OA |
469 | JMP A1 GO TO C/R TEST |
470 | T1W3 PZE ** TEMP STORE |
471 | * |
472 | * |
473 | * ************************ |
474 | * *DO STATEMENT PROCESSOR* |
475 | * ************************ |
476 | * STACK INFO IN DO TABLE. OUTPUT DO INITIAL |
477 | * CODE |
478 | C9T0 PZE ** |
479 | C9 JST IS00 INPUT STATEMENT = |
480 | JST NR00 NON-REL TEST |
481 | LDA A |
482 | STA C9T0 T0 = A |
483 | JST UC00 UNINPUT COLUMN |
484 | JST IR00 |
485 | LDA C951 |
486 | JST TS00 |
487 | LDA C9T0 (A) = T0 |
488 | IAB |
489 | JST DP00 DO INPUT |
490 | JST DS00 DO INITIALIZE |
491 | JMP C5 GO TO ILLTERM |
492 | C951 OCT 16 = |
493 | * |
494 | * |
495 | * ********** |
496 | * *END FILE* |
497 | * ********** |
498 | * *********** |
499 | * *BACKSPACE* |
500 | * *REWIND * |
501 | * *********** |
502 | V6 LDA K71 |
503 | V6A STA NAMF+1 |
504 | JST NF00 SET UP NAMF |
505 | JST OI00 OUTPUT I/0 LINK |
506 | JMP A1 GO TO C/R TEST |
507 | V7 LDA K72 |
508 | JMP V6A |
509 | V8 LDA K73 |
510 | JMP V6A |
511 | K71 BCI 1,FN FN |
512 | K72 BCI 1,DN |
513 | K73 BCI 1,BN BN |
514 | * |
515 | * |
516 | * ************** |
517 | * *READ * |
518 | * *WRITE * |
519 | * *INPUT FORMAT* |
520 | * ************** |
521 | * LIST ELEMENT DATA AND IMPLIED DO CONTROL |
522 | * STACKED IN TRIAD TABLE. PROCESSED BY |
523 | * OUTPUT TRIAD ROUTINE, SPECIAL OPERATORS |
524 | * ARE -I = DO INITIALIZATION |
525 | * T = DO TERMINATION |
526 | * Q = I/0 ARG TRANSFER |
527 | T0V5 PZE ** |
528 | V5 LDA K41 FSRN |
529 | STA NAMF+1 |
530 | JST XN00 EXAM NEXT CHAR |
531 | SZE |
532 | JMP V5A GENERAL READ |
533 | LDA V5K4 |
534 | JMP V10A CARD READ |
535 | V4 LDA K40 NAWF = F$WN |
536 | STA NAMF+1 |
537 | V5A JST NF00 SET UP REMAINING NAME |
538 | LDA D |
539 | STA V5T1 |
540 | JST CH00 INPUT CHARACTER |
541 | LDA K17 ='250......( |
542 | JST TS00 (-TEST |
543 | JST OI00 OUTPUT I0 LINK |
544 | LDA TC IF TC .NE. , |
545 | SUB K134 ='17 (,) |
546 | SZE G0 10 V5J |
547 | JMP V5J |
548 | JST V5X INPUT FORMAT |
549 | V5B JST IP00 ) - INPUT OPERATOR |
550 | LDA TC |
551 | SUB CRET TEST FOR TC=C/R |
552 | SZE |
553 | JMP V5C N0, G0 TO V5C |
554 | V5B2 LDA K42 YES. NAMF = ND |
555 | STA NAMF+1 |
556 | JST CN00 CALL NAME |
557 | LDA V5T1 |
558 | STA D |
559 | JMP A1 G0 TO C/R TEST |
560 | V5C JST UC00 |
561 | V5C5 CRA |
562 | STA IOF IOF = 0 |
563 | V5D JST II00 INPUT ITEM |
564 | SZE |
565 | JMP V5E IF (A) NOT 0, GO TO V5E |
566 | LDA K17 |
567 | JST TS00 (-TEST |
568 | CRA |
569 | STA O2 O2 = 0 |
570 | LDA IOF |
571 | STA O1 01 = IOF |
572 | LDA V5K1 = '27 |
573 | STA P |
574 | JST ET00 |
575 | LDA L |
576 | STA IOF IOF = L |
577 | JMP V5D GO TO V5D |
578 | V5E JST NC00 NON-CONSTANT TEST |
579 | LDA IU IF IU NOT ARR |
580 | SUB K103 |
581 | SZE |
582 | JMP V5H GO TO V5H |
583 | LDA TC |
584 | SUB K17 IF TC NOT -(, |
585 | SZE |
586 | JMP V5G GO TO V5G |
587 | LDA D0 |
588 | STA T0V5 T5 = D0 |
589 | LDA K103 |
590 | TCA |
591 | JST EX00 EXPRESSION |
592 | LDA T0V5 |
593 | STA D0 D0 = T5 |
594 | V5E5 LDA A |
595 | STA O2 |
596 | LDA D0 O2 = D0 |
597 | STA O1 |
598 | LDA V5K2 ='32 |
599 | STA P |
600 | JST ET00 ENTER TRIAD |
601 | V5E7 LDA TC IF TC = COMMA |
602 | SUB K134 GO T0 V5D |
603 | SNZ |
604 | JMP V5D |
605 | LDA IOF I = IOF |
606 | STA I |
607 | SZE IF NOT ZERO, |
608 | JMP V5F GO TO V5F |
609 | JST OT00 OUTPUT TRIADS |
610 | JMP V5B2 GO TO V5B2 |
611 | V5F JST IP00 )-INPUT OPERATOR |
612 | JST STXI |
613 | LDA DP+1,1 |
614 | STA IOF IOF = O1 (I) |
615 | JMP V5E7 |
616 | V5G JST KT00 K = = WDS/ITEM |
617 | JMP V5E5 GO TO V5E5 |
618 | V5H JST TV00 TAG VARIABLE |
619 | LDA TC |
620 | SUB K16X ='16 (=) |
621 | SZE GO TO V5E5 |
622 | JMP V5E5 ELSE, |
623 | JST IT00 INTEGER TEST |
624 | LDA IOF |
625 | SNZ IF IOF = ZERO OR L |
626 | JMP V5H7 |
627 | SUB L |
628 | SZE |
629 | JMP *+3 ERROR |
630 | V5H7 JST ER00 |
631 | BCI 1,PR PARENTHESES MISSING IN DO STATEMENT |
632 | JST DP00 DO INPUT |
633 | LDA IOF |
634 | STA I |
635 | JST STXI |
636 | LDA D |
637 | STA DP,1 O2(IOF) = D |
638 | STA O2 O2 = D |
639 | LDA V5K3 ='30 |
640 | STA P |
641 | JST ET00 ENTER TRIAD 'T'. |
642 | JMP V5F |
643 | V5J CRA |
644 | STA A A = 0 |
645 | JST OA00 OUTPUT ABSOLUTE |
646 | JMP V5B |
647 | V5T1 PZE 0 |
648 | V5K1 OCT 27 |
649 | V5K2 OCT 32 |
650 | V5K3 OCT 30 |
651 | V5K4 BCI 1,R3 |
652 | V5K5 BCI 1,W4 |
653 | V5X DAC ** INPUT FORMAT |
654 | JST XN00 EXAM NEXT CHARACTER |
655 | SZE |
656 | JMP V5X5 GO TO INPUT ARRAY NAME |
657 | JST IS00 INPUT STMNT NO. |
658 | V5X2 LRL 32 OUTPUT DAC A |
659 | JST OB00 OUTPUT 0A |
660 | JMP* V5X RETURN |
661 | V5X5 JST NA00 INPUT NAME |
662 | JST AT00 ARRAY TEST |
663 | JMP V5X2 |
664 | * PRINT |
665 | V10 LDA V5K5 PRINTER |
666 | V10A STA NAMF+1 |
667 | JST NF00 SET UP REST 0F NAME |
668 | JST CN00 CALL NAME |
669 | JST V5X INPUT FORMAT |
670 | LDA TC |
671 | SUB K134 |
672 | SZE SKIP IF COMMA |
673 | JMP V5B2 |
674 | LDA D |
675 | STA V5T1 |
676 | JMP V5C5 |
677 | * |
678 | * |
679 | * ************************** |
680 | * *FORMAT * |
681 | * *INPUT FORMAT STRING * |
682 | * *INPUT NUMERIC FORMAT STR* |
683 | * *NON ZERO TEST STRING * |
684 | * ************************** |
685 | T0V2 PZE 0 |
686 | T2V2 PZE 0 |
687 | V2T0 EQU T0V2 |
688 | V2T2 EQU T2V2 |
689 | V2 LDA K17 |
690 | JST OK00 OUTPUT RACK |
691 | CRA |
692 | STA T0V2 TO = 0 |
693 | LDA LSTP IF LSTOP .NE. 0 |
694 | SZE |
695 | JMP V2K GO TO V2K |
696 | V2A JST SI00 INPUT FORMAT STRING |
697 | SZE |
698 | JMP V2B |
699 | V2A1 LDA TC |
700 | SUB K12 IF TC NOT MINUS |
701 | SZE |
702 | JMP V2F GO TO V2F |
703 | JST IN00 INPUT NUMERIC FORMAT STRING |
704 | CRA |
705 | STA TID TID = 0 |
706 | V2B LDA TC IF TC .NE. P |
707 | SUB K46 |
708 | SZE |
709 | JMP V2H GO TO V2H |
710 | JST SI00 INPUT FORMAT STRING |
711 | SZE |
712 | JST NZ00 IF (A) .NE. 0 |
713 | V2C LDA TC |
714 | CAS K52 IF TC = D,E,F, OR G |
715 | NOP |
716 | JMP *+2 |
717 | JMP V2DA |
718 | CAS K53 |
719 | JMP V2E5-2 |
720 | NOP |
721 | JST IN00 INPUT NUMERIC FORMAT STRING |
722 | JST NZ00 NON-ZERO STRING TEST |
723 | LDA K10 |
724 | JST TS00 PERIOD TEST |
725 | V2D JST IN00 INPUT NUMERIC FORMAT STRING |
726 | V2DA LDA TC IF TC = ) |
727 | SUB K4 |
728 | SZE |
729 | JMP V2E |
730 | JST CH00 |
731 | JST OK00 INPUT CHAR AND OUTPUT PACK |
732 | LDA T0V2 IF F4 + ( Z ( |
733 | SUB K101 GO TO V2E |
734 | STA T0V2 |
735 | SPL |
736 | JMP V2N ELSE, |
737 | JMP V2DA |
738 | * GO TO C/R TEST |
739 | V2E LDA TC IF TC =, |
740 | SUB K5 |
741 | SNZ |
742 | JMP V2A GO TO V2A |
743 | LDA K9 |
744 | JST TS00 / TEST |
745 | JMP V2A |
746 | V2E5 JST SI00 INPUT FORMAT STRING |
747 | SZE IF (A) NOT 0, |
748 | JMP V2B GO TO V2B |
749 | LDA DFL IF DFL .NE. ZERO, |
750 | SZE |
751 | JMP V2DA GO TO V2DA |
752 | JMP V2A1 |
753 | V2F LDA TC IF TC = H |
754 | CAS K48 |
755 | JMP *+2 |
756 | JMP V2P GO TO V2P |
757 | V2FB CAS K47 |
758 | JMP *+2 |
759 | JMP V2E5 |
760 | CAS K17 IF TC = (, |
761 | JMP *+2 |
762 | JMP V2Q GO TO V2Q |
763 | LDA TC IF TC .NE. A,I, OR L |
764 | CAS K49 A |
765 | JMP *+2 |
766 | JMP V2G |
767 | CAS K50 I |
768 | JMP *+2 |
769 | JMP V2G |
770 | SUB K51 L |
771 | SZE |
772 | JMP V2C |
773 | V2G JST IN00 INPUT NUMERIC FORMAT STRING |
774 | JST NZ00 NON-ZERO STRING TEST |
775 | JMP V2DA |
776 | V2H JST NZ00 NON-ZERO STRING TEST |
777 | LDA TC |
778 | SUB K48 |
779 | SZE |
780 | JMP V2F |
781 | V2J JST HS00 TRANSMIT HOLLERITH STRING |
782 | JMP V2E5 GO T0 V2E5 |
783 | V2K LDA LSTN IF LSTN = 0, |
784 | SZE |
785 | JMP *+3 |
786 | JST ER00 ERR0R, NO PATH |
787 | BCI 1,NF NO REFERENCE T0 FORMAT STATEMENT |
788 | LDA RPL LIF = RPL |
789 | STA LIF |
790 | CRA |
791 | STA A |
792 | STA AF |
793 | AOA |
794 | STA DF |
795 | LDA K201 = JMP 0 |
796 | JST OA00 OUTPUT ABS |
797 | JMP V2A GO T0 V2A |
798 | * |
799 | NZ00 DAC ** |
800 | LDA TID |
801 | SZE |
802 | JMP* NZ00 |
803 | NZ10 JST ER00 |
804 | BCI 1,NZ NON-ZERO STRING TEST FAILED |
805 | IN00 DAC ** |
806 | JST SI00 (A) = 0 IS ERROR CONDITION |
807 | SZE |
808 | JMP* IN00 |
809 | JMP NZ10 |
810 | SI00 DAC ** |
811 | CRA |
812 | STA TID ID = T2 = 0 |
813 | SI05 STA V2T2 |
814 | JST CH00 INPUT CHAR |
815 | JST OK00 OUTPUT PACK |
816 | LDA TC |
817 | SUB K60 ASC-2 ZERO |
818 | CAS K124 |
819 | JMP SI10 |
820 | NOP |
821 | SPL |
822 | JMP SI10 |
823 | STA TC |
824 | LDA TID TID = 10*TID+TC |
825 | ALS 3 |
826 | ADD TID |
827 | ADD TID |
828 | ADD TC |
829 | STA TID |
830 | LDA K101 T2 =1 |
831 | JMP SI05 |
832 | SI10 LDA V2T2 (A) = ERROR CONDITION OR NOT |
833 | JMP* SI00 |
834 | V2M JST ER00 |
835 | BCI 1,FR FORMAT STATEMENT ERROR |
836 | V2N EQU A1 |
837 | V2P LDA K101 |
838 | STA ID ID = 1 |
839 | JMP V2J GO T0 V2J |
840 | V2Q LDA T0V2 |
841 | AOA |
842 | STA T0V2 |
843 | SUB K103 |
844 | SZE |
845 | JMP V2A |
846 | JMP V2M |
847 | K46 OCT 320 0P |
848 | K47 OCT 330 0X |
849 | K48 EQU K14 0H |
850 | K49 OCT 301 0A |
851 | K51 OCT 314 0L |
852 | K52 EQU K11 0D |
853 | K53 OCT 307 0G |
854 | K50 EQU K43 0I |
855 | * |
856 | * |
857 | * ******* |
858 | * *STOP * |
859 | * *PAUSE* |
860 | * ******* |
861 | * PAUSE AND STOP CENERATE CALLS TO F$HT |
862 | T1W7 PZE 0 |
863 | T2W7 PZE 0 |
864 | W7 LDA K55 |
865 | STA T1W7 |
866 | W7A LDA K74 |
867 | STA NAMF+1 NAMF = F$HT |
868 | JST NF00 SET-UP REMAINING CHAR 0F NAME |
869 | JST XN00 EXAMINE NEXT CHAR |
870 | LDA TC |
871 | SUB CRET |
872 | SNZ |
873 | JMP W7C TC = C/R - NOTING FOLLOWING |
874 | JST IV00 INPUT INTEGER/VARIA8LE |
875 | LRL 32 |
876 | LDA K200 OUTPUT LDA |
877 | JST OB00 OUTPUT OA |
878 | W7C JST CN00 CALL NAME |
879 | CRA |
880 | STA DF DF = 0 |
881 | LDA T1W7 |
882 | STA ID |
883 | JST AI00 ASSIGN INTEGER CONSTANT |
884 | CRA OUTPUT DAC |
885 | JST OB00 OUTPUT OA OF ST/PA OR HT |
886 | LDA T1W7 |
887 | SUB K54 |
888 | SNZ |
889 | JMP C5 PA-NOT THE CASE |
890 | LDA RPL |
891 | STA AF OUTPUT JMP * |
892 | CRA |
893 | STA A CAUSE LISTING TO HAVE OCTAL ADDRESS |
894 | LDA K201 |
895 | JST OR00 OUTPUT RELATWE |
896 | JMP B6 |
897 | W8 LDA K54 |
898 | JMP W7+1 |
899 | K74 BCI 1,HT HT |
900 | K54 BCI 1,PA PA |
901 | K55 BCI 1,ST ST |
902 | * |
903 | * |
904 | * - R8 CALL |
905 | * GENERATES CALL DIRECTLY OR USES EXPRESSION TO |
906 | * ANALYZE AN ARGUMENT LIST. |
907 | R8 JST SY00 INPUT SYMBOL |
908 | LDA IU |
909 | SUB K101 =1 (SUB) |
910 | SZE SKIP IF IU=SUBR, |
911 | JST TG00 TAG SUB PROCRAM |
912 | LDA TC |
913 | SUB K17 ='250 ( ( ) |
914 | SZE |
915 | JMP *+3 |
916 | G2B LDA K101 SET A=1 BEFORE EXPRESSION |
917 | JMP G2A |
918 | CRA |
919 | IAB (B)=0 |
920 | LDA OMI2 =JST INSTR, |
921 | JST OB00 OUTPUT 0A |
922 | JMP A1 CR TEST |
923 | * ********************** |
924 | * *ASSIGNMENT STATEMENT* |
925 | * ********************** |
926 | G2 LDA K104 |
927 | JST NP00 FIRST NON-SPEC CHECK |
928 | JST II00 INPUT ITEM |
929 | LDA K102 SET A = 2 BEFORE EXPRESSION |
930 | G2A TCA |
931 | JST EX00 |
932 | JMP A1 |
933 | * |
934 | * |
935 | * ******** |
936 | * *RETURN* |
937 | * ******** |
938 | * OPTIMIZES EXIT CODING FOR FUNCTIONS TO MINIMIZE |
939 | * FETCHES OF THE FUNCTION VALUE. |
940 | R9 LDA SBF A = SBF, |
941 | STA A IF ZERO, GO TO ERROR |
942 | SZE |
943 | JMP *+3 |
944 | JST ER00 |
945 | BCI 1,RT RETURN NOT ALLOWED IN MAIN PROGRAM |
946 | LDA SFF ELSE, IF SFF = 0, |
947 | SNZ |
948 | JMP R9C GO TO R9C |
949 | CAS K101 IF SFF = 1, GO TO R98 |
950 | JMP *+2 |
951 | JMP R9B |
952 | STA AF OUTPUT REL JMP TO 1ST RETN |
953 | LRL 32 |
954 | STA A SET A=0 TO OUTPUT OCTAL ADDR ON LISTING |
955 | LDA K201 |
956 | JMP R9A |
957 | R9B IAB |
958 | LDA RPL SFF = RPL |
959 | STA SFF |
960 | LDA K56 0UTPUT ITEM (F,A) |
961 | JST OM00 |
962 | R9C LRL 32 |
963 | STA A SET FOR OCTAL ADDHESS IW LISTING |
964 | STA AF SET RELATIVE ADDRESS TO ZERO |
965 | LDA K206 JUMP I, 0 |
966 | R9A JST OR00 OUTPUT REL |
967 | JMP B6 EXIT |
968 | K56 OCT 31 P CODE FOR 'F' (FETCH) |
969 | * |
970 | * |
971 | * ******************** |
972 | * *STATEMENT FUNCTION* |
973 | * ******************** |
974 | * OLD ASSIGN VALUES ARE SAVED IN SFTB AND ARE |
975 | * RESTORED AT COMPLETION. |
976 | G1T0 PZE 0 |
977 | G1T1 PZE 0 |
978 | G1 LDA K103 (A) = 3 |
979 | JST NP00 FIRST NON-SPEC CHECK |
980 | JST SY00 INPUT SYMBOL |
981 | JST LO00 DEFINE LOCATION |
982 | LDA K103 |
983 | STA I |
984 | JST GE00 GENERATE SUBPROGRAM ENTRANCE |
985 | LDA I |
986 | STA G1T1 T1 = I |
987 | LDA K16X '=' TEST |
988 | JST TS00 |
989 | JST II00 INPUT ITEM |
990 | CRA |
991 | JST EX00 EXPRESSION |
992 | LDA G1T1 |
993 | STA I I = T1 |
994 | IRS TCF TCF = TCF+1 |
995 | G1A JST STXI |
996 | LDA SFTB+2,1 |
997 | STA A |
998 | LDA SFTB+0,1 |
999 | IAB |
1000 | JST STXA SET R TO A |
1001 | IAB |
1002 | STA DP,1 |
1003 | JST STXI SET R TO I |
1004 | LDA SFTB+1,1 |
1005 | IAB |
1006 | JST STXA SET R TO A |
1007 | IAB |
1008 | STA DP+1,1 |
1009 | LDA I |
1010 | SUB K103 I = I-3 = 0 |
1011 | STA I |
1012 | SUB K103 |
1013 | SZE |
1014 | JMP G1A NO, GO TO G1A |
1015 | LDA T1NP |
1016 | STA A |
1017 | LLL 16 |
1018 | LDA OMJ1 |
1019 | JST OB00 |
1020 | JST TG00 TAG SUBPROGRAM |
1021 | JMP A1 GO TO C/R TEST |
1022 | * - W5 END |
1023 | * *************** |
1024 | * *END PROC6SSOR* |
1025 | * *************** |
1026 | * FIRST CHECK SUBPROGRAMS FOR CORRECT USAGE, THEN |
1027 | * GENERATE MAP AND STRING BACK VARIABLES |
1028 | * AND CONSTANTS. |
1029 | T1W5 PZE |
1030 | W5 LDA BDF IF BLOCK DATA, |
1031 | SZE |
1032 | JMP W5K GO TO W5K |
1033 | LDA SBF IF SBF NOT ZERO |
1034 | STA A INDICATES SUBROUTINES |
1035 | SZE OR FUNCTION, |
1036 | JMP W5M GO TO W5M |
1037 | W5B CRA |
1038 | STA A A = J=0 |
1039 | JMP W5H |
1040 | W5D JST FA00 FETCH ASSIGNS |
1041 | JST STXA |
1042 | LDA NT |
1043 | SZE IF NT=L (CONSTANT) |
1044 | JMP W5O GO TO W5O |
1045 | LDA IU |
1046 | SUB K101 IF IU=1 |
1047 | SZE INDICATES VARIABLE, |
1048 | JMP W5T GO TO W5T |
1049 | W5F LDA RPL SAVE RPL |
1050 | STA T1W5 RPL=-AF (INHIBIT LISTING) |
1051 | LDA AF |
1052 | SSM |
1053 | STA RPL |
1054 | CRA |
1055 | JST OR00 OUTPUT REL |
1056 | LDA T1W5 RESTORE RPL |
1057 | STA RPL |
1058 | W5H LDA A A=A+5 |
1059 | ADD K105 |
1060 | STA A |
1061 | SUB ABAR IF A=ABAR, (DONE) |
1062 | SUB K105 |
1063 | SZE |
1064 | JMP W5D ELSE, GO TO W5D |
1065 | W5J JST FS00 FLUSH BUFFER |
1066 | LDA SBF |
1067 | SZE |
1068 | LDA W5Z1 |
1069 | ERA W5Z2 |
1070 | STA OCI |
1071 | LDA SBF |
1072 | SZE |
1073 | LDA W5Z3 |
1074 | STA OCI+1 |
1075 | LDA K106 |
1076 | STA OCNT |
1077 | JST FS00 |
1078 | JMP A051 GO TO INITIALIZE |
1079 | W5K LDA RPL IF RPL NOT ZERO, |
1080 | SNZ |
1081 | JMP W5J |
1082 | JST ER00 ERROR-CODE GENERATED |
1083 | BCI 1,BD IN A BLOCK DATA SUBPROGRAM |
1084 | W5M JST FA00 FETCH ASSIGNS |
1085 | LDA SFF IF FUNCTION, |
1086 | SZE |
1087 | JMP W5N GO TO W5N |
1088 | JST NU00 NO USE TEST |
1089 | JST STXA |
1090 | LDA DP,1 IF NO ERROR, |
1091 | SSM NT(A)=1 |
1092 | STA DP,1 |
1093 | JMP W5B GO T0 W5B |
1094 | W5N LDA IU |
1095 | SUB K102 IU MUST BE VAR/CON, |
1096 | SNZ ELSE, |
1097 | JMP W5B |
1098 | JST ER00 ERROR-FUNCTION |
1099 | BCI 1,FD NAME NOT DEFINED BY AN ARITHM, STATEMENT |
1100 | W5O LDA IU IF IU=VAR/CON |
1101 | SUB K102 |
1102 | SZE |
1103 | JMP W5H |
1104 | LDA AT AND AT = STR/REL |
1105 | SUB K103 A "STRING" REQ'D. |
1106 | SZE |
1107 | JMP W5H |
1108 | W5P LDA D0 IF D0 IS 4, THE |
1109 | SUB K104 CONSTANT IS COMPLEX, |
1110 | SZE OTHERWISE |
1111 | JMP W5Q GO TO W5Q |
1112 | LDA AF |
1113 | JST OS00 OUTPUT STRING |
1114 | JST STXA |
1115 | LDA DP+2,1 OUTPUT 4 WORDS |
1116 | JST W5X OF CONSTANT |
1117 | LDA DP+3,1 |
1118 | JST W5X |
1119 | LDA NT |
1120 | SNZ |
1121 | JMP W5S |
1122 | LDA A INCREMENT A |
1123 | ADD K105 |
1124 | STA A |
1125 | JST STXA |
1126 | JMP W5S |
1127 | W5Q LDA AF |
1128 | JST OS00 OUTPUT STRING |
1129 | JST STXA |
1130 | LDA D0 IF D0=1, |
1131 | SUB K101 INDICATES INTEGER, |
1132 | SNZ |
1133 | JMP W5R GO TO W5R |
1134 | W5S LDA DP+2,1 OUTPUT TWO WORDS |
1135 | JST W5X FLOATING POINT CONSTANT |
1136 | LDA DP+3,1 |
1137 | JST W5X |
1138 | LDA D0 IF DOUBLE PRECISION, |
1139 | SUB K103 |
1140 | SZE |
1141 | JMP W5H |
1142 | W5R LDA DP+4,1 OUTPUT THE 3RD WORD |
1143 | JST W5X |
1144 | JMP W5H GO TO W5H |
1145 | W5T LDA AT |
1146 | CAS K103 |
1147 | JMP W5F STRONG VARIABLE (IU = NON 0) |
1148 | JMP W5T5 |
1149 | CAS K102 TEST FOR STG ABS ADDRESS |
1150 | OCT 17400 |
1151 | JMP *+2 |
1152 | JMP W5F NO |
1153 | LDA DP+4,1 TEST FOR PREFIX G |
1154 | ANA *-4 |
1155 | SUB *-5 |
1156 | SZE |
1157 | JMP W5F STRONG VARIABLE (IU = NON 0) |
1158 | W5T5 LDA IU |
1159 | SZE |
1160 | JMP W5P |
1161 | JST ER00 |
1162 | BCI 1,US |
1163 | W5X DAC ** |
1164 | LRL 16 |
1165 | STA DF |
1166 | IAB |
1167 | JST OA00 OUTPUT ABS |
1168 | JST STXA REST "A" |
1169 | JMP* W5X EXIT |
1170 | W5Z1 EQU K100 000377 |
1171 | W5Z2 EQU K122 040000 |
1172 | W5Z3 EQU K116 177400 |
1173 | * |
1174 | * |
1175 | * |
1176 | * ************************ |
1177 | * *INPUT CHAR/OUTPUT PACK* |
1178 | * ************************ |
1179 | PO00 DAC ** |
1180 | JST CH00 INPUT CHAR |
1181 | JST OK00 OUTPUT PACK |
1182 | JMP* PO00 RETURN |
1183 | * ************************ |
1184 | * *TRANS HOLLERITH STRING* |
1185 | * ************************ |
1186 | * FORM HOLLERITH STRING, CHARACTER COUNT IN ID 0N |
1187 | * ENTRY. C/R WILL ALSO TERMINATE STRING. |
1188 | HS00 DAC ** |
1189 | HS10 JST IC00 INPUT 1 CHARACTER |
1190 | CAS CRET CHECK FOR CHAR = C/R |
1191 | JMP *+2 |
1192 | JMP HS15 HOLLERITH STRING EXTENDS PAST END 0F CARD |
1193 | JST OK00 OUTPUT PACK THE CHARACTER |
1194 | LDA ID |
1195 | SUB K101 REDUCE CHARACTER COUNT BY 1 |
1196 | STA ID |
1197 | SZE |
1198 | JMP HS10 INPUT MORE CHARACTERS |
1199 | JMP* HS00 |
1200 | HS15 JST ER00 |
1201 | BCI 1,HS HOLLERITH STRING EXTENDS OVER STATEMENT |
1202 | * |
1203 | * |
1204 | * ********** |
1205 | * *DO INPUT* |
1206 | * ********** |
1207 | * SET UP DO TABLE ENTRIES. |
1208 | DP00 DAC ** |
1209 | LDA D D = D+5 |
1210 | ADD K105 IFLG = NON-ZERO |
1211 | STA IFLG |
1212 | STA D |
1213 | ADD DO I = D0+D |
1214 | STA I |
1215 | JST STXI |
1216 | LDA A DP (1-4) = (B) |
1217 | STA DP-2,1 DP (1-2) = A |
1218 | IAB |
1219 | STA DP-4,1 |
1220 | JST IV00 INPUT INT VAR/CON |
1221 | LDA K134 = , |
1222 | JST TS00 COMMA TEST |
1223 | JST STXI |
1224 | LDA A |
1225 | STA DP,1 DP(I) = INITIAL VALUE POINTER |
1226 | JST IV00 INPUT INT VAR/CON |
1227 | JST STXI |
1228 | LDA A |
1229 | STA DP-1,1 DP (I-1) = A - FINAL VALUE POINTER |
1230 | LDA TC |
1231 | SUB K134 = , |
1232 | SZE IF THIRD TERM |
1233 | JMP DP20 |
1234 | JST IV00 READ AND ASSIGN, |
1235 | DP10 JST STXI |
1236 | LDA A |
1237 | STA DP-3,1 DP(I-3) = INCREMENT POINTER |
1238 | CRA |
1239 | STA IFLG CLEAR IFLAG |
1240 | JMP* DP00 EXIT |
1241 | DP20 LDA K101 |
1242 | STA ID THIRD TERM = 1 |
1243 | JST AI00 ASSIGN CONSTANT |
1244 | JMP DP10 |
1245 | * *************** |
1246 | * *DO INITIALIZE* |
1247 | * *************** |
1248 | * GENERATE DO INITIALIZATION CODE. |
1249 | DS00 DAC ** |
1250 | JST STXI ESTABLISH I |
1251 | LDA DP,1 A = DP (I) |
1252 | STA A |
1253 | LDA K200 |
1254 | JST DS20 LOAD - LDA INITIAL VALUE |
1255 | LDA DP-2,1 |
1256 | STA A A = DP (I-2) |
1257 | LDA RPL |
1258 | STA DP,1 SET RETURN ADDRESS INTO DP(I) |
1259 | LDA K202 |
1260 | JST DS20 STORE - STA VARIABLE NAME |
1261 | JMP* DS00 |
1262 | * OUTPUT OA SUBROUTINE |
1263 | DS20 DAC ** |
1264 | IAB |
1265 | LLL 16 SET B = 0 |
1266 | JST OB00 OUTPUT OA |
1267 | JST STXI RESTORE I |
1268 | JMP* DS20 RETURN |
1269 | * |
1270 | DS90 PZE 0 |
1271 | * |
1272 | * **************** |
1273 | * *DO TERMINATION* |
1274 | * **************** |
1275 | * GENERATE DO TERMINATION CODE. |
1276 | DQ00 DAC ** |
1277 | JST STXI |
1278 | LDA DP-2,1 |
1279 | STA A |
1280 | LDA K200 |
1281 | JST DS20 OUTPUT LDA VARIABLE NAME |
1282 | LDA DP-3,1 |
1283 | STA A |
1284 | LDA K203 |
1285 | JST DS20 OUTPUT ADD INCREMENT |
1286 | LDA DP-1,1 |
1287 | STA A |
1288 | LDA OMK9 |
1289 | JST DS20 OUTPUT CAS FINAL VALUE |
1290 | CRA |
1291 | STA A |
1292 | LDA RPL |
1293 | ADD K103 |
1294 | STA AF |
1295 | LDA DP,1 |
1296 | STA DS90 |
1297 | LDA OMI5 JUMP *+3 |
1298 | JST OR00 OUTPUT REL |
1299 | LDA DS90 |
1300 | STA AF |
1301 | LDA OMI5 JMP RPL (SAVED) - POINTS TO 'STA' INST. |
1302 | JST OR00 OUTPUT REL |
1303 | LDA OMI5 OUTPUT JMP RPL (SAVED) |
1304 | JST OR00 OUTPUT REL |
1305 | JMP* DQ00 |
1306 | * ************ |
1307 | * *EXPRESSION* |
1308 | * ************ |
1309 | * THE RESULTANT OUTPUT IS A BUILT UP AOIN |
1310 | * TABLE THAT IS FURTHER PROCESSED BY SCAN. |
1311 | T0EX PZE 0 |
1312 | EXT0 EQU T0EX |
1313 | T1EX PZE 0 |
1314 | T2EX PZE 0 |
1315 | T3EX PZE 0 |
1316 | T5EX PZE 0 |
1317 | T6EX PZE 0 |
1318 | EXT7 PZE 0 |
1319 | T9EX PZE 0 |
1320 | EX00 DAC ** |
1321 | STA F F = (A) |
1322 | LDA A SAVE POINTER TO FIRST VARIABLE |
1323 | STA TRFA FOR LATER POSSIBLE TRACING |
1324 | LDA D I = D+D0+10 |
1325 | ADD DO |
1326 | ADD K125 =8 |
1327 | STA I |
1328 | JST EX99 DATA POOL CHECK |
1329 | JST STXI |
1330 | CRA |
1331 | STA EXT0 T0 = 0 |
1332 | STA B B = 0 |
1333 | STA EXT7 T7 = 0 |
1334 | ADD EX92+12 |
1335 | LGL 9 O(1-2) = '=' |
1336 | STA DP-1,1 0 (I) = 0 |
1337 | CMA |
1338 | STA IFLG IFLM NOT 0 |
1339 | LDA L0 |
1340 | STA DP-2,1 O(I-2) = L0 |
1341 | EX10 JST STXI |
1342 | CRA |
1343 | STA T1EX T1 = 0 |
1344 | STA DP,1 AOIN(I) = T(1) = 0 |
1345 | STA DP+1,1 |
1346 | LDA IM IF IM NOT ZERO, |
1347 | SZE |
1348 | JMP EX50 GO TO EX50 |
1349 | LDA K106 |
1350 | TCA |
1351 | STA 0 |
1352 | * PERFORM TABLE SEARCH |
1353 | EX11 LDA TC GO TO ROUTINE ACCORDING |
1354 | SUB EX90+6,1 TO TC. |
1355 | SNZ IF NO MATCH, ERROR |
1356 | JMP EXI1 |
1357 | IRS XR |
1358 | JMP EX11 |
1359 | JST STXI |
1360 | LDA LIBF SPECIAL LIBRARY FLAG |
1361 | SZE |
1362 | JMP EX39 |
1363 | JMP EX95 ERROR CONDITION |
1364 | EXI1 LDA EX91+6,1 |
1365 | STA 0 |
1366 | JMP 0,1 PROCESS LEADING OPERATOR |
1367 | * SPECIAL OPERATOR FLAG SET WHEN COMPILING THE FORTRAN |
1368 | * LIBRARY IN WHICH CASE THE OPERATIONS ( A= ) AND |
1369 | * ( =A ) ARE REQUIRED, THIS LOGIC WILL ALLOW THESE |
1370 | * TO BE PROCESSED WITHOUT GIVING AN ERROR MESSAGE IF THE |
1371 | * SPECIAL LIBRARY FLAG, (LIBF) IS SET TO NON-ZERO, |
1372 | * |
1373 | EX12 LDA B TC = ( |
1374 | ADD K109 B = B+16 |
1375 | STA B SXF = NON-ZERO |
1376 | STA SXF |
1377 | EX14 JST II00 INPUT ITEM |
1378 | JST STXI |
1379 | JMP EX10 GO TO EX10 |
1380 | EX16 JST STXI TC = * |
1381 | LDA TC |
1382 | LGL 9 OI (I-2) = *, B+13 |
1383 | ADD B |
1384 | ADD K129 |
1385 | ERA DP-1,1 |
1386 | SSP |
1387 | SNZ |
1388 | JMP *+3 |
1389 | JST ER00 NO, CONSTR ERROR |
1390 | BCI 1,PW * NOT PRECEDED BY ANOTHER * |
1391 | LDA K109 (E = '20) |
1392 | LGL 9 |
1393 | IMA DP-1,1 |
1394 | ANA K118 ='777 |
1395 | ADD K101 |
1396 | ERA DP-1,1 CHAJNE * TO ** |
1397 | STA DP-1,1 |
1398 | JMP EX14 GO TO EX14 |
1399 | EX18 LDA K102 =2 |
1400 | STA TC SET TC TO - |
1401 | LDA K125 =8 |
1402 | STA T1EX T1 = 8 |
1403 | JST STXI |
1404 | LDA DP-1,1 |
1405 | ANA K118 |
1406 | SUB B 8 .GT. I (I-2) -B |
1407 | SUB T1EX |
1408 | SPL |
1409 | JMP *+3 |
1410 | EX19 JST ER00 NO, ERROR |
1411 | BCI 1,NT LOGICAL .NOT. NOT A UNARY OPERATOR |
1412 | EX20 LDA T0EX YES |
1413 | SZE T (0) = 0 |
1414 | JMP EX34 |
1415 | EX22 LDA B YES, |
1416 | ADD F B + + (5) .GT. 0 |
1417 | SPL NO, ERROR |
1418 | JMP EX96 |
1419 | EX24 JST STXI |
1420 | LDA TC |
1421 | LGL 9 |
1422 | ADD T1EX |
1423 | ADD B |
1424 | STA DP+1,1 OI(I) = TC , T1+B |
1425 | JST EX99 DATA POOL CHECK |
1426 | JMP EX14 |
1427 | EX26 JST STXI |
1428 | LDA DP-1,1 |
1429 | ANA K118 IF I (I-2) .LT. B |
1430 | CAS B |
1431 | JMP EX97 ERROR-----MULTIPLE + OR - SIGNS |
1432 | NOP |
1433 | EX30 LDA K131 SET INDEX TO |
1434 | STA 0 SEARCH OPERATOR TABLE FOR TRAILING |
1435 | EX31 LDA EX92+14,1 OPERATOR AFTER HAVING ENCOUNTERED AN |
1436 | SUB TC ITEM 0R A NEGATE, |
1437 | SZE |
1438 | JMP EX32 |
1439 | LDA EX93+14,1 |
1440 | STA *+3 |
1441 | JST STXI |
1442 | JMP* *+1 |
1443 | DAC ** |
1444 | EX32 IRS XR CONTROL OPERATOR LOOP |
1445 | JMP EX31 CONTINUE |
1446 | * |
1447 | * |
1448 | * TAPE 3 OF 5 - END |
1449 | MOR |