**
***  FORMULA OPERATOR JUMP TABLE  **
**
AROTB DEF ESCMA     SUBSCRIPT SEPARATOR
      DEF ESTR      ASSIGNMENT OPERATOR
      DEF EFAD      '+'
      DEF EFSB      '-'
      DEF EFMP      '*'
      DEF EFDV      '/'
      DEF EPWR      '^'
      DEF EGTRT     '>'
      DEF ELST      '<'
      DEF ENEQL     '#'
      DEF EEQL      '='
      DEF EUMIN     UNARY '-'
      DEF ELBRC     '['
      DEF FOR1A,I   '('
      DEF FOR0B,I   UNARY '+'
      DEF EOR       OR
      DEF EAND      AND
      DEF ENOT      NOT
      DEF EGORE     '>='
      DEF ELORE     '<='
**
***  EXECUTE A BINARY OPERATOR  **
**
BINOP NOP           SAVE
      LDA BINOP,I     SUBROUTINE
      STA BINO1         CALL
      ISZ BINOP     SET RETURN ADDRESS
      JSB OPCHK     SAVE ADDRESS OF
      STB BINO2       TOP OPERAND
      ISZ HSTPT     UNSTACK ADDRESS
      JSB STTOP     LOAD SECOND OPERAND
BINO1 NOP           PERFORM OPERATION
BINO2 NOP           ADDRESS OF SECOND OPERAND
      JMP BINOP,I
      SKP
**
***  EXECUTE SUBSCRIPT COMMA  **
**
ESCMA JSB ESBS      INTEGERIZE COLUMN SUBSCRIPT
      ISZ LSTPT
      JSB ESBS      INTEGERIZE ROW SUBSCRIPT
      LDB HSTPT,I   FETCH
      ADB .2          SUBSCRIPT
      LDA 1,I           ROUNDS
      AND MSK0      SAVE
      STA OUTLN       COLUMN BOUND
      LDA 1,I       EXTRACT
      ALF,ALF         ROW
      AND MSK0          BOUND
      CMA,INA       ACTUAL
      ADA LSTPT,I     ROW SUBSCRIPT
      SSA,RSS           LEGAL?
      JMP E6-1      NO
      LDA OUTLN     YES
      CPA .1        COLUMN MATRIX?
      JMP ESCM1     YES
      JSB MPY       NO, COMPUTE ADDRESS
      DEF LSTPT,I     DISPLACEMENT
      RSS               DUE TO ROWS
ESCM1 LDA LSTPT,I
      CCB           UNSTACK
      ADB LSTPT       ROW
      STB LSTPT         SUBSCRIPT
      LDB OUTLN     ACTUAL
      CMB,INB         COLUMN
      ADB LSTPT,I       SUBSCRIPT
      SSB,RSS             LEGAL?
      JSB ERROR     NO
