projects / h316.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
*** empty log message ***
[h316.git] / programs / fortran / src / frtn_3_of_5.asm
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
My complete H316 universe