      SPC 5
**
***  ERROR TABLE  **
**
ERR   DEF EOF+1     PREMATURE STATEMENT END
      DEF RTLE      INPUT EXCEEDS 71 CHARACTERS
      DEF INVSC     SYSTEM COMMAND NOT RECOGNIZED
      DEF SYNE1     NO STATEMENT TYPE FOUND
      DEF NUMER+1   BAD EXPONENT PART
      DEF SYE16     NO LETTER WHERE EXPECTED
      DEF SYNE2     LET STATEMENT HAS NO STORE
      DEF SYNE3     ILLEGAL COM STATEMENT
      DEF SYNE4+1   NO FUNCTION IDENTIFIER (OR BAD)
      DEF SYNE5     MISSING PARAMETER
      DEF SYNE6+1   MISSING ASSIGNMENT OPERATOR
      DEF SYNE7     MISSING 'THEN'
      DEF SYNE8+1   MISSING OR IMPROPER FOR-VARIABLE
      DEF SYNE9     MISSING 'TO'
      DEF SYE10     BAD 'STEP' PART IN FOR STATEMENT
      DEF CALER     CALLED ROUTINE DOES NOT EXIST
      DEF SYE11+1   WRONG NUMBER OF CALL PARAMETERS
      DEF SYE12     NO CONSTANT WHERE EXPECTED
      DEF SYE13     NO VARIABLE WHERE EXPECTED
      DEF SYE14     NO CLOSING QUOTE FOR STRING
      DEF SYE15     PRINT JUXTAPOSES FORMULAS
      DEF SYE17     IMPROPER WORD IN MAT STATEMENT
      DEF SYE18     NO COMMA WHERE EXPECTED
      DEF SYE19     IMPROPER ARRAY FUNCTION
      DEF SYE20     NO SUBSCRIPT WHERE EXPECTED
      DEF SYE21     ARRAY INVERSION INTO SELF
      DEF SYE22     MISSING MULTIPLICATION OPERATOR
      DEF SYE23     IMPROPER ARRAY OPERATOR
      DEF SYE24+1   ARRAY MULTIPLICATION INTO SELF
      DEF FSCE1+1   MISSING LEFT PARENTHESIS
      DEF FSCE2+1   MISSING RIGHT PARENTHESIS
      DEF FSCE3+1   UNRECOGNIZED OPERAND
      DEF ARRE1     MISSING SUBSCRIPT
      DEF ARRE2     MISSING ARRAY IDENTIFIER
      DEF SYE25+1   MISSING OR BAD INTEGER
      DEF NOEOF+1   CHARACTERS AFTER STATEMENT END
      DEF FSCE4+1   OUT OF CORE DURING SYNTAX
      DEF PRERR     PHOTO READER NOT READY
      DEF MER4      FUNCTION MULTIPLY DEFINED
      DEF MER6      UNMATCHED FOR STATEMENT
      DEF MER3      UNMATCHED NEXT
      DEF MER8      OUT OF STORAGE-SYMBOL TABLE
      DEF MSYM      INCONSISTENT DIMENSIONS
      DEF MLOP6     LAST STATEMENT IS NOT 'END'
      DEF MER5      ARRAY DOUBLE DIMENSIONED
      DEF MER10     NO OF DIMENSIONS UNSPECIFIED
      DEF MER9      ARRAY TOO LARGE
      DEF MER7      OUT OF STORAGE-ARRAY ALLOCATION
      DEF E6        SUBSCRIPT TOO LARGE
      DEF E8        UNDEFINED OPERAND ACCESSED
      DEF BASER     NEGATIVE BASE POWERED TO REAL
      DEF POWER     ZERO TO ZERO POWER
      DEF XEC5      MISSING STATEMENT
      DEF E2        GOSUBS NESTED 10 DEEP
      DEF E3        RETURN FINDS NO ADDRESS
      DEF E4        OUT OF DATA
      DEF E1+1      OUT OF STORAGE - EXECUTION
      DEF E7        RE-DIMENSIONED ARRAY TOO LARGE
      DEF LERR+1    DIMENSIONS NOT COMPATIBLE
      DEF LCHK5     MATRIX UNASSIGNED
      DEF LDUM1     NEARLY SINGULAR MATRIX
      DEF TRGER     ARGUMENT TOO LARGE
      DEF SQRER     SQRT HAS NEGATIVE ARGUMENT
      DEF LOGER     LOG OF NEGATIVE ARGUMENT
