
      JSB IDN00     INPUT DNA
      SZA           IM=0, POSSIBLE ERROR
      JSB AI00      ASSIGN ITEM
      SZA
      JMP *+3            (A)=IM OF THE OPERAND
      LDA K17
      JSB ER00           DELIMETER ENCOUNTERED WHEN OPERAND EXPECTED
      JSB TV00           TAG VARIABLE
*         * INTEGER TEST *
      LDA K26       NO
      LDB IM        IM=INTEGER ?
      CPB INT
      RSS           YES
      JSB ER00      ITEM NOT AN INTEGER
      CLA
      JMP IVC00,I
K26   DEC 26
ILTRM LDB K2
      JMP CRTST     TO 'ILTRM'
* 
JMP   OCT 26000
JSB   OCT 16000
* 
*         *******************
*         * GO TO PROCESSOR *
*         *******************
GOTOP JSB EXN00     EXAMINE NEXT CHARACTER
      SZA           CHAR. A DIGIT?
      JMP GOTO2     NO
      JSB ISN00     INPUT STATEMENT NUMBER
      LDA .A
      STA IFF       IFF=.A
      JMP ILTRM     ILLEGAL TERMINATOR CHECK
GOTO2 LDA DFL       CHAR. A LETTER ?
      SZA           YES
      JMP GOTO4     NO
      JSB IIV00     INPUT INTEGER VARIABLE
      JSB OJI00     OUTPUT  'JMP,I,.A'
      LDA TC
      CPA B54       ','
      RSS
      JMP *+3
      JSB IBL00     INPUT BRANCH LIST
      JSB ICH00     INPUT CHAR
      CLA
GOTO3 STA L
      LDA LO
      STA STK2B
      STA STK2T
      JMP JUMP
GOTO4 JSB IBL00     INPUT BRANCH LIST
      JSB ICH00     INPUT A CHARACTER
      CPA B54       TC=,?
      RSS
      JSB UC00      UNINPUT COLUMN
      LDA KM5
      LDB K10
EECAL EQU *
      STB EXSW      E.E. SWITCH
      LDB K28
      JMP CRTST     TO EESWJ
K10   DEC 10
* 
GOSW6 EQU *
      STA T1GOT     SAVE .A OF VAR OR TEMP CELL
      LDA JSB       'JSB'
      LDB .GOTO     ADDR OF .GOTO
      JSB ODF00     'JSB .GOTO'
      CLA
      LDB T1IBL     # OF STATEMENTS
      ADB K2
      JSB OZ00      'DEF RPL+N+2'
      CLA
      LDB T1GOT     .A OF VAR OR TEMP CELL
      JSB SOA00     'DEF .A OF VAR OR TEMP CELL'
      LDA LO
      STA I         I=D
GOTO6 ISZ I
      LDA I,I
      STA .A        .A=(I)
      SZA,RSS
      JMP GOTO3
      CLA
      JSB OA00      OUTPUT 'DEF  .A'
      JMP GOTO6
T1GOT NOP
.GOTO DEF .TBL+49   COMPUTED GO TO
* 
*         ***********************
*         * STORE AND OUTPUT OA *
*         ***********************
* 
SOA00 NOP
      STB .A
      JSB OA00
      JMP SOA00,I
* 
*         *********************
*         * INPUT BRANCH LIST *
*         *********************
IBL00 NOP
      CLA
      STA T1IBL     T1=0
      JSB ICH00     INPUT CHAR.
      LDA B50       '('
      JSB TCTST     TC-TEST
IBL02 JSB ISN00     INPUT STATEMENT NUMBER
      LDA .A
      JSB PU200     STORE STMENT NO. .A IN STACK
      ISZ T1IBL     INCREMENT NUMBER OF STMNT NOS.
      LDA TC
      CPA B54       ','
      JMP IBL02     TC=,
      CLA
      JSB PU200     ENTER 0 INTO STACK
      JSB RP00      )-INPUT OPERATOR
IBLEX JMP IBL00,I   EXIT
* 
* 
* 
B104  OCT 104       'D'
B117  OCT 117       'O'
KM5   DEC -5
* 
*         ***********
*         * TC TEST *
*         ***********
*     ENTRY: (A)=CORRECT TERMINATING CHAR.
TCTST NOP
      CPA TC
      JMP TCTST,I   TC=(A),EXIT
      LDA K28
      JSB ER00      IMPROPER TERMINATING CHARACTER
