projects / h316.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
*** empty log message ***
[h316.git] / programs / fortran / src / frtn_1_of_5.asm
1 * C210-001-6601 (FRTN) 3C NO.180463000 REV. D
2 *
3 * TAPE 1 OF 5 - BEGIN
4 *
5 *
6 * COMPUTER. DDP-116,516
7 *
8 *
9 *
10 *
11 * PROGRAM CATEGORY- COMPILER
12 *
13 *
14 *
15 *
16 * PROGRAM TITLE. FRTN
17 * EXPANDED FORTRAN IV COMPILER
18 * FOR DDP-116,516
19 *
20 *
21 *
22 *
23 *
24 *
25 *
26 * APPROVAL DATE
27 *
28 *
29 * PROG--------------------- ------------
30 *
31 *
32 * SUPR---------------------- ------------
33 *
34 *
35 * QUAL---------------------- ------------
36 *
37 *
38 * NO. OF PAGES ------------
39 *
40 * REVISIONS
41 *
42 * REV. D ECO 5249
43 * REV. C ECO 3824 10-31-66
44 * REV. B ECO 3476 09-19-66
45 * REV. A 06-08-66
46 *
47 * AUTHOR
48 *
49 * HONEYWELL. INC. - COMPUTER CONTROL DIVISION
50 *
51 *
52 * PURPOSE
53 *
54 * THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV
55 * PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE
56 * DDP-116 OR DDP-516.
57 *
58 *
59 * RESTRICTIONS
60 *
61 * MINIMUM 8K CORE STORAGE
62 *
63 *
64 * STORAGE
65 *
66 * 6682 (DECIMAL)
67 * 15034 (OCTAL)
68 *
69 *
70 * USE
71 *
72 *
73 * ********************************
74 *
75 * *FORTRAN-IV OPERATING PROCEDURE*
76 * ********************************
77 *
78 * 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE'
79 * (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES
80 *
81 * 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE
82 * SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE
83 * SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START.
84 *
85 * 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY).....
86 * 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS
87 * OPTION IS USED WHEN COMPILING THOSE PARTS OF THE
88 * LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE
89 * LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO
90 * GENERATE SPECIAL CODING.
91 *
92 * 2-7....NOT ASSIGNED
93 *
94 * 8-10...INPUT DEVICE SELECTION
95 * 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER)
96 * 2 = NCR CARD READER
97 * 3 = DIGITRONICS PAPER TAPE READER
98 * 4 = MAGNETIC TAPE ( UNIT 1 )
99 * 5-7 = (SPARES)
100 *
101 * 11-13..SYMBOLIC LISTING SELECTION
102 * 0. SUPPRESS ALL SYMBOLIC LISTINGS
103 * 1. ASR-33/35 TYPEWRITER
104 * 2. LINE PRINTER
105 * 3 = ( SPARE )
106 * 4 = LISTING ON MAGNETIC TAPE UNIT 2
107 * 5-7 = (SPARES)
108 *
109 * 14-16..BINARY OUTPUT SELECTION
110 * 0. SUPPRESS BINARY OUTPUT.
111 * 1. BRPE HIGH SPEED PAPER TAPE PUNCH
112 * 2. ASR BINARY OUTPUT ASR/33
113 * 3. ASR BINARY OUTPUT ASR/35
114 * 4 = MAGNETIC TAPE OUTPUT
115 * 5-7 (SPARES)
116 *
117 *
118 * 4. SENSE SWITCH SETTINGS AND MEANINGS.......
119 * 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE
120 * SIDE-BY-SIDE OCTAL INFORMATION.
121 * 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET).
122 * 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING
123 * THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT
124 * STATUS OF THE I/O KEYBOARD, IT MAY BE
125 * CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING
126 * SSW-3 AND PRESSING START TO CONTINUE.
127 * 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED
128 * IN THE OBJECT CODING BEING GENERATED REGARDLESS OF
129 * ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR
130 * OVERRIDE).
131 *
132 * 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER
133 * AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A
134 * LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF
135 * TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE
136 * PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START'
137 * TO PROCESS THE NEXT PROGRAM (BATCH COMPILING).
138 *
139 * FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS
140 * PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT
141 * THE COMPILATION.
142 *
143 *
144 * ERRORS
145 *
146 * THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A
147 * SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION.
148 * *************************
149 * *DATA POOL ENTRY FORMATS*
150 * *************************
151 *
152 * THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION
153 * 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS
154 * AT THE END OF THE COMPILER AND EXTENDS TOWARD THE
155 * END OF MEMORY.
156 *
157 * TDCCCCCCCCCCCCCC....DP(A+4)
158 * CCCCCCCCCCCCCCCC....DP(A+3)
159 * CCCCCCCCCCCCCCCC....DP(A+2)
160 * IIAAAAAAAAAAAAAA....DP(A+1)
161 * NRRRMMMLLLLLLLLL....DP(A)
162 *
163 * T = TRACE TAG
164 * D = DATA TAG
165 * C = SIX 8-BIT CHAR. OR BINARY CONSTANT
166 * I = ITEM USAGE (IU)
167 * 0 = NO USAGE 2 = VAR/CONSTAN^
168 * 1 = SUBPROGRAM 3 = ARRAY
169 * A = ASSIGNMENT ADDRESS
170 * N = NAME TAG (NT)
171 * 0 = NAME 1 = CONSTANT
172 * R = ADDRESS TYPE (AT)
173 * 0 = ABSOLUTE 3 = STRING-REL
174 * 1 = RELATIVE 4 = COMMON
175 * 2 = STRING-ABS 5 = DUMMT
176 * M = ITEM MODE (IM)
177 * 1 = INTEGER 5 = COMPLEX
178 * 2 = REAL 6 = DOUBLE
179 * 3 = LOGICAL
180 * 4=COM/EQU LINK
181 * 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT
182 * TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT
183 * A DO-LOOP, EACH ENTRY IS 5 WORDS.
184 * 00IIIIIIIIIIIII
185 * 00TTTITTTTTTTTT
186 * 00XXXXXXXXXXXXX
187 * 00UUUUUUUUUUUUUU
188 * 00NNNNNNNNNNNNNN
189 * I = INITIAL VALUE/OR RPL
190 * T = TERMINAL VALUE
191 * X = INDEX
192 * U = INCREMENT
193 * N = STATEMENT NUMBER
194 *
195 * 3. THE EXPRESSION TABLE (A0I TABLE) 'FLOATS' ON TOP
196 * THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES.
197 *
198 * NOOOOOOOOIIIIIII.....DP(I+1)
199 * 00AAAAAAAAAAAAAAAA...DP(I)
200 * N = NEGATION INDICATOR
201 * O = OPERATOR
202 * I = INDEX (OPERATOR LEVEL)
203 * A = ASSIGNMENT TABLE REFERENCE
204 * 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND
205 * IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE
206 * COMPILER. EACH ENTRY IS THREE WORDS LONG.
207 *
208 * S000000000PPPPPP.....DP(L+2)
209 * 0011111111111111.....DP(L+1)
210 * 0022222222222222.....DP(L)
211 * S = TEMP STORAGE INDICATOR
212 * P = OPERATOR
213 * 1 = FIRST OPERAND ADDRESS
214 * 2 = SECOND OPERAND ADDRESS
215 ABS
216 ORG '100
217 *
218 * ************************************
219 * * DIRECTORY OF FORTRAN IV COMPILER *
220 * ************************************
221 *
222 *
223 *
224 *..............ENTRANCE GROUP
225 DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE
226 DAC DP DATA POOL START
227 *
228 *..............INPUT GROUP
229 DAC IC00 (IPG1) INPUT COLUMN
230 DAC UC00 (IPG2) UNINPUT COLUMN
231 DAC CH00 (IPG3) INPUT CHARACTER
232 DAC ID00 (IPG4) INPUT DIGIT
233 DAC IA00 (IPG5) INPUT (A) CHARACTERS
234 DAC FN00 (IPG6) FINISH OPERATOR
235 DAC DN00 (IPG7) INPUT DNA
236 DAC II00 (IPG8) INPUT ITEM
237 DAC OP00 (IPG9) INPUT OPERAND
238 DAC NA00 (IPG10) INPUT NAME
239 DAC IG00 (IPG11) INPUT INTEGER
240 DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT
241 DAC IR00 (IPG13) INPUT INTEGER VARIABLE
242 DAC IS00 (IPG14) INPUT STATEMENT NUMBER
243 DAC XN00 (IPG15) EXAMINE NEXT CHARACTER
244 DAC SY00 INPUT STMBOL
245 *
246 *..............TEST GROUP
247 DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R)
248 DAC IP00 (TSG2) )-INPUT OPERATOR
249 DAC A1 (TSG3) C/R TEST
250 DAC B1 (TSG4) , OR C/R TEST
251 DAC NU00 (TSG5) NO USAGE TEST
252 DAC NC00 (TSG6) NON CONSTANT TEST
253 DAC NS00 (TSG7) NON SUBPROGRAM TEST
254 DAC AT00 (TSG8) ARRAY TEST
255 DAC IT00 (TSG9) INTEGER TEST
256 DAC NR00 (TSG10) NON REL TEST
257 *
258 *..............ASSIGNMENT GROUP
259 DAC AS00 (ASG1) ASSIGN ITEM
260 DAC TG00 (ASG2) TAG SUBPROGRAM
261 DAC TV00 (ASG3) TAG VARIABLE
262 DAC FA00 (ASG4) FETCH ASSIGN
263 DAC FL00 (ASG5) FETCH LINK
264 DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION
265 DAC DM00 (ASG7) DEFINE IM
266 DAC DA00 (ASG8) DEFINE AF
267 DAC AF00 (ASG9) DEFINE AFT
268 DAC LO00 (ASG10) DEFINE LOCATION
269 DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT
270 DAC AA00 (ASG12) ASSIGN SPECIAL
271 DAC NXT GET NEXT ENTRY FROM ASSGN TABLE
272 DAC BUD BUILD ASSIGNMENT TABLE ENTRT
273 *
274 *..............CONTROL GROUP
275 DAC B6 (CNG1) JUMP
276 DAC C5 ILL TERM
277 DAC C6 (CNG2) CONTINUE
278 DAC C7 (CNG3) STATEMENT INPUT
279 DAC C8 (CNG4) STATEMENT SCAN
280 DAC A9 (CNG5) STATEMENT IDENTIFICATION
281 DAC NP00 (CNG6) FIRST NON-SPEC CHECK
282 *
283 *..............SPECIFICATIONS GROUP
284 DAC EL00 (SPG1) EXCHANGE LINKS
285 DAC NM00 (SPG2) NON COMM0N TEST
286 DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST
287 DAC SC00 (SPG4) INPUT SUBSCRIPT
288 DAC IL00 (SPG5) INPUT LIST ELEMENT
289 DAC R1 (SPG6) FUNCTION
290 DAC R2 SUBROUTINE
291 DAC A3 (SPG7) INTEGER
292 DAC A4 REAL
293 DAC A5 DOUBLE PRECISION
294 DAC A6 COMPLEX
295 DAC A7 LOGICAL
296 DAC B2 (SPG8) EXTERNAL
297 DAC B3 (SPG9) DIMENSION
298 DAC B7 INPUT DIMENSION
299 DAC B4 (SPG10) COMMON
300 DAC B5 (SPG11) EQUIVALENCE
301 DAC C2 (SPG12) RELATE COMMON ITEMS
302 DAC C3 (SPG13) GROUP EOUIVALENCE
303 DAC C4 (SPG14) ASSIGN SPECIFICATIONS
304 DAC W4 (SPG15) DATA
305 DAC R3 (SPG16) BLOCK DATA
306 DAC TRAC (SPG17) TRACE
307 *
308 *..............PROCESSOR GROUP
309 DAC V3 (PRG1) IF
310 DAC R7 (PRG2) GO TO
311 DAC IB00 INPUT BRANCH LIST
312 DAC W3 (PRG3) ASSIGN
313 DAC C9 (PRG5) DO
314 DAC V7 (PRG6) END FILE
315 DAC V6 BACKSPACE
316 DAC V8 REWIND
317 DAC V5 (PRG7) READ
318 DAC V4 WRITE
319 DAC V2 (PRG8) FORMAT
320 DAC SI00 INPUT FORMAT STRING
321 DAC IN00 INPUT NUMERIC FORMAT STRING
322 DAC NZ00 NON ZERO STRING TEST
323 DAC W8 (PRG9) PAUSE
324 DAC W7 STOP
325 DAC R8 (PRG10) CALL
326 DAC G2 ASSIGNMENT STATEMENT
327 DAC R9 (PRG11) RETURN
328 DAC G1 (PRG12) STATEMENT FUNCTION
329 DAC W5 (PRG13) END
330 *
331 *..............PROCESSOR SUBROUTINES GROUP
332 DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK
333 DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING
334 DAC DP00 (PSG3) DO INPUT
335 DAC DS00 (PSG4) DO INITIALIZE
336 DAC DQ00 (PSG5) DO TERMINATION
337 DAC EX00 (PSG6) EXPRESSION
338 DAC CA00 (PSG7) SCAN
339 DAC ST00 TRIAD SEARCH
340 DAC TC00 TEMP STORE CHECK
341 DAC ET00 (PSG8) ENTER TRIAD
342 DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE
343 *
344 *..............OUTPUT GROUP
345 DAC OL00 (OPG1) OUTPUT OBJECT LINK
346 DAC OI00 (OPG2) OUTPUT I/O LINK
347 DAC CN00 (OPG3) CALL NAME
348 DAC OK00 (OPG4) OUTPUT PACK
349 DAC OB00 (OPG5) OUTPUT OA
350 DAC OT00 (OPG6) OUTPUT TRIADS
351 DAC OM00 (OPG7) OUTPUT ITEM
352 DAC OR00 (OPG8) OUTPUT REL
353 DAC OA00 OUTPUT ABS
354 DAC OS00 OUTPUT STRING
355 DAC OW00 (OPG9) OUTPUT WORD
356 DAC PU00 PICKUP
357 DAC FS00 (OPG10) FLUSH
358 DAC TRSE (OPG11) OUTPUT TRACE COUPLING
359 DAC PRSP SET BUFFER TO SPACES
360 *
361 *..............MISC. GROUP
362 DAC AD3 ADD TWO 3 WORD INTEGERS
363 DAC IM00 MULTIPLY (A) BY (B)
364 DAC STXA SET A INTO INDEX
365 DAC STXI SET I INTO INDEX
366 DAC NF00 SET FS INTO NAMF
367 DAC BLNK SET AREA TO ZEROS
368 DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE
369 DAC CIB COMPARE IBUF TO A CONSTANT
370 DAC SAV SAVE INDEX IN PUSH-DOWN STACK
371 DAC RST RESET INDEX FROM PUSH-DOWN STACK
372 DAC PACK
373 DAC ER00 ERROR OUTPUT
374 DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.)
375 DAC SFT SHIFT LEFT 1 (TRIPLE PRES.)
376 DAC LIST
377 *
378 *
379 * ****************************
380 * *CONSTANT AND VARIABLE POOL*
381 * ****************************
382 *
383 XR EQU 0 INDEX REGISTER
384 * THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING
385 * PROGRAM INITIALIZATION
386 A EQU '40 ASSIGNMENT TABLE INDEX
387 I EQU A+1 EXPRESSION TABLE INDEX
388 C EQU A+2
389 ASAV EQU A+3
390 L EQU A+4
391 MFL EQU A+5 MODE FLAG
392 SFF EQU A+6 FUNCTION FLAG
393 SBF EQU A+7 SUBFUNCTION FLAG
394 SXF EQU A+8 POSSIBLE CPX FLAG
395 SPF EQU A+9 PEC. FLAG
396 TCF EQU A+10 TEMP STORE COUNT
397 IFF EQU A+11
398 ABAR EQU A+12 BASE OF ASSIGN TABLE
399 XST EQU A+13 FIRST EXECUTABLE STMNT.
400 CFL EQU A+14 MON FLAG
401 D EQU A+15 DO INDEX
402 RPL EQU A+16 RELATE PROGRAM LOCATION
403 BDF EQU A+17 LOCK DATA FLAG
404 SLST EQU A+18 SOURCE LIST
405 OBLS EQU A+19 OUTPUT BINARY LIST
406 BNOT EQU A+20 BINART OUTPUT FLAG
407 TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.)
408 TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN
409 * AN EXPRESSION (FOR USE BY TRACE).
410 SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET)
411 LIF EQU A+24 LOGICAL IF FLAG
412 LSTN EQU A+25 LAST STATEMENT NO.
413 LSTF EQU A+26 LAST STATEMENT FLAG
414 LSTP EQU A+27 LAST STATEMENT STOP
415 SDSW EQU A+28 STATEMENT I0 SWITCH
416 *
417 NAMF EQU '570 NAME FUNCTION
418 ND EQU NAMF+1 NO OF DIMENSIONS
419 NS EQU '572 NO OF SUBSCRIPTS
420 NT EQU NS+1 NAME TAG
421 NTF EQU NS+2 NAME TAG FLAG
422 NTID EQU NS+3 NO. WORDS IN TID
423 O1 EQU NS+4 OPERATOR 1
424 O2 EQU NS+5 OPERATOR 2
425 P EQU NS+6
426 PCNT EQU NS+7
427 OCNT EQU NS+8 OUTPUT COUNT
428 S0 EQU NS+9
429 S1 EQU NS+10 SUBSCRIPT NO.1
430 S2 EQU NS+11 SUBSCRIPT NO.2
431 S3 EQU NS+12 SUBSCRIPT NO.3
432 TC EQU NS+13 TERMINAL CHAR
433 TT EQU NS+14
434 TYPE EQU NS+15
435 X EQU NS+16 ARRAY INDICES
436 X1 EQU NS+17
437 X2 EQU NS+18
438 X3 EQU NS+19
439 X4 EQU NS+20
440 NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS
441 ATA EQU NS+22
442 IMA EQU NS+23
443 CLA EQU NS+24
444 IUA EQU NS+25
445 DTA EQU NS+26
446 TTA EQU NS+27
447 *..........ADJUST THIS ORG IF THE SIZE OF THE CONSTAST POOL IS MODIFIED
448 ORG '630
449 AF PZE 0 ADDRESS FIELD
450 GF EQU AF
451 AT PZE 0 ADDRESS TYPE
452 CODE PZE 0 OUTPUT CODE
453 D0 PZE 0 DIMENSIONS
454 D1 PZE 0
455 D2 PZE 0
456 D3 PZE 0
457 D4 PZE 0
458 DF PZE 0 DATA FLAG
459 NF PZE 0
460 B PZE 0
461 DFL PZE 0 DELIMITER FLAG
462 E OCT 0 EQUIVALENCE INDEX
463 EP PZE 0 E-PRIME
464 E0 PZE 0 E-ZERO
465 FTOP PZE 0 OUTPUT COMMAND
466 GFA PZE 0
467 ICSW PZE 1 INPUT CONTROL SWITCH
468 IFLG PZE 0 I-FLAG
469 IM PZE 0 ITEM MODE
470 IOF PZE 0 I-0 FLAG
471 IU PZE 0 ITEM USAGE
472 KBAR PZE 0 TEM STORE
473 KPRM PZE 0 TEM STORE
474 EBAR OCT -1 E-BAR
475 DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT)
476 CC PZE '111 CARD COLUMN COUNTER
477 DCT PZE 0 DUMMY ARGUMENT COUNT
478 F PZE 0 TRIAD TABLE INDEX
479 CL PZE 0 ASSIGNMENT ITEMS UNPACKED
480 DT PZE 0
481 FLT1 PZE 0 FETCH LINK CL POINTER LOCATION
482 LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET)
483 *..........CONSTANTS USED BY THE COMPILER
484 K4 OCT 251 0)
485 K5 OCT 254 0,
486 K8 OCT 240 0-SPACE
487 K9 OCT 257 0/
488 K10 OCT 256 0.
489 K12 OCT 255 0-
490 K13 OCT 253 0+
491 K15 OCT 244 0$
492 K16X OCT 16
493 K17 OCT 250 0(
494 K18 OCT 275 0=
495 K19 BCI 1,DO DO
496 K34 OCT 324 0T
497 K35 OCT 317 0O
498 K40 BCI 1,WN
499 K41 BCI 1,RN RN
500 K42 BCI 1,CB
501 K43 OCT 311 0I
502 K44 OCT 321 0Q
503 K45 EQU K34 0T
504 K57 OCT 252 0*
505 K60 OCT 260 00 (BCI ZERO)
506 K61 OCT 271 09
507 K68 EQU K19
508 K101 OCT 1
509 K102 OCT 2
510 K103 OCT 3
511 K104 OCT 4
512 K105 OCT 5
513 K106 OCT 6
514 K107 OCT 7
515 K109 DEC 16
516 K100 OCT 377
517 K111 OCT 37777
518 K110 DEC -17
519 K115 OCT 170777
520 K116 OCT 177400
521 K117 DEC -27
522 K118 OCT 777
523 K119 OCT 177000
524 K120 DEC -15
525 K122 OCT 040000
526 K123 DEC -1
527 K124 DEC 9
528 K125 DEC 8
529 K126 DEC 10
530 K127 DEC 11
531 K128 DEC 12
532 K129 DEC 13
533 K131 DEC -14
534 K132 OCT 22
535 K134 OCT 17
536 K137 OCT 24002
537 K138 OCT 25
538 K139 OCT 24
539 CRET OCT 215 0 C/R
540 ZERO OCT 0
541 HBIT OCT 140000 HIGH BITS FOR ALPHA DATA
542 KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT
543 MIN2 DEC -2 -2
544 HC2 OCT 340
545 K357 OCT 357
546 *
547 *
548 DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET
549 * BY THE FORTRAN IOS SUBROUTINE.)
550 L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS)
551 * THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER
552 * TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS
553 * 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL
554 * CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL
555 * LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER
556 * CONFIGURATION.
557 ORG '1000
558 PZE DP-4,1 (100)
559 PZE DP-3,1 (101) DATA POOL REFERENCES
560 PZE DP-2,1 (102)
561 PZE DP-1,1 (103)
562 PZE DP,1 (104)
563 PZE DP+1,1 (105)
564 PZE DP+2,1 (106)
565 PZE DP+3,1 (107)
566 PZE DP+4,1 (108)
567 PZE DP+9,1 (111)
568 PZE DP+6,1 (112)
569 PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS
570 *
571 *
572 ORG 1
573 JST ER00 THIS INSTRUCTION REACHED ONLY IF THE
574 BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE.
575 *
576 *
577 *
578 *
579 * *******************
580 * *START OF COMPILER*
581 * *******************
582 *
583 ORG '1000
584 *
585 *
586 *
587 * - A0 COMP ENT EMPTY BUFFERS
588 LRL 15
589 STA LIBF SET SPECIAL LIBRARY FLAG
590 LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS)
591 A0 CALL F4$INT INITIALIZE I/O DEVICES
592 LDA K108
593 STA CC CC = 73
594 JST IC00 INPUT COLUMN
595 A051 LDA A090
596 STA XR
597 LDA A092 LOC, OF INDEX PUSH-DOWN BUFFER
598 STA SAV9 INITIALIZE PUSH-DOWN BUFR,
599 CRA
600 STA A+M,1 SET M VARIABLES TO ZERO
601 STA NAMF+M,1
602 IRS XR
603 JMP *-3
604 STA IFLG
605 STA PKF
606 JST FS00 INITIALIZE OUTPUT BUFFER
607 CMA
608 STA LSTF LSTF NOT EQ 0
609 STA LSTP LSTP NOT EQ 0
610 STA EBAR EBAR SET NEGATIVE
611 LDA L0
612 STA ICSW
613 STA E0 INITIALIZE EQUIVALENCE TABLE
614 STA L INITIALIZE TRIAD TABLE POINTER
615 JST PRSP SET PRINT BUFFER TO SPACES
616 LDA K134
617 STA DO INITIALIZE DO TABLE POINTER
618 SUB K138
619 STA A091
620 CRA
621 STA ID
622 A055 IRS ID ESTABLISH CONSTANTS
623 JST AI00
624 IRS A091
625 JMP A055
626 LDA K81
627 STA ID
628 STA ID+1
629 STA ID+2
630 CRA
631 LRL 32 (B)=0 IM=NO USAGE
632 LDA K101 (A)=1 IU=SUBR
633 JST AA00 ASSIGN (SPECIAL)
634 JST STXA SET POINTER A INTO INDEX AND (A)
635 STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK)
636 ADD K122 ='40000 (IU=SUBR)
637 STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFI
638 JMP C7 GO TO STMNT INPUT
639 M EQU 30
640 A090 DAC* -M,1
641 A091 PZE 0
642 A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER
643 *
644 *
645 *
646 * **************
647 * *INPUT COLUMN*
648 * **************
649 *
650 * INPUT NEXT CHARACTER
651 * IGNORE BLANKS
652 * CHECK FOR COMMENTS
653 * IC02 SET AS FOLLOWS -
654 * NORMAL - ICIP
655 * INITIAL SCAN -ICSR
656 IC00 DAC ** LINK STORE
657 JST SAV SAVE INDEX
658 LDA CC IF CC = 73, GO TO IC 10
659 SUB K108
660 SZE
661 JMP IC19 ELSE, GO TO IC
662 IC10 LDA ICSW IF ICSW. GO TO IC12
663 SNZ
664 JMP IC24 ELSE, GO TO IC24
665 IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE
666 DAC CI
667 LDA CI
668 LGR 8 GO 70 IC 14
669 CAS K16 =(C)
670 JMP *+2
671 JMP IC30 COMMENT CARD (IGNORE)
672 SUB K15 =($)
673 SNZ
674 JMP IC18 CONTROL CARD (IGNORE COLUMN 6)
675 LDA K357 IF CARD COL, SIX IS
676 ANA CI+2 ZERO OR BLANK, GO TO IC18
677 SUB K8
678 SZE
679 JMP IC26 ELSE, GO TO IC26
680 IC18 STA CC CC = 0.
681 LDA CI+2 CI(6) = SPECIAL
682 ANA K116
683 ADD HC2 ='340
684 STA CI+2
685 LDA CRET
686 JMP IC20 TC = C.R.
687 IC19 LDA CC TC = CI(CC)
688 SUB K101
689 LGR 1
690 STA XR
691 LDA CI,1
692 SSC
693 LGR 8
694 ANA K100
695 IC20 STA TC
696 IRS CC CC = CC+1
697 IC22 JST RST RESTORE INDEX
698 JMP* IC00 RETURN
699 IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN
700 STA TC
701 JMP IC22 GO TO IC22
702 IC26 JST LIST LIST, CONTINUATION CARD
703 LDA K107 CC = 7. IGNORE STATEMENT NO.
704 STA CC
705 JMP IC19 G0 TO IC19
706 IC30 JST LIST PRINT CARD IMAGE
707 JMP IC12 READ IN NEW CARD
708 K16 OCT 303 0C
709 K108 DEC 73
710 KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER
711 CI BSS 40
712 BCI 20,
713 *
714 *
715 *
716 * ****************
717 * *UNINPUT COLUMN*
718 * ****************
719 * BACK UP ONE COLUMN
720 *
721 UC00 DAC **
722 IMA CC CC= CC-1
723 SUB K101 RETAIN (A)
724 IMA CC
725 JMP* UC00
726 *
727 *
728 * *****************
729 * *INPUT CHARACTER*
730 * *****************
731 * INPUT ONE CHARACTER FROM EITHER
732 * 1, INPUT BUFFER (EBAR POSITIVE) OR
733 * 2, EQUIVALENCE BUFFER (EBAR NEGATIVE)
734 *
735 CH00 DAC **
736 LDA EBAR IF EBAR 7 0,
737 SMI
738 JMP CH10 G0 10 CH10
739 CH03 JST IC00 INPUT COLUMN
740 SUB K8 IF BLANK, REPEAT
741 SNZ
742 JMP CH03
743 LDA TC ELSE,
744 *
745 CH04 CAS CH13 ='301
746 NOP
747 JMP CH06
748 CAS K61 ='271
749 JMP CH05
750 NOP
751 CAS K15 ='244
752 JMP *+2
753 JMP CH05-1
754 CAS K60 ='260
755 NOP
756 CRA ALPHA NUMERIC CHARACTER
757 CH05 STA DFL DELIMITER ENTRY
758 LDA TC EXIT WITH TC IN A
759 JMP* CH00
760 CH06 CAS K63 ='332
761 JMP CH05
762 NOP
763 JMP CH05-1
764 CH08 STA DFL
765 JMP* CH00
766 CH10 LDA E IF E = EBAR
767 CAS EBAR
768 JMP *+2
769 JMP CH12 GO TO CH12
770 STA 0 SET E INTO INDEX
771 LLL 16 SET (B) TO ZERO
772 LDA DP,1 CURRENT CHARACTER WORD
773 LLR 8
774 STA DP,1 SAVE REMAINING CHARACTER IF ANY
775 IAB
776 STA TC TC=LEFTMOST CHARACTER
777 SZE SKIP IF NEW CHARACTER WORD NEEDED
778 JMP CH04
779 LDA E E=E-1
780 SUB K101 =1
781 STA E
782 JMP CH10 PICK UP NEXT CHARACTER WORD
783 CH12 SSM MAKE E MINUS
784 STA EBAR
785 JMP C4 GO TO ASSIGN SPEC
786 K63 OCT 332 0Z
787 CH13 OCT 301
788 *
789 *
790 * *************
791 * *INPUT DIGIT*
792 * *************
793 * A IS ZERO IF NOT DIGIT
794 *
795 ID00 DAC ** INPUT DIGIT
796 JST CH00 INPUT A CHAR
797 CAS K61 ='271 (9)
798 JMP* ID00 (A) = TC
799 JMP ID10 ELSE, (A) = 0
800 CAS K60 RETURN
801 NOP
802 JMP *+2
803 JMP* ID00
804 ID10 CRA
805 JMP* ID00
806 *
807 *
808 * **********************
809 * *INPUT (A) CHARACTERS*
810 * **********************
811 * CHAR COUNT IN XR, TERMINATES WITH EITHER
812 * 1, CHAR COUNT -1 = ZERO OR
813 * 2, LAST CHAR IS A DELIMITER
814 *
815 IA00 DAC **
816 TCA SET COUNTER
817 STA IA99
818 JST IA50 EXCHANGE IBUF AND ID
819 CRA
820 STA NTID NTID = 0
821 IA10 JST CH00 INPUT A CHARACTER
822 JST PACK
823 LDA DFL IF DFL NOT ZERO,
824 SZE CONTINUE
825 JMP IA20 ELSE,
826 IRS IA99 TEST COUNTER
827 JMP IA10 MORE CHARACTERS TO INPUT
828 IA20 JST IA50 EXCHANGE ID AND IBUF
829 JMP* IA00 RETURN
830 IA50 DAC ** EXCHANGE IBUF AND ID
831 JST SAV SAVE INDEX
832 LDA IA90
833 STA XR
834 LDA IBUF+3,1
835 IMA ID+3,1
836 STA IBUF+3,1
837 IRS XR
838 JMP *-4
839 JST RST RESTORE INDEX
840 LDA NTID
841 JMP* IA50
842 IA90 OCT -3
843 IA99 PZE 0
844 *
845 *
846 * *****************
847 * *FINISH OPERATOR*
848 * *****************
849 * WRAP UP LOGICAL/RELATIONAL OPERATORS
850 *
851 FN00 DAC **
852 LDA DFL IF DFL NOT . ,
853 STA IBUF
854 SUB K10
855 SZE
856 JMP FN05 GO TO FN05
857 LDA K104
858 JST IA00
859 FN05 LDA K110 USE TABLE TO CONVERT
860 STA XR OPERATOR
861 FN10 LDA FN90+17,1
862 CAS IBUF
863 JMP *+2
864 JMP FN20
865 IRS XR
866 JMP FN10
867 LDA TC
868 JMP* FN00
869 FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR
870 STA TC SET INTO TC
871 JMP* FN00
872 FN90 OCT 253,255,252,257 +-*/
873 BCI 9,NOANORLTLEEQGEGTNE
874 OCT 275,254 =,
875 FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17
876 *
877 *
878 * ***********
879 * *INPUT DNA*
880 * ***********
881 * BASIC INPUT ROUTINE, HANDLES FOLLOWING -
882 * CONSTANT CONVERSION
883 * MODE TYPING (CONSTANTS, IMPLIED/VARIABLES)
884 * ALL OPERATORS (TERMINATE ITEM)
885 *
886 ID BSS 4
887 TID EQU ID TEMP STORE FOR ID
888 IBUF BSS 3 3-WORD BUF
889 TIDN PZE 0
890 K155 OCT 177727 -41
891 K156 OCT 024000 1085
892 K157 OCT 007777
893 K158 OCT 074000
894 F1 PZE 0 SIGN FLAG
895 F2 PZE 0
896 F3 PZE 0 INPUT EXPONENT
897 F4 PZE 0 NO, FRAC. POSITIONS
898 F5 PZE 0 TEMP DELIMITER STORE
899 F6 PZE 0
900 L4 PZE 0
901 HOLF PZE 0 HOLLERITH FLAG
902 DN00 DAC **
903 DN01 CRA
904 STA HOLF SET HOLF =0
905 STA F4 F4 = 0
906 STA IU
907 STA NT IU=NT=NTID=0
908 STA NTID
909 JST BLNK CLEAR OUT TID = ID
910 DAC TID
911 JST BLNK
912 DAC F1 F1,F2,F3 = 0
913 DN06 CRA
914 STA IM
915 STA DNX2
916 DN07 JST ID00 INPUT DIGIT
917 SZE
918 JMP DN14 (A) NON-ZERO, G0 T0 DN14
919 DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST
920 ANA K158 POSITION COUNT IF NECESSARY,
921 SZE
922 JMP SKIP
923 ADD IM
924 ARS 1
925 ADD F4 F4 = F4+1 IF NO OVERFLOW
926 STA F4 AND IM ALREADY SET TO REAL
927 LDA K101
928 STA NT NT=1
929 ADD K101
930 STA IU IU = VAR/COD
931 JST SFT SHIFT ID LEFT
932 DAC ID
933 JST MOV3 MOVE TO TEMP STORE
934 JST SFT
935 DAC ID
936 JST SFT
937 DAC ID
938 JST AD3 ID = 10*ID+TC
939 JST BLNK
940 DAC DNX1
941 LDA TC
942 SUB K60
943 STA DNX1
944 JST AD3
945 JMP DN07
946 SKIP LDA MIN2
947 ADD IM
948 ARS 1
949 ADD F4
950 STA F4
951 JMP DN07
952 DN14 LDA IM IM = REAL
953 SUB K102
954 SZE
955 JMP DN50 NO, GO TO DN50
956 DN16 LDA K10 YES,
957 DN17 STA F5 F5 = '.'
958 LDA DFL IF DFL =0, GO SO DN20 (5)
959 SZE
960 JMP DN90 ELSE GO TO DN90 (9)
961 DN20 LDA TC IF TC = D, GO TO DN26
962 SUB K11
963 SNZ
964 JMP DN26
965 SUB K101 ELSE, IF TC = E, GO TO DN22
966 SNZ
967 JMP DN22 TERMINATOR = E
968 JST UC00
969 LDA K10 ='256 (,)
970 STA DFL SET DELIMITER FLAG
971 LDA K101 =1
972 STA IM SET ITEM MODE TO INTEGER
973 JMP DN67 FINISH OPERATOR AND EXIT
974 *
975 DN22 JST ID00 INPUT DIGIT
976 SNZ IF (A) = 0, GO TO DN30
977 JMP DN30
978 LDA TC IF TC = -, GO TO DN28
979 SUB K12
980 SNZ
981 JMP DN28
982 ADD K102
983 SNZ
984 JMP DN29
985 LDA F5
986 STA DFL
987 JST UC00 UN-INPUT COL
988 DN24 JST FN00 FINISH OPERATOR
989 DN25 LDA K101 IM = INT
990 STA IM
991 LDA ID+1 IF ID IS TOO BIG TO
992 SZE BE AN INTEGER (>L2),
993 JMP DN69 GO TO DN69 (20)
994 LDA ID+2
995 SZE
996 JMP DN69
997 JMP DN84 OTHERWISE, GO TO DN84(12)
998 DN26 LDA K106 IM = DBL
999 STA IM
1000 JMP DN22
1001 DN28 LDA K101 F2 = 1
1002 STA F2
1003 DN29 JST ID00 INPUT DIGIT
1004 SZE IF (A) = 0, GO TO DN30 (8.5)
1005 JMP DN69 ELSE, GO TO DN69 (20)
1006 DN30 LDA F3 F3 = 10 * F3
1007 ALS 3
1008 IMA F3 F3 = F3 +TC
1009 ALS 1
1010 ADD F3
1011 ADD TC INPUT DIGIT
1012 SUB K60
1013 STA F3 IF (A) = 0, GO TO DN30 (8.5)
1014 JST ID00 ELSE, GO TO DN90 (9)
1015 SZE
1016 JMP DN90
1017 JMP DN30
1018 DN50 LDA K102 IM=REA
1019 STA IM
1020 LDA TC IF TC = ., GO TO DN54
1021 SUB K10
1022 SNZ
1023 JMP DN54 ELSE,
1024 LDA NT
1025 SNZ IF NT = 0, GO TO DN72
1026 JMP DN72
1027 LDA TC IF TC = H, GO TO DN9H (22)
1028 SUB K14
1029 SNZ
1030 JMP DN9H
1031 LDA DFL IF DFL = 0,
1032 SZE GO TO DN16 (4.9)
1033 JMP DN25 ELSE, GO TO DN25
1034 JMP DN16
1035 DN54 JST ID00 INPUT DIGIT
1036 SNZ
1037 JMP DN10 IF (A) = 0, GO TO DN10 (3)
1038 LDA NT
1039 SNZ IF NT = 0, GO TO DN56
1040 JMP DN56
1041 LDA TC F5 = TC
1042 JMP DN16 GO TO DN16 (4)
1043 DN56 CRA
1044 STA TC TC = )
1045 DN58 JST UC00 UN-INPUT A COLUMN,
1046 LDA F1 IF F1 = 0, GO TO DN60
1047 SZE
1048 JMP DN63 ELSE, GO TO DN63 (15)
1049 DN60 LDA K106
1050 JST IA00 INPUT (6) CHARS
1051 JST CIB IF IBUF = TRUE.,
1052 DAC K1+3,1
1053 JMP DN64
1054 JST CIB IF IBUF = FALSE.,
1055 DAC K2+3,1 GO TO DN66 (16)
1056 JMP DN66
1057 JST CIB CHECK FOR .NOT. OPERATOR
1058 DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR
1059 JMP DN9N OPERATOR IS .NOT.
1060 *
1061 * TAPE 1 OF 5 - END
1062 MOR
My complete H316 universe