RCERR EQU *         ** RECOVERABLE ERRORS FOLLOW  **
      DEF OVRER     OVERFLOW
      DEF UNDER     UNDERFLOW
      DEF LNZR      LOG OF ZERO
      DEF EXPER     EXPONENTIAL OVERFLOW
      DEF DBYZR     DIVIDE BY ZERO
      DEF ZRTNG     ZERO TO NEGATIVE POWER
*
*
EBUFF OCT 6412
      ASC 3,ERROR
EBFF  BSS 2
LBUFF ASC 5, IN LINE
LNBFF BSS 2
      SKP
**
***  PREDEFINED FUNCTION JUMP TABLE  **
**
PDFT  DEF ETAB
      DEF ESIN
      DEF ECOS
      DEF ETAN
      DEF EATN
      DEF EEXP
      DEF ELOG
      DEF EABS
      DEF ESQR
      DEF EINT
      DEF ERND
      DEF ESGN
**
***  OUTPUT A NUMBER  **
**
NUMOT NOP           NUMBER IN (A) AND (B)
      STA EXPON     SAVE NUMBER
      SEZ,RSS       SIGN?
      JMP NS2       NO
      SSA,RSS       YES, NEGATIVE NUMBER?
      JMP NS1       NO
      JSB ARINV     YES, INVERT IT
      STA EXPON
      LDA .45
      RSS
NS1   LDA .32       STORE
      STA SIGN          SIGN
      LDA EXPON
NS2   STB GETDG     SAVE NUMBER
      JSB IFIX      INTEGERIZE
      NOP
      LDA NUMOT,I   SET
      STA NUMO1       END-OF-LINE
      STA NUMO3         OPERATION
      ISZ NUMOT     BUMP RETURN ADDRESS
      SOC           WAS IT AN INTEGER?
      JMP NUMO2     NO
**
***  OUTPUT AN INTEGER  **
**
      CLA           SAVE
      STB B1+1        INTEGER
      ADB M1000     5 OR MORE
      SSB,RSS         CHARACTERS?
      ADA .3        YES
      ADA .6        COMPUTE
      ADA CCNT        END-OF-FIELD
      CMA,INA       SAVE MARKER TO
      STA MLBX1+1     END-OF-FIELD
      ADA .74       ENOUGH
      SSA             ROOM?
NUMO1 NOP           NO
      LDA SIGN
      SZA           SIGN?
      JSB OUTCR     YES, OUTPUT IT
      LDA B1+1      OUTPUT
      JSB OUTIA,I     THE INTEGER
      JMP NUMOT,I
NUMO2 CCA           SET 'FIXED'
      STA FFLAG       FLAG FALSE
      LDA EXPON     LOAD
      LDB GETDG       NUMBER
      JSB .FADA,I   IS NUMBER
      DEF MAXFX       LESS THAN
      SSA,RSS           999999.5 ?
      JMP NUMO5     NO
      LDA EXPON     YES, IS
      LDB GETDG       NUMBER
      JSB .FADA,I       LESS
      DEF MINFX           THAN
      LDB .12               0..9999995?
      SSA,RSS
      ISZ FFLAG     NO, SET FFLAG = 0 AND SKIP
NUMO5 LDB .15       YES, LOAD 'FLOATING' FIELD WIDTH
      ADB CCNT      SAVE
      CMB,INB         END-OF-FIELD
      STB MLBX1+1       MARKER
      ADB .75       ROOM
      SSB             ENOUGH?