K28   DEC 28
* 
INT   OCT 10000          IM=1  INTEGER
LOG   OCT 30000          IM=3  LOGICAL
CPX   OCT 50000          IM=5  COMPLEX
DBL   OCT 60000          IM=6  DOUBLE
* 
* 
DUM   OCT 5000      AT=5 (RELATIVE WITHIN DUMMY LOC)
* 
* 
* 
*         *********************
*         * DECIMAL CONSTANTS *
*         *********************
K2    DEC 2
K3    DEC 3
K4    DEC 4
K13   DEC 13
K31   DEC 31
K32   DEC 32
K40   DEC 40
K41   DEC 41
K44   DEC 44
K48   DEC 48
K51   DEC 51
* 
KM4   DEC -4
KM6   DEC -6
* 
*         *******************
*         * OCTAL CONSTANTS *
*         *******************
B15   EQU K13
B50   EQU K40
B51   EQU K41
B54   EQU K44
B60   EQU K48
B75   EQU K61
* 
* 
* 
* 
I     BSS 1         SUPPLEMENTARY INDEX
JMPI  OCT 126000
* 
REL   OCT 1000
K23   DEC 23
K50   DEC 50
* 
*         ****************
*         * DO PROCESSOR *
*         ****************
DOPR  EQU *         RESTORE CC
      LDA T0SV
      STA CC             RESTORE COLUMN COUNTER
      CLA
      STA CLSW           SET TO CODE GENERATION, INPUT CARDS IF NEEDED
      JSB ICH00     INPUT CHARACTER
      CPA B104      'D'
      JMP DOPR4     TC=D
      LDA K48
      JSB ERCM      DO MISSPELLED
DOPR4 JSB ICH00     INPUT CHARACTER
      CPA B117      'O'
      JMP DOPR6
      LDA K48
      JSB ERCM      DO MISSPELLED
DOPR6 EQU *
      LDA K50
      LDB T1IFL     IM OF LOG IF EXP.
      CPB LOG
      JSB ERCM
      CLA
      STA T1IFL
      JSB ISN00     INPUT STATEMENT NUMBER
      LDA K23
      LDB AT
      CPB REL
      JSB ER00      MULTIPLIED DEFINED STATEMENT NO.
      LDA .A
      STA DOSN      DO STATEMENT NUMBER PTR SAVED
      JSB IIV00     INPUT INTEGER VARIABLE
      LDB D
DOPR5 CPB DO        LAST AVAILABLE CELL
      JMP DOPR7
      ADB K2
      LDA B,I
      CPA .A
      JMP *+3
      ADB K3
      JMP DOPR5
      LDA K51
      JSB ER00      NESTED DO WITH SAME CONTR VAR
DOPR7 EQU *
      LDA B75       '='
      JSB TCTST     TC TEST
      LDA D
      ADA KM5
      JSB DPO00     D=D-5
      LDB D
      LDA DOSN
      STA B,I       (D)=.A OF STATEMENT NUMBER
      ADB K2
      LDA .A
      STA B,I       (D+2)=.A OF INDEX VARIABLE
      LDA KM2
      LDB K12
      STB EXSW      SET E.E. SWITCH
      LDB K25
      JMP CRTST     TO EXDO
KM2   DEC -2
K25   DEC 25
* 
* 
* 
EXDO1 EQU *
      JSB ATD00     ALLOCATE TEMP CELL TO DO LOOP
      LDB D
      ADB K3
      STA B,I       (D+3)=.A OF TERMINATING INDEX
      LDA TC
      CPA B15       C/R
      JMP DOPR9     TC=C/R
      LDA KM4
      LDB K13
      JMP EECAL     E.E. CALL
K12   DEC 12
EXDO2 EQU *
      JSB ATD00     ALLOCATE TEMP CELL TO DO LOOP
DOPR8 LDB D
      INB
      STA B,I       (D+1)=.A OF INCREMENTING INDEX
      ADB K3
      LDA RPL
      STA B,I       (D+4)=RPL
      JMP ILTRM     TO ILLEGAL TERMINATOR
DOPR9 LDA DP
      INA           (A)=.A OF THE INTEGER 1
      JMP DOPR8
* 
* 
* 
* 
* 
*         ***************************************
*         * ALLOCATE TEMP CELL TO DO EXPRESSION *
*         ***************************************
*     ENTRY: (A)=.A POINTER OF INT CONST/INT VAR/TEMP CELL
* 
ATD00 NOP
      LDB .A
      ADB K2
      LDB B,I
      SSB,RSS
      JMP ATDEX     NOT INT TEMP CELL
      CCB
      ADB .INT.
      STB .INT.     .INT.=.INT.-1
ATDEX JMP ATD00,I   EXIT
* 
* 
* 
* 
* 
*         ***************************
*         * DATA POOL OVERFLOW TEST *
*         ***************************
*     INPUT: (A)=VALUE OF NEW D
DPO00 NOP
      STA D         D=(A)
      CMA,INA
      ADA LO
      ADA L         (A)=LO+L-D
      SSA
      JMP DPO00,I   EXIT
      LDA K3
      JSB ER00      DATA POOL OVERFLOW
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
*         ***************
*         * INPUT DIGIT *
*         ***************
ID00  NOP
      JSB ICH00          INPUT CHARACTER
      LDA NFL            IF CHAR. A DIGIT,NFL=0, ELSE NOT
      JMP ID00,I
* 
* 
* 
* 
* 
* 
* 
      END FTN4A
                                                                                                                                                                 24170-80019 C                                                                                             