--- /dev/null
+* C210-001-6601 (FRTN) 3C NO.180463000 REV. D
+*
+*
+*
+* 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.
+DN63 CRA IM = 0
+ STA IM
+ JMP DN67 GO TO DN67 (18)
+DN64 LDA K101
+ STA TID
+DN66 LDA K101
+ STA NT NAME TAG = 1 (CONSTANT)
+ LDA K102 IU=VAR
+ STA IU
+ LDA K103
+ STA IM IM = LOG
+ JST CH00
+DN67 JST FN00 FINISH OPERATOR
+DN68 LDA F6 IF F6 = 0,
+ SNZ GO TO DN70 (21)
+ JMP DN70
+DN69 LDA K10
+ STA TC TC = .
+DN70 CRA
+ STA F6 F6 = SXF = 0
+ STA SXF
+ LDA IM (A) = IM
+ JMP* DN00 RETURN
+DN72 LDA F1 IF F1 = 0, GO TO DN74
+ SNZ
+ JMP DN74
+ LDA F1 ELSE, TC = F1
+ STA TC
+ JMP DN58 GO TO DN58 (14)
+DN74 LDA TC IF TC = -, GO TO DN82
+ SUB K12
+ SNZ
+ JMP DN82
+ ADD K102 CHECK FOR TC = +
+ SNZ
+ JMP DN82
+ LDA DFL IF DFL = NON-ZERO
+ SZE
+ JMP DN63 GO TO DN63 (15)
+ LDA TC
+ CAS K43
+ JMP *+3
+ JMP DN78
+ JMP DN80
+ CAS K62
+ JMP DN80
+ NOP
+DN78 LDA K101 IM < INT
+ STA IM
+DN80 LDA TC PACK TC TO ID
+ JST PACK
+ JST CH00 INPUT CHAR
+ LDA DFL IF DFL IS NOT ZERO,
+ SZE GO TO DN67 (18)
+ JMP DN67
+ LDA NTID IF NTID = 6, GO TO DN67
+ SUB K106
+ SZE
+ JMP DN80
+ JMP DN67
+DN82 JST FN00
+ STA F1 F1 = CONVERTED TC
+ JMP DN06 GO TO DN06 (2)
+DN84 LDA F1 IF F1 = -,
+ SUB K102 GO TO DN85(13)
+ SZE
+ JMP DN85
+ CRA
+ SUB TID COMPLEMENT THREE WORDS AT TID
+ SZE
+ JMP DN8A
+ SUB TID+1
+ SZE
+ JMP DN8B
+ JMP DN8C
+DN8A STA TID
+ LDA K123
+ SUB TID+1
+DN8B STA TID+1
+ LDA K123
+DN8C SUB TID+2
+ STA TID+2
+DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18)
+ SNZ
+ JMP DN67 ELSE,
+ LDA IM IF IM NOT = REA,
+ SUB K102
+ SZE GO TO DN67 (18)
+ JMP DN67
+ LDA F6 ELSE,
+ SNZ IF F6 = 0, GO TO DN87
+ JMP DN87
+ LDA K105
+ STA IM IM = CPX
+ LDA TID INTERCHANGE
+ IMA TIDB 3 CELLS
+ STA TID TID
+ LDA TID+1 WITH
+ IMA TIDB+1 3 CELLS
+ STA TID+1 OF
+ LDA TID+2 TIDB
+ IMA TIDB+2
+ STA TID+2
+ JST IP00 )-INPUT OPERATOR
+ JMP DN70 GO TO DN70 (21)
+DN87 LDA TC IF TC = ,
+ SUB K5
+ SZE
+ JMP DN67 TID-BAR = TID
+ LDA TID F6 = 1
+ STA TIDB GO TO DN01 (1)
+ LDA TID+1
+ STA TIDB+1 ELSE, GO TO DN67 (18)
+ LDA TID+2
+ STA TIDB+2
+ LDA K101
+ STA F6
+ JMP DN01
+DN90 LDA F2 IF F2= 0, GO TO DN9A (10)
+ SNZ
+ JMP DN9A
+ LDA F3 F3 = - F3
+ TCA
+ STA F3
+DN9A LDA F3 F4 = F3 - F4
+ SUB F4
+ STA F4
+ LDA K12 F2 = EXP, BIAS + MANTISSA
+ STA F2
+ LDA TID IF TID = 0,
+ ADD TID+1
+ ADD TID+2 GO TO DN85(13)
+ SNZ
+ JMP DN85
+DN9C LDA TID+2
+ LGL 1 NORMALIZE ID
+ SPL
+ JMP DN9D ID IS NORMALIZED
+ JST SFT
+ DAC ID
+* F2 = F2 - = SHIFTS
+ LDA F2
+ SUB K101
+ STA F2
+ JMP DN9C CONTINUE NORMALIZE LOOP
+DN9D LDA F4
+ CAS ZERO
+ JMP DN9E
+ JMP DN9G FINISHED E FACTOR LOOP
+ IRS F4
+ NOP F4 = F4 +1
+ LDA K155 DIVIDE LOOP COUNTER
+ STA TIDN
+ JST SRT
+ DAC TID
+ JST SRT
+ DAC TID
+DND1 JST SFT
+ DAC TID
+ LDA TID+2
+ SUB K156 10 AT B=4
+ SMI
+ STA TID+2
+ SMI
+ IRS TID
+ IRS TIDN
+ JMP DND1 REDUCE DIVIDE COUNTER
+ JST SFT
+ DAC TID
+ LDA TID+2
+ ANA K157
+ STA TID+2
+ JMP DN9C
+DN9E SUB K101
+ STA F4 F4 = F4-1
+ LDA F2 F2 = F2+4
+ ADD K104
+ STA F2
+ JST SRT
+ DAC ID
+ JST MOV3
+ JST SRT ID = ID*10
+ DAC ID
+ JST SRT
+ DAC ID
+ JST AD3 ADD THREE WORD INTEGERS
+ JMP DN9C
+* CONVERT THREE WORD INTEGER TO INTERNAL FORMAT
+DN9G LDA TID+2
+ IAB
+ LDA F2
+ LRS 8
+ SNZ
+ JMP *+3
+ JST ER00
+ BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW)
+ IAB
+ IMA TID+2
+ IAB
+ LDA TID+1
+ LGL 1
+ LRR 8
+ STA TID+1
+ LRR 9
+ LDA TID PACK UP TRIPLE PRECISION
+ LGL 1
+ LRR 7 REAL CONSTANT
+ STA TID
+ LDA F2
+ LGR 8
+ SZE
+ JMP DN69 GO TO DN69 (20)
+ JMP DN84 ELSE. GO TO DN84 (12)
+DN9H STA IM
+ LDA SPF
+ SUB K102
+ SZE
+ LDA K106
+ SUB K124
+ ADD TID
+ SMI
+ JMP DN70
+ LDA TID
+ STA HOLF HOLF=NO.OF HOLLERITH CHARS,
+ STA F3
+ TCA
+ SNZ
+ JMP DN9K FIELD WIDTH OF ZERO
+ STA F2 F2= -1(1 CHAR) OR -2(2 CHAR)
+ JST BLNK SET ID,ID+1(ID+2 TO ZERO
+ DAC TID
+DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS)
+ JST PACK PACK CHARACTERS 2 PER WORD
+ IRS F2 REDUCE CHARACTER COUNT
+ JMP DN9J INPUT AND PACK MORE CHARACTERS
+ LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT
+ ANA K101
+ SNZ
+ JMP *+3
+ LDA K8 ='240 (SP)
+ JST PACK SHIFT A SPACE INTO THE LAST WORD
+ IRS IM
+DN9M JST CH00 INPUT THE TERMINATING CHARACTER
+ JMP DN67 FINISH OPERATOR AND EXIT
+DN9K JST ER00
+ BCI 1,HF
+DN9N LDA K105 SET .NOT. OPERATOR (TC=5)
+ STA TC SET .NOT. OPERATOR (TC=5)
+ CRA
+ STA IM IM=0 = UNDEFINED
+ JMP DN68
+DNX1 BSS 3
+DNX2 DAC ** OVERFLOW FLAG
+ JMP* *-1
+*
+*
+* ************
+* *INPUT ITEM*
+* ************
+* INPUTS AND ASSIGNS ITEM (IF ONE EXISTS)
+*
+II00 DAC **
+ JST DN00 INPUT DNA
+ SNZ IF (A) = 0
+ JMP* II00 RETURN
+ JST AS00 NO, ASSIGN ITEM
+ LDA IM
+ JMP* II00 RETURN (A) = IM
+*
+*
+* ***************
+* *INPUT OPERAND*
+* ***************
+* EXIT WITH ITEM MODE IN A (TC SET TO . IF NO
+* OPERAND)
+*
+OP00 DAC ** INPUT OPERAND
+ JST II00 INPUT ITEM
+ SZE IF IM = 0, SKIP
+ JMP* OP00 ELSE (A) = IM, RETURN
+ LDA K10 TC = .
+ STA TC (A) = 0
+ CRA
+ JMP* OP00 RETURN
+*
+*
+* ************
+* *INPUT NAME*
+* ************
+* INPUT OPERAND AND ENSURE THAT IT IS A NAME
+*
+NA00 DAC ** INPUT NAME
+ JST OP00 INPUT OPERAND
+ LDA NT IF NT = 1,
+ SNZ
+ JMP NA10
+ JST ER00
+ PZE 9
+NA10 LDA IM (A) = IM
+ JMP* NA00 RETURN
+*
+*
+* ***************
+* *INPUT INTEGER*
+* ***************
+* INPUT ITEM AND ENSURE THAT IT IS AN INTEGER CONSTANT
+* GREATER THAN ZERO
+*
+IG00 DAC ** INPUT INTEGER
+ JST DN00 INPUT - DNA
+ LDA F1
+ SZE IF F1 = 0,
+ JMP IG20 AND NT = 1,
+ LDA NT AND IM = INT,
+ SNZ AND TID L2**15,
+ JMP IG20 GO TO IG10
+ LDA IM LSE, GO TO IG20
+ SUB K101
+ SZE
+ JMP IG20
+ LDA TID+1
+ SZE
+ JMP IG20
+ LDA TID+2
+ SZE
+ JMP IG20
+IG10 LDA TID
+ JMP* IG00
+IG20 JST ER00 ERROR
+ BCI 1,IN INTEGER REQUIRED
+*
+*
+* ***********************
+* *INPUT INTEGER VAR/CON*
+* ***********************
+*
+IV00 DAC **
+ JST OP00 INPUT OPERAND
+ JST IT00 INTER TEST
+ JST TV00 TAG VARIABLE
+ JMP* IV00 EXIT
+*
+*
+* ************************
+* *INPUT INTEGER VARIABLE*
+* ************************
+*
+IR00 DAC ** INPUT INT VAR
+ JST IV00 INPUT INT VAR/CON
+ JST NC00 NON-CONSTANT TEST
+ JMP* IR00 RETURN
+*
+*
+* ************************
+* *INPUT STATEMENT NUMBER*
+* ************************
+* NUMBER IS FORMED AS SPECIAL NAME , NOT CONVERTED
+* TO NUMERIC
+*
+IS00 DAC **
+IS04 CRA
+ STA NT
+ STA IM
+ STA IU IU = IM = IT = 0
+ STA NTID PUT LEADING 'S' IN STATEMENT NO,
+ LDA K79
+ JST PACK
+IS10 JST ID00 INPUT DIGIT
+ SZE
+ JMP IS20 NOT A DIGIT GO TO IS20
+ LDA NTID
+ SUB K106
+ SMI
+ JMP IS22
+ LDA TC
+ JST PACK PACK TC TO ID - LEGAL ST, NO, CHAR
+ LDA TID
+ CAS K79X
+ JMP IS10
+ JMP IS04 IGNORE LEAD ZERO ON ST. NO,
+ JMP IS10
+IS20 LDA NTID
+ SUB K101
+ SMI
+ JMP IS25
+IS22 JST ER00
+ BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT
+IS25 JST AS00 ASSIGN ITEM
+ JST STXA
+ LDA DP+1,1
+ ANA K111
+ STA DP+1,1 IU = 0
+ LDA AF ADDRESS FIELD IS
+ CAS XST LE XST - ALREADY ASSIGNED
+ JMP* IS00
+ JMP* IS00 OK - OTHERWISE
+ LDA AT MUST HAVE STR-ABS OTHERWISE
+ CAS K102
+ JMP *+2
+ JMP* IS00 !!!
+ JST ER00
+ BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER
+K79 OCT 337
+K79X OCT 157660
+*
+SY00 DAC ** INPUT SYMBOL
+ LDA K101
+ STA NTF NTF NOT 0 - DON'T SET IU IN AS00
+ JST NA00 INPUT NAME
+ JMP* SY00 EXIT
+*
+* ************************
+* *EXAMINE NEXT CHARACTER*
+* ************************
+* CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT)
+*
+XN00 DAC **
+ JST ID00 INPUT DIGIT
+ JST UC00 UNINPUT COLUMM
+ JMP* XN00
+K1 BCI 3,TRUE.
+K2 BCI 3,FALSE.
+K3 OCT 247
+KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST
+K11 OCT 304 0D
+K14 OCT 310 0H
+K62 OCT 316 0N
+K64 OCT 336 0)
+*
+*
+* ********************
+* *ALL CHARACTER TEST*
+* ********************
+*
+TS00 DAC ** TEST (A) AGAINST TC
+ SUB TC
+ SNZ
+ JMP* TS00 RETURN
+ JST ER00 TO ERROR TEST
+ BCI 1,CH IMPROPER TERMINATING CHARACTER
+*
+*
+* *******************
+* *)- INPUT OPERATOR*
+* *******************
+*
+IP00 DAC **
+ LDA K4 TEST - )
+ JST TS00
+ JST CH00 INPUT CHAR
+ JST FN00 FINISH OPERATOR
+ LDA B B = B-16
+ SUB K109
+ STA B
+ CRA (A) = 0
+ JMP* IP00 RETURN
+*
+*
+*
+* B1 COMMA OR C/R TST
+B1 LDA K134 IF TC = ','(CONVERTED TO 17)
+ SUB TC
+ SNZ
+ JMP* A9T2 GO TO SIDSW
+ JMP A1 ELSE, GO TO C/R TEST
+*
+*
+NR00 DAC ** NON-REL TEST
+ LDA AT
+ SUB K101 IF AT = 1 GO TO ERROR-
+ SZE TEST
+ JMP* NR00 RETURN
+ JST ER00 ERROR TEST ROUTINE
+ BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER
+*
+*
+* ***************
+* *NO USAGE TEST*
+* ***************
+*
+NU00 DAC ** N0 USAGE TEST
+ LDA IU
+ SNZ IF IU NOT = 0, TO ERROR
+ JMP* NU00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,NU NAME ALREADY BEING USED
+*
+*
+* *******************
+* *NON-CONSTANT TEST*
+* *******************
+*
+NC00 DAC ** NON CONSTANT TEST
+ LDA NT
+ SNZ IF NT NOT = 0, TO ERROR TEST
+ JMP* NC00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,NC CONSTANT MUST BE PRESENT
+*
+*
+* *********************
+* *NON SUBPROGRAM TEST*
+* *********************
+*
+NS00 DAC ** NON SUBPROGRAM TEST
+ LDA IU
+ SUB K101 IF IU = 1, GO TO-
+ SZE ERROR TEST
+ JMP* NS00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,NS SUBPROGRAM NAME NOT ALLOWED
+*
+*
+* **********
+* *ARR TEST*
+* **********
+*
+AT00 DAC ** ARRAY TEST
+ LDA IU
+ SUB K103 IF IU = 3, GO TO
+ SNZ
+ JMP* AT00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,AR ITEM NOT AN ARRAY NAME
+*
+*
+* **************
+* *INTEGER TEST*
+* **************
+*
+IT00 DAC ** INTEGER TEST
+ LDA IM
+ SUB K101 IF IM = 1, GO TO-
+ SNZ ERROR ROUTINE, ELSE
+ JMP* IT00 RETURN
+ JST ER00 TO ERROR TEST
+ BCI 1,IT ITEM NOT AN INTEGER
+*
+*
+TA00 DAC **
+ LDA AT STRING-ABS TEST
+ SUB K102
+ SNZ
+ JMP* TA00
+ JST ER00
+ BCI 1,NR ITEM NOT A RELATIVE VARIABLE
+*
+*
+*
+*
+*
+*
+*
+*
+AD3 DAC ** ADD TWO THREE WORD INTEGERS,
+ LDA TID
+ ADD DNX1
+ CSA
+ STA TID
+ LDA TID+1
+ ACA
+ ADD DNX1+1
+ CSA
+ STA TID+1
+ LDA TID+2
+ ACA
+ ADD DNX1+2
+ STA TID+2
+ JMP* AD3
+*
+*
+* ***********************
+* *ASSIGN INDEX REGISTER*
+* ***********************
+*
+STXA DAC **
+ LDA A
+ STA 0
+ JMP* STXA
+STXI DAC **
+ LDA I
+ STA 0
+ JMP* STXI
+K153 OCT 16
+IM00 DAC **
+ STA T1IM MULTIPLY A BY B
+ LDA K120 =-15
+ STA T2IM
+ CRA
+ RCB C BIT = 0
+IM10 LRL 1 LOW BIT OF B INTO C
+ SRC SKIP IF B = 0
+ ADD T1IM
+ IRS T2IM
+ JMP IM10
+ LLL 14
+ JMP* IM00 RETURN, RESULT IN A
+T1IM PZE 0
+T2IM PZE 0
+*
+*
+NF00 DAC ** CONSTRUCT EXTERNAL NAME
+ LDA K80 ENTRY FOR FORTRAN GENERATER
+ STA NAMF
+ LDA K81 SUBROUTINE CALLS,
+ STA NAMF+2
+ JMP* NF00
+K80 BCI 1,F$
+K81 BCI 1,
+KM92 DEC 1 001 = INT
+ DEC 2 010 = REA
+ DEC 1 011 = LOG
+ DEC 0 - -
+ DEC 4 101 = CPX
+ DEC 3 110 = DSL
+ OCT 3 111 = HOL
+*
+*
+BLNK DAC ** CLEAR A 3/36
+ JST SAV AREA TO ZEROS
+ LDA* BLNK
+ STA XR
+ CRA CLEAR 3 WORDS OF MEMORY
+ STA 1,1 PARAMETER INPUT ADDRESS TO 0
+ STA 2,1
+ STA 0,1
+ JST RST
+ IRS BLNK
+ JMP* BLNK EXIT
+*
+*
+MOV3 DAC ** MOVE 3-WORDS
+ LDA TID TO TEMO STORE
+ STA DNX1
+ LDA TID+1
+ STA DNX1+1
+ LDA TID+2
+ STA DNX1+2
+ JMP* MOV3
+*
+*
+*
+*
+CIB DAC ** COMPARE IBUF TO A CONSTANT
+ JST SAV SAVE INDEX
+ LDA* CIB +DDR OF CON+3,0
+ STA CIBZ
+ CRA
+ SUB K103 XR=-3
+ STA XR
+CIBB LDA IBUF+3,1
+ SUB* CIBZ
+ SZE
+ JMP CIBD
+ IRS XR
+ JMP CIBB
+CIBC IRS CIB
+ JST RST RESTORE INDEX
+ JMP* CIB
+CIBD IRS CIB
+ JMP CIBC
+CIBZ DAC **
+*
+*
+*
+*
+SAV DAC ** SAVE INDEX REGISTER
+ STA SAVY STACKED IN PUSH DOWN LIST
+ LDA XR
+ STA* SAV9
+ IRS SAV9
+ LDA SAVY
+ JMP* SAV
+RST DAC ** RESTORE INDEX REGISTER
+ STA SAVY
+ LDA SAV9 UNSTACK PUSH DOWN LIST
+ SUB K101
+ STA SAV9
+ LDA* SAV9
+ STA XR
+ LDA SAVY
+ JMP* RST
+SAVY PZE 0
+SAV9 DAC SAVX IS INITIATED BY A092
+SAVX BSS 20
+*
+*
+PACK DAC ** PLACE CHARACTER IN A
+ STA PAK7
+ LDA NTID INTO ID - UPDATE 3 WORDS OF
+PAK1 SNZ
+ JMP PAK4 ID
+ LRL 1
+ ADD PAK9
+ STA PAK8
+ LDA PAK7
+ IAB
+ SPL
+ JMP PAK3
+ LLL 24
+ ADD K8
+PAK2 STA* PAK8
+ IRS NTID
+ JMP* PACK
+PAK3 LLL 8
+ LDA* PAK8
+ LGR 8
+ LLL 8
+ JMP PAK2
+PAK4 LDA PAK6
+ STA TID
+ STA TID+1
+ STA TID+2
+ STA TID+3
+ LDA NTID
+ JMP PAK1+2
+PAK6 BCI 1,
+PAK7 DAC **
+PAK8 DAC **
+PAK9 DAC TID
+*
+*
+* ***************
+* *ERROR ROUTINE*
+* ***************
+*
+ER00 DAC ** ERROR ROUTINE
+ LDA SAV9
+ STA SAVX
+ LDA ER93 =-35
+ STA 0 SET INDEX
+ LDA ER91 (*)(*)
+ STA PRI+35,1 SET ** INTO PRINT BUFFER
+ IRS 0 SET COMPLETE PRINT BUFFER TO ********
+ JMP *-2
+ LDA CC
+ ARS 1 CC = CC/2
+ SUB K101 =1
+ SPL
+ CRA
+ STA XR
+ LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.)
+ SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT
+ JMP *+3
+ LDA KAEQ ='142721 (=(E)(Q) )
+ STA PRI+1,1
+ LDA* ER00
+ STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER
+ CALL F4$SYM PRINT THE BUFFER
+ DAC PRI
+ JST PRSP SET PRINT BUFFER TO SPACES
+ LDA TC
+ER20 CAS CRET INPUT CHARACTERS UNTIL C/R
+ JMP *+2
+ JMP C7 GO TO STATEMENT INPUT
+ JST CH00
+ JMP ER20
+ER91 BCI 1,**
+ER93 OCT 177735 -35
+*
+*
+SRT DAC **
+ JST SAV
+ LDA* SRT SHIFT RIGHT ONE PLACE
+ STA XR TRIPLE PRECISION
+ LDA 0,1
+ IAB
+ LDA 1,1
+ LRS 1
+ LGL 1
+ IAB
+ STA 0,1
+ LDA 2,1
+ LRS 1
+ STA 2,1
+ IAB
+ STA 1,1
+ JST RST
+ IRS SRT
+ JMP* SRT
+*
+*
+SFT DAC ** TRIPLE PRECISION
+ JST SAV SHIFT LEFT ONE PLACE
+ LDA* SFT
+ STA XR
+ LDA 0,1
+ IAB
+ LDA 1,1
+ LLS 1
+ CSA
+ STA 1,1
+ IAB
+ STA 0,1
+ ACA
+ LRS 1
+ LDA 2,1
+ LLS 1
+ CSA
+ STA 2,1
+ JST RST
+ IRS SFT
+ JMP* SFT
+*
+LIST DAC **
+ JST PRSP
+ SR2
+ JMP *+3
+ CALL F4$SYM PRINT BLANK LINE
+ DAC PRI
+ CALL F4$SYM PRINT SOURCE INPUT LINE
+ DAC CI
+ JMP* LIST
+* *************
+* *ASSIGN ITEM*
+* *************
+* CHECKS ASSIGNMENT AREA OF DATA POOL (A0 TO ABAR)
+* FOR ITEM DEFINED BY ID, IM, IU, ETC.
+* IF FOUND, EXIT WITH POINTER AND
+* ASSIGNMENTS DATA SET, OTHERWISE
+* ASSIGN THE ITEM.
+*
+*
+*
+T0AS PZE 0
+AS00 DAC **
+ CRA
+ STA A A = A (0)
+AS04 JST STXA
+ JST NXT GET NEXT ENTRY
+ JMP AS30 AT END, GO TO AS30
+ LDA NT
+ SUB NTA NT = NT(A)
+ SZE
+ JMP AS04 NO, G0 TO AS04
+ LDA TID
+ SUB TIDA
+ SZE
+ JMP AS04 TID = TID(A)
+ LDA TID+1
+ SUB TIDA+1
+ SZE
+ JMP AS04 NO, GO TO AS04
+ LDA TID+2
+ SUB TIDA+2
+ SZE
+ JMP AS04
+ LDA NT IF NT (A) .NE. 0,
+ SNZ GO TO AS10
+ JMP AS16 GO TO AS16 (4)
+AS10 LDA IM IF IM .NE. IM (A),
+ SUB IMA GO TO AS04 (1)
+ SZE
+ JMP AS04
+ LDA IU IF IU = 0,
+ SNZ OR NOT EQUAL IU (A)
+ JMP AS04 GO T0 AS04 (1)
+ SUB IUA
+ SZE
+ JMP AS04 ELSE,
+ LDA IM
+ SUB K105 GO TO AS16 (4)
+ SZE
+ JMP AS16
+ JST NXT ELSE, GET NEXT ENTRY
+ JMP AS30
+ LDA TIDA IF IU (A) = TIDB
+ SUB TIDB GO TO AS16 (4)
+ SZE ELSE, GO TO AS04 (1)
+ JMP AS04
+ LDA TIDA+1
+ SUB TIDB+1
+ SZE
+ JMP AS04
+ LDA TIDA+2
+ SUB TIDB+2
+ SZE
+ JMP AS04
+ LDA A
+ SUB K105
+ STA A
+AS16 LDA IUA IF IU (A) .NE. 0
+ ADD NTF
+ SZE
+ JMP AS18 GO TO AS18 (5)
+ LDA SPF IF SPF = 0, GO TO AS18 (5)
+ SNZ
+ JMP AS18
+ LDA TC IF TC = (
+ SUB K17
+ SZE
+ JMP AS19
+ JST TG00 TAG SUBPROGRAM
+AS18 CRA SET NTF TO 0
+ STA NTF SET NTF TO 0
+ JST FA00 GO TO FETCH ASSIGNS
+ JST STXA
+ LDA IM
+ JMP* AS00 RETURN
+AS19 JST TV00 TAG VARIABLE
+ JMP AS18
+AS30 JST BUD BUILD ASSIGNMENT ENTRY
+ LDA NT IF NT = 1
+ SZE
+ JMP AS32 OR IV = VAR,
+ LDA IU
+ SUB K102
+ SZE
+ JMP AS40 AMD
+AS32 LDA IM IF IM = CPX,
+ SUB K105
+ SZE
+ JMP AS40
+ STA IU MOVE 1ST PART OF
+ LDA TIDB COMPLEX ENTRY TO
+ STA TID TID AND BUILD
+ LDA TIDB+1 ASSIGNMENT ENTRY
+ STA TID+1
+ LDA TIDB+2
+ STA TID+2
+ LDA A
+ ADD K105
+ STA A
+ JST BUD
+ LDA A
+ SUB K105 RESTORE A
+ STA A
+AS40 LDA ABAR
+ SUB A TO = -(ABAR-A+5)
+ ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP
+ TCA
+ STA T0AS
+ TCA
+ ADD DO CO=DO+TO
+ STA DO
+ LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE
+ SNZ
+ JMP AS60 GO TO AS60
+ LDA I
+ SUB T0AS
+ STA I I = I - T0(T0 IS NEGATIVE)
+ AOA
+AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE
+ NOP
+ JMP AS50
+ ADD '104 =DP,1
+ STA AS91 AS91 = NEW TABLE TOP
+ ADD T0AS
+ STA AS92 AS92
+ SUB T0AS COMPUTE SIZE OF FLOATING TABLES
+ SUB '104 =DP,1
+ SUB DO
+ SNZ IF ZERO, ASSIGN TABLE ONLY,
+ JMP AS16
+ TCA
+ STA T0AS
+ CRA
+ STA XR
+AS46 LDA* AS92 END-5
+ STA* AS91 END (MOVE TABLES UP)
+ LDA 0
+ SUB K101 =1
+ STA 0 REDUCE INDEX
+ IRS T0AS = NO, OF WORDS TO MOVE
+ JMP AS46
+ JMP AS16
+AS50 JST ER00
+ BCI 1,MO DATA POOL OVERFLOW
+AS60 LDA DO
+ ADD D
+ JMP AS41
+AS91 DAC 0
+AS92 DAC **
+*
+*
+*
+*
+* ****************
+* *TAG SUBPROGRAM*
+* ****************
+* TAG ITEM AS A SUBPROGRAM, CHECK TO SEE IF
+* NAME IS IN IMPLICIT MODE TABLE AND SET
+* MODE ACCORDINGLY
+*
+TG00 DAC **
+ LDA IU
+ SUB K101 IF IU = SUB
+ SNZ
+ JMP* TG00 RETURN, ELSE
+ JST NU00 NO * USAGE TEST
+ LDA TG22 =-21
+ STA 0 SET INDEX
+TG04 LDA ID+1 CHARACTERS 3 AND 4
+ CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE
+ JMP *+2
+ JMP TG10
+TG06 IRS 0
+ JMP TG04 NOT DONE WITH TABLE
+TG08 LDA K101 =1 (IU=SUBR.)
+ STA IU
+ JST STXA
+ LDA DP+1,1 IU(A) = SUB
+ LGL 1
+ SSM
+ LGR 1
+ STA DP+1,1
+ JMP* TG00 RETURN
+*
+TG10 LDA ID CHARACTERS 1 AND 2
+ ANA K111 ='37777
+ ADD HBIT ='140000
+ SUB TGT1+21,1
+ SZE
+ JMP TG06 CONTINUE SEARCH
+ LDA ID+2 CHARACTERS 5 AND 6
+ SUB TGT3+21,1
+ SZE
+ JMP TG06 CONTINUE SEARCH
+ LDA TGT1+21,1
+ LGR 8
+ ANA K107 =7 (=3 IF CPX, 4 IF DBL)
+ ADD K102 =2 (=5 IF CPX, 6 IF DBL)
+ JST DM00 DEFINE IM
+ JMP TG08
+*
+TG22 OCT 177753 =-21
+*
+*...........IMPLICIT MODE SUBROUTINE NAME TABLE
+TGT1 BCI 6,DECEDLCLDLDS
+ BCI 6,CSDCCCDSCSDA
+ BCI 6,DADMDADMDMDS
+ BCI 3,DBCMCO
+TGT2 BCI 6,XPXPOGOGOGIN
+ BCI 6,INOSOSQRQRTA
+ BCI 6,TAODBSAXINIG
+ BCI 3,LEPLNJ
+TGT3 BCI 6, 10 /
+ BCI 6, T T N /
+ BCI 6,N2 1 1 N /
+ BCI 3, X G /
+*
+*
+TIDA BSS 3
+TIDB BSS 3
+*
+* - TV00 TAG VARIABLE
+TV00 DAC **
+ LDA IU IF IU = 'VAR',
+ SUB K102
+ SNZ
+ JMP* TV00 RETURN
+ JST NU00 ELSE, NO USAGE TEST
+ JST STXA
+ LDA DP+1,1
+ ANA K111 IU (A) = 'VAR'
+ SSM
+ STA DP+1,1
+ JMP* TV00 RETURN
+*
+*
+*
+*
+*
+* **************
+* *FETCH ASSIGN*
+* **************
+* SET ASSIGNMENT DATA FROM ASSIGN (EXCEPT ID)
+* EXPAND DIMENSION INFO IF ARRAY
+*
+FA00 DAC **
+ JST STXA
+ LDA DP,1
+ LRL 15
+ STA NT NT=NT(A)
+ CRA
+ LLL 3
+ STA AT AT=AT(A)
+ CRA
+ LLL 3 IM = IM(A)
+ STA IM
+ STA 0
+ LDA KM92-1,1
+ STA D0 D0 = NUMBER OF WORDS
+ ALS 2
+ ADD D0
+ STA X X = POINTER TO CONSTANT NUMBER OF WORDS
+ JST STXA
+ LDA DP+1,1
+ LRL 14
+ STA IU
+ SUB K103 IF IU NOT 'ARR'
+ SNZ
+ JMP FA10
+ CRA
+ LLL 14 AF = GF(A)
+ STA AF
+ JMP* FA00
+FA10 LLL 14
+ STA 0 INDEX = GF(A)
+ LDA DP+4,1
+ STA X1 POINTER OF DIMENSION 1
+ LDA DP+3,1
+ STA X2 POINTER OF DIMENSION 2
+ LDA DP+2,1
+ STA X3 POINTER OF DIMENSION 3
+ LDA DP+1,1
+ ANA K111 ='37777
+ STA AF AF = GF(GF(A))
+ LDA DP,1
+ LGR 9
+ ANA K107 =7
+ STA ND NUMBER OF DIMENSIONS
+ STA 0
+ LDA K101 =1
+ STA D2
+ STA D3
+ JMP* FA91-1,1
+FA22 LDA X3 FETCH 3RD DIMENSION SIZE
+ STA XR
+ JST FA40
+ STA D3 STORE D3
+FA24 LDA X2
+ STA XR
+ JST FA40
+ STA D2 D2 = 2ND DIMENSION SIZE
+FA26 LDA X1
+ STA XR
+ JST FA40
+ STA D1 D1 = 1ST DIMENSION SIZE
+ JST STXA EXIT WITH AF IN A
+ LDA AF
+ JMP* FA00
+FA40 DAC **
+ LDA DP,1 IM OF SUBSCRIPT VALUE
+ SSP
+ LGR 12
+ SUB K105 =5
+ SZE SKIP IF DUMMY SUBSCRIPT
+ LDA DP+4,1 FETCH VALUE OF SUBSCRIPT
+ JMP* FA40
+FA91 DAC FA26
+ DAC FA24
+ DAC FA22
+*
+*
+* ************
+* *FETCH LINK*
+* ************
+* EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE
+* LINKED ITEM
+*
+FL00 DAC **
+ JST STXA
+ LDA DP,1 A = 5 * CL(A)
+ ANA K118
+ STA FLT1
+ ALS 2
+ ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC)
+ STA A
+ JST FA00 FETCH ASSIGN
+ JST KT00 D0 = = WDS /ITEM
+ LDA A
+ SUB F (A) = A-F
+ JMP* FL00 RETURN
+*
+*
+* *******************
+* *D0=WORDS FOR LINK*
+* *******************
+* D = ITEM MODE SIZE TIMES THE TOTAL SIZE IF
+* THE ITEM IS AN ARRAY
+*
+KT00 DAC **
+ LDA IU IF IU NOT 'ARR'
+ SUB K103
+ SZE
+ JMP* KT00 RETURN
+ LDA D0
+ IAB D0 = D0 * D1 * D2 * D3
+ LDA D1
+ JST IM00 MULTIPLY A BY B
+ IAB
+ LDA D2
+ JST IM00 MULTIPLY A BY B
+ IAB
+ LDA D3
+ JST IM00 MULTIPLY A BY B
+ STA D0
+ JMP* KT00 RETURN
+*
+*
+*
+* ***********
+* *DEFINE IM*
+* ***********
+* IM SUBA = IM (SET FROM A REG)
+*
+DM00 DAC **
+ STA IM IM = (A)
+ JST STXA ESTABLISH A
+ LDA DP,1
+ LRL 9
+ LGR 3 IM(A) = IM
+ LGL 3
+ ADD IM
+ LLL 9
+ STA DP,1
+ JMP* DM00
+*
+*
+* ***********
+* *DEFINE AF*
+* ***********
+* AF SUBA = AF (SET FROM A REG)
+*
+DA00 DAC **
+ STA AF AF = (A)
+ LRL 14
+ JST STXA
+DA10 LDA DP+1,1 IF IU (A) NOT ARR
+ LGR 14
+ CAS K103 GF (A) : AF
+ JMP *+2
+ JMP DA20 ELSE, GF (GF (A)) = AF
+ LLL 14
+ STA DP+1,1
+ JMP* DA00 RETURN
+DA20 LDA DP+1,1
+ ANA K111
+ STA GFA
+ STA 0
+ JMP DA10
+NXT DAC ** GET NEXT ENTRY
+ LDA A FROM ASSIGNMENT
+ ADD K105 =5
+ STA A
+ STA 0
+ CAS ABAR
+ JMP* NXT
+ NOP
+ IRS NXT
+ LDA DP,1
+ LRL 15
+ STA NTA NT(A) = NT FROM (A)
+ CRA
+ LLL 3
+ STA ATA AT(A) = AT FROM (A)
+ CRA
+ LLL 3
+ STA IMA IM(A) = IM FROM (A)
+ CRA
+ LLL 9
+ STA CLA CL(A) = CL FROM (A)
+ LDA DP+1,1
+ LRL 14
+ STA IUA IU(A) = IU FROM (A)
+ CRA
+ LLL 14
+ STA GFA GF(A) = GF FROM (A)
+ LDA DP+2,1
+ STA TIDA+2 TID(A) = TID FROM (A)
+ LDA DP+3,1
+ STA TIDA+1
+ LDA DP+4,1
+ STA TIDA
+ LRL 15
+ STA DTA DT(A) = DT FROM (A)
+ CRA
+ LLL 1
+ STA TTA TT(A) = TT FROM (A)
+ LDA NTA NT(A) = NT FROM (A)
+ SZE
+ JMP* NXT
+ LDA DP+4,1
+ SSM
+ ALR 1
+ SSM
+ ARR 1
+ STA TIDA
+ JMP* NXT
+*
+*
+BUD DAC ** BUILD ASSIGNMENT
+ JST STXA
+ STA ABAR
+ LDA TID TABLE ENTRY
+ STA DP+4,1
+ LDA TID+1
+ STA DP+3,1
+ LDA TID+2
+ STA DP+2,1
+ LDA IU
+ STA IUA
+ LGL 14
+ STA DP+1,1
+ LDA NT
+ LGL 3
+ ADD K102 AT = STR/+BS
+ LGL 3
+ ADD IM
+ LRL 16
+ STA CL
+ LDA K102
+ STA AT
+ LDA A CL(A) = A/5
+ SUB K105
+ SPL
+ JMP *+3
+ IRS CL
+ JMP *-4
+ LLL 25
+ ADD CL
+ STA DP,1
+ SPL
+ JMP* BUD
+ LDA DT
+ LGL 1
+ ADD TT
+ LGL 14
+ IMA DP+4,1
+ ANA K111
+ ADD DP+4,1
+ STA DP+4,1
+ JMP* BUD
+*
+*
+*
+*
+*
+* ************
+* *DEFINE AFT*
+* ************
+* AT SUBA = AT (FROM B REG), THEN DEFINE AF
+*
+AF00 DAC **
+ IAB
+ STA AF90
+ JST STXA
+ LDA AF90
+ LGL 12
+ IMA DP,1
+ ANA AF91
+ ADD DP,1
+ STA DP,1 AT(A) = CONTENTS OF B INPUT
+ IAB
+ JST DA00 DEFINE AF
+ JMP* AF00
+AF90 PZE 0
+AF91 OCT 107777
+*
+*
+* *****************
+* *DEFINE LOCATION*
+* *****************
+* SET AF = RPL, AT = REL
+LO00 DAC **
+ LDA K101 REL
+ IAB
+ LDA RPL
+ JST AF00 DEFINE AF
+ JMP* LO00
+* *************************
+* *ASSIGN INTEGER CONSTANT*
+* *************************
+* IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL
+AI00 DAC **
+ CRA
+ STA ID+1
+ STA ID+2
+ LDA K101 (B) = INT
+ IAB
+ LDA K102 (A) = VAR
+ JST AA00 ASSIGN SPECIAL
+ JMP* AI00 RETURN
+*
+*
+* ****************
+* *ASSIGN SPECIAL*
+* ****************
+* B REG TO IM, A REG TO IU, 1 TO NT (CONSTANT), THEN
+* ASSIGN ITEM
+AA00 DAC **
+ STA IU IU = (A)
+ IAB
+ STA IM IM = (B)
+ LDA K101
+ STA NT NT = 1
+ JST AS00 ASSIGN ITEM
+ JMP* AA00 RETURN
+*
+*
+* **********
+* *JUMP *
+* *ILL TERM*
+* **********
+*
+* CLEAR LAST OP FLAG FOR NO PATH TESTING
+*
+B6 CRA
+ STA LSTP LSTP = 0
+* SET ILLEGAL DO TERM FLAG
+C5 LDA K101
+ STA LSTF LSTF =1
+A1 LDA CRET
+ JST TS00 IF TC NOT C/R, ERROR
+ JMP C6
+*
+*
+* **********
+* *CONTINUE*
+* **********
+* WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH
+* DO TABLE FOR DO TERMINATION
+C6 LDA LIF
+ SZE IF LIF NON-ZERO,
+ JMP C6H GO TO
+C6A LDA LSTN IF LSTN NON-ZERO,
+ SZE GO TO
+ JMP C6C
+C6B STA LSTF LSTF = 0
+ JMP C7 GO TO STATEMENT INPUT
+C6C SUB TRF TRACE FLAG
+ SNZ SMP IF NOT END OF TRACE ZONE
+ STA TRF SET TRF TO ZERO (TURN FLAG OFF)
+ LDA DO START OF DO TABLE
+ ADD D
+C6D STA I I = DO + D
+ JST STXI
+ SUB DO
+ SNZ
+ JMP C6B GO TO C6B - FINISHED DO
+ LDA DP-4,1
+ SUB LSTN
+ SZE
+ JMP C6E
+ LDA LSTF
+ SZE
+ JMP C6K
+ JST DQ00 DO TERMINATION
+ LDA D
+ SUB K105
+ STA D D = D-5
+ LDA LSTF
+C6E STA LSTF
+ LDA I
+ SUB K105
+ JMP C6D I = I-5 - CONTINUE DO LOOP
+C6H LDA IFF
+ STA A
+ SNZ
+ JMP C6J
+ LLL 16
+ LDA OMI5 (A) = JMP INSTRUCTION
+ JST OB00 OUTPUT OA
+ CRA
+ STA IFF IFF = 0
+C6J STA A A = U
+ LDA LIF
+ STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG
+ JST OS00 OUTPUT STRING - RPL
+ JMP C6A
+*
+C6K JST ER00
+ BCI 1,DT
+*
+* *****************
+* *STATEMENT INPUT*
+* *****************
+* SET UP PROCESSING OF NEXT SOURCE STATEMENT
+* PROCESS STATEMENT NUMBER IF PRESENT
+* WRAPUP ANY OUTSTANDING ARITHMETIC IF
+C7 CRA
+ STA LSTN LSTN = 0
+ STA IFLG IFLG = 0
+ STA LIF LIF = 0
+ LDA L0 L = L (0)
+ STA L
+ LDA CI CHECK CARD COLUMN 1
+ LGR 8 FOR $ CHARACTER
+ SUB K15 *($)
+ SNZ
+ JMP CCRD CONTROL CARD
+ JST XN00 EXAMINE NEXT CHAR
+ SZE
+ JMP C71
+ JST IS00 INPUT STATEMENT =
+ LDA A
+ STA LSTN LSTN = A
+ STA LSTP
+C71 LDA IFF CHECK FOR IFF=0
+ LDA IFF IF IFF = 0,
+ SNZ
+ JMP C7B GO TO C7B
+ SUB LSTN IF = LSTN
+ SZE
+ JMP C7C
+C7A STA IFF IFF = 0
+C7B JST C7LT LINE TEST
+ JMP C8
+C7C LDA IFF IFF = A
+ STA A
+ LRL 32
+ LDA K201 (A) = JMP INSTRUCTION
+ JST OB00 OUTPUT OA
+ CRA
+ JMP C7A GO TO C7A
+C7LT DAC ** LINE TEST
+ LDA CI+2 CI = BLANK
+ ANA K116 LIST LINE
+ ADD K8 RETURN
+ STA CI+2
+ LDA TC
+ SUB HC2 IF TC : SPECIAL
+ SZE
+ JMP C7LU
+ JST LIST
+ JMP* C7LT
+C7LU JST ER00 CONSTRUCTION ERROR
+ BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD
+*
+*
+*
+* ************************
+* *CONTROL CARD PROCESSOR*
+* ************************
+CCRD JST FS00 FLUSH BUFFER IF NECESSARY
+ JST LIST LIST CARD
+ LDA CI WORD CONTAINING COLUMN 1
+ LGL 12
+ SNZ
+ LDA CCRK ='030000 (EOJ CODE = 3)
+ LGR 6 TRUNCATE TO A DIGIT
+ STA OCI
+ LDA K106 =6
+ STA OCNT SET BUFFER WORD COUNT TO 3
+ JST FS00 FLUSH BUFFER
+ LDA CI
+ LGL 12 CHECK COLUMN 1 FOR CONTROL CODE 0
+ SZE
+ JMP ER20 SKIP TO NEXT CARD (NOT CONTROL CARD)
+ CALL F4$END CLOSE-OUT I/0 DEVICES AND STOP
+ JMP A0 RESTART NEW COMPILATION
+CCRK OCT 030000 EOJ CONTROL CODE
+*
+* ****************
+* *STATEMENT SCAN*
+* ****************
+* DETERMINE THE CLASS OF THE STATEMENT
+* IF AN = IS FOUND WITH A FOLLOWING ,
+* THE STATEMENT IS A DO
+* IF NO FOLLOWING COMMA, THE PAREN FLAG
+* IS TESTED, IF NO PARENS, THE STATEMENT
+* IS ARITHMETIC ASSIGNMENT
+* IF PARENS WERE DETECTED AND THE FIRST
+* NAME IS AN ARRAY, THE STATEMENT IS
+* ARITHMETIC ASSIGNMENT
+* OTHERWISE, IT IS A STATEMENT FUNCTION
+* IF NO = IS FOUND, THE STATEMENT IS
+* PROCESSED FURTHER IN STATEMENT ID
+C8T1 PZE 0
+C8 LDA CC SAVE CC
+ STA C8X9
+ LDA K101
+ STA C8T1 T (1) = 1
+ CRA
+ STA ICSW ICSW = SIR
+C8A JST CH00 INPUT CHARACTER
+C8B LDA TC IF TC = )
+ SUB K4
+ SZE
+ JMP C8C
+ JST CH00 INPUT CHAR
+C8B2 LDA DFL IF DFL NOT ZERO
+ SZE
+ JMP C8B GO TO C8B
+C8B4 LDA C8X9 RESTORE CC
+ STA CC
+ LDA K101 IPL
+ STA ICSW ICSW = IPL
+ JMP A9 GO TO STATEMENT ID
+C8C LDA TC IF TC NOT (,
+ SUB K17
+ SZE
+ JMP C8D GO TO C8D
+ LDA C8T1 T1 = T1 - 1
+ SUB K101
+ STA C8T1
+C8C4 SZE IF T1 = 0
+ JMP C8B4
+ JST DN00 INPUT DNA
+ JMP C8B2 GO TO C8B2
+C8D LDA TC IF TC = ,
+ CAS K134 ='17 ('FINISHED' CODE FOR COMMA)
+ JMP *+2
+ JMP C8D2 TC = COMMA
+ SUB K5
+ SZE
+ JMP C8E
+C8D2 LDA C8T1 GO TO C8C4,
+ JMP C8C4
+C8E LDA TC ELSE, IF TC = '/'
+ SUB K9
+ SNZ
+ JMP C8B4 GO TO C8B4
+ LDA TC
+ SUB K18 IF NOT = ,
+ SZE
+ JMP C8A GO TO C8A
+ LDA K107 INPUT 7 CHARACTERS
+ JST IA00
+ LDA C8X9 RESTORE CC
+ STA CC
+ LDA K101 IPL
+ STA ICSW ICSW = IPL
+ LDA TC
+ SUB K5 IF TC NOT,
+ SZE
+ JMP C8G GO TO C8G
+ LDA K102 ELSE, INPUT 2 CHARS
+ JST IA00
+ LDA IBUF IF (A) = 'DO'
+ SUB K19
+ SNZ
+ JMP *+3
+ JST ER00
+ BCI 1,CM COMMA OUTSIDE PARENTHESES, NOT IN DO STMNT,
+ LDA K104
+ JST NP00 FIRST NON-SPEC CHECK
+ JMP C9 GO TO DO
+C8G LDA C8T1 1 IF NO ( TO LEFT OF EQUALS
+ SZE
+ JMP G2 ARITHMETIC ASSIGNMENT STATEMENT
+ JST SY00 INPUT SYMBOL
+ LDA C8X9
+ STA CC RESTORE CC
+ LDA IU IF IU = SUBR
+ SUB K103
+ SZE
+ JMP G1 GO TO ARITH ST. FUNCT,
+ JMP G2 OTHERWISE = ASSIGNMENT STATEMENT
+C8X9 PZE 0
+*
+*
+* **************************
+* *STATEMENT IDENTIFICATION*
+* **************************
+* READ FOUR CHARACTERS AND DETERMINE CORRECT ROUTINE
+* FOR PROCESSING, THEN CHECK SPELLING ON REST
+A9T1 PZE 0
+A9T2 PZE 0
+A9T3 PZE 0
+A9 LDA K104
+ JST IA00 INPUT (4) CHARS
+ LDA IBUF
+ STA NAMF NAMF = IBUF
+ LDA IBUF+1
+ STA NAMF+1
+ LDA A9Z9 INITIALIZE INDEX FOR LOOP
+ STA XR THROUGH THE STATEMENT NAMES
+A9A LDA NAMF
+ SUB A9X1+30,1
+ SZE
+ JMP A9F READ IN REST OF
+ LDA NAMF+1 CHECK REST OF SPELLING FOR
+ SUB A9X2+30,1
+ SZE A MATCH ON 4 CHARACTERS
+ JMP A9F NOT FOUND
+ LDA A9X4+30,1
+ ANA K133
+ STA A9T1 T1 = NUMBER OF REMAINING CHARACTERS
+ LDA A9X3+30,1 LEFT TO CHECK
+ LRL 13
+ IAB
+ LGR 3
+ STA A9T2 T2 = ADDRESS OF ROUTINE
+ IAB
+ JST NP00 FIRST NON-SPECIFIC. CHECK -(A) =
+A9B LDA A9T1 HIERARCHY CODE
+ SZE
+ JMP A9C MUST CHECK MORE CHARACTERS
+ JMP* A9T2 FINISHED CHARACTER CHECK, EXIT TO
+* SPECIFIC ANALYZER.
+A9C SUB K106
+ SPL
+ JMP A9E
+ STA A9T1
+ LDA K106 REMAINING SPELLING 1S CHECKED.
+A9D STA A9T3
+ JST IA00
+ SUB A9T3
+ SNZ
+ JMP A9B
+ JST ER00
+ BCI 1,SP STATEMENT NAME MISSPELLED
+A9E ADD K106
+ IMA A9T1
+ CRA
+ IMA A9T1
+ JMP A9D
+A9F IRS XR LOOP CONTROL FOR STATEMENT NAMES.
+ JMP A9A MORE NAMES - CONTINUE LOOP
+ LDA TC
+ SUB CRET
+ SZE
+ JMP A9G
+ LDA LSTN TC = C/R
+ SNZ
+ JMP C7 AND LSTN = 0 - INPUT NEW STATEMENT
+A9G JST ER00
+ BCI 1,ID UNRECOGNIZED STATEMENT
+A9X1 BCI 10,INREDOCOLOFUSUBLEXDI
+ BCI 10,COEQGOCARECOFOIFWRRE
+ BCI 7,BAENREENASSTPA
+ BCI 2,DATR
+ BCI 1,PR
+A9X2 BCI 10,TEALUBMPGINCBROCTEME
+ BCI 10,MMUITOLLTUNTRM( ITAD
+ BCI 3,CKDFWI
+ OCT 142215 D, C/R
+ BCI 3,SIOPUS
+ BCI 2,TAAC
+ BCI 1,IN
+A9X3 DAC A3
+ DAC A4
+ DAC A5
+ DAC A6
+ DAC A7
+ DAC R1
+ DAC R2
+ DAC R3
+ DAC B2
+ DAC B3
+ DAC B4
+ DAC B5
+ DAC* R7
+ DAC* R8
+ DAC* R9
+ DAC* CONT
+ DAC* V2
+ DAC* V3
+ DAC* V4
+ DAC* V5
+ DAC* V6
+ DAC* V7
+ DAC* V8
+ DAC W5+'20000
+ DAC* W3
+ DAC* W7
+ DAC* W8
+ DAC W4,1
+ DAC* TRAC+'20000,1 TRACE STATEMENT
+ DAC* V10
+*
+* ******************************
+* *CONTINUE STATEMENT PROCESS0R*
+* ******************************
+CONT LDA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR
+ ADD LSTN ACCOUNTS FOR POSSIBLE PATH ERROR
+ STA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR
+ JMP C6
+*
+*-------------THE FOLLOWING TABLE IS USED BY STATEMENT ID
+*-------------(RIGHT 6 BITS) AND OUTPUT ITEM,
+A9X4 OCT 000003 (00)
+ OCT 030100 (01) + (A$--)
+ OCT 032313 (02) - (S$--)
+ OCT 031503 (03) * (M$--)
+ OCT 030403 (04) / (D$--)
+ OCT 000004 (05) .NOT.
+ OCT 000006 (06) .AND.
+ OCT 031405 (07) .OR. (L$-,
+ OCT 000004 (10) .LT.
+ OCT 000005 (11) .LE.
+ OCT 000002 (12) .EQ.
+ OCT 000007 (13) .GE.
+ OCT 000000 (14) .GT.
+ OCT 000000 (15) .NE.
+ OCT 031003 (16) = (H$--)
+ OCT 000005 (17) ,
+ OCT 030503 (20) 'E' (E$--)
+ OCT 031600 (21) 'C' NC$--)
+ OCT 000001 (22) 'A'
+ OCT 000000 (23)
+ OCT 000005 (24) 'X'
+ OCT 000003 (25) 'H'
+ OCT 000002 (26) 'L'
+ OCT 000000 (27) 'I'
+ OCT 000002 (30) 'T'
+ OCT 031400 (31) 'F' (L$--)
+ OCT 000001 (32) 'Q'
+ OCT 000000
+ OCT 000001
+ OCT 000001
+A9Z9 DAC* -30,1 NO. OF ITEMS IN STMNT NAME TABLE
+*
+*
+* **********************
+* *FIRST NON-SPEC CHECK*
+* **********************
+* AT FIRST SHIFT IN LEVEL FROM ZERO, WRAP-UP
+* SPECIFICATION STATEMENTS
+T0NP PZE 0
+NPT0 EQU T0NP
+T2NP PZE 0
+T1NP PZE 0
+NP00 DAC **
+ STA NPT0 T0 = (A)
+ LDA A
+ STA T1NP T1 = A
+ LDA NPT0
+ CAS K107 =7
+ JMP *+2
+ JMP NP10 TRACE STMNT. (MAY OCCUR ANYWHERE)
+ CAS SPF T0 , G.R. SPF, GO TO NP30
+ JMP NP30 T0 = SPF, G0 TO NP25
+ JMP NP25
+ LDA TC IF TC = C/R
+ SUB CRET GO TO NP10
+ SNZ
+ JMP NP10
+ JST ER00 ELSE, ILLEGAL STATEMENT
+ BCI 1,EX SPECIFICATION STATEMENT APPEARS AFTER
+*
+NP10 LDA LSTN SPECIFICATION STATEMENT CLEAN-UP
+ STA A A = LSTN
+ SNZ
+ JMP NP16 IF ZERO, RETURN
+ JST FA00 FETCH ASSIGNS
+ LDA K103 STR-REL
+ SUB AT
+ SZE
+ JMP NP20
+ LDA AF
+ JST OS00 OUTPUT STRING RPL
+NP15 JST LO00 DEFINE LOCATION
+ LDA NAMF
+ SUB A9X1+16
+ SZE
+ JST TRSE OUTPUT TRACE COUPLING
+NP16 LDA T1NP
+ STA A
+ JMP* NP00
+NP20 JST NR00 NON-REL TEST
+ JMP NP15
+NP25 LDA LIF
+ SZE
+ JMP NP16
+ LDA LSTP IF LSTP + LSTN =0
+ ADD LSTN
+ SZE
+ JMP NP10
+ IRS LSTP
+ JST ER00 'NO PATH' ERROR
+ BCI 1,PH NO PATH LEADING TO THE STATEMENT
+NP30 LDA SPF IF SPF 0 0
+ SZE
+ JMP NP37
+NP32 LDA TC
+ STA T2NP T2 = TC
+ LDA RPL
+ STA XST XST = RPL
+ LDA BDF BLOCK DATA SUBPROGRAM FLAG
+ SZE SKIP IF NOT BLOCK DATA SUBPROGRAM
+ JMP C2 GO TO RELATE COMMON
+ STA A SET LISTING FOR OCTAL ADDR.
+ LDA OMI5 JMP INSTRUCTION
+ STA DF SET LISTING FOR SYMBOLIC INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ JMP C2 GO TO RELATE COMMON
+NP35 LDA T2NP
+ STA TC
+NP37 LDA T0NP
+ STA SPF SPF = T0
+ SUB K104
+ SZE
+ JMP NP10
+NP40 STA A SET LISTING FOR OCTAL ADDR.
+ LDA XST LOCATION OF INITIAL JUMP
+ JST OS00 OUTPUT STRING
+ LDA RPL
+ STA XST XST = RPL
+ JMP NP10 GO TO NP10
+*
+* *****************
+* *IF( PROCESSOR*
+* *****************
+* ARITHMETIC IF ($1 $2 $3)
+* IF $2 NOT = $3, JZE $2
+* IF $3 NOT = $1, JPL $3
+* (IF $1 NOT = NEXT ST NO., JMP $1) LATER
+* LOGICAL IF
+* OUTPUT JZE 77777 (FOR STRINGING AROUND
+* IMBEDDED STATEMENT)
+V3 JST II00 INPUT ITEM
+ SNZ
+ JMP V310 IM=0 (POSSI8LE UNARY + OR -)
+ LDA DFL
+ SZE
+ JMP V310 FIRST ITEM IN EXPRESSION 0.K.
+V308 JST ER00 ERROR.....IF(SENSE SWITCH,.ETC).....
+ BCI 1,IF ILLEGAL IF STATEMENT TYPE
+V310 CRA (A)=0
+ JST EX00 EXPRESSION EVALUATOR
+ LDA K4
+ JST TS00 )-TEST
+ CRA
+ STA A SET A TO SPECIAL (IF) ENTRY IN DATA POOL
+ STA 0
+ LDA MFL SET MODE OF EXPRESSION INTO SPECIAL (IF)
+ LGL 9
+ STA DP,1
+ JST TRSE OUTPUT TRACE COUPLING (IF NECESSARY)
+ LDA MFL CHECK MODE FLAG FOR LOGICAL
+ SUB K103
+ SZE
+ JMP V320 ARITHMETIC IF
+ LDA LIF
+ SZE
+ JMP V308
+ STA AF SET ADDR OF SNZ AND JMP INSTR TO 00000
+ LDA OMJ2 =SNZ INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ LDA RPL SET LIF=CURRENT +DDR, (STRING BACK)
+ STA LIF
+ LDA OMI5 =JMP 0 INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ JST XN00 GO TO NEXT INPUT LINE
+ JMP C8 GO TO STATEMENT SCAN
+*
+V320 SUB K102 CHECK FOR MODE = COMPLEX
+ SNZ
+ JMP V308 ERROR,...COMPLEX MODE EXPRESSION
+ LDA V356 =-3
+ STA I
+V324 JST IS00 INPUT STATEMENT NUMBER
+ JST STXI SET INDEX TO I
+ LDA A
+ STA T1V3+3,1 SAVE BRANCH ADDRESSES
+ IRS I I=I+1
+ JMP V350 CHECK FOR TERMINAL COMMA
+ LDA T3V3
+ CAS T2V3 CHECK FOR ADDR-2 = ADDR-3
+ JMP *+2
+ JMP V330 ADDR-2 = ADDR-3
+ CRA
+ STA A
+ LDA OMJ2 =SNZ INSTR.
+ STA DF
+ JST OA00 OUTPUT ABSOLUTE
+ LDA T2V3
+ JST V360 OUTPUT A JMP(ADDR-2) INSTR.
+ LDA T3V3
+V330 CAS T1V3 CHECK FOR ADDR-3 = ADDR-2
+ JMP *+2
+ JMP V340 ADDR-3 = ADDR-1
+ CRA
+ STA A
+ LDA OMJ3 =SMI INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ LDA T3V3
+ JST V360 OUTPUT A JMP (ADDR-3) INSTR.
+V340 LDA T1V3
+ STA IFF SET IFF ' ADDR-1
+ JMP C5 GO TO ILL-TERM
+*
+V350 LDA K5
+ JST TS00 COMMA TEST
+ JMP V324 INPUT NEXT STATEMENT NO.
+*
+V356 OCT 177775 -3
+*
+*---------------SUBROUTINE TO OUTPUT A RELATIVE JMP
+V360 DAC **
+ STA A SET ADDR. OF JUMP REF. TO A
+ CRA
+ IAB SET (B) = 0
+ LDA OMI5 SET (A) = JMP INSTR.
+ JST OB00 OUTPUT OA
+ JMP* V360 EXIT
+*
+T1V3 *** ** ADDR-1
+T2V3 *** ** ADDR-2
+T3V3 *** ** ADDR-3
+*
+* *******
+* *GO TO*
+* *******
+* CHECK FOR NORMAL (R740), COMPUTED (R710) OR
+* ASSIGNED (R730). INPUT BRANCH LIST USED BY BOTH
+* R710 AND R730 FOR STATEMENT NO. LIST.
+*
+*
+R7 JST XN00 EXAMINE NEXT CHAR
+ SZE
+ JMP R78 GO TO TEST DFL
+ JST IS00 INPUT STMNT =
+ LDA A (GO TO 20)
+ STA IFF IFF = A
+ JMP C5 G0 TO ILLTERM
+R78 LDA DFL
+ SZE
+ JMP R7D
+ JST IR00 GO TO I (10, 20, 30}
+ LRL 32
+ LDA K206 OUTPUT JMP* INSTRUCTION
+ JST OB00 OUTPUT OA
+ LDA K134
+ JST TS00 , TEST
+ JST IB00 INPUT BRANCH LIST
+ JMP B6 GO TO JUMP
+R7D JST IB00 INPUT BRANCH LIST GO TO (10,11,12), I
+ LDA K134
+ JST TS00 , TEST
+ JST IR00 INPUT INT VAR
+ LRL 32
+ LDA K200 OUTPUT LDA
+ JST OB00 OUTPUT OA
+ CRA
+ STA A
+ STA AF CAUSE OCTAL ADDRESS IN LISTING
+ LDA K75
+ JST OA00 OUTPUT ABS (STA 0) - INDEX LOAD
+ LDA RPL
+ STA AF CAUSE RPL T0 BE IN LISTING
+ LDA K207
+ JST OR00 OUTPUT RELATIVE (JMP RPL,1)
+ LDA L0
+R7F SUB K101
+ STA I I = L (0)
+ JST STXI
+ LDA DP,1
+ STA A
+ JST STXA
+ SNZ
+ JMP B6 FINISHED LOOPING ON LIST
+ LLL 16
+ LDA K201 OUTPUT JMP INSTRUCTIONS
+ JST OB00 OUTPUT OA (JMP 0)
+ LDA I
+ JMP R7F
+* *******************
+* *INPUT BRANCH LIST*
+* *******************
+* INPUT STATEMENT NO. LISTS FOR GO TO PROCESSOR
+IB00 DAC **
+ LDA L0
+ SUB K101
+ STA I I = L0-1
+ JST CH00 INPUT CHAR
+ LDA K17
+ JST TS00 (- TEST
+IB10 JST IS00 INPUT STMNT =
+ JST STXI
+ LDA A
+ STA DP,1 SET POINTER OF ST. N0. INTO TRIAD TABLE
+* AREA
+ LDA I DP (J) = A
+ SUB K101
+ STA I I = I-1
+ LDA TC IF TC = , GO TO IB10
+ SUB K5
+ SNZ
+ JMP IB10 CONTINUE LOOP
+ CRA
+ STA DP-1,1 SET END FLAG INTO TABLE
+ JST IP00 )- INPUT OPEN
+ JMP* IB00 EXIT
+K75 STA 0
+*
+*
+* ********
+* *ASSIGN*
+* ********
+* CHECK TO SEE THAT 'TO' IS INCLUDED PROPERLY
+W3 JST IS00 INPUT STMNT =
+ LDA A
+ STA T1W3 SAVE A
+ LDA TC
+ SUB K34 CHECK FOR T0
+ SZE
+ JMP W305 CLEAR A FOR OUTPUT REL
+ STA A CAUSE OCTAL ADDRESS IN LIST
+ JST CH00 INPUT CHAR
+ LDA TC
+ SUB K35
+ SNZ
+ JMP *+3
+W305 JST ER00 ERROR
+ BCI 1,TO GO TO IN ASSIGN STATEMENT
+ LDA RPL
+ ADD K102
+ STA AF OUTPUT REL LDA *+2
+ LDA K200 OUTPUT LDA *+2
+ JST OR00 OUTPUT REL
+ LDA RPL
+ ADD K102
+ STA AF OUTPUT REL JMP *+2
+ LDA K201
+ JST OR00 OUTPUT OA
+ LRL 32
+ LDA T1W3
+ STA A RESTORE A
+ CRA
+ JST OB00 OUTPUT DAC ST. NO.
+ JST IR00 INPUT INTEGER VARIABLE
+ LRL 32
+ LDA K202 OUTPUT STA INSTRUCTION
+ JST OB00 OUTPUT OA
+ JMP A1 GO TO C/R TEST
+T1W3 PZE ** TEMP STORE
+*
+*
+* ************************
+* *DO STATEMENT PROCESSOR*
+* ************************
+* STACK INFO IN DO TABLE. OUTPUT DO INITIAL
+* CODE
+C9T0 PZE **
+C9 JST IS00 INPUT STATEMENT =
+ JST NR00 NON-REL TEST
+ LDA A
+ STA C9T0 T0 = A
+ JST UC00 UNINPUT COLUMN
+ JST IR00
+ LDA C951
+ JST TS00
+ LDA C9T0 (A) = T0
+ IAB
+ JST DP00 DO INPUT
+ JST DS00 DO INITIALIZE
+ JMP C5 GO TO ILLTERM
+C951 OCT 16 =
+*
+*
+* **********
+* *END FILE*
+* **********
+* ***********
+* *BACKSPACE*
+* *REWIND *
+* ***********
+V6 LDA K71
+V6A STA NAMF+1
+ JST NF00 SET UP NAMF
+ JST OI00 OUTPUT I/0 LINK
+ JMP A1 GO TO C/R TEST
+V7 LDA K72
+ JMP V6A
+V8 LDA K73
+ JMP V6A
+K71 BCI 1,FN FN
+K72 BCI 1,DN
+K73 BCI 1,BN BN
+*
+*
+* **************
+* *READ *
+* *WRITE *
+* *INPUT FORMAT*
+* **************
+* LIST ELEMENT DATA AND IMPLIED DO CONTROL
+* STACKED IN TRIAD TABLE. PROCESSED BY
+* OUTPUT TRIAD ROUTINE, SPECIAL OPERATORS
+* ARE -I = DO INITIALIZATION
+* T = DO TERMINATION
+* Q = I/0 ARG TRANSFER
+T0V5 PZE **
+V5 LDA K41 FSRN
+ STA NAMF+1
+ JST XN00 EXAM NEXT CHAR
+ SZE
+ JMP V5A GENERAL READ
+ LDA V5K4
+ JMP V10A CARD READ
+V4 LDA K40 NAWF = F$WN
+ STA NAMF+1
+V5A JST NF00 SET UP REMAINING NAME
+ LDA D
+ STA V5T1
+ JST CH00 INPUT CHARACTER
+ LDA K17 ='250......(
+ JST TS00 (-TEST
+ JST OI00 OUTPUT I0 LINK
+ LDA TC IF TC .NE. ,
+ SUB K134 ='17 (,)
+ SZE G0 10 V5J
+ JMP V5J
+ JST V5X INPUT FORMAT
+V5B JST IP00 ) - INPUT OPERATOR
+ LDA TC
+ SUB CRET TEST FOR TC=C/R
+ SZE
+ JMP V5C N0, G0 TO V5C
+V5B2 LDA K42 YES. NAMF = ND
+ STA NAMF+1
+ JST CN00 CALL NAME
+ LDA V5T1
+ STA D
+ JMP A1 G0 TO C/R TEST
+V5C JST UC00
+V5C5 CRA
+ STA IOF IOF = 0
+V5D JST II00 INPUT ITEM
+ SZE
+ JMP V5E IF (A) NOT 0, GO TO V5E
+ LDA K17
+ JST TS00 (-TEST
+ CRA
+ STA O2 O2 = 0
+ LDA IOF
+ STA O1 01 = IOF
+ LDA V5K1 = '27
+ STA P
+ JST ET00
+ LDA L
+ STA IOF IOF = L
+ JMP V5D GO TO V5D
+V5E JST NC00 NON-CONSTANT TEST
+ LDA IU IF IU NOT ARR
+ SUB K103
+ SZE
+ JMP V5H GO TO V5H
+ LDA TC
+ SUB K17 IF TC NOT -(,
+ SZE
+ JMP V5G GO TO V5G
+ LDA D0
+ STA T0V5 T5 = D0
+ LDA K103
+ TCA
+ JST EX00 EXPRESSION
+ LDA T0V5
+ STA D0 D0 = T5
+V5E5 LDA A
+ STA O2
+ LDA D0 O2 = D0
+ STA O1
+ LDA V5K2 ='32
+ STA P
+ JST ET00 ENTER TRIAD
+V5E7 LDA TC IF TC = COMMA
+ SUB K134 GO T0 V5D
+ SNZ
+ JMP V5D
+ LDA IOF I = IOF
+ STA I
+ SZE IF NOT ZERO,
+ JMP V5F GO TO V5F
+ JST OT00 OUTPUT TRIADS
+ JMP V5B2 GO TO V5B2
+V5F JST IP00 )-INPUT OPERATOR
+ JST STXI
+ LDA DP+1,1
+ STA IOF IOF = O1 (I)
+ JMP V5E7
+V5G JST KT00 K = = WDS/ITEM
+ JMP V5E5 GO TO V5E5
+V5H JST TV00 TAG VARIABLE
+ LDA TC
+ SUB K16X ='16 (=)
+ SZE GO TO V5E5
+ JMP V5E5 ELSE,
+ JST IT00 INTEGER TEST
+ LDA IOF
+ SNZ IF IOF = ZERO OR L
+ JMP V5H7
+ SUB L
+ SZE
+ JMP *+3 ERROR
+V5H7 JST ER00
+ BCI 1,PR PARENTHESES MISSING IN DO STATEMENT
+ JST DP00 DO INPUT
+ LDA IOF
+ STA I
+ JST STXI
+ LDA D
+ STA DP,1 O2(IOF) = D
+ STA O2 O2 = D
+ LDA V5K3 ='30
+ STA P
+ JST ET00 ENTER TRIAD 'T'.
+ JMP V5F
+V5J CRA
+ STA A A = 0
+ JST OA00 OUTPUT ABSOLUTE
+ JMP V5B
+V5T1 PZE 0
+V5K1 OCT 27
+V5K2 OCT 32
+V5K3 OCT 30
+V5K4 BCI 1,R3
+V5K5 BCI 1,W4
+V5X DAC ** INPUT FORMAT
+ JST XN00 EXAM NEXT CHARACTER
+ SZE
+ JMP V5X5 GO TO INPUT ARRAY NAME
+ JST IS00 INPUT STMNT NO.
+V5X2 LRL 32 OUTPUT DAC A
+ JST OB00 OUTPUT 0A
+ JMP* V5X RETURN
+V5X5 JST NA00 INPUT NAME
+ JST AT00 ARRAY TEST
+ JMP V5X2
+* PRINT
+V10 LDA V5K5 PRINTER
+V10A STA NAMF+1
+ JST NF00 SET UP REST 0F NAME
+ JST CN00 CALL NAME
+ JST V5X INPUT FORMAT
+ LDA TC
+ SUB K134
+ SZE SKIP IF COMMA
+ JMP V5B2
+ LDA D
+ STA V5T1
+ JMP V5C5
+*
+*
+* **************************
+* *FORMAT *
+* *INPUT FORMAT STRING *
+* *INPUT NUMERIC FORMAT STR*
+* *NON ZERO TEST STRING *
+* **************************
+T0V2 PZE 0
+T2V2 PZE 0
+V2T0 EQU T0V2
+V2T2 EQU T2V2
+V2 LDA K17
+ JST OK00 OUTPUT RACK
+ CRA
+ STA T0V2 TO = 0
+ LDA LSTP IF LSTOP .NE. 0
+ SZE
+ JMP V2K GO TO V2K
+V2A JST SI00 INPUT FORMAT STRING
+ SZE
+ JMP V2B
+V2A1 LDA TC
+ SUB K12 IF TC NOT MINUS
+ SZE
+ JMP V2F GO TO V2F
+ JST IN00 INPUT NUMERIC FORMAT STRING
+ CRA
+ STA TID TID = 0
+V2B LDA TC IF TC .NE. P
+ SUB K46
+ SZE
+ JMP V2H GO TO V2H
+ JST SI00 INPUT FORMAT STRING
+ SZE
+ JST NZ00 IF (A) .NE. 0
+V2C LDA TC
+ CAS K52 IF TC = D,E,F, OR G
+ NOP
+ JMP *+2
+ JMP V2DA
+ CAS K53
+ JMP V2E5-2
+ NOP
+ JST IN00 INPUT NUMERIC FORMAT STRING
+ JST NZ00 NON-ZERO STRING TEST
+ LDA K10
+ JST TS00 PERIOD TEST
+V2D JST IN00 INPUT NUMERIC FORMAT STRING
+V2DA LDA TC IF TC = )
+ SUB K4
+ SZE
+ JMP V2E
+ JST CH00
+ JST OK00 INPUT CHAR AND OUTPUT PACK
+ LDA T0V2 IF F4 + ( Z (
+ SUB K101 GO TO V2E
+ STA T0V2
+ SPL
+ JMP V2N ELSE,
+ JMP V2DA
+* GO TO C/R TEST
+V2E LDA TC IF TC =,
+ SUB K5
+ SNZ
+ JMP V2A GO TO V2A
+ LDA K9
+ JST TS00 / TEST
+ JMP V2A
+V2E5 JST SI00 INPUT FORMAT STRING
+ SZE IF (A) NOT 0,
+ JMP V2B GO TO V2B
+ LDA DFL IF DFL .NE. ZERO,
+ SZE
+ JMP V2DA GO TO V2DA
+ JMP V2A1
+V2F LDA TC IF TC = H
+ CAS K48
+ JMP *+2
+ JMP V2P GO TO V2P
+V2FB CAS K47
+ JMP *+2
+ JMP V2E5
+ CAS K17 IF TC = (,
+ JMP *+2
+ JMP V2Q GO TO V2Q
+ LDA TC IF TC .NE. A,I, OR L
+ CAS K49 A
+ JMP *+2
+ JMP V2G
+ CAS K50 I
+ JMP *+2
+ JMP V2G
+ SUB K51 L
+ SZE
+ JMP V2C
+V2G JST IN00 INPUT NUMERIC FORMAT STRING
+ JST NZ00 NON-ZERO STRING TEST
+ JMP V2DA
+V2H JST NZ00 NON-ZERO STRING TEST
+ LDA TC
+ SUB K48
+ SZE
+ JMP V2F
+V2J JST HS00 TRANSMIT HOLLERITH STRING
+ JMP V2E5 GO T0 V2E5
+V2K LDA LSTN IF LSTN = 0,
+ SZE
+ JMP *+3
+ JST ER00 ERR0R, NO PATH
+ BCI 1,NF NO REFERENCE T0 FORMAT STATEMENT
+ LDA RPL LIF = RPL
+ STA LIF
+ CRA
+ STA A
+ STA AF
+ AOA
+ STA DF
+ LDA K201 = JMP 0
+ JST OA00 OUTPUT ABS
+ JMP V2A GO T0 V2A
+*
+NZ00 DAC **
+ LDA TID
+ SZE
+ JMP* NZ00
+NZ10 JST ER00
+ BCI 1,NZ NON-ZERO STRING TEST FAILED
+IN00 DAC **
+ JST SI00 (A) = 0 IS ERROR CONDITION
+ SZE
+ JMP* IN00
+ JMP NZ10
+SI00 DAC **
+ CRA
+ STA TID ID = T2 = 0
+SI05 STA V2T2
+ JST CH00 INPUT CHAR
+ JST OK00 OUTPUT PACK
+ LDA TC
+ SUB K60 ASC-2 ZERO
+ CAS K124
+ JMP SI10
+ NOP
+ SPL
+ JMP SI10
+ STA TC
+ LDA TID TID = 10*TID+TC
+ ALS 3
+ ADD TID
+ ADD TID
+ ADD TC
+ STA TID
+ LDA K101 T2 =1
+ JMP SI05
+SI10 LDA V2T2 (A) = ERROR CONDITION OR NOT
+ JMP* SI00
+V2M JST ER00
+ BCI 1,FR FORMAT STATEMENT ERROR
+V2N EQU A1
+V2P LDA K101
+ STA ID ID = 1
+ JMP V2J GO T0 V2J
+V2Q LDA T0V2
+ AOA
+ STA T0V2
+ SUB K103
+ SZE
+ JMP V2A
+ JMP V2M
+K46 OCT 320 0P
+K47 OCT 330 0X
+K48 EQU K14 0H
+K49 OCT 301 0A
+K51 OCT 314 0L
+K52 EQU K11 0D
+K53 OCT 307 0G
+K50 EQU K43 0I
+*
+*
+* *******
+* *STOP *
+* *PAUSE*
+* *******
+* PAUSE AND STOP CENERATE CALLS TO F$HT
+T1W7 PZE 0
+T2W7 PZE 0
+W7 LDA K55
+ STA T1W7
+W7A LDA K74
+ STA NAMF+1 NAMF = F$HT
+ JST NF00 SET-UP REMAINING CHAR 0F NAME
+ JST XN00 EXAMINE NEXT CHAR
+ LDA TC
+ SUB CRET
+ SNZ
+ JMP W7C TC = C/R - NOTING FOLLOWING
+ JST IV00 INPUT INTEGER/VARIA8LE
+ LRL 32
+ LDA K200 OUTPUT LDA
+ JST OB00 OUTPUT OA
+W7C JST CN00 CALL NAME
+ CRA
+ STA DF DF = 0
+ LDA T1W7
+ STA ID
+ JST AI00 ASSIGN INTEGER CONSTANT
+ CRA OUTPUT DAC
+ JST OB00 OUTPUT OA OF ST/PA OR HT
+ LDA T1W7
+ SUB K54
+ SNZ
+ JMP C5 PA-NOT THE CASE
+ LDA RPL
+ STA AF OUTPUT JMP *
+ CRA
+ STA A CAUSE LISTING TO HAVE OCTAL ADDRESS
+ LDA K201
+ JST OR00 OUTPUT RELATWE
+ JMP B6
+W8 LDA K54
+ JMP W7+1
+K74 BCI 1,HT HT
+K54 BCI 1,PA PA
+K55 BCI 1,ST ST
+*
+*
+* - R8 CALL
+* GENERATES CALL DIRECTLY OR USES EXPRESSION TO
+* ANALYZE AN ARGUMENT LIST.
+R8 JST SY00 INPUT SYMBOL
+ LDA IU
+ SUB K101 =1 (SUB)
+ SZE SKIP IF IU=SUBR,
+ JST TG00 TAG SUB PROCRAM
+ LDA TC
+ SUB K17 ='250 ( ( )
+ SZE
+ JMP *+3
+G2B LDA K101 SET A=1 BEFORE EXPRESSION
+ JMP G2A
+ CRA
+ IAB (B)=0
+ LDA OMI2 =JST INSTR,
+ JST OB00 OUTPUT 0A
+ JMP A1 CR TEST
+* **********************
+* *ASSIGNMENT STATEMENT*
+* **********************
+G2 LDA K104
+ JST NP00 FIRST NON-SPEC CHECK
+ JST II00 INPUT ITEM
+ LDA K102 SET A = 2 BEFORE EXPRESSION
+G2A TCA
+ JST EX00
+ JMP A1
+*
+*
+* ********
+* *RETURN*
+* ********
+* OPTIMIZES EXIT CODING FOR FUNCTIONS TO MINIMIZE
+* FETCHES OF THE FUNCTION VALUE.
+R9 LDA SBF A = SBF,
+ STA A IF ZERO, GO TO ERROR
+ SZE
+ JMP *+3
+ JST ER00
+ BCI 1,RT RETURN NOT ALLOWED IN MAIN PROGRAM
+ LDA SFF ELSE, IF SFF = 0,
+ SNZ
+ JMP R9C GO TO R9C
+ CAS K101 IF SFF = 1, GO TO R98
+ JMP *+2
+ JMP R9B
+ STA AF OUTPUT REL JMP TO 1ST RETN
+ LRL 32
+ STA A SET A=0 TO OUTPUT OCTAL ADDR ON LISTING
+ LDA K201
+ JMP R9A
+R9B IAB
+ LDA RPL SFF = RPL
+ STA SFF
+ LDA K56 0UTPUT ITEM (F,A)
+ JST OM00
+R9C LRL 32
+ STA A SET FOR OCTAL ADDHESS IW LISTING
+ STA AF SET RELATIVE ADDRESS TO ZERO
+ LDA K206 JUMP I, 0
+R9A JST OR00 OUTPUT REL
+ JMP B6 EXIT
+K56 OCT 31 P CODE FOR 'F' (FETCH)
+*
+*
+* ********************
+* *STATEMENT FUNCTION*
+* ********************
+* OLD ASSIGN VALUES ARE SAVED IN SFTB AND ARE
+* RESTORED AT COMPLETION.
+G1T0 PZE 0
+G1T1 PZE 0
+G1 LDA K103 (A) = 3
+ JST NP00 FIRST NON-SPEC CHECK
+ JST SY00 INPUT SYMBOL
+ JST LO00 DEFINE LOCATION
+ LDA K103
+ STA I
+ JST GE00 GENERATE SUBPROGRAM ENTRANCE
+ LDA I
+ STA G1T1 T1 = I
+ LDA K16X '=' TEST
+ JST TS00
+ JST II00 INPUT ITEM
+ CRA
+ JST EX00 EXPRESSION
+ LDA G1T1
+ STA I I = T1
+ IRS TCF TCF = TCF+1
+G1A JST STXI
+ LDA SFTB+2,1
+ STA A
+ LDA SFTB+0,1
+ IAB
+ JST STXA SET R TO A
+ IAB
+ STA DP,1
+ JST STXI SET R TO I
+ LDA SFTB+1,1
+ IAB
+ JST STXA SET R TO A
+ IAB
+ STA DP+1,1
+ LDA I
+ SUB K103 I = I-3 = 0
+ STA I
+ SUB K103
+ SZE
+ JMP G1A NO, GO TO G1A
+ LDA T1NP
+ STA A
+ LLL 16
+ LDA OMJ1
+ JST OB00
+ JST TG00 TAG SUBPROGRAM
+ JMP A1 GO TO C/R TEST
+* - W5 END
+* ***************
+* *END PROC6SSOR*
+* ***************
+* FIRST CHECK SUBPROGRAMS FOR CORRECT USAGE, THEN
+* GENERATE MAP AND STRING BACK VARIABLES
+* AND CONSTANTS.
+T1W5 PZE
+W5 LDA BDF IF BLOCK DATA,
+ SZE
+ JMP W5K GO TO W5K
+ LDA SBF IF SBF NOT ZERO
+ STA A INDICATES SUBROUTINES
+ SZE OR FUNCTION,
+ JMP W5M GO TO W5M
+W5B CRA
+ STA A A = J=0
+ JMP W5H
+W5D JST FA00 FETCH ASSIGNS
+ JST STXA
+ LDA NT
+ SZE IF NT=L (CONSTANT)
+ JMP W5O GO TO W5O
+ LDA IU
+ SUB K101 IF IU=1
+ SZE INDICATES VARIABLE,
+ JMP W5T GO TO W5T
+W5F LDA RPL SAVE RPL
+ STA T1W5 RPL=-AF (INHIBIT LISTING)
+ LDA AF
+ SSM
+ STA RPL
+ CRA
+ JST OR00 OUTPUT REL
+ LDA T1W5 RESTORE RPL
+ STA RPL
+W5H LDA A A=A+5
+ ADD K105
+ STA A
+ SUB ABAR IF A=ABAR, (DONE)
+ SUB K105
+ SZE
+ JMP W5D ELSE, GO TO W5D
+W5J JST FS00 FLUSH BUFFER
+ LDA SBF
+ SZE
+ LDA W5Z1
+ ERA W5Z2
+ STA OCI
+ LDA SBF
+ SZE
+ LDA W5Z3
+ STA OCI+1
+ LDA K106
+ STA OCNT
+ JST FS00
+ JMP A051 GO TO INITIALIZE
+W5K LDA RPL IF RPL NOT ZERO,
+ SNZ
+ JMP W5J
+ JST ER00 ERROR-CODE GENERATED
+ BCI 1,BD IN A BLOCK DATA SUBPROGRAM
+W5M JST FA00 FETCH ASSIGNS
+ LDA SFF IF FUNCTION,
+ SZE
+ JMP W5N GO TO W5N
+ JST NU00 NO USE TEST
+ JST STXA
+ LDA DP,1 IF NO ERROR,
+ SSM NT(A)=1
+ STA DP,1
+ JMP W5B GO T0 W5B
+W5N LDA IU
+ SUB K102 IU MUST BE VAR/CON,
+ SNZ ELSE,
+ JMP W5B
+ JST ER00 ERROR-FUNCTION
+ BCI 1,FD NAME NOT DEFINED BY AN ARITHM, STATEMENT
+W5O LDA IU IF IU=VAR/CON
+ SUB K102
+ SZE
+ JMP W5H
+ LDA AT AND AT = STR/REL
+ SUB K103 A "STRING" REQ'D.
+ SZE
+ JMP W5H
+W5P LDA D0 IF D0 IS 4, THE
+ SUB K104 CONSTANT IS COMPLEX,
+ SZE OTHERWISE
+ JMP W5Q GO TO W5Q
+ LDA AF
+ JST OS00 OUTPUT STRING
+ JST STXA
+ LDA DP+2,1 OUTPUT 4 WORDS
+ JST W5X OF CONSTANT
+ LDA DP+3,1
+ JST W5X
+ LDA NT
+ SNZ
+ JMP W5S
+ LDA A INCREMENT A
+ ADD K105
+ STA A
+ JST STXA
+ JMP W5S
+W5Q LDA AF
+ JST OS00 OUTPUT STRING
+ JST STXA
+ LDA D0 IF D0=1,
+ SUB K101 INDICATES INTEGER,
+ SNZ
+ JMP W5R GO TO W5R
+W5S LDA DP+2,1 OUTPUT TWO WORDS
+ JST W5X FLOATING POINT CONSTANT
+ LDA DP+3,1
+ JST W5X
+ LDA D0 IF DOUBLE PRECISION,
+ SUB K103
+ SZE
+ JMP W5H
+W5R LDA DP+4,1 OUTPUT THE 3RD WORD
+ JST W5X
+ JMP W5H GO TO W5H
+W5T LDA AT
+ CAS K103
+ JMP W5F STRONG VARIABLE (IU = NON 0)
+ JMP W5T5
+ CAS K102 TEST FOR STG ABS ADDRESS
+ OCT 17400
+ JMP *+2
+ JMP W5F NO
+ LDA DP+4,1 TEST FOR PREFIX G
+ ANA *-4
+ SUB *-5
+ SZE
+ JMP W5F STRONG VARIABLE (IU = NON 0)
+W5T5 LDA IU
+ SZE
+ JMP W5P
+ JST ER00
+ BCI 1,US
+W5X DAC **
+ LRL 16
+ STA DF
+ IAB
+ JST OA00 OUTPUT ABS
+ JST STXA REST "A"
+ JMP* W5X EXIT
+W5Z1 EQU K100 000377
+W5Z2 EQU K122 040000
+W5Z3 EQU K116 177400
+*
+*
+*
+*
+*
+* ************************
+* *INPUT CHAR/OUTPUT PACK*
+* ************************
+PO00 DAC **
+ JST CH00 INPUT CHAR
+ JST OK00 OUTPUT PACK
+ JMP* PO00 RETURN
+* ************************
+* *TRANS HOLLERITH STRING*
+* ************************
+* FORM HOLLERITH STRING, CHARACTER COUNT IN ID 0N
+* ENTRY. C/R WILL ALSO TERMINATE STRING.
+HS00 DAC **
+HS10 JST IC00 INPUT 1 CHARACTER
+ CAS CRET CHECK FOR CHAR = C/R
+ JMP *+2
+ JMP HS15 HOLLERITH STRING EXTENDS PAST END 0F CARD
+ JST OK00 OUTPUT PACK THE CHARACTER
+ LDA ID
+ SUB K101 REDUCE CHARACTER COUNT BY 1
+ STA ID
+ SZE
+ JMP HS10 INPUT MORE CHARACTERS
+ JMP* HS00
+HS15 JST ER00
+ BCI 1,HS HOLLERITH STRING EXTENDS OVER STATEMENT
+*
+*
+* **********
+* *DO INPUT*
+* **********
+* SET UP DO TABLE ENTRIES.
+DP00 DAC **
+ LDA D D = D+5
+ ADD K105 IFLG = NON-ZERO
+ STA IFLG
+ STA D
+ ADD DO I = D0+D
+ STA I
+ JST STXI
+ LDA A DP (1-4) = (B)
+ STA DP-2,1 DP (1-2) = A
+ IAB
+ STA DP-4,1
+ JST IV00 INPUT INT VAR/CON
+ LDA K134 = ,
+ JST TS00 COMMA TEST
+ JST STXI
+ LDA A
+ STA DP,1 DP(I) = INITIAL VALUE POINTER
+ JST IV00 INPUT INT VAR/CON
+ JST STXI
+ LDA A
+ STA DP-1,1 DP (I-1) = A - FINAL VALUE POINTER
+ LDA TC
+ SUB K134 = ,
+ SZE IF THIRD TERM
+ JMP DP20
+ JST IV00 READ AND ASSIGN,
+DP10 JST STXI
+ LDA A
+ STA DP-3,1 DP(I-3) = INCREMENT POINTER
+ CRA
+ STA IFLG CLEAR IFLAG
+ JMP* DP00 EXIT
+DP20 LDA K101
+ STA ID THIRD TERM = 1
+ JST AI00 ASSIGN CONSTANT
+ JMP DP10
+* ***************
+* *DO INITIALIZE*
+* ***************
+* GENERATE DO INITIALIZATION CODE.
+DS00 DAC **
+ JST STXI ESTABLISH I
+ LDA DP,1 A = DP (I)
+ STA A
+ LDA K200
+ JST DS20 LOAD - LDA INITIAL VALUE
+ LDA DP-2,1
+ STA A A = DP (I-2)
+ LDA RPL
+ STA DP,1 SET RETURN ADDRESS INTO DP(I)
+ LDA K202
+ JST DS20 STORE - STA VARIABLE NAME
+ JMP* DS00
+* OUTPUT OA SUBROUTINE
+DS20 DAC **
+ IAB
+ LLL 16 SET B = 0
+ JST OB00 OUTPUT OA
+ JST STXI RESTORE I
+ JMP* DS20 RETURN
+*
+DS90 PZE 0
+*
+* ****************
+* *DO TERMINATION*
+* ****************
+* GENERATE DO TERMINATION CODE.
+DQ00 DAC **
+ JST STXI
+ LDA DP-2,1
+ STA A
+ LDA K200
+ JST DS20 OUTPUT LDA VARIABLE NAME
+ LDA DP-3,1
+ STA A
+ LDA K203
+ JST DS20 OUTPUT ADD INCREMENT
+ LDA DP-1,1
+ STA A
+ LDA OMK9
+ JST DS20 OUTPUT CAS FINAL VALUE
+ CRA
+ STA A
+ LDA RPL
+ ADD K103
+ STA AF
+ LDA DP,1
+ STA DS90
+ LDA OMI5 JUMP *+3
+ JST OR00 OUTPUT REL
+ LDA DS90
+ STA AF
+ LDA OMI5 JMP RPL (SAVED) - POINTS TO 'STA' INST.
+ JST OR00 OUTPUT REL
+ LDA OMI5 OUTPUT JMP RPL (SAVED)
+ JST OR00 OUTPUT REL
+ JMP* DQ00
+* ************
+* *EXPRESSION*
+* ************
+* THE RESULTANT OUTPUT IS A BUILT UP AOIN
+* TABLE THAT IS FURTHER PROCESSED BY SCAN.
+T0EX PZE 0
+EXT0 EQU T0EX
+T1EX PZE 0
+T2EX PZE 0
+T3EX PZE 0
+T5EX PZE 0
+T6EX PZE 0
+EXT7 PZE 0
+T9EX PZE 0
+EX00 DAC **
+ STA F F = (A)
+ LDA A SAVE POINTER TO FIRST VARIABLE
+ STA TRFA FOR LATER POSSIBLE TRACING
+ LDA D I = D+D0+10
+ ADD DO
+ ADD K125 =8
+ STA I
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ CRA
+ STA EXT0 T0 = 0
+ STA B B = 0
+ STA EXT7 T7 = 0
+ ADD EX92+12
+ LGL 9 O(1-2) = '='
+ STA DP-1,1 0 (I) = 0
+ CMA
+ STA IFLG IFLM NOT 0
+ LDA L0
+ STA DP-2,1 O(I-2) = L0
+EX10 JST STXI
+ CRA
+ STA T1EX T1 = 0
+ STA DP,1 AOIN(I) = T(1) = 0
+ STA DP+1,1
+ LDA IM IF IM NOT ZERO,
+ SZE
+ JMP EX50 GO TO EX50
+ LDA K106
+ TCA
+ STA 0
+* PERFORM TABLE SEARCH
+EX11 LDA TC GO TO ROUTINE ACCORDING
+ SUB EX90+6,1 TO TC.
+ SNZ IF NO MATCH, ERROR
+ JMP EXI1
+ IRS XR
+ JMP EX11
+ JST STXI
+ LDA LIBF SPECIAL LIBRARY FLAG
+ SZE
+ JMP EX39
+ JMP EX95 ERROR CONDITION
+EXI1 LDA EX91+6,1
+ STA 0
+ JMP 0,1 PROCESS LEADING OPERATOR
+* SPECIAL OPERATOR FLAG SET WHEN COMPILING THE FORTRAN
+* LIBRARY IN WHICH CASE THE OPERATIONS ( A= ) AND
+* ( =A ) ARE REQUIRED, THIS LOGIC WILL ALLOW THESE
+* TO BE PROCESSED WITHOUT GIVING AN ERROR MESSAGE IF THE
+* SPECIAL LIBRARY FLAG, (LIBF) IS SET TO NON-ZERO,
+*
+EX12 LDA B TC = (
+ ADD K109 B = B+16
+ STA B SXF = NON-ZERO
+ STA SXF
+EX14 JST II00 INPUT ITEM
+ JST STXI
+ JMP EX10 GO TO EX10
+EX16 JST STXI TC = *
+ LDA TC
+ LGL 9 OI (I-2) = *, B+13
+ ADD B
+ ADD K129
+ ERA DP-1,1
+ SSP
+ SNZ
+ JMP *+3
+ JST ER00 NO, CONSTR ERROR
+ BCI 1,PW * NOT PRECEDED BY ANOTHER *
+ LDA K109 (E = '20)
+ LGL 9
+ IMA DP-1,1
+ ANA K118 ='777
+ ADD K101
+ ERA DP-1,1 CHAJNE * TO **
+ STA DP-1,1
+ JMP EX14 GO TO EX14
+EX18 LDA K102 =2
+ STA TC SET TC TO -
+ LDA K125 =8
+ STA T1EX T1 = 8
+ JST STXI
+ LDA DP-1,1
+ ANA K118
+ SUB B 8 .GT. I (I-2) -B
+ SUB T1EX
+ SPL
+ JMP *+3
+EX19 JST ER00 NO, ERROR
+ BCI 1,NT LOGICAL .NOT. NOT A UNARY OPERATOR
+EX20 LDA T0EX YES
+ SZE T (0) = 0
+ JMP EX34
+EX22 LDA B YES,
+ ADD F B + + (5) .GT. 0
+ SPL NO, ERROR
+ JMP EX96
+EX24 JST STXI
+ LDA TC
+ LGL 9
+ ADD T1EX
+ ADD B
+ STA DP+1,1 OI(I) = TC , T1+B
+ JST EX99 DATA POOL CHECK
+ JMP EX14
+EX26 JST STXI
+ LDA DP-1,1
+ ANA K118 IF I (I-2) .LT. B
+ CAS B
+ JMP EX97 ERROR-----MULTIPLE + OR - SIGNS
+ NOP
+EX30 LDA K131 SET INDEX TO
+ STA 0 SEARCH OPERATOR TABLE FOR TRAILING
+EX31 LDA EX92+14,1 OPERATOR AFTER HAVING ENCOUNTERED AN
+ SUB TC ITEM 0R A NEGATE,
+ SZE
+ JMP EX32
+ LDA EX93+14,1
+ STA *+3
+ JST STXI
+ JMP* *+1
+ DAC **
+EX32 IRS XR CONTROL OPERATOR LOOP
+ JMP EX31 CONTINUE
+EX34 LDA B IF B = 0
+ SUB EXT7
+ SZE
+ JMP EX40 NO, GO TO EX40
+ LDA T0EX IF T (0) = 0
+ SZE
+ JMP EX38 NO, GO TO EX38
+EX35 CRA
+ STA IFLG IFLG = 0
+ LDA F
+ AOA
+ SMI F . GE. -1
+ JMP EX36 YES
+ JMP* EX00 RETURN - NO
+EX36 JST CA00 SCAN
+ JST OT00 OUTPUT TRIADS
+ JMP* EX00 RETURN
+EX38 JST STXI
+ LDA B
+ SUB K109
+ STA B
+ LDA K103
+ STA MFL
+ LDA T0EX
+ LGL 9 O (I) = T (0)
+ ADD B I (I) = B+9
+ ADD K124 I = I+2
+ STA DP+1,1
+ JST EX99 DATA POOL CHECK
+ CRA
+ STA T0EX T0 = 0
+ STA EXT7 T7 = 0
+EX39 LDA L0
+ STA A A = L0
+ STA IM IM NOT EQ 0
+ JMP EX10
+EX40 LDA TC TC 0 ,
+ CAS K5 ='254 (,) IN BCD MODE
+ JMP *+2
+ JMP EX41
+ SUB K134 =17
+ SZE
+ JMP EX44 NO, GO TO EX44
+EX41 LDA I
+EX42 SUB K102
+ STA XR B VS. I (J)
+ LDA DP+1,1
+ ANA K118
+ CAS B
+ JMP *+3
+ JMP EX24 EQUAL, GO TO EX24
+ JMP* EX00 LESS, RETURN
+ LDA XR GREATER, REPEAT LOOP
+ JMP EX42
+EX44 JST IP00 ) - INPUT OPERATOR
+ JMP EX30 GO TO EX30
+EX46 LDA* A
+ STA T6EX IF O1(O1(A)) = L(0)
+ LDA* T6EX
+ CAS L0
+ JMP *+2
+ JMP EX34 GO TO EX34
+ STA O2 O2 = L0
+EX48 JST ET00 ENTER TRIAD
+ JMP EX34
+EX50 JST STXI
+ LDA A A(I) = A
+ STA DP,1
+ LDA IU IU = SUB OR ARR
+ SLN
+ JMP EX30 NO, GO TO EX30
+ LDA TC
+ SUB K17 TC = (
+ SZE
+ JMP EX76 NO, GO TO EX76
+ LDA B YES, B = B+16
+ ADD K109
+ STA B
+ LDA IU IU = ARR
+ SUB K103
+ SZE
+ JMP EX75 NO, GO TO EX75
+ CRA
+ STA DP,1 A(I) = 0
+ STA X4 X4 = 0
+ STA T3EX T3 = 0
+ STA K T5 = A
+ LDA D0
+ STA T9EX T9 = D0
+ LDA A
+ STA T5EX T5 = A
+ LDA AT
+ SUB K105 AT = DUM
+ SZE
+ JMP EX74 NO, GO TO EX74
+ CRA
+ STA T2EX YES, T (0) = 0
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ LDA A
+ STA DP,1 A(I) = A
+ LDA K132 OI (I) = A, 11
+ LGL 9
+ ADD K124
+ STA DP+1,1 I=9
+EX54 LDA D0 IF D0 = 1, GO TO EX56
+ SUB K101
+ SNZ
+ JMP EX56
+ JST EX99 DATA POOL CHECK
+ JMP *+2
+EX55 IRS K K = K+1
+ LDA K
+ STA XR
+ LDA X,1
+ STA T6EX T6 = X (K)
+ JST STXI
+ LDA T6EX
+ STA DP,1 O(I) = *
+ LDA K103 I (I) = T3+13
+ LGL 9 T3 = T3+16
+ ADD T3EX A (A) = T6
+ ADD K129 =13
+ STA DP+1,1
+ ANA K118
+ ADD K103
+ STA T3EX T3 = A(A)
+EX56 JST IV00 INPUT INTEGER VARIABLE
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ LDA A A(I) = A
+ STA DP,1
+ LDA NT
+ SZE
+ JMP EX68 CONSTANT ENCOUNTERED
+ JST UC00 UNINPUT COLUMN
+ JST DN00 INPUT DO NOT ASSIGN
+ SNZ
+ JMP EX57 IM = 0
+ SUB K101
+ SNZ
+ JMP EX57 IM * INTEGEH
+ JST ER00
+ BCI 1,SU SUBSCRIPT INCREMENTER NOT A CONSTANT
+EX57 JST STXI
+ LDA K101
+ LGL 9
+ ADD T3EX
+ ADD K127
+ STA DP+1,1 O(1) = +, I(I) = T3+11
+ JST EX99 DATA POOL CHECK
+EX58 LDA T9EX
+ STA D0 RESET D(0)
+ LDA ID SUBSCRIPT SIZE
+ SUB K101 ID = ID-1
+ STA ID
+ SNZ IF ZERO, GO TO EX60
+ JMP EX60
+ LDA K
+ STA 0
+ LDA D0,1 D(K) = 0
+ SNZ
+ JMP EX67 YES - (DUMMY DIMENSION)
+ IAB
+ LDA ID
+ JST IM00
+ ADD T2EX
+ STA T2EX T2 = T2+ID*D(K)
+EX60 LDA T9EX
+ STA D0 RESET D(0)
+ LDA K
+ STA 0
+ LDA X+2,1 X(K+2) = 0
+ SNZ
+ JMP EX62 YES - FINISHED
+ LDA K134 =17
+ JST TS00 COMMA TEST
+ LDA D0+1,1
+ IAB
+ LDA D0,1
+ JST IM00
+ STA D0+1,1 D(K+1) = D(K+1)*D(K)
+ JMP EX55
+EX62 JST STXI
+ LDA DP-1,1 DOES O(--2) = *
+ SSP
+ LGR 9
+ CAS K103
+ JMP *+2
+ JMP EX66 YES.
+ SNZ NO.
+ JMP EX64 O(I-2) = 0 - YES
+ CAS K132 DOES O(I-2) = A
+ JMP EX63
+ JMP *+2 YES
+ JMP EX63
+ LDA T2EX IS T2 = 0
+ SNZ
+ JMP EX65 YES (DUMMY ARRAY (1,1,1))
+EX63 LDA K101
+ STA DP-1,1 01(I-2) = 1
+ LDA T2EX A(I) = T2
+ STA DP,1
+ LDA K137 0='X' ('24), I=2
+ STA DP+1,1
+ CRA
+ STA DP+3,1 O1(1+2) = 0
+ LDA T5EX
+ STA DP+2,1 A(I+2) = T5
+ JST EX99 DATA POOL CHECK
+ JST CA00 SCAN
+ LDA O1
+ STA A A = O1
+ JST STXA
+ LDA DP+2,1 S(A) = NON-ZERO
+ SSM
+ STA DP+2,1 S(A) = 1
+ JMP EX44
+EX64 LDA L0
+ STA DP,1 A(I) = L0
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ JMP EX63
+EX65 LDA I
+ SUB K104
+ STA I I = I-4
+ LDA T5EX
+ STA DP-4,1 A (I) = T5
+ JMP EX44
+EX66 LDA I
+ SUB K102
+ STA I I = I-2
+ JMP EX62 ASSIGN INT CONSTANT
+EX67 JST AI00
+ JST STXI SET XR TO I
+ LDA A
+ STA DP,1 A(I) = A
+ LDA K101
+ LGL 9
+ ADD T3EX
+ ADD K127
+ STA DP+1,1 OI(I) = +, T3+11
+ JST EX99 DATA POOL CHECK
+ JMP EX60
+EX68 LDA TC IS TC
+ CAS K103 = *
+ JMP *+2
+ JMP *+2
+ JMP EX58 NO
+ LGL 9
+ ADD T3EX
+ ADD K129 =13
+ STA DP+1,1 OI(I) = *, T3+13
+ JST IR00 INPUT INTEGER VAR/CON
+ JMP EX56+1
+EX69 CRA SET LISTING FOR OCTAL ADDR
+ STA A
+ LDA OMI5 JMP 0 INSTRUCTION
+ STA DF SET LISTING FOR SYMBOLIC A INSTR,
+ JST OA00 OUTPUT ABSOLUTE
+ LDA RPL
+ STA O2
+ LDA K138
+ STA P P = H
+ JST ET00 ENTER TRIAD
+ JST HS00 TRANSFER HOLLERITH STRING
+ LDA CRET (A) = C/R
+ JST OK00 OUTPUT PACK
+ CRA
+ STA 0 SET LISTING FOR OCTAL ADDR.
+ STA A SET LISTING FOR OCTAL ADDR.
+ LDA O2
+ SUB K101
+ JST OS00 OUTPUT STRING RPL-1
+ JST CH00 INPUT CHARACTER
+ JST FN00
+ JST STXI RESET INDEX TO I
+ LDA L
+ STA DP,1 A(I) = L
+ JMP EX76
+EX74 LDA AF
+ STA T2EX T2 = AF
+ JMP EX54 GO TO EX54
+EX75 LDA K134
+ STA TC TC = ,
+ JMP EX24 GO TO EX24
+EX76 LDA DP-1,1
+ LGR 9
+ ANA K133
+ SUB K134
+ SNZ
+ JMP EX34 WITHIN AN ARGUMENT LIST
+ JST ER00
+ BCI 1,AG SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST
+EX78 LDA K127
+EX79 STA T1EX T (1) = 11
+ JMP EX22
+EX80 LDA K129 T (1) = 13
+ JMP EX79
+EX81 LDA K106
+ STA T1EX T (1) = 6
+ JMP EX20
+EX82 LDA K104 T (1) = 4
+ JMP EX81+1
+EX83 LDA T0EX T (0) =0
+ SZE
+ JMP EX84
+ LDA TC YES,
+ STA T0EX T (0) = TC
+ LDA EX92+1
+ STA TC TC = -
+ LDA B
+ ADD K109
+ STA B
+ STA EXT7
+ LDA *+2
+ JMP EX79
+ DEC -5
+EX84 JST ER00 ERROR
+ BCI 1,RL MORE THAN 1 RELATIONAL OPERATOR
+EX85 LDA F
+ ADD K102 T (5) = T (5) +2 = B = 0
+ STA F
+ ADD B
+ SNZ
+ JMP EX24
+ JST ER00 ERROR
+ BCI 1,EQ MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF =
+EX90 OCT 250 (
+ OCT 3 *
+ OCT 5 NOT
+ OCT 1 +
+ OCT 2 -
+ OCT 310 H
+EX91 DAC EX12 (
+ DAC EX16 *
+ DAC EX18 NOT
+ DAC EX26 +
+ DAC EX26 -
+ DAC EX69 H
+EX92 OCT 1 +
+ OCT 2 -
+ OCT 3 *
+ OCT 4 /
+ OCT 6 AND
+ OCT 7 OR
+ OCT 15 NE
+ OCT 12 EQ
+ OCT 14 GT
+ OCT 10 LT
+ OCT 13 GE
+ OCT 11 LE
+ OCT 16 =
+ OCT 16 = (ERROR)
+EX93 DAC EX78 +
+ DAC EX78
+ DAC EX80 *
+ DAC EX80 /
+ DAC EX81 AND
+ DAC EX82 OR
+ DAC EX83 NE
+ DAC EX83 EQ
+ DAC EX83 GT
+ DAC EX83 LT
+ DAC EX83 GE
+ DAC EX83 LE
+ DAC EX85 =
+ DAC EX34 NONE OF THESE
+EX95 JST ER00
+ BCI 1,OP MURE THAN ONE OPERATOR IN A ROW
+EX96 JST ER00 ERROR
+ BCI 1,PA OPERATOR MUST BE WITHIN PARENTHESES
+EX97 JST ER00 ERROR
+ BCI 1,UO MULTIPLE + OR - SIGNS NOT AS UNARY OPS
+* BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW
+EX99 DAC **
+ IRS I
+ IRS I
+ LDA I
+ AOA
+ CAS L
+ NOP
+ JMP AS50
+ JMP* EX99
+K133 OCT 77
+K130 DEC -6
+K141 DEC 33
+K PZE 0
+KM8 DEC -8
+*
+*
+*
+*
+* ******************
+* *SCAN *
+* *TRIAD SEARCH *
+* *TEMP STORE CHECK*
+* ******************
+T0CA PZE 0
+T1CA PZE 0
+T2CA PZE 0
+T9CA PZE 0
+* THE AOIN TABLE IS PROCESSED FROM THE BOTTOM
+* UP AND ENTRIES ARE FORMED FOR INCLUSION
+* IN THE TRIAD TABLE, LEVELS ARE USED
+* TO CONTROL THE ORDER OF ENTRY INTO
+* THE TRIADS. SIGN CONTROL IS ALSO
+* ACCOMPLISHED IN THIS ROUTINE.
+CA00 DAC **
+ LDA L0
+ STA ACCP INDICATE EMPTY ACCUM
+CA04 JST STXI ESTABLISH I
+ STA T1CA T1 = I
+ LDA DP-1,1
+ ANA K118 IF I (I-2) = 0,
+* OR .LT. I (I)
+ STA T9CA
+ LDA DP+1,1
+ ANA K118
+ CAS T9CA
+ JMP CA08 GO TO CA08
+ NOP
+ LDA I
+ SUB K102
+ STA I I = I-2
+ STA 0
+CA08 LDA DP+3,1
+ ERA DP+1,1
+ STA T0CA
+ LDA DP+1,1
+ ANA K118
+ STA T2CA
+ LDA DP+1,1
+ SSP
+ LGR 9 P = O (I)
+ STA P
+ CAS K102 IF P IS NOT * OR /, GO TO CCA10
+ CAS K105
+ JMP CA10
+ JMP CA10
+ JMP CA14 GO T0 CA14
+CA10 LDA T0CA
+ SMI
+ JMP CA13
+ LDA KM8
+ IMA XR
+ IAB
+ LDA P
+ CAS CA90+8,1
+ JMP *+2
+ JMP *+4
+ IRS XR
+ JMP *-4
+ JMP CA45
+ LDA CA91+8,1
+ STA P
+ IAB
+ STA XR
+CA13 LDA K130
+ IMA XR
+ IAB
+ LDA P
+ CAS CA90+8,1
+ JMP *+2
+ JMP CA50
+ IRS XR
+ JMP *-4
+ IAB
+ STA XR
+ IAB
+ LDA DP+1,1
+ JMP *+2
+CA50 CRA
+ STA T0CA
+ IAB
+ STA XR
+CA14 LDA DP,1
+ STA O1 O1=A(I)
+ LDA DP+2,1
+ STA O2 O2 = A (I+2)
+ LDA T2CA
+ SNZ
+ JMP CA37 IF ZER0, GO TO CA37
+ LDA DP-1,1
+ SSP
+ LGR 9
+ STA T1CA
+ LDA DP-1,1
+ ANA K118 IF T2 .GT. I (I-2)
+ SUB T2CA
+ SPL
+ JMP CA18
+ SZE
+ JMP CA04
+ LDA O2
+ SUB ACCP
+ SZE
+ JMP CA04
+ LDA P
+ SUB K103
+ SMI
+ JMP CA39
+ LDA T1CA
+ SUB P
+ SZE
+ LDA K101 GO TO
+ ADD K101 P = - OR +
+ STA P
+CA18 LDA I
+ STA 0 J=I
+CA20 LDA DP+2,1
+ STA DP,1 AOIN(J) = AOIN(J+2)
+ LDA DP+3,1
+ STA DP+1,1
+ SSP
+ SNZ
+ JMP CA22
+ IRS XR J = J+2
+ IRS XR
+ JMP CA20
+CA22 JST STXI
+ LDA DP+1,1
+ SSP IF O (I) = ,
+ LGR 9
+ CAS P
+ JMP CA24
+ CAS K134
+ JMP CA24
+ JMP CA30 GO TO CA30
+CA24 JST ST00 TRIAD SEARCH
+ LDA P
+ CAS K132 IF P = +,*, AND, OR
+ JMP CA28
+ JMP CA37 GO TO CA37
+ CAS K107
+ JMP CA28 ELSE, GO TO CA26
+ JMP CA37
+ CAS K106
+ JMP CA28
+ JMP CA37
+ CAS K103
+ JMP CA28
+ JMP CA37
+ CAS K101
+ JMP CA26
+*
+*
+*
+ JMP CA37
+CA26 CAS K102
+ JMP *+2 IF P = -
+ JMP CA35 GO TO
+CA28 LDA O1
+ JST TC00 TEMP STORE CHECK
+CA30 LDA O2
+ JST TC00 TEMP STORE CHECK
+CA31 JST ET00 ENTER TRIAD
+CA32 JST STXI
+ LDA O1
+ STA DP,1
+ LDA DP+1,1
+ LRL 15
+ LDA T0CA
+ LGR 15
+ LLL 15
+ STA DP+1,1
+ LDA T2CA IF T2 NOT ZERO,
+ SZE
+ JMP CA04 GO TU CA04
+ JMP* CA00 ELSE, RETURN
+CA35 LDA T0CA
+ ERA ='100000
+ STA T0CA
+CA37 LDA O2
+ IMA O1 O1 * = O2
+ STA O2
+ SNZ IF 02 = 0,
+ JMP CA32 GO TO CA32
+*
+*
+*
+ JST ST00 TRIAD SEARCH
+ LDA T0CA
+ SMI
+ JMP CA28 GO TO CA28
+ LDA P
+ JMP CA26 ELSE, GO TO CA26
+CA39 SUB K128
+ SNZ IF P = , OR
+ JMP CA04
+ LDA T1CA
+ SUB K104
+ SZE ELSE,
+ JMP CA18 GO TO CA18
+ JMP CA04
+CA45 LDA T1CA
+ STA I I = T1
+ STA T2CA
+ CRA
+ STA T0CA * * * * * * * * * * *
+ STA O2 O2 = C = 0
+ SUB K110 P = C
+ STA P
+ JMP CA24 GO TO CA24
+* IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES
+* ANY TRIAD TABLE ENTRY, EXIT WITH THE
+* POINTER VALUE OF THE MATCHING ENTRY
+* (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT
+* SUBEXPRESSION CALCULATIONS.
+ST00 DAC ** TRIAD SEARCH
+ LDA F
+ ADD K103
+ SZE
+ JMP ST10 GO TO ST10
+ST05 LDA P ELSE, IF P = X
+ SUB K139
+ SNZ
+ JMP CA31 GO TO CA31
+ LDA O1 ELSE, IF 01=ACCP
+ SUB ACCP
+ SNZ
+ JMP CA30 GO TO CA30
+ JMP* ST00 ELSE, RETURN
+ST10 LDA L0
+ STA XR
+ST20 LDA XR
+ SUB K103
+ STA XR J = J-2
+ SUB L IF J .LT. L
+ SPL
+ JMP ST05 GO TO ST05
+ LDA O2
+ SUB DP,1 IF O1/P/O2 .NE. O1/P/O2(J)
+ SZE
+ JMP ST20 GO TO ST20
+ LDA DP+2,1
+ SSP EXTRACT OFF STORE BIT
+ SUB P
+ SZE
+ JMP ST20
+ LDA O1
+ SUB DP+1,1
+ SZE
+ JMP ST20 O1 = J
+ LDA XR
+ STA O1
+ JST STXI ESTABLISH I
+ JMP CA32 GO T0 CA32
+* IF J IS A REFERENCE TO A TRIAD , THE TEMP
+* STORE BIT 0F THE REFERENCED TRIAD IS SET.)
+TC00 DAC ** TEMP STORE CHECK
+ STA XR
+ LDA ABAR
+ SUB XR
+ SMI IS J .GR. ABAR
+ JMP* TC00 NO.
+ LDA DP+2,1 YES.
+ SSM
+ STA DP+2,1 S(J) = 1
+ JMP* TC00
+CA90 OCT 1,2,11,10,13,14,12,15
+CA91 OCT 2,1,13,14,11,10,12,15
+*
+*
+* *************
+* *ENTER TRIAD*
+* *************
+* STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY
+* LOCATION.
+ET00 DAC **
+ JST SAV
+ LDA L
+ SUB K103 =3
+ STA L L=L-3
+ STA ACCP SET ACCUM PTR TO LAST TRIAD ENTRY
+ STA 0 J=L
+ LDA P
+ STA DP+2,1 P(J) = P
+ LDA O1
+ STA DP+1,1 O1(J) = O1
+ LDA O2
+ STA DP,1 O2(J) = O2
+ LDA 0
+ STA O1 O1=J
+ JST RST
+ JMP* ET00
+ACCP DAC ** ACCUM POINTER
+*
+*
+SFTB BSS 36 SUBFUNCTION TABLE
+* **************************
+* *GENERATE SUBPRO ENTRANCE*
+* **************************
+* OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE
+* CALL TO ARGUMENT ADDRESS TRANSFER.
+T0GE PZE 0
+GE00 DAC **
+ CRA
+ STA T0GE
+ LDA K17 ( TEST
+ JST TS00
+GE10 JST NA00 INPUT NAME
+ LDA I IFF I=0,
+ SNZ
+ JMP GE20 GO TO GE20
+ CAS K141
+ NOP
+ JMP GE30 MAKE ENTRY IN SFTB TABLE
+ ADD K103
+ STA I IF FULL, GO TO GE30
+ JST STXA SET XR TO A
+ LDA DP,1
+ IAB
+ JST STXI ESTABLISH I
+ IAB
+ STA SFTB,1
+ JST STXA SET XR TO A
+ LDA DP+1,1
+ IAB
+ JST STXI SET XR TO I
+ IAB
+ STA SFTB+1,1
+ LDA A
+ STA SFTB+2,1
+ JST STXA SET XR TO A
+ CRA
+ STA DP+1,1 CLEAR OLD USACE
+GE20 LDA K105
+ IAB
+ LDA RPL
+ ADD T0GE
+ ADD K103 (B) = DUM
+ JST AF00 DEFINE AFT (A=RPL+T0+3)
+ IRS T0GE T0 = T0+1
+ LDA K134
+ SUB TC IF TC = ,
+ SNZ
+ JMP GE10 GO TO GE10
+ JST IP00 INPUT OPERATOR
+ CRA
+ STA DF
+ JST OA00 OUTPUT ABS (0)
+ LDA T0GE
+ STA ID ID = T0
+ LDA K69
+ STA NAMF+1 NAMF = AT
+ JST NF00 FILL IN REMAINING NAME
+ JST OL00 OUTPUT OBJECT LINK
+ LDA T0GE
+ TCA
+ STA T0GE
+ CRA
+ JST OA00 OUTPUT NUMBER OF ARGS
+ IRS T0GE OUTPUT SPACE FOR ARG. ADDR.
+ JMP *-3
+ JMP* GE00 RETURN
+GE30 JST ER00 CONSTR, ERROR
+ BCI 1,AE
+K69 BCI 1,AT AT
+*
+* ****************
+* *EXCHANGE LINKS*
+* ****************
+* CL SUBA IS INTERCHANGED WITH CL SUBF
+EL00 DAC **
+ JST STXA
+ LDA DP,1
+ STA EL90 CL (F) == CL (A)
+ LDA F
+ STA 0
+ JST EL40
+ JST STXA
+ JST EL40
+ JMP* EL00
+EL40 DAC **
+ LDA DP,1
+ IMA EL90
+ ANA K118
+ IMA DP,1
+ ANA K119
+ ADD DP,1
+ STA DP,1
+ JMP* EL40
+EL90 PZE 0
+*
+*
+* *****************
+* *NON COMMON TEST*
+* *****************
+NM00 DAC ** NON-COMMON TEST
+ LDA AT
+ SUB K104
+ SZE
+ JMP* NM00
+ JST ER00
+ BCI 1,CR ILLEGAL COMMON REFERENCE
+*
+*
+* **************************
+* *NON DUMMY OR SUBPRO TEST*
+* **************************
+ND00 DAC **
+ LDA AT TEST
+ SUB K105
+ SZE
+ JMP ND10
+ JST ER00
+ BCI 1,DA ILLEGAL USE OF A DUMMY ARGUMENT
+ JMP* ND00
+ND10 JST NS00
+ JMP* ND00
+*
+*
+* *****************
+* *INPUT SUBSCRIPT*
+* *****************
+SCT0 PZE 0
+SC00 DAC **
+ STA SCT0 T0 = (A)
+ CRA
+ STA NS
+ STA S2 NS = S2 = S3 = 0
+ STA S3
+ LDA K17 (-TEST
+ JST TS00
+SC10 LDA EBAR
+ SMI
+ JMP SC15 EBAR .GR. 0
+ JST XN00 EXAMINE NEXT CHAR,
+ SZE
+ JMP SC70 IF (A) NON ZERO,
+SC15 JST IG00 GO TO SC70
+ LDA SCT0 INPUT INTEGER
+ SZE
+ SPL
+ JMP SC60
+ LDA ID
+ SUB K101
+ JMP SC30
+SC60 JST AS00 ASSIGN ITEM
+SC20 LDA A S (NS+1) = A
+SC30 IAB
+ LDA SC90
+ ADD NS
+ STA SC91
+ IAB S(NS + 1) = A
+ STA* SC91
+ LDA NS
+ AOA
+ STA NS NS = NS + 1
+ SUB K103
+ SZE
+ JMP SC50 MORE SUBSCRIPTS PERMITTED
+SC40 JST IP00 )-INPUT OPERATOR
+ JMP* SC00 RETURN
+SC50 LDA TC
+ SUB K134
+ SZE
+ JMP SC40 TERMINATOR NOT A COMMA
+ JMP SC10 G0 TO SC10
+SC70 JST IR00 INPUT INT VARIABLE
+ LDA SCT0 CHECK FOR NON-DUMMY
+ SNZ VARIABLE DIMENSIONS
+ JMP SC20
+ LDA AT
+ SUB K105
+ SNZ
+ JMP SC20
+ JST ER00
+ BCI 1,VD ILLEGAL SYMBOLIC SUBSCRIPT
+SC90 DAC S1
+SC91 DAC **
+*
+*
+* ********************
+* *INPUT LIST ELEMENT*
+* ********************
+* IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT
+IL00 DAC **
+ JST NA00 INPUT NAME
+ LDA AT
+ SUB K105 NON-DUMMY TEST
+ SZE
+ JMP *+3
+ JST ER00 USAGE ERROR
+ BCI 1,DD DUMMY ITEM IN AN EQUIV, OR DATA LIST
+ LDA IU IF IU NOT ARR,
+ SUB K103
+ SZE
+ JMP IL30 GO TO IL30
+ LDA K103
+ JST SC00 INPUT SUBSCRIPTS
+ JST FA00 FETCH ASSIGNS
+ LDA ND IF ND = NS
+ SUB NS
+ SZE S1 = D* (S1 + D1* (S2+D2*S3)
+ JMP IL10 ELSE, GO TO IL10
+ LDA S3
+ IAB
+ LDA D2
+ JST IM00
+ ADD S2
+ IAB
+ LDA D1
+ JST IM00
+ ADD S1
+ IAB
+ LDA D0
+ JST IM00
+ STA S1
+ JMP* IL00 RETURN
+IL10 LDA NS IF NS NOT 1
+ SUB K101
+ SZE
+ JMP IL20 GO TO IL20
+ LDA S1 ELSE, 20
+ IAB S1 * D0*S1
+ LDA D0
+ JST IM00
+IL18 STA S1
+ JMP* IL00 RETURN
+IL20 JST ER00
+ BCI 1,ND WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT
+ JMP* IL00 RETURN
+IL30 JST TV00 TAG VARIABLE
+ CRA S1 = 0
+ JMP IL18 RETURN
+*
+*
+* ************
+* *FUNCTION *
+* *SUBROUTINE*
+* ************
+* IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER
+* FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS
+R1 LDA K101
+ STA SFF SFF = 1
+R2 LDA LSTF
+ SZE IF LSTF = 0
+ JMP R2A
+ JST ER00 ILLEGAL STATEMENT
+ BCI 1,FS NOT FIRST STATEMENT IN SUBPROGRAM
+R2A JST NA00 INPUT NAME
+ LDA A
+ STA SBF SBF = A
+ CRA ADDR=0, S/C CODE =0
+ JST ON00 OUTPUT NAME BLOCK TO THE LOADER
+ LDA MFL
+ SZE
+ JST DM00 DEFINE IM
+ LDA TC
+ SUB CRET IF IC NOT C/R
+ SZE
+ JMP R2C GO TO
+ LDA SFF IF SFF = 0
+ SNZ
+ JMP R2D GO TO R2D
+ JST ER00 ERROR
+ BCI 1,FA FUNCTION HAS NO ARGUMENTS
+R2C CRA
+ STA I I = 0
+ JST GE00 GENERATE SUBPROGRAM ENTRY
+ JMP A1 GO TO C/R TEST
+R2D CRA
+ JST OA00 OUTPUT ABS
+ JMP C6 GO TO CONTINUE
+*
+*
+* ******************
+* *INTEGER *
+* *REAL *
+* *DOUBLE PRECISION*
+* *COMPLEX *
+* *LOGICAL *
+* ******************
+* THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE
+* VALUE AND ANY ARRAY INFO IS PROCESSED
+A3 LDA K101 INTEGER
+ JMP A7A TMFL = INT
+A4 LDA K102 REAL
+ JMP A7A TMFL = REAL
+A5 LDA K106 DOUBLE PRECISION
+ JMP A7A TMFL = DBL
+A6 LDA K105 COMPLEX
+ JMP A7A TMFL = CPX
+A7 LDA K103 LOGICAL
+A7A STA MFL TMFL = LOG
+ LDA LSTF IF LSTF = 0, GO TO A7B (2)
+ SNZ
+ JMP A7B ELSE,
+ LDA CC SAVE CC
+ STA A790
+ CRA
+ STA ICSW
+ JST DN00 INPUT DNA
+ LDA A790 RESTORE CC
+ STA CC
+ STA ICSW ICSW = IPL
+ LDA DFL IF DFL NOT = 0, GO TO A7B
+ SZE
+ JMP A7B
+ LDA TID IF ID = FUNCTI,
+ SUB A7K GO TO A9
+ SNZ SKIP IF NOT 'FUNCTION'
+ JMP A9 FUNCTION PROCESSOR
+A7A5 JST ER00 CONSTRUCTION ERROR
+ BCI 1,TF 'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST
+A7K BCI 1,FU CONSTANT FOR 'FUNCTION' CHECK
+A7B JST NA00 INPUT NAME
+ LDA MFL
+ JST DM00 DEFINE IM
+ JMP B7 GO TO INPUT DIMENSION
+A790 PZE 0
+*
+*
+* - B2 EXTERNAL
+* TAGS NAME AS SUBPROGRAM
+B2 JST NA00 EXTERNAL, INPUT NAME
+ JST TG00 TAG SUBPROGRAM
+ JMP B1 GO TO , OR C/R TEST
+*
+*
+* *****************
+* *DIMENSION *
+* *INPUT DIMENSION*
+* *****************
+* PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL
+* ARRAY POINTER ITEM
+B3T0 PZE 0
+B3T1 PZE 0
+B3T2 PZE 0
+B3T3 PZE 0
+B3 JST NA00
+B3A LDA AT IF AT = DUM
+ SUB K105 (A) = 0
+ SZE ELSE (A) = .LT. 0
+ SSM
+B3B STA B3T0 T0 = (A)
+ LDA AF
+ STA B3T3 T3 = AF
+ LDA A
+ STA B3T1 T1 = A
+ LDA AT TEST FOR AT=DUMMY
+ SUB K105 =5
+ SZE SKIP NO-USAGE TEST IF DUMMY
+ JST NU00 NO USAGE TEST
+ JST STXA
+ LDA DP+1,1 IU (A) = ARR
+ LRL 14
+ LDA K103
+ LLL 14
+ STA DP+1,1
+ LDA B3T0 (A) = T0
+ JST SC00 INPUT SUBSCRIPT
+ LDA S1
+ STA ID
+ LDA S2 PLACE SUBSCRIPTS IN ID
+ STA ID+1
+ LDA S3
+ STA ID+2
+ LDA NS (A) = 0, B = NS
+ LRL 16
+ JST AA00 ASSIGN SPECIAL.
+ JST STXA
+ LDA DP+1,1
+ LLR 2
+ LDA B3T3
+ LGL 2
+ LRR 2
+ STA DP+1,1 DEFINE GF T0 GF(A)
+ LDA A
+ STA B3T2 T2 = A
+ LDA B3T1
+ STA A A = T1
+ JST STXA
+ LDA DP+1,1
+ LLR 2
+ LDA B3T2
+ LGL 2
+ LRR 2
+ STA DP+1,1 DEFINE GF TO GF(A)
+B3D LDA TC
+ SUB K104 IF TC NOT SLASH
+ SZE
+ JMP B1 GO TO ,-C/R TEST
+ LDA A9T2 IF SIDSW = COMMON-4
+ SUB B4Z9
+ SZE GO T0 B4 (COMMON-0)
+ JMP B1 ELSE, GO TO ,-C/R TEST
+ JMP B40
+B7 LDA TC IF TC = (
+ SUB K17
+ SZE
+ JMP B3D
+ JMP B3A
+*
+*
+* ********
+* *COMMON*
+* ********
+* INPUT BLOCK NAMES AND LINK THEM WITH THE
+* FOLLOWING VAR/ARRAY NAMES, BLOCK NAMES
+* ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS
+B4 LDA K81
+ STA ID
+ STA ID+1
+ STA ID+2
+ LDA B4Z9 SET SWITCH IN INPUT DIMENSION
+ STA A9T2
+ JST CH00 INPUT CHAR
+ SUB K9 IF NOT SLASH
+ SZE GO TO
+ JMP B4E
+B40 JST DN00 INPUT DNA
+ LDA K104 SLASH TEST
+ JST TS00
+B4B LRL 32
+ LDA K101 (A) = SUB, (B) = 0
+ JST AA00 ASSIGN SPECIAL
+ LDA CFL
+ SNZ
+ LDA A
+ STA CFL
+ LDA A
+ STA F
+ JST FL00 FETCH LINK
+ SZE
+ JMP B4D
+ LDA CFL
+ STA 0
+ LDA DP+1,1 GF(CFL)
+ IMA A
+ STA 0 INDEX = A
+ IMA A
+ STA DP+1,1 GF(A) = GF(CFL)
+ LDA CFL
+ STA 0 INDEX = CFL
+ LDA A
+ ADD K122 ='040000
+ STA DP+1,1 GF(CFL) = A
+B4D JST NA00 INPUT NAME
+ JST ND00 NON DUMMY/SUBPROG TEST
+ JST NM00 NON-COMMON TEST
+ JST EL00 EXCHANGE LINKS
+ LDA DP,1
+ ANA B4F ='107777
+ ADD K122 AT(A) = COM (='040000)
+ STA DP,1
+ JMP B7
+B4E JST UC00 UNINPUT COLUMN
+ JMP B4B
+B4Z9 DAC B4D GO TO INPUT DIMENSION
+B4F OCT 107777 EXTRACT MASK TO STRIP OFF AT FIELD
+*
+*
+* *************
+* *EQUIVALENCE*
+* *************
+* STORE EQUIV INFO IN THE DATA POOL FOR LATER
+* PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP)
+B5 LDA E0 L = NEXT WORD IN EQUIVALENCE TABLE
+ STA I I=L
+ SUB K101 (=1)
+ STA E0 L=L-1
+ SUB ABAR
+ SMI
+ JMP *+3
+ JST ER00 DATA POOL FULL
+ BCI 1,MO MEMORY OVERFLOW
+ JST STXI ESTABLISH I
+ CRA
+ STA DP,1 DP (I) = 0
+B5B JST CH00
+ LDA DP,1 INPUT CHAR
+ SZE
+ JMP B5D
+ LDA TC PUT IN FIRST CHARACTER
+ LGL 8 PACK INTO DP (I)
+B5C STA DP,1
+ LDA TC
+ SUB CRET
+ SNZ
+ JMP C6 CHARACTER E C/R - EXIT
+ LDA DP,1
+ ANA K100
+ SNZ
+ JMP B5B WORD NOT FULL
+ JMP B5 OBTAIN NEW WORD
+B5D LDA TC PUT IN SECOND CHARACTER
+ ERA DP,1
+ JMP B5C
+*
+*
+* *********************
+* *RELATE COMMON ITEMS*
+* *********************
+* ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED
+* AND THEIR INVERSE OFFSETS CALCULATED. THESE
+* WILL BE INVERTED LATER TO GIVE TRUE
+* POSITION IN THE BLOCK.
+C2T0 PZE 0
+C2 LDA CFL
+ STA A A = F = CFL
+C2A CRA
+ STA C2T0 T0 = 0
+ LDA A
+ STA F F = A
+C2B JST FL00 FETCH LINK
+ SNZ
+ JMP C2D
+ LDA D0
+ ADD C2T0 T0 = T0 + D0
+ STA C2T0
+ JST DA00 DEFINE ADDRESS FIELD
+ JMP C2B
+C2D JST FL00 FETCH LINK
+ SZE
+ JMP C2F
+ LDA AF
+ STA A A = AF
+ SUB CFL
+ SZE
+ JMP C2A AF = CFL. NO
+ JMP C3 YES - GROUP EQUIVALENCE
+C2F LDA C2T0
+ SUB AF (A) = T0 - AF
+ JST DA00 DEFINE AF
+ LDA IU
+ SZE
+ JMP C2D
+ JST TV00 TAG VARIABLE
+ JMP C2D
+*
+*
+* *******************
+* *GROUP EQUIVALENCE*
+* *******************
+* THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON
+* USAGE IS CHECKED TO SEE THAT THE ORIGIN
+* IS NOT MOVED AND THAT ONLY ONE ITEM IS
+* COMMON.
+C3T0 PZE 0
+C3T1 PZE 0
+C3T2 PZE 0
+C3T3 PZE 0
+C3T4 PZE 0
+C3T5 PZE 0
+T0C3 EQU C3T0
+T1C3 EQU C3T1
+T2C3 EQU C3T2
+T3C3 EQU C3T3
+T4C3 EQU C3T4
+C3 LDA E0
+ STA EBAR EBAR=E(0) = END OF EQUIVALENCE TABLE
+ LDA L0
+ STA E E=L(0) = START OF EUUIVALENCE TABLE
+ LDA CRET
+ STA TC
+C3B LDA E
+ STA EP E-PRIME = E
+ CRA
+ STA F I = 0
+ LDA K102 T4 = STR-ABS
+ STA C3T4
+ JST CH00 INPUT CHARACTER
+ LDA K17
+ JST TS00 (TEST
+C3D JST IL00 INPUT LIST ELEMENT
+ JST SAF
+ LDA S1
+ SUB AF TL = S1-AF
+ STA C3T1
+ LDA A T2 = A
+ STA C3T2
+C3F LDA F IF I=0, GO TO C3P
+ SNZ
+ JMP C3P
+C3G LDA F ELSE,
+ SUB A
+ SNZ IF A = I, GO TO C3N
+ JMP C3N
+C3H LDA AT
+ SUB K104 ELSE,
+ SNZ IF AT = COM, GO TO C3O
+ JMP C3O
+C3H2 LDA T1C3
+ ADD AF
+ STA T0C3 T(0) = AF +T (1)
+ LDA T4C3
+ SUB K104 IF T(4) = 0, GO T0 C3K
+ SZE
+ JMP C3K
+ LDA T3C3
+ SUB T0C3 ELSE,
+ STA T0C3 T(0) = T(3)-T(0)
+ SMI
+ JMP C3K
+ JST ER00 IF T(0)<0,
+ BCI 1,IC
+C3K LDA C3T4 IMPOSSIBLE COMMON EQUIVALENCING
+ IAB
+ LDA T0C3 AT (A) = COM
+ ALS 2
+ LGR 2
+ JST AF00
+ JST FL00 DEFINE AF
+ JST SAF FETCH LINK
+ LDA A
+ SUB C3T2
+ SZE IF A .NE. T (2),
+ JMP C3G GO TO C3G (5)
+*
+ JST EL00 EXCHANGE CL(A) == CL(I)
+C3M LDA TC EXCHANGE LINKS (CL(A) WITH CL(F) )
+ SUB K134 IF TC = ,
+ SNZ
+ JMP C3D ELSE,
+ JST IP00 )-INPUT OPERATOR
+ LDA TC
+ SUB K134 IF TC = , OR C/R
+ SNZ GO TO C3B (1)
+ JMP C3B
+ LDA TC
+ SUB CRET
+ SNZ
+ JMP C3B ELSE,
+ JST ER00
+ BCI 1,EC EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR
+ JMP C3B
+C3N LDA T1C3 IF T1 = 0, GO TO C3M
+ SNZ
+ JMP C3M
+C3N5 JST ER00 ERROR IMPOSSIBLE GROUP
+ BCI 1,IE IMPOSSIBLE EQUIVALENCE GROUPING
+C3O LDA S1
+ ADD AF
+ STA T3C3
+ LDA K104 =4
+ CAS T4C3
+ JMP *+2
+ JMP C3N5
+ STA T4C3
+ LDA F
+ CAS A IF A = F, GO TO C3M (B)
+ JMP *+2
+ JMP C3M ELSE,
+ STA A A = I
+ IMA C3T2
+ STA F
+ CRA T1 = 0
+ STA C3T1
+ JST FA00 FETCH ASSIGNS
+ JST SAF
+ JMP C3H2 GO TO C3H2
+C3P LDA A
+ STA F
+ JMP C3H
+*
+*
+* ***********************
+* *ASSIGN SPECIFICATIONS*
+* ***********************
+* NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER
+* COMMON BLOCKS ARE OUTPUT (WITH SIZE).
+C4T0 PZE 0
+C4T1 PZE 0
+C4B STA A A = 0
+C4C LDA A
+ ADD K105 I = A = A+5
+ STA A
+ STA F
+ CAS ABAR
+ JMP NP35 RETURN TO FIRST NON-SPEC CHECK (POINT 1)
+ NOP
+ JST FA00 ELSE, FETCH ASSIGN
+ LDA AT
+ SUB K102 IF AT = STR-ABS
+ SZE IU=VAR, OR ARR, AND
+ JMP C4C NT = 0
+ LDA IU GO TO C4E
+ SUB K102 ELSE, GO TO C4C
+ SPL
+ JMP C4C
+ LDA NT
+ SZE
+ JMP C4C
+C4E CRA
+ STA C4T0 T0 = 0. T1 =-MAX
+ SUB K111
+ STA C4T1
+ JST KT00 SET D(0) = NO. OF WORDS PER ITEM
+C4F JST SAF
+ CAS C4T0
+ STA C4T0
+ NOP
+ LDA D0
+ SUB AF (A) = D(0) - AF
+ CAS C4T1
+ STA C4T1
+ NOP
+ JST FL00 FETCH LINK ( (A)=A - F )
+ SZE
+ JMP C4F GO TO C4F
+ LDA RPL
+ ADD C4T0 RPL * RPL + T0 + TL
+ STA C4T0
+ ADD C4T1 TO = RPL-T1
+ STA RPL
+C4I JST SAF
+ LDA K101
+ IAB (B) = REL
+ LDA C4T0 (A) = TO-AF
+ SUB AF
+ JST AF00 DEFIME AFT
+ JST FL00 FETCH LINK
+ SZE IF (A) NOT ZERO,
+ JMP C4I NOT END OF EQUIVALENCE GROUP
+ JMP C4C CHECK NEXT ITEM IN ASSIGNMENI TABLE
+*
+C4L2 LDA FLT1 = LINK LOCATION TO COMMON BLOCK NAME
+ STA C4T1
+C4L3 LDA A
+ STA I SAVE A FOR LATER MODIFICATION
+ JST FL00 FETCH LINK
+ SNZ
+ JMP C4M END OF COMMON GROUP
+ JST STXI SET INDEX TO POINT TO CURRENT ITEM IN
+* COMMON GROUP.
+ LDA DP,1 SET CL FIELD TO POINT AT COMMON BLOCK
+* NAME.
+ ANA K119 ( = '177000)
+ ADD C4T1 (= LINK LOCATION OF COMMON BLOCK NAME)
+ STA DP,1
+ JMP C4L3 PROCESS NEXT ITEM IN COMMON BLOCK
+*
+C4 LDA CFL LOC, OF FIRST (BLANK) COMMON BLOCK
+ STA F
+C4L6 STA A
+ CRA
+ STA C4T0
+C4L JST FL00 FETCH LINK
+ SNZ
+ JMP C4L2 NO MORE ITEMS IN COMMON BLOCK
+ LDA D0 ELSE, IF TO .LT. DO+AF,
+ ADD AF
+ CAS C4T0 T0 = D0 + AF
+ STA C4T0
+ NOP
+ JMP C4L GO TO C4L
+C4M LDA AF
+ STA F I=AF
+ LDA C4T0 (A) = T0
+ JST DA00 DEFINE AF
+*....OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER
+ LDA AF LENGTH OF COMMON BLOCK
+ ANA K111 ='37777
+ ADD K122 ='40000 (S/C CODE = 1)
+ JST ON00 OUTPUT NAME BLOCK TO LOADER
+ LDA F
+ SUB CFL IF I = CFL
+ SNZ
+ JMP C4B
+ LDA F
+ JMP C4L6
+*
+SAF DAC **
+ LDA AF
+ LGL 2
+ ARS 2
+ STA AF
+ JMP* SAF
+*
+* **************************
+* *DATA STATEMENT PROCESSOR*
+* **************************
+* PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS
+* TO APPROPRIATE LOCATIONS. MODES MUST AGREE
+T0W4 PZE 0
+T1W4 PZE 0
+G PZE 0 LOWEST INDEX POINT IN LIST
+W4 LDA L0
+ STA I I=END OF DATA POOL
+W4B JST IL00 INPUT LIST ELEMENT
+ LDA AT D (0) = =WDS/ITEM
+ SUB K102
+ SNZ IF AT = 'STR-ABS'
+ JMP W4T GO TO
+ LDA I
+ STA 0
+ LDA S1 S1 * DEFLECTION IF AN ARRAY
+ ADD AF
+ STA DP,1 DP(E) = AF + S1
+W4C LDA A
+ STA DP-1,1 DP (E-1) = A
+ LDA I
+ SUB K102
+ STA I
+ STA G
+ LDA TC IF TC = ,
+ SUB K134
+ SNZ
+ JMP W4B GO TO W4B
+ LDA K104
+ JST TS00 TEST FOR SLASH TERMINATOR
+ LDA RPL
+ STA T1W4
+ LDA L0
+ STA I I= END OF DATA POOL
+W4E CRA
+ STA KPRM K' = KBAR = 0
+ STA KBAR
+W4F JST DN00 INPUT, DNA
+ LDA NT
+ SZE IF NT = 0
+ JMP W4G VARIABLE OR ARRAY
+ LDA TC LAST CHARACTER
+ CAS K17 ='250 ( =( )
+ JMP *+2
+ JMP *+3 START OF COMPLEX CONSTANT
+ JST ER00 ERROR
+ BCI 1,CN NON-CON DATA
+ STA SXF SET SXF TO NON-ZERO
+ JMP W4F FINISH INPUT OF COMPLEX CONSTANT
+W4G LDA KBAR MULTIPLY COUNT
+ SZE
+ JMP W4K GO TO W4K
+ LDA TC IF TC NOT *
+ SUB K103
+ SZE
+ JMP W4L
+ LDA ID
+ SUB K101
+ STA KBAR KBAR = ID-1
+ JST IT00 INTEGER TEST
+ JMP W4F
+W4K LDA KPRM IF K NOT ZERO
+ SZE
+ JMP W4M GO TO W4M
+W4L LDA KBAR
+ ALS 1 K ' = E-3* KBAR
+ TCA
+ ADD I
+ STA KPRM
+W4M JST STXI SET INDEX = I
+ LDA DP-1,1
+ STA A A = DP (E-1)
+ LDA IM
+ STA T0W4 TO = IM
+ JST FA00
+ LDA BDF IF BDF NOT ZERO
+ SZE
+ JMP W4S GO TO W4S
+ JST NM00 NON-COMMON TEST
+W4O JST STXI SET INDEX = I
+ LDA DP,1
+ STA RPL RPL = AF
+ JST FS00 FLUSH
+ CRA
+ STA DF DF = 0
+ LDA HOLF IS IT HOLLERITH DATA
+ SZE NO
+ JMP WHOW YES, GO TO OUTPUT IT
+ LDA D0
+ STA 0
+ JMP *,1 SWITCH ON NUMBER OF WORDS TO OUTPUT
+ JMP W405
+ JMP W403
+ JMP W404
+ LDA TID+2
+ JST OA00
+ LDA TID+1
+ JST OA00
+ LDA TIDB+2
+ JST OA00
+ LDA TIDB+1
+ JMP W406
+WHOW LDA D0 (A)=NO. OF WORDS PER ITEM
+ ALS 1 (A)=NO. OF CHARS, PER ITEM
+ STA NTID NTID=NO. OF CHARS. TO BE OUTPUT
+ SUB HOLF
+ SPL
+ JMP WERR
+ LDA ID FIRST WORD
+ JST WSNG OUTPUT IT
+ LDA ID+1 2ND WORD
+ JST WSNG OUTPUT IT
+ LDA ID+2 3RD WORD
+ JST WSNG OUTPUT IT
+ LDA ID+3 4TH WORD
+ JST OA00 OUTPUT IT
+ JMP W420 TO CHECK NEXT DATA
+*
+WSNG PZE 0
+ JST OA00 OUTPUT (A)
+ LDA NTID NO. OF CHARS, REMAINED TO BE OUTPUT
+ SUB K102
+ STA NTID NTID=NTID-2
+ SNZ
+ JMP W420 ALL FINISHED, CHECK NEXT ITEM
+ JMP* WSNG SOME HOLLERITH CHARS, REMAINED
+W403 LDA TID+2 REAL OUTPUT
+ JST OA00
+ LDA TID+1
+ JMP W406
+W404 LDA TID+2 DOUBLE PRECISION OUTPUT
+ JST OA00
+ LDA TID+1
+ JST OA00
+W405 LDA TID INTEGER OUTPUT
+W406 JST OA00
+ LDA T0W4
+ ERA IM
+ ANA K105
+ SNZ
+ JMP *+3
+* TO BE OUTPUT, RETURN
+WERR JST ER00
+ BCI 1,DM DATA AND DATA NAME MODE DO NOT AGREE
+W420 LDA I
+ SUB K102
+ STA I I = I-2
+ CAS KPRM
+ NOP
+ JMP W4M MORE TO DO
+ SUB G TEST FOR COMPLETE
+ SZE
+ JMP W4P
+ LDA K104
+ JST TS00
+ LDA T1W4
+ STA RPL
+ JST CH00 INPUT NEXT CHARACTER
+ SUB K5 ='254 (,)
+ SZE SKIP IF CHAR = COMMA
+ JMP A1 CHECK FOR (CR)
+ JMP W4 PROCESS NEXT DATA GROUP
+W4P LDA K134
+ JST TS00
+ JMP W4E
+W4S JST FS00 FLUSH BUFFER IF NECESSARY
+ LDA AF POSITION WITHIN COMMON BLOCK
+ LRL 14
+ LDA K106 FORMAT BCD OUTPUT
+ LGL 6
+ LLL 6
+ STA OCI
+ IAB
+ ANA K116
+ STA OCI+1
+ JST FL00 FETCH LINK
+ LDA DP+4,1
+ SSM
+ ALR 1
+ SSM
+ ARR 1
+ LRL 8
+ ERA OCI+1
+ STA OCI+1
+ LDA DP+3,1
+ IAB
+ LDA DP+4,1
+ LLL 8
+ STA OCI+2
+ LDA DP+2,1
+ IAB
+ LDA DP+3,1
+ LLL 8
+ STA OCI+3
+ LDA DP+2,1
+ LGL 2
+ ADD K103
+ LGL 6
+ STA OCI+4
+ LDA K128
+ STA OCNT
+ JST STXI I POINTS TO DATA TABLE
+ LDA DP-1,1 SET A TO VARIABLE
+ STA A
+ JST FA00
+ JMP W4O
+W4T LDA K101 =1 (=REL)
+ IAB
+ LDA RPL
+ JST AF00 DEFINE AFT (AT=REL. AF=RPL)
+ LDA I SET POINTER IN DATA POOL
+ STA 0
+ LDA RPL
+ STA DP,1 DP(I) = RPL OF VARIABLE
+ ADD D0
+ STA RPL
+ JMP W4C
+*
+*
+* *********************************
+* *BLOCK DATA SUBPROGRAM PROCESSOR*
+* *********************************
+* SET BLOCK DATA FLAG AND OUTPUT FORCE LOAD CODE
+R3 LDA LSTF =0 IF FIRST STATEMENT IN THE SUBPROGRAM
+ SZE
+ JMP *+3
+ JST ER00 ERROR...NOT FIRST STATEMENT
+ BCI 1,BL 'BLOCK DATA' NOT FIRST STATEMENT
+ STA BDF SET BLOCK DATA FLAG ON (NON-ZERO)
+ JST CH00 INPUT NEXT CHARACTER
+ JMP A1 CHECK FOR (CR) AND EXIT
+*
+*
+*
+*
+*
+*
+*
+* ***************************
+* *TRACE STATEMENT PROCESSOR*
+* ***************************
+* SETS TRACE TAG ON VARIABLES OR SETS TRACE FLAG
+TRAC JST XN00 EXAMINE NEXT CHARACTER
+ SZE SKIP IF CHAR, WAS A DIGIT
+ JMP TRAD JUMP IF CHAR. WAS A LETTER
+ JST IS00 INPUT STATEMENT NO.
+ LDA A STATEMENT NO. POINTER
+ STA TRF SET TRACE FLAG ON
+ JMP A1 TEST FOR (CR) AND EXIT
+*
+TRAD JST NA00 INPUT NAME
+ JST STXA SET INDEX TO NAME ENTRY
+ LDA DP+4,1 TT(A) TRACE TAG
+ CHS
+ STA DP+4,1
+ JMP B1 (,) OR (CR) TEST
+* (RETURN TO TRAC IF (,) )
+*
+*
+*
+* ********************
+* *OUTPUT OBJECT LINK*
+* ********************
+OL00 DAC **
+ JST CN00 CALL NAME
+ CRA
+ STA DF DF = 0
+ LDA ID (A) = IP
+ JST OA00 OUTPUT +BS
+*
+ JMP* OL00
+*
+* *****************
+* *OUTPUT I/O LINK*
+* *****************
+* GENERATE I/O DRIVER LINKAGE CODE. NAME OF
+* CALLED ROUTINE IS CHANGED IF UNIT DESIGNATOR
+* IS A CONSTANT.
+OI00 DAC **
+ JST IV00 INPUT INT VAR/CON
+ LDA NT
+ SNZ IF NT = 0
+ JMP OI20 GO TO 0I20
+ LDA ID IF ID CR 9
+ SUB K126 G0 TU OI20
+ SMI
+ JMP OI20
+* FORM F$RN OR F$WN
+ LDA NAMF+1
+ ANA K116
+ ADD ID
+ ADD K60 ='260 (SP)
+ STA NAMF+1
+OI10 JST CN00 CALL NAME
+ JMP* OI00 RETURN
+OI20 LRL 32
+ LDA OMI7 OUTPUT OA
+ JST OB00 (LOAD A (UNIT N0.))
+ JMP OI10 FO TO OI10
+*
+*
+* ***********
+* *CALL NAME*
+* ***********
+* SET UP NAME AND GENERATE CODE FOR CALLING IT.
+CN00 DAC **
+ JST FS00 FLUSH
+ JST PRSP SET PRINT BUFFER TO SPACES
+ LDA K147 SET UP OCI FOR CALL
+ STA OCI
+ LDA NAMF+1 OCI = NAMF
+ STA PRI+9
+ IAB ALSO TO PRINT BUFFER
+ LDA NAMF
+ STA PRI+8
+ LRL 8
+ STA OCI+1
+ LLL 16
+ STA OCI+2
+ LDA NAMF+2
+ STA PRI+10
+ IAB
+ LDA NAMF+1
+ LLL 8
+ STA OCI+3
+ LLL 16
+ STA OCI+4
+ LDA K128 ='14
+ STA OCNT OCNT = 6
+ LDA CN90
+ STA PRI+5
+ LDA CN90+1
+ STA PRI+6
+ LDA RPL
+ JST OR80
+ DAC PRI
+ SR2
+ JMP *+3 INHIBIT SYMBOLIC OUTPUT
+ CALL F4$SYM OUTPUT SYMBOLIC LINE,
+ DAC PRI
+ IRS RPL RPL = RPL + 1
+ JST PRSP SET PRINT BUFFER TO SPACES
+ JST FS00 FLUSH
+ JMP* CN00 RETURN
+K147 OCT 55000
+CN90 BCI 2,CALL
+* *************
+* *OUTPUT PACK*
+* *************
+* OUTPUT THE PACK WORD WHEN IT IS FULL.
+PKF PZE 0 PACK FLAG
+T0OK PZE 0
+OK00 DAC **
+ CAS CRET IF (A) = C/R
+ JMP *+2
+ JMP OK30 GO TO OK30
+ IRS PKF PKF = PKF + 1
+ JMP OK20 IF NON-ZERO, GO TO OK20
+OK10 ADD T0OK (A) = (A) + T0
+ LRL 16
+ STA DF
+ IAB
+ JST OA00 OUTPUT ABS
+ JMP* OK00
+OK20 LGL 8
+ STA T0OK
+ LDA K123 PKF = - 1
+ STA PKF
+ JMP* OK00 RETURN
+OK30 LDA PKF IF PKF = 0
+ SNZ
+ JMP* OK00 RETURN
+ LDA K8 ELSE (A) = SPACE,
+ STA PKF
+ JMP OK10 GO TO OK10
+*
+*
+* ***********
+* *OUTPUT OA*
+* ***********
+* GENERAL OUTPUT ROUTINE. MAKES CHECKS AGAINST
+* THE ASSIGNMENT TABLE ENTRY TO PROCESS DUMMY,
+* EXTERNAL, RELATIVE, ABSOLUTE OR STRING
+* REFERENCES PROPERLY.
+T1OB PZE 0
+OB00 DAC **
+ STA FTOP FTOP = (A)
+ IAB
+ STA T1OB
+ JST STXA ESTABLISH A
+ SNZ IF A = 0
+ JMP OB08 GO TO OB08
+ JST FA00 FETCH ASSIGNS
+ LDA SOF SPECIAL OUTPUT FLAT
+ SZE
+ JMP OB60 SUBSCRIPT CONSTANT DEFLECTION
+ LDA AF
+ STA T1OB T0 = AF
+ LDA AT
+ SUB K105 IF AT = 'DUM'
+ SNZ
+ JMP OB15 GO TO OB15
+ LDA IU
+ SUB K101 IF IU = 'SUB'
+ SNZ
+ JMP OB40 GO TO OB40
+OB06 LDA AT
+ CAS K104 IF AT = 'COM'
+ JMP *+2
+ JMP OB20 GO TO OB20
+ CAS K101
+ JMP *+2 IF AT = 'REL'
+ JMP OB10 GO TO OB10
+ LDA K103
+ IAB
+ LDA RPL
+ JST AF00 DEFINE AF AND AT
+ LDA AT IF AT = 'STR-RE'
+ SUB K103
+ SNZ
+ JMP OB10 GO TO OB10
+ CRA
+ STA AF AF = 0
+OB08 LDA K102
+ STA DF SET FLAG TO OUTPUT SYMBOLIC
+ LDA FTOP
+ JST OA00 OUTPUT ABSOLUTE
+ JMP* OB00 RETURN
+OB10 LDA T1OB
+ STA AF
+ LDA FTOP
+ JST OR00 OUTPUT REL
+ JMP* OB00 RETURN
+OB15 LDA FTOP
+ CHS REVERSE INDIRECT BIT
+ STA FTOP
+ JMP OB10 GO TO OB10
+OB20 JST FS00 OUTPUT COMMON REOUEST
+ LDA T1OB PACK ADDRESS INTO BLOCK
+ LRL 14
+ LDA FTOP
+ LGR 10
+ ADD K150
+ LLL 6
+ STA OCI
+ LLL 8
+ STA OCI+1
+ JST SAV
+ JST FL00
+ LDA DP+2,1
+ STA PRI+13 SET COMMON NAME INTO PRINT BUFFER
+ LLR 8
+ STA OCI+4
+ LLL 8
+ LDA DP+3,1
+ STA PRI+12 SET COMMON NAME INTO PRINT BUFFER
+ LLR 8
+ STA OCI+3
+ LLL 8
+ LDA DP+4,1
+ ANA K111 ='037777
+ CAS *+1 LOOK FOR BLANK COMMON
+ OCT 020240
+ ERA K122
+ ERA HBIT
+ STA PRI+11 SET NAME INTO PRINT BUFFER
+ LLR 8
+ STA OCI+2
+ LLL 8
+ LDA OCI+1
+ LLL 8
+ STA OCI+1
+ LDA K128 ='14
+ STA OCNT
+ JST RST
+ LDA 0
+ STA A RESTORE A TO POINT AT NAME
+ LDA RPL SET RPL MINUS
+ SSM TO DISABLE WORD OUTPUT
+ STA RPL
+ LDA FTOP OUTPUT WORD TO LIST
+ JST OR00 SYMBOLIC COMMAND
+ LDA RPL RESTORE AND
+ SSP INCREMENT PROGRAM
+ AOA COUNTER FOR COMMON
+ STA RPL OUTPUT
+ JST FS00 CLOSE OUT BLOCK
+ JMP* OB00 EXIT
+OB30 LDA DP+4,1
+ SSM
+ ALR 1
+ SSM
+ ARR 1
+ STA NAMF
+ LDA DP+3,1
+ STA NAMF+1
+ LDA DP+2,1
+ STA NAMF+2
+ JST CN00
+ JMP* OB00
+OB40 LDA AT
+ SUB K102
+ SNZ
+ JMP OB30
+ JMP OB06
+OB50 OCT 140000
+*
+OB60 CRA
+ STA SOF RESET SPECIAL OUTPUT FLAG
+ LDA AT ADDRESS TYPE
+ CAS K105 TEST FOR DUMMY
+ JMP OB06 PROCESS NORMALLY
+ JMP OB61
+ JMP OB06 PROCESS NORMALLY
+OB61 LDA T1OB
+ STA FTOP
+ CRA
+ JMP OB08+1
+*
+K150 OCT 700
+*
+*
+* **************
+* OUTPUT TRIADS*
+* **************
+* PROCESSES THE TRIAD TABLE, HANDLES FETCH
+* GENERATION AND RELATIONAL OPERATOR CODE
+* GENERATION, DRIVES OUTPUT ITEM. ASSIGNS
+* AND OUTPUT TEMP STORES.
+T0OT PZE 0
+T2OT PZE 0
+T1OT PZE 0
+T3OT PZE 0 TEMP STORE FOR P
+OT00 DAC **
+ JST SAV
+ LDA L0
+ STA I I = L0
+ CRA
+ STA T0OT T0 = 0
+ STA IFLG
+OT06 STA T1OT T1 = I
+OT10 LDA I
+ SUB K103 I = I-3
+ STA I
+ STA T2OT T2 = I
+ SUB L
+ SPL
+ JMP OT60 IF FINISHED, GO TO OT60
+ JST STXI
+ LDA DP+2,1
+ SSP CHECK P (I)
+ CAS K139 X
+ JMP *+2
+ JMP OT10
+ CAS K138 H
+ JMP *+2
+ JMP OT10
+ CAS K142 I
+ JMP *+2
+ JMP OT50
+ CAS K143 T
+ JMP *+2
+ JMP OT40
+ CAS K151 Q
+ JMP *+2
+ JMP OT35
+ STA T3OT SAVE P
+ LDA DP+1,1
+ STA A A = O1(I)
+ CAS T1OT
+ JMP *+2
+ JMP OT30
+ CAS L0
+ JMP OT16
+ JMP OT99 MAYBE SPECIAL LOAD FOR (A=) STATEMENT
+ JMP OT16
+OT18 JST STXI
+ LDA DP,1
+ STA A A = O2 (I)
+ LDA DP+2,1
+ SSP
+ JST OM00 OUTPUT ITEM(P(I),A = 02(I))
+OT22 JST STXI
+ LDA DP+2,1
+ SMI
+ JMP OT28
+ CRA ASSIGN TEMP STOR
+ STA NT NT = 0
+ LDA K102
+ STA IU IU = VAR
+ LDA T0OT
+ LRL 6
+ LDA TCF ID =
+ LRL 3 TS-IM-TCF-T0
+ LDA MFL
+ STA IM
+ LLL 9
+ JST OR80
+ DAC ID
+ LDA K77
+ STA ID
+ IRS T0OT T0 = T0+1
+ JST AS00 ASSIGN ITEM
+ JST STXI
+ LDA A
+ STA DP,1 O2(I) = A
+ LDA K153
+ SSM SURPRESS TRACE OF TEMPORARY STORAGE
+ JST OM00 OUTPUT ITEM (=,A)
+OT28 LDA I
+ JMP OT06
+OT30 JST STXA
+ LDA DP+2,1
+ SSP IF P (A) = 0
+ SZE
+ JMP OT32
+OT16 LDA K152 GENERATE FETCH
+ JST OM00 OUTPUT ITEM
+OT32 LDA T3OT CHECK FOR RELATIONALS
+ SUB K125 ='10
+ SPL
+ JMP OT18 NOT LOGICAL OR6RATOR
+ SUB K106 =6
+ SMI
+ JMP OT18 NOT A LOGICAL QPERATOR
+ STA 0 SET INDEX = -1 TO -6
+ LDA K103 =3 (LOG)
+ STA MFL SET MODE TO LOGICAL
+ CRA
+ STA A SET FOR OCTAL ADDRESS
+ JMP *+7,1 BRANCH TO OPERATOR PROCESSOR
+ JMP OT3G .LT.
+ JMP OT3E .LE.
+ JMP OT3C .EQ.
+ JMP OT3B .GE.
+ JMP OT3A .GT.
+ LDA OMJ4 .NE. =ALS 16
+ JST OA00 OUTPUT ABSOLUTE
+ LDA OMJ6 =ACA
+ JMP OT3D
+OT3A LDA OMJ7 *TCA
+ JMP OT3F
+OT3B LDA OMK1 =CMA
+ JMP OT3F
+OT3C LDA OMJ4 = ALS 16
+ JST OA00
+ LDA OMK2 =SSC
+ JST OA00 OUTPUT ABSOLUTE
+ LDA OMK3 =AOA
+OT3D JST OA00 OUTPUT ABSOLUTE
+ JMP OT22
+OT3E LDA OMJ2 =SNZ
+ JST OA00 OUTPUT ABSOLUTE
+ LDA OMK4 =SSM
+OT3F JST OA00 OUTPUT ABSOLUTE
+OT3G LDA OMJ5 =LGR 15
+ JMP OT3D
+*
+OT35 LDA DP+1,1
+ STA ID
+ JST NF00
+ LDA K78 NAMF = F $AR
+ STA NAMF+1
+ JST OL00 OUTPUT OBJECT LINK
+ JMP OT18 GO TO OT18
+OT40 LDA DP,1
+ ADD DO
+ STA I I = 02 (I) + DO
+ JST DQ00 DO TERMINATION
+OT45 LDA T2OT
+ STA I I = T2
+ JMP OT28
+OT50 LDA DP,1
+ ADD DO I=O2(I)+DO
+ STA I IF I = DO
+ SUB DO
+ SZE GO TO OT45
+ JST DS00 DO INITIALIZE
+ JMP OT45 GO TO OT45
+OT60 JST RST
+ LDA L0 RESET TRIAD TABLE
+ STA L
+ JMP* OT00
+*
+OT99 LDA T3OT
+ SUB K153 CODE FOR =
+ SZE
+ JMP OT16 NOT SPECIAL LOAD
+ STA MFL SPECIAL LOAD, SET MFL=0
+ JMP OT18 OUTPUT A STORE
+K77 BCI 1,T$ T$
+K78 BCI 1,AR AR
+K142 OCT 27
+K143 OCT 30
+K151 OCT 32
+K152 OCT 31
+* *************
+* *OUTPUT ITEM*
+* *************
+*
+* DRIVES BASIC OUTPUT ROUTINES. HANDLES SPECIAL
+* SUBSCRIPT PROCESSING, GENERATES NECESSARY
+* MODE CONVERSION CALLS AND HANDLES MODE
+* CHECKING. IN-LINE ARITHMETIC CODE IS
+* GENERATED WHERE POSSIBLE. OTHERWISE CALLS
+* TO ARITHMETIC ROUTINES ARE GENERATED.
+*
+T0OM PZE 0
+T1OM PZE 0
+T2OM PZE 0
+T8OM PZE 0
+T9OM PZE 0
+TXOM PZE 0
+*
+*-------------OUTPUT ITEM
+OM00 DAC ** RETURN ADDR
+ STA T8OM
+ SSP
+ STA T0OM R(0)=(A)='P' CODE
+ CAS K134
+ JMP *+2
+ JMP OMD1
+ LDA TXOM
+ CAS K101
+ JMP OME1
+ JMP OME5
+OM05 CRA
+ STA T1OM T(1)=0
+ STA T9OM T(9)=0
+ LDA A
+ STA T2OM T(2)=A
+ SZE
+ JMP OM07
+ LDA MFL
+ JMP OM13
+OM07 CAS L0
+ JMP *+2
+ JMP OML1
+ CAS ABAR
+ JMP OM76 A .LE. ABAR....WITHIN TRIAD TABLE
+ JMP *+1
+OM10 JST STXA SET INDEX=A
+ LDA DP,1
+ ARS 9 SES IM=MODE OF ITEM
+ ANA K107
+OM13 STA IM
+OM14 LDA MFL SET MFL,IM AS DIGITS INTO NAMF
+ ALS 8
+ ADD IM
+ ERA OM90 ADD '0''0'
+ STA NAMF+1
+ LDA K130
+ STA 0 INDEX=-6
+ LDA T0OM
+ CAS OM50+6,1 CHECK FOR SPECIAL OPERATOR
+ JMP *+2 '1
+ JMP* OM52+6,1 'P'='Q',',','0','A'F', OR 'E'
+ IRS 0
+ JMP *-4
+ LDA MFL
+ SNZ
+ JMP OM62 SPECIAL LIBRARY FIX FOR ( A= )
+ CAS IM CHECK FOR MODE MIXING
+ JMP *+2
+ JMP OMA1 ITEM MODE SAME AS CURRENT MODE
+OM20 LDA K103
+ JST OM44 CHECK MODE FOR LOG
+ LDA K102 =2 (MODE CODE FOR REAL)
+ CAS MFL MODE OF EXPRESSION
+ JMP *+2
+ JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING
+ CAS IM MODE OF ITEM
+ JMP *+2
+ JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING
+ LDA K105
+ JST OM44 TEST FOR MODE = COMPLEX
+OM26 LDA T0OM OPERATOR BEING PROCESSED
+ CAS K153
+ JMP *+2
+ JMP OM36 T(0)='=' (ALLOW INTEGER MODE)
+ LDA K101
+ JST OM44 TEST FOR MODE=INTEGER
+ LDA IM
+ CAS MFL
+ JMP OM38 CONVERT MODE OF ACCUMULATOR
+ JMP *+1
+OM30 JST NF00 SET LBUF+2 TO SPACES
+ LDA T0OM
+ STA 0
+ LDA A9X4,1 PICK-UP PRINT CODE FOR 'P' OPERATOR
+ ARS 6
+ ANA K100 ='377
+ SNZ
+ JMP OM46 MODE MIXING ERROR
+ LGL 8
+ ERA OM91 ADD '$'
+ STA NAMF
+ LDA K134
+ STA T0OM T(0)=','
+ JMP OM40
+*
+OM36 LDA K105
+ JST OM44 CHECK FOR MODE=COMPLEX
+OM38 LDA IM
+ STA MFL
+ JST NF00 SET LBUF+2 TO SPACES
+ LDA OM92 'C$'
+ STA NAMF
+OM40 JST CN00 OUTPUT....CALL NAMF
+ LDA MFL
+ STA IM SET ITEM MODE TO CURRENT MODE
+ LDA NAMF
+ CAS OM96
+ JMP OM14
+ JMP* OM00
+ JMP OM14 OUTPUT ARGUMENT ADDRESS
+*
+*-----SUBROUTINE TO CHECK FOR ILLEGAL IM OR MFL MODES,
+OM44 DAC ** RETURN ADDR,
+ CAS IM CHECK FOR IM0(A)
+ JMP *+2
+ JMP OM46 ERROR
+ CAS MFL CHECK FOR MFL=(A)
+ JMP* OM44
+ JMP OM46 ERROR
+ JMP* OM44
+OM46 JST ER00 NON-RECOVERABLE ERROR......
+ BCI 1,MM MODE MIXING ERROR
+*
+*------SPECIAL 'P' OPERATOR TABLE
+OM50 OCT 32 'Q'
+ OCT 17 ','
+ OCT 00 '0'
+ OCT 22 'A'
+ OCT 31 *F'
+ OCT 20 'E'
+OM52 DAC OMB3 ('Q')
+ DAC OMB3 (',')
+ DAC OMB3 ('0')
+ DAC OM56 ('A')
+ DAC OM60 ('F')
+ DAC OM70 ('E')
+*
+*
+OM56 LDA OMI1 SET T(1) = ADD*
+ JMP OMB1
+*
+OM60 JST STXA SET INDEX = A
+ LDA DP+1,1
+ LGR 14 SET UV=IU(A)
+ STA IU
+ JST STXI SET INDEX=I
+ LDA DP+2,1 P(I)
+ ANA K133 ='77
+ SNZ
+ JMP OM64 (POSSIBLE DUMMY ARRAY FETCH)
+OM62 LDA IM
+ STA MFL SET CURRENT MODE TO ITEM MODE
+ LGL 8
+ ADD IM
+ ERA OM90
+ STA NAMF+1
+ LDA IU
+ SUB K101 CHECK FOR IU=1 (SUBROUTINE)
+ SZE
+ JMP OMA1
+ LDA OMI2 SET T(1) = JST
+ JMP OM66
+OM64 LDA IU
+ SUB K103 CHECK FOR IV=3 (ARRAY)
+ SZE
+ JMP OM62
+ LDA K101 SET CURRENT MODE TO INTEGER
+ STA MFL
+ LDA OMI3 SET T(1) = LDA*
+OM66 STA T1OM
+ JMP OMB3
+*
+OM70 LDA K101
+ CAS IM CHECK ITEM MODE EQUALS INTEGER
+ JMP *+2
+ JMP OM74
+ LDA K105 CHECK FOR MODE = COMPLEX
+ JST OM44
+ JMP OM20
+OM74 LDA K103 CHECK FOR MODE = LOGICAL
+ JST OM44
+ JMP OM30 OUTPUT SUBROUTINE CALL
+*
+OM76 JST STXA INDEX=A
+ LDA DP,1 02(A)
+ STA T2OM T(2)=02(A)
+ LDA DP+2,1 P(A)
+ ANA K133 ='77
+ SNZ
+ JMP OM84 P(A)='0' (SUBSCRIPTED VARIABLE)
+ CAS K139
+ JMP *+2
+ JMP OM80 P(A) = 'X' (END OF ARRAY CALCULATION)
+ CAS K138
+ JMP *+2
+ JMP OMHW
+OM78 LDA T2OM P(4)= 'H' (HOLLERITH DATA)
+ STA A RESET A
+ JMP OM10
+*
+OM80 JST STXI INDEX=I
+ LDA T2OM
+ STA DP+1,1 O1(I) = T(2)
+ CRA
+ STA T1OT SET T(1) OF OUTPUT TRIADS TO ZERO
+ LDA A SAVE A
+ STA T1OM
+ CRA SET A=0 (NOT SYMBOLIC)
+ STA A
+ LDA RPL
+ ADD K102 AF = RPL+ 2
+ STA AF
+ LDA OMI4 =ADD INSTRUCTION
+ JST OR00 OUTPUT RELATIVE
+ LDA RPL
+ ADD K102 AF = RPL P+ 2
+ STA AF
+ LDA OMI5 = JMP INSTR,
+ JST OR00 OUTPUT RELATIVE
+ LDA T1OM
+ STA A RESTORE A
+ STA SOF SET SPECIAL OUTPUT FLAG TO NON-ZERO
+ CRA = DAC INSTR.
+ STA T1OM
+ LDA K101
+ STA AT
+ JMP OM88
+OM84 LDA DP+1,1 O1(A)
+ STA A A=O1(A)
+ CAS L0
+ JMP *+2
+ JMP OM86 A=L(0)....CONSTANT SUBSCRIPT ONLY
+ LDA OMI0 T(1) = INDIRECT BIT
+ STA T1OM
+ JMP OM10
+*
+OM86 LDA T2OM A=T(2)
+ STA A
+ STA 0
+ STA SOF
+ LDA DP,1 T(2) = 02(A)
+ STA T2OM
+OM88 JST STXA INDEX=A
+ LDA DP+1,1 O1(A)
+ STA T9OM T(9)=O1(A)
+ JMP OM78
+OMHW LDA T2OM
+ STA AF
+ CRA
+ STA A
+ JST OR00
+ JMP* OM00
+*
+OM90 OCT 130260 '00'
+OM91 OCT 000244 ' $'
+OM92 OCT 141644 'C$'
+OM93 OCT 152322 'TR'
+OM94 OCT 000021 'C' CODE
+OM95 OCT 017777 (MASK)
+OM96 BCI 1,N$
+OM97 BCI 1,-1
+*
+OMA1 LDA IM CHECK FOR IM=LOGICAL
+ CAS K103
+ JMP *+2
+ JMP OMC1 IM=LOGICAL
+ CAS K101 CHECK FOR IM=INTEGER
+ JMP *+2
+ JMP OMA3 IM=INTEGER
+ JMP OM30
+*
+OMA3 LDA T0OM CHECK FOR T,0) = '+'
+ CAS K103 =3
+ JMP *+2
+ JMP OMA4 T(0)= '*'
+ CAS OM94 T(0) = 'C
+ JMP *+2
+ JMP OMA6 OUTPUT 'TCA'
+ CAS K101
+ JMP OMA5
+ LDA OMI4 =ADD INSTR.
+ JMP OMB1
+OMA4 LDA T2OM VALUE OF A
+ SUB K126 ='12 KNOWN LOCATION OF A FOR 2
+ SZE SMP IF MULTIPLIER IS A CONSTANT OF 2
+ JMP OM30 COUPLE TO THE MULTIPLY SUBROUTINE
+ STA A SET A AND AF TO ZERO (FOR LISTING FLAGS)
+ STA AF
+ LDA *+3 ALS 1 INSTRUCTION
+ JST OA00 OUTPUT ABSOLUTE
+ JMP* OM00 EXIT UUTPUT ITEM
+ ALS 1 (INSTRUCTION TO BE OUTPUT)
+OMA5 CAS K102 CHECK FOR T(0) = '-'
+ JMP OMA7
+ LDA OMI6 =SUB INSTR,
+ JMP OMB1
+OMA6 CRA
+ STA A CAUSE OCTAL ADDR LISTING
+ STA AF
+ LDA *+3 TCA
+ JST OA00 OUTPUT ABSOLUTE
+ JMP* OM00 EXIT
+ TCA
+OMA7 CAS K153 CHECK FOR T(0) = '='
+ JMP *+2
+ JMP OMA9 OUTPUT A STA INSTR,
+ SUB K152 CHECK FOR T(0) = 'F'
+ SZE
+ JMP OM30
+OMA8 LDA OMI7 =LDA INSTR,
+ JMP OMB1
+OMA9 LDA OMI8 =STA INSTR,
+OMB1 ADD T1OM T(1) = T(1) + INSTR.
+ STA T1OM
+OMB3 LDA T2OM SET A=T(2)
+ STA A
+ LDA T9OM OUTPUT INSTR. WITH T(1) AND T(9)
+ IAB
+ LDA T1OM
+ JST OB00 OUTPUT OA
+ LDA T8OM CHECK FOR T(8) = '='
+ CAS K153 ='16
+ JMP* OM00
+ JMP *+2
+ JMP* OM00 EXIT
+ LDA TRFA POINTER TO FIRST VARIABLE OR ARRAY
+ STA A PROCESSED IN EXPRESSION
+ JST TRSE OUTPUT TRACE COUPLING IF REQUIRED
+ JMP* OM00 EXIT OUTPUT ITEM
+*
+*
+OMC1 LDA T0OM
+ CAS K152 CHECK FOR T(0) = 'F'
+ JMP *+2
+ JMP OMA8 OUTPUT A LDA INSTR.
+ CAS K153 CHECK FOR T(0) = '='
+ JMP *+2
+ JMP OMA9 OUTPUT A STA INSTR,
+ CAS OM94 CHECK FOR T(0) = 'C'
+ JMP *+2
+ JMP OM30 OUTPUT COMPLEMENT CODING
+ CAS K106
+ JMP *+2
+ JMP OMC5 OUTPUT AN ANA INSTR.
+ CAS K107
+ JMP OM46 ERROR
+ JMP OM30
+ JMP OM46 ERR0R
+OMC5 LDA OMI9 =ANA INSTR.
+ JMP OMB1
+OMD1 IRS TXOM T0 = T0+1
+ JMP OM05
+OME1 CRA
+ STA DF DF = 0
+ JST OA00 OUTPUT ABSOLUTE
+OME5 CRA
+ STA TXOM T0 = 0
+ JMP OM05
+*
+TRSE DAC 0 SUBROUTINE TO OUTPUT TRACE COUPLING
+ JST STXA SET INDEX = A
+ SZE
+ LDA DP+4,1 CHECK STATUS OF TRACE TAG
+ SPL
+ JMP TRS7
+ SR4
+ JMP TRS7
+ LDA TRF CHECK STATUS OF TRACE FLAG
+ SNZ
+ JMP* TRSE
+TRS7 JST NF00 SET LBUF TO 'F$', LSUF+2 TO SPACES
+ LDA OM93 ='TR'
+ STA NAMF+1
+ JST CN00 OUTPUT.....CALL NAMF
+ JST STXA SET INDEX = A
+ LDA DP+4,1
+ ANA OM95
+ STA T1OM
+ LDA DP+3,1
+ STA T8OM
+ LDA DP+2,1
+ STA T9OM
+ CRA
+ STA DF
+ LDA DP,1 MERGE IM WITH ITEM NAME
+ ARS 9
+ LGL 13
+ ERA T1OM
+ JST OA00 OUTPUT ABSOLUTE (FIRST 2 CHAR.)
+ LDA T8OM
+ JST OA00 OUTPUT ABSOLUTE (NEXT 2 CHAR.)
+ LDA T9OM
+ JST OA00 OUTPUT ABSOLUTE (LAST 2 CHAR.)
+ JMP* TRSE
+*
+*.................INSTRUCTION TABLE
+OMI0 OCT 100000 INDIRECT BIT
+OMI1 OCT 114000 ADD*
+OMI2 OCT 020000 JST
+OMI3 OCT 104000 LDA*
+OMI4 OCT 014000 ADD
+OMI5 OCT 002000 JMP
+OMI6 OCT 016000 SUB
+OMI7 OCT 004000 LDA
+OMI8 OCT 010000 STA
+OMI9 OCT 006000 ANA
+OMJ1 OCT 102000 JMP*
+OMJ2 OCT 101040 SNZ
+OMJ3 OCT 101400 SMI
+OMJ4 ALS 16
+OMJ5 OCT 040461 LGR 15
+OMJ6 OCT 141216 ACA
+OMJ7 OCT 140407 TCA
+OMK1 OCT 140401 CMA
+OMK2 OCT 101001 SSC
+OMK3 OCT 141206 AOA
+OMK4 OCT 140500 SSM
+OMK5 OCT 042000 JMP 0,1
+OMK6 OCT 000000 DAC **
+ ALS 1 ALS1
+ TCA TCA
+OMK7 OCT 176000 STG
+OMK9 CAS 0 CAS
+ STA* 0
+ SUB* 0
+ DAC* **
+ OCT 131001
+ OCT 030000 SUBR
+ CAS* 0
+OMK8 OCT 0 (///)
+OML1 LDA K101
+ STA AT
+ JMP OT10
+*
+* ************
+* *OUTPUT REL*
+* ************
+* ALSO DRIVES SYMBOLIC INSTRUCTION OUTPUT.
+OR00 DAC **
+ STA FTOP
+ LDA K102 DF = NON ZER0
+ STA DF CODE = 2
+OR10 STA CODE
+ LDA RPL LIST RPL
+ SSP
+ JST OR80
+ DAC PRI
+OR12 LDA DF IF DF NOT ZERO
+ SZE
+ JMP OR20 GO TO OR20
+ LDA OR18 ='147703
+ STA PRI+5
+ LDA OR19 SET 'OCT' INTO PRINT IMAGE
+ STA PRI+6
+ LDA FTOP
+OR13 JST OR80
+ DAC PRI+8
+OR15 LDA RPL IF RPL PLUS
+ SMI
+ JST OW00 OUTPUT WORD
+ SR2
+ JMP *+3 SURPRESS SYMBOLIC OUTPUT
+ CALL F4$SYM LIST LINE
+ DAC PRI
+ JST PRSP SET PRINT BUFFER TO SPACES
+ JMP* OR00 RETURN
+OR18 OCT 147703 (0)(C)
+OR19 OCT 152240 (T)(SP)
+OR20 JST SAV
+ LDA OR90 SEARCH OP-CODE LIST
+ TCA
+ STA XR PUT BCI IN PRINT IMAGE
+ LDA FTOP
+ SSP
+ SZE
+ JMP OR24
+ LDA AT
+ CAS K103
+ SUB K106
+ ADD K102
+ CMA
+ ANA K107
+ STA CODE
+OR24 LDA FTOP
+ CAS OR91+NINS,1
+ JMP *+2
+ JMP *+3
+ IRS XR
+ JMP *-4
+ LDA OR92+NINS,1
+ STA PRI+5
+ LDA OR93+NINS,1
+ STA PRI+6
+ JST RST
+ LDA A
+ SZE
+ JMP OR30
+ LDA AF
+ ANA K111 MASK OUT HIGH BITS OF ADDRESS
+ JMP OR13
+OR30 JST STXA
+ LDA DP,1
+ SMI
+ JMP OR40
+ LDA K149
+ STA PRI+8 SET =' INTO LISTING
+ LDA DP,1 CHECK IM (A)
+ LGL 4
+ SPL SKIP IF NOT COMPLEX
+ JMP *+4
+ LGL 2
+ SPL SKIP IF INTEGER OR LOGICAL
+ JMP *+3
+ LDA DP+2,1
+ JMP *+2 LIST EXPONENT AND PART OF FRACTION
+ LDA DP+4,1 LIST INTEGER VALUE
+ JST OR80 CONVERT OCTAL
+ DAC PRI+9
+ JMP OR15
+OR40 LDA DP+4,1 CONVERT AND PACK INTO
+ ALR 1
+ SSM SYMBOLIC IMAGE
+ ARR 1
+ SSM
+ STA PRI+8
+ LDA DP+3,1
+ STA PRI+9
+ LDA DP+2,1
+ STA PRI+10
+ JMP OR15
+* ***********
+* *OUTPUT ABS*
+* ***********
+OA00 DAC **
+ STA FTOP
+ LDA OA00
+ STA OR00
+ CRA
+ JMP OR10
+* *******************
+* *OUTPUT STRING-RPL*
+* *******************
+OS00 DAC 00
+ STA AF
+ LDA OMK7
+ STA FTOP
+ LDA OS00
+ STA OR00 SET RETURN INTO OUTPUT REL
+ LDA K104
+ STA CODE
+ STA STFL STRING FLAG = NON ZERO
+ JST PRSP SET PRINT BUF. TO SPACES
+ JMP OR20 JMP-OUTPUT REL FOR SYMBOLIC AND BINARY
+OR80 DAC **
+ IAB
+ LDA* OR80
+ STA OR89
+ CRA
+ LRR 2
+ IRS OR80
+ JST OR85
+ JST OR85
+ JST OR85
+ JMP* OR80
+OR85 DAC **
+ ADD K140
+ LLR 3
+ LGL 5
+ ADD K140
+ LLL 3
+ STA* OR89
+ IRS OR89
+ CRA
+ JMP* OR85
+OR89 PZE 0
+OR90 DAC NINS
+K200 EQU OMI7
+K201 EQU OMI5
+K202 EQU OMI8
+K203 EQU OMI4
+K204 EQU OMI6
+K205 EQU OMJ3
+K206 EQU OMJ1
+K207 EQU OMK5
+OR91 EQU OMI1
+OR92 BCI 22,ADJSLDADJMSULDSTANJMSNSMLLLRACTCCMSSAOSSJMDA
+ BCI 2,ALTC
+ BCI 9,STCASTSUDAERSUCA//
+OR93 BCI 22,D*T A*D P B A A A P*Z I 1515A A A C A M PXC
+ BCI 2,S1A
+ BCI 9,G S A*B*C*R/BRS*/
+NINS EQU 32
+*
+PRSP DAC ** SUBR. T0 SET PRINT BUF. T0 SPACES
+ LDA PRSK =-40
+ STA 0
+ LDA KASP (SP)(SP)
+ STA PRI+40,1
+ IRS 0
+ JMP *-2
+ JMP* PRSP EXIT
+PRSK OCT 177730 =-40
+*
+* *************************************
+* *OUTPUT SUBROUTINE/COMMON BLOCK NAME*
+* ************************************
+* OUTPUT AN EXTERNAL REFERENCE NAME.
+*
+ON00 DAC **
+ STA ONT1 SAVE ADDRESS
+ JST FS00 FLUSH BUFFER IF NECESSARY
+ JST STXA SET INDEX=A
+ LDA ONT1 SUBR. ENTRY ADDR.
+ LRL 14
+ STA ONT1 SAVE S/C BITS
+ LDA ON02 ='600 (=BLOCK CODE NO.)
+ LLL 6
+ STA OCI FILL BUFFER
+ LRL 8
+ JST STXA SET INDEX=A
+ LDA DP+4,1 FIHST 2 CHAR. 0F NAME
+ ANA K111 ='037777
+ CAS *+1
+ OCT 020240
+ ERA K122
+ ERA HBIT ='140000
+ LRR 8
+ STA OCI+1 BUFFER
+ LRL 8
+ LDA DP+3,1 SECOND 2 CHAR. OF NAME
+ LRR 8
+ STA OCI+2 BUFFER
+ LRL 8
+ LDA DP+2,1 LAST 2 CHAR. OF NAME
+ LRR 8
+ STA OCI+3 BUFFER
+ LLL 8
+ LGL 2
+ ADD ONT1 S/C BITS
+ LGL 6
+ STA OCI+4 BUFFER
+ CRA SET SIZE = 0
+ STA OCI+5 8UFFER
+ LDA K128 ='14
+ STA OCNT SET 8LOCK SIZE (DOUBLED)
+ JST FS00 FLUSH BUFFER
+ JMP* ON00 EXIT
+ON02 OCT 600 BLOCK CODE NUMBER (6)
+ONT1 OCT 0 TEMP STORE
+*
+K149 BCI 1,='
+K140 OCT 26
+*
+OW00 DAC **
+ JST SAV
+ LDA RPL
+ SUB ORPL
+ SPL
+ TCA
+ CAS K101
+ JST FS00 FLUSH BUFFER IF DIFFERENCE IN RPL'S N0T 1
+ NOP
+ LDA OCNT
+ ADD K103
+ CAS K146
+ NOP
+ JST FS00 FLUSH BUFFER
+ LDA OCNT
+ ADD K103
+ STA OCNT OCNT = OCNT+3
+ SUB K103
+ ARR 1 OCI (OUTPUT CARD IMAGE)
+ STA XR
+ SMI LEFT OR RIGHT POS,
+ JMP OW20
+ JST PU00
+ LRL 8 IF BUFFER FULL
+ IMA OCI,1
+ ANA K116 CALL FLUSH (FS0O)
+ ERA OCI,1
+OW10 STA OCI,1
+ IAB
+ STA OCI+1,1
+ LDA PRI+16
+ IAB
+ LDA PRI+14 USE LOW BIT OF PRI+14 DATA
+ LLL 9
+ LGR 1 STRIP OFF HIGH BIT OF BLOCK CODE TYPE NO,
+ LLL 3 SET DIGITS IN PRI+17, PRI+19
+ JST OR80
+ DAC PRI+16
+ LDA PRI+14
+ LRL 6
+ LGL 1 SHIFT ADDR. TO RIGHT BY 1 BIT
+ LLL 5
+ JST OR80 SET DIGITS IN PRI+15, PRI+16
+ DAC PRI+14
+ LDA KASP (SP)(SP)
+ SR1
+ JMP OW14
+ STA PRI+15 OVERWRITE BINARY DATA IN
+ STA PRI+16 PRINT BUFFER WITH SPACES
+ STA PRI+17 IF NO BINARY LISTING IS WANTED
+ STA PRI+18
+OW14 STA PRI+14
+ JST RST
+ LDA RPL
+ STA ORPL ORPL=RPL
+ CRA
+ IMA STFL INDICATE WORD WAS KEY TO LOADER
+ SNZ THEN LEAVE RPL ALONE
+ IRS RPL RPL = RPL+1
+ JMP* OW00
+STFL PZE 0
+OW20 JST PU00
+ JMP OW10
+ORPL PZE 0
+PU00 DAC **
+ LDA CODE COMBINE CODES TO
+ CAS K104 =4
+ NOP
+ JMP PU10
+ SZE SKIP IF ABS
+ JMP PU10 JUMP IF REL.
+ LRL 8
+ LDA FTOP
+PU08 LRL 4
+ STA PRI+14 SAVE FOR LISTING
+ IAB
+ STA PRI+16
+ LRR 12 RESTORE POSITION
+ JMP* PU00
+PU10 LRL 4
+ LDA AF
+ LRL 4
+ ERA FTOP
+ JMP PU08
+PU20 LRL 4
+ LDA AF
+ ANA K111
+ LRL 4
+ IMA AF
+ ANA K114
+ ERA AF
+ JMP PU08
+K114 OCT 14000
+K146 OCT 117
+*
+*
+* ******************
+* *FLUSH SUBROUTINE*
+* ******************
+FS00 DAC **
+ LDA OCNT BUFFER OCCUPANCY SIZE
+ JST SAV SAVE INDEX REGESTER
+ SUB K104 CHECK FOR OCNT .GT. 4
+ SPL
+ JMP FS20 SKIP OUTPUT IF BUFFER IS EMPTY
+ ADD K105 ADD 1/2 AT B14
+ ARS 1 DIVIDE BY 2
+ TCA
+ STA OCNT OCNT = -WORDS/BUFFER
+ SUB K101 =1
+ STA PCNT BUFFER SIZE INCLUDING CHECKSUM
+ LDA OCI FIRST WORD IN BUFFER
+ LRL 12
+ CAS K102 =2
+ JMP *+2
+ JMP FS30 BLOCK TYPE = 2 (RELOCATABLE CODE)
+* EVERY TIME A BLOCK OF OBJECT OUTPUT IS DUMPED, THE FIRST
+* 3 WORDS OF THE BLOCK IS INSERTED IN THE SYMBOLIC OUTPUT
+* ALONG WITH AN EOB OPERATOR CODE IF SENSE SWITCH 1 1S DOWN.
+* TO INHIBIT THIS LINE, REPLACE FROM FS10 TO AND INCLUDING
+* FS11 WITH (FS10 CRA ).
+FS10 SS1
+ JMP FS11 N0 BINARY LISTING UNLESS SSW-1 IS DOWN
+ CALL F4$SYM
+ DAC PRI OUTPUT WHATEVER MIGHT BE IN SYMBOLIC BUF.
+ LDA FS41 =(E)(O)
+ STA PRI+5 ENTER 'EOB' INTO LISTING
+ LDA FS41+1 =(B)(SP)
+ STA PRI+6
+ LDA OCI
+ JST OR80 ENTER FIRST WORD FROM BUFFER INTO LISTING
+ DAC PRI+8
+ LDA OCI+1
+ JST OR80 ENTER WORD 2 FROM BUFFER INTO LISTING
+ DAC PRI+12
+ LDA OCI+2
+ JST OR80 ENTER WORD 3 FROM BUFFER INTO LISTING
+ DAC PRI+16
+ CALL F4$SYM OUTPUT SYMBOLIC BUFFER
+ DAC PRI
+ JST PRSP RESET SYMBOLIC BUFFER TO SPACES
+FS11 CRA
+ STA 0 COMPUTE CHECKSUM
+FS12 ERA OCI,1 MERGE BUFFER WORD INTO CHECKSUM
+ IRS 0 INCREMENT BUFFER POSITION
+ IRS OCNT DECREMENT BUFFER SIZE
+ JMP FS12
+ STA OCI,1 SET CHECKSUM INTO BUFFER
+ LDA PCNT = NO. OF WORDS IN BUFFER
+ IMA 0
+ ADD FS40 = OCI+1,1
+ CALL F4$OUT PUNCH BUFFER
+FS20 LDA RPL SET UP BUFFER FOR NEXT OUTPUT
+ LRL 8
+ ADD K145 =#'2000 (BLOCK CODE 2)
+ STA OCI
+ IAB
+ STA OCI+1 SET FIRST 2 WORDS OF BUFFER
+ LDA K103 =O
+ STA OCNT RESET BUFFER OCCUPANCY SIZE
+ JST RST RESET INDEX REGISTER
+ JMP* FS00 EXIT
+*
+FS30 LGL 6 MERGE BUFFER SIZE INTO BLOCK HEADER
+ SUB OCNT BUFFER SIZE
+ ADD K101 =1 (ACCOUNT FOR CHECKSUM)
+ LLR 6
+ LGR 6
+ LLL 6 BRING IN UPPER HALF OF ADDRESSES
+ STA OCI STORE INTO BUFFER
+ JMP FS10 COMPUTE CHECKSUM
+*
+FS40 DAC OCI+1,1
+FS41 BCI 2,EOB 'EOB'
+K145 OCT 20000 BLOCK TYPE 2 CODE
+C499 OCT 060000
+*
+OCI BSS 40 40 WORD CARD IMAGE INPUT BUFFER
+PRI BSS 40 40 WORD PRINT BUFFER
+ BCI 20,
+ BSS 30 COMPILER PATCH AREA
+*
+* ***********************
+* *IOS (AND IOL) GO HERE*
+* ***********************
+*
+ END A0
projects / h316.git / commitdiff