NUMO3 NOP           NO
**
***  OUTPUT A FLOATING POINT NUMBER  **
**
      LDA EXPON
      STA MANT1
      LDB GETDG     UNPACK
      JSB .FLUN
      STB MANT2       NUMBER
      STA EXP
      LDA SIGN
      SZA           SIGN?
      JSB OUTCR     YES, OUTPUT IT
      CLA           INITIALIZE COUNTER
      STA EXPON       FOR DECIMAL EXPONENT
      CPA EXP       EXPONENT ZERO?
      JMP EOUT4     YES
EOUT2 JSB MBY10     NO,
      LDA EXP         MULTIPLY
      CMA,INA           NUMBER BY 10
      SSA                 UNTIL
      JMP *+3               IT IS
      ISZ EXPON               GREATER
      JMP EOUT2                 THAN 1
      JSB DBY10     DIVIDE BY 10
      LDA EXPON
EOUT3 LDB EXP       DIVIDE
      CMB,INB         NUMBER
      SSB,RSS           BY 10
      JMP EOUT4           UNTIL
      STA EXPON             IT IS
      JSB DBY10               LESS
      CCA                       THAN
      ADA EXPON                   1
      JMP EOUT3
EOUT4 CMA           SET EXPONENT
      STA EXPON       TO TRUE VALUE-1
      LDB M7        SET DIGIT
      STB RETCR       COUNTER
      CCB           SET DECIMAL
      STB OUTLN       POINT FLAG
      CPB FFLAG     FIXED POINT?
      JMP EOUT6     NO
      CMA           YES, SET
      STA OUTLN       DECIMAL POINT FLAG
      CPA .1        .1?
      JMP EOUT5     YES
      SSA,RSS       LEADING DECIMAL POINT?
      JMP EOUT7+2   YES
EOUT6 JSB GETDG     OUTPUT
      ADA .48         A
      JSB OUTCR         DIGIT
      JMP EOUT8
EOUT5 LDA .46       OUTPUT
      JSB OUTCR       DECIMAL POINT
      LDA .48       OUTPUT
      JMP EOUT8-1     LEADING ZERO
EOUT7 ISZ OUTLN     DECIMAL POINT NEXT?
      JMP EOUT6     NO
      LDA .46       YES,
      JSB OUTCR       OUTPUT IT
EOUT8 ISZ RETCR     MORE MANTISSA?
      JMP EOUT7     YES
      LDA CCNT      NO,
      STA NUMO1       SAVE
      LDA BADDR         OUTPUT
      STA NUMO3           POINTERS
      JSB GETDG     NEXT DIGIT
      ADA M5          FIVE OR
      SSA               GREATER?
      JMP EOUT1     NO
      CCA           SET DECIMAL
ERND1 STA SYMCK       POINT COUNTER
      JSB RETCR     RETRIEVE CHARACTER
      CPA .46       DECIMAL POINT?
      JMP ERND1-1   YES, FLAG IT
      JSB DIGCK     NO, DIGIT?
      JMP ERND2     NO
      CPA .9        YES, 9?
      JMP *+3       YES
      ADA .49       NO, BUMP
      JMP ERND3       DIGIT 1
      LDA .48       OVERLAY
      JSB OUTCR       A ZERO
      JSB RETCR     BACKSPACE
      CCA           DECREMENT
      ADA SYMCK       DECIMAL POINT
      JMP ERND1         COUNTER
ERND2 JSB OUTCR     RESTORE CHARACTER
      ISZ EXPON     CORRECT
      NOP             EXPONENT
      LDA .49       OVERLAY A 1
      LDB FFLAG     FIXED
      SZB             POINT?
      JMP ERND3     NO
      JSB OUTCR     YES, OUTPUT CHARACTER
      LDA .48       PREPARE TO OVERLAY A ZERO
      ISZ SYMCK     DECIMAL POINT NEXT?
      JMP *-3       NO
      LDA .46       YES
ERND3 JSB OUTCR
      LDA NUMO1     RESTORE
      STA CCNT        OUTPUT
      LDA NUMO3         POINTERS
      STA BADDR
