+++ /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