--- /dev/null
+* F4$DUM - DEC 10 2006 - VERSION 1
+*
+* FORTRAN COMPILER DUMMY DEVICE DRIVERS AND DATA POOL INITIALISATION
+*
+* THIS MODULE MUST BE THE LAST ONE BEING LINKED TO THE F4 COMPILER.
+* THESE ROUTINES ARE CALLED BY F4-IOS AND THE INITIALISATION ROUTINE
+* IS OVERWRITTEN BY THE DATA POOL AFTER INITIALISATION.
+*
+* HONEYWELL X16 16 BIT COMPUTER SOFTWARE
+*
+* PROGRAM LENGTH: 48 WORDS
+*
+* THIS SOURCE IS RECREATED FROM THE EXISTING SLST FILE:
+* - SLST-FRTN.IMG (WHICH ORIGINATES FROM HONEYWELL)
+*
+* THE SOURCE IS RECREATED BY: THEO ENGEL (THEO.ENGEL@HETNET.NL)
+*
+ SUBR F4$INI,SIZE
+ SUBR F4$DUM,DUM
+ SUBR O$LH
+ SUBR O$ME
+*
+ SUBR I$AA
+ SUBR I$CA
+ SUBR I$PA
+ SUBR I$MA
+ SUBR C$6TO8,C$68
+*
+ SUBR O$PB
+ SUBR O$AB
+ SUBR O$MB
+*
+ SUBR O$LA
+ SUBR C$8TO6,C$86
+ SUBR O$MA
+*
+ REL
+*
+DUM EQU *
+ DAC *-*
+ JMP* *-1
+*
+O$LH EQU *
+O$ME EQU *
+ DAC *-*
+ IRS *-1
+ JMP* *-2
+*
+* SOURCE INPUT
+I$AA EQU *
+I$CA EQU *
+I$PA EQU *
+I$MA EQU *
+C$68 EQU *
+ DAC *-* DUMMY SOURCE INPUT
+ JMP* SI
+*
+* OBJECT OUTPUT
+O$PB EQU *
+O$AB EQU *
+O$MB EQU *
+O$MS EQU *
+ DAC *-* DUMMY OBJECT OUTPUT
+ JMP* OO
+*
+* LISTING OUTPUT
+O$LA EQU *
+C$86 EQU *
+O$MA EQU *
+ DAC *-* DUMMY LISTING OUTPUT
+ JMP* LL
+*
+* JUMP TABLE TO APPROPRIATE DUMMY DRIVER IN F4-IOS
+SI XAC F4$DUI POINTER TO DUMMY SOURCE INPUT DEVICE DRIVER
+OO XAC F4$DUO POINTER TO DUMMY OBJECT OUTPUT DEVICE DRIVER
+LL XAC F4$DUS POINTER TO DUMMY LISTING OUTPUT DEVICE DRIVER
+*
+* PURPOSE OF INI ROUTINE IS TWOFOLD:
+* - INITIALIZE THE MEMORY BOUNDARIES BEING USED BY THE F4 COMPILER CODE
+* AND I/O DRIVERS TO DETERMINE THE SPACE FOR THE DATA POOL
+* - INITIALIZE AND LINK THE DATA POOL TO THE F4 COMPILER VIA SECTOR 0
+*
+DP EQU * START OF DATA POOL
+*
+SIZE DAC *-*
+ LDA SIZE GET RETURN ADDRESS
+ SUB N1 MINUS 1
+ STA SIZE = CALLING ADDRESS
+ LDA NOP
+ STA* SIZE REPLACE CALL BY NOP
+NEXT LDA MTOP MEMORY BOUNDARY
+ SUB CTOP MINUS CODE LENGTH
+ SUB O103 ='103
+ STA LO SAVE DATAPOOL SIZE
+ LDA* MTOP CONTENT MEM BOUNDARY
+ IAB => B = CONTENT MEM BOUNDARY
+ LDA PAT PATTERN
+ STA* MTOP STORE PATTERN
+ LDA* MTOP AND TRY TO GET IT BACK
+ SNZ
+ JMP* SIZE MEMORY SIZE = MTOP
+ IAB
+ STA* MTOP RESTORE CONTENT MEM BOUNDARY
+ LDA MTOP
+ ADD M4K INCREASE MEM BOUNDARY WITH 4K
+ STA MTOP
+ ERA UPP 16K?/20K?
+ SZE
+ JMP NEXT NO
+*
+* THE ADAPTION PROCESS STOPS HERE WHEN MTOP = 16K
+* THE DATA POOL SIZE (LO) IS ADAPTED THEN FOR THE MTOP = 12K
+* FOR A 16K MACHINE THE UPPER 4K IS NOT USED FOR THE DATAPOOL.
+* TO USE THAT UPPER 4K, THE VALUE OF 'UPP' HAS TO CHANCE TO '50000
+*
+ JMP* SIZE YES; STOP IF MTOP = UPP
+*
+* WORKSPACE
+*
+MTOP OCT 20000 MINIMUM MEMORY TOP (8K INIT)
+NOP NOP NOP OPERATION
+CTOP DAC DP CODE TOP
+UPP OCT 40000 16K (20K => '50000)
+M4K OCT 10000 4K
+PAT OCT 12525 MEMORY PATTREN
+O103 OCT 103 ='103
+N1 OCT 1
+*
+*
+* THE FOLLOWING TABLE LINKS THE DATA POOL VIA SECTOR 0 TO THE F4 COMPILER
+*
+*
+ ABS
+ ORG '100
+ DAC DP-4,1 (100)
+ DAC DP-3,1 (101)
+ DAC DP-2,1 (102)
+ DAC DP-1,1 (103)
+ DAC DP,1 (104)
+ DAC DP+1,1 (105)
+ DAC DP+2,1 (106)
+ DAC DP+3,1 (107)
+ DAC DP+4,1 (110)
+ DAC DP+5,1 (111)
+ DAC DP+6,1 (112)
+LO DAC DP+7 (113) DATA POOL SIZE
+*
+ END
--- /dev/null
+* F4$IOS-B - DEC 12 2006 - VERSION 1
+*
+* FORTRAN COMPILER IO SELECTOR
+*
+* WHEN THE COMPILER IS STARTED, REGISTER A SPECIFIES THE DEVICES
+* TO BE USED FOR SOURCE INPUT, OBJECT OUTPUT AND FOR LISTING OUTPUT.
+* THE IOS SELECTOR HONORS THIS SELECTION BY ACTIVATING THE SELECTED
+* DEVICES FOR THESE TASKS.
+*
+* THE FOLOWING OPTIONS ARE SUPPORTED:
+*
+* A[ 8-10] SOURCE INPUT DEVICE (1=TTY 2=CR 3=HSR 4=MAGTAPE-UNIT 1)
+* A[11-13] LISTING DEVICE (0=SUP 1=TTY 2=LP 4=MAGTAPE-UNIT 2)
+* A[14-16] OBJECT OUTPUT DEVICE (0=SUP 1=PTP 2=TTY 4=MAGTAPE-UNIT 2)
+* THE LISTED DEVICE ALLOCATION IS SET BY F4IOS
+* THIS VERSION OF F4IOS DOES NOT, WITHOUT MODIFICATION, SUPPORT OTHER
+* DEVICES FOR THE SPECIFIED TASKS.
+* THIS ALSO MEANS THAT TAPE UNIT 2 CAN EITHER BE USED FOR
+* OBJECT OUTPUT OR FOR LISTING OUTPUT
+*
+* IN CASE NO DEVICE SELECTION IS SPECIFIED IN REGISTER A, A DEFAULT
+* SELECTION IS MADE BY F4IOS:
+* - SOURCE INPUT 3=HSR
+* - LISTING OUTPUT 1=TTY
+* - OBJECT OUTPUT 1=PTP
+*
+* F4IOS LINKS, TO SUPPORT THE SPECIFIED IO, THE DRIVERS FOR THESE DEVICES.
+* HOWEVER, IF FOR INSTANCE NO MAGTAPE IS AVAILABLE IN A PARTICULAR
+* INSTALLATION, THE MAGTAPE DRIVER CAN BE REPLACED BY A DUMMY DRIVER.
+* THE COMPILER FOOTPRINT IN MEMORY BECOMES SMALLER THEN. DO NOT LINK
+* THE MAGTAPE DRIVER IN THAT CASE. THE F4$DUM MODULE RESOLVES THE CALLS
+* TO THE MAGTAPE DRIVER AND MUST BE THAT LAST MODULE TO BE LINKED.
+*
+* HONEYWELL X16 16 BIT COMPUTER SOFTWARE
+*
+* PROGRAM LENGTH: 415 WORDS
+*
+* THIS SOURCE IS RECREATED FROM THE EXISTING SLST FILE:
+* - SLST-FRTN.IMG (WHICH ORIGINATES FROM HONEYWELL)
+*
+* THE SOURCE IS RECREATED BY: THEO ENGEL (THEO.ENGEL@HETNET.NL)
+*
+* SUBR F4$INT,F4IN IO INITIALISATION ROUTINE
+* SUBR F4$IN,F4SI GENERAL SOURCE INPUT ROUTINE
+* SUBR F4$OUT,F4OO GENERAL OBJECT OUTPUT ROUTINE
+* SUBR F4$SYM,F4LO GENERAL LISTING OUTPUT ROUTINE
+* SUBR F4$END,F4EN END COMPILATION
+*
+* SUBR F4$DUI,IL1 DUMMY SOURCE INPUT DRIVER
+* SUBR F4$DUO,OL4 DUMMY OBJECT OUTPUT DRIVER
+* SUBR F4$DUS,LL9 DUMMY LISTING OUTPUT DRIVER
+*
+ SUBR F4$INT,F4IN
+ SUBR F4$IN,F4SI
+ SUBR F4$OUT,F4OO
+ SUBR F4$SYM,F4LO
+ SUBR F4$END,F4EN
+*
+ SUBR F4$DUI,IL1
+ SUBR F4$DUO,OL4
+ SUBR F4$DUS,LL9
+ REL
+*
+*******************************************************************
+* F4$INT -- INIT COMPILER DATA POOL AND STORE IO DEVICE SELECTION *
+*******************************************************************
+*
+F4IN DAC *-*
+ JST SDEV SET THE SELECTED DEVICES
+ JST PUTR PUNCH LEADER IN CASE PTP IS OBJECT DEVICE
+ CALL F4$INI SET THE SIZE OF THE DATA POOL
+ CRA
+ STA SCNT SOURCE INPUT RECORD COUNTER/LINENUMBER = 0
+ IRS INFL SET 1ST-TIME-CALL FLAG FOR LISTING DRIVER
+ JMP* F4IN
+*
+**************************************
+* GENERAL SOURCE INPUT ROUTINE *
+* CALLING SEQUENCE: *
+* CALL F4$IN *
+* DAC SOURCEBUFFER *
+**************************************
+*
+F4SI DAC *-* SOURCE INPUT DRIVER
+ LDA* F4SI GET SOURCE BUFFER ADDRESS
+ STA IB1 AND STORE
+ STA IB2
+ STA IB3
+ STA IB4
+ STA IB5
+ STA IB6
+IL6 LDA DSRC LOAD SELECTED SOURCE DEVICE
+ JST SWCH JMP SWITCH
+ JMP IL1 0 NON
+ JMP IL2 1 TTY
+ JMP IL3 2 CR
+ JMP IL4 3 HSR
+ JMP IL5 4 MAG TAPE
+ JMP IL1 5 NON
+ JMP IL1 6 NON
+* DUMMY SOURCE INPUT DEVICE DRIVER: SELECT PROPER DEVICE
+IL1 LDA MO5 7 NON =-5 MESSAGE LENGTH, 5 WORDS LONG
+ JST PRBF
+ DAC MDEV MESSAGE: DEVICE? (NO DRIVER FOR REQUESTED DEVICE)
+ JST STOP SET DEFAULT OR NEW DEVICE SELECTION
+ JMP IL6
+*
+IL2 CALL I$AA TTY = SOURCE INPUT DEVICE
+IB1 DAC *-* SOURCE BUFFER ADDRESS
+ JMP IL2 EOM/EOF RETURN
+ JMP IL7 NORMAL RETURN
+IL3 CALL I$CA CR = SOURCE INPUT DEVICE
+IB2 DAC *-* SOURCE BUFFER ADDRESS
+ JMP IL3 EOM/EOF RETURN
+ JMP IL7 NORMAL RETURN
+IL4 CALL I$PA HSR = SOURCE INPUT DEVICE
+IB3 DAC *-* SOURCE BUFFER ADDRESS
+ JMP IL4
+ JMP IL7
+IL5 CALL I$MA MT = SOURCE INPUT DEVICE
+IB4 DAC *-* SOURCE BUFFER ADDRESS
+ OCT 50 BUFFER LENGTH (WORDS)
+ OCT 1 TAPE UNIT 1 = SOURCE DECK
+ JMP ERR0 RECORD NOT READABLE RETURN
+ JMP ERR1 END OF TAPE RETURN
+ JMP IL5 END OF FILE RETURN; READ NEXT FILE
+ CALL C$6TO8 NORMAL RETURN; CONVERT RECORD TO ASCII
+IB5 DAC *-* SOURCE BUFFER ADDRESS
+ OCT 50 BUFFER LENGTH
+IL7 LDA SCNT SOURCE RECORD COUNTER
+ ADD N1 =1
+ SSP
+ STA SCNT SOURCE RECORD COUNTER
+ IRS F4SI SET RETURN ADDRESS
+ JMP* F4SI
+*
+**************************************
+* GENERAL OBJECT OUTPUT ROUTINE *
+* CALLING SEQUENCE: *
+* A = OBJECT BUFFER ADDRESS *
+* X = - BUFFER LENGTH (WORDS) *
+* CALL F4$OUT *
+**************************************
+*
+F4OO DAC *-* OBJECT OUTPUT DRIVER
+ STA OSRC EXTERNAL OBJECT BUFFER ADDRESS
+ LDA 0 - BUFFER LENGTH (WORDS)
+ TCA
+ STA OBFL + BUFFER LENGTH (WORDS)
+ STA MTBL
+ ADD OPTR POINTER TO OUTPUT BUFFER
+ ADD IFLG INDEX FLAG
+ STA ODES INDEXED DESTINATION
+OL1 LDA* OSRC MOVE OBJECT TO INTERNAL OUTPUT BUFFER
+ STA* ODES
+ IRS 0
+ JMP OL1
+OL6 LDA DOBJ
+ JST SWCH JMP SWITCH
+ JMP* F4OO 0 SUPPRESS OBJECT OUTPUT
+ JMP OL2 1 PTP
+ JMP OL3 2 TTY
+ JMP OL4 3 NON
+ JMP OL5 4 MAG TAPE
+ JMP OL4 5 NON
+ JMP OL4 6 NON
+* DUMMY OBJECT OUTPUT DEVICE DRIVER: SELECT PROPER DEVICE
+OL4 LDA MO5 7 NON =-5
+ JST PRBF
+ DAC MDEV MESSAGE: DEVICE?
+ JST STOP SET DEFAULT OR NEW DEVICE SELECTION
+ JST PUTR PUNCH TRAILER IN CASE PTP IS SELECTED
+ JMP OL6
+*
+OL2 CALL O$PB PTP = OBJECT OUTPUT DEVICE
+ DAC OBUF OUTPUT BUFFER ADDRESS
+ JMP* F4OO EXIT
+OL3 CALL O$AB TTY = OBJECT OUTPUT DEVICE
+ DAC OBUF OUTPUT BUFFER ADDRESS
+ JMP* F4OO EXIT
+OL5 CALL O$MB MAG TAPE = OBJECT OUTPUT DEVICE
+ DAC OBUF+1 BUFFER ADDRESS
+MTBL OCT 0 BUFFER LENGTH (WORDS)
+ OCT 2 TAPE UNIT 2 = OBJECT DECK
+ JMP ERR1 END OF TAPE RETURN
+ JMP* F4OO EXIT
+*
+**************************************
+* GENERAL LISTING OUTPUT ROUTINE *
+* CALLING SEQUENCE: *
+* CALL F4$SYM *
+* DAC LINEBUFFER *
+**************************************
+*
+F4LO DAC *-* LISTING OUTPUT DRIVER
+ LDA SPSP <SPACE><SPACE>
+ STA OBUF SET LINENUMBER FIELD
+ STA OBUF+1 (6 CHARS) TO SPACES
+ STA OBUF+2
+ LDA* F4LO EXTERNAL BUFFER ADDRESS
+ ADD ILPB +INDEX / LENGTH
+ STA OSRC INDEXED EXTERNAL BUFFER ADDRESS
+ LDA MO50 ='-50
+ STA 0 X = INDEX INTO THE LINE BUFFER
+LL1 LDA* OSRC MOVE LINE TO INTERNAL DRIVER BUFFER
+ STA LBUF,1
+ IRS 0
+ JMP LL1
+LL10 LDA INFL NON-ZERO WITH 1ST CALL
+ SNZ
+ JMP LL2 EQUAL 0
+* 1ST CALL OF LISTING DRIVER
+ LDA* F4LO EXTERNAL BUFFER ADDRESS
+ ERA IB6 EQUAL TO SOURCE BUFFER ADDRESS??
+ SZE
+ JMP LEX NOT EQUAL; EXIT
+ LDA DLST YES; GET REQUIRED LISTING DEVICE
+ ERA N2 EQUAL 2 ? (LP)
+ SZE
+ JMP LL2 NOT LP
+ CALL O$LH YES, LP. INIT THE HEADER
+ DAC OBUF
+LL2 LDA* F4LO EXTERNAL BUFFER ADDRESS
+ ERA IB6 EQUAL TO SOURCE BUFFER ADDRESS??
+ SZE
+ JMP LL3 NO
+ LDA TPTR YES, EQUAL TO SOURCE BUFFER
+ STA TEMP TEMP = PTR TO DEC CONV TAB
+ LDA SCNT GET SOURCE LINE NUMBER
+ STA NUMB LINENUMBER TO PRINT
+* WITH ZERO BEING TRUE, LEADING ZERO'S OF THE LINENUMBER ARE SUPPRESSED
+ IRS ZERO LEADING ZERO FLAG IS TRUE (SET TO FALSE WITH 1ST NONZERO)
+ JST CDIG DIGIT 1
+ JST CDIG DIGIT 2
+ JST CDIG DIGIT 3
+ JST CDIG DIGIT 4
+ JST CDIG DIGIT 5
+LL3 LDA DLST WHICH DRIVER TO OUTPUT LISTING?
+ JST SWCH JMP SWITCH
+ JMP LL4 0 SUPPRESS LISTING
+ JMP LL5 1 TTY
+ JMP LL6 2 LP
+ JMP LL9 3 NON
+ JMP LL8 4 MAG TAPE
+ JMP LL9 5 NON
+ JMP LL9 6 NON
+* DUMMY LISTING OUTPUT DEVICE DRIVER: SELECT PROPER DEVICE
+LL9 LDA MO5 7 NON =-5
+ JST PRBF
+ DAC MDEV MESSAGE: DEVICE?
+ JST STOP SET DEFAULT OR NEW DEVICE SELECTION
+ JMP LL10
+*
+LL5 LDA O43 TTY = LISTING OUTPUT DEVICE (35 WORDS)
+LL13 STA 0 REMOVE TRAILING BLANKS
+ LDA OBUF,1
+ ERA SPSP
+ SZE
+ JMP LL11
+ LDA 0
+ SNZ
+ JMP LL12
+ SUB N1
+ JMP LL13
+LL11 IRS 0
+ LDA 0
+ TCA A = - LENGTH (IN WORDS) OF THE LINE TO PRINT
+LL12 JST PRBF PRINT THE LINE
+ DAC OBUF
+ JMP LL4
+LL6 CALL O$LA LP = LISTING OUTPUT DEVICE
+ DAC OBUF OUTPUT BUFFER (60 WORDS)
+ JMP LL4
+LL8 CALL C$8TO6 MAG TAPE = LISTING OUTPUT DEVICE (UNIT 2)
+ DAC OBUF OUTPUT BUFFER
+ OCT 50 BUFFER LENGTH (WORDS)
+ CALL O$MA
+ DAC OBUF OUTPUT BUFFER
+ OCT 50 BUFFER LENGTH (WORDS)
+ OCT 2 TAPE UNIT 2 = OBJECT DECK
+ JMP ERR1 EOT RETURN
+LL4 CRA NORMAL RETURN
+ STA INFL RESET 1ST-TIME-CALL FLAG OF THE LISTING DRIVER
+LEX IRS F4LO SET RETURN ADDRESS
+ JMP* F4LO
+*
+* CONVERT 1 DIGIT FOR PRINTING A 5 DIGIT LINENUMBER
+* USED BY THE OUTPUT LISTING DRIVER
+CDIG DAC *-*
+ CRA
+ STA 0 X=0 (COUNT=0)
+ LDA NUMB NUMBER (OR RESIDUAL OF NUMBER) BEING CONVERTED
+CV1 SUB* TEMP TEMP = POINTER INTO CONVERSION TABLE
+ SPL
+ JMP CV2 NEGATIVE
+ STA NUMB STILL POSITIVE
+ IRS 0 COUNT + 1
+ JMP CV1
+CV2 IRS TEMP TEMP = POINTER TO NEXT ITEM IN CONVERSION TABLE
+ LDA TPTR POINTER TO TABLE
+ SUB TEMP MINUS THE CURRENT POINTER TO THE TABLE
+ STA T1
+ ADD N1 +1
+ TCA
+ LGR 1 = INDEX IN BUFFER
+ IMA 0 A = COUNT
+ SNZ
+ JMP CV3 COUNT = 0 => DIGIT WOULD BE 0
+CV4 ADD O20 ='20 (TO MAKE ASCII DIGIT OF SPACE)
+CV5 ALR '10
+ IRS T1
+ JMP CV5
+ ADD OBUF,1
+ STA OBUF,1
+ CRA
+ STA ZERO RESET THE LEADING ZERO FLAG
+ JMP* CDIG
+CV3 LDA ZERO NONZERO IF STILL LEADING ZERO'S
+ SZE
+ JMP* CDIG NONZERO, SO STILL A LEADING ZERO
+ JMP CV4 ZERO, SO NOT A LEADING ZERO, SO OUTPUT
+*
+**************************************
+* STOP COMPILATION: F4$END *
+**************************************
+*
+F4EN DAC *-*
+ LDA DOBJ OBJECT DEVICE?
+ JST PUTR PUNCH TRAILER IN CASE OF PTP
+ LDA DOBJ
+ ERA N1 PTP?
+ SNZ
+ OCP '102 YES; PTP OFF
+ ERA N5 OBJECT DEVICE MAGTAPE?
+ SNZ
+ JMP LE1 YES
+ LDA DLST LISTING DEVICE MAGTAPE?
+ ERA N4
+ SZE
+ JMP LE2 NO
+LE1 CALL O$ME WRITE EOF ON UNIT 2 (OBJECT OR LISTING DEVICE)
+ OCT 2 UNIT 2
+LE2 LDA MO6 ='-6
+ JST PRBF PRINT EOJ MESSGE
+ DAC MEOJ
+ JST STOP STOP
+ LDA DEFT
+ JMP* F4EN AND RESTART
+MEOJ OCT 106612 END OF JOB MESSAGE
+ BCI 1,EN
+ BCI 1,D
+ BCI 1,OF
+ BCI 1, J
+ BCI 1,OB
+*
+**************************************
+* STOP AND (RE)LOAD DEVICE SELECTION *
+**************************************
+* CALLED BY SOURCE, OBJECT AND LISTING (DUMMY) DRIVERS OF F4-IOS
+* CALLED BY F4$END (WHICH IS ALSO PART OF F4-IOS)
+*
+STOP DAC *-*
+ LDA DEFT LOAD DEFAULT DEVICE SETTINGS
+ HLT STOP AND POSSIBLY ADAPT THE SETTING
+ JST SDEV SET THE NEW DEVICE SELECTION
+ JMP* STOP
+*
+**************************************************************
+* SAVE DEVICE SELECTION AS DEFINED DURING COMPILER (RE)START *
+**************************************************************
+* DEVICE SELECTION AS SPECIFIED IN REG-A (SOURCE, LIST, OBJECT), OR DEFAULT
+*
+SDEV DAC *-* SET SELECTED DEVICES
+ SZE
+ STA DEFT STORE REQUESTED DEVICES
+ LDA DEFT LOAD DEFAULT IF NOTHING SPECIFIED,
+ LRL 6
+ ANA M7
+ STA DSRC SOURCE DEVICE
+ CRA
+ LLL 3
+ STA DLST LISTING DEVICE
+ CRA
+ LLL 3
+ STA DOBJ OBJECT DEVICE
+ JMP* SDEV
+*
+******************************************************************
+* PUNCH LEADER/TRAILER IN CASE PTP IS THE SELECTED OBJECT DEVICE *
+******************************************************************
+* A[14-16] = SELECTED OBJECT DEVICE
+*
+PUTR DAC *-*
+ ERA N1 =1 PUNCHER SELECTED?
+ SNZ
+ CALL O$PLDR YES; PUNCH LEADER/TRAILER
+ JMP* PUTR
+*
+**************************************
+* PRINT MESSAGE FROM BUFFER ON TTY *
+**************************************
+* CALLING SEQUENCE:
+* JST PRBF A = - MESSAGE LENGTH IN WORDS
+* DAC MESSAGE
+*
+PRBF DAC *-* PRINT BUFFER
+ STA 0 X = A = - BUFFER LENGTH
+ LDA* PRBF BUFFER ADDRESS
+ IRS PRBF SET RETURN ADDRESS
+ STA BA STORE BUFFER ADDRESS
+ SKS '104 TTY READY?
+ JMP *-1
+ OCP '104 SET OUTPUT MODE
+ LDA CRLF
+ JST PRA PRINT 2 CHARS IN A
+ LDA 0
+ SNZ
+ JMP* PRBF
+P1 LDA* BA GET 2 CHARS
+ JST PRA PRINT 2 CHARS IN A
+ IRS BA
+ IRS 0
+ JMP P1
+ JMP* PRBF
+*
+**************************************
+* PRINT 2 CHARS FROM REG-A ON TTY *
+**************************************
+*
+PRA DAC *-*
+ LRL '10
+ OTA 4
+ JMP *-1
+ LLL '10
+ OTA 4
+ JMP *-1
+ JMP* PRA
+*
+**************************************
+* SWITCH VIA JUMP-TABLE *
+**************************************
+* CALLING SEQUENCE:
+* LDA INDEX INTO JUMP-TABLE
+* JST SWCH
+* JMP -- JUMP-TABLE ENTRY 0 (INDEX 0)
+* JMP -- JUMP-TABLE ENTRY 1 (INDEX 1)
+* ETC
+*
+SWCH DAC *-* SWITCH
+ ADD SWCH
+ STA SWCH
+ JMP* SWCH
+*
+**************************************
+* ERROR HANDLING ROUTINES *
+**************************************
+*
+STRT EQU '1000 COMPILER START ADDRESS
+ERR0 LDA MO2 =-2
+ JST PRBF
+ DAC MUR MESSAGE: UR (RECORD UNREADABLE)
+ JMP ERR2
+ERR1 LDA MO3 =-3
+ JST PRBF
+ DAC MEOT MESSAGE: EOT (END OF TAPE)
+ERR2 JST STOP
+ LDA DEFT LOAD DEVICE SETTINGS (REG-A)
+ JMP STRT RESTART COMPILATION
+*
+**************************************
+* F4-IOS DATA AREA *
+**************************************
+*
+DEFT OCT 311 DEFAULT SELECTION OF IO DEVICES (I 3=HSR; L 1=TTY; O 1=PTP)
+* DECIMAL CONVERION TABLE (USER FOR PRINTING NUMBERS)
+DTAB OCT 23420 =10000
+ OCT 1750 =1000
+ OCT 144 =100
+ OCT 12 =10
+ OCT 1 =1
+DSRC OCT 0 SOURCE INPUT DEVICE AS SPECIFIED DURING START
+DLST OCT 0 LISTING DEVICE AS SPECIFIED DURING START
+DOBJ OCT 0 OBJECT OUTPUT DEVICE AS SPECIFIED DURING START
+IB6 OCT 0 SOURCE BUFFER ADDRESS
+SCNT OCT 0 SOURCE RECORD COUNTER
+INFL OCT 0 FLAG LISTING DRIVER (NONZERO WITH 1ST-TIME-CALL)
+OSRC OCT 0 POINTER TO EXTERNAL OBJECT BUFFER
+BA EQU * BUFFER ADDRESS
+TEMP EQU * TEMP POINTER TO DECIMAL CONVERSION TABLE
+ODES OCT 0 INDEXED POINTER TO INTERNAL OBJECT BUFFER
+NUMB OCT 0 TEMP STORAGE FOR LINENUMBER TO CONVERT/PRINT
+ZERO OCT 0 SET TO 0 WITH 1ST NONZERO DIGIT IN LINENUMBER
+T1 OCT 0
+OPTR DAC OBUF POINTER TO OUTPUT BUFFER
+TPTR DAC DTAB POINTER TO DECIMAL CONVERSION TABLE
+*
+OBFL EQU * OUTPUT BUFFER LENGTH FOR BINARY OUTPUT (WORDS)
+OBUF OCT 4 OUTPUT BUFFER (60 WORDS; MUST NOT EXCEED 60 WORDS)
+ OCT 300
+ OCT 0
+ OCT 2
+ OCT 302
+ BCI 3,
+ BCI 3,EOB
+ BCI 3,000300
+ BCI 1,
+ BCI 3,000000
+ BCI 1,
+ BCI 3,000002
+ BCI 3,
+ BCI 3,
+ BCI 3,
+ BCI 3,
+ BCI 3,
+ BCI 3,
+ BCI 3,
+LBUF BCI 3, END OF LISTING BUFFER
+ BCI 3,
+ BCI 3,
+ BCI 3,
+ BCI 3,
+ BCI 2,
+*
+CRLF EQU *
+* MESSAGE: DRIVER? (NO DEVICE DRIVER FOR REQUESTED DEVICE) 5 WORDS LONG
+MDEV OCT 106612 MESSAGE: DEVICE?
+ BCI 1,DE
+ BCI 1,VI
+ BCI 1,CE
+ BCI 1,?
+*
+MEOT OCT 106612 MESSAGE: EOT (END OF TAPE)
+ BCI 1,EO
+ BCI 1,T
+MUR OCT 106612 MESSAGE: UR (UNREADABLE RECORD)
+ BCI 1,UR
+MO3 OCT 177775
+MO2 OCT 177776
+M7 OCT 7
+MO6 OCT 177772
+N4 OCT 4
+N5 OCT 5
+O20 OCT 20
+O43 OCT 43
+N2 OCT 2
+MO50 OCT 177730 ='-50
+ILPB OCT 40050 INDEX LISTING BUFFER
+SPSP OCT 120240 <SPACE><SPACE>
+IFLG OCT 40001 INDEX FLAG
+MO5 OCT 177773
+N1 OCT 1
+ END
+++ /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
--- /dev/null
+* C210-001-6601 (FRTN) 3C NO.180463000 REV. D
+*
+*
+*
+* COMPUTER. DDP-116,516
+*
+*
+*
+*
+* PROGRAM CATEGORY- COMPILER
+*
+*
+*
+*
+* PROGRAM TITLE. FRTN
+* EXPANDED FORTRAN IV COMPILER
+* FOR DDP-116,516
+*
+*
+*
+*
+*
+*
+*
+* APPROVAL DATE
+*
+*
+* PROG--------------------- ------------
+*
+*
+* SUPR---------------------- ------------
+*
+*
+* QUAL---------------------- ------------
+*
+*
+* NO. OF PAGES ------------
+*
+* REVISIONS
+*
+* REV. D ECO 5249
+* REV. C ECO 3824 10-31-66
+* REV. B ECO 3476 09-19-66
+* REV. A 06-08-66
+*
+* AUTHOR
+*
+* HONEYWELL. INC. - COMPUTER CONTROL DIVISION
+*
+*
+* PURPOSE
+*
+* THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV
+* PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE
+* DDP-116 OR DDP-516.
+*
+*
+* RESTRICTIONS
+*
+* MINIMUM 8K CORE STORAGE
+*
+*
+* STORAGE
+*
+* 6682 (DECIMAL)
+* 15034 (OCTAL)
+*
+*
+* USE
+*
+*
+* ********************************
+*
+* *FORTRAN-IV OPERATING PROCEDURE*
+* ********************************
+*
+* 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE'
+* (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES
+*
+* 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE
+* SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE
+* SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START.
+*
+* 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY).....
+* 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS
+* OPTION IS USED WHEN COMPILING THOSE PARTS OF THE
+* LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE
+* LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO
+* GENERATE SPECIAL CODING.
+*
+* 2-7....NOT ASSIGNED
+*
+* 8-10...INPUT DEVICE SELECTION
+* 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER)
+* 2 = NCR CARD READER
+* 3 = DIGITRONICS PAPER TAPE READER
+* 4 = MAGNETIC TAPE ( UNIT 1 )
+* 5-7 = (SPARES)
+*
+* 11-13..SYMBOLIC LISTING SELECTION
+* 0. SUPPRESS ALL SYMBOLIC LISTINGS
+* 1. ASR-33/35 TYPEWRITER
+* 2. LINE PRINTER
+* 3 = ( SPARE )
+* 4 = LISTING ON MAGNETIC TAPE UNIT 2
+* 5-7 = (SPARES)
+*
+* 14-16..BINARY OUTPUT SELECTION
+* 0. SUPPRESS BINARY OUTPUT.
+* 1. BRPE HIGH SPEED PAPER TAPE PUNCH
+* 2. ASR BINARY OUTPUT ASR/33
+* 3. ASR BINARY OUTPUT ASR/35
+* 4 = MAGNETIC TAPE OUTPUT
+* 5-7 (SPARES)
+*
+*
+* 4. SENSE SWITCH SETTINGS AND MEANINGS.......
+* 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE
+* SIDE-BY-SIDE OCTAL INFORMATION.
+* 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET).
+* 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING
+* THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT
+* STATUS OF THE I/O KEYBOARD, IT MAY BE
+* CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING
+* SSW-3 AND PRESSING START TO CONTINUE.
+* 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED
+* IN THE OBJECT CODING BEING GENERATED REGARDLESS OF
+* ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR
+* OVERRIDE).
+*
+* 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER
+* AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A
+* LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF
+* TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE
+* PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START'
+* TO PROCESS THE NEXT PROGRAM (BATCH COMPILING).
+*
+* FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS
+* PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT
+* THE COMPILATION.
+*
+*
+* ERRORS
+*
+* THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A
+* SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION.
+* *************************
+* *DATA POOL ENTRY FORMATS*
+* *************************
+*
+* THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION
+* 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS
+* AT THE END OF THE COMPILER AND EXTENDS TOWARD THE
+* END OF MEMORY.
+*
+* TDCCCCCCCCCCCCCC....DP(A+4)
+* CCCCCCCCCCCCCCCC....DP(A+3)
+* CCCCCCCCCCCCCCCC....DP(A+2)
+* IIAAAAAAAAAAAAAA....DP(A+1)
+* NRRRMMMLLLLLLLLL....DP(A)
+*
+* T = TRACE TAG
+* D = DATA TAG
+* C = SIX 8-BIT CHAR. OR BINARY CONSTANT
+* I = ITEM USAGE (IU)
+* 0 = NO USAGE 2 = VAR/CONSTAN^
+* 1 = SUBPROGRAM 3 = ARRAY
+* A = ASSIGNMENT ADDRESS
+* N = NAME TAG (NT)
+* 0 = NAME 1 = CONSTANT
+* R = ADDRESS TYPE (AT)
+* 0 = ABSOLUTE 3 = STRING-REL
+* 1 = RELATIVE 4 = COMMON
+* 2 = STRING-ABS 5 = DUMMT
+* M = ITEM MODE (IM)
+* 1 = INTEGER 5 = COMPLEX
+* 2 = REAL 6 = DOUBLE
+* 3 = LOGICAL
+* 4=COM/EQU LINK
+* 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT
+* TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT
+* A DO-LOOP, EACH ENTRY IS 5 WORDS.
+* 00IIIIIIIIIIIII
+* 00TTTITTTTTTTTT
+* 00XXXXXXXXXXXXX
+* 00UUUUUUUUUUUUUU
+* 00NNNNNNNNNNNNNN
+* I = INITIAL VALUE/OR RPL
+* T = TERMINAL VALUE
+* X = INDEX
+* U = INCREMENT
+* N = STATEMENT NUMBER
+*
+* 3. THE EXPRESSION TABLE (A0I TABLE) 'FLOATS' ON TOP
+* THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES.
+*
+* NOOOOOOOOIIIIIII.....DP(I+1)
+* 00AAAAAAAAAAAAAAAA...DP(I)
+* N = NEGATION INDICATOR
+* O = OPERATOR
+* I = INDEX (OPERATOR LEVEL)
+* A = ASSIGNMENT TABLE REFERENCE
+* 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND
+* IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE
+* COMPILER. EACH ENTRY IS THREE WORDS LONG.
+*
+* S000000000PPPPPP.....DP(L+2)
+* 0011111111111111.....DP(L+1)
+* 0022222222222222.....DP(L)
+* S = TEMP STORAGE INDICATOR
+* P = OPERATOR
+* 1 = FIRST OPERAND ADDRESS
+* 2 = SECOND OPERAND ADDRESS
+ ABS
+ ORG '100
+*
+* ************************************
+* * DIRECTORY OF FORTRAN IV COMPILER *
+* ************************************
+*
+*
+*
+*..............ENTRANCE GROUP
+ DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE
+ DAC DP DATA POOL START
+*
+*..............INPUT GROUP
+ DAC IC00 (IPG1) INPUT COLUMN
+ DAC UC00 (IPG2) UNINPUT COLUMN
+ DAC CH00 (IPG3) INPUT CHARACTER
+ DAC ID00 (IPG4) INPUT DIGIT
+ DAC IA00 (IPG5) INPUT (A) CHARACTERS
+ DAC FN00 (IPG6) FINISH OPERATOR
+ DAC DN00 (IPG7) INPUT DNA
+ DAC II00 (IPG8) INPUT ITEM
+ DAC OP00 (IPG9) INPUT OPERAND
+ DAC NA00 (IPG10) INPUT NAME
+ DAC IG00 (IPG11) INPUT INTEGER
+ DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT
+ DAC IR00 (IPG13) INPUT INTEGER VARIABLE
+ DAC IS00 (IPG14) INPUT STATEMENT NUMBER
+ DAC XN00 (IPG15) EXAMINE NEXT CHARACTER
+ DAC SY00 INPUT STMBOL
+*
+*..............TEST GROUP
+ DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R)
+ DAC IP00 (TSG2) )-INPUT OPERATOR
+ DAC A1 (TSG3) C/R TEST
+ DAC B1 (TSG4) , OR C/R TEST
+ DAC NU00 (TSG5) NO USAGE TEST
+ DAC NC00 (TSG6) NON CONSTANT TEST
+ DAC NS00 (TSG7) NON SUBPROGRAM TEST
+ DAC AT00 (TSG8) ARRAY TEST
+ DAC IT00 (TSG9) INTEGER TEST
+ DAC NR00 (TSG10) NON REL TEST
+*
+*..............ASSIGNMENT GROUP
+ DAC AS00 (ASG1) ASSIGN ITEM
+ DAC TG00 (ASG2) TAG SUBPROGRAM
+ DAC TV00 (ASG3) TAG VARIABLE
+ DAC FA00 (ASG4) FETCH ASSIGN
+ DAC FL00 (ASG5) FETCH LINK
+ DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION
+ DAC DM00 (ASG7) DEFINE IM
+ DAC DA00 (ASG8) DEFINE AF
+ DAC AF00 (ASG9) DEFINE AFT
+ DAC LO00 (ASG10) DEFINE LOCATION
+ DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT
+ DAC AA00 (ASG12) ASSIGN SPECIAL
+ DAC NXT GET NEXT ENTRY FROM ASSGN TABLE
+ DAC BUD BUILD ASSIGNMENT TABLE ENTRT
+*
+*..............CONTROL GROUP
+ DAC B6 (CNG1) JUMP
+ DAC C5 ILL TERM
+ DAC C6 (CNG2) CONTINUE
+ DAC C7 (CNG3) STATEMENT INPUT
+ DAC C8 (CNG4) STATEMENT SCAN
+ DAC A9 (CNG5) STATEMENT IDENTIFICATION
+ DAC NP00 (CNG6) FIRST NON-SPEC CHECK
+*
+*..............SPECIFICATIONS GROUP
+ DAC EL00 (SPG1) EXCHANGE LINKS
+ DAC NM00 (SPG2) NON COMM0N TEST
+ DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST
+ DAC SC00 (SPG4) INPUT SUBSCRIPT
+ DAC IL00 (SPG5) INPUT LIST ELEMENT
+ DAC R1 (SPG6) FUNCTION
+ DAC R2 SUBROUTINE
+ DAC A3 (SPG7) INTEGER
+ DAC A4 REAL
+ DAC A5 DOUBLE PRECISION
+ DAC A6 COMPLEX
+ DAC A7 LOGICAL
+ DAC B2 (SPG8) EXTERNAL
+ DAC B3 (SPG9) DIMENSION
+ DAC B7 INPUT DIMENSION
+ DAC B4 (SPG10) COMMON
+ DAC B5 (SPG11) EQUIVALENCE
+ DAC C2 (SPG12) RELATE COMMON ITEMS
+ DAC C3 (SPG13) GROUP EOUIVALENCE
+ DAC C4 (SPG14) ASSIGN SPECIFICATIONS
+ DAC W4 (SPG15) DATA
+ DAC R3 (SPG16) BLOCK DATA
+ DAC TRAC (SPG17) TRACE
+*
+*..............PROCESSOR GROUP
+ DAC V3 (PRG1) IF
+ DAC R7 (PRG2) GO TO
+ DAC IB00 INPUT BRANCH LIST
+ DAC W3 (PRG3) ASSIGN
+ DAC C9 (PRG5) DO
+ DAC V7 (PRG6) END FILE
+ DAC V6 BACKSPACE
+ DAC V8 REWIND
+ DAC V5 (PRG7) READ
+ DAC V4 WRITE
+ DAC V2 (PRG8) FORMAT
+ DAC SI00 INPUT FORMAT STRING
+ DAC IN00 INPUT NUMERIC FORMAT STRING
+ DAC NZ00 NON ZERO STRING TEST
+ DAC W8 (PRG9) PAUSE
+ DAC W7 STOP
+ DAC R8 (PRG10) CALL
+ DAC G2 ASSIGNMENT STATEMENT
+ DAC R9 (PRG11) RETURN
+ DAC G1 (PRG12) STATEMENT FUNCTION
+ DAC W5 (PRG13) END
+*
+*..............PROCESSOR SUBROUTINES GROUP
+ DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK
+ DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING
+ DAC DP00 (PSG3) DO INPUT
+ DAC DS00 (PSG4) DO INITIALIZE
+ DAC DQ00 (PSG5) DO TERMINATION
+ DAC EX00 (PSG6) EXPRESSION
+ DAC CA00 (PSG7) SCAN
+ DAC ST00 TRIAD SEARCH
+ DAC TC00 TEMP STORE CHECK
+ DAC ET00 (PSG8) ENTER TRIAD
+ DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE
+*
+*..............OUTPUT GROUP
+ DAC OL00 (OPG1) OUTPUT OBJECT LINK
+ DAC OI00 (OPG2) OUTPUT I/O LINK
+ DAC CN00 (OPG3) CALL NAME
+ DAC OK00 (OPG4) OUTPUT PACK
+ DAC OB00 (OPG5) OUTPUT OA
+ DAC OT00 (OPG6) OUTPUT TRIADS
+ DAC OM00 (OPG7) OUTPUT ITEM
+ DAC OR00 (OPG8) OUTPUT REL
+ DAC OA00 OUTPUT ABS
+ DAC OS00 OUTPUT STRING
+ DAC OW00 (OPG9) OUTPUT WORD
+ DAC PU00 PICKUP
+ DAC FS00 (OPG10) FLUSH
+ DAC TRSE (OPG11) OUTPUT TRACE COUPLING
+ DAC PRSP SET BUFFER TO SPACES
+*
+*..............MISC. GROUP
+ DAC AD3 ADD TWO 3 WORD INTEGERS
+ DAC IM00 MULTIPLY (A) BY (B)
+ DAC STXA SET A INTO INDEX
+ DAC STXI SET I INTO INDEX
+ DAC NF00 SET FS INTO NAMF
+ DAC BLNK SET AREA TO ZEROS
+ DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE
+ DAC CIB COMPARE IBUF TO A CONSTANT
+ DAC SAV SAVE INDEX IN PUSH-DOWN STACK
+ DAC RST RESET INDEX FROM PUSH-DOWN STACK
+ DAC PACK
+ DAC ER00 ERROR OUTPUT
+ DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.)
+ DAC SFT SHIFT LEFT 1 (TRIPLE PRES.)
+ DAC LIST
+*
+*
+* ****************************
+* *CONSTANT AND VARIABLE POOL*
+* ****************************
+*
+XR EQU 0 INDEX REGISTER
+* THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING
+* PROGRAM INITIALIZATION
+A EQU '40 ASSIGNMENT TABLE INDEX
+I EQU A+1 EXPRESSION TABLE INDEX
+C EQU A+2
+ASAV EQU A+3
+L EQU A+4
+MFL EQU A+5 MODE FLAG
+SFF EQU A+6 FUNCTION FLAG
+SBF EQU A+7 SUBFUNCTION FLAG
+SXF EQU A+8 POSSIBLE CPX FLAG
+SPF EQU A+9 PEC. FLAG
+TCF EQU A+10 TEMP STORE COUNT
+IFF EQU A+11
+ABAR EQU A+12 BASE OF ASSIGN TABLE
+XST EQU A+13 FIRST EXECUTABLE STMNT.
+CFL EQU A+14 MON FLAG
+D EQU A+15 DO INDEX
+RPL EQU A+16 RELATE PROGRAM LOCATION
+BDF EQU A+17 LOCK DATA FLAG
+SLST EQU A+18 SOURCE LIST
+OBLS EQU A+19 OUTPUT BINARY LIST
+BNOT EQU A+20 BINART OUTPUT FLAG
+TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.)
+TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN
+* AN EXPRESSION (FOR USE BY TRACE).
+SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET)
+LIF EQU A+24 LOGICAL IF FLAG
+LSTN EQU A+25 LAST STATEMENT NO.
+LSTF EQU A+26 LAST STATEMENT FLAG
+LSTP EQU A+27 LAST STATEMENT STOP
+SDSW EQU A+28 STATEMENT I0 SWITCH
+*
+NAMF EQU '570 NAME FUNCTION
+ND EQU NAMF+1 NO OF DIMENSIONS
+NS EQU '572 NO OF SUBSCRIPTS
+NT EQU NS+1 NAME TAG
+NTF EQU NS+2 NAME TAG FLAG
+NTID EQU NS+3 NO. WORDS IN TID
+O1 EQU NS+4 OPERATOR 1
+O2 EQU NS+5 OPERATOR 2
+P EQU NS+6
+PCNT EQU NS+7
+OCNT EQU NS+8 OUTPUT COUNT
+S0 EQU NS+9
+S1 EQU NS+10 SUBSCRIPT NO.1
+S2 EQU NS+11 SUBSCRIPT NO.2
+S3 EQU NS+12 SUBSCRIPT NO.3
+TC EQU NS+13 TERMINAL CHAR
+TT EQU NS+14
+TYPE EQU NS+15
+X EQU NS+16 ARRAY INDICES
+X1 EQU NS+17
+X2 EQU NS+18
+X3 EQU NS+19
+X4 EQU NS+20
+NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS
+ATA EQU NS+22
+IMA EQU NS+23
+CLA EQU NS+24
+IUA EQU NS+25
+DTA EQU NS+26
+TTA EQU NS+27
+*..........ADJUST THIS ORG IF THE SIZE OF THE CONSTAST POOL IS MODIFIED
+ ORG '630
+AF PZE 0 ADDRESS FIELD
+GF EQU AF
+AT PZE 0 ADDRESS TYPE
+CODE PZE 0 OUTPUT CODE
+D0 PZE 0 DIMENSIONS
+D1 PZE 0
+D2 PZE 0
+D3 PZE 0
+D4 PZE 0
+DF PZE 0 DATA FLAG
+NF PZE 0
+B PZE 0
+DFL PZE 0 DELIMITER FLAG
+E OCT 0 EQUIVALENCE INDEX
+EP PZE 0 E-PRIME
+E0 PZE 0 E-ZERO
+FTOP PZE 0 OUTPUT COMMAND
+GFA PZE 0
+ICSW PZE 1 INPUT CONTROL SWITCH
+IFLG PZE 0 I-FLAG
+IM PZE 0 ITEM MODE
+IOF PZE 0 I-0 FLAG
+IU PZE 0 ITEM USAGE
+KBAR PZE 0 TEM STORE
+KPRM PZE 0 TEM STORE
+EBAR OCT -1 E-BAR
+DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT)
+CC PZE '111 CARD COLUMN COUNTER
+DCT PZE 0 DUMMY ARGUMENT COUNT
+F PZE 0 TRIAD TABLE INDEX
+CL PZE 0 ASSIGNMENT ITEMS UNPACKED
+DT PZE 0
+FLT1 PZE 0 FETCH LINK CL POINTER LOCATION
+LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET)
+*..........CONSTANTS USED BY THE COMPILER
+K4 OCT 251 0)
+K5 OCT 254 0,
+K8 OCT 240 0-SPACE
+K9 OCT 257 0/
+K10 OCT 256 0.
+K12 OCT 255 0-
+K13 OCT 253 0+
+K15 OCT 244 0$
+K16X OCT 16
+K17 OCT 250 0(
+K18 OCT 275 0=
+K19 BCI 1,DO DO
+K34 OCT 324 0T
+K35 OCT 317 0O
+K40 BCI 1,WN
+K41 BCI 1,RN RN
+K42 BCI 1,CB
+K43 OCT 311 0I
+K44 OCT 321 0Q
+K45 EQU K34 0T
+K57 OCT 252 0*
+K60 OCT 260 00 (BCI ZERO)
+K61 OCT 271 09
+K68 EQU K19
+K101 OCT 1
+K102 OCT 2
+K103 OCT 3
+K104 OCT 4
+K105 OCT 5
+K106 OCT 6
+K107 OCT 7
+K109 DEC 16
+K100 OCT 377
+K111 OCT 37777
+K110 DEC -17
+K115 OCT 170777
+K116 OCT 177400
+K117 DEC -27
+K118 OCT 777
+K119 OCT 177000
+K120 DEC -15
+K122 OCT 040000
+K123 DEC -1
+K124 DEC 9
+K125 DEC 8
+K126 DEC 10
+K127 DEC 11
+K128 DEC 12
+K129 DEC 13
+K131 DEC -14
+K132 OCT 22
+K134 OCT 17
+K137 OCT 24002
+K138 OCT 25
+K139 OCT 24
+CRET OCT 215 0 C/R
+ZERO OCT 0
+HBIT OCT 140000 HIGH BITS FOR ALPHA DATA
+KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT
+MIN2 DEC -2 -2
+HC2 OCT 340
+K357 OCT 357
+*
+*
+DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET
+* BY THE FORTRAN IOS SUBROUTINE.)
+L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS)
+* THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER
+* TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS
+* 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL
+* CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL
+* LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER
+* CONFIGURATION.
+ ORG '1000
+ PZE DP-4,1 (100)
+ PZE DP-3,1 (101) DATA POOL REFERENCES
+ PZE DP-2,1 (102)
+ PZE DP-1,1 (103)
+ PZE DP,1 (104)
+ PZE DP+1,1 (105)
+ PZE DP+2,1 (106)
+ PZE DP+3,1 (107)
+ PZE DP+4,1 (108)
+ PZE DP+9,1 (111)
+ PZE DP+6,1 (112)
+ PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS
+*
+*
+ ORG 1
+ JST ER00 THIS INSTRUCTION REACHED ONLY IF THE
+ BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE.
+*
+*
+*
+*
+* *******************
+* *START OF COMPILER*
+* *******************
+*
+ ORG '1000
+*
+*
+*
+* - A0 COMP ENT EMPTY BUFFERS
+ LRL 15
+ STA LIBF SET SPECIAL LIBRARY FLAG
+ LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS)
+A0 CALL F4$INT INITIALIZE I/O DEVICES
+ LDA K108
+ STA CC CC = 73
+ JST IC00 INPUT COLUMN
+A051 LDA A090
+ STA XR
+ LDA A092 LOC, OF INDEX PUSH-DOWN BUFFER
+ STA SAV9 INITIALIZE PUSH-DOWN BUFR,
+ CRA
+ STA A+M,1 SET M VARIABLES TO ZERO
+ STA NAMF+M,1
+ IRS XR
+ JMP *-3
+ STA IFLG
+ STA PKF
+ JST FS00 INITIALIZE OUTPUT BUFFER
+ CMA
+ STA LSTF LSTF NOT EQ 0
+ STA LSTP LSTP NOT EQ 0
+ STA EBAR EBAR SET NEGATIVE
+ LDA L0
+ STA ICSW
+ STA E0 INITIALIZE EQUIVALENCE TABLE
+ STA L INITIALIZE TRIAD TABLE POINTER
+ JST PRSP SET PRINT BUFFER TO SPACES
+ LDA K134
+ STA DO INITIALIZE DO TABLE POINTER
+ SUB K138
+ STA A091
+ CRA
+ STA ID
+A055 IRS ID ESTABLISH CONSTANTS
+ JST AI00
+ IRS A091
+ JMP A055
+ LDA K81
+ STA ID
+ STA ID+1
+ STA ID+2
+ CRA
+ LRL 32 (B)=0 IM=NO USAGE
+ LDA K101 (A)=1 IU=SUBR
+ JST AA00 ASSIGN (SPECIAL)
+ JST STXA SET POINTER A INTO INDEX AND (A)
+ STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK)
+ ADD K122 ='40000 (IU=SUBR)
+ STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFI
+ JMP C7 GO TO STMNT INPUT
+M EQU 30
+A090 DAC* -M,1
+A091 PZE 0
+A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER
+*
+*
+*
+* **************
+* *INPUT COLUMN*
+* **************
+*
+* INPUT NEXT CHARACTER
+* IGNORE BLANKS
+* CHECK FOR COMMENTS
+* IC02 SET AS FOLLOWS -
+* NORMAL - ICIP
+* INITIAL SCAN -ICSR
+IC00 DAC ** LINK STORE
+ JST SAV SAVE INDEX
+ LDA CC IF CC = 73, GO TO IC 10
+ SUB K108
+ SZE
+ JMP IC19 ELSE, GO TO IC
+IC10 LDA ICSW IF ICSW. GO TO IC12
+ SNZ
+ JMP IC24 ELSE, GO TO IC24
+IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE
+ DAC CI
+ LDA CI
+ LGR 8 GO 70 IC 14
+ CAS K16 =(C)
+ JMP *+2
+ JMP IC30 COMMENT CARD (IGNORE)
+ SUB K15 =($)
+ SNZ
+ JMP IC18 CONTROL CARD (IGNORE COLUMN 6)
+ LDA K357 IF CARD COL, SIX IS
+ ANA CI+2 ZERO OR BLANK, GO TO IC18
+ SUB K8
+ SZE
+ JMP IC26 ELSE, GO TO IC26
+IC18 STA CC CC = 0.
+ LDA CI+2 CI(6) = SPECIAL
+ ANA K116
+ ADD HC2 ='340
+ STA CI+2
+ LDA CRET
+ JMP IC20 TC = C.R.
+IC19 LDA CC TC = CI(CC)
+ SUB K101
+ LGR 1
+ STA XR
+ LDA CI,1
+ SSC
+ LGR 8
+ ANA K100
+IC20 STA TC
+ IRS CC CC = CC+1
+IC22 JST RST RESTORE INDEX
+ JMP* IC00 RETURN
+IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN
+ STA TC
+ JMP IC22 GO TO IC22
+IC26 JST LIST LIST, CONTINUATION CARD
+ LDA K107 CC = 7. IGNORE STATEMENT NO.
+ STA CC
+ JMP IC19 G0 TO IC19
+IC30 JST LIST PRINT CARD IMAGE
+ JMP IC12 READ IN NEW CARD
+K16 OCT 303 0C
+K108 DEC 73
+KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER
+CI BSS 40
+ BCI 20,
+*
+*
+*
+* ****************
+* *UNINPUT COLUMN*
+* ****************
+* BACK UP ONE COLUMN
+*
+UC00 DAC **
+ IMA CC CC= CC-1
+ SUB K101 RETAIN (A)
+ IMA CC
+ JMP* UC00
+*
+*
+* *****************
+* *INPUT CHARACTER*
+* *****************
+* INPUT ONE CHARACTER FROM EITHER
+* 1, INPUT BUFFER (EBAR POSITIVE) OR
+* 2, EQUIVALENCE BUFFER (EBAR NEGATIVE)
+*
+CH00 DAC **
+ LDA EBAR IF EBAR 7 0,
+ SMI
+ JMP CH10 G0 10 CH10
+CH03 JST IC00 INPUT COLUMN
+ SUB K8 IF BLANK, REPEAT
+ SNZ
+ JMP CH03
+ LDA TC ELSE,
+*
+CH04 CAS CH13 ='301
+ NOP
+ JMP CH06
+ CAS K61 ='271
+ JMP CH05
+ NOP
+ CAS K15 ='244
+ JMP *+2
+ JMP CH05-1
+ CAS K60 ='260
+ NOP
+ CRA ALPHA NUMERIC CHARACTER
+CH05 STA DFL DELIMITER ENTRY
+ LDA TC EXIT WITH TC IN A
+ JMP* CH00
+CH06 CAS K63 ='332
+ JMP CH05
+ NOP
+ JMP CH05-1
+CH08 STA DFL
+ JMP* CH00
+CH10 LDA E IF E = EBAR
+ CAS EBAR
+ JMP *+2
+ JMP CH12 GO TO CH12
+ STA 0 SET E INTO INDEX
+ LLL 16 SET (B) TO ZERO
+ LDA DP,1 CURRENT CHARACTER WORD
+ LLR 8
+ STA DP,1 SAVE REMAINING CHARACTER IF ANY
+ IAB
+ STA TC TC=LEFTMOST CHARACTER
+ SZE SKIP IF NEW CHARACTER WORD NEEDED
+ JMP CH04
+ LDA E E=E-1
+ SUB K101 =1
+ STA E
+ JMP CH10 PICK UP NEXT CHARACTER WORD
+CH12 SSM MAKE E MINUS
+ STA EBAR
+ JMP C4 GO TO ASSIGN SPEC
+K63 OCT 332 0Z
+CH13 OCT 301
+*
+*
+* *************
+* *INPUT DIGIT*
+* *************
+* A IS ZERO IF NOT DIGIT
+*
+ID00 DAC ** INPUT DIGIT
+ JST CH00 INPUT A CHAR
+ CAS K61 ='271 (9)
+ JMP* ID00 (A) = TC
+ JMP ID10 ELSE, (A) = 0
+ CAS K60 RETURN
+ NOP
+ JMP *+2
+ JMP* ID00
+ID10 CRA
+ JMP* ID00
+*
+*
+* **********************
+* *INPUT (A) CHARACTERS*
+* **********************
+* CHAR COUNT IN XR, TERMINATES WITH EITHER
+* 1, CHAR COUNT -1 = ZERO OR
+* 2, LAST CHAR IS A DELIMITER
+*
+IA00 DAC **
+ TCA SET COUNTER
+ STA IA99
+ JST IA50 EXCHANGE IBUF AND ID
+ CRA
+ STA NTID NTID = 0
+IA10 JST CH00 INPUT A CHARACTER
+ JST PACK
+ LDA DFL IF DFL NOT ZERO,
+ SZE CONTINUE
+ JMP IA20 ELSE,
+ IRS IA99 TEST COUNTER
+ JMP IA10 MORE CHARACTERS TO INPUT
+IA20 JST IA50 EXCHANGE ID AND IBUF
+ JMP* IA00 RETURN
+IA50 DAC ** EXCHANGE IBUF AND ID
+ JST SAV SAVE INDEX
+ LDA IA90
+ STA XR
+ LDA IBUF+3,1
+ IMA ID+3,1
+ STA IBUF+3,1
+ IRS XR
+ JMP *-4
+ JST RST RESTORE INDEX
+ LDA NTID
+ JMP* IA50
+IA90 OCT -3
+IA99 PZE 0
+*
+*
+* *****************
+* *FINISH OPERATOR*
+* *****************
+* WRAP UP LOGICAL/RELATIONAL OPERATORS
+*
+FN00 DAC **
+ LDA DFL IF DFL NOT . ,
+ STA IBUF
+ SUB K10
+ SZE
+ JMP FN05 GO TO FN05
+ LDA K104
+ JST IA00
+FN05 LDA K110 USE TABLE TO CONVERT
+ STA XR OPERATOR
+FN10 LDA FN90+17,1
+ CAS IBUF
+ JMP *+2
+ JMP FN20
+ IRS XR
+ JMP FN10
+ LDA TC
+ JMP* FN00
+FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR
+ STA TC SET INTO TC
+ JMP* FN00
+FN90 OCT 253,255,252,257 +-*/
+ BCI 9,NOANORLTLEEQGEGTNE
+ OCT 275,254 =,
+FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17
+*
+*
+* ***********
+* *INPUT DNA*
+* ***********
+* BASIC INPUT ROUTINE, HANDLES FOLLOWING -
+* CONSTANT CONVERSION
+* MODE TYPING (CONSTANTS, IMPLIED/VARIABLES)
+* ALL OPERATORS (TERMINATE ITEM)
+*
+ID BSS 4
+TID EQU ID TEMP STORE FOR ID
+IBUF BSS 3 3-WORD BUF
+TIDN PZE 0
+K155 OCT 177727 -41
+K156 OCT 024000 1085
+K157 OCT 007777
+K158 OCT 074000
+F1 PZE 0 SIGN FLAG
+F2 PZE 0
+F3 PZE 0 INPUT EXPONENT
+F4 PZE 0 NO, FRAC. POSITIONS
+F5 PZE 0 TEMP DELIMITER STORE
+F6 PZE 0
+L4 PZE 0
+HOLF PZE 0 HOLLERITH FLAG
+DN00 DAC **
+DN01 CRA
+ STA HOLF SET HOLF =0
+ STA F4 F4 = 0
+ STA IU
+ STA NT IU=NT=NTID=0
+ STA NTID
+ JST BLNK CLEAR OUT TID = ID
+ DAC TID
+ JST BLNK
+ DAC F1 F1,F2,F3 = 0
+DN06 CRA
+ STA IM
+ STA DNX2
+DN07 JST ID00 INPUT DIGIT
+ SZE
+ JMP DN14 (A) NON-ZERO, G0 T0 DN14
+DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST
+ ANA K158 POSITION COUNT IF NECESSARY,
+ SZE
+ JMP SKIP
+ ADD IM
+ ARS 1
+ ADD F4 F4 = F4+1 IF NO OVERFLOW
+ STA F4 AND IM ALREADY SET TO REAL
+ LDA K101
+ STA NT NT=1
+ ADD K101
+ STA IU IU = VAR/COD
+ JST SFT SHIFT ID LEFT
+ DAC ID
+ JST MOV3 MOVE TO TEMP STORE
+ JST SFT
+ DAC ID
+ JST SFT
+ DAC ID
+ JST AD3 ID = 10*ID+TC
+ JST BLNK
+ DAC DNX1
+ LDA TC
+ SUB K60
+ STA DNX1
+ JST AD3
+ JMP DN07
+SKIP LDA MIN2
+ ADD IM
+ ARS 1
+ ADD F4
+ STA F4
+ JMP DN07
+DN14 LDA IM IM = REAL
+ SUB K102
+ SZE
+ JMP DN50 NO, GO TO DN50
+DN16 LDA K10 YES,
+DN17 STA F5 F5 = '.'
+ LDA DFL IF DFL =0, GO SO DN20 (5)
+ SZE
+ JMP DN90 ELSE GO TO DN90 (9)
+DN20 LDA TC IF TC = D, GO TO DN26
+ SUB K11
+ SNZ
+ JMP DN26
+ SUB K101 ELSE, IF TC = E, GO TO DN22
+ SNZ
+ JMP DN22 TERMINATOR = E
+ JST UC00
+ LDA K10 ='256 (,)
+ STA DFL SET DELIMITER FLAG
+ LDA K101 =1
+ STA IM SET ITEM MODE TO INTEGER
+ JMP DN67 FINISH OPERATOR AND EXIT
+*
+DN22 JST ID00 INPUT DIGIT
+ SNZ IF (A) = 0, GO TO DN30
+ JMP DN30
+ LDA TC IF TC = -, GO TO DN28
+ SUB K12
+ SNZ
+ JMP DN28
+ ADD K102
+ SNZ
+ JMP DN29
+ LDA F5
+ STA DFL
+ JST UC00 UN-INPUT COL
+DN24 JST FN00 FINISH OPERATOR
+DN25 LDA K101 IM = INT
+ STA IM
+ LDA ID+1 IF ID IS TOO BIG TO
+ SZE BE AN INTEGER (>L2),
+ JMP DN69 GO TO DN69 (20)
+ LDA ID+2
+ SZE
+ JMP DN69
+ JMP DN84 OTHERWISE, GO TO DN84(12)
+DN26 LDA K106 IM = DBL
+ STA IM
+ JMP DN22
+DN28 LDA K101 F2 = 1
+ STA F2
+DN29 JST ID00 INPUT DIGIT
+ SZE IF (A) = 0, GO TO DN30 (8.5)
+ JMP DN69 ELSE, GO TO DN69 (20)
+DN30 LDA F3 F3 = 10 * F3
+ ALS 3
+ IMA F3 F3 = F3 +TC
+ ALS 1
+ ADD F3
+ ADD TC INPUT DIGIT
+ SUB K60
+ STA F3 IF (A) = 0, GO TO DN30 (8.5)
+ JST ID00 ELSE, GO TO DN90 (9)
+ SZE
+ JMP DN90
+ JMP DN30
+DN50 LDA K102 IM=REA
+ STA IM
+ LDA TC IF TC = ., GO TO DN54
+ SUB K10
+ SNZ
+ JMP DN54 ELSE,
+ LDA NT
+ SNZ IF NT = 0, GO TO DN72
+ JMP DN72
+ LDA TC IF TC = H, GO TO DN9H (22)
+ SUB K14
+ SNZ
+ JMP DN9H
+ LDA DFL IF DFL = 0,
+ SZE GO TO DN16 (4.9)
+ JMP DN25 ELSE, GO TO DN25
+ JMP DN16
+DN54 JST ID00 INPUT DIGIT
+ SNZ
+ JMP DN10 IF (A) = 0, GO TO DN10 (3)
+ LDA NT
+ SNZ IF NT = 0, GO TO DN56
+ JMP DN56
+ LDA TC F5 = TC
+ JMP DN16 GO TO DN16 (4)
+DN56 CRA
+ STA TC TC = )
+DN58 JST UC00 UN-INPUT A COLUMN,
+ LDA F1 IF F1 = 0, GO TO DN60
+ SZE
+ JMP DN63 ELSE, GO TO DN63 (15)
+DN60 LDA K106
+ JST IA00 INPUT (6) CHARS
+ JST CIB IF IBUF = TRUE.,
+ DAC K1+3,1
+ JMP DN64
+ JST CIB IF IBUF = FALSE.,
+ DAC K2+3,1 GO TO DN66 (16)
+ JMP DN66
+ JST CIB CHECK FOR .NOT. OPERATOR
+ DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR
+ JMP DN9N OPERATOR IS .NOT.
+DN63 CRA IM = 0
+ STA IM
+ JMP DN67 GO TO DN67 (18)
+DN64 LDA K101
+ STA TID
+DN66 LDA K101
+ STA NT NAME TAG = 1 (CONSTANT)
+ LDA K102 IU=VAR
+ STA IU
+ LDA K103
+ STA IM IM = LOG
+ JST CH00
+DN67 JST FN00 FINISH OPERATOR
+DN68 LDA F6 IF F6 = 0,
+ SNZ GO TO DN70 (21)
+ JMP DN70
+DN69 LDA K10
+ STA TC TC = .
+DN70 CRA
+ STA F6 F6 = SXF = 0
+ STA SXF
+ LDA IM (A) = IM
+ JMP* DN00 RETURN
+DN72 LDA F1 IF F1 = 0, GO TO DN74
+ SNZ
+ JMP DN74
+ LDA F1 ELSE, TC = F1
+ STA TC
+ JMP DN58 GO TO DN58 (14)
+DN74 LDA TC IF TC = -, GO TO DN82
+ SUB K12
+ SNZ
+ JMP DN82
+ ADD K102 CHECK FOR TC = +
+ SNZ
+ JMP DN82
+ LDA DFL IF DFL = NON-ZERO
+ SZE
+ JMP DN63 GO TO DN63 (15)
+ LDA TC
+ CAS K43
+ JMP *+3
+ JMP DN78
+ JMP DN80
+ CAS K62
+ JMP DN80
+ NOP
+DN78 LDA K101 IM < INT
+ STA IM
+DN80 LDA TC PACK TC TO ID
+ JST PACK
+ JST CH00 INPUT CHAR
+ LDA DFL IF DFL IS NOT ZERO,
+ SZE GO TO DN67 (18)
+ JMP DN67
+ LDA NTID IF NTID = 6, GO TO DN67
+ SUB K106
+ SZE
+ JMP DN80
+ JMP DN67
+DN82 JST FN00
+ STA F1 F1 = CONVERTED TC
+ JMP DN06 GO TO DN06 (2)
+DN84 LDA F1 IF F1 = -,
+ SUB K102 GO TO DN85(13)
+ SZE
+ JMP DN85
+ CRA
+ SUB TID COMPLEMENT THREE WORDS AT TID
+ SZE
+ JMP DN8A
+ SUB TID+1
+ SZE
+ JMP DN8B
+ JMP DN8C
+DN8A STA TID
+ LDA K123
+ SUB TID+1
+DN8B STA TID+1
+ LDA K123
+DN8C SUB TID+2
+ STA TID+2
+DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18)
+ SNZ
+ JMP DN67 ELSE,
+ LDA IM IF IM NOT = REA,
+ SUB K102
+ SZE GO TO DN67 (18)
+ JMP DN67
+ LDA F6 ELSE,
+ SNZ IF F6 = 0, GO TO DN87
+ JMP DN87
+ LDA K105
+ STA IM IM = CPX
+ LDA TID INTERCHANGE
+ IMA TIDB 3 CELLS
+ STA TID TID
+ LDA TID+1 WITH
+ IMA TIDB+1 3 CELLS
+ STA TID+1 OF
+ LDA TID+2 TIDB
+ IMA TIDB+2
+ STA TID+2
+ JST IP00 )-INPUT OPERATOR
+ JMP DN70 GO TO DN70 (21)
+DN87 LDA TC IF TC = ,
+ SUB K5
+ SZE
+ JMP DN67 TID-BAR = TID
+ LDA TID F6 = 1
+ STA TIDB GO TO DN01 (1)
+ LDA TID+1
+ STA TIDB+1 ELSE, GO TO DN67 (18)
+ LDA TID+2
+ STA TIDB+2
+ LDA K101
+ STA F6
+ JMP DN01
+DN90 LDA F2 IF F2= 0, GO TO DN9A (10)
+ SNZ
+ JMP DN9A
+ LDA F3 F3 = - F3
+ TCA
+ STA F3
+DN9A LDA F3 F4 = F3 - F4
+ SUB F4
+ STA F4
+ LDA K12 F2 = EXP, BIAS + MANTISSA
+ STA F2
+ LDA TID IF TID = 0,
+ ADD TID+1
+ ADD TID+2 GO TO DN85(13)
+ SNZ
+ JMP DN85
+DN9C LDA TID+2
+ LGL 1 NORMALIZE ID
+ SPL
+ JMP DN9D ID IS NORMALIZED
+ JST SFT
+ DAC ID
+* F2 = F2 - = SHIFTS
+ LDA F2
+ SUB K101
+ STA F2
+ JMP DN9C CONTINUE NORMALIZE LOOP
+DN9D LDA F4
+ CAS ZERO
+ JMP DN9E
+ JMP DN9G FINISHED E FACTOR LOOP
+ IRS F4
+ NOP F4 = F4 +1
+ LDA K155 DIVIDE LOOP COUNTER
+ STA TIDN
+ JST SRT
+ DAC TID
+ JST SRT
+ DAC TID
+DND1 JST SFT
+ DAC TID
+ LDA TID+2
+ SUB K156 10 AT B=4
+ SMI
+ STA TID+2
+ SMI
+ IRS TID
+ IRS TIDN
+ JMP DND1 REDUCE DIVIDE COUNTER
+ JST SFT
+ DAC TID
+ LDA TID+2
+ ANA K157
+ STA TID+2
+ JMP DN9C
+DN9E SUB K101
+ STA F4 F4 = F4-1
+ LDA F2 F2 = F2+4
+ ADD K104
+ STA F2
+ JST SRT
+ DAC ID
+ JST MOV3
+ JST SRT ID = ID*10
+ DAC ID
+ JST SRT
+ DAC ID
+ JST AD3 ADD THREE WORD INTEGERS
+ JMP DN9C
+* CONVERT THREE WORD INTEGER TO INTERNAL FORMAT
+DN9G LDA TID+2
+ IAB
+ LDA F2
+ LRS 8
+ SNZ
+ JMP *+3
+ JST ER00
+ BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW)
+ IAB
+ IMA TID+2
+ IAB
+ LDA TID+1
+ LGL 1
+ LRR 8
+ STA TID+1
+ LRR 9
+ LDA TID PACK UP TRIPLE PRECISION
+ LGL 1
+ LRR 7 REAL CONSTANT
+ STA TID
+ LDA F2
+ LGR 8
+ SZE
+ JMP DN69 GO TO DN69 (20)
+ JMP DN84 ELSE. GO TO DN84 (12)
+DN9H STA IM
+ LDA SPF
+ SUB K102
+ SZE
+ LDA K106
+ SUB K124
+ ADD TID
+ SMI
+ JMP DN70
+ LDA TID
+ STA HOLF HOLF=NO.OF HOLLERITH CHARS,
+ STA F3
+ TCA
+ SNZ
+ JMP DN9K FIELD WIDTH OF ZERO
+ STA F2 F2= -1(1 CHAR) OR -2(2 CHAR)
+ JST BLNK SET ID,ID+1(ID+2 TO ZERO
+ DAC TID
+DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS)
+ JST PACK PACK CHARACTERS 2 PER WORD
+ IRS F2 REDUCE CHARACTER COUNT
+ JMP DN9J INPUT AND PACK MORE CHARACTERS
+ LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT
+ ANA K101
+ SNZ
+ JMP *+3
+ LDA K8 ='240 (SP)
+ JST PACK SHIFT A SPACE INTO THE LAST WORD
+ IRS IM
+DN9M JST CH00 INPUT THE TERMINATING CHARACTER
+ JMP DN67 FINISH OPERATOR AND EXIT
+DN9K JST ER00
+ BCI 1,HF
+DN9N LDA K105 SET .NOT. OPERATOR (TC=5)
+ STA TC SET .NOT. OPERATOR (TC=5)
+ CRA
+ STA IM IM=0 = UNDEFINED
+ JMP DN68
+DNX1 BSS 3
+DNX2 DAC ** OVERFLOW FLAG
+ JMP* *-1
+*
+*
+* ************
+* *INPUT ITEM*
+* ************
+* INPUTS AND ASSIGNS ITEM (IF ONE EXISTS)
+*
+II00 DAC **
+ JST DN00 INPUT DNA
+ SNZ IF (A) = 0
+ JMP* II00 RETURN
+ JST AS00 NO, ASSIGN ITEM
+ LDA IM
+ JMP* II00 RETURN (A) = IM
+*
+*
+* ***************
+* *INPUT OPERAND*
+* ***************
+* EXIT WITH ITEM MODE IN A (TC SET TO . IF NO
+* OPERAND)
+*
+OP00 DAC ** INPUT OPERAND
+ JST II00 INPUT ITEM
+ SZE IF IM = 0, SKIP
+ JMP* OP00 ELSE (A) = IM, RETURN
+ LDA K10 TC = .
+ STA TC (A) = 0
+ CRA
+ JMP* OP00 RETURN
+*
+*
+* ************
+* *INPUT NAME*
+* ************
+* INPUT OPERAND AND ENSURE THAT IT IS A NAME
+*
+NA00 DAC ** INPUT NAME
+ JST OP00 INPUT OPERAND
+ LDA NT IF NT = 1,
+ SNZ
+ JMP NA10
+ JST ER00
+ PZE 9
+NA10 LDA IM (A) = IM
+ JMP* NA00 RETURN
+*
+*
+* ***************
+* *INPUT INTEGER*
+* ***************
+* INPUT ITEM AND ENSURE THAT IT IS AN INTEGER CONSTANT
+* GREATER THAN ZERO
+*
+IG00 DAC ** INPUT INTEGER
+ JST DN00 INPUT - DNA
+ LDA F1
+ SZE IF F1 = 0,
+ JMP IG20 AND NT = 1,
+ LDA NT AND IM = INT,
+ SNZ AND TID L2**15,
+ JMP IG20 GO TO IG10
+ LDA IM LSE, GO TO IG20
+ SUB K101
+ SZE
+ JMP IG20
+ LDA TID+1
+ SZE
+ JMP IG20
+ LDA TID+2
+ SZE
+ JMP IG20
+IG10 LDA TID
+ JMP* IG00
+IG20 JST ER00 ERROR
+ BCI 1,IN INTEGER REQUIRED
+*
+*
+* ***********************
+* *INPUT INTEGER VAR/CON*
+* ***********************
+*
+IV00 DAC **
+ JST OP00 INPUT OPERAND
+ JST IT00 INTER TEST
+ JST TV00 TAG VARIABLE
+ JMP* IV00 EXIT
+*
+*
+* ************************
+* *INPUT INTEGER VARIABLE*
+* ************************
+*
+IR00 DAC ** INPUT INT VAR
+ JST IV00 INPUT INT VAR/CON
+ JST NC00 NON-CONSTANT TEST
+ JMP* IR00 RETURN
+*
+*
+* ************************
+* *INPUT STATEMENT NUMBER*
+* ************************
+* NUMBER IS FORMED AS SPECIAL NAME , NOT CONVERTED
+* TO NUMERIC
+*
+IS00 DAC **
+IS04 CRA
+ STA NT
+ STA IM
+ STA IU IU = IM = IT = 0
+ STA NTID PUT LEADING 'S' IN STATEMENT NO,
+ LDA K79
+ JST PACK
+IS10 JST ID00 INPUT DIGIT
+ SZE
+ JMP IS20 NOT A DIGIT GO TO IS20
+ LDA NTID
+ SUB K106
+ SMI
+ JMP IS22
+ LDA TC
+ JST PACK PACK TC TO ID - LEGAL ST, NO, CHAR
+ LDA TID
+ CAS K79X
+ JMP IS10
+ JMP IS04 IGNORE LEAD ZERO ON ST. NO,
+ JMP IS10
+IS20 LDA NTID
+ SUB K101
+ SMI
+ JMP IS25
+IS22 JST ER00
+ BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT
+IS25 JST AS00 ASSIGN ITEM
+ JST STXA
+ LDA DP+1,1
+ ANA K111
+ STA DP+1,1 IU = 0
+ LDA AF ADDRESS FIELD IS
+ CAS XST LE XST - ALREADY ASSIGNED
+ JMP* IS00
+ JMP* IS00 OK - OTHERWISE
+ LDA AT MUST HAVE STR-ABS OTHERWISE
+ CAS K102
+ JMP *+2
+ JMP* IS00 !!!
+ JST ER00
+ BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER
+K79 OCT 337
+K79X OCT 157660
+*
+SY00 DAC ** INPUT SYMBOL
+ LDA K101
+ STA NTF NTF NOT 0 - DON'T SET IU IN AS00
+ JST NA00 INPUT NAME
+ JMP* SY00 EXIT
+*
+* ************************
+* *EXAMINE NEXT CHARACTER*
+* ************************
+* CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT)
+*
+XN00 DAC **
+ JST ID00 INPUT DIGIT
+ JST UC00 UNINPUT COLUMM
+ JMP* XN00
+K1 BCI 3,TRUE.
+K2 BCI 3,FALSE.
+K3 OCT 247
+KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST
+K11 OCT 304 0D
+K14 OCT 310 0H
+K62 OCT 316 0N
+K64 OCT 336 0)
+*
+*
+* ********************
+* *ALL CHARACTER TEST*
+* ********************
+*
+TS00 DAC ** TEST (A) AGAINST TC
+ SUB TC
+ SNZ
+ JMP* TS00 RETURN
+ JST ER00 TO ERROR TEST
+ BCI 1,CH IMPROPER TERMINATING CHARACTER
+*
+*
+* *******************
+* *)- INPUT OPERATOR*
+* *******************
+*
+IP00 DAC **
+ LDA K4 TEST - )
+ JST TS00
+ JST CH00 INPUT CHAR
+ JST FN00 FINISH OPERATOR
+ LDA B B = B-16
+ SUB K109
+ STA B
+ CRA (A) = 0
+ JMP* IP00 RETURN
+*
+*
+*
+* B1 COMMA OR C/R TST
+B1 LDA K134 IF TC = ','(CONVERTED TO 17)
+ SUB TC
+ SNZ
+ JMP* A9T2 GO TO SIDSW
+ JMP A1 ELSE, GO TO C/R TEST
+*
+*
+NR00 DAC ** NON-REL TEST
+ LDA AT
+ SUB K101 IF AT = 1 GO TO ERROR-
+ SZE TEST
+ JMP* NR00 RETURN
+ JST ER00 ERROR TEST ROUTINE
+ BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER
+*
+*
+* ***************
+* *NO USAGE TEST*
+* ***************
+*
+NU00 DAC ** N0 USAGE TEST
+ LDA IU
+ SNZ IF IU NOT = 0, TO ERROR
+ JMP* NU00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,NU NAME ALREADY BEING USED
+*
+*
+* *******************
+* *NON-CONSTANT TEST*
+* *******************
+*
+NC00 DAC ** NON CONSTANT TEST
+ LDA NT
+ SNZ IF NT NOT = 0, TO ERROR TEST
+ JMP* NC00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,NC CONSTANT MUST BE PRESENT
+*
+*
+* *********************
+* *NON SUBPROGRAM TEST*
+* *********************
+*
+NS00 DAC ** NON SUBPROGRAM TEST
+ LDA IU
+ SUB K101 IF IU = 1, GO TO-
+ SZE ERROR TEST
+ JMP* NS00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,NS SUBPROGRAM NAME NOT ALLOWED
+*
+*
+* **********
+* *ARR TEST*
+* **********
+*
+AT00 DAC ** ARRAY TEST
+ LDA IU
+ SUB K103 IF IU = 3, GO TO
+ SNZ
+ JMP* AT00 RETURN
+ JST ER00 ERROR TEST
+ BCI 1,AR ITEM NOT AN ARRAY NAME
+*
+*
+* **************
+* *INTEGER TEST*
+* **************
+*
+IT00 DAC ** INTEGER TEST
+ LDA IM
+ SUB K101 IF IM = 1, GO TO-
+ SNZ ERROR ROUTINE, ELSE
+ JMP* IT00 RETURN
+ JST ER00 TO ERROR TEST
+ BCI 1,IT ITEM NOT AN INTEGER
+*
+*
+TA00 DAC **
+ LDA AT STRING-ABS TEST
+ SUB K102
+ SNZ
+ JMP* TA00
+ JST ER00
+ BCI 1,NR ITEM NOT A RELATIVE VARIABLE
+*
+*
+*
+*
+*
+*
+*
+*
+AD3 DAC ** ADD TWO THREE WORD INTEGERS,
+ LDA TID
+ ADD DNX1
+ CSA
+ STA TID
+ LDA TID+1
+ ACA
+ ADD DNX1+1
+ CSA
+ STA TID+1
+ LDA TID+2
+ ACA
+ ADD DNX1+2
+ STA TID+2
+ JMP* AD3
+*
+*
+* ***********************
+* *ASSIGN INDEX REGISTER*
+* ***********************
+*
+STXA DAC **
+ LDA A
+ STA 0
+ JMP* STXA
+STXI DAC **
+ LDA I
+ STA 0
+ JMP* STXI
+K153 OCT 16
+IM00 DAC **
+ STA T1IM MULTIPLY A BY B
+ LDA K120 =-15
+ STA T2IM
+ CRA
+ RCB C BIT = 0
+IM10 LRL 1 LOW BIT OF B INTO C
+ SRC SKIP IF B = 0
+ ADD T1IM
+ IRS T2IM
+ JMP IM10
+ LLL 14
+ JMP* IM00 RETURN, RESULT IN A
+T1IM PZE 0
+T2IM PZE 0
+*
+*
+NF00 DAC ** CONSTRUCT EXTERNAL NAME
+ LDA K80 ENTRY FOR FORTRAN GENERATER
+ STA NAMF
+ LDA K81 SUBROUTINE CALLS,
+ STA NAMF+2
+ JMP* NF00
+K80 BCI 1,F$
+K81 BCI 1,
+KM92 DEC 1 001 = INT
+ DEC 2 010 = REA
+ DEC 1 011 = LOG
+ DEC 0 - -
+ DEC 4 101 = CPX
+ DEC 3 110 = DSL
+ OCT 3 111 = HOL
+*
+*
+BLNK DAC ** CLEAR A 3/36
+ JST SAV AREA TO ZEROS
+ LDA* BLNK
+ STA XR
+ CRA CLEAR 3 WORDS OF MEMORY
+ STA 1,1 PARAMETER INPUT ADDRESS TO 0
+ STA 2,1
+ STA 0,1
+ JST RST
+ IRS BLNK
+ JMP* BLNK EXIT
+*
+*
+MOV3 DAC ** MOVE 3-WORDS
+ LDA TID TO TEMO STORE
+ STA DNX1
+ LDA TID+1
+ STA DNX1+1
+ LDA TID+2
+ STA DNX1+2
+ JMP* MOV3
+*
+*
+*
+*
+CIB DAC ** COMPARE IBUF TO A CONSTANT
+ JST SAV SAVE INDEX
+ LDA* CIB +DDR OF CON+3,0
+ STA CIBZ
+ CRA
+ SUB K103 XR=-3
+ STA XR
+CIBB LDA IBUF+3,1
+ SUB* CIBZ
+ SZE
+ JMP CIBD
+ IRS XR
+ JMP CIBB
+CIBC IRS CIB
+ JST RST RESTORE INDEX
+ JMP* CIB
+CIBD IRS CIB
+ JMP CIBC
+CIBZ DAC **
+*
+*
+*
+*
+SAV DAC ** SAVE INDEX REGISTER
+ STA SAVY STACKED IN PUSH DOWN LIST
+ LDA XR
+ STA* SAV9
+ IRS SAV9
+ LDA SAVY
+ JMP* SAV
+RST DAC ** RESTORE INDEX REGISTER
+ STA SAVY
+ LDA SAV9 UNSTACK PUSH DOWN LIST
+ SUB K101
+ STA SAV9
+ LDA* SAV9
+ STA XR
+ LDA SAVY
+ JMP* RST
+SAVY PZE 0
+SAV9 DAC SAVX IS INITIATED BY A092
+SAVX BSS 20
+*
+*
+PACK DAC ** PLACE CHARACTER IN A
+ STA PAK7
+ LDA NTID INTO ID - UPDATE 3 WORDS OF
+PAK1 SNZ
+ JMP PAK4 ID
+ LRL 1
+ ADD PAK9
+ STA PAK8
+ LDA PAK7
+ IAB
+ SPL
+ JMP PAK3
+ LLL 24
+ ADD K8
+PAK2 STA* PAK8
+ IRS NTID
+ JMP* PACK
+PAK3 LLL 8
+ LDA* PAK8
+ LGR 8
+ LLL 8
+ JMP PAK2
+PAK4 LDA PAK6
+ STA TID
+ STA TID+1
+ STA TID+2
+ STA TID+3
+ LDA NTID
+ JMP PAK1+2
+PAK6 BCI 1,
+PAK7 DAC **
+PAK8 DAC **
+PAK9 DAC TID
+*
+*
+* ***************
+* *ERROR ROUTINE*
+* ***************
+*
+ER00 DAC ** ERROR ROUTINE
+ LDA SAV9
+ STA SAVX
+ LDA ER93 =-35
+ STA 0 SET INDEX
+ LDA ER91 (*)(*)
+ STA PRI+35,1 SET ** INTO PRINT BUFFER
+ IRS 0 SET COMPLETE PRINT BUFFER TO ********
+ JMP *-2
+ LDA CC
+ ARS 1 CC = CC/2
+ SUB K101 =1
+ SPL
+ CRA
+ STA XR
+ LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.)
+ SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT
+ JMP *+3
+ LDA KAEQ ='142721 (=(E)(Q) )
+ STA PRI+1,1
+ LDA* ER00
+ STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER
+ CALL F4$SYM PRINT THE BUFFER
+ DAC PRI
+ JST PRSP SET PRINT BUFFER TO SPACES
+ LDA TC
+ER20 CAS CRET INPUT CHARACTERS UNTIL C/R
+ JMP *+2
+ JMP C7 GO TO STATEMENT INPUT
+ JST CH00
+ JMP ER20
+ER91 BCI 1,**
+ER93 OCT 177735 -35
+*
+*
+SRT DAC **
+ JST SAV
+ LDA* SRT SHIFT RIGHT ONE PLACE
+ STA XR TRIPLE PRECISION
+ LDA 0,1
+ IAB
+ LDA 1,1
+ LRS 1
+ LGL 1
+ IAB
+ STA 0,1
+ LDA 2,1
+ LRS 1
+ STA 2,1
+ IAB
+ STA 1,1
+ JST RST
+ IRS SRT
+ JMP* SRT
+*
+*
+SFT DAC ** TRIPLE PRECISION
+ JST SAV SHIFT LEFT ONE PLACE
+ LDA* SFT
+ STA XR
+ LDA 0,1
+ IAB
+ LDA 1,1
+ LLS 1
+ CSA
+ STA 1,1
+ IAB
+ STA 0,1
+ ACA
+ LRS 1
+ LDA 2,1
+ LLS 1
+ CSA
+ STA 2,1
+ JST RST
+ IRS SFT
+ JMP* SFT
+*
+LIST DAC **
+ JST PRSP
+ SR2
+ JMP *+3
+ CALL F4$SYM PRINT BLANK LINE
+ DAC PRI
+ CALL F4$SYM PRINT SOURCE INPUT LINE
+ DAC CI
+ JMP* LIST
+* *************
+* *ASSIGN ITEM*
+* *************
+* CHECKS ASSIGNMENT AREA OF DATA POOL (A0 TO ABAR)
+* FOR ITEM DEFINED BY ID, IM, IU, ETC.
+* IF FOUND, EXIT WITH POINTER AND
+* ASSIGNMENTS DATA SET, OTHERWISE
+* ASSIGN THE ITEM.
+*
+*
+*
+T0AS PZE 0
+AS00 DAC **
+ CRA
+ STA A A = A (0)
+AS04 JST STXA
+ JST NXT GET NEXT ENTRY
+ JMP AS30 AT END, GO TO AS30
+ LDA NT
+ SUB NTA NT = NT(A)
+ SZE
+ JMP AS04 NO, G0 TO AS04
+ LDA TID
+ SUB TIDA
+ SZE
+ JMP AS04 TID = TID(A)
+ LDA TID+1
+ SUB TIDA+1
+ SZE
+ JMP AS04 NO, GO TO AS04
+ LDA TID+2
+ SUB TIDA+2
+ SZE
+ JMP AS04
+ LDA NT IF NT (A) .NE. 0,
+ SNZ GO TO AS10
+ JMP AS16 GO TO AS16 (4)
+AS10 LDA IM IF IM .NE. IM (A),
+ SUB IMA GO TO AS04 (1)
+ SZE
+ JMP AS04
+ LDA IU IF IU = 0,
+ SNZ OR NOT EQUAL IU (A)
+ JMP AS04 GO T0 AS04 (1)
+ SUB IUA
+ SZE
+ JMP AS04 ELSE,
+ LDA IM
+ SUB K105 GO TO AS16 (4)
+ SZE
+ JMP AS16
+ JST NXT ELSE, GET NEXT ENTRY
+ JMP AS30
+ LDA TIDA IF IU (A) = TIDB
+ SUB TIDB GO TO AS16 (4)
+ SZE ELSE, GO TO AS04 (1)
+ JMP AS04
+ LDA TIDA+1
+ SUB TIDB+1
+ SZE
+ JMP AS04
+ LDA TIDA+2
+ SUB TIDB+2
+ SZE
+ JMP AS04
+ LDA A
+ SUB K105
+ STA A
+AS16 LDA IUA IF IU (A) .NE. 0
+ ADD NTF
+ SZE
+ JMP AS18 GO TO AS18 (5)
+ LDA SPF IF SPF = 0, GO TO AS18 (5)
+ SNZ
+ JMP AS18
+ LDA TC IF TC = (
+ SUB K17
+ SZE
+ JMP AS19
+ JST TG00 TAG SUBPROGRAM
+AS18 CRA SET NTF TO 0
+ STA NTF SET NTF TO 0
+ JST FA00 GO TO FETCH ASSIGNS
+ JST STXA
+ LDA IM
+ JMP* AS00 RETURN
+AS19 JST TV00 TAG VARIABLE
+ JMP AS18
+AS30 JST BUD BUILD ASSIGNMENT ENTRY
+ LDA NT IF NT = 1
+ SZE
+ JMP AS32 OR IV = VAR,
+ LDA IU
+ SUB K102
+ SZE
+ JMP AS40 AMD
+AS32 LDA IM IF IM = CPX,
+ SUB K105
+ SZE
+ JMP AS40
+ STA IU MOVE 1ST PART OF
+ LDA TIDB COMPLEX ENTRY TO
+ STA TID TID AND BUILD
+ LDA TIDB+1 ASSIGNMENT ENTRY
+ STA TID+1
+ LDA TIDB+2
+ STA TID+2
+ LDA A
+ ADD K105
+ STA A
+ JST BUD
+ LDA A
+ SUB K105 RESTORE A
+ STA A
+AS40 LDA ABAR
+ SUB A TO = -(ABAR-A+5)
+ ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP
+ TCA
+ STA T0AS
+ TCA
+ ADD DO CO=DO+TO
+ STA DO
+ LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE
+ SNZ
+ JMP AS60 GO TO AS60
+ LDA I
+ SUB T0AS
+ STA I I = I - T0(T0 IS NEGATIVE)
+ AOA
+AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE
+ NOP
+ JMP AS50
+ ADD '104 =DP,1
+ STA AS91 AS91 = NEW TABLE TOP
+ ADD T0AS
+ STA AS92 AS92
+ SUB T0AS COMPUTE SIZE OF FLOATING TABLES
+ SUB '104 =DP,1
+ SUB DO
+ SNZ IF ZERO, ASSIGN TABLE ONLY,
+ JMP AS16
+ TCA
+ STA T0AS
+ CRA
+ STA XR
+AS46 LDA* AS92 END-5
+ STA* AS91 END (MOVE TABLES UP)
+ LDA 0
+ SUB K101 =1
+ STA 0 REDUCE INDEX
+ IRS T0AS = NO, OF WORDS TO MOVE
+ JMP AS46
+ JMP AS16
+AS50 JST ER00
+ BCI 1,MO DATA POOL OVERFLOW
+AS60 LDA DO
+ ADD D
+ JMP AS41
+AS91 DAC 0
+AS92 DAC **
+*
+*
+*
+*
+* ****************
+* *TAG SUBPROGRAM*
+* ****************
+* TAG ITEM AS A SUBPROGRAM, CHECK TO SEE IF
+* NAME IS IN IMPLICIT MODE TABLE AND SET
+* MODE ACCORDINGLY
+*
+TG00 DAC **
+ LDA IU
+ SUB K101 IF IU = SUB
+ SNZ
+ JMP* TG00 RETURN, ELSE
+ JST NU00 NO * USAGE TEST
+ LDA TG22 =-21
+ STA 0 SET INDEX
+TG04 LDA ID+1 CHARACTERS 3 AND 4
+ CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE
+ JMP *+2
+ JMP TG10
+TG06 IRS 0
+ JMP TG04 NOT DONE WITH TABLE
+TG08 LDA K101 =1 (IU=SUBR.)
+ STA IU
+ JST STXA
+ LDA DP+1,1 IU(A) = SUB
+ LGL 1
+ SSM
+ LGR 1
+ STA DP+1,1
+ JMP* TG00 RETURN
+*
+TG10 LDA ID CHARACTERS 1 AND 2
+ ANA K111 ='37777
+ ADD HBIT ='140000
+ SUB TGT1+21,1
+ SZE
+ JMP TG06 CONTINUE SEARCH
+ LDA ID+2 CHARACTERS 5 AND 6
+ SUB TGT3+21,1
+ SZE
+ JMP TG06 CONTINUE SEARCH
+ LDA TGT1+21,1
+ LGR 8
+ ANA K107 =7 (=3 IF CPX, 4 IF DBL)
+ ADD K102 =2 (=5 IF CPX, 6 IF DBL)
+ JST DM00 DEFINE IM
+ JMP TG08
+*
+TG22 OCT 177753 =-21
+*
+*...........IMPLICIT MODE SUBROUTINE NAME TABLE
+TGT1 BCI 6,DECEDLCLDLDS
+ BCI 6,CSDCCCDSCSDA
+ BCI 6,DADMDADMDMDS
+ BCI 3,DBCMCO
+TGT2 BCI 6,XPXPOGOGOGIN
+ BCI 6,INOSOSQRQRTA
+ BCI 6,TAODBSAXINIG
+ BCI 3,LEPLNJ
+TGT3 BCI 6, 10 /
+ BCI 6, T T N /
+ BCI 6,N2 1 1 N /
+ BCI 3, X G /
+*
+*
+TIDA BSS 3
+TIDB BSS 3
+*
+* - TV00 TAG VARIABLE
+TV00 DAC **
+ LDA IU IF IU = 'VAR',
+ SUB K102
+ SNZ
+ JMP* TV00 RETURN
+ JST NU00 ELSE, NO USAGE TEST
+ JST STXA
+ LDA DP+1,1
+ ANA K111 IU (A) = 'VAR'
+ SSM
+ STA DP+1,1
+ JMP* TV00 RETURN
+*
+*
+*
+*
+*
+* **************
+* *FETCH ASSIGN*
+* **************
+* SET ASSIGNMENT DATA FROM ASSIGN (EXCEPT ID)
+* EXPAND DIMENSION INFO IF ARRAY
+*
+FA00 DAC **
+ JST STXA
+ LDA DP,1
+ LRL 15
+ STA NT NT=NT(A)
+ CRA
+ LLL 3
+ STA AT AT=AT(A)
+ CRA
+ LLL 3 IM = IM(A)
+ STA IM
+ STA 0
+ LDA KM92-1,1
+ STA D0 D0 = NUMBER OF WORDS
+ ALS 2
+ ADD D0
+ STA X X = POINTER TO CONSTANT NUMBER OF WORDS
+ JST STXA
+ LDA DP+1,1
+ LRL 14
+ STA IU
+ SUB K103 IF IU NOT 'ARR'
+ SNZ
+ JMP FA10
+ CRA
+ LLL 14 AF = GF(A)
+ STA AF
+ JMP* FA00
+FA10 LLL 14
+ STA 0 INDEX = GF(A)
+ LDA DP+4,1
+ STA X1 POINTER OF DIMENSION 1
+ LDA DP+3,1
+ STA X2 POINTER OF DIMENSION 2
+ LDA DP+2,1
+ STA X3 POINTER OF DIMENSION 3
+ LDA DP+1,1
+ ANA K111 ='37777
+ STA AF AF = GF(GF(A))
+ LDA DP,1
+ LGR 9
+ ANA K107 =7
+ STA ND NUMBER OF DIMENSIONS
+ STA 0
+ LDA K101 =1
+ STA D2
+ STA D3
+ JMP* FA91-1,1
+FA22 LDA X3 FETCH 3RD DIMENSION SIZE
+ STA XR
+ JST FA40
+ STA D3 STORE D3
+FA24 LDA X2
+ STA XR
+ JST FA40
+ STA D2 D2 = 2ND DIMENSION SIZE
+FA26 LDA X1
+ STA XR
+ JST FA40
+ STA D1 D1 = 1ST DIMENSION SIZE
+ JST STXA EXIT WITH AF IN A
+ LDA AF
+ JMP* FA00
+FA40 DAC **
+ LDA DP,1 IM OF SUBSCRIPT VALUE
+ SSP
+ LGR 12
+ SUB K105 =5
+ SZE SKIP IF DUMMY SUBSCRIPT
+ LDA DP+4,1 FETCH VALUE OF SUBSCRIPT
+ JMP* FA40
+FA91 DAC FA26
+ DAC FA24
+ DAC FA22
+*
+*
+* ************
+* *FETCH LINK*
+* ************
+* EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE
+* LINKED ITEM
+*
+FL00 DAC **
+ JST STXA
+ LDA DP,1 A = 5 * CL(A)
+ ANA K118
+ STA FLT1
+ ALS 2
+ ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC)
+ STA A
+ JST FA00 FETCH ASSIGN
+ JST KT00 D0 = = WDS /ITEM
+ LDA A
+ SUB F (A) = A-F
+ JMP* FL00 RETURN
+*
+*
+* *******************
+* *D0=WORDS FOR LINK*
+* *******************
+* D = ITEM MODE SIZE TIMES THE TOTAL SIZE IF
+* THE ITEM IS AN ARRAY
+*
+KT00 DAC **
+ LDA IU IF IU NOT 'ARR'
+ SUB K103
+ SZE
+ JMP* KT00 RETURN
+ LDA D0
+ IAB D0 = D0 * D1 * D2 * D3
+ LDA D1
+ JST IM00 MULTIPLY A BY B
+ IAB
+ LDA D2
+ JST IM00 MULTIPLY A BY B
+ IAB
+ LDA D3
+ JST IM00 MULTIPLY A BY B
+ STA D0
+ JMP* KT00 RETURN
+*
+*
+*
+* ***********
+* *DEFINE IM*
+* ***********
+* IM SUBA = IM (SET FROM A REG)
+*
+DM00 DAC **
+ STA IM IM = (A)
+ JST STXA ESTABLISH A
+ LDA DP,1
+ LRL 9
+ LGR 3 IM(A) = IM
+ LGL 3
+ ADD IM
+ LLL 9
+ STA DP,1
+ JMP* DM00
+*
+*
+* ***********
+* *DEFINE AF*
+* ***********
+* AF SUBA = AF (SET FROM A REG)
+*
+DA00 DAC **
+ STA AF AF = (A)
+ LRL 14
+ JST STXA
+DA10 LDA DP+1,1 IF IU (A) NOT ARR
+ LGR 14
+ CAS K103 GF (A) : AF
+ JMP *+2
+ JMP DA20 ELSE, GF (GF (A)) = AF
+ LLL 14
+ STA DP+1,1
+ JMP* DA00 RETURN
+DA20 LDA DP+1,1
+ ANA K111
+ STA GFA
+ STA 0
+ JMP DA10
+NXT DAC ** GET NEXT ENTRY
+ LDA A FROM ASSIGNMENT
+ ADD K105 =5
+ STA A
+ STA 0
+ CAS ABAR
+ JMP* NXT
+ NOP
+ IRS NXT
+ LDA DP,1
+ LRL 15
+ STA NTA NT(A) = NT FROM (A)
+ CRA
+ LLL 3
+ STA ATA AT(A) = AT FROM (A)
+ CRA
+ LLL 3
+ STA IMA IM(A) = IM FROM (A)
+ CRA
+ LLL 9
+ STA CLA CL(A) = CL FROM (A)
+ LDA DP+1,1
+ LRL 14
+ STA IUA IU(A) = IU FROM (A)
+ CRA
+ LLL 14
+ STA GFA GF(A) = GF FROM (A)
+ LDA DP+2,1
+ STA TIDA+2 TID(A) = TID FROM (A)
+ LDA DP+3,1
+ STA TIDA+1
+ LDA DP+4,1
+ STA TIDA
+ LRL 15
+ STA DTA DT(A) = DT FROM (A)
+ CRA
+ LLL 1
+ STA TTA TT(A) = TT FROM (A)
+ LDA NTA NT(A) = NT FROM (A)
+ SZE
+ JMP* NXT
+ LDA DP+4,1
+ SSM
+ ALR 1
+ SSM
+ ARR 1
+ STA TIDA
+ JMP* NXT
+*
+*
+BUD DAC ** BUILD ASSIGNMENT
+ JST STXA
+ STA ABAR
+ LDA TID TABLE ENTRY
+ STA DP+4,1
+ LDA TID+1
+ STA DP+3,1
+ LDA TID+2
+ STA DP+2,1
+ LDA IU
+ STA IUA
+ LGL 14
+ STA DP+1,1
+ LDA NT
+ LGL 3
+ ADD K102 AT = STR/+BS
+ LGL 3
+ ADD IM
+ LRL 16
+ STA CL
+ LDA K102
+ STA AT
+ LDA A CL(A) = A/5
+ SUB K105
+ SPL
+ JMP *+3
+ IRS CL
+ JMP *-4
+ LLL 25
+ ADD CL
+ STA DP,1
+ SPL
+ JMP* BUD
+ LDA DT
+ LGL 1
+ ADD TT
+ LGL 14
+ IMA DP+4,1
+ ANA K111
+ ADD DP+4,1
+ STA DP+4,1
+ JMP* BUD
+*
+*
+*
+*
+*
+* ************
+* *DEFINE AFT*
+* ************
+* AT SUBA = AT (FROM B REG), THEN DEFINE AF
+*
+AF00 DAC **
+ IAB
+ STA AF90
+ JST STXA
+ LDA AF90
+ LGL 12
+ IMA DP,1
+ ANA AF91
+ ADD DP,1
+ STA DP,1 AT(A) = CONTENTS OF B INPUT
+ IAB
+ JST DA00 DEFINE AF
+ JMP* AF00
+AF90 PZE 0
+AF91 OCT 107777
+*
+*
+* *****************
+* *DEFINE LOCATION*
+* *****************
+* SET AF = RPL, AT = REL
+LO00 DAC **
+ LDA K101 REL
+ IAB
+ LDA RPL
+ JST AF00 DEFINE AF
+ JMP* LO00
+* *************************
+* *ASSIGN INTEGER CONSTANT*
+* *************************
+* IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL
+AI00 DAC **
+ CRA
+ STA ID+1
+ STA ID+2
+ LDA K101 (B) = INT
+ IAB
+ LDA K102 (A) = VAR
+ JST AA00 ASSIGN SPECIAL
+ JMP* AI00 RETURN
+*
+*
+* ****************
+* *ASSIGN SPECIAL*
+* ****************
+* B REG TO IM, A REG TO IU, 1 TO NT (CONSTANT), THEN
+* ASSIGN ITEM
+AA00 DAC **
+ STA IU IU = (A)
+ IAB
+ STA IM IM = (B)
+ LDA K101
+ STA NT NT = 1
+ JST AS00 ASSIGN ITEM
+ JMP* AA00 RETURN
+*
+*
+* **********
+* *JUMP *
+* *ILL TERM*
+* **********
+*
+* CLEAR LAST OP FLAG FOR NO PATH TESTING
+*
+B6 CRA
+ STA LSTP LSTP = 0
+* SET ILLEGAL DO TERM FLAG
+C5 LDA K101
+ STA LSTF LSTF =1
+A1 LDA CRET
+ JST TS00 IF TC NOT C/R, ERROR
+ JMP C6
+*
+*
+* **********
+* *CONTINUE*
+* **********
+* WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH
+* DO TABLE FOR DO TERMINATION
+C6 LDA LIF
+ SZE IF LIF NON-ZERO,
+ JMP C6H GO TO
+C6A LDA LSTN IF LSTN NON-ZERO,
+ SZE GO TO
+ JMP C6C
+C6B STA LSTF LSTF = 0
+ JMP C7 GO TO STATEMENT INPUT
+C6C SUB TRF TRACE FLAG
+ SNZ SMP IF NOT END OF TRACE ZONE
+ STA TRF SET TRF TO ZERO (TURN FLAG OFF)
+ LDA DO START OF DO TABLE
+ ADD D
+C6D STA I I = DO + D
+ JST STXI
+ SUB DO
+ SNZ
+ JMP C6B GO TO C6B - FINISHED DO
+ LDA DP-4,1
+ SUB LSTN
+ SZE
+ JMP C6E
+ LDA LSTF
+ SZE
+ JMP C6K
+ JST DQ00 DO TERMINATION
+ LDA D
+ SUB K105
+ STA D D = D-5
+ LDA LSTF
+C6E STA LSTF
+ LDA I
+ SUB K105
+ JMP C6D I = I-5 - CONTINUE DO LOOP
+C6H LDA IFF
+ STA A
+ SNZ
+ JMP C6J
+ LLL 16
+ LDA OMI5 (A) = JMP INSTRUCTION
+ JST OB00 OUTPUT OA
+ CRA
+ STA IFF IFF = 0
+C6J STA A A = U
+ LDA LIF
+ STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG
+ JST OS00 OUTPUT STRING - RPL
+ JMP C6A
+*
+C6K JST ER00
+ BCI 1,DT
+*
+* *****************
+* *STATEMENT INPUT*
+* *****************
+* SET UP PROCESSING OF NEXT SOURCE STATEMENT
+* PROCESS STATEMENT NUMBER IF PRESENT
+* WRAPUP ANY OUTSTANDING ARITHMETIC IF
+C7 CRA
+ STA LSTN LSTN = 0
+ STA IFLG IFLG = 0
+ STA LIF LIF = 0
+ LDA L0 L = L (0)
+ STA L
+ LDA CI CHECK CARD COLUMN 1
+ LGR 8 FOR $ CHARACTER
+ SUB K15 *($)
+ SNZ
+ JMP CCRD CONTROL CARD
+ JST XN00 EXAMINE NEXT CHAR
+ SZE
+ JMP C71
+ JST IS00 INPUT STATEMENT =
+ LDA A
+ STA LSTN LSTN = A
+ STA LSTP
+C71 LDA IFF CHECK FOR IFF=0
+ LDA IFF IF IFF = 0,
+ SNZ
+ JMP C7B GO TO C7B
+ SUB LSTN IF = LSTN
+ SZE
+ JMP C7C
+C7A STA IFF IFF = 0
+C7B JST C7LT LINE TEST
+ JMP C8
+C7C LDA IFF IFF = A
+ STA A
+ LRL 32
+ LDA K201 (A) = JMP INSTRUCTION
+ JST OB00 OUTPUT OA
+ CRA
+ JMP C7A GO TO C7A
+C7LT DAC ** LINE TEST
+ LDA CI+2 CI = BLANK
+ ANA K116 LIST LINE
+ ADD K8 RETURN
+ STA CI+2
+ LDA TC
+ SUB HC2 IF TC : SPECIAL
+ SZE
+ JMP C7LU
+ JST LIST
+ JMP* C7LT
+C7LU JST ER00 CONSTRUCTION ERROR
+ BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD
+*
+*
+*
+* ************************
+* *CONTROL CARD PROCESSOR*
+* ************************
+CCRD JST FS00 FLUSH BUFFER IF NECESSARY
+ JST LIST LIST CARD
+ LDA CI WORD CONTAINING COLUMN 1
+ LGL 12
+ SNZ
+ LDA CCRK ='030000 (EOJ CODE = 3)
+ LGR 6 TRUNCATE TO A DIGIT
+ STA OCI
+ LDA K106 =6
+ STA OCNT SET BUFFER WORD COUNT TO 3
+ JST FS00 FLUSH BUFFER
+ LDA CI
+ LGL 12 CHECK COLUMN 1 FOR CONTROL CODE 0
+ SZE
+ JMP ER20 SKIP TO NEXT CARD (NOT CONTROL CARD)
+ CALL F4$END CLOSE-OUT I/0 DEVICES AND STOP
+ JMP A0 RESTART NEW COMPILATION
+CCRK OCT 030000 EOJ CONTROL CODE
+*
+* ****************
+* *STATEMENT SCAN*
+* ****************
+* DETERMINE THE CLASS OF THE STATEMENT
+* IF AN = IS FOUND WITH A FOLLOWING ,
+* THE STATEMENT IS A DO
+* IF NO FOLLOWING COMMA, THE PAREN FLAG
+* IS TESTED, IF NO PARENS, THE STATEMENT
+* IS ARITHMETIC ASSIGNMENT
+* IF PARENS WERE DETECTED AND THE FIRST
+* NAME IS AN ARRAY, THE STATEMENT IS
+* ARITHMETIC ASSIGNMENT
+* OTHERWISE, IT IS A STATEMENT FUNCTION
+* IF NO = IS FOUND, THE STATEMENT IS
+* PROCESSED FURTHER IN STATEMENT ID
+C8T1 PZE 0
+C8 LDA CC SAVE CC
+ STA C8X9
+ LDA K101
+ STA C8T1 T (1) = 1
+ CRA
+ STA ICSW ICSW = SIR
+C8A JST CH00 INPUT CHARACTER
+C8B LDA TC IF TC = )
+ SUB K4
+ SZE
+ JMP C8C
+ JST CH00 INPUT CHAR
+C8B2 LDA DFL IF DFL NOT ZERO
+ SZE
+ JMP C8B GO TO C8B
+C8B4 LDA C8X9 RESTORE CC
+ STA CC
+ LDA K101 IPL
+ STA ICSW ICSW = IPL
+ JMP A9 GO TO STATEMENT ID
+C8C LDA TC IF TC NOT (,
+ SUB K17
+ SZE
+ JMP C8D GO TO C8D
+ LDA C8T1 T1 = T1 - 1
+ SUB K101
+ STA C8T1
+C8C4 SZE IF T1 = 0
+ JMP C8B4
+ JST DN00 INPUT DNA
+ JMP C8B2 GO TO C8B2
+C8D LDA TC IF TC = ,
+ CAS K134 ='17 ('FINISHED' CODE FOR COMMA)
+ JMP *+2
+ JMP C8D2 TC = COMMA
+ SUB K5
+ SZE
+ JMP C8E
+C8D2 LDA C8T1 GO TO C8C4,
+ JMP C8C4
+C8E LDA TC ELSE, IF TC = '/'
+ SUB K9
+ SNZ
+ JMP C8B4 GO TO C8B4
+ LDA TC
+ SUB K18 IF NOT = ,
+ SZE
+ JMP C8A GO TO C8A
+ LDA K107 INPUT 7 CHARACTERS
+ JST IA00
+ LDA C8X9 RESTORE CC
+ STA CC
+ LDA K101 IPL
+ STA ICSW ICSW = IPL
+ LDA TC
+ SUB K5 IF TC NOT,
+ SZE
+ JMP C8G GO TO C8G
+ LDA K102 ELSE, INPUT 2 CHARS
+ JST IA00
+ LDA IBUF IF (A) = 'DO'
+ SUB K19
+ SNZ
+ JMP *+3
+ JST ER00
+ BCI 1,CM COMMA OUTSIDE PARENTHESES, NOT IN DO STMNT,
+ LDA K104
+ JST NP00 FIRST NON-SPEC CHECK
+ JMP C9 GO TO DO
+C8G LDA C8T1 1 IF NO ( TO LEFT OF EQUALS
+ SZE
+ JMP G2 ARITHMETIC ASSIGNMENT STATEMENT
+ JST SY00 INPUT SYMBOL
+ LDA C8X9
+ STA CC RESTORE CC
+ LDA IU IF IU = SUBR
+ SUB K103
+ SZE
+ JMP G1 GO TO ARITH ST. FUNCT,
+ JMP G2 OTHERWISE = ASSIGNMENT STATEMENT
+C8X9 PZE 0
+*
+*
+* **************************
+* *STATEMENT IDENTIFICATION*
+* **************************
+* READ FOUR CHARACTERS AND DETERMINE CORRECT ROUTINE
+* FOR PROCESSING, THEN CHECK SPELLING ON REST
+A9T1 PZE 0
+A9T2 PZE 0
+A9T3 PZE 0
+A9 LDA K104
+ JST IA00 INPUT (4) CHARS
+ LDA IBUF
+ STA NAMF NAMF = IBUF
+ LDA IBUF+1
+ STA NAMF+1
+ LDA A9Z9 INITIALIZE INDEX FOR LOOP
+ STA XR THROUGH THE STATEMENT NAMES
+A9A LDA NAMF
+ SUB A9X1+30,1
+ SZE
+ JMP A9F READ IN REST OF
+ LDA NAMF+1 CHECK REST OF SPELLING FOR
+ SUB A9X2+30,1
+ SZE A MATCH ON 4 CHARACTERS
+ JMP A9F NOT FOUND
+ LDA A9X4+30,1
+ ANA K133
+ STA A9T1 T1 = NUMBER OF REMAINING CHARACTERS
+ LDA A9X3+30,1 LEFT TO CHECK
+ LRL 13
+ IAB
+ LGR 3
+ STA A9T2 T2 = ADDRESS OF ROUTINE
+ IAB
+ JST NP00 FIRST NON-SPECIFIC. CHECK -(A) =
+A9B LDA A9T1 HIERARCHY CODE
+ SZE
+ JMP A9C MUST CHECK MORE CHARACTERS
+ JMP* A9T2 FINISHED CHARACTER CHECK, EXIT TO
+* SPECIFIC ANALYZER.
+A9C SUB K106
+ SPL
+ JMP A9E
+ STA A9T1
+ LDA K106 REMAINING SPELLING 1S CHECKED.
+A9D STA A9T3
+ JST IA00
+ SUB A9T3
+ SNZ
+ JMP A9B
+ JST ER00
+ BCI 1,SP STATEMENT NAME MISSPELLED
+A9E ADD K106
+ IMA A9T1
+ CRA
+ IMA A9T1
+ JMP A9D
+A9F IRS XR LOOP CONTROL FOR STATEMENT NAMES.
+ JMP A9A MORE NAMES - CONTINUE LOOP
+ LDA TC
+ SUB CRET
+ SZE
+ JMP A9G
+ LDA LSTN TC = C/R
+ SNZ
+ JMP C7 AND LSTN = 0 - INPUT NEW STATEMENT
+A9G JST ER00
+ BCI 1,ID UNRECOGNIZED STATEMENT
+A9X1 BCI 10,INREDOCOLOFUSUBLEXDI
+ BCI 10,COEQGOCARECOFOIFWRRE
+ BCI 7,BAENREENASSTPA
+ BCI 2,DATR
+ BCI 1,PR
+A9X2 BCI 10,TEALUBMPGINCBROCTEME
+ BCI 10,MMUITOLLTUNTRM( ITAD
+ BCI 3,CKDFWI
+ OCT 142215 D, C/R
+ BCI 3,SIOPUS
+ BCI 2,TAAC
+ BCI 1,IN
+A9X3 DAC A3
+ DAC A4
+ DAC A5
+ DAC A6
+ DAC A7
+ DAC R1
+ DAC R2
+ DAC R3
+ DAC B2
+ DAC B3
+ DAC B4
+ DAC B5
+ DAC* R7
+ DAC* R8
+ DAC* R9
+ DAC* CONT
+ DAC* V2
+ DAC* V3
+ DAC* V4
+ DAC* V5
+ DAC* V6
+ DAC* V7
+ DAC* V8
+ DAC W5+'20000
+ DAC* W3
+ DAC* W7
+ DAC* W8
+ DAC W4,1
+ DAC* TRAC+'20000,1 TRACE STATEMENT
+ DAC* V10
+*
+* ******************************
+* *CONTINUE STATEMENT PROCESS0R*
+* ******************************
+CONT LDA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR
+ ADD LSTN ACCOUNTS FOR POSSIBLE PATH ERROR
+ STA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR
+ JMP C6
+*
+*-------------THE FOLLOWING TABLE IS USED BY STATEMENT ID
+*-------------(RIGHT 6 BITS) AND OUTPUT ITEM,
+A9X4 OCT 000003 (00)
+ OCT 030100 (01) + (A$--)
+ OCT 032313 (02) - (S$--)
+ OCT 031503 (03) * (M$--)
+ OCT 030403 (04) / (D$--)
+ OCT 000004 (05) .NOT.
+ OCT 000006 (06) .AND.
+ OCT 031405 (07) .OR. (L$-,
+ OCT 000004 (10) .LT.
+ OCT 000005 (11) .LE.
+ OCT 000002 (12) .EQ.
+ OCT 000007 (13) .GE.
+ OCT 000000 (14) .GT.
+ OCT 000000 (15) .NE.
+ OCT 031003 (16) = (H$--)
+ OCT 000005 (17) ,
+ OCT 030503 (20) 'E' (E$--)
+ OCT 031600 (21) 'C' NC$--)
+ OCT 000001 (22) 'A'
+ OCT 000000 (23)
+ OCT 000005 (24) 'X'
+ OCT 000003 (25) 'H'
+ OCT 000002 (26) 'L'
+ OCT 000000 (27) 'I'
+ OCT 000002 (30) 'T'
+ OCT 031400 (31) 'F' (L$--)
+ OCT 000001 (32) 'Q'
+ OCT 000000
+ OCT 000001
+ OCT 000001
+A9Z9 DAC* -30,1 NO. OF ITEMS IN STMNT NAME TABLE
+*
+*
+* **********************
+* *FIRST NON-SPEC CHECK*
+* **********************
+* AT FIRST SHIFT IN LEVEL FROM ZERO, WRAP-UP
+* SPECIFICATION STATEMENTS
+T0NP PZE 0
+NPT0 EQU T0NP
+T2NP PZE 0
+T1NP PZE 0
+NP00 DAC **
+ STA NPT0 T0 = (A)
+ LDA A
+ STA T1NP T1 = A
+ LDA NPT0
+ CAS K107 =7
+ JMP *+2
+ JMP NP10 TRACE STMNT. (MAY OCCUR ANYWHERE)
+ CAS SPF T0 , G.R. SPF, GO TO NP30
+ JMP NP30 T0 = SPF, G0 TO NP25
+ JMP NP25
+ LDA TC IF TC = C/R
+ SUB CRET GO TO NP10
+ SNZ
+ JMP NP10
+ JST ER00 ELSE, ILLEGAL STATEMENT
+ BCI 1,EX SPECIFICATION STATEMENT APPEARS AFTER
+*
+NP10 LDA LSTN SPECIFICATION STATEMENT CLEAN-UP
+ STA A A = LSTN
+ SNZ
+ JMP NP16 IF ZERO, RETURN
+ JST FA00 FETCH ASSIGNS
+ LDA K103 STR-REL
+ SUB AT
+ SZE
+ JMP NP20
+ LDA AF
+ JST OS00 OUTPUT STRING RPL
+NP15 JST LO00 DEFINE LOCATION
+ LDA NAMF
+ SUB A9X1+16
+ SZE
+ JST TRSE OUTPUT TRACE COUPLING
+NP16 LDA T1NP
+ STA A
+ JMP* NP00
+NP20 JST NR00 NON-REL TEST
+ JMP NP15
+NP25 LDA LIF
+ SZE
+ JMP NP16
+ LDA LSTP IF LSTP + LSTN =0
+ ADD LSTN
+ SZE
+ JMP NP10
+ IRS LSTP
+ JST ER00 'NO PATH' ERROR
+ BCI 1,PH NO PATH LEADING TO THE STATEMENT
+NP30 LDA SPF IF SPF 0 0
+ SZE
+ JMP NP37
+NP32 LDA TC
+ STA T2NP T2 = TC
+ LDA RPL
+ STA XST XST = RPL
+ LDA BDF BLOCK DATA SUBPROGRAM FLAG
+ SZE SKIP IF NOT BLOCK DATA SUBPROGRAM
+ JMP C2 GO TO RELATE COMMON
+ STA A SET LISTING FOR OCTAL ADDR.
+ LDA OMI5 JMP INSTRUCTION
+ STA DF SET LISTING FOR SYMBOLIC INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ JMP C2 GO TO RELATE COMMON
+NP35 LDA T2NP
+ STA TC
+NP37 LDA T0NP
+ STA SPF SPF = T0
+ SUB K104
+ SZE
+ JMP NP10
+NP40 STA A SET LISTING FOR OCTAL ADDR.
+ LDA XST LOCATION OF INITIAL JUMP
+ JST OS00 OUTPUT STRING
+ LDA RPL
+ STA XST XST = RPL
+ JMP NP10 GO TO NP10
+*
+* *****************
+* *IF( PROCESSOR*
+* *****************
+* ARITHMETIC IF ($1 $2 $3)
+* IF $2 NOT = $3, JZE $2
+* IF $3 NOT = $1, JPL $3
+* (IF $1 NOT = NEXT ST NO., JMP $1) LATER
+* LOGICAL IF
+* OUTPUT JZE 77777 (FOR STRINGING AROUND
+* IMBEDDED STATEMENT)
+V3 JST II00 INPUT ITEM
+ SNZ
+ JMP V310 IM=0 (POSSI8LE UNARY + OR -)
+ LDA DFL
+ SZE
+ JMP V310 FIRST ITEM IN EXPRESSION 0.K.
+V308 JST ER00 ERROR.....IF(SENSE SWITCH,.ETC).....
+ BCI 1,IF ILLEGAL IF STATEMENT TYPE
+V310 CRA (A)=0
+ JST EX00 EXPRESSION EVALUATOR
+ LDA K4
+ JST TS00 )-TEST
+ CRA
+ STA A SET A TO SPECIAL (IF) ENTRY IN DATA POOL
+ STA 0
+ LDA MFL SET MODE OF EXPRESSION INTO SPECIAL (IF)
+ LGL 9
+ STA DP,1
+ JST TRSE OUTPUT TRACE COUPLING (IF NECESSARY)
+ LDA MFL CHECK MODE FLAG FOR LOGICAL
+ SUB K103
+ SZE
+ JMP V320 ARITHMETIC IF
+ LDA LIF
+ SZE
+ JMP V308
+ STA AF SET ADDR OF SNZ AND JMP INSTR TO 00000
+ LDA OMJ2 =SNZ INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ LDA RPL SET LIF=CURRENT +DDR, (STRING BACK)
+ STA LIF
+ LDA OMI5 =JMP 0 INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ JST XN00 GO TO NEXT INPUT LINE
+ JMP C8 GO TO STATEMENT SCAN
+*
+V320 SUB K102 CHECK FOR MODE = COMPLEX
+ SNZ
+ JMP V308 ERROR,...COMPLEX MODE EXPRESSION
+ LDA V356 =-3
+ STA I
+V324 JST IS00 INPUT STATEMENT NUMBER
+ JST STXI SET INDEX TO I
+ LDA A
+ STA T1V3+3,1 SAVE BRANCH ADDRESSES
+ IRS I I=I+1
+ JMP V350 CHECK FOR TERMINAL COMMA
+ LDA T3V3
+ CAS T2V3 CHECK FOR ADDR-2 = ADDR-3
+ JMP *+2
+ JMP V330 ADDR-2 = ADDR-3
+ CRA
+ STA A
+ LDA OMJ2 =SNZ INSTR.
+ STA DF
+ JST OA00 OUTPUT ABSOLUTE
+ LDA T2V3
+ JST V360 OUTPUT A JMP(ADDR-2) INSTR.
+ LDA T3V3
+V330 CAS T1V3 CHECK FOR ADDR-3 = ADDR-2
+ JMP *+2
+ JMP V340 ADDR-3 = ADDR-1
+ CRA
+ STA A
+ LDA OMJ3 =SMI INSTR.
+ JST OA00 OUTPUT ABSOLUTE
+ LDA T3V3
+ JST V360 OUTPUT A JMP (ADDR-3) INSTR.
+V340 LDA T1V3
+ STA IFF SET IFF ' ADDR-1
+ JMP C5 GO TO ILL-TERM
+*
+V350 LDA K5
+ JST TS00 COMMA TEST
+ JMP V324 INPUT NEXT STATEMENT NO.
+*
+V356 OCT 177775 -3
+*
+*---------------SUBROUTINE TO OUTPUT A RELATIVE JMP
+V360 DAC **
+ STA A SET ADDR. OF JUMP REF. TO A
+ CRA
+ IAB SET (B) = 0
+ LDA OMI5 SET (A) = JMP INSTR.
+ JST OB00 OUTPUT OA
+ JMP* V360 EXIT
+*
+T1V3 *** ** ADDR-1
+T2V3 *** ** ADDR-2
+T3V3 *** ** ADDR-3
+*
+* *******
+* *GO TO*
+* *******
+* CHECK FOR NORMAL (R740), COMPUTED (R710) OR
+* ASSIGNED (R730). INPUT BRANCH LIST USED BY BOTH
+* R710 AND R730 FOR STATEMENT NO. LIST.
+*
+*
+R7 JST XN00 EXAMINE NEXT CHAR
+ SZE
+ JMP R78 GO TO TEST DFL
+ JST IS00 INPUT STMNT =
+ LDA A (GO TO 20)
+ STA IFF IFF = A
+ JMP C5 G0 TO ILLTERM
+R78 LDA DFL
+ SZE
+ JMP R7D
+ JST IR00 GO TO I (10, 20, 30}
+ LRL 32
+ LDA K206 OUTPUT JMP* INSTRUCTION
+ JST OB00 OUTPUT OA
+ LDA K134
+ JST TS00 , TEST
+ JST IB00 INPUT BRANCH LIST
+ JMP B6 GO TO JUMP
+R7D JST IB00 INPUT BRANCH LIST GO TO (10,11,12), I
+ LDA K134
+ JST TS00 , TEST
+ JST IR00 INPUT INT VAR
+ LRL 32
+ LDA K200 OUTPUT LDA
+ JST OB00 OUTPUT OA
+ CRA
+ STA A
+ STA AF CAUSE OCTAL ADDRESS IN LISTING
+ LDA K75
+ JST OA00 OUTPUT ABS (STA 0) - INDEX LOAD
+ LDA RPL
+ STA AF CAUSE RPL T0 BE IN LISTING
+ LDA K207
+ JST OR00 OUTPUT RELATIVE (JMP RPL,1)
+ LDA L0
+R7F SUB K101
+ STA I I = L (0)
+ JST STXI
+ LDA DP,1
+ STA A
+ JST STXA
+ SNZ
+ JMP B6 FINISHED LOOPING ON LIST
+ LLL 16
+ LDA K201 OUTPUT JMP INSTRUCTIONS
+ JST OB00 OUTPUT OA (JMP 0)
+ LDA I
+ JMP R7F
+* *******************
+* *INPUT BRANCH LIST*
+* *******************
+* INPUT STATEMENT NO. LISTS FOR GO TO PROCESSOR
+IB00 DAC **
+ LDA L0
+ SUB K101
+ STA I I = L0-1
+ JST CH00 INPUT CHAR
+ LDA K17
+ JST TS00 (- TEST
+IB10 JST IS00 INPUT STMNT =
+ JST STXI
+ LDA A
+ STA DP,1 SET POINTER OF ST. N0. INTO TRIAD TABLE
+* AREA
+ LDA I DP (J) = A
+ SUB K101
+ STA I I = I-1
+ LDA TC IF TC = , GO TO IB10
+ SUB K5
+ SNZ
+ JMP IB10 CONTINUE LOOP
+ CRA
+ STA DP-1,1 SET END FLAG INTO TABLE
+ JST IP00 )- INPUT OPEN
+ JMP* IB00 EXIT
+K75 STA 0
+*
+*
+* ********
+* *ASSIGN*
+* ********
+* CHECK TO SEE THAT 'TO' IS INCLUDED PROPERLY
+W3 JST IS00 INPUT STMNT =
+ LDA A
+ STA T1W3 SAVE A
+ LDA TC
+ SUB K34 CHECK FOR T0
+ SZE
+ JMP W305 CLEAR A FOR OUTPUT REL
+ STA A CAUSE OCTAL ADDRESS IN LIST
+ JST CH00 INPUT CHAR
+ LDA TC
+ SUB K35
+ SNZ
+ JMP *+3
+W305 JST ER00 ERROR
+ BCI 1,TO GO TO IN ASSIGN STATEMENT
+ LDA RPL
+ ADD K102
+ STA AF OUTPUT REL LDA *+2
+ LDA K200 OUTPUT LDA *+2
+ JST OR00 OUTPUT REL
+ LDA RPL
+ ADD K102
+ STA AF OUTPUT REL JMP *+2
+ LDA K201
+ JST OR00 OUTPUT OA
+ LRL 32
+ LDA T1W3
+ STA A RESTORE A
+ CRA
+ JST OB00 OUTPUT DAC ST. NO.
+ JST IR00 INPUT INTEGER VARIABLE
+ LRL 32
+ LDA K202 OUTPUT STA INSTRUCTION
+ JST OB00 OUTPUT OA
+ JMP A1 GO TO C/R TEST
+T1W3 PZE ** TEMP STORE
+*
+*
+* ************************
+* *DO STATEMENT PROCESSOR*
+* ************************
+* STACK INFO IN DO TABLE. OUTPUT DO INITIAL
+* CODE
+C9T0 PZE **
+C9 JST IS00 INPUT STATEMENT =
+ JST NR00 NON-REL TEST
+ LDA A
+ STA C9T0 T0 = A
+ JST UC00 UNINPUT COLUMN
+ JST IR00
+ LDA C951
+ JST TS00
+ LDA C9T0 (A) = T0
+ IAB
+ JST DP00 DO INPUT
+ JST DS00 DO INITIALIZE
+ JMP C5 GO TO ILLTERM
+C951 OCT 16 =
+*
+*
+* **********
+* *END FILE*
+* **********
+* ***********
+* *BACKSPACE*
+* *REWIND *
+* ***********
+V6 LDA K71
+V6A STA NAMF+1
+ JST NF00 SET UP NAMF
+ JST OI00 OUTPUT I/0 LINK
+ JMP A1 GO TO C/R TEST
+V7 LDA K72
+ JMP V6A
+V8 LDA K73
+ JMP V6A
+K71 BCI 1,FN FN
+K72 BCI 1,DN
+K73 BCI 1,BN BN
+*
+*
+* **************
+* *READ *
+* *WRITE *
+* *INPUT FORMAT*
+* **************
+* LIST ELEMENT DATA AND IMPLIED DO CONTROL
+* STACKED IN TRIAD TABLE. PROCESSED BY
+* OUTPUT TRIAD ROUTINE, SPECIAL OPERATORS
+* ARE -I = DO INITIALIZATION
+* T = DO TERMINATION
+* Q = I/0 ARG TRANSFER
+T0V5 PZE **
+V5 LDA K41 FSRN
+ STA NAMF+1
+ JST XN00 EXAM NEXT CHAR
+ SZE
+ JMP V5A GENERAL READ
+ LDA V5K4
+ JMP V10A CARD READ
+V4 LDA K40 NAWF = F$WN
+ STA NAMF+1
+V5A JST NF00 SET UP REMAINING NAME
+ LDA D
+ STA V5T1
+ JST CH00 INPUT CHARACTER
+ LDA K17 ='250......(
+ JST TS00 (-TEST
+ JST OI00 OUTPUT I0 LINK
+ LDA TC IF TC .NE. ,
+ SUB K134 ='17 (,)
+ SZE G0 10 V5J
+ JMP V5J
+ JST V5X INPUT FORMAT
+V5B JST IP00 ) - INPUT OPERATOR
+ LDA TC
+ SUB CRET TEST FOR TC=C/R
+ SZE
+ JMP V5C N0, G0 TO V5C
+V5B2 LDA K42 YES. NAMF = ND
+ STA NAMF+1
+ JST CN00 CALL NAME
+ LDA V5T1
+ STA D
+ JMP A1 G0 TO C/R TEST
+V5C JST UC00
+V5C5 CRA
+ STA IOF IOF = 0
+V5D JST II00 INPUT ITEM
+ SZE
+ JMP V5E IF (A) NOT 0, GO TO V5E
+ LDA K17
+ JST TS00 (-TEST
+ CRA
+ STA O2 O2 = 0
+ LDA IOF
+ STA O1 01 = IOF
+ LDA V5K1 = '27
+ STA P
+ JST ET00
+ LDA L
+ STA IOF IOF = L
+ JMP V5D GO TO V5D
+V5E JST NC00 NON-CONSTANT TEST
+ LDA IU IF IU NOT ARR
+ SUB K103
+ SZE
+ JMP V5H GO TO V5H
+ LDA TC
+ SUB K17 IF TC NOT -(,
+ SZE
+ JMP V5G GO TO V5G
+ LDA D0
+ STA T0V5 T5 = D0
+ LDA K103
+ TCA
+ JST EX00 EXPRESSION
+ LDA T0V5
+ STA D0 D0 = T5
+V5E5 LDA A
+ STA O2
+ LDA D0 O2 = D0
+ STA O1
+ LDA V5K2 ='32
+ STA P
+ JST ET00 ENTER TRIAD
+V5E7 LDA TC IF TC = COMMA
+ SUB K134 GO T0 V5D
+ SNZ
+ JMP V5D
+ LDA IOF I = IOF
+ STA I
+ SZE IF NOT ZERO,
+ JMP V5F GO TO V5F
+ JST OT00 OUTPUT TRIADS
+ JMP V5B2 GO TO V5B2
+V5F JST IP00 )-INPUT OPERATOR
+ JST STXI
+ LDA DP+1,1
+ STA IOF IOF = O1 (I)
+ JMP V5E7
+V5G JST KT00 K = = WDS/ITEM
+ JMP V5E5 GO TO V5E5
+V5H JST TV00 TAG VARIABLE
+ LDA TC
+ SUB K16X ='16 (=)
+ SZE GO TO V5E5
+ JMP V5E5 ELSE,
+ JST IT00 INTEGER TEST
+ LDA IOF
+ SNZ IF IOF = ZERO OR L
+ JMP V5H7
+ SUB L
+ SZE
+ JMP *+3 ERROR
+V5H7 JST ER00
+ BCI 1,PR PARENTHESES MISSING IN DO STATEMENT
+ JST DP00 DO INPUT
+ LDA IOF
+ STA I
+ JST STXI
+ LDA D
+ STA DP,1 O2(IOF) = D
+ STA O2 O2 = D
+ LDA V5K3 ='30
+ STA P
+ JST ET00 ENTER TRIAD 'T'.
+ JMP V5F
+V5J CRA
+ STA A A = 0
+ JST OA00 OUTPUT ABSOLUTE
+ JMP V5B
+V5T1 PZE 0
+V5K1 OCT 27
+V5K2 OCT 32
+V5K3 OCT 30
+V5K4 BCI 1,R3
+V5K5 BCI 1,W4
+V5X DAC ** INPUT FORMAT
+ JST XN00 EXAM NEXT CHARACTER
+ SZE
+ JMP V5X5 GO TO INPUT ARRAY NAME
+ JST IS00 INPUT STMNT NO.
+V5X2 LRL 32 OUTPUT DAC A
+ JST OB00 OUTPUT 0A
+ JMP* V5X RETURN
+V5X5 JST NA00 INPUT NAME
+ JST AT00 ARRAY TEST
+ JMP V5X2
+* PRINT
+V10 LDA V5K5 PRINTER
+V10A STA NAMF+1
+ JST NF00 SET UP REST 0F NAME
+ JST CN00 CALL NAME
+ JST V5X INPUT FORMAT
+ LDA TC
+ SUB K134
+ SZE SKIP IF COMMA
+ JMP V5B2
+ LDA D
+ STA V5T1
+ JMP V5C5
+*
+*
+* **************************
+* *FORMAT *
+* *INPUT FORMAT STRING *
+* *INPUT NUMERIC FORMAT STR*
+* *NON ZERO TEST STRING *
+* **************************
+T0V2 PZE 0
+T2V2 PZE 0
+V2T0 EQU T0V2
+V2T2 EQU T2V2
+V2 LDA K17
+ JST OK00 OUTPUT RACK
+ CRA
+ STA T0V2 TO = 0
+ LDA LSTP IF LSTOP .NE. 0
+ SZE
+ JMP V2K GO TO V2K
+V2A JST SI00 INPUT FORMAT STRING
+ SZE
+ JMP V2B
+V2A1 LDA TC
+ SUB K12 IF TC NOT MINUS
+ SZE
+ JMP V2F GO TO V2F
+ JST IN00 INPUT NUMERIC FORMAT STRING
+ CRA
+ STA TID TID = 0
+V2B LDA TC IF TC .NE. P
+ SUB K46
+ SZE
+ JMP V2H GO TO V2H
+ JST SI00 INPUT FORMAT STRING
+ SZE
+ JST NZ00 IF (A) .NE. 0
+V2C LDA TC
+ CAS K52 IF TC = D,E,F, OR G
+ NOP
+ JMP *+2
+ JMP V2DA
+ CAS K53
+ JMP V2E5-2
+ NOP
+ JST IN00 INPUT NUMERIC FORMAT STRING
+ JST NZ00 NON-ZERO STRING TEST
+ LDA K10
+ JST TS00 PERIOD TEST
+V2D JST IN00 INPUT NUMERIC FORMAT STRING
+V2DA LDA TC IF TC = )
+ SUB K4
+ SZE
+ JMP V2E
+ JST CH00
+ JST OK00 INPUT CHAR AND OUTPUT PACK
+ LDA T0V2 IF F4 + ( Z (
+ SUB K101 GO TO V2E
+ STA T0V2
+ SPL
+ JMP V2N ELSE,
+ JMP V2DA
+* GO TO C/R TEST
+V2E LDA TC IF TC =,
+ SUB K5
+ SNZ
+ JMP V2A GO TO V2A
+ LDA K9
+ JST TS00 / TEST
+ JMP V2A
+V2E5 JST SI00 INPUT FORMAT STRING
+ SZE IF (A) NOT 0,
+ JMP V2B GO TO V2B
+ LDA DFL IF DFL .NE. ZERO,
+ SZE
+ JMP V2DA GO TO V2DA
+ JMP V2A1
+V2F LDA TC IF TC = H
+ CAS K48
+ JMP *+2
+ JMP V2P GO TO V2P
+V2FB CAS K47
+ JMP *+2
+ JMP V2E5
+ CAS K17 IF TC = (,
+ JMP *+2
+ JMP V2Q GO TO V2Q
+ LDA TC IF TC .NE. A,I, OR L
+ CAS K49 A
+ JMP *+2
+ JMP V2G
+ CAS K50 I
+ JMP *+2
+ JMP V2G
+ SUB K51 L
+ SZE
+ JMP V2C
+V2G JST IN00 INPUT NUMERIC FORMAT STRING
+ JST NZ00 NON-ZERO STRING TEST
+ JMP V2DA
+V2H JST NZ00 NON-ZERO STRING TEST
+ LDA TC
+ SUB K48
+ SZE
+ JMP V2F
+V2J JST HS00 TRANSMIT HOLLERITH STRING
+ JMP V2E5 GO T0 V2E5
+V2K LDA LSTN IF LSTN = 0,
+ SZE
+ JMP *+3
+ JST ER00 ERR0R, NO PATH
+ BCI 1,NF NO REFERENCE T0 FORMAT STATEMENT
+ LDA RPL LIF = RPL
+ STA LIF
+ CRA
+ STA A
+ STA AF
+ AOA
+ STA DF
+ LDA K201 = JMP 0
+ JST OA00 OUTPUT ABS
+ JMP V2A GO T0 V2A
+*
+NZ00 DAC **
+ LDA TID
+ SZE
+ JMP* NZ00
+NZ10 JST ER00
+ BCI 1,NZ NON-ZERO STRING TEST FAILED
+IN00 DAC **
+ JST SI00 (A) = 0 IS ERROR CONDITION
+ SZE
+ JMP* IN00
+ JMP NZ10
+SI00 DAC **
+ CRA
+ STA TID ID = T2 = 0
+SI05 STA V2T2
+ JST CH00 INPUT CHAR
+ JST OK00 OUTPUT PACK
+ LDA TC
+ SUB K60 ASC-2 ZERO
+ CAS K124
+ JMP SI10
+ NOP
+ SPL
+ JMP SI10
+ STA TC
+ LDA TID TID = 10*TID+TC
+ ALS 3
+ ADD TID
+ ADD TID
+ ADD TC
+ STA TID
+ LDA K101 T2 =1
+ JMP SI05
+SI10 LDA V2T2 (A) = ERROR CONDITION OR NOT
+ JMP* SI00
+V2M JST ER00
+ BCI 1,FR FORMAT STATEMENT ERROR
+V2N EQU A1
+V2P LDA K101
+ STA ID ID = 1
+ JMP V2J GO T0 V2J
+V2Q LDA T0V2
+ AOA
+ STA T0V2
+ SUB K103
+ SZE
+ JMP V2A
+ JMP V2M
+K46 OCT 320 0P
+K47 OCT 330 0X
+K48 EQU K14 0H
+K49 OCT 301 0A
+K51 OCT 314 0L
+K52 EQU K11 0D
+K53 OCT 307 0G
+K50 EQU K43 0I
+*
+*
+* *******
+* *STOP *
+* *PAUSE*
+* *******
+* PAUSE AND STOP CENERATE CALLS TO F$HT
+T1W7 PZE 0
+T2W7 PZE 0
+W7 LDA K55
+ STA T1W7
+W7A LDA K74
+ STA NAMF+1 NAMF = F$HT
+ JST NF00 SET-UP REMAINING CHAR 0F NAME
+ JST XN00 EXAMINE NEXT CHAR
+ LDA TC
+ SUB CRET
+ SNZ
+ JMP W7C TC = C/R - NOTING FOLLOWING
+ JST IV00 INPUT INTEGER/VARIA8LE
+ LRL 32
+ LDA K200 OUTPUT LDA
+ JST OB00 OUTPUT OA
+W7C JST CN00 CALL NAME
+ CRA
+ STA DF DF = 0
+ LDA T1W7
+ STA ID
+ JST AI00 ASSIGN INTEGER CONSTANT
+ CRA OUTPUT DAC
+ JST OB00 OUTPUT OA OF ST/PA OR HT
+ LDA T1W7
+ SUB K54
+ SNZ
+ JMP C5 PA-NOT THE CASE
+ LDA RPL
+ STA AF OUTPUT JMP *
+ CRA
+ STA A CAUSE LISTING TO HAVE OCTAL ADDRESS
+ LDA K201
+ JST OR00 OUTPUT RELATWE
+ JMP B6
+W8 LDA K54
+ JMP W7+1
+K74 BCI 1,HT HT
+K54 BCI 1,PA PA
+K55 BCI 1,ST ST
+*
+*
+* - R8 CALL
+* GENERATES CALL DIRECTLY OR USES EXPRESSION TO
+* ANALYZE AN ARGUMENT LIST.
+R8 JST SY00 INPUT SYMBOL
+ LDA IU
+ SUB K101 =1 (SUB)
+ SZE SKIP IF IU=SUBR,
+ JST TG00 TAG SUB PROCRAM
+ LDA TC
+ SUB K17 ='250 ( ( )
+ SZE
+ JMP *+3
+G2B LDA K101 SET A=1 BEFORE EXPRESSION
+ JMP G2A
+ CRA
+ IAB (B)=0
+ LDA OMI2 =JST INSTR,
+ JST OB00 OUTPUT 0A
+ JMP A1 CR TEST
+* **********************
+* *ASSIGNMENT STATEMENT*
+* **********************
+G2 LDA K104
+ JST NP00 FIRST NON-SPEC CHECK
+ JST II00 INPUT ITEM
+ LDA K102 SET A = 2 BEFORE EXPRESSION
+G2A TCA
+ JST EX00
+ JMP A1
+*
+*
+* ********
+* *RETURN*
+* ********
+* OPTIMIZES EXIT CODING FOR FUNCTIONS TO MINIMIZE
+* FETCHES OF THE FUNCTION VALUE.
+R9 LDA SBF A = SBF,
+ STA A IF ZERO, GO TO ERROR
+ SZE
+ JMP *+3
+ JST ER00
+ BCI 1,RT RETURN NOT ALLOWED IN MAIN PROGRAM
+ LDA SFF ELSE, IF SFF = 0,
+ SNZ
+ JMP R9C GO TO R9C
+ CAS K101 IF SFF = 1, GO TO R98
+ JMP *+2
+ JMP R9B
+ STA AF OUTPUT REL JMP TO 1ST RETN
+ LRL 32
+ STA A SET A=0 TO OUTPUT OCTAL ADDR ON LISTING
+ LDA K201
+ JMP R9A
+R9B IAB
+ LDA RPL SFF = RPL
+ STA SFF
+ LDA K56 0UTPUT ITEM (F,A)
+ JST OM00
+R9C LRL 32
+ STA A SET FOR OCTAL ADDHESS IW LISTING
+ STA AF SET RELATIVE ADDRESS TO ZERO
+ LDA K206 JUMP I, 0
+R9A JST OR00 OUTPUT REL
+ JMP B6 EXIT
+K56 OCT 31 P CODE FOR 'F' (FETCH)
+*
+*
+* ********************
+* *STATEMENT FUNCTION*
+* ********************
+* OLD ASSIGN VALUES ARE SAVED IN SFTB AND ARE
+* RESTORED AT COMPLETION.
+G1T0 PZE 0
+G1T1 PZE 0
+G1 LDA K103 (A) = 3
+ JST NP00 FIRST NON-SPEC CHECK
+ JST SY00 INPUT SYMBOL
+ JST LO00 DEFINE LOCATION
+ LDA K103
+ STA I
+ JST GE00 GENERATE SUBPROGRAM ENTRANCE
+ LDA I
+ STA G1T1 T1 = I
+ LDA K16X '=' TEST
+ JST TS00
+ JST II00 INPUT ITEM
+ CRA
+ JST EX00 EXPRESSION
+ LDA G1T1
+ STA I I = T1
+ IRS TCF TCF = TCF+1
+G1A JST STXI
+ LDA SFTB+2,1
+ STA A
+ LDA SFTB+0,1
+ IAB
+ JST STXA SET R TO A
+ IAB
+ STA DP,1
+ JST STXI SET R TO I
+ LDA SFTB+1,1
+ IAB
+ JST STXA SET R TO A
+ IAB
+ STA DP+1,1
+ LDA I
+ SUB K103 I = I-3 = 0
+ STA I
+ SUB K103
+ SZE
+ JMP G1A NO, GO TO G1A
+ LDA T1NP
+ STA A
+ LLL 16
+ LDA OMJ1
+ JST OB00
+ JST TG00 TAG SUBPROGRAM
+ JMP A1 GO TO C/R TEST
+* - W5 END
+* ***************
+* *END PROC6SSOR*
+* ***************
+* FIRST CHECK SUBPROGRAMS FOR CORRECT USAGE, THEN
+* GENERATE MAP AND STRING BACK VARIABLES
+* AND CONSTANTS.
+T1W5 PZE
+W5 LDA BDF IF BLOCK DATA,
+ SZE
+ JMP W5K GO TO W5K
+ LDA SBF IF SBF NOT ZERO
+ STA A INDICATES SUBROUTINES
+ SZE OR FUNCTION,
+ JMP W5M GO TO W5M
+W5B CRA
+ STA A A = J=0
+ JMP W5H
+W5D JST FA00 FETCH ASSIGNS
+ JST STXA
+ LDA NT
+ SZE IF NT=L (CONSTANT)
+ JMP W5O GO TO W5O
+ LDA IU
+ SUB K101 IF IU=1
+ SZE INDICATES VARIABLE,
+ JMP W5T GO TO W5T
+W5F LDA RPL SAVE RPL
+ STA T1W5 RPL=-AF (INHIBIT LISTING)
+ LDA AF
+ SSM
+ STA RPL
+ CRA
+ JST OR00 OUTPUT REL
+ LDA T1W5 RESTORE RPL
+ STA RPL
+W5H LDA A A=A+5
+ ADD K105
+ STA A
+ SUB ABAR IF A=ABAR, (DONE)
+ SUB K105
+ SZE
+ JMP W5D ELSE, GO TO W5D
+W5J JST FS00 FLUSH BUFFER
+ LDA SBF
+ SZE
+ LDA W5Z1
+ ERA W5Z2
+ STA OCI
+ LDA SBF
+ SZE
+ LDA W5Z3
+ STA OCI+1
+ LDA K106
+ STA OCNT
+ JST FS00
+ JMP A051 GO TO INITIALIZE
+W5K LDA RPL IF RPL NOT ZERO,
+ SNZ
+ JMP W5J
+ JST ER00 ERROR-CODE GENERATED
+ BCI 1,BD IN A BLOCK DATA SUBPROGRAM
+W5M JST FA00 FETCH ASSIGNS
+ LDA SFF IF FUNCTION,
+ SZE
+ JMP W5N GO TO W5N
+ JST NU00 NO USE TEST
+ JST STXA
+ LDA DP,1 IF NO ERROR,
+ SSM NT(A)=1
+ STA DP,1
+ JMP W5B GO T0 W5B
+W5N LDA IU
+ SUB K102 IU MUST BE VAR/CON,
+ SNZ ELSE,
+ JMP W5B
+ JST ER00 ERROR-FUNCTION
+ BCI 1,FD NAME NOT DEFINED BY AN ARITHM, STATEMENT
+W5O LDA IU IF IU=VAR/CON
+ SUB K102
+ SZE
+ JMP W5H
+ LDA AT AND AT = STR/REL
+ SUB K103 A "STRING" REQ'D.
+ SZE
+ JMP W5H
+W5P LDA D0 IF D0 IS 4, THE
+ SUB K104 CONSTANT IS COMPLEX,
+ SZE OTHERWISE
+ JMP W5Q GO TO W5Q
+ LDA AF
+ JST OS00 OUTPUT STRING
+ JST STXA
+ LDA DP+2,1 OUTPUT 4 WORDS
+ JST W5X OF CONSTANT
+ LDA DP+3,1
+ JST W5X
+ LDA NT
+ SNZ
+ JMP W5S
+ LDA A INCREMENT A
+ ADD K105
+ STA A
+ JST STXA
+ JMP W5S
+W5Q LDA AF
+ JST OS00 OUTPUT STRING
+ JST STXA
+ LDA D0 IF D0=1,
+ SUB K101 INDICATES INTEGER,
+ SNZ
+ JMP W5R GO TO W5R
+W5S LDA DP+2,1 OUTPUT TWO WORDS
+ JST W5X FLOATING POINT CONSTANT
+ LDA DP+3,1
+ JST W5X
+ LDA D0 IF DOUBLE PRECISION,
+ SUB K103
+ SZE
+ JMP W5H
+W5R LDA DP+4,1 OUTPUT THE 3RD WORD
+ JST W5X
+ JMP W5H GO TO W5H
+W5T LDA AT
+ CAS K103
+ JMP W5F STRONG VARIABLE (IU = NON 0)
+ JMP W5T5
+ CAS K102 TEST FOR STG ABS ADDRESS
+ OCT 17400
+ JMP *+2
+ JMP W5F NO
+ LDA DP+4,1 TEST FOR PREFIX G
+ ANA *-4
+ SUB *-5
+ SZE
+ JMP W5F STRONG VARIABLE (IU = NON 0)
+W5T5 LDA IU
+ SZE
+ JMP W5P
+ JST ER00
+ BCI 1,US
+W5X DAC **
+ LRL 16
+ STA DF
+ IAB
+ JST OA00 OUTPUT ABS
+ JST STXA REST "A"
+ JMP* W5X EXIT
+W5Z1 EQU K100 000377
+W5Z2 EQU K122 040000
+W5Z3 EQU K116 177400
+*
+*
+*
+*
+*
+* ************************
+* *INPUT CHAR/OUTPUT PACK*
+* ************************
+PO00 DAC **
+ JST CH00 INPUT CHAR
+ JST OK00 OUTPUT PACK
+ JMP* PO00 RETURN
+* ************************
+* *TRANS HOLLERITH STRING*
+* ************************
+* FORM HOLLERITH STRING, CHARACTER COUNT IN ID 0N
+* ENTRY. C/R WILL ALSO TERMINATE STRING.
+HS00 DAC **
+HS10 JST IC00 INPUT 1 CHARACTER
+ CAS CRET CHECK FOR CHAR = C/R
+ JMP *+2
+ JMP HS15 HOLLERITH STRING EXTENDS PAST END 0F CARD
+ JST OK00 OUTPUT PACK THE CHARACTER
+ LDA ID
+ SUB K101 REDUCE CHARACTER COUNT BY 1
+ STA ID
+ SZE
+ JMP HS10 INPUT MORE CHARACTERS
+ JMP* HS00
+HS15 JST ER00
+ BCI 1,HS HOLLERITH STRING EXTENDS OVER STATEMENT
+*
+*
+* **********
+* *DO INPUT*
+* **********
+* SET UP DO TABLE ENTRIES.
+DP00 DAC **
+ LDA D D = D+5
+ ADD K105 IFLG = NON-ZERO
+ STA IFLG
+ STA D
+ ADD DO I = D0+D
+ STA I
+ JST STXI
+ LDA A DP (1-4) = (B)
+ STA DP-2,1 DP (1-2) = A
+ IAB
+ STA DP-4,1
+ JST IV00 INPUT INT VAR/CON
+ LDA K134 = ,
+ JST TS00 COMMA TEST
+ JST STXI
+ LDA A
+ STA DP,1 DP(I) = INITIAL VALUE POINTER
+ JST IV00 INPUT INT VAR/CON
+ JST STXI
+ LDA A
+ STA DP-1,1 DP (I-1) = A - FINAL VALUE POINTER
+ LDA TC
+ SUB K134 = ,
+ SZE IF THIRD TERM
+ JMP DP20
+ JST IV00 READ AND ASSIGN,
+DP10 JST STXI
+ LDA A
+ STA DP-3,1 DP(I-3) = INCREMENT POINTER
+ CRA
+ STA IFLG CLEAR IFLAG
+ JMP* DP00 EXIT
+DP20 LDA K101
+ STA ID THIRD TERM = 1
+ JST AI00 ASSIGN CONSTANT
+ JMP DP10
+* ***************
+* *DO INITIALIZE*
+* ***************
+* GENERATE DO INITIALIZATION CODE.
+DS00 DAC **
+ JST STXI ESTABLISH I
+ LDA DP,1 A = DP (I)
+ STA A
+ LDA K200
+ JST DS20 LOAD - LDA INITIAL VALUE
+ LDA DP-2,1
+ STA A A = DP (I-2)
+ LDA RPL
+ STA DP,1 SET RETURN ADDRESS INTO DP(I)
+ LDA K202
+ JST DS20 STORE - STA VARIABLE NAME
+ JMP* DS00
+* OUTPUT OA SUBROUTINE
+DS20 DAC **
+ IAB
+ LLL 16 SET B = 0
+ JST OB00 OUTPUT OA
+ JST STXI RESTORE I
+ JMP* DS20 RETURN
+*
+DS90 PZE 0
+*
+* ****************
+* *DO TERMINATION*
+* ****************
+* GENERATE DO TERMINATION CODE.
+DQ00 DAC **
+ JST STXI
+ LDA DP-2,1
+ STA A
+ LDA K200
+ JST DS20 OUTPUT LDA VARIABLE NAME
+ LDA DP-3,1
+ STA A
+ LDA K203
+ JST DS20 OUTPUT ADD INCREMENT
+ LDA DP-1,1
+ STA A
+ LDA OMK9
+ JST DS20 OUTPUT CAS FINAL VALUE
+ CRA
+ STA A
+ LDA RPL
+ ADD K103
+ STA AF
+ LDA DP,1
+ STA DS90
+ LDA OMI5 JUMP *+3
+ JST OR00 OUTPUT REL
+ LDA DS90
+ STA AF
+ LDA OMI5 JMP RPL (SAVED) - POINTS TO 'STA' INST.
+ JST OR00 OUTPUT REL
+ LDA OMI5 OUTPUT JMP RPL (SAVED)
+ JST OR00 OUTPUT REL
+ JMP* DQ00
+* ************
+* *EXPRESSION*
+* ************
+* THE RESULTANT OUTPUT IS A BUILT UP AOIN
+* TABLE THAT IS FURTHER PROCESSED BY SCAN.
+T0EX PZE 0
+EXT0 EQU T0EX
+T1EX PZE 0
+T2EX PZE 0
+T3EX PZE 0
+T5EX PZE 0
+T6EX PZE 0
+EXT7 PZE 0
+T9EX PZE 0
+EX00 DAC **
+ STA F F = (A)
+ LDA A SAVE POINTER TO FIRST VARIABLE
+ STA TRFA FOR LATER POSSIBLE TRACING
+ LDA D I = D+D0+10
+ ADD DO
+ ADD K125 =8
+ STA I
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ CRA
+ STA EXT0 T0 = 0
+ STA B B = 0
+ STA EXT7 T7 = 0
+ ADD EX92+12
+ LGL 9 O(1-2) = '='
+ STA DP-1,1 0 (I) = 0
+ CMA
+ STA IFLG IFLM NOT 0
+ LDA L0
+ STA DP-2,1 O(I-2) = L0
+EX10 JST STXI
+ CRA
+ STA T1EX T1 = 0
+ STA DP,1 AOIN(I) = T(1) = 0
+ STA DP+1,1
+ LDA IM IF IM NOT ZERO,
+ SZE
+ JMP EX50 GO TO EX50
+ LDA K106
+ TCA
+ STA 0
+* PERFORM TABLE SEARCH
+EX11 LDA TC GO TO ROUTINE ACCORDING
+ SUB EX90+6,1 TO TC.
+ SNZ IF NO MATCH, ERROR
+ JMP EXI1
+ IRS XR
+ JMP EX11
+ JST STXI
+ LDA LIBF SPECIAL LIBRARY FLAG
+ SZE
+ JMP EX39
+ JMP EX95 ERROR CONDITION
+EXI1 LDA EX91+6,1
+ STA 0
+ JMP 0,1 PROCESS LEADING OPERATOR
+* SPECIAL OPERATOR FLAG SET WHEN COMPILING THE FORTRAN
+* LIBRARY IN WHICH CASE THE OPERATIONS ( A= ) AND
+* ( =A ) ARE REQUIRED, THIS LOGIC WILL ALLOW THESE
+* TO BE PROCESSED WITHOUT GIVING AN ERROR MESSAGE IF THE
+* SPECIAL LIBRARY FLAG, (LIBF) IS SET TO NON-ZERO,
+*
+EX12 LDA B TC = (
+ ADD K109 B = B+16
+ STA B SXF = NON-ZERO
+ STA SXF
+EX14 JST II00 INPUT ITEM
+ JST STXI
+ JMP EX10 GO TO EX10
+EX16 JST STXI TC = *
+ LDA TC
+ LGL 9 OI (I-2) = *, B+13
+ ADD B
+ ADD K129
+ ERA DP-1,1
+ SSP
+ SNZ
+ JMP *+3
+ JST ER00 NO, CONSTR ERROR
+ BCI 1,PW * NOT PRECEDED BY ANOTHER *
+ LDA K109 (E = '20)
+ LGL 9
+ IMA DP-1,1
+ ANA K118 ='777
+ ADD K101
+ ERA DP-1,1 CHAJNE * TO **
+ STA DP-1,1
+ JMP EX14 GO TO EX14
+EX18 LDA K102 =2
+ STA TC SET TC TO -
+ LDA K125 =8
+ STA T1EX T1 = 8
+ JST STXI
+ LDA DP-1,1
+ ANA K118
+ SUB B 8 .GT. I (I-2) -B
+ SUB T1EX
+ SPL
+ JMP *+3
+EX19 JST ER00 NO, ERROR
+ BCI 1,NT LOGICAL .NOT. NOT A UNARY OPERATOR
+EX20 LDA T0EX YES
+ SZE T (0) = 0
+ JMP EX34
+EX22 LDA B YES,
+ ADD F B + + (5) .GT. 0
+ SPL NO, ERROR
+ JMP EX96
+EX24 JST STXI
+ LDA TC
+ LGL 9
+ ADD T1EX
+ ADD B
+ STA DP+1,1 OI(I) = TC , T1+B
+ JST EX99 DATA POOL CHECK
+ JMP EX14
+EX26 JST STXI
+ LDA DP-1,1
+ ANA K118 IF I (I-2) .LT. B
+ CAS B
+ JMP EX97 ERROR-----MULTIPLE + OR - SIGNS
+ NOP
+EX30 LDA K131 SET INDEX TO
+ STA 0 SEARCH OPERATOR TABLE FOR TRAILING
+EX31 LDA EX92+14,1 OPERATOR AFTER HAVING ENCOUNTERED AN
+ SUB TC ITEM 0R A NEGATE,
+ SZE
+ JMP EX32
+ LDA EX93+14,1
+ STA *+3
+ JST STXI
+ JMP* *+1
+ DAC **
+EX32 IRS XR CONTROL OPERATOR LOOP
+ JMP EX31 CONTINUE
+EX34 LDA B IF B = 0
+ SUB EXT7
+ SZE
+ JMP EX40 NO, GO TO EX40
+ LDA T0EX IF T (0) = 0
+ SZE
+ JMP EX38 NO, GO TO EX38
+EX35 CRA
+ STA IFLG IFLG = 0
+ LDA F
+ AOA
+ SMI F . GE. -1
+ JMP EX36 YES
+ JMP* EX00 RETURN - NO
+EX36 JST CA00 SCAN
+ JST OT00 OUTPUT TRIADS
+ JMP* EX00 RETURN
+EX38 JST STXI
+ LDA B
+ SUB K109
+ STA B
+ LDA K103
+ STA MFL
+ LDA T0EX
+ LGL 9 O (I) = T (0)
+ ADD B I (I) = B+9
+ ADD K124 I = I+2
+ STA DP+1,1
+ JST EX99 DATA POOL CHECK
+ CRA
+ STA T0EX T0 = 0
+ STA EXT7 T7 = 0
+EX39 LDA L0
+ STA A A = L0
+ STA IM IM NOT EQ 0
+ JMP EX10
+EX40 LDA TC TC 0 ,
+ CAS K5 ='254 (,) IN BCD MODE
+ JMP *+2
+ JMP EX41
+ SUB K134 =17
+ SZE
+ JMP EX44 NO, GO TO EX44
+EX41 LDA I
+EX42 SUB K102
+ STA XR B VS. I (J)
+ LDA DP+1,1
+ ANA K118
+ CAS B
+ JMP *+3
+ JMP EX24 EQUAL, GO TO EX24
+ JMP* EX00 LESS, RETURN
+ LDA XR GREATER, REPEAT LOOP
+ JMP EX42
+EX44 JST IP00 ) - INPUT OPERATOR
+ JMP EX30 GO TO EX30
+EX46 LDA* A
+ STA T6EX IF O1(O1(A)) = L(0)
+ LDA* T6EX
+ CAS L0
+ JMP *+2
+ JMP EX34 GO TO EX34
+ STA O2 O2 = L0
+EX48 JST ET00 ENTER TRIAD
+ JMP EX34
+EX50 JST STXI
+ LDA A A(I) = A
+ STA DP,1
+ LDA IU IU = SUB OR ARR
+ SLN
+ JMP EX30 NO, GO TO EX30
+ LDA TC
+ SUB K17 TC = (
+ SZE
+ JMP EX76 NO, GO TO EX76
+ LDA B YES, B = B+16
+ ADD K109
+ STA B
+ LDA IU IU = ARR
+ SUB K103
+ SZE
+ JMP EX75 NO, GO TO EX75
+ CRA
+ STA DP,1 A(I) = 0
+ STA X4 X4 = 0
+ STA T3EX T3 = 0
+ STA K T5 = A
+ LDA D0
+ STA T9EX T9 = D0
+ LDA A
+ STA T5EX T5 = A
+ LDA AT
+ SUB K105 AT = DUM
+ SZE
+ JMP EX74 NO, GO TO EX74
+ CRA
+ STA T2EX YES, T (0) = 0
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ LDA A
+ STA DP,1 A(I) = A
+ LDA K132 OI (I) = A, 11
+ LGL 9
+ ADD K124
+ STA DP+1,1 I=9
+EX54 LDA D0 IF D0 = 1, GO TO EX56
+ SUB K101
+ SNZ
+ JMP EX56
+ JST EX99 DATA POOL CHECK
+ JMP *+2
+EX55 IRS K K = K+1
+ LDA K
+ STA XR
+ LDA X,1
+ STA T6EX T6 = X (K)
+ JST STXI
+ LDA T6EX
+ STA DP,1 O(I) = *
+ LDA K103 I (I) = T3+13
+ LGL 9 T3 = T3+16
+ ADD T3EX A (A) = T6
+ ADD K129 =13
+ STA DP+1,1
+ ANA K118
+ ADD K103
+ STA T3EX T3 = A(A)
+EX56 JST IV00 INPUT INTEGER VARIABLE
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ LDA A A(I) = A
+ STA DP,1
+ LDA NT
+ SZE
+ JMP EX68 CONSTANT ENCOUNTERED
+ JST UC00 UNINPUT COLUMN
+ JST DN00 INPUT DO NOT ASSIGN
+ SNZ
+ JMP EX57 IM = 0
+ SUB K101
+ SNZ
+ JMP EX57 IM * INTEGEH
+ JST ER00
+ BCI 1,SU SUBSCRIPT INCREMENTER NOT A CONSTANT
+EX57 JST STXI
+ LDA K101
+ LGL 9
+ ADD T3EX
+ ADD K127
+ STA DP+1,1 O(1) = +, I(I) = T3+11
+ JST EX99 DATA POOL CHECK
+EX58 LDA T9EX
+ STA D0 RESET D(0)
+ LDA ID SUBSCRIPT SIZE
+ SUB K101 ID = ID-1
+ STA ID
+ SNZ IF ZERO, GO TO EX60
+ JMP EX60
+ LDA K
+ STA 0
+ LDA D0,1 D(K) = 0
+ SNZ
+ JMP EX67 YES - (DUMMY DIMENSION)
+ IAB
+ LDA ID
+ JST IM00
+ ADD T2EX
+ STA T2EX T2 = T2+ID*D(K)
+EX60 LDA T9EX
+ STA D0 RESET D(0)
+ LDA K
+ STA 0
+ LDA X+2,1 X(K+2) = 0
+ SNZ
+ JMP EX62 YES - FINISHED
+ LDA K134 =17
+ JST TS00 COMMA TEST
+ LDA D0+1,1
+ IAB
+ LDA D0,1
+ JST IM00
+ STA D0+1,1 D(K+1) = D(K+1)*D(K)
+ JMP EX55
+EX62 JST STXI
+ LDA DP-1,1 DOES O(--2) = *
+ SSP
+ LGR 9
+ CAS K103
+ JMP *+2
+ JMP EX66 YES.
+ SNZ NO.
+ JMP EX64 O(I-2) = 0 - YES
+ CAS K132 DOES O(I-2) = A
+ JMP EX63
+ JMP *+2 YES
+ JMP EX63
+ LDA T2EX IS T2 = 0
+ SNZ
+ JMP EX65 YES (DUMMY ARRAY (1,1,1))
+EX63 LDA K101
+ STA DP-1,1 01(I-2) = 1
+ LDA T2EX A(I) = T2
+ STA DP,1
+ LDA K137 0='X' ('24), I=2
+ STA DP+1,1
+ CRA
+ STA DP+3,1 O1(1+2) = 0
+ LDA T5EX
+ STA DP+2,1 A(I+2) = T5
+ JST EX99 DATA POOL CHECK
+ JST CA00 SCAN
+ LDA O1
+ STA A A = O1
+ JST STXA
+ LDA DP+2,1 S(A) = NON-ZERO
+ SSM
+ STA DP+2,1 S(A) = 1
+ JMP EX44
+EX64 LDA L0
+ STA DP,1 A(I) = L0
+ JST EX99 DATA POOL CHECK
+ JST STXI
+ JMP EX63
+EX65 LDA I
+ SUB K104
+ STA I I = I-4
+ LDA T5EX
+ STA DP-4,1 A (I) = T5
+ JMP EX44
+EX66 LDA I
+ SUB K102
+ STA I I = I-2
+ JMP EX62 ASSIGN INT CONSTANT
+EX67 JST AI00
+ JST STXI SET XR TO I
+ LDA A
+ STA DP,1 A(I) = A
+ LDA K101
+ LGL 9
+ ADD T3EX
+ ADD K127
+ STA DP+1,1 OI(I) = +, T3+11
+ JST EX99 DATA POOL CHECK
+ JMP EX60
+EX68 LDA TC IS TC
+ CAS K103 = *
+ JMP *+2
+ JMP *+2
+ JMP EX58 NO
+ LGL 9
+ ADD T3EX
+ ADD K129 =13
+ STA DP+1,1 OI(I) = *, T3+13
+ JST IR00 INPUT INTEGER VAR/CON
+ JMP EX56+1
+EX69 CRA SET LISTING FOR OCTAL ADDR
+ STA A
+ LDA OMI5 JMP 0 INSTRUCTION
+ STA DF SET LISTING FOR SYMBOLIC A INSTR,
+ JST OA00 OUTPUT ABSOLUTE
+ LDA RPL
+ STA O2
+ LDA K138
+ STA P P = H
+ JST ET00 ENTER TRIAD
+ JST HS00 TRANSFER HOLLERITH STRING
+ LDA CRET (A) = C/R
+ JST OK00 OUTPUT PACK
+ CRA
+ STA 0 SET LISTING FOR OCTAL ADDR.
+ STA A SET LISTING FOR OCTAL ADDR.
+ LDA O2
+ SUB K101
+ JST OS00 OUTPUT STRING RPL-1
+ JST CH00 INPUT CHARACTER
+ JST FN00
+ JST STXI RESET INDEX TO I
+ LDA L
+ STA DP,1 A(I) = L
+ JMP EX76
+EX74 LDA AF
+ STA T2EX T2 = AF
+ JMP EX54 GO TO EX54
+EX75 LDA K134
+ STA TC TC = ,
+ JMP EX24 GO TO EX24
+EX76 LDA DP-1,1
+ LGR 9
+ ANA K133
+ SUB K134
+ SNZ
+ JMP EX34 WITHIN AN ARGUMENT LIST
+ JST ER00
+ BCI 1,AG SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST
+EX78 LDA K127
+EX79 STA T1EX T (1) = 11
+ JMP EX22
+EX80 LDA K129 T (1) = 13
+ JMP EX79
+EX81 LDA K106
+ STA T1EX T (1) = 6
+ JMP EX20
+EX82 LDA K104 T (1) = 4
+ JMP EX81+1
+EX83 LDA T0EX T (0) =0
+ SZE
+ JMP EX84
+ LDA TC YES,
+ STA T0EX T (0) = TC
+ LDA EX92+1
+ STA TC TC = -
+ LDA B
+ ADD K109
+ STA B
+ STA EXT7
+ LDA *+2
+ JMP EX79
+ DEC -5
+EX84 JST ER00 ERROR
+ BCI 1,RL MORE THAN 1 RELATIONAL OPERATOR
+EX85 LDA F
+ ADD K102 T (5) = T (5) +2 = B = 0
+ STA F
+ ADD B
+ SNZ
+ JMP EX24
+ JST ER00 ERROR
+ BCI 1,EQ MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF =
+EX90 OCT 250 (
+ OCT 3 *
+ OCT 5 NOT
+ OCT 1 +
+ OCT 2 -
+ OCT 310 H
+EX91 DAC EX12 (
+ DAC EX16 *
+ DAC EX18 NOT
+ DAC EX26 +
+ DAC EX26 -
+ DAC EX69 H
+EX92 OCT 1 +
+ OCT 2 -
+ OCT 3 *
+ OCT 4 /
+ OCT 6 AND
+ OCT 7 OR
+ OCT 15 NE
+ OCT 12 EQ
+ OCT 14 GT
+ OCT 10 LT
+ OCT 13 GE
+ OCT 11 LE
+ OCT 16 =
+ OCT 16 = (ERROR)
+EX93 DAC EX78 +
+ DAC EX78
+ DAC EX80 *
+ DAC EX80 /
+ DAC EX81 AND
+ DAC EX82 OR
+ DAC EX83 NE
+ DAC EX83 EQ
+ DAC EX83 GT
+ DAC EX83 LT
+ DAC EX83 GE
+ DAC EX83 LE
+ DAC EX85 =
+ DAC EX34 NONE OF THESE
+EX95 JST ER00
+ BCI 1,OP MURE THAN ONE OPERATOR IN A ROW
+EX96 JST ER00 ERROR
+ BCI 1,PA OPERATOR MUST BE WITHIN PARENTHESES
+EX97 JST ER00 ERROR
+ BCI 1,UO MULTIPLE + OR - SIGNS NOT AS UNARY OPS
+* BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW
+EX99 DAC **
+ IRS I
+ IRS I
+ LDA I
+ AOA
+ CAS L
+ NOP
+ JMP AS50
+ JMP* EX99
+K133 OCT 77
+K130 DEC -6
+K141 DEC 33
+K PZE 0
+KM8 DEC -8
+*
+*
+*
+*
+* ******************
+* *SCAN *
+* *TRIAD SEARCH *
+* *TEMP STORE CHECK*
+* ******************
+T0CA PZE 0
+T1CA PZE 0
+T2CA PZE 0
+T9CA PZE 0
+* THE AOIN TABLE IS PROCESSED FROM THE BOTTOM
+* UP AND ENTRIES ARE FORMED FOR INCLUSION
+* IN THE TRIAD TABLE, LEVELS ARE USED
+* TO CONTROL THE ORDER OF ENTRY INTO
+* THE TRIADS. SIGN CONTROL IS ALSO
+* ACCOMPLISHED IN THIS ROUTINE.
+CA00 DAC **
+ LDA L0
+ STA ACCP INDICATE EMPTY ACCUM
+CA04 JST STXI ESTABLISH I
+ STA T1CA T1 = I
+ LDA DP-1,1
+ ANA K118 IF I (I-2) = 0,
+* OR .LT. I (I)
+ STA T9CA
+ LDA DP+1,1
+ ANA K118
+ CAS T9CA
+ JMP CA08 GO TO CA08
+ NOP
+ LDA I
+ SUB K102
+ STA I I = I-2
+ STA 0
+CA08 LDA DP+3,1
+ ERA DP+1,1
+ STA T0CA
+ LDA DP+1,1
+ ANA K118
+ STA T2CA
+ LDA DP+1,1
+ SSP
+ LGR 9 P = O (I)
+ STA P
+ CAS K102 IF P IS NOT * OR /, GO TO CCA10
+ CAS K105
+ JMP CA10
+ JMP CA10
+ JMP CA14 GO T0 CA14
+CA10 LDA T0CA
+ SMI
+ JMP CA13
+ LDA KM8
+ IMA XR
+ IAB
+ LDA P
+ CAS CA90+8,1
+ JMP *+2
+ JMP *+4
+ IRS XR
+ JMP *-4
+ JMP CA45
+ LDA CA91+8,1
+ STA P
+ IAB
+ STA XR
+CA13 LDA K130
+ IMA XR
+ IAB
+ LDA P
+ CAS CA90+8,1
+ JMP *+2
+ JMP CA50
+ IRS XR
+ JMP *-4
+ IAB
+ STA XR
+ IAB
+ LDA DP+1,1
+ JMP *+2
+CA50 CRA
+ STA T0CA
+ IAB
+ STA XR
+CA14 LDA DP,1
+ STA O1 O1=A(I)
+ LDA DP+2,1
+ STA O2 O2 = A (I+2)
+ LDA T2CA
+ SNZ
+ JMP CA37 IF ZER0, GO TO CA37
+ LDA DP-1,1
+ SSP
+ LGR 9
+ STA T1CA
+ LDA DP-1,1
+ ANA K118 IF T2 .GT. I (I-2)
+ SUB T2CA
+ SPL
+ JMP CA18
+ SZE
+ JMP CA04
+ LDA O2
+ SUB ACCP
+ SZE
+ JMP CA04
+ LDA P
+ SUB K103
+ SMI
+ JMP CA39
+ LDA T1CA
+ SUB P
+ SZE
+ LDA K101 GO TO
+ ADD K101 P = - OR +
+ STA P
+CA18 LDA I
+ STA 0 J=I
+CA20 LDA DP+2,1
+ STA DP,1 AOIN(J) = AOIN(J+2)
+ LDA DP+3,1
+ STA DP+1,1
+ SSP
+ SNZ
+ JMP CA22
+ IRS XR J = J+2
+ IRS XR
+ JMP CA20
+CA22 JST STXI
+ LDA DP+1,1
+ SSP IF O (I) = ,
+ LGR 9
+ CAS P
+ JMP CA24
+ CAS K134
+ JMP CA24
+ JMP CA30 GO TO CA30
+CA24 JST ST00 TRIAD SEARCH
+ LDA P
+ CAS K132 IF P = +,*, AND, OR
+ JMP CA28
+ JMP CA37 GO TO CA37
+ CAS K107
+ JMP CA28 ELSE, GO TO CA26
+ JMP CA37
+ CAS K106
+ JMP CA28
+ JMP CA37
+ CAS K103
+ JMP CA28
+ JMP CA37
+ CAS K101
+ JMP CA26
+*
+*
+*
+ JMP CA37
+CA26 CAS K102
+ JMP *+2 IF P = -
+ JMP CA35 GO TO
+CA28 LDA O1
+ JST TC00 TEMP STORE CHECK
+CA30 LDA O2
+ JST TC00 TEMP STORE CHECK
+CA31 JST ET00 ENTER TRIAD
+CA32 JST STXI
+ LDA O1
+ STA DP,1
+ LDA DP+1,1
+ LRL 15
+ LDA T0CA
+ LGR 15
+ LLL 15
+ STA DP+1,1
+ LDA T2CA IF T2 NOT ZERO,
+ SZE
+ JMP CA04 GO TU CA04
+ JMP* CA00 ELSE, RETURN
+CA35 LDA T0CA
+ ERA ='100000
+ STA T0CA
+CA37 LDA O2
+ IMA O1 O1 * = O2
+ STA O2
+ SNZ IF 02 = 0,
+ JMP CA32 GO TO CA32
+*
+*
+*
+ JST ST00 TRIAD SEARCH
+ LDA T0CA
+ SMI
+ JMP CA28 GO TO CA28
+ LDA P
+ JMP CA26 ELSE, GO TO CA26
+CA39 SUB K128
+ SNZ IF P = , OR
+ JMP CA04
+ LDA T1CA
+ SUB K104
+ SZE ELSE,
+ JMP CA18 GO TO CA18
+ JMP CA04
+CA45 LDA T1CA
+ STA I I = T1
+ STA T2CA
+ CRA
+ STA T0CA * * * * * * * * * * *
+ STA O2 O2 = C = 0
+ SUB K110 P = C
+ STA P
+ JMP CA24 GO TO CA24
+* IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES
+* ANY TRIAD TABLE ENTRY, EXIT WITH THE
+* POINTER VALUE OF THE MATCHING ENTRY
+* (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT
+* SUBEXPRESSION CALCULATIONS.
+ST00 DAC ** TRIAD SEARCH
+ LDA F
+ ADD K103
+ SZE
+ JMP ST10 GO TO ST10
+ST05 LDA P ELSE, IF P = X
+ SUB K139
+ SNZ
+ JMP CA31 GO TO CA31
+ LDA O1 ELSE, IF 01=ACCP
+ SUB ACCP
+ SNZ
+ JMP CA30 GO TO CA30
+ JMP* ST00 ELSE, RETURN
+ST10 LDA L0
+ STA XR
+ST20 LDA XR
+ SUB K103
+ STA XR J = J-2
+ SUB L IF J .LT. L
+ SPL
+ JMP ST05 GO TO ST05
+ LDA O2
+ SUB DP,1 IF O1/P/O2 .NE. O1/P/O2(J)
+ SZE
+ JMP ST20 GO TO ST20
+ LDA DP+2,1
+ SSP EXTRACT OFF STORE BIT
+ SUB P
+ SZE
+ JMP ST20
+ LDA O1
+ SUB DP+1,1
+ SZE
+ JMP ST20 O1 = J
+ LDA XR
+ STA O1
+ JST STXI ESTABLISH I
+ JMP CA32 GO T0 CA32
+* IF J IS A REFERENCE TO A TRIAD , THE TEMP
+* STORE BIT 0F THE REFERENCED TRIAD IS SET.)
+TC00 DAC ** TEMP STORE CHECK
+ STA XR
+ LDA ABAR
+ SUB XR
+ SMI IS J .GR. ABAR
+ JMP* TC00 NO.
+ LDA DP+2,1 YES.
+ SSM
+ STA DP+2,1 S(J) = 1
+ JMP* TC00
+CA90 OCT 1,2,11,10,13,14,12,15
+CA91 OCT 2,1,13,14,11,10,12,15
+*
+*
+* *************
+* *ENTER TRIAD*
+* *************
+* STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY
+* LOCATION.
+ET00 DAC **
+ JST SAV
+ LDA L
+ SUB K103 =3
+ STA L L=L-3
+ STA ACCP SET ACCUM PTR TO LAST TRIAD ENTRY
+ STA 0 J=L
+ LDA P
+ STA DP+2,1 P(J) = P
+ LDA O1
+ STA DP+1,1 O1(J) = O1
+ LDA O2
+ STA DP,1 O2(J) = O2
+ LDA 0
+ STA O1 O1=J
+ JST RST
+ JMP* ET00
+ACCP DAC ** ACCUM POINTER
+*
+*
+SFTB BSS 36 SUBFUNCTION TABLE
+* **************************
+* *GENERATE SUBPRO ENTRANCE*
+* **************************
+* OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE
+* CALL TO ARGUMENT ADDRESS TRANSFER.
+T0GE PZE 0
+GE00 DAC **
+ CRA
+ STA T0GE
+ LDA K17 ( TEST
+ JST TS00
+GE10 JST NA00 INPUT NAME
+ LDA I IFF I=0,
+ SNZ
+ JMP GE20 GO TO GE20
+ CAS K141
+ NOP
+ JMP GE30 MAKE ENTRY IN SFTB TABLE
+ ADD K103
+ STA I IF FULL, GO TO GE30
+ JST STXA SET XR TO A
+ LDA DP,1
+ IAB
+ JST STXI ESTABLISH I
+ IAB
+ STA SFTB,1
+ JST STXA SET XR TO A
+ LDA DP+1,1
+ IAB
+ JST STXI SET XR TO I
+ IAB
+ STA SFTB+1,1
+ LDA A
+ STA SFTB+2,1
+ JST STXA SET XR TO A
+ CRA
+ STA DP+1,1 CLEAR OLD USACE
+GE20 LDA K105
+ IAB
+ LDA RPL
+ ADD T0GE
+ ADD K103 (B) = DUM
+ JST AF00 DEFINE AFT (A=RPL+T0+3)
+ IRS T0GE T0 = T0+1
+ LDA K134
+ SUB TC IF TC = ,
+ SNZ
+ JMP GE10 GO TO GE10
+ JST IP00 INPUT OPERATOR
+ CRA
+ STA DF
+ JST OA00 OUTPUT ABS (0)
+ LDA T0GE
+ STA ID ID = T0
+ LDA K69
+ STA NAMF+1 NAMF = AT
+ JST NF00 FILL IN REMAINING NAME
+ JST OL00 OUTPUT OBJECT LINK
+ LDA T0GE
+ TCA
+ STA T0GE
+ CRA
+ JST OA00 OUTPUT NUMBER OF ARGS
+ IRS T0GE OUTPUT SPACE FOR ARG. ADDR.
+ JMP *-3
+ JMP* GE00 RETURN
+GE30 JST ER00 CONSTR, ERROR
+ BCI 1,AE
+K69 BCI 1,AT AT
+*
+* ****************
+* *EXCHANGE LINKS*
+* ****************
+* CL SUBA IS INTERCHANGED WITH CL SUBF
+EL00 DAC **
+ JST STXA
+ LDA DP,1
+ STA EL90 CL (F) == CL (A)
+ LDA F
+ STA 0
+ JST EL40
+ JST STXA
+ JST EL40
+ JMP* EL00
+EL40 DAC **
+ LDA DP,1
+ IMA EL90
+ ANA K118
+ IMA DP,1
+ ANA K119
+ ADD DP,1
+ STA DP,1
+ JMP* EL40
+EL90 PZE 0
+*
+*
+* *****************
+* *NON COMMON TEST*
+* *****************
+NM00 DAC ** NON-COMMON TEST
+ LDA AT
+ SUB K104
+ SZE
+ JMP* NM00
+ JST ER00
+ BCI 1,CR ILLEGAL COMMON REFERENCE
+*
+*
+* **************************
+* *NON DUMMY OR SUBPRO TEST*
+* **************************
+ND00 DAC **
+ LDA AT TEST
+ SUB K105
+ SZE
+ JMP ND10
+ JST ER00
+ BCI 1,DA ILLEGAL USE OF A DUMMY ARGUMENT
+ JMP* ND00
+ND10 JST NS00
+ JMP* ND00
+*
+*
+* *****************
+* *INPUT SUBSCRIPT*
+* *****************
+SCT0 PZE 0
+SC00 DAC **
+ STA SCT0 T0 = (A)
+ CRA
+ STA NS
+ STA S2 NS = S2 = S3 = 0
+ STA S3
+ LDA K17 (-TEST
+ JST TS00
+SC10 LDA EBAR
+ SMI
+ JMP SC15 EBAR .GR. 0
+ JST XN00 EXAMINE NEXT CHAR,
+ SZE
+ JMP SC70 IF (A) NON ZERO,
+SC15 JST IG00 GO TO SC70
+ LDA SCT0 INPUT INTEGER
+ SZE
+ SPL
+ JMP SC60
+ LDA ID
+ SUB K101
+ JMP SC30
+SC60 JST AS00 ASSIGN ITEM
+SC20 LDA A S (NS+1) = A
+SC30 IAB
+ LDA SC90
+ ADD NS
+ STA SC91
+ IAB S(NS + 1) = A
+ STA* SC91
+ LDA NS
+ AOA
+ STA NS NS = NS + 1
+ SUB K103
+ SZE
+ JMP SC50 MORE SUBSCRIPTS PERMITTED
+SC40 JST IP00 )-INPUT OPERATOR
+ JMP* SC00 RETURN
+SC50 LDA TC
+ SUB K134
+ SZE
+ JMP SC40 TERMINATOR NOT A COMMA
+ JMP SC10 G0 TO SC10
+SC70 JST IR00 INPUT INT VARIABLE
+ LDA SCT0 CHECK FOR NON-DUMMY
+ SNZ VARIABLE DIMENSIONS
+ JMP SC20
+ LDA AT
+ SUB K105
+ SNZ
+ JMP SC20
+ JST ER00
+ BCI 1,VD ILLEGAL SYMBOLIC SUBSCRIPT
+SC90 DAC S1
+SC91 DAC **
+*
+*
+* ********************
+* *INPUT LIST ELEMENT*
+* ********************
+* IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT
+IL00 DAC **
+ JST NA00 INPUT NAME
+ LDA AT
+ SUB K105 NON-DUMMY TEST
+ SZE
+ JMP *+3
+ JST ER00 USAGE ERROR
+ BCI 1,DD DUMMY ITEM IN AN EQUIV, OR DATA LIST
+ LDA IU IF IU NOT ARR,
+ SUB K103
+ SZE
+ JMP IL30 GO TO IL30
+ LDA K103
+ JST SC00 INPUT SUBSCRIPTS
+ JST FA00 FETCH ASSIGNS
+ LDA ND IF ND = NS
+ SUB NS
+ SZE S1 = D* (S1 + D1* (S2+D2*S3)
+ JMP IL10 ELSE, GO TO IL10
+ LDA S3
+ IAB
+ LDA D2
+ JST IM00
+ ADD S2
+ IAB
+ LDA D1
+ JST IM00
+ ADD S1
+ IAB
+ LDA D0
+ JST IM00
+ STA S1
+ JMP* IL00 RETURN
+IL10 LDA NS IF NS NOT 1
+ SUB K101
+ SZE
+ JMP IL20 GO TO IL20
+ LDA S1 ELSE, 20
+ IAB S1 * D0*S1
+ LDA D0
+ JST IM00
+IL18 STA S1
+ JMP* IL00 RETURN
+IL20 JST ER00
+ BCI 1,ND WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT
+ JMP* IL00 RETURN
+IL30 JST TV00 TAG VARIABLE
+ CRA S1 = 0
+ JMP IL18 RETURN
+*
+*
+* ************
+* *FUNCTION *
+* *SUBROUTINE*
+* ************
+* IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER
+* FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS
+R1 LDA K101
+ STA SFF SFF = 1
+R2 LDA LSTF
+ SZE IF LSTF = 0
+ JMP R2A
+ JST ER00 ILLEGAL STATEMENT
+ BCI 1,FS NOT FIRST STATEMENT IN SUBPROGRAM
+R2A JST NA00 INPUT NAME
+ LDA A
+ STA SBF SBF = A
+ CRA ADDR=0, S/C CODE =0
+ JST ON00 OUTPUT NAME BLOCK TO THE LOADER
+ LDA MFL
+ SZE
+ JST DM00 DEFINE IM
+ LDA TC
+ SUB CRET IF IC NOT C/R
+ SZE
+ JMP R2C GO TO
+ LDA SFF IF SFF = 0
+ SNZ
+ JMP R2D GO TO R2D
+ JST ER00 ERROR
+ BCI 1,FA FUNCTION HAS NO ARGUMENTS
+R2C CRA
+ STA I I = 0
+ JST GE00 GENERATE SUBPROGRAM ENTRY
+ JMP A1 GO TO C/R TEST
+R2D CRA
+ JST OA00 OUTPUT ABS
+ JMP C6 GO TO CONTINUE
+*
+*
+* ******************
+* *INTEGER *
+* *REAL *
+* *DOUBLE PRECISION*
+* *COMPLEX *
+* *LOGICAL *
+* ******************
+* THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE
+* VALUE AND ANY ARRAY INFO IS PROCESSED
+A3 LDA K101 INTEGER
+ JMP A7A TMFL = INT
+A4 LDA K102 REAL
+ JMP A7A TMFL = REAL
+A5 LDA K106 DOUBLE PRECISION
+ JMP A7A TMFL = DBL
+A6 LDA K105 COMPLEX
+ JMP A7A TMFL = CPX
+A7 LDA K103 LOGICAL
+A7A STA MFL TMFL = LOG
+ LDA LSTF IF LSTF = 0, GO TO A7B (2)
+ SNZ
+ JMP A7B ELSE,
+ LDA CC SAVE CC
+ STA A790
+ CRA
+ STA ICSW
+ JST DN00 INPUT DNA
+ LDA A790 RESTORE CC
+ STA CC
+ STA ICSW ICSW = IPL
+ LDA DFL IF DFL NOT = 0, GO TO A7B
+ SZE
+ JMP A7B
+ LDA TID IF ID = FUNCTI,
+ SUB A7K GO TO A9
+ SNZ SKIP IF NOT 'FUNCTION'
+ JMP A9 FUNCTION PROCESSOR
+A7A5 JST ER00 CONSTRUCTION ERROR
+ BCI 1,TF 'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST
+A7K BCI 1,FU CONSTANT FOR 'FUNCTION' CHECK
+A7B JST NA00 INPUT NAME
+ LDA MFL
+ JST DM00 DEFINE IM
+ JMP B7 GO TO INPUT DIMENSION
+A790 PZE 0
+*
+*
+* - B2 EXTERNAL
+* TAGS NAME AS SUBPROGRAM
+B2 JST NA00 EXTERNAL, INPUT NAME
+ JST TG00 TAG SUBPROGRAM
+ JMP B1 GO TO , OR C/R TEST
+*
+*
+* *****************
+* *DIMENSION *
+* *INPUT DIMENSION*
+* *****************
+* PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL
+* ARRAY POINTER ITEM
+B3T0 PZE 0
+B3T1 PZE 0
+B3T2 PZE 0
+B3T3 PZE 0
+B3 JST NA00
+B3A LDA AT IF AT = DUM
+ SUB K105 (A) = 0
+ SZE ELSE (A) = .LT. 0
+ SSM
+B3B STA B3T0 T0 = (A)
+ LDA AF
+ STA B3T3 T3 = AF
+ LDA A
+ STA B3T1 T1 = A
+ LDA AT TEST FOR AT=DUMMY
+ SUB K105 =5
+ SZE SKIP NO-USAGE TEST IF DUMMY
+ JST NU00 NO USAGE TEST
+ JST STXA
+ LDA DP+1,1 IU (A) = ARR
+ LRL 14
+ LDA K103
+ LLL 14
+ STA DP+1,1
+ LDA B3T0 (A) = T0
+ JST SC00 INPUT SUBSCRIPT
+ LDA S1
+ STA ID
+ LDA S2 PLACE SUBSCRIPTS IN ID
+ STA ID+1
+ LDA S3
+ STA ID+2
+ LDA NS (A) = 0, B = NS
+ LRL 16
+ JST AA00 ASSIGN SPECIAL.
+ JST STXA
+ LDA DP+1,1
+ LLR 2
+ LDA B3T3
+ LGL 2
+ LRR 2
+ STA DP+1,1 DEFINE GF T0 GF(A)
+ LDA A
+ STA B3T2 T2 = A
+ LDA B3T1
+ STA A A = T1
+ JST STXA
+ LDA DP+1,1
+ LLR 2
+ LDA B3T2
+ LGL 2
+ LRR 2
+ STA DP+1,1 DEFINE GF TO GF(A)
+B3D LDA TC
+ SUB K104 IF TC NOT SLASH
+ SZE
+ JMP B1 GO TO ,-C/R TEST
+ LDA A9T2 IF SIDSW = COMMON-4
+ SUB B4Z9
+ SZE GO T0 B4 (COMMON-0)
+ JMP B1 ELSE, GO TO ,-C/R TEST
+ JMP B40
+B7 LDA TC IF TC = (
+ SUB K17
+ SZE
+ JMP B3D
+ JMP B3A
+*
+*
+* ********
+* *COMMON*
+* ********
+* INPUT BLOCK NAMES AND LINK THEM WITH THE
+* FOLLOWING VAR/ARRAY NAMES, BLOCK NAMES
+* ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS
+B4 LDA K81
+ STA ID
+ STA ID+1
+ STA ID+2
+ LDA B4Z9 SET SWITCH IN INPUT DIMENSION
+ STA A9T2
+ JST CH00 INPUT CHAR
+ SUB K9 IF NOT SLASH
+ SZE GO TO
+ JMP B4E
+B40 JST DN00 INPUT DNA
+ LDA K104 SLASH TEST
+ JST TS00
+B4B LRL 32
+ LDA K101 (A) = SUB, (B) = 0
+ JST AA00 ASSIGN SPECIAL
+ LDA CFL
+ SNZ
+ LDA A
+ STA CFL
+ LDA A
+ STA F
+ JST FL00 FETCH LINK
+ SZE
+ JMP B4D
+ LDA CFL
+ STA 0
+ LDA DP+1,1 GF(CFL)
+ IMA A
+ STA 0 INDEX = A
+ IMA A
+ STA DP+1,1 GF(A) = GF(CFL)
+ LDA CFL
+ STA 0 INDEX = CFL
+ LDA A
+ ADD K122 ='040000
+ STA DP+1,1 GF(CFL) = A
+B4D JST NA00 INPUT NAME
+ JST ND00 NON DUMMY/SUBPROG TEST
+ JST NM00 NON-COMMON TEST
+ JST EL00 EXCHANGE LINKS
+ LDA DP,1
+ ANA B4F ='107777
+ ADD K122 AT(A) = COM (='040000)
+ STA DP,1
+ JMP B7
+B4E JST UC00 UNINPUT COLUMN
+ JMP B4B
+B4Z9 DAC B4D GO TO INPUT DIMENSION
+B4F OCT 107777 EXTRACT MASK TO STRIP OFF AT FIELD
+*
+*
+* *************
+* *EQUIVALENCE*
+* *************
+* STORE EQUIV INFO IN THE DATA POOL FOR LATER
+* PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP)
+B5 LDA E0 L = NEXT WORD IN EQUIVALENCE TABLE
+ STA I I=L
+ SUB K101 (=1)
+ STA E0 L=L-1
+ SUB ABAR
+ SMI
+ JMP *+3
+ JST ER00 DATA POOL FULL
+ BCI 1,MO MEMORY OVERFLOW
+ JST STXI ESTABLISH I
+ CRA
+ STA DP,1 DP (I) = 0
+B5B JST CH00
+ LDA DP,1 INPUT CHAR
+ SZE
+ JMP B5D
+ LDA TC PUT IN FIRST CHARACTER
+ LGL 8 PACK INTO DP (I)
+B5C STA DP,1
+ LDA TC
+ SUB CRET
+ SNZ
+ JMP C6 CHARACTER E C/R - EXIT
+ LDA DP,1
+ ANA K100
+ SNZ
+ JMP B5B WORD NOT FULL
+ JMP B5 OBTAIN NEW WORD
+B5D LDA TC PUT IN SECOND CHARACTER
+ ERA DP,1
+ JMP B5C
+*
+*
+* *********************
+* *RELATE COMMON ITEMS*
+* *********************
+* ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED
+* AND THEIR INVERSE OFFSETS CALCULATED. THESE
+* WILL BE INVERTED LATER TO GIVE TRUE
+* POSITION IN THE BLOCK.
+C2T0 PZE 0
+C2 LDA CFL
+ STA A A = F = CFL
+C2A CRA
+ STA C2T0 T0 = 0
+ LDA A
+ STA F F = A
+C2B JST FL00 FETCH LINK
+ SNZ
+ JMP C2D
+ LDA D0
+ ADD C2T0 T0 = T0 + D0
+ STA C2T0
+ JST DA00 DEFINE ADDRESS FIELD
+ JMP C2B
+C2D JST FL00 FETCH LINK
+ SZE
+ JMP C2F
+ LDA AF
+ STA A A = AF
+ SUB CFL
+ SZE
+ JMP C2A AF = CFL. NO
+ JMP C3 YES - GROUP EQUIVALENCE
+C2F LDA C2T0
+ SUB AF (A) = T0 - AF
+ JST DA00 DEFINE AF
+ LDA IU
+ SZE
+ JMP C2D
+ JST TV00 TAG VARIABLE
+ JMP C2D
+*
+*
+* *******************
+* *GROUP EQUIVALENCE*
+* *******************
+* THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON
+* USAGE IS CHECKED TO SEE THAT THE ORIGIN
+* IS NOT MOVED AND THAT ONLY ONE ITEM IS
+* COMMON.
+C3T0 PZE 0
+C3T1 PZE 0
+C3T2 PZE 0
+C3T3 PZE 0
+C3T4 PZE 0
+C3T5 PZE 0
+T0C3 EQU C3T0
+T1C3 EQU C3T1
+T2C3 EQU C3T2
+T3C3 EQU C3T3
+T4C3 EQU C3T4
+C3 LDA E0
+ STA EBAR EBAR=E(0) = END OF EQUIVALENCE TABLE
+ LDA L0
+ STA E E=L(0) = START OF EUUIVALENCE TABLE
+ LDA CRET
+ STA TC
+C3B LDA E
+ STA EP E-PRIME = E
+ CRA
+ STA F I = 0
+ LDA K102 T4 = STR-ABS
+ STA C3T4
+ JST CH00 INPUT CHARACTER
+ LDA K17
+ JST TS00 (TEST
+C3D JST IL00 INPUT LIST ELEMENT
+ JST SAF
+ LDA S1
+ SUB AF TL = S1-AF
+ STA C3T1
+ LDA A T2 = A
+ STA C3T2
+C3F LDA F IF I=0, GO TO C3P
+ SNZ
+ JMP C3P
+C3G LDA F ELSE,
+ SUB A
+ SNZ IF A = I, GO TO C3N
+ JMP C3N
+C3H LDA AT
+ SUB K104 ELSE,
+ SNZ IF AT = COM, GO TO C3O
+ JMP C3O
+C3H2 LDA T1C3
+ ADD AF
+ STA T0C3 T(0) = AF +T (1)
+ LDA T4C3
+ SUB K104 IF T(4) = 0, GO T0 C3K
+ SZE
+ JMP C3K
+ LDA T3C3
+ SUB T0C3 ELSE,
+ STA T0C3 T(0) = T(3)-T(0)
+ SMI
+ JMP C3K
+ JST ER00 IF T(0)<0,
+ BCI 1,IC
+C3K LDA C3T4 IMPOSSIBLE COMMON EQUIVALENCING
+ IAB
+ LDA T0C3 AT (A) = COM
+ ALS 2
+ LGR 2
+ JST AF00
+ JST FL00 DEFINE AF
+ JST SAF FETCH LINK
+ LDA A
+ SUB C3T2
+ SZE IF A .NE. T (2),
+ JMP C3G GO TO C3G (5)
+*
+ JST EL00 EXCHANGE CL(A) == CL(I)
+C3M LDA TC EXCHANGE LINKS (CL(A) WITH CL(F) )
+ SUB K134 IF TC = ,
+ SNZ
+ JMP C3D ELSE,
+ JST IP00 )-INPUT OPERATOR
+ LDA TC
+ SUB K134 IF TC = , OR C/R
+ SNZ GO TO C3B (1)
+ JMP C3B
+ LDA TC
+ SUB CRET
+ SNZ
+ JMP C3B ELSE,
+ JST ER00
+ BCI 1,EC EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR
+ JMP C3B
+C3N LDA T1C3 IF T1 = 0, GO TO C3M
+ SNZ
+ JMP C3M
+C3N5 JST ER00 ERROR IMPOSSIBLE GROUP
+ BCI 1,IE IMPOSSIBLE EQUIVALENCE GROUPING
+C3O LDA S1
+ ADD AF
+ STA T3C3
+ LDA K104 =4
+ CAS T4C3
+ JMP *+2
+ JMP C3N5
+ STA T4C3
+ LDA F
+ CAS A IF A = F, GO TO C3M (B)
+ JMP *+2
+ JMP C3M ELSE,
+ STA A A = I
+ IMA C3T2
+ STA F
+ CRA T1 = 0
+ STA C3T1
+ JST FA00 FETCH ASSIGNS
+ JST SAF
+ JMP C3H2 GO TO C3H2
+C3P LDA A
+ STA F
+ JMP C3H
+*
+*
+* ***********************
+* *ASSIGN SPECIFICATIONS*
+* ***********************
+* NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER
+* COMMON BLOCKS ARE OUTPUT (WITH SIZE).
+C4T0 PZE 0
+C4T1 PZE 0
+C4B STA A A = 0
+C4C LDA A
+ ADD K105 I = A = A+5
+ STA A
+ STA F
+ CAS ABAR
+ JMP NP35 RETURN TO FIRST NON-SPEC CHECK (POINT 1)
+ NOP
+ JST FA00 ELSE, FETCH ASSIGN
+ LDA AT
+ SUB K102 IF AT = STR-ABS
+ SZE IU=VAR, OR ARR, AND
+ JMP C4C NT = 0
+ LDA IU GO TO C4E
+ SUB K102 ELSE, GO TO C4C
+ SPL
+ JMP C4C
+ LDA NT
+ SZE
+ JMP C4C
+C4E CRA
+ STA C4T0 T0 = 0. T1 =-MAX
+ SUB K111
+ STA C4T1
+ JST KT00 SET D(0) = NO. OF WORDS PER ITEM
+C4F JST SAF
+ CAS C4T0
+ STA C4T0
+ NOP
+ LDA D0
+ SUB AF (A) = D(0) - AF
+ CAS C4T1
+ STA C4T1
+ NOP
+ JST FL00 FETCH LINK ( (A)=A - F )
+ SZE
+ JMP C4F GO TO C4F
+ LDA RPL
+ ADD C4T0 RPL * RPL + T0 + TL
+ STA C4T0
+ ADD C4T1 TO = RPL-T1
+ STA RPL
+C4I JST SAF
+ LDA K101
+ IAB (B) = REL
+ LDA C4T0 (A) = TO-AF
+ SUB AF
+ JST AF00 DEFIME AFT
+ JST FL00 FETCH LINK
+ SZE IF (A) NOT ZERO,
+ JMP C4I NOT END OF EQUIVALENCE GROUP
+ JMP C4C CHECK NEXT ITEM IN ASSIGNMENI TABLE
+*
+C4L2 LDA FLT1 = LINK LOCATION TO COMMON BLOCK NAME
+ STA C4T1
+C4L3 LDA A
+ STA I SAVE A FOR LATER MODIFICATION
+ JST FL00 FETCH LINK
+ SNZ
+ JMP C4M END OF COMMON GROUP
+ JST STXI SET INDEX TO POINT TO CURRENT ITEM IN
+* COMMON GROUP.
+ LDA DP,1 SET CL FIELD TO POINT AT COMMON BLOCK
+* NAME.
+ ANA K119 ( = '177000)
+ ADD C4T1 (= LINK LOCATION OF COMMON BLOCK NAME)
+ STA DP,1
+ JMP C4L3 PROCESS NEXT ITEM IN COMMON BLOCK
+*
+C4 LDA CFL LOC, OF FIRST (BLANK) COMMON BLOCK
+ STA F
+C4L6 STA A
+ CRA
+ STA C4T0
+C4L JST FL00 FETCH LINK
+ SNZ
+ JMP C4L2 NO MORE ITEMS IN COMMON BLOCK
+ LDA D0 ELSE, IF TO .LT. DO+AF,
+ ADD AF
+ CAS C4T0 T0 = D0 + AF
+ STA C4T0
+ NOP
+ JMP C4L GO TO C4L
+C4M LDA AF
+ STA F I=AF
+ LDA C4T0 (A) = T0
+ JST DA00 DEFINE AF
+*....OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER
+ LDA AF LENGTH OF COMMON BLOCK
+ ANA K111 ='37777
+ ADD K122 ='40000 (S/C CODE = 1)
+ JST ON00 OUTPUT NAME BLOCK TO LOADER
+ LDA F
+ SUB CFL IF I = CFL
+ SNZ
+ JMP C4B
+ LDA F
+ JMP C4L6
+*
+SAF DAC **
+ LDA AF
+ LGL 2
+ ARS 2
+ STA AF
+ JMP* SAF
+*
+* **************************
+* *DATA STATEMENT PROCESSOR*
+* **************************
+* PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS
+* TO APPROPRIATE LOCATIONS. MODES MUST AGREE
+T0W4 PZE 0
+T1W4 PZE 0
+G PZE 0 LOWEST INDEX POINT IN LIST
+W4 LDA L0
+ STA I I=END OF DATA POOL
+W4B JST IL00 INPUT LIST ELEMENT
+ LDA AT D (0) = =WDS/ITEM
+ SUB K102
+ SNZ IF AT = 'STR-ABS'
+ JMP W4T GO TO
+ LDA I
+ STA 0
+ LDA S1 S1 * DEFLECTION IF AN ARRAY
+ ADD AF
+ STA DP,1 DP(E) = AF + S1
+W4C LDA A
+ STA DP-1,1 DP (E-1) = A
+ LDA I
+ SUB K102
+ STA I
+ STA G
+ LDA TC IF TC = ,
+ SUB K134
+ SNZ
+ JMP W4B GO TO W4B
+ LDA K104
+ JST TS00 TEST FOR SLASH TERMINATOR
+ LDA RPL
+ STA T1W4
+ LDA L0
+ STA I I= END OF DATA POOL
+W4E CRA
+ STA KPRM K' = KBAR = 0
+ STA KBAR
+W4F JST DN00 INPUT, DNA
+ LDA NT
+ SZE IF NT = 0
+ JMP W4G VARIABLE OR ARRAY
+ LDA TC LAST CHARACTER
+ CAS K17 ='250 ( =( )
+ JMP *+2
+ JMP *+3 START OF COMPLEX CONSTANT
+ JST ER00 ERROR
+ BCI 1,CN NON-CON DATA
+ STA SXF SET SXF TO NON-ZERO
+ JMP W4F FINISH INPUT OF COMPLEX CONSTANT
+W4G LDA KBAR MULTIPLY COUNT
+ SZE
+ JMP W4K GO TO W4K
+ LDA TC IF TC NOT *
+ SUB K103
+ SZE
+ JMP W4L
+ LDA ID
+ SUB K101
+ STA KBAR KBAR = ID-1
+ JST IT00 INTEGER TEST
+ JMP W4F
+W4K LDA KPRM IF K NOT ZERO
+ SZE
+ JMP W4M GO TO W4M
+W4L LDA KBAR
+ ALS 1 K ' = E-3* KBAR
+ TCA
+ ADD I
+ STA KPRM
+W4M JST STXI SET INDEX = I
+ LDA DP-1,1
+ STA A A = DP (E-1)
+ LDA IM
+ STA T0W4 TO = IM
+ JST FA00
+ LDA BDF IF BDF NOT ZERO
+ SZE
+ JMP W4S GO TO W4S
+ JST NM00 NON-COMMON TEST
+W4O JST STXI SET INDEX = I
+ LDA DP,1
+ STA RPL RPL = AF
+ JST FS00 FLUSH
+ CRA
+ STA DF DF = 0
+ LDA HOLF IS IT HOLLERITH DATA
+ SZE NO
+ JMP WHOW YES, GO TO OUTPUT IT
+ LDA D0
+ STA 0
+ JMP *,1 SWITCH ON NUMBER OF WORDS TO OUTPUT
+ JMP W405
+ JMP W403
+ JMP W404
+ LDA TID+2
+ JST OA00
+ LDA TID+1
+ JST OA00
+ LDA TIDB+2
+ JST OA00
+ LDA TIDB+1
+ JMP W406
+WHOW LDA D0 (A)=NO. OF WORDS PER ITEM
+ ALS 1 (A)=NO. OF CHARS, PER ITEM
+ STA NTID NTID=NO. OF CHARS. TO BE OUTPUT
+ SUB HOLF
+ SPL
+ JMP WERR
+ LDA ID FIRST WORD
+ JST WSNG OUTPUT IT
+ LDA ID+1 2ND WORD
+ JST WSNG OUTPUT IT
+ LDA ID+2 3RD WORD
+ JST WSNG OUTPUT IT
+ LDA ID+3 4TH WORD
+ JST OA00 OUTPUT IT
+ JMP W420 TO CHECK NEXT DATA
+*
+WSNG PZE 0
+ JST OA00 OUTPUT (A)
+ LDA NTID NO. OF CHARS, REMAINED TO BE OUTPUT
+ SUB K102
+ STA NTID NTID=NTID-2
+ SNZ
+ JMP W420 ALL FINISHED, CHECK NEXT ITEM
+ JMP* WSNG SOME HOLLERITH CHARS, REMAINED
+W403 LDA TID+2 REAL OUTPUT
+ JST OA00
+ LDA TID+1
+ JMP W406
+W404 LDA TID+2 DOUBLE PRECISION OUTPUT
+ JST OA00
+ LDA TID+1
+ JST OA00
+W405 LDA TID INTEGER OUTPUT
+W406 JST OA00
+ LDA T0W4
+ ERA IM
+ ANA K105
+ SNZ
+ JMP *+3
+* TO BE OUTPUT, RETURN
+WERR JST ER00
+ BCI 1,DM DATA AND DATA NAME MODE DO NOT AGREE
+W420 LDA I
+ SUB K102
+ STA I I = I-2
+ CAS KPRM
+ NOP
+ JMP W4M MORE TO DO
+ SUB G TEST FOR COMPLETE
+ SZE
+ JMP W4P
+ LDA K104
+ JST TS00
+ LDA T1W4
+ STA RPL
+ JST CH00 INPUT NEXT CHARACTER
+ SUB K5 ='254 (,)
+ SZE SKIP IF CHAR = COMMA
+ JMP A1 CHECK FOR (CR)
+ JMP W4 PROCESS NEXT DATA GROUP
+W4P LDA K134
+ JST TS00
+ JMP W4E
+W4S JST FS00 FLUSH BUFFER IF NECESSARY
+ LDA AF POSITION WITHIN COMMON BLOCK
+ LRL 14
+ LDA K106 FORMAT BCD OUTPUT
+ LGL 6
+ LLL 6
+ STA OCI
+ IAB
+ ANA K116
+ STA OCI+1
+ JST FL00 FETCH LINK
+ LDA DP+4,1
+ SSM
+ ALR 1
+ SSM
+ ARR 1
+ LRL 8
+ ERA OCI+1
+ STA OCI+1
+ LDA DP+3,1
+ IAB
+ LDA DP+4,1
+ LLL 8
+ STA OCI+2
+ LDA DP+2,1
+ IAB
+ LDA DP+3,1
+ LLL 8
+ STA OCI+3
+ LDA DP+2,1
+ LGL 2
+ ADD K103
+ LGL 6
+ STA OCI+4
+ LDA K128
+ STA OCNT
+ JST STXI I POINTS TO DATA TABLE
+ LDA DP-1,1 SET A TO VARIABLE
+ STA A
+ JST FA00
+ JMP W4O
+W4T LDA K101 =1 (=REL)
+ IAB
+ LDA RPL
+ JST AF00 DEFINE AFT (AT=REL. AF=RPL)
+ LDA I SET POINTER IN DATA POOL
+ STA 0
+ LDA RPL
+ STA DP,1 DP(I) = RPL OF VARIABLE
+ ADD D0
+ STA RPL
+ JMP W4C
+*
+*
+* *********************************
+* *BLOCK DATA SUBPROGRAM PROCESSOR*
+* *********************************
+* SET BLOCK DATA FLAG AND OUTPUT FORCE LOAD CODE
+R3 LDA LSTF =0 IF FIRST STATEMENT IN THE SUBPROGRAM
+ SZE
+ JMP *+3
+ JST ER00 ERROR...NOT FIRST STATEMENT
+ BCI 1,BL 'BLOCK DATA' NOT FIRST STATEMENT
+ STA BDF SET BLOCK DATA FLAG ON (NON-ZERO)
+ JST CH00 INPUT NEXT CHARACTER
+ JMP A1 CHECK FOR (CR) AND EXIT
+*
+*
+*
+*
+*
+*
+*
+* ***************************
+* *TRACE STATEMENT PROCESSOR*
+* ***************************
+* SETS TRACE TAG ON VARIABLES OR SETS TRACE FLAG
+TRAC JST XN00 EXAMINE NEXT CHARACTER
+ SZE SKIP IF CHAR, WAS A DIGIT
+ JMP TRAD JUMP IF CHAR. WAS A LETTER
+ JST IS00 INPUT STATEMENT NO.
+ LDA A STATEMENT NO. POINTER
+ STA TRF SET TRACE FLAG ON
+ JMP A1 TEST FOR (CR) AND EXIT
+*
+TRAD JST NA00 INPUT NAME
+ JST STXA SET INDEX TO NAME ENTRY
+ LDA DP+4,1 TT(A) TRACE TAG
+ CHS
+ STA DP+4,1
+ JMP B1 (,) OR (CR) TEST
+* (RETURN TO TRAC IF (,) )
+*
+*
+*
+* ********************
+* *OUTPUT OBJECT LINK*
+* ********************
+OL00 DAC **
+ JST CN00 CALL NAME
+ CRA
+ STA DF DF = 0
+ LDA ID (A) = IP
+ JST OA00 OUTPUT +BS
+*
+ JMP* OL00
+*
+* *****************
+* *OUTPUT I/O LINK*
+* *****************
+* GENERATE I/O DRIVER LINKAGE CODE. NAME OF
+* CALLED ROUTINE IS CHANGED IF UNIT DESIGNATOR
+* IS A CONSTANT.
+OI00 DAC **
+ JST IV00 INPUT INT VAR/CON
+ LDA NT
+ SNZ IF NT = 0
+ JMP OI20 GO TO 0I20
+ LDA ID IF ID CR 9
+ SUB K126 G0 TU OI20
+ SMI
+ JMP OI20
+* FORM F$RN OR F$WN
+ LDA NAMF+1
+ ANA K116
+ ADD ID
+ ADD K60 ='260 (SP)
+ STA NAMF+1
+OI10 JST CN00 CALL NAME
+ JMP* OI00 RETURN
+OI20 LRL 32
+ LDA OMI7 OUTPUT OA
+ JST OB00 (LOAD A (UNIT N0.))
+ JMP OI10 FO TO OI10
+*
+*
+* ***********
+* *CALL NAME*
+* ***********
+* SET UP NAME AND GENERATE CODE FOR CALLING IT.
+CN00 DAC **
+ JST FS00 FLUSH
+ JST PRSP SET PRINT BUFFER TO SPACES
+ LDA K147 SET UP OCI FOR CALL
+ STA OCI
+ LDA NAMF+1 OCI = NAMF
+ STA PRI+9
+ IAB ALSO TO PRINT BUFFER
+ LDA NAMF
+ STA PRI+8
+ LRL 8
+ STA OCI+1
+ LLL 16
+ STA OCI+2
+ LDA NAMF+2
+ STA PRI+10
+ IAB
+ LDA NAMF+1
+ LLL 8
+ STA OCI+3
+ LLL 16
+ STA OCI+4
+ LDA K128 ='14
+ STA OCNT OCNT = 6
+ LDA CN90
+ STA PRI+5
+ LDA CN90+1
+ STA PRI+6
+ LDA RPL
+ JST OR80
+ DAC PRI
+ SR2
+ JMP *+3 INHIBIT SYMBOLIC OUTPUT
+ CALL F4$SYM OUTPUT SYMBOLIC LINE,
+ DAC PRI
+ IRS RPL RPL = RPL + 1
+ JST PRSP SET PRINT BUFFER TO SPACES
+ JST FS00 FLUSH
+ JMP* CN00 RETURN
+K147 OCT 55000
+CN90 BCI 2,CALL
+* *************
+* *OUTPUT PACK*
+* *************
+* OUTPUT THE PACK WORD WHEN IT IS FULL.
+PKF PZE 0 PACK FLAG
+T0OK PZE 0
+OK00 DAC **
+ CAS CRET IF (A) = C/R
+ JMP *+2
+ JMP OK30 GO TO OK30
+ IRS PKF PKF = PKF + 1
+ JMP OK20 IF NON-ZERO, GO TO OK20
+OK10 ADD T0OK (A) = (A) + T0
+ LRL 16
+ STA DF
+ IAB
+ JST OA00 OUTPUT ABS
+ JMP* OK00
+OK20 LGL 8
+ STA T0OK
+ LDA K123 PKF = - 1
+ STA PKF
+ JMP* OK00 RETURN
+OK30 LDA PKF IF PKF = 0
+ SNZ
+ JMP* OK00 RETURN
+ LDA K8 ELSE (A) = SPACE,
+ STA PKF
+ JMP OK10 GO TO OK10
+*
+*
+* ***********
+* *OUTPUT OA*
+* ***********
+* GENERAL OUTPUT ROUTINE. MAKES CHECKS AGAINST
+* THE ASSIGNMENT TABLE ENTRY TO PROCESS DUMMY,
+* EXTERNAL, RELATIVE, ABSOLUTE OR STRING
+* REFERENCES PROPERLY.
+T1OB PZE 0
+OB00 DAC **
+ STA FTOP FTOP = (A)
+ IAB
+ STA T1OB
+ JST STXA ESTABLISH A
+ SNZ IF A = 0
+ JMP OB08 GO TO OB08
+ JST FA00 FETCH ASSIGNS
+ LDA SOF SPECIAL OUTPUT FLAT
+ SZE
+ JMP OB60 SUBSCRIPT CONSTANT DEFLECTION
+ LDA AF
+ STA T1OB T0 = AF
+ LDA AT
+ SUB K105 IF AT = 'DUM'
+ SNZ
+ JMP OB15 GO TO OB15
+ LDA IU
+ SUB K101 IF IU = 'SUB'
+ SNZ
+ JMP OB40 GO TO OB40
+OB06 LDA AT
+ CAS K104 IF AT = 'COM'
+ JMP *+2
+ JMP OB20 GO TO OB20
+ CAS K101
+ JMP *+2 IF AT = 'REL'
+ JMP OB10 GO TO OB10
+ LDA K103
+ IAB
+ LDA RPL
+ JST AF00 DEFINE AF AND AT
+ LDA AT IF AT = 'STR-RE'
+ SUB K103
+ SNZ
+ JMP OB10 GO TO OB10
+ CRA
+ STA AF AF = 0
+OB08 LDA K102
+ STA DF SET FLAG TO OUTPUT SYMBOLIC
+ LDA FTOP
+ JST OA00 OUTPUT ABSOLUTE
+ JMP* OB00 RETURN
+OB10 LDA T1OB
+ STA AF
+ LDA FTOP
+ JST OR00 OUTPUT REL
+ JMP* OB00 RETURN
+OB15 LDA FTOP
+ CHS REVERSE INDIRECT BIT
+ STA FTOP
+ JMP OB10 GO TO OB10
+OB20 JST FS00 OUTPUT COMMON REOUEST
+ LDA T1OB PACK ADDRESS INTO BLOCK
+ LRL 14
+ LDA FTOP
+ LGR 10
+ ADD K150
+ LLL 6
+ STA OCI
+ LLL 8
+ STA OCI+1
+ JST SAV
+ JST FL00
+ LDA DP+2,1
+ STA PRI+13 SET COMMON NAME INTO PRINT BUFFER
+ LLR 8
+ STA OCI+4
+ LLL 8
+ LDA DP+3,1
+ STA PRI+12 SET COMMON NAME INTO PRINT BUFFER
+ LLR 8
+ STA OCI+3
+ LLL 8
+ LDA DP+4,1
+ ANA K111 ='037777
+ CAS *+1 LOOK FOR BLANK COMMON
+ OCT 020240
+ ERA K122
+ ERA HBIT
+ STA PRI+11 SET NAME INTO PRINT BUFFER
+ LLR 8
+ STA OCI+2
+ LLL 8
+ LDA OCI+1
+ LLL 8
+ STA OCI+1
+ LDA K128 ='14
+ STA OCNT
+ JST RST
+ LDA 0
+ STA A RESTORE A TO POINT AT NAME
+ LDA RPL SET RPL MINUS
+ SSM TO DISABLE WORD OUTPUT
+ STA RPL
+ LDA FTOP OUTPUT WORD TO LIST
+ JST OR00 SYMBOLIC COMMAND
+ LDA RPL RESTORE AND
+ SSP INCREMENT PROGRAM
+ AOA COUNTER FOR COMMON
+ STA RPL OUTPUT
+ JST FS00 CLOSE OUT BLOCK
+ JMP* OB00 EXIT
+OB30 LDA DP+4,1
+ SSM
+ ALR 1
+ SSM
+ ARR 1
+ STA NAMF
+ LDA DP+3,1
+ STA NAMF+1
+ LDA DP+2,1
+ STA NAMF+2
+ JST CN00
+ JMP* OB00
+OB40 LDA AT
+ SUB K102
+ SNZ
+ JMP OB30
+ JMP OB06
+OB50 OCT 140000
+*
+OB60 CRA
+ STA SOF RESET SPECIAL OUTPUT FLAG
+ LDA AT ADDRESS TYPE
+ CAS K105 TEST FOR DUMMY
+ JMP OB06 PROCESS NORMALLY
+ JMP OB61
+ JMP OB06 PROCESS NORMALLY
+OB61 LDA T1OB
+ STA FTOP
+ CRA
+ JMP OB08+1
+*
+K150 OCT 700
+*
+*
+* **************
+* OUTPUT TRIADS*
+* **************
+* PROCESSES THE TRIAD TABLE, HANDLES FETCH
+* GENERATION AND RELATIONAL OPERATOR CODE
+* GENERATION, DRIVES OUTPUT ITEM. ASSIGNS
+* AND OUTPUT TEMP STORES.
+T0OT PZE 0
+T2OT PZE 0
+T1OT PZE 0
+T3OT PZE 0 TEMP STORE FOR P
+OT00 DAC **
+ JST SAV
+ LDA L0
+ STA I I = L0
+ CRA
+ STA T0OT T0 = 0
+ STA IFLG
+OT06 STA T1OT T1 = I
+OT10 LDA I
+ SUB K103 I = I-3
+ STA I
+ STA T2OT T2 = I
+ SUB L
+ SPL
+ JMP OT60 IF FINISHED, GO TO OT60
+ JST STXI
+ LDA DP+2,1
+ SSP CHECK P (I)
+ CAS K139 X
+ JMP *+2
+ JMP OT10
+ CAS K138 H
+ JMP *+2
+ JMP OT10
+ CAS K142 I
+ JMP *+2
+ JMP OT50
+ CAS K143 T
+ JMP *+2
+ JMP OT40
+ CAS K151 Q
+ JMP *+2
+ JMP OT35
+ STA T3OT SAVE P
+ LDA DP+1,1
+ STA A A = O1(I)
+ CAS T1OT
+ JMP *+2
+ JMP OT30
+ CAS L0
+ JMP OT16
+ JMP OT99 MAYBE SPECIAL LOAD FOR (A=) STATEMENT
+ JMP OT16
+OT18 JST STXI
+ LDA DP,1
+ STA A A = O2 (I)
+ LDA DP+2,1
+ SSP
+ JST OM00 OUTPUT ITEM(P(I),A = 02(I))
+OT22 JST STXI
+ LDA DP+2,1
+ SMI
+ JMP OT28
+ CRA ASSIGN TEMP STOR
+ STA NT NT = 0
+ LDA K102
+ STA IU IU = VAR
+ LDA T0OT
+ LRL 6
+ LDA TCF ID =
+ LRL 3 TS-IM-TCF-T0
+ LDA MFL
+ STA IM
+ LLL 9
+ JST OR80
+ DAC ID
+ LDA K77
+ STA ID
+ IRS T0OT T0 = T0+1
+ JST AS00 ASSIGN ITEM
+ JST STXI
+ LDA A
+ STA DP,1 O2(I) = A
+ LDA K153
+ SSM SURPRESS TRACE OF TEMPORARY STORAGE
+ JST OM00 OUTPUT ITEM (=,A)
+OT28 LDA I
+ JMP OT06
+OT30 JST STXA
+ LDA DP+2,1
+ SSP IF P (A) = 0
+ SZE
+ JMP OT32
+OT16 LDA K152 GENERATE FETCH
+ JST OM00 OUTPUT ITEM
+OT32 LDA T3OT CHECK FOR RELATIONALS
+ SUB K125 ='10
+ SPL
+ JMP OT18 NOT LOGICAL OR6RATOR
+ SUB K106 =6
+ SMI
+ JMP OT18 NOT A LOGICAL QPERATOR
+ STA 0 SET INDEX = -1 TO -6
+ LDA K103 =3 (LOG)
+ STA MFL SET MODE TO LOGICAL
+ CRA
+ STA A SET FOR OCTAL ADDRESS
+ JMP *+7,1 BRANCH TO OPERATOR PROCESSOR
+ JMP OT3G .LT.
+ JMP OT3E .LE.
+ JMP OT3C .EQ.
+ JMP OT3B .GE.
+ JMP OT3A .GT.
+ LDA OMJ4 .NE. =ALS 16
+ JST OA00 OUTPUT ABSOLUTE
+ LDA OMJ6 =ACA
+ JMP OT3D
+OT3A LDA OMJ7 *TCA
+ JMP OT3F
+OT3B LDA OMK1 =CMA
+ JMP OT3F
+OT3C LDA OMJ4 = ALS 16
+ JST OA00
+ LDA OMK2 =SSC
+ JST OA00 OUTPUT ABSOLUTE
+ LDA OMK3 =AOA
+OT3D JST OA00 OUTPUT ABSOLUTE
+ JMP OT22
+OT3E LDA OMJ2 =SNZ
+ JST OA00 OUTPUT ABSOLUTE
+ LDA OMK4 =SSM
+OT3F JST OA00 OUTPUT ABSOLUTE
+OT3G LDA OMJ5 =LGR 15
+ JMP OT3D
+*
+OT35 LDA DP+1,1
+ STA ID
+ JST NF00
+ LDA K78 NAMF = F $AR
+ STA NAMF+1
+ JST OL00 OUTPUT OBJECT LINK
+ JMP OT18 GO TO OT18
+OT40 LDA DP,1
+ ADD DO
+ STA I I = 02 (I) + DO
+ JST DQ00 DO TERMINATION
+OT45 LDA T2OT
+ STA I I = T2
+ JMP OT28
+OT50 LDA DP,1
+ ADD DO I=O2(I)+DO
+ STA I IF I = DO
+ SUB DO
+ SZE GO TO OT45
+ JST DS00 DO INITIALIZE
+ JMP OT45 GO TO OT45
+OT60 JST RST
+ LDA L0 RESET TRIAD TABLE
+ STA L
+ JMP* OT00
+*
+OT99 LDA T3OT
+ SUB K153 CODE FOR =
+ SZE
+ JMP OT16 NOT SPECIAL LOAD
+ STA MFL SPECIAL LOAD, SET MFL=0
+ JMP OT18 OUTPUT A STORE
+K77 BCI 1,T$ T$
+K78 BCI 1,AR AR
+K142 OCT 27
+K143 OCT 30
+K151 OCT 32
+K152 OCT 31
+* *************
+* *OUTPUT ITEM*
+* *************
+*
+* DRIVES BASIC OUTPUT ROUTINES. HANDLES SPECIAL
+* SUBSCRIPT PROCESSING, GENERATES NECESSARY
+* MODE CONVERSION CALLS AND HANDLES MODE
+* CHECKING. IN-LINE ARITHMETIC CODE IS
+* GENERATED WHERE POSSIBLE. OTHERWISE CALLS
+* TO ARITHMETIC ROUTINES ARE GENERATED.
+*
+T0OM PZE 0
+T1OM PZE 0
+T2OM PZE 0
+T8OM PZE 0
+T9OM PZE 0
+TXOM PZE 0
+*
+*-------------OUTPUT ITEM
+OM00 DAC ** RETURN ADDR
+ STA T8OM
+ SSP
+ STA T0OM R(0)=(A)='P' CODE
+ CAS K134
+ JMP *+2
+ JMP OMD1
+ LDA TXOM
+ CAS K101
+ JMP OME1
+ JMP OME5
+OM05 CRA
+ STA T1OM T(1)=0
+ STA T9OM T(9)=0
+ LDA A
+ STA T2OM T(2)=A
+ SZE
+ JMP OM07
+ LDA MFL
+ JMP OM13
+OM07 CAS L0
+ JMP *+2
+ JMP OML1
+ CAS ABAR
+ JMP OM76 A .LE. ABAR....WITHIN TRIAD TABLE
+ JMP *+1
+OM10 JST STXA SET INDEX=A
+ LDA DP,1
+ ARS 9 SES IM=MODE OF ITEM
+ ANA K107
+OM13 STA IM
+OM14 LDA MFL SET MFL,IM AS DIGITS INTO NAMF
+ ALS 8
+ ADD IM
+ ERA OM90 ADD '0''0'
+ STA NAMF+1
+ LDA K130
+ STA 0 INDEX=-6
+ LDA T0OM
+ CAS OM50+6,1 CHECK FOR SPECIAL OPERATOR
+ JMP *+2 '1
+ JMP* OM52+6,1 'P'='Q',',','0','A'F', OR 'E'
+ IRS 0
+ JMP *-4
+ LDA MFL
+ SNZ
+ JMP OM62 SPECIAL LIBRARY FIX FOR ( A= )
+ CAS IM CHECK FOR MODE MIXING
+ JMP *+2
+ JMP OMA1 ITEM MODE SAME AS CURRENT MODE
+OM20 LDA K103
+ JST OM44 CHECK MODE FOR LOG
+ LDA K102 =2 (MODE CODE FOR REAL)
+ CAS MFL MODE OF EXPRESSION
+ JMP *+2
+ JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING
+ CAS IM MODE OF ITEM
+ JMP *+2
+ JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING
+ LDA K105
+ JST OM44 TEST FOR MODE = COMPLEX
+OM26 LDA T0OM OPERATOR BEING PROCESSED
+ CAS K153
+ JMP *+2
+ JMP OM36 T(0)='=' (ALLOW INTEGER MODE)
+ LDA K101
+ JST OM44 TEST FOR MODE=INTEGER
+ LDA IM
+ CAS MFL
+ JMP OM38 CONVERT MODE OF ACCUMULATOR
+ JMP *+1
+OM30 JST NF00 SET LBUF+2 TO SPACES
+ LDA T0OM
+ STA 0
+ LDA A9X4,1 PICK-UP PRINT CODE FOR 'P' OPERATOR
+ ARS 6
+ ANA K100 ='377
+ SNZ
+ JMP OM46 MODE MIXING ERROR
+ LGL 8
+ ERA OM91 ADD '$'
+ STA NAMF
+ LDA K134
+ STA T0OM T(0)=','
+ JMP OM40
+*
+OM36 LDA K105
+ JST OM44 CHECK FOR MODE=COMPLEX
+OM38 LDA IM
+ STA MFL
+ JST NF00 SET LBUF+2 TO SPACES
+ LDA OM92 'C$'
+ STA NAMF
+OM40 JST CN00 OUTPUT....CALL NAMF
+ LDA MFL
+ STA IM SET ITEM MODE TO CURRENT MODE
+ LDA NAMF
+ CAS OM96
+ JMP OM14
+ JMP* OM00
+ JMP OM14 OUTPUT ARGUMENT ADDRESS
+*
+*-----SUBROUTINE TO CHECK FOR ILLEGAL IM OR MFL MODES,
+OM44 DAC ** RETURN ADDR,
+ CAS IM CHECK FOR IM0(A)
+ JMP *+2
+ JMP OM46 ERROR
+ CAS MFL CHECK FOR MFL=(A)
+ JMP* OM44
+ JMP OM46 ERROR
+ JMP* OM44
+OM46 JST ER00 NON-RECOVERABLE ERROR......
+ BCI 1,MM MODE MIXING ERROR
+*
+*------SPECIAL 'P' OPERATOR TABLE
+OM50 OCT 32 'Q'
+ OCT 17 ','
+ OCT 00 '0'
+ OCT 22 'A'
+ OCT 31 *F'
+ OCT 20 'E'
+OM52 DAC OMB3 ('Q')
+ DAC OMB3 (',')
+ DAC OMB3 ('0')
+ DAC OM56 ('A')
+ DAC OM60 ('F')
+ DAC OM70 ('E')
+*
+*
+OM56 LDA OMI1 SET T(1) = ADD*
+ JMP OMB1
+*
+OM60 JST STXA SET INDEX = A
+ LDA DP+1,1
+ LGR 14 SET UV=IU(A)
+ STA IU
+ JST STXI SET INDEX=I
+ LDA DP+2,1 P(I)
+ ANA K133 ='77
+ SNZ
+ JMP OM64 (POSSIBLE DUMMY ARRAY FETCH)
+OM62 LDA IM
+ STA MFL SET CURRENT MODE TO ITEM MODE
+ LGL 8
+ ADD IM
+ ERA OM90
+ STA NAMF+1
+ LDA IU
+ SUB K101 CHECK FOR IU=1 (SUBROUTINE)
+ SZE
+ JMP OMA1
+ LDA OMI2 SET T(1) = JST
+ JMP OM66
+OM64 LDA IU
+ SUB K103 CHECK FOR IV=3 (ARRAY)
+ SZE
+ JMP OM62
+ LDA K101 SET CURRENT MODE TO INTEGER
+ STA MFL
+ LDA OMI3 SET T(1) = LDA*
+OM66 STA T1OM
+ JMP OMB3
+*
+OM70 LDA K101
+ CAS IM CHECK ITEM MODE EQUALS INTEGER
+ JMP *+2
+ JMP OM74
+ LDA K105 CHECK FOR MODE = COMPLEX
+ JST OM44
+ JMP OM20
+OM74 LDA K103 CHECK FOR MODE = LOGICAL
+ JST OM44
+ JMP OM30 OUTPUT SUBROUTINE CALL
+*
+OM76 JST STXA INDEX=A
+ LDA DP,1 02(A)
+ STA T2OM T(2)=02(A)
+ LDA DP+2,1 P(A)
+ ANA K133 ='77
+ SNZ
+ JMP OM84 P(A)='0' (SUBSCRIPTED VARIABLE)
+ CAS K139
+ JMP *+2
+ JMP OM80 P(A) = 'X' (END OF ARRAY CALCULATION)
+ CAS K138
+ JMP *+2
+ JMP OMHW
+OM78 LDA T2OM P(4)= 'H' (HOLLERITH DATA)
+ STA A RESET A
+ JMP OM10
+*
+OM80 JST STXI INDEX=I
+ LDA T2OM
+ STA DP+1,1 O1(I) = T(2)
+ CRA
+ STA T1OT SET T(1) OF OUTPUT TRIADS TO ZERO
+ LDA A SAVE A
+ STA T1OM
+ CRA SET A=0 (NOT SYMBOLIC)
+ STA A
+ LDA RPL
+ ADD K102 AF = RPL+ 2
+ STA AF
+ LDA OMI4 =ADD INSTRUCTION
+ JST OR00 OUTPUT RELATIVE
+ LDA RPL
+ ADD K102 AF = RPL P+ 2
+ STA AF
+ LDA OMI5 = JMP INSTR,
+ JST OR00 OUTPUT RELATIVE
+ LDA T1OM
+ STA A RESTORE A
+ STA SOF SET SPECIAL OUTPUT FLAG TO NON-ZERO
+ CRA = DAC INSTR.
+ STA T1OM
+ LDA K101
+ STA AT
+ JMP OM88
+OM84 LDA DP+1,1 O1(A)
+ STA A A=O1(A)
+ CAS L0
+ JMP *+2
+ JMP OM86 A=L(0)....CONSTANT SUBSCRIPT ONLY
+ LDA OMI0 T(1) = INDIRECT BIT
+ STA T1OM
+ JMP OM10
+*
+OM86 LDA T2OM A=T(2)
+ STA A
+ STA 0
+ STA SOF
+ LDA DP,1 T(2) = 02(A)
+ STA T2OM
+OM88 JST STXA INDEX=A
+ LDA DP+1,1 O1(A)
+ STA T9OM T(9)=O1(A)
+ JMP OM78
+OMHW LDA T2OM
+ STA AF
+ CRA
+ STA A
+ JST OR00
+ JMP* OM00
+*
+OM90 OCT 130260 '00'
+OM91 OCT 000244 ' $'
+OM92 OCT 141644 'C$'
+OM93 OCT 152322 'TR'
+OM94 OCT 000021 'C' CODE
+OM95 OCT 017777 (MASK)
+OM96 BCI 1,N$
+OM97 BCI 1,-1
+*
+OMA1 LDA IM CHECK FOR IM=LOGICAL
+ CAS K103
+ JMP *+2
+ JMP OMC1 IM=LOGICAL
+ CAS K101 CHECK FOR IM=INTEGER
+ JMP *+2
+ JMP OMA3 IM=INTEGER
+ JMP OM30
+*
+OMA3 LDA T0OM CHECK FOR T,0) = '+'
+ CAS K103 =3
+ JMP *+2
+ JMP OMA4 T(0)= '*'
+ CAS OM94 T(0) = 'C
+ JMP *+2
+ JMP OMA6 OUTPUT 'TCA'
+ CAS K101
+ JMP OMA5
+ LDA OMI4 =ADD INSTR.
+ JMP OMB1
+OMA4 LDA T2OM VALUE OF A
+ SUB K126 ='12 KNOWN LOCATION OF A FOR 2
+ SZE SMP IF MULTIPLIER IS A CONSTANT OF 2
+ JMP OM30 COUPLE TO THE MULTIPLY SUBROUTINE
+ STA A SET A AND AF TO ZERO (FOR LISTING FLAGS)
+ STA AF
+ LDA *+3 ALS 1 INSTRUCTION
+ JST OA00 OUTPUT ABSOLUTE
+ JMP* OM00 EXIT UUTPUT ITEM
+ ALS 1 (INSTRUCTION TO BE OUTPUT)
+OMA5 CAS K102 CHECK FOR T(0) = '-'
+ JMP OMA7
+ LDA OMI6 =SUB INSTR,
+ JMP OMB1
+OMA6 CRA
+ STA A CAUSE OCTAL ADDR LISTING
+ STA AF
+ LDA *+3 TCA
+ JST OA00 OUTPUT ABSOLUTE
+ JMP* OM00 EXIT
+ TCA
+OMA7 CAS K153 CHECK FOR T(0) = '='
+ JMP *+2
+ JMP OMA9 OUTPUT A STA INSTR,
+ SUB K152 CHECK FOR T(0) = 'F'
+ SZE
+ JMP OM30
+OMA8 LDA OMI7 =LDA INSTR,
+ JMP OMB1
+OMA9 LDA OMI8 =STA INSTR,
+OMB1 ADD T1OM T(1) = T(1) + INSTR.
+ STA T1OM
+OMB3 LDA T2OM SET A=T(2)
+ STA A
+ LDA T9OM OUTPUT INSTR. WITH T(1) AND T(9)
+ IAB
+ LDA T1OM
+ JST OB00 OUTPUT OA
+ LDA T8OM CHECK FOR T(8) = '='
+ CAS K153 ='16
+ JMP* OM00
+ JMP *+2
+ JMP* OM00 EXIT
+ LDA TRFA POINTER TO FIRST VARIABLE OR ARRAY
+ STA A PROCESSED IN EXPRESSION
+ JST TRSE OUTPUT TRACE COUPLING IF REQUIRED
+ JMP* OM00 EXIT OUTPUT ITEM
+*
+*
+OMC1 LDA T0OM
+ CAS K152 CHECK FOR T(0) = 'F'
+ JMP *+2
+ JMP OMA8 OUTPUT A LDA INSTR.
+ CAS K153 CHECK FOR T(0) = '='
+ JMP *+2
+ JMP OMA9 OUTPUT A STA INSTR,
+ CAS OM94 CHECK FOR T(0) = 'C'
+ JMP *+2
+ JMP OM30 OUTPUT COMPLEMENT CODING
+ CAS K106
+ JMP *+2
+ JMP OMC5 OUTPUT AN ANA INSTR.
+ CAS K107
+ JMP OM46 ERROR
+ JMP OM30
+ JMP OM46 ERR0R
+OMC5 LDA OMI9 =ANA INSTR.
+ JMP OMB1
+OMD1 IRS TXOM T0 = T0+1
+ JMP OM05
+OME1 CRA
+ STA DF DF = 0
+ JST OA00 OUTPUT ABSOLUTE
+OME5 CRA
+ STA TXOM T0 = 0
+ JMP OM05
+*
+TRSE DAC 0 SUBROUTINE TO OUTPUT TRACE COUPLING
+ JST STXA SET INDEX = A
+ SZE
+ LDA DP+4,1 CHECK STATUS OF TRACE TAG
+ SPL
+ JMP TRS7
+ SR4
+ JMP TRS7
+ LDA TRF CHECK STATUS OF TRACE FLAG
+ SNZ
+ JMP* TRSE
+TRS7 JST NF00 SET LBUF TO 'F$', LSUF+2 TO SPACES
+ LDA OM93 ='TR'
+ STA NAMF+1
+ JST CN00 OUTPUT.....CALL NAMF
+ JST STXA SET INDEX = A
+ LDA DP+4,1
+ ANA OM95
+ STA T1OM
+ LDA DP+3,1
+ STA T8OM
+ LDA DP+2,1
+ STA T9OM
+ CRA
+ STA DF
+ LDA DP,1 MERGE IM WITH ITEM NAME
+ ARS 9
+ LGL 13
+ ERA T1OM
+ JST OA00 OUTPUT ABSOLUTE (FIRST 2 CHAR.)
+ LDA T8OM
+ JST OA00 OUTPUT ABSOLUTE (NEXT 2 CHAR.)
+ LDA T9OM
+ JST OA00 OUTPUT ABSOLUTE (LAST 2 CHAR.)
+ JMP* TRSE
+*
+*.................INSTRUCTION TABLE
+OMI0 OCT 100000 INDIRECT BIT
+OMI1 OCT 114000 ADD*
+OMI2 OCT 020000 JST
+OMI3 OCT 104000 LDA*
+OMI4 OCT 014000 ADD
+OMI5 OCT 002000 JMP
+OMI6 OCT 016000 SUB
+OMI7 OCT 004000 LDA
+OMI8 OCT 010000 STA
+OMI9 OCT 006000 ANA
+OMJ1 OCT 102000 JMP*
+OMJ2 OCT 101040 SNZ
+OMJ3 OCT 101400 SMI
+OMJ4 ALS 16
+OMJ5 OCT 040461 LGR 15
+OMJ6 OCT 141216 ACA
+OMJ7 OCT 140407 TCA
+OMK1 OCT 140401 CMA
+OMK2 OCT 101001 SSC
+OMK3 OCT 141206 AOA
+OMK4 OCT 140500 SSM
+OMK5 OCT 042000 JMP 0,1
+OMK6 OCT 000000 DAC **
+ ALS 1 ALS1
+ TCA TCA
+OMK7 OCT 176000 STG
+OMK9 CAS 0 CAS
+ STA* 0
+ SUB* 0
+ DAC* **
+ OCT 131001
+ OCT 030000 SUBR
+ CAS* 0
+OMK8 OCT 0 (///)
+OML1 LDA K101
+ STA AT
+ JMP OT10
+*
+* ************
+* *OUTPUT REL*
+* ************
+* ALSO DRIVES SYMBOLIC INSTRUCTION OUTPUT.
+OR00 DAC **
+ STA FTOP
+ LDA K102 DF = NON ZER0
+ STA DF CODE = 2
+OR10 STA CODE
+ LDA RPL LIST RPL
+ SSP
+ JST OR80
+ DAC PRI
+OR12 LDA DF IF DF NOT ZERO
+ SZE
+ JMP OR20 GO TO OR20
+ LDA OR18 ='147703
+ STA PRI+5
+ LDA OR19 SET 'OCT' INTO PRINT IMAGE
+ STA PRI+6
+ LDA FTOP
+OR13 JST OR80
+ DAC PRI+8
+OR15 LDA RPL IF RPL PLUS
+ SMI
+ JST OW00 OUTPUT WORD
+ SR2
+ JMP *+3 SURPRESS SYMBOLIC OUTPUT
+ CALL F4$SYM LIST LINE
+ DAC PRI
+ JST PRSP SET PRINT BUFFER TO SPACES
+ JMP* OR00 RETURN
+OR18 OCT 147703 (0)(C)
+OR19 OCT 152240 (T)(SP)
+OR20 JST SAV
+ LDA OR90 SEARCH OP-CODE LIST
+ TCA
+ STA XR PUT BCI IN PRINT IMAGE
+ LDA FTOP
+ SSP
+ SZE
+ JMP OR24
+ LDA AT
+ CAS K103
+ SUB K106
+ ADD K102
+ CMA
+ ANA K107
+ STA CODE
+OR24 LDA FTOP
+ CAS OR91+NINS,1
+ JMP *+2
+ JMP *+3
+ IRS XR
+ JMP *-4
+ LDA OR92+NINS,1
+ STA PRI+5
+ LDA OR93+NINS,1
+ STA PRI+6
+ JST RST
+ LDA A
+ SZE
+ JMP OR30
+ LDA AF
+ ANA K111 MASK OUT HIGH BITS OF ADDRESS
+ JMP OR13
+OR30 JST STXA
+ LDA DP,1
+ SMI
+ JMP OR40
+ LDA K149
+ STA PRI+8 SET =' INTO LISTING
+ LDA DP,1 CHECK IM (A)
+ LGL 4
+ SPL SKIP IF NOT COMPLEX
+ JMP *+4
+ LGL 2
+ SPL SKIP IF INTEGER OR LOGICAL
+ JMP *+3
+ LDA DP+2,1
+ JMP *+2 LIST EXPONENT AND PART OF FRACTION
+ LDA DP+4,1 LIST INTEGER VALUE
+ JST OR80 CONVERT OCTAL
+ DAC PRI+9
+ JMP OR15
+OR40 LDA DP+4,1 CONVERT AND PACK INTO
+ ALR 1
+ SSM SYMBOLIC IMAGE
+ ARR 1
+ SSM
+ STA PRI+8
+ LDA DP+3,1
+ STA PRI+9
+ LDA DP+2,1
+ STA PRI+10
+ JMP OR15
+* ***********
+* *OUTPUT ABS*
+* ***********
+OA00 DAC **
+ STA FTOP
+ LDA OA00
+ STA OR00
+ CRA
+ JMP OR10
+* *******************
+* *OUTPUT STRING-RPL*
+* *******************
+OS00 DAC 00
+ STA AF
+ LDA OMK7
+ STA FTOP
+ LDA OS00
+ STA OR00 SET RETURN INTO OUTPUT REL
+ LDA K104
+ STA CODE
+ STA STFL STRING FLAG = NON ZERO
+ JST PRSP SET PRINT BUF. TO SPACES
+ JMP OR20 JMP-OUTPUT REL FOR SYMBOLIC AND BINARY
+OR80 DAC **
+ IAB
+ LDA* OR80
+ STA OR89
+ CRA
+ LRR 2
+ IRS OR80
+ JST OR85
+ JST OR85
+ JST OR85
+ JMP* OR80
+OR85 DAC **
+ ADD K140
+ LLR 3
+ LGL 5
+ ADD K140
+ LLL 3
+ STA* OR89
+ IRS OR89
+ CRA
+ JMP* OR85
+OR89 PZE 0
+OR90 DAC NINS
+K200 EQU OMI7
+K201 EQU OMI5
+K202 EQU OMI8
+K203 EQU OMI4
+K204 EQU OMI6
+K205 EQU OMJ3
+K206 EQU OMJ1
+K207 EQU OMK5
+OR91 EQU OMI1
+OR92 BCI 22,ADJSLDADJMSULDSTANJMSNSMLLLRACTCCMSSAOSSJMDA
+ BCI 2,ALTC
+ BCI 9,STCASTSUDAERSUCA//
+OR93 BCI 22,D*T A*D P B A A A P*Z I 1515A A A C A M PXC
+ BCI 2,S1A
+ BCI 9,G S A*B*C*R/BRS*/
+NINS EQU 32
+*
+PRSP DAC ** SUBR. T0 SET PRINT BUF. T0 SPACES
+ LDA PRSK =-40
+ STA 0
+ LDA KASP (SP)(SP)
+ STA PRI+40,1
+ IRS 0
+ JMP *-2
+ JMP* PRSP EXIT
+PRSK OCT 177730 =-40
+*
+* *************************************
+* *OUTPUT SUBROUTINE/COMMON BLOCK NAME*
+* ************************************
+* OUTPUT AN EXTERNAL REFERENCE NAME.
+*
+ON00 DAC **
+ STA ONT1 SAVE ADDRESS
+ JST FS00 FLUSH BUFFER IF NECESSARY
+ JST STXA SET INDEX=A
+ LDA ONT1 SUBR. ENTRY ADDR.
+ LRL 14
+ STA ONT1 SAVE S/C BITS
+ LDA ON02 ='600 (=BLOCK CODE NO.)
+ LLL 6
+ STA OCI FILL BUFFER
+ LRL 8
+ JST STXA SET INDEX=A
+ LDA DP+4,1 FIHST 2 CHAR. 0F NAME
+ ANA K111 ='037777
+ CAS *+1
+ OCT 020240
+ ERA K122
+ ERA HBIT ='140000
+ LRR 8
+ STA OCI+1 BUFFER
+ LRL 8
+ LDA DP+3,1 SECOND 2 CHAR. OF NAME
+ LRR 8
+ STA OCI+2 BUFFER
+ LRL 8
+ LDA DP+2,1 LAST 2 CHAR. OF NAME
+ LRR 8
+ STA OCI+3 BUFFER
+ LLL 8
+ LGL 2
+ ADD ONT1 S/C BITS
+ LGL 6
+ STA OCI+4 BUFFER
+ CRA SET SIZE = 0
+ STA OCI+5 8UFFER
+ LDA K128 ='14
+ STA OCNT SET 8LOCK SIZE (DOUBLED)
+ JST FS00 FLUSH BUFFER
+ JMP* ON00 EXIT
+ON02 OCT 600 BLOCK CODE NUMBER (6)
+ONT1 OCT 0 TEMP STORE
+*
+K149 BCI 1,='
+K140 OCT 26
+*
+OW00 DAC **
+ JST SAV
+ LDA RPL
+ SUB ORPL
+ SPL
+ TCA
+ CAS K101
+ JST FS00 FLUSH BUFFER IF DIFFERENCE IN RPL'S N0T 1
+ NOP
+ LDA OCNT
+ ADD K103
+ CAS K146
+ NOP
+ JST FS00 FLUSH BUFFER
+ LDA OCNT
+ ADD K103
+ STA OCNT OCNT = OCNT+3
+ SUB K103
+ ARR 1 OCI (OUTPUT CARD IMAGE)
+ STA XR
+ SMI LEFT OR RIGHT POS,
+ JMP OW20
+ JST PU00
+ LRL 8 IF BUFFER FULL
+ IMA OCI,1
+ ANA K116 CALL FLUSH (FS0O)
+ ERA OCI,1
+OW10 STA OCI,1
+ IAB
+ STA OCI+1,1
+ LDA PRI+16
+ IAB
+ LDA PRI+14 USE LOW BIT OF PRI+14 DATA
+ LLL 9
+ LGR 1 STRIP OFF HIGH BIT OF BLOCK CODE TYPE NO,
+ LLL 3 SET DIGITS IN PRI+17, PRI+19
+ JST OR80
+ DAC PRI+16
+ LDA PRI+14
+ LRL 6
+ LGL 1 SHIFT ADDR. TO RIGHT BY 1 BIT
+ LLL 5
+ JST OR80 SET DIGITS IN PRI+15, PRI+16
+ DAC PRI+14
+ LDA KASP (SP)(SP)
+ SR1
+ JMP OW14
+ STA PRI+15 OVERWRITE BINARY DATA IN
+ STA PRI+16 PRINT BUFFER WITH SPACES
+ STA PRI+17 IF NO BINARY LISTING IS WANTED
+ STA PRI+18
+OW14 STA PRI+14
+ JST RST
+ LDA RPL
+ STA ORPL ORPL=RPL
+ CRA
+ IMA STFL INDICATE WORD WAS KEY TO LOADER
+ SNZ THEN LEAVE RPL ALONE
+ IRS RPL RPL = RPL+1
+ JMP* OW00
+STFL PZE 0
+OW20 JST PU00
+ JMP OW10
+ORPL PZE 0
+PU00 DAC **
+ LDA CODE COMBINE CODES TO
+ CAS K104 =4
+ NOP
+ JMP PU10
+ SZE SKIP IF ABS
+ JMP PU10 JUMP IF REL.
+ LRL 8
+ LDA FTOP
+PU08 LRL 4
+ STA PRI+14 SAVE FOR LISTING
+ IAB
+ STA PRI+16
+ LRR 12 RESTORE POSITION
+ JMP* PU00
+PU10 LRL 4
+ LDA AF
+ LRL 4
+ ERA FTOP
+ JMP PU08
+PU20 LRL 4
+ LDA AF
+ ANA K111
+ LRL 4
+ IMA AF
+ ANA K114
+ ERA AF
+ JMP PU08
+K114 OCT 14000
+K146 OCT 117
+*
+*
+* ******************
+* *FLUSH SUBROUTINE*
+* ******************
+FS00 DAC **
+ LDA OCNT BUFFER OCCUPANCY SIZE
+ JST SAV SAVE INDEX REGESTER
+ SUB K104 CHECK FOR OCNT .GT. 4
+ SPL
+ JMP FS20 SKIP OUTPUT IF BUFFER IS EMPTY
+ ADD K105 ADD 1/2 AT B14
+ ARS 1 DIVIDE BY 2
+ TCA
+ STA OCNT OCNT = -WORDS/BUFFER
+ SUB K101 =1
+ STA PCNT BUFFER SIZE INCLUDING CHECKSUM
+ LDA OCI FIRST WORD IN BUFFER
+ LRL 12
+ CAS K102 =2
+ JMP *+2
+ JMP FS30 BLOCK TYPE = 2 (RELOCATABLE CODE)
+* EVERY TIME A BLOCK OF OBJECT OUTPUT IS DUMPED, THE FIRST
+* 3 WORDS OF THE BLOCK IS INSERTED IN THE SYMBOLIC OUTPUT
+* ALONG WITH AN EOB OPERATOR CODE IF SENSE SWITCH 1 1S DOWN.
+* TO INHIBIT THIS LINE, REPLACE FROM FS10 TO AND INCLUDING
+* FS11 WITH (FS10 CRA ).
+FS10 SS1
+ JMP FS11 N0 BINARY LISTING UNLESS SSW-1 IS DOWN
+ CALL F4$SYM
+ DAC PRI OUTPUT WHATEVER MIGHT BE IN SYMBOLIC BUF.
+ LDA FS41 =(E)(O)
+ STA PRI+5 ENTER 'EOB' INTO LISTING
+ LDA FS41+1 =(B)(SP)
+ STA PRI+6
+ LDA OCI
+ JST OR80 ENTER FIRST WORD FROM BUFFER INTO LISTING
+ DAC PRI+8
+ LDA OCI+1
+ JST OR80 ENTER WORD 2 FROM BUFFER INTO LISTING
+ DAC PRI+12
+ LDA OCI+2
+ JST OR80 ENTER WORD 3 FROM BUFFER INTO LISTING
+ DAC PRI+16
+ CALL F4$SYM OUTPUT SYMBOLIC BUFFER
+ DAC PRI
+ JST PRSP RESET SYMBOLIC BUFFER TO SPACES
+FS11 CRA
+ STA 0 COMPUTE CHECKSUM
+FS12 ERA OCI,1 MERGE BUFFER WORD INTO CHECKSUM
+ IRS 0 INCREMENT BUFFER POSITION
+ IRS OCNT DECREMENT BUFFER SIZE
+ JMP FS12
+ STA OCI,1 SET CHECKSUM INTO BUFFER
+ LDA PCNT = NO. OF WORDS IN BUFFER
+ IMA 0
+ ADD FS40 = OCI+1,1
+ CALL F4$OUT PUNCH BUFFER
+FS20 LDA RPL SET UP BUFFER FOR NEXT OUTPUT
+ LRL 8
+ ADD K145 =#'2000 (BLOCK CODE 2)
+ STA OCI
+ IAB
+ STA OCI+1 SET FIRST 2 WORDS OF BUFFER
+ LDA K103 =O
+ STA OCNT RESET BUFFER OCCUPANCY SIZE
+ JST RST RESET INDEX REGISTER
+ JMP* FS00 EXIT
+*
+FS30 LGL 6 MERGE BUFFER SIZE INTO BLOCK HEADER
+ SUB OCNT BUFFER SIZE
+ ADD K101 =1 (ACCOUNT FOR CHECKSUM)
+ LLR 6
+ LGR 6
+ LLL 6 BRING IN UPPER HALF OF ADDRESSES
+ STA OCI STORE INTO BUFFER
+ JMP FS10 COMPUTE CHECKSUM
+*
+FS40 DAC OCI+1,1
+FS41 BCI 2,EOB 'EOB'
+K145 OCT 20000 BLOCK TYPE 2 CODE
+C499 OCT 060000
+*
+OCI BSS 40 40 WORD CARD IMAGE INPUT BUFFER
+PRI BSS 40 40 WORD PRINT BUFFER
+ BCI 20,
+ BSS 30 COMPILER PATCH AREA
+*
+* ***********************
+* *IOS (AND IOL) GO HERE*
+* ***********************
+*
+ END A0
projects / h316.git / commitdiff