EOUT1 ISZ FFLAG     NO, FIXED POINT?
      JMP EOUT9     YES
      LDA E         NO,
      JSB OUTCR       OUTPUT 'E'
      LDA .45       LOAD '-'
      LDB EXPON     POSITIVE
      SSB             EXPONENT?
      CMB,INB,RSS   NO
      LDA .43       YES, LOAD '+'
      STB EXPON
      JSB OUTCR     OUTPUT SIGN
      LDB EXPON
      LDA .48       COMPUTE
      ADB M10
      SSB             EXPONENT
      JMP *+3
      INA               DIGIT
      JMP *-4
      ADB .58       COMPUTE
      STB EXPON       SECOND DIGIT
      JSB OUTCR     OUTPUT
      LDA EXPON
      JSB OUTCR       EXPONENT
      JMP NUMOT,I
EOUT9 JSB RETCR     RETRIEVE CHARACTER
      CPA .48       ZERO?
      JMP EOU10     YES
      JSB OUTCR     NO, RESTORE CHARACTER
      JMP NUMOT,I
EOU10 LDA .32       OVERLAY
      JSB OUTCR       A BLANK
      JSB RETCR     BACKSPACE
      JMP EOUT9
      SKP
**
***  GET DIGIT TO OUTPUT  **
**
GETDG NOP
      JSB MBY10     MULTIPLY BY 10
      LDB EXP       GET EXPONENT IN (B)
      CMB,INB         AS NEGATIVE
      AND HIMSK     KEEP 5 HIGH BITS OF (A)
      RAL           NORMALIZE TO BIT 15
      SSB,INB       ROTATE INTEGER
      JMP *-2         INTO (A)
      AND MSK0      EXTRACT
      STA NUMCK       DIGIT
      LDB EXP       ROTATE
      CMB,INB
      RAR             BACK
      SSB,INB
      JMP *-2
      XOR MANT1     REMOVE
      LDB MANT2       DIGIT
      JSB NORML     NORMALIZE REMAINDER
      LDA NUMCK     LOAD (A) WITH DIGIT
      JMP GETDG,I
**
***  RETRIEVE CHARACTER FROM OUTPUT BUFFER  **
**
RETCR NOP
      LDB CCNT      DECREMENT
      ADB M1          CHARACTER
      STB CCNT          COUNT
      LDA BADDR,I   POSITION
      SLB,RSS         AND
      ALF,ALF           EXTRACT
      AND MSK0            CHARACTER
      SLB           FIRST CHARACTER OF WORD?
      JMP RETCR,I   NO
      LDB BADDR     YES, DECREMENT
      ADB M1          BUFFER
      STB BADDR         POINTER
      JMP RETCR,I
*
*
A1    EQU SETDP
A2    EQU STSRH
C1    EQU FLWST
C2    EQU FVSRH
      HED LIBRARY ROUTINES
*               ******************************
*               SUBROUTINE TO CALCULATE TAN(X)
*               ******************************
*
*               CALLED BY A JMP ETAN WITH THE ARGUMENT
*               IN FLOATING RADIANS IN THE REGISTERS.
*               THE FLOATING RESULT IS RETURNED IN A & B
*
ETAN  JSB .FMPA,I
      DEF FOPI      4/PI
      STA XTEMP
      STB XTEMP+1
      JSB .FADA,I
      DEF K1
      JSB .PWR2
      DEC -2
      JSB .IENT
      JSB ERROR
TRGER JSB FLOAT
      JSB ARINV
      JSB .PWR2
      DEC 2
      JSB .FADA,I
      DEF XTEMP
      STA XTEMP
      STB XTEMP+1   X=X-4*ENTIER((X+1)/4)
      JSB .FSBA,I
      DEF K1
      STA SBOX      TEMPORARY
      SSA           X<1?
      JMP ELSE1     YES
      LDA K2        NO
      LDB K2+1
      JSB .FSBA,I
      DEF XTEMP
