+* C210-001-6601 (FRTN) 3C NO.180463000 REV. D
+*
+* TAPE 1 OF 5 - BEGIN
+*
+*
+* COMPUTER. DDP-116,516
+*
+*
+*
+*
+* PROGRAM CATEGORY- COMPILER
+*
+*
+*
+*
+* PROGRAM TITLE. FRTN
+* EXPANDED FORTRAN IV COMPILER
+* FOR DDP-116,516
+*
+*
+*
+*
+*
+*
+*
+* APPROVAL DATE
+*
+*
+* PROG--------------------- ------------
+*
+*
+* SUPR---------------------- ------------
+*
+*
+* QUAL---------------------- ------------
+*
+*
+* NO. OF PAGES ------------
+*
+* REVISIONS
+*
+* REV. D ECO 5249
+* REV. C ECO 3824 10-31-66
+* REV. B ECO 3476 09-19-66
+* REV. A 06-08-66
+*
+* AUTHOR
+*
+* HONEYWELL. INC. - COMPUTER CONTROL DIVISION
+*
+*
+* PURPOSE
+*
+* THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV
+* PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE
+* DDP-116 OR DDP-516.
+*
+*
+* RESTRICTIONS
+*
+* MINIMUM 8K CORE STORAGE
+*
+*
+* STORAGE
+*
+* 6682 (DECIMAL)
+* 15034 (OCTAL)
+*
+*
+* USE
+*
+*
+* ********************************
+*
+* *FORTRAN-IV OPERATING PROCEDURE*
+* ********************************
+*
+* 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE'
+* (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES
+*
+* 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE
+* SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE
+* SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START.
+*
+* 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY).....
+* 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS
+* OPTION IS USED WHEN COMPILING THOSE PARTS OF THE
+* LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE
+* LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO
+* GENERATE SPECIAL CODING.
+*
+* 2-7....NOT ASSIGNED
+*
+* 8-10...INPUT DEVICE SELECTION
+* 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER)
+* 2 = NCR CARD READER
+* 3 = DIGITRONICS PAPER TAPE READER
+* 4 = MAGNETIC TAPE ( UNIT 1 )
+* 5-7 = (SPARES)
+*
+* 11-13..SYMBOLIC LISTING SELECTION
+* 0. SUPPRESS ALL SYMBOLIC LISTINGS
+* 1. ASR-33/35 TYPEWRITER
+* 2. LINE PRINTER
+* 3 = ( SPARE )
+* 4 = LISTING ON MAGNETIC TAPE UNIT 2
+* 5-7 = (SPARES)
+*
+* 14-16..BINARY OUTPUT SELECTION
+* 0. SUPPRESS BINARY OUTPUT.
+* 1. BRPE HIGH SPEED PAPER TAPE PUNCH
+* 2. ASR BINARY OUTPUT ASR/33
+* 3. ASR BINARY OUTPUT ASR/35
+* 4 = MAGNETIC TAPE OUTPUT
+* 5-7 (SPARES)
+*
+*
+* 4. SENSE SWITCH SETTINGS AND MEANINGS.......
+* 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE
+* SIDE-BY-SIDE OCTAL INFORMATION.
+* 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET).
+* 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING
+* THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT
+* STATUS OF THE I/O KEYBOARD, IT MAY BE
+* CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING
+* SSW-3 AND PRESSING START TO CONTINUE.
+* 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED
+* IN THE OBJECT CODING BEING GENERATED REGARDLESS OF
+* ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR
+* OVERRIDE).
+*
+* 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER
+* AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A
+* LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF
+* TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE
+* PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START'
+* TO PROCESS THE NEXT PROGRAM (BATCH COMPILING).
+*
+* FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS
+* PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT
+* THE COMPILATION.
+*
+*
+* ERRORS
+*
+* THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A
+* SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION.
+* *************************
+* *DATA POOL ENTRY FORMATS*
+* *************************
+*
+* THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION
+* 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS
+* AT THE END OF THE COMPILER AND EXTENDS TOWARD THE
+* END OF MEMORY.
+*
+* TDCCCCCCCCCCCCCC....DP(A+4)
+* CCCCCCCCCCCCCCCC....DP(A+3)
+* CCCCCCCCCCCCCCCC....DP(A+2)
+* IIAAAAAAAAAAAAAA....DP(A+1)
+* NRRRMMMLLLLLLLLL....DP(A)
+*
+* T = TRACE TAG
+* D = DATA TAG
+* C = SIX 8-BIT CHAR. OR BINARY CONSTANT
+* I = ITEM USAGE (IU)
+* 0 = NO USAGE 2 = VAR/CONSTAN^
+* 1 = SUBPROGRAM 3 = ARRAY
+* A = ASSIGNMENT ADDRESS
+* N = NAME TAG (NT)
+* 0 = NAME 1 = CONSTANT
+* R = ADDRESS TYPE (AT)
+* 0 = ABSOLUTE 3 = STRING-REL
+* 1 = RELATIVE 4 = COMMON
+* 2 = STRING-ABS 5 = DUMMT
+* M = ITEM MODE (IM)
+* 1 = INTEGER 5 = COMPLEX
+* 2 = REAL 6 = DOUBLE
+* 3 = LOGICAL
+* 4=COM/EQU LINK
+* 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT
+* TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT
+* A DO-LOOP, EACH ENTRY IS 5 WORDS.
+* 00IIIIIIIIIIIII
+* 00TTTITTTTTTTTT
+* 00XXXXXXXXXXXXX
+* 00UUUUUUUUUUUUUU
+* 00NNNNNNNNNNNNNN
+* I = INITIAL VALUE/OR RPL
+* T = TERMINAL VALUE
+* X = INDEX
+* U = INCREMENT
+* N = STATEMENT NUMBER
+*
+* 3. THE EXPRESSION TABLE (A0I TABLE) 'FLOATS' ON TOP
+* THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES.
+*
+* NOOOOOOOOIIIIIII.....DP(I+1)
+* 00AAAAAAAAAAAAAAAA...DP(I)
+* N = NEGATION INDICATOR
+* O = OPERATOR
+* I = INDEX (OPERATOR LEVEL)
+* A = ASSIGNMENT TABLE REFERENCE
+* 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND
+* IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE
+* COMPILER. EACH ENTRY IS THREE WORDS LONG.
+*
+* S000000000PPPPPP.....DP(L+2)
+* 0011111111111111.....DP(L+1)
+* 0022222222222222.....DP(L)
+* S = TEMP STORAGE INDICATOR
+* P = OPERATOR
+* 1 = FIRST OPERAND ADDRESS
+* 2 = SECOND OPERAND ADDRESS
+ ABS
+ ORG '100
+*
+* ************************************
+* * DIRECTORY OF FORTRAN IV COMPILER *
+* ************************************
+*
+*
+*
+*..............ENTRANCE GROUP
+ DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE
+ DAC DP DATA POOL START
+*
+*..............INPUT GROUP
+ DAC IC00 (IPG1) INPUT COLUMN
+ DAC UC00 (IPG2) UNINPUT COLUMN
+ DAC CH00 (IPG3) INPUT CHARACTER
+ DAC ID00 (IPG4) INPUT DIGIT
+ DAC IA00 (IPG5) INPUT (A) CHARACTERS
+ DAC FN00 (IPG6) FINISH OPERATOR
+ DAC DN00 (IPG7) INPUT DNA
+ DAC II00 (IPG8) INPUT ITEM
+ DAC OP00 (IPG9) INPUT OPERAND
+ DAC NA00 (IPG10) INPUT NAME
+ DAC IG00 (IPG11) INPUT INTEGER
+ DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT
+ DAC IR00 (IPG13) INPUT INTEGER VARIABLE
+ DAC IS00 (IPG14) INPUT STATEMENT NUMBER
+ DAC XN00 (IPG15) EXAMINE NEXT CHARACTER
+ DAC SY00 INPUT STMBOL
+*
+*..............TEST GROUP
+ DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R)
+ DAC IP00 (TSG2) )-INPUT OPERATOR
+ DAC A1 (TSG3) C/R TEST
+ DAC B1 (TSG4) , OR C/R TEST
+ DAC NU00 (TSG5) NO USAGE TEST
+ DAC NC00 (TSG6) NON CONSTANT TEST
+ DAC NS00 (TSG7) NON SUBPROGRAM TEST
+ DAC AT00 (TSG8) ARRAY TEST
+ DAC IT00 (TSG9) INTEGER TEST
+ DAC NR00 (TSG10) NON REL TEST
+*
+*..............ASSIGNMENT GROUP
+ DAC AS00 (ASG1) ASSIGN ITEM
+ DAC TG00 (ASG2) TAG SUBPROGRAM
+ DAC TV00 (ASG3) TAG VARIABLE
+ DAC FA00 (ASG4) FETCH ASSIGN
+ DAC FL00 (ASG5) FETCH LINK
+ DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION
+ DAC DM00 (ASG7) DEFINE IM
+ DAC DA00 (ASG8) DEFINE AF
+ DAC AF00 (ASG9) DEFINE AFT
+ DAC LO00 (ASG10) DEFINE LOCATION
+ DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT
+ DAC AA00 (ASG12) ASSIGN SPECIAL
+ DAC NXT GET NEXT ENTRY FROM ASSGN TABLE
+ DAC BUD BUILD ASSIGNMENT TABLE ENTRT
+*
+*..............CONTROL GROUP
+ DAC B6 (CNG1) JUMP
+ DAC C5 ILL TERM
+ DAC C6 (CNG2) CONTINUE
+ DAC C7 (CNG3) STATEMENT INPUT
+ DAC C8 (CNG4) STATEMENT SCAN
+ DAC A9 (CNG5) STATEMENT IDENTIFICATION
+ DAC NP00 (CNG6) FIRST NON-SPEC CHECK
+*
+*..............SPECIFICATIONS GROUP
+ DAC EL00 (SPG1) EXCHANGE LINKS
+ DAC NM00 (SPG2) NON COMM0N TEST
+ DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST
+ DAC SC00 (SPG4) INPUT SUBSCRIPT
+ DAC IL00 (SPG5) INPUT LIST ELEMENT
+ DAC R1 (SPG6) FUNCTION
+ DAC R2 SUBROUTINE
+ DAC A3 (SPG7) INTEGER
+ DAC A4 REAL
+ DAC A5 DOUBLE PRECISION
+ DAC A6 COMPLEX
+ DAC A7 LOGICAL
+ DAC B2 (SPG8) EXTERNAL
+ DAC B3 (SPG9) DIMENSION
+ DAC B7 INPUT DIMENSION
+ DAC B4 (SPG10) COMMON
+ DAC B5 (SPG11) EQUIVALENCE
+ DAC C2 (SPG12) RELATE COMMON ITEMS
+ DAC C3 (SPG13) GROUP EOUIVALENCE
+ DAC C4 (SPG14) ASSIGN SPECIFICATIONS
+ DAC W4 (SPG15) DATA
+ DAC R3 (SPG16) BLOCK DATA
+ DAC TRAC (SPG17) TRACE
+*
+*..............PROCESSOR GROUP
+ DAC V3 (PRG1) IF
+ DAC R7 (PRG2) GO TO
+ DAC IB00 INPUT BRANCH LIST
+ DAC W3 (PRG3) ASSIGN
+ DAC C9 (PRG5) DO
+ DAC V7 (PRG6) END FILE
+ DAC V6 BACKSPACE
+ DAC V8 REWIND
+ DAC V5 (PRG7) READ
+ DAC V4 WRITE
+ DAC V2 (PRG8) FORMAT
+ DAC SI00 INPUT FORMAT STRING
+ DAC IN00 INPUT NUMERIC FORMAT STRING
+ DAC NZ00 NON ZERO STRING TEST
+ DAC W8 (PRG9) PAUSE
+ DAC W7 STOP
+ DAC R8 (PRG10) CALL
+ DAC G2 ASSIGNMENT STATEMENT
+ DAC R9 (PRG11) RETURN
+ DAC G1 (PRG12) STATEMENT FUNCTION
+ DAC W5 (PRG13) END
+*
+*..............PROCESSOR SUBROUTINES GROUP
+ DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK
+ DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING
+ DAC DP00 (PSG3) DO INPUT
+ DAC DS00 (PSG4) DO INITIALIZE
+ DAC DQ00 (PSG5) DO TERMINATION
+ DAC EX00 (PSG6) EXPRESSION
+ DAC CA00 (PSG7) SCAN
+ DAC ST00 TRIAD SEARCH
+ DAC TC00 TEMP STORE CHECK
+ DAC ET00 (PSG8) ENTER TRIAD
+ DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE
+*
+*..............OUTPUT GROUP
+ DAC OL00 (OPG1) OUTPUT OBJECT LINK
+ DAC OI00 (OPG2) OUTPUT I/O LINK
+ DAC CN00 (OPG3) CALL NAME
+ DAC OK00 (OPG4) OUTPUT PACK
+ DAC OB00 (OPG5) OUTPUT OA
+ DAC OT00 (OPG6) OUTPUT TRIADS
+ DAC OM00 (OPG7) OUTPUT ITEM
+ DAC OR00 (OPG8) OUTPUT REL
+ DAC OA00 OUTPUT ABS
+ DAC OS00 OUTPUT STRING
+ DAC OW00 (OPG9) OUTPUT WORD
+ DAC PU00 PICKUP
+ DAC FS00 (OPG10) FLUSH
+ DAC TRSE (OPG11) OUTPUT TRACE COUPLING
+ DAC PRSP SET BUFFER TO SPACES
+*
+*..............MISC. GROUP
+ DAC AD3 ADD TWO 3 WORD INTEGERS
+ DAC IM00 MULTIPLY (A) BY (B)
+ DAC STXA SET A INTO INDEX
+ DAC STXI SET I INTO INDEX
+ DAC NF00 SET FS INTO NAMF
+ DAC BLNK SET AREA TO ZEROS
+ DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE
+ DAC CIB COMPARE IBUF TO A CONSTANT
+ DAC SAV SAVE INDEX IN PUSH-DOWN STACK
+ DAC RST RESET INDEX FROM PUSH-DOWN STACK
+ DAC PACK
+ DAC ER00 ERROR OUTPUT
+ DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.)
+ DAC SFT SHIFT LEFT 1 (TRIPLE PRES.)
+ DAC LIST
+*
+*
+* ****************************
+* *CONSTANT AND VARIABLE POOL*
+* ****************************
+*
+XR EQU 0 INDEX REGISTER
+* THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING
+* PROGRAM INITIALIZATION
+A EQU '40 ASSIGNMENT TABLE INDEX
+I EQU A+1 EXPRESSION TABLE INDEX
+C EQU A+2
+ASAV EQU A+3
+L EQU A+4
+MFL EQU A+5 MODE FLAG
+SFF EQU A+6 FUNCTION FLAG
+SBF EQU A+7 SUBFUNCTION FLAG
+SXF EQU A+8 POSSIBLE CPX FLAG
+SPF EQU A+9 PEC. FLAG
+TCF EQU A+10 TEMP STORE COUNT
+IFF EQU A+11
+ABAR EQU A+12 BASE OF ASSIGN TABLE
+XST EQU A+13 FIRST EXECUTABLE STMNT.
+CFL EQU A+14 MON FLAG
+D EQU A+15 DO INDEX
+RPL EQU A+16 RELATE PROGRAM LOCATION
+BDF EQU A+17 LOCK DATA FLAG
+SLST EQU A+18 SOURCE LIST
+OBLS EQU A+19 OUTPUT BINARY LIST
+BNOT EQU A+20 BINART OUTPUT FLAG
+TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.)
+TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN
+* AN EXPRESSION (FOR USE BY TRACE).
+SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET)
+LIF EQU A+24 LOGICAL IF FLAG
+LSTN EQU A+25 LAST STATEMENT NO.
+LSTF EQU A+26 LAST STATEMENT FLAG
+LSTP EQU A+27 LAST STATEMENT STOP
+SDSW EQU A+28 STATEMENT I0 SWITCH
+*
+NAMF EQU '570 NAME FUNCTION
+ND EQU NAMF+1 NO OF DIMENSIONS
+NS EQU '572 NO OF SUBSCRIPTS
+NT EQU NS+1 NAME TAG
+NTF EQU NS+2 NAME TAG FLAG
+NTID EQU NS+3 NO. WORDS IN TID
+O1 EQU NS+4 OPERATOR 1
+O2 EQU NS+5 OPERATOR 2
+P EQU NS+6
+PCNT EQU NS+7
+OCNT EQU NS+8 OUTPUT COUNT
+S0 EQU NS+9
+S1 EQU NS+10 SUBSCRIPT NO.1
+S2 EQU NS+11 SUBSCRIPT NO.2
+S3 EQU NS+12 SUBSCRIPT NO.3
+TC EQU NS+13 TERMINAL CHAR
+TT EQU NS+14
+TYPE EQU NS+15
+X EQU NS+16 ARRAY INDICES
+X1 EQU NS+17
+X2 EQU NS+18
+X3 EQU NS+19
+X4 EQU NS+20
+NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS
+ATA EQU NS+22
+IMA EQU NS+23
+CLA EQU NS+24
+IUA EQU NS+25
+DTA EQU NS+26
+TTA EQU NS+27
+*..........ADJUST THIS ORG IF THE SIZE OF THE CONSTAST POOL IS MODIFIED
+ ORG '630
+AF PZE 0 ADDRESS FIELD
+GF EQU AF
+AT PZE 0 ADDRESS TYPE
+CODE PZE 0 OUTPUT CODE
+D0 PZE 0 DIMENSIONS
+D1 PZE 0
+D2 PZE 0
+D3 PZE 0
+D4 PZE 0
+DF PZE 0 DATA FLAG
+NF PZE 0
+B PZE 0
+DFL PZE 0 DELIMITER FLAG
+E OCT 0 EQUIVALENCE INDEX
+EP PZE 0 E-PRIME
+E0 PZE 0 E-ZERO
+FTOP PZE 0 OUTPUT COMMAND
+GFA PZE 0
+ICSW PZE 1 INPUT CONTROL SWITCH
+IFLG PZE 0 I-FLAG
+IM PZE 0 ITEM MODE
+IOF PZE 0 I-0 FLAG
+IU PZE 0 ITEM USAGE
+KBAR PZE 0 TEM STORE
+KPRM PZE 0 TEM STORE
+EBAR OCT -1 E-BAR
+DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT)
+CC PZE '111 CARD COLUMN COUNTER
+DCT PZE 0 DUMMY ARGUMENT COUNT
+F PZE 0 TRIAD TABLE INDEX
+CL PZE 0 ASSIGNMENT ITEMS UNPACKED
+DT PZE 0
+FLT1 PZE 0 FETCH LINK CL POINTER LOCATION
+LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET)
+*..........CONSTANTS USED BY THE COMPILER
+K4 OCT 251 0)
+K5 OCT 254 0,
+K8 OCT 240 0-SPACE
+K9 OCT 257 0/
+K10 OCT 256 0.
+K12 OCT 255 0-
+K13 OCT 253 0+
+K15 OCT 244 0$
+K16X OCT 16
+K17 OCT 250 0(
+K18 OCT 275 0=
+K19 BCI 1,DO DO
+K34 OCT 324 0T
+K35 OCT 317 0O
+K40 BCI 1,WN
+K41 BCI 1,RN RN
+K42 BCI 1,CB
+K43 OCT 311 0I
+K44 OCT 321 0Q
+K45 EQU K34 0T
+K57 OCT 252 0*
+K60 OCT 260 00 (BCI ZERO)
+K61 OCT 271 09
+K68 EQU K19
+K101 OCT 1
+K102 OCT 2
+K103 OCT 3
+K104 OCT 4
+K105 OCT 5
+K106 OCT 6
+K107 OCT 7
+K109 DEC 16
+K100 OCT 377
+K111 OCT 37777
+K110 DEC -17
+K115 OCT 170777
+K116 OCT 177400
+K117 DEC -27
+K118 OCT 777
+K119 OCT 177000
+K120 DEC -15
+K122 OCT 040000
+K123 DEC -1
+K124 DEC 9
+K125 DEC 8
+K126 DEC 10
+K127 DEC 11
+K128 DEC 12
+K129 DEC 13
+K131 DEC -14
+K132 OCT 22
+K134 OCT 17
+K137 OCT 24002
+K138 OCT 25
+K139 OCT 24
+CRET OCT 215 0 C/R
+ZERO OCT 0
+HBIT OCT 140000 HIGH BITS FOR ALPHA DATA
+KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT
+MIN2 DEC -2 -2
+HC2 OCT 340
+K357 OCT 357
+*
+*
+DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET
+* BY THE FORTRAN IOS SUBROUTINE.)
+L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS)
+* THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER
+* TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS
+* 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL
+* CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL
+* LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER
+* CONFIGURATION.
+ ORG '1000
+ PZE DP-4,1 (100)
+ PZE DP-3,1 (101) DATA POOL REFERENCES
+ PZE DP-2,1 (102)
+ PZE DP-1,1 (103)
+ PZE DP,1 (104)
+ PZE DP+1,1 (105)
+ PZE DP+2,1 (106)
+ PZE DP+3,1 (107)
+ PZE DP+4,1 (108)
+ PZE DP+9,1 (111)
+ PZE DP+6,1 (112)
+ PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS
+*
+*
+ ORG 1
+ JST ER00 THIS INSTRUCTION REACHED ONLY IF THE
+ BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE.
+*
+*
+*
+*
+* *******************
+* *START OF COMPILER*
+* *******************
+*
+ ORG '1000
+*
+*
+*
+* - A0 COMP ENT EMPTY BUFFERS
+ LRL 15
+ STA LIBF SET SPECIAL LIBRARY FLAG
+ LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS)
+A0 CALL F4$INT INITIALIZE I/O DEVICES
+ LDA K108
+ STA CC CC = 73
+ JST IC00 INPUT COLUMN
+A051 LDA A090
+ STA XR
+ LDA A092 LOC, OF INDEX PUSH-DOWN BUFFER
+ STA SAV9 INITIALIZE PUSH-DOWN BUFR,
+ CRA
+ STA A+M,1 SET M VARIABLES TO ZERO
+ STA NAMF+M,1
+ IRS XR
+ JMP *-3
+ STA IFLG
+ STA PKF
+ JST FS00 INITIALIZE OUTPUT BUFFER
+ CMA
+ STA LSTF LSTF NOT EQ 0
+ STA LSTP LSTP NOT EQ 0
+ STA EBAR EBAR SET NEGATIVE
+ LDA L0
+ STA ICSW
+ STA E0 INITIALIZE EQUIVALENCE TABLE
+ STA L INITIALIZE TRIAD TABLE POINTER
+ JST PRSP SET PRINT BUFFER TO SPACES
+ LDA K134
+ STA DO INITIALIZE DO TABLE POINTER
+ SUB K138
+ STA A091
+ CRA
+ STA ID
+A055 IRS ID ESTABLISH CONSTANTS
+ JST AI00
+ IRS A091
+ JMP A055
+ LDA K81
+ STA ID
+ STA ID+1
+ STA ID+2
+ CRA
+ LRL 32 (B)=0 IM=NO USAGE
+ LDA K101 (A)=1 IU=SUBR
+ JST AA00 ASSIGN (SPECIAL)
+ JST STXA SET POINTER A INTO INDEX AND (A)
+ STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK)
+ ADD K122 ='40000 (IU=SUBR)
+ STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFI
+ JMP C7 GO TO STMNT INPUT
+M EQU 30
+A090 DAC* -M,1
+A091 PZE 0
+A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER
+*
+*
+*
+* **************
+* *INPUT COLUMN*
+* **************
+*
+* INPUT NEXT CHARACTER
+* IGNORE BLANKS
+* CHECK FOR COMMENTS
+* IC02 SET AS FOLLOWS -
+* NORMAL - ICIP
+* INITIAL SCAN -ICSR
+IC00 DAC ** LINK STORE
+ JST SAV SAVE INDEX
+ LDA CC IF CC = 73, GO TO IC 10
+ SUB K108
+ SZE
+ JMP IC19 ELSE, GO TO IC
+IC10 LDA ICSW IF ICSW. GO TO IC12
+ SNZ
+ JMP IC24 ELSE, GO TO IC24
+IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE
+ DAC CI
+ LDA CI
+ LGR 8 GO 70 IC 14
+ CAS K16 =(C)
+ JMP *+2
+ JMP IC30 COMMENT CARD (IGNORE)
+ SUB K15 =($)
+ SNZ
+ JMP IC18 CONTROL CARD (IGNORE COLUMN 6)
+ LDA K357 IF CARD COL, SIX IS
+ ANA CI+2 ZERO OR BLANK, GO TO IC18
+ SUB K8
+ SZE
+ JMP IC26 ELSE, GO TO IC26
+IC18 STA CC CC = 0.
+ LDA CI+2 CI(6) = SPECIAL
+ ANA K116
+ ADD HC2 ='340
+ STA CI+2
+ LDA CRET
+ JMP IC20 TC = C.R.
+IC19 LDA CC TC = CI(CC)
+ SUB K101
+ LGR 1
+ STA XR
+ LDA CI,1
+ SSC
+ LGR 8
+ ANA K100
+IC20 STA TC
+ IRS CC CC = CC+1
+IC22 JST RST RESTORE INDEX
+ JMP* IC00 RETURN
+IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN
+ STA TC
+ JMP IC22 GO TO IC22
+IC26 JST LIST LIST, CONTINUATION CARD
+ LDA K107 CC = 7. IGNORE STATEMENT NO.
+ STA CC
+ JMP IC19 G0 TO IC19
+IC30 JST LIST PRINT CARD IMAGE
+ JMP IC12 READ IN NEW CARD
+K16 OCT 303 0C
+K108 DEC 73
+KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER
+CI BSS 40
+ BCI 20,
+*
+*
+*
+* ****************
+* *UNINPUT COLUMN*
+* ****************
+* BACK UP ONE COLUMN
+*
+UC00 DAC **
+ IMA CC CC= CC-1
+ SUB K101 RETAIN (A)
+ IMA CC
+ JMP* UC00
+*
+*
+* *****************
+* *INPUT CHARACTER*
+* *****************
+* INPUT ONE CHARACTER FROM EITHER
+* 1, INPUT BUFFER (EBAR POSITIVE) OR
+* 2, EQUIVALENCE BUFFER (EBAR NEGATIVE)
+*
+CH00 DAC **
+ LDA EBAR IF EBAR 7 0,
+ SMI
+ JMP CH10 G0 10 CH10
+CH03 JST IC00 INPUT COLUMN
+ SUB K8 IF BLANK, REPEAT
+ SNZ
+ JMP CH03
+ LDA TC ELSE,
+*
+CH04 CAS CH13 ='301
+ NOP
+ JMP CH06
+ CAS K61 ='271
+ JMP CH05
+ NOP
+ CAS K15 ='244
+ JMP *+2
+ JMP CH05-1
+ CAS K60 ='260
+ NOP
+ CRA ALPHA NUMERIC CHARACTER
+CH05 STA DFL DELIMITER ENTRY
+ LDA TC EXIT WITH TC IN A
+ JMP* CH00
+CH06 CAS K63 ='332
+ JMP CH05
+ NOP
+ JMP CH05-1
+CH08 STA DFL
+ JMP* CH00
+CH10 LDA E IF E = EBAR
+ CAS EBAR
+ JMP *+2
+ JMP CH12 GO TO CH12
+ STA 0 SET E INTO INDEX
+ LLL 16 SET (B) TO ZERO
+ LDA DP,1 CURRENT CHARACTER WORD
+ LLR 8
+ STA DP,1 SAVE REMAINING CHARACTER IF ANY
+ IAB
+ STA TC TC=LEFTMOST CHARACTER
+ SZE SKIP IF NEW CHARACTER WORD NEEDED
+ JMP CH04
+ LDA E E=E-1
+ SUB K101 =1
+ STA E
+ JMP CH10 PICK UP NEXT CHARACTER WORD
+CH12 SSM MAKE E MINUS
+ STA EBAR
+ JMP C4 GO TO ASSIGN SPEC
+K63 OCT 332 0Z
+CH13 OCT 301
+*
+*
+* *************
+* *INPUT DIGIT*
+* *************
+* A IS ZERO IF NOT DIGIT
+*
+ID00 DAC ** INPUT DIGIT
+ JST CH00 INPUT A CHAR
+ CAS K61 ='271 (9)
+ JMP* ID00 (A) = TC
+ JMP ID10 ELSE, (A) = 0
+ CAS K60 RETURN
+ NOP
+ JMP *+2
+ JMP* ID00
+ID10 CRA
+ JMP* ID00
+*
+*
+* **********************
+* *INPUT (A) CHARACTERS*
+* **********************
+* CHAR COUNT IN XR, TERMINATES WITH EITHER
+* 1, CHAR COUNT -1 = ZERO OR
+* 2, LAST CHAR IS A DELIMITER
+*
+IA00 DAC **
+ TCA SET COUNTER
+ STA IA99
+ JST IA50 EXCHANGE IBUF AND ID
+ CRA
+ STA NTID NTID = 0
+IA10 JST CH00 INPUT A CHARACTER
+ JST PACK
+ LDA DFL IF DFL NOT ZERO,
+ SZE CONTINUE
+ JMP IA20 ELSE,
+ IRS IA99 TEST COUNTER
+ JMP IA10 MORE CHARACTERS TO INPUT
+IA20 JST IA50 EXCHANGE ID AND IBUF
+ JMP* IA00 RETURN
+IA50 DAC ** EXCHANGE IBUF AND ID
+ JST SAV SAVE INDEX
+ LDA IA90
+ STA XR
+ LDA IBUF+3,1
+ IMA ID+3,1
+ STA IBUF+3,1
+ IRS XR
+ JMP *-4
+ JST RST RESTORE INDEX
+ LDA NTID
+ JMP* IA50
+IA90 OCT -3
+IA99 PZE 0
+*
+*
+* *****************
+* *FINISH OPERATOR*
+* *****************
+* WRAP UP LOGICAL/RELATIONAL OPERATORS
+*
+FN00 DAC **
+ LDA DFL IF DFL NOT . ,
+ STA IBUF
+ SUB K10
+ SZE
+ JMP FN05 GO TO FN05
+ LDA K104
+ JST IA00
+FN05 LDA K110 USE TABLE TO CONVERT
+ STA XR OPERATOR
+FN10 LDA FN90+17,1
+ CAS IBUF
+ JMP *+2
+ JMP FN20
+ IRS XR
+ JMP FN10
+ LDA TC
+ JMP* FN00
+FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR
+ STA TC SET INTO TC
+ JMP* FN00
+FN90 OCT 253,255,252,257 +-*/
+ BCI 9,NOANORLTLEEQGEGTNE
+ OCT 275,254 =,
+FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17
+*
+*
+* ***********
+* *INPUT DNA*
+* ***********
+* BASIC INPUT ROUTINE, HANDLES FOLLOWING -
+* CONSTANT CONVERSION
+* MODE TYPING (CONSTANTS, IMPLIED/VARIABLES)
+* ALL OPERATORS (TERMINATE ITEM)
+*
+ID BSS 4
+TID EQU ID TEMP STORE FOR ID
+IBUF BSS 3 3-WORD BUF
+TIDN PZE 0
+K155 OCT 177727 -41
+K156 OCT 024000 1085
+K157 OCT 007777
+K158 OCT 074000
+F1 PZE 0 SIGN FLAG
+F2 PZE 0
+F3 PZE 0 INPUT EXPONENT
+F4 PZE 0 NO, FRAC. POSITIONS
+F5 PZE 0 TEMP DELIMITER STORE
+F6 PZE 0
+L4 PZE 0
+HOLF PZE 0 HOLLERITH FLAG
+DN00 DAC **
+DN01 CRA
+ STA HOLF SET HOLF =0
+ STA F4 F4 = 0
+ STA IU
+ STA NT IU=NT=NTID=0
+ STA NTID
+ JST BLNK CLEAR OUT TID = ID
+ DAC TID
+ JST BLNK
+ DAC F1 F1,F2,F3 = 0
+DN06 CRA
+ STA IM
+ STA DNX2
+DN07 JST ID00 INPUT DIGIT
+ SZE
+ JMP DN14 (A) NON-ZERO, G0 T0 DN14
+DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST
+ ANA K158 POSITION COUNT IF NECESSARY,
+ SZE
+ JMP SKIP
+ ADD IM
+ ARS 1
+ ADD F4 F4 = F4+1 IF NO OVERFLOW
+ STA F4 AND IM ALREADY SET TO REAL
+ LDA K101
+ STA NT NT=1
+ ADD K101
+ STA IU IU = VAR/COD
+ JST SFT SHIFT ID LEFT
+ DAC ID
+ JST MOV3 MOVE TO TEMP STORE
+ JST SFT
+ DAC ID
+ JST SFT
+ DAC ID
+ JST AD3 ID = 10*ID+TC
+ JST BLNK
+ DAC DNX1
+ LDA TC
+ SUB K60
+ STA DNX1
+ JST AD3
+ JMP DN07
+SKIP LDA MIN2
+ ADD IM
+ ARS 1
+ ADD F4
+ STA F4
+ JMP DN07
+DN14 LDA IM IM = REAL
+ SUB K102
+ SZE
+ JMP DN50 NO, GO TO DN50
+DN16 LDA K10 YES,
+DN17 STA F5 F5 = '.'
+ LDA DFL IF DFL =0, GO SO DN20 (5)
+ SZE
+ JMP DN90 ELSE GO TO DN90 (9)
+DN20 LDA TC IF TC = D, GO TO DN26
+ SUB K11
+ SNZ
+ JMP DN26
+ SUB K101 ELSE, IF TC = E, GO TO DN22
+ SNZ
+ JMP DN22 TERMINATOR = E
+ JST UC00
+ LDA K10 ='256 (,)
+ STA DFL SET DELIMITER FLAG
+ LDA K101 =1
+ STA IM SET ITEM MODE TO INTEGER
+ JMP DN67 FINISH OPERATOR AND EXIT
+*
+DN22 JST ID00 INPUT DIGIT
+ SNZ IF (A) = 0, GO TO DN30
+ JMP DN30
+ LDA TC IF TC = -, GO TO DN28
+ SUB K12
+ SNZ
+ JMP DN28
+ ADD K102
+ SNZ
+ JMP DN29
+ LDA F5
+ STA DFL
+ JST UC00 UN-INPUT COL
+DN24 JST FN00 FINISH OPERATOR
+DN25 LDA K101 IM = INT
+ STA IM
+ LDA ID+1 IF ID IS TOO BIG TO
+ SZE BE AN INTEGER (>L2),
+ JMP DN69 GO TO DN69 (20)
+ LDA ID+2
+ SZE
+ JMP DN69
+ JMP DN84 OTHERWISE, GO TO DN84(12)
+DN26 LDA K106 IM = DBL
+ STA IM
+ JMP DN22
+DN28 LDA K101 F2 = 1
+ STA F2
+DN29 JST ID00 INPUT DIGIT
+ SZE IF (A) = 0, GO TO DN30 (8.5)
+ JMP DN69 ELSE, GO TO DN69 (20)
+DN30 LDA F3 F3 = 10 * F3
+ ALS 3
+ IMA F3 F3 = F3 +TC
+ ALS 1
+ ADD F3
+ ADD TC INPUT DIGIT
+ SUB K60
+ STA F3 IF (A) = 0, GO TO DN30 (8.5)
+ JST ID00 ELSE, GO TO DN90 (9)
+ SZE
+ JMP DN90
+ JMP DN30
+DN50 LDA K102 IM=REA
+ STA IM
+ LDA TC IF TC = ., GO TO DN54
+ SUB K10
+ SNZ
+ JMP DN54 ELSE,
+ LDA NT
+ SNZ IF NT = 0, GO TO DN72
+ JMP DN72
+ LDA TC IF TC = H, GO TO DN9H (22)
+ SUB K14
+ SNZ
+ JMP DN9H
+ LDA DFL IF DFL = 0,
+ SZE GO TO DN16 (4.9)
+ JMP DN25 ELSE, GO TO DN25
+ JMP DN16
+DN54 JST ID00 INPUT DIGIT
+ SNZ
+ JMP DN10 IF (A) = 0, GO TO DN10 (3)
+ LDA NT
+ SNZ IF NT = 0, GO TO DN56
+ JMP DN56
+ LDA TC F5 = TC
+ JMP DN16 GO TO DN16 (4)
+DN56 CRA
+ STA TC TC = )
+DN58 JST UC00 UN-INPUT A COLUMN,
+ LDA F1 IF F1 = 0, GO TO DN60
+ SZE
+ JMP DN63 ELSE, GO TO DN63 (15)
+DN60 LDA K106
+ JST IA00 INPUT (6) CHARS
+ JST CIB IF IBUF = TRUE.,
+ DAC K1+3,1
+ JMP DN64
+ JST CIB IF IBUF = FALSE.,
+ DAC K2+3,1 GO TO DN66 (16)
+ JMP DN66
+ JST CIB CHECK FOR .NOT. OPERATOR
+ DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR
+ JMP DN9N OPERATOR IS .NOT.
+*
+* TAPE 1 OF 5 - END
+ MOR