E6    ADA LSTPT,I   YES, ADD IN COLUMN DISPLACEMENT
      ALS           DOUBLE DISPLACEMENT
      LDB HSTPT,I   COMPUTE
      ADA 1,I         ACTUAL
      STA HSTPT,I       ADDRESS
      LDB LSTPT     UNSTACK
      ADB M1
      STB LSTPT         (
      JMP FOR1A,I
**
***  INTEGERIZE A SUBSCRIPT  **
**
ESBS  NOP
      JSB OPCHK     VALIDATE SUBSCRIPT
      LDA 1,I       FETCH
      INB             SUBSCRIPT
      LDB 1,I
      JSB SBFIX     INTEGERIZE
      STB LSTPT,I   SAVE IN OPERATOR STACK
      ISZ HSTPT     POP OPERAND STACK
      JMP ESBS,I
      SKP
**
***  EXECUTE STORE  **
**
ESTR  LDB TEMPS+7   IS NEXT OPERATOR
      SZB             AN END-OF-FORMULA?
      JMP FOR1B,I   NO, DEFER STORE
      CPB TEMPS+6   YES, FIRST STORE OPERATOR USED?
      JMP ESTR2     YES
ESTR1 LDA HSTPT,I   SET
      STA TEMPS+9     DESTINATION
      LDA TEMPS+6   SOURCE ADDRESS IN (A)
      LDB 0,I       TRANSFER HIGH
      STB TEMPS+9,I   PART OF SOURCE
      ISZ TEMPS+9   UPDATE
      INA             POINTERS
      LDB 0,I       TRANSFER LOW
      STB TEMPS+9,I   PART OF SOURCE
      ISZ HSTPT     POP STACK
      JMP FOR0B,I
ESTR2 JSB OPCHK     SAVE ADDRESS
      STB TEMPS+6     OF QUANTITY
      ISZ HSTPT     YES, POP HIGH-CORE
      JMP ESTR1       STACK AND EXECUTE STORE
**
***  CALL ADD  **
**
EFAD  JSB BINOP
      JSB .FAD
      JMP FOR0A,I
**
***  CALL SUBTRACT  **
**
EFSB  JSB BINOP
      JSB .FSB
      JMP FOR0A,I
**
***  CALL MULTIPLY  **
**
EFMP  JSB BINOP
      JSB .FMP
      JMP FOR0A,I
**
***  CALL DIVIDE  **
**
EFDV  JSB BINOP
      JSB .FDV
      JMP FOR0A,I
**
***  EXECUTE ^  **
**
EPWR  LDB HSTPT,I   LOAD
      LDA 1,I
      INB             POWER
      LDB 1,I
      JSB IFIX
      JMP *+3
      SOS           INTEGER?
      JMP EPWR1     YES
      JSB BINOP     NO
      JMP RPWR
RPWR  JSB PCHK      CHECK ARGUMENTS
      SSA           NEGATIVE BASE?
      JSB ERROR     YES
BASER EQU *
      LDB BINO1     NO, LOAD BASE
      JSB .LOGA,I   TAKE NATURAL LOG
      JSB .FMP      MULTIPLY
      DEF BINO2,I     BY POWER
      JSB .EXPA,I   EXPONENTIATE
      JMP FOR0A,I     RESULT
EPWR1 STB TT1       SAVE SIGN
      SSB           SAVE
      CMB,INB         ABSOLUTE VALUE
      STB TT2           OF POWER
      JSB BINOP
      JMP IPWR
IPWR  JSB PCHK      CHECK ARGUMENTS
      LDB BINO1     STORE
      STA BINO1
      STB BINO2       BASE
      LDA HONE      INITIALIZE
      STA TT3         RESULT
      LDA .2            TO
      STA TT4             1.0
IPWR1 LDB TT2       DIVIDE POWER
      SLB,BRS         BY 2
      JMP IPWR3     WAS ODD
      STB TT2       WAS EVEN
IPWR2 SZB           ZERO?
      JMP IPWR4     NO
      LDA TT1       YES
      SSA           POSITIVE POWER?
      JMP IPWR5     NO
      LDA TT3       YES,LOAD
      LDB TT4         RESULT
      JMP FOR0A,I
IPWR5 LDA HONE      LOAD
      LDB .2          1.0
      JSB .FDV      DIVIDE BY
      DEF TT3         RESULT
      JMP FOR0A,I
IPWR3 STB TT2       SAVE POWER
      LDA BINO1     LOAD
      LDB BINO2       BASE
      JSB .FMP      MULTIPLY BY
      DEF TT3         RESULT-SO-FAR
      STA TT3       SAVE PARTIAL
      STB TT4         RESULT
      LDB TT2       LOAD POWER
      JMP IPWR2
IPWR4 LDA BINO1     LOAD
      LDB BINO2       BASE
      JSB .FMP      SQUARE
      DEF BINO1       IT
      STA BINO1     SAVE
      STB BINO2       RESULT
      JMP IPWR1
**
***  INSURE VALID OPERATION  **
**
PCHK  NOP
      STB BINO1     LOAD
      LDB BINO2,I     POWER
      SZA           BASE ZERO?
      JMP PCHK1     NO
      SZB,RSS       YES, POWER ZERO?
      JSB ERROR     YES
POWER EQU *
      SSB,RSS       NO, POWER POSITIVE?
      JMP FALSE     YES
      JSB ERROR     NO
ZRTNG LDA INF       USE POSITIVE
      LDB M2          INFINITY
      JMP FOR0A,I
PCHK1 SZB,RSS       POWER ZERO?
      JMP TRUE      YES, RETURN 1.0
      JMP PCHK,I    NO
**
***  EXECUTE >  **
**
EGTRT JSB BINOP     COMPUTE OPERAND
      JSB .FSB        DIFFERENCE
      SSA           NEGATIVE?
      JMP FALSE     YES
      JMP ENEQ1     NO
**
***  EXECUTE <  **
**
ELST  JSB BINOP     COMPUTE OPERAND
      JSB .FSB        DIFFERENCE
      SSA           NEGATIVE?
      JMP TRUE      YES
      JMP FALSE     NO
**
***  EXECUTE =  **
**
EEQL  JSB BINOP     COMPUTE OPERAND
      JSB .FSB        DIFFERENCE
EEQL1 SZA           ZERO?
      JMP FALSE     NO
      JMP TRUE      YES
      SKP
**
***  EXECUTE >=  **
**
EGORE JSB BINOP     COMPUTE OPERAND
      JSB .FSB        DIFFERENCE
      SSA           POSITIVE?
      JMP FALSE     NO
      JMP TRUE      YES
**
***  EXECUTE <=  **
**
ELORE JSB BINOP     COMPUTE OPERAND
      JSB .FSB        DIFFERENCE
      SSA           NEGATIVE?
      JMP TRUE      YES
      JMP EEQL1     NO
**
***  EXECUTE #  **
**
ENEQL JSB BINOP     COMPUTE OPERAND
      JSB .FSB        DIFFERENCE
ENEQ1 SZA           NON-ZERO?
      JMP TRUE      YES
**
***  SET LOGICAL VALUES  **
**
FALSE CLA           LOAD
      CLB             ZERO
      JMP FOR0A,I
TRUE  LDA HONE      LOAD
      LDB .2          ONE
      JMP FOR0A,I
**
***  EXECUTE UNARY -  **
**
EUMIN JSB STTOP     LOAD NUMBER
      JSB ARINV     NEGATE NUMBER
      JMP FOR0A,I
**
***  EXECUTE LEFT BRACKET  **
**
ELBRC ISZ LSTPT     LOAD SUBSCRIPT COMMA
      LDB SCCNT       INFORMATION WORD
      JSB SLWST     STACK IT
      JSB BHSTP     STACK
      JSB RSCHK
      JMP TRUE        1
**
***  EXECUTE OR  **
**
EOR   JSB BINOP     VALIDATE
      JMP ORS         OPERANDS
ORS   SZA           SECOND OPERAND NON-ZERO?
      JMP TRUE      YES
ORS1  LDA BINO2,I   NO, CHECK SECOND
      JMP ENEQ1       OPERAND
**
***  EXECUTE AND  **
**
EAND  JSB BINOP     VALIDATE
      JMP ANDS        OPERANDS
ANDS  SZA,RSS       SECOND OPERAND ZERO?
      JMP FALSE     YES
      JMP ORS1      NO
**
***  EXECUTE NOT  **
**
ENOT  JSB STTOP     LOAD OPERAND
      SZA           ZERO?
      JMP FALSE     NO
      JMP TRUE      YES
**
***  ADD TWO FLOATING POINT QUANTITIES  **
**
ADMUP NOP
      LDA OUTLN     COMPUTE
ADMU1 CMA,INA         EXPONENT
      ADA EXP           DIFFERENCE
      SSA,RSS       ARG 1 LARGER?
      JMP ADMU2     YES
      LDA A1        NO,
      LDB A2          SWAP
      STA A2            ARGUMENTS
      STB A1
      LDA C1
      LDB C2
      STA C2
      STB C1
      LDA EXP
      LDB OUTLN
      STA OUTLN
      STB EXP
      JMP ADMU1
ADMU2 ADA M25       SHIFT COUNT >=
      LDB C1
      SSA,RSS         25 ?
      JMP ADMU4     YES, IGNORE SMALLER ARGUMENT
      CMA,CLE       NO, COMPUTE
      ADA M25         SHIFT COUNT
      STA OUTLN         AS NEGATIVE
      LDA A2        LOAD SMALLER
      LDB C2        MANTISSA
ADMU3 ISZ OUTLN     MORE SHIFTS?
      JMP ADMU5     YES
      ADB C1        NO, ADD LOW MANTISSAS
      CLO
      RBR,ELB       SAVE (E) IN B(0)
      CLE
      ADA A1        ADD HIGH MANTISSAS
      SLB           OVERFLOW FROM LOWER MANTISSA?
      INA           YES, ADD IT IN
      ERB,CLE,ELB   ERASE B(0)
      SOS           OVERFLOW?
      JMP ADMU4+1   NO
      ERA           YES, SHIFT
      ERB             MANTISSA DOWN AND
      ISZ EXP           CORRECT EXPONENT
      JMP ADMU4+1
      RSS
ADMU4 LDA A1        RETRIEVE HIGH MANTISSA
      JSB .PACK     NORMALIZE AND PACK
      JMP ADMUP,I
ADMU5 CLE,SLA,ARS   ARITHMETIC
      CME             DOUBLE
      ERB,CLE           SHIFT
      JMP ADMU3
**
***  ADD TWO FLOATING POINT NUMBERS  **
**
.FAD  NOP
      JSB UNPAK     UNPACK THE ARGUMENTS
      JSB ADMUP     ADD THEM UP
      JMP .FAD,I
**
***  SUBTRACT TWO FLOATING POINT NUMBERS  **
**
.FSB  NOP
      JSB UNPAK     UNPACK THE ARGUMENTS
      LDA A2        TWO'S COMPLEMENT
      CMA             THE SECOND ARGUMENT
      CMB,INB,SZB   LOW PART ZERO?
      JMP .FSB1     NO
      SSA,INA,RSS   YES, ORIGINAL NUMBER NEGATIVE?
      SSA,RSS       YES, STILL NEGATIVE?
      JMP .FSB1     NO
      RAR           YES, SHIFT DOWN AND
      ISZ OUTLN       CORRECT EXPONENT
.FSB1 STB C2        SAVE COMPLEMENTED
      STA A2          NUMBER
      JSB ADMUP     ADD ARGUMENTS
      JMP .FSB,I
**
***  UNPACK ARGUMENTS FOR ARITHMETIC OPERATIONS  **
**
UNPAK NOP
      STA A1        SAVE HIGH PART OF ARG 1
      SZA,RSS       UNPACK
      CLB,INB         SECOND
      JSB .FLUN         WORD
      STB C1        SAVE LOW PART OF ARG 1
      STA EXP       SAVE EXPONENT OF ARG 1
      LDA UNPAK     COMPUTE ADDRESS OF
      ADA M2          CALLING ROUTINE
      LDB 0,I
      ISZ 0,I       SET CALLING ROUTINE'S RETURN
      LDB 1,I       LOAD
      RBL,CLE,SLB,ERB   ADDRESS OF
      JMP *-2             ARG 2
      LDA 1,I       LOAD
      INB             ARG 2
      LDB 1,I
      STA A2        SAVE HIGH PART OF ARG 2
      SZA,RSS       UNPACK
      CLB,INB         SECOND
      JSB .FLUN         WORD
      STB C2        SAVE LOW PART OF ARG 2
      STA OUTLN     SAVE EXPONENT OF ARG 2
      JMP UNPAK,I
**
***  MULTIPLY TWO FLOATING POINT NUMBERS  **
**
.FMP  NOP           UNPACK THE
      JSB UNPAK       ARGUMENTS
      ADA EXP       ADD EXPONENTS
      INA             PLUS 1 FOR
      STA EXP           NORMALIZATION
      RBR           POSITION LOW PART OF ARG 2
      LDA 1         COMPUTE A
      JSB MPY         CROSS PRODUCT
      DEF A1
      STA C2        SAVE RESULT
      LDA C1        LOAD AND POSITION
      RAR             LOW PART OF ARG 1
      STB C1        SAVE REST OF PRIOR RESULT
      JSB MPY       COMPUTE SECOND
      DEF A2          CROSS PRODUCT
      ADB C1        ADD
      CLE             CROSS
      ADA C2            PRODUCTS
      SEZ           CORRECT
      INB             FOR CARRY
      STB C2        SAVE RESULT
      LDA A1        COMPUTE
      JSB MPY         HIGH PART
      DEF A2            OF PRODUCT
      CLE,ERA       POSITION LOW PART
      ADA C2        ADD IN CROSS TERMS
      CLE,ELA       REPOSITION
      SEZ,RSS       CARRY FROM LOW PART?
      JMP *+4       NO
      SOC           YES, POSITIVE CARRY?
      INB,RSS       YES
      ADB M1        NO
      STA A1        EXCHANGE
      LDA 1
      LDB A1          REGISTERS
      JSB .PACK     NORMALIZE AND PACK
      JMP .FMP,I
      SKP
**
***  PERFORM FLOATING DIVIDE  **
**
.FDV  NOP
      JSB UNPAK     UNPACK ARGUMENTS
      LDB A2        DIVISOR
      SZB,RSS         ZERO?
      JMP .FDV2     YES
      LDB A1        NO, DIVIDEND
      SZB,RSS         ZERO?
      JMP .FDV1     YES
      CMA,INA       NO, COMPUTE
      INA             EXPONENT
      ADA EXP           DIFFERENCE
      STA EXP             PLUS 1
      LDA C1        LOAD DIVIDEND
      CLE,SLB,BRS   ARITHMETIC
      CME             RIGHT SHIFT
      ERA               TWICE TO
      CLE,SLB,BRS         PREVENT
      CME                   DIVISION
      ERA                     OVERFLOW
      JSB IDIV      DIVIDE
      STA OUTLN     SAVE QUOTIENT
      BRS           DIVIDE REMAINDER BY 2 TO
      CLA             PREVENT DIVISION OVERFLOW
      JSB IDIV      DIVIDE REMAINDER AND
      STA NUMCK       SAVE LOW PART OF QUOTIENT
      LDB C2
      CLA,CLE       SCALE TO
      ERB,BRS         PREVENT
      BRS               OVERFLOW
      JSB IDIV      COMPUTE B2/A2 = Q
      CMA,INA       COMPUTE
      JSB MPY         -HIGH QUOTIENT*Q
      DEF OUTLN
      BLS,CLE,ELB   SHIFT SIGN TO (E)
      LDA NUMCK     LOW QUOTIENT
      SSA             NEGATIVE?
      CCA,RSS       YES, SET (A)=-1  (EXTEND
      CLA           NO, SET (A)=0       SIGN)
      CMA,SEZ       IF (E)=1 SUBTRACT
      INA             1 AS EXTENSION
      CMA,CLE           OF PRODUCT
      ADB NUMCK     ADD IN LOW QUOTIENT
      SEZ           CARRY
      INA             INTO (A)
      CLE,ELB       POSITION
      ELA             REGISTERS
      ADA OUTLN     ADD IN HIGH QUOTIENT
      RSS
.FDV1 CLA           SET MANTISSA TO ZERO
      JSB .PACK     NORMALIZE AND PACK
      JMP .FDV,I
.FDV2 JSB ERROR     DIVIDE-BY-ZERO
DBYZR LDA A1
      JSB OVFLW     RETURN INFINITY
      JMP .FDV,I
**
***  INTEGER DIVIDE  **
**
IDIV  NOP           DIVIDEND IN (B) AND (A)
      STB A1        SAVE HIGH DIVIDEND
      LDB A2
      CLE,SSB       SET (B) TO ABS(B)
      CMB,CME,INB     AND (E) TO SIGN(B)
      STB .FAD      SAVE POSITIVE DIVISOR
      CMB,INB       SAVE
      STB .FSB        NEGATIVE DIVISOR
      LDB M16       SET
      STB C1          COUNTER
      LDB M2        SET
      STB SIGN
      STB .FMP        SIGNS
      LDB A1        RETRIEVE HIGH DIVIDENED
      SSB,RSS       POSITIVE?
      JMP IDIV1     YES
      ISZ .FMP      NO, SET REMAINDER SIGN
      CMB,CME         NEGATIVE AND COMPLEMENT
      SZA               THE DIVISOR
      CMA,INA,RSS         AND (E)
      INB
IDIV1 SEZ           QUOTIENT POSITIVE?
      ISZ SIGN      NO
IDIV2 CLE,ELA       SHIFT
      ELB             DIVIDEND
      ADB .FSB      SUBTRACT DIVISOR
      SSB,RSS       OK?
      INA,RSS       YES
      ADB .FAD      NO, RESTORE DIVIDEND
      ISZ C1        DONE?
      JMP IDIV2     NO
      CMA,INA       YES, NEGATE QUOTIENT
      ISZ SIGN      RESULT TO BE POSITIVE?
      CMA,INA       YES
      ISZ .FMP      NO, REMAINDER POSITIVE?
      JMP IDIV,I    YES
      CMB,INB       NO
      JMP IDIV,I
      SKP
*               ******************************
*               SYMBOL TABLE SEARCH SUBROUTINE
*               ******************************
*
*               THE SUBROUTINE IS CALLED WITH THE IDENTIFIER TO BE
*               SEARCHED FOR IN A . THE SUBROUTINE RETURNS WITH
*               THE ADDRESS OF THE MATCHING ENTRY IN B OR -1 IN
*               B IF THERE IS NO MATCHING ENTRY
*               THE FOLLOWING RULES APPLY WHEN SEARCHING FOR ARRAYS
*
*               TYPE 1 (1 DIMENSION) SEARCH FOR CORRESPONDING TYPE 1
*               OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE THE ENTRY
*               TYPE TO TYPE 1
*
*               TYPE 2 (2 DIMENSIONS) SEARCH FOR CORRESPONDING TYPES
*               OR TYPE 3 ARRAY. IF TYPE 3 IS FORND CHANGE THE ENTRY
*               TYPE TO TYPE 2
*
*               TYPE 3 (UNDIMENSIONED) SEARCH FOR CORRESPONDING
*               TYPE 3 OR TYPE 1 OR TYPE 2 ARRAY
*
SSYMT NOP
      STA STEMP    STORE IDENTIFIER
      AND .15      ISOLATE IDENTIFIER TYPE
      ADA M4
      SSA,INA
      JMP *+4      JUMP IF ARRAY TYPE
      LDA STEMP    RESTORE A
      STA 1        STORE IN B
      JMP SYMT1+3
      SSA          SKIP IF UNDIMENSIONED
      JMP SYMT1
      LDA STEMP    RESTORE A
      AND MSK3     177771B SET TYPE TO 1
      STA 1
      INB          SET TYPE IN B TO 2
      JMP *+4
SYMT1 CCB          SET DIMENSIONED FLAG IN B
      LDA .3
      IOR STEMP    SET TYPE TO UNDEFINED
      STA STEMP+1  STORE A
      STB STEMP+2  STORE B
      LDB SYMTF    START OF SYMBOL TABLE
      JMP SYMT4
SYMT2 LDA 1,I      PICK UP 1ST WORD OF ENTRY
      CPA STEMP    COMPARE WITH IDENTIFIER
      JMP SSYMT,I  MATCH ?  RETURN
      CPA STEMP+1  COMPARE WITH DIFFERENT DIM.
      JMP SYMT3
      CPA STEMP+2  COMPARE WITH DIFFERENT DIM.
      JMP SYMT3
      LDA 1,I
      AND .15      ISOLATE ENTRY TYPE
      CPA .15      FUNCTION ?
      JMP *+5      YES
      ADA M4
      SSA          ARRAY ?
      INB          YES INCREMENT POINTER
      INB          INCREMENT POINTER
      ADB .2       ADD 2 TO POINTER
SYMT4 CPB SYMTA     SYMBOL TABLE EXHAUSTED?
      CCB,RSS       YES
      JMP SYMT2     NO, CHECK NEXT ENTRY FOR MATCH
      LDA STEMP     RETRIEVE SYMBOL
      JMP SSYMT,I  RETURN WITH B NEGATIVE
SYMT3 LDA STEMP    RESTORE A
      ISZ STEMP+2  DIMENSIONED IDENTIFIER?
      RSS          NO, SKIP
      STA 1,I      YES CHANGE 1ST WORD OF ENTRY TO
      JMP SSYMT,I  APPROPRIATE DIMENSION TYPE