BOTH1 STA YTEMP
      STB YTEMP+1   Y= 2-X
      JSB .FMPA,I
      DEF YTEMP
      JSB .FMPA,I
      DEF K2
      JSB .FSBA,I
      DEF K1
      JSB .CHEB
      DEF COEFF
      JSB .FMPA,I
      DEF YTEMP
      STA YTEMP
      STB YTEMP+1   Y=Y*CHEBY(2*Y**2-1)
      LDA SBOX
      SSA           X<1 ?
      JMP ELSE2     YES
      LDA K1
      LDB K1+1
      JSB .FDVA,I
      DEF YTEMP
      JMP FR12A,I   ANS = 1/Y
ELSE1 LDA XTEMP
      LDB XTEMP+1
      JMP BOTH1     Y=X
ELSE2 LDA YTEMP
      LDB YTEMP+1
      JMP FR12A,I   ANS = Y
*
FOPI  DEC 1.273239545    4/PI
K1    DEC 1.
XTEMP BSS 2
YTEMP BSS 2
UTEMP BSS 2
K2    DEC 2.
COEFF DEC 1.4458E-8
      DEC 2.013766E-7
      DEC 2.804816E-6
      DEC 3.906637E-5
      DEC 5.4417038E-4
      DEC 7.586101578E-3
      DEC .10675392857
      DEC 1.7701474227
      OCT 0
      SKP
*               ******************************
*               SUBROUTINE TO CALCULATE ATN(X)
*               ******************************
*
*               CALLED BY A JMP EATN WITH THE ARGUMENT
*               IN FLOATING POINT FORM IN THE REGISTERS.
*               THE FLOATING RESULT IN THE RANGE -PI/2
*               TO PI/2 IS RETURNED IN A & B
*
EATN  STA XTEMP
      STB XTEMP+1
      LDA 1
      AND MSK0
      STA SBOX      TAN = EXP OF (X)
      SZA
      SLA           ABS (X) > 1 ?
      JMP ELS1      NO
      LDA K1
      LDB K1+1
      JSB .FDVA,I
      DEF XTEMP     U=1/X
BTH1  STA UTEMP
      STB UTEMP+1
      JSB .FMPA,I
      DEF UTEMP
      JSB .FMPA,I
      DEF K2
      JSB .FSBA,I
      DEF K1
      JSB .CHEB
      DEF COEF
      JSB .FMPA,I
      DEF UTEMP
      STA YTEMP
      STB YTEMP+1   Y=U*CHEBY(2*U**2-1)
      LDA SBOX
      SZA
      SLA           ABS(X)>1 ?
      JMP ELS2      NO
      LDA XTEMP
      SSA           X<O ?
      JMP ELS3      YES
      LDA PIBY2
      LDB PIBY2+1
      JMP ELS3+2    ANS = PI/2 - Y
ELS1  LDA XTEMP
      LDB XTEMP+1
      JMP BTH1      U=X
ELS2  LDA YTEMP
      LDB YTEMP+1
      JMP FR12A,I   ANS = Y
ELS3  LDA MP2
      LDB MP2+1
      JSB .FSBA,I
      DEF YTEMP     ANS=-PI/2-Y
      JMP FR12A,I
*
PIBY2 DEC 1.5707963268   PI/2
MP2   DEC -1.5707963268  -PI/2
COEF  DEC -1.33034E-8
      DEC 8.64888E-8
      DEC -56.99186E-8
      DEC 3.821037E-6
      DEC -2.6215196E-5
      DEC 1.8574297E-4
      DEC -1.381195004E-3
      DEC .01113584206
      DEC -.1058929245
      DEC 1.762747174
      OCT 0
      SPC 5
*               ******************************
*               SUBROUTINE TO COMPUTE ABS(X)
*               ******************************
*
*               CALLED BY A JMP EABS WITH THE ARGUMENT
*               IN FLOATING POINT FORM IN THE REGISTERS.
*               THE ABSOLUTE VALUE IN FLOATING POINT
*               IS RETURNED IN A S B
*
EABS  SSA           NEGATIVE?
      JSB ARINV     YES, NEGATE IT
      JMP FR12A,I
