*DECK,MATH
          IDENT     BASATRI 
          TITLE  TRIG FUNCTIONS 
*CALL COPYRITE
          ENTRY     BASASIN,BATASIN 
          ENTRY     BASACOS,BATACOS 
          ENTRY     BASATAN,BATATAN 
          ENTRY     BASACOT,BATACOT 
          EXT       BASEGEN 
          COMMENT BASIC 3 - TRIGONOMETRIC ROUTINES. 
          EXT    RNBLOCK,RNLIST,DBUGON
* 
* 
 MOVEREG  MACRO     XX,YY 
          IFNE      XX,YY,1 
          BX.YY     X.XX                MOVE XX TO YY 
          ENDM
* 
 INF      MACRO     XX
         SX.XX     3777B                INFINITY
         LX.XX     48 
          ENDM
* 
 UV       EQU       5 
*CALL,ERMNUM
* 
* 
*         ERROR-MESSAGES
* 
 ERM148   DATA   C* ARGUMENT IS POLE IN COT * 
 ERM149   DATA   C* ARGUMENT TOO LARGE IN COT * 
 ERM150   DATA   C* ARGUMENT TOO LARGE IN SIN * 
 ERM151   DATA   C* ARGUMENT TOO LARGE IN TAN * 
 ERM152   DATA   C* ARGUMENT TOO LARGE IN COS * 
 ERM153   DATA   C* ARGUMENT IS POLE IN TAN * 
          TITLE  SIN,COS,TAN AND COT
* 
*         SIN(X) - ARGUMENT IN UV AND RESULT IN UV
* 
          DATA      10HBASASIN
 BASASIN  BSSZ      1 
          SB7    ERM150      *ARGUMENT TOO LARGE IN SIN*
          SB6         B0               .SIN KEY = 0 
          RJ        SINCOSTN
          EQ        BASASIN 
* 
*         END OF SIN(X) 
* 
*         COS(X) - ARGUMENT IN UV AND RESULT LEFT IN UV 
* 
          DATA      10HBASACOS
 BASACOS  BSSZ      1 
          SB7    ERM152      *ARGUMENT TOO LARGE IN COS*
          SB6         1                .COSINE KEY = 1
          RJ        SINCOSTN
          EQ        BASACOS 
* 
*         END OF COS(X) 
* 
*         TAN(X) - ARGUMENT IN UV AND RESULT IN UV
* 
          DATA      10HBASATAN
 BASATAN  BSSZ      1 
          ID        X.UV,TAN1XXX        RETURN UNDEFINED
          BX6       X.UV
          SA6       TANARG              SAVE ARGUMENT 
          SB7    ERM151      *ARGUMENT TOO LARGE IN TAN*
          SB6       B0                  SET SIN 
          RJ        SINCOSTN
          BX6       X.UV
          SA.UV     TANARG              RE-FETCH ARGUMENT 
          SA6       A.UV                SAVE SIN
          SB7    B0          * * NO ERROR * * 
          SB6       1                   SET COS 
          RJ        SINCOSTN
          BX6       X.UV
          SA.UV     TANARG
          ZR        X6,TANERXX          CHECK FOR DIVISION BY ZERO
          FX.UV     X.UV/X6 
 TAN1XXX  BSS       0 
          EQ        BASATAN 
 TANERXX  BSS       0 
          ZR        X.UV,TAN1XXX        ARGUMENT TOO LARGE
          RTERROR ERMN153,ERM153,BASEGEN   *ARGUMENT TOO LARGE *
* 
 TANARG   BSS       1 
* 
*         END OF TAN(X) 
* 
* 
*  COT(X) = COS(X)/SIN(X) 
* 
          DATA   10HBASACOT 
 BASACOT  DATA   0
          ID    X.UV,BASACOT       RETURN SAME VALUE IF INDEFINITE
          BX6    X.UV              SAVE ARG 
  
          SA6    COTARG 
          SB7    ERM149            ERR MSG ADDR - *ARG TOO LARGE* 
          SB6    1                 SELECT COS 
          RJ   SINCOSTN 
          BX6    X.UV 
          SA.UV  COTARG            REFETCH ARG
          SA6    A.UV              SAVE COS(ARG)
          SB7    B0                NO ERROR ADDR
          SB6    B0                SELECT SIN 
          RJ   SINCOSTN 
          BX6    X.UV              X6 = SIN(ARG)
          SA.UV  COTARG            X.UV = COS(ARG)
          ZR   X6,COTER            DO NOT DIVIDE BY ZERO
          FX.UV  X.UV/X6           COT = COS/SIN
          EQ   BASACOT             DONE 
 COTER    BSS     0 
          RTERROR ERMN148,ERM148,BASEGEN   *ARGUMENT IS POLE *
* 
 COTARG   BSS    1
* 
*   END OF COT(X) 
* 
          EJECT 
* 
*         SINCOSTN(X) - ARGUMENT IN UV AND RESULT IN UV 
* 
 SINCOSTN BSSZ      1 
          SX7       B5
          SA7       TSAVEB5             SAVE B5 
          MOVEREG   UV,5                MOVE ARGUMENT TO X5 
          ID          X5,COS3XXX       .EXIT DIRECTLY INTO INDEFINITE 
          OR          X5,COS4XXX       .ALARM EXIT FOR OUT OF RANGE 
          SA2         COS2PIX          .LOAD 2/PI 
          FX7         X5*X2            .N=ARG*2/PI
          MX0         0                .
          PX2         X0               .MASK = 2000...B 
          FX4         X2+X7            .
          DX6         X2+X7            .
          RX0         X4+X6            .ROUNDED N IN X0 
          NX1         B5,X0            .NORMALIZED FOR RANGE REDUCTION
          BX6         X2-X0            .N IN INTEGER FORMAT 
          IX0         X2+X6            .POSITIVE
          EQ          B5,B0,COS4XXX    .ALARM EXIT FOR LARGE ARGUMENT 
          SB5         1                .
          SA2         A2+B5            .PI/2-U
          FX7         X1*X2            .N*(PI/2-U),UPPER = H1 
          SA4         A2+B5            .PI/2-L
          ZR          X6,COS5XXX       .NO RANGE REDUCTION NEEDED 
          FX6         X5-X7            .(ARG-H1), UPPER 
          DX3         X2*X1            .N*(PI/2-U),LOWER = H2 
          DX2         X5-X7            .(ARG-H1),LOWER
          NX6         B0,X6               . 
          FX7         X4*X1            .N*(PI/2-L),UPPER
          FX2         X2-X3            .
          SX1         B6               .K TO X1 
          FX2         X2-X7            .LOW ORDER TERMS 
          IX0         X0+X1            .N+K+2  POWER  58   GREATER   0
          MX3         58               .X3=-3 
          BX7         -X3*X0           .K=(N+K) MOD 4 
          RX6         X6+X2            .X=FINAL REDUCED ARGUMENT
          SB6         X7               .K BACK TO B6
          NX5         B0,X6               .NORMALIZED 
 COS5XXX  SX6         B6               .K TO X6 
          FX0         X5*X5            .Z=X*X 
          LX6         59               .K=0,2 USE SINE EVALUATION 
          SA1         A4+B5            .C5
          PL     X6,COS6XXX 
          FX7         X0*X0            .Z*Z 
          SA2         A1+B5            .C6
          FX4         X0*X1            .C5*Z
          FX3         X2*X7            .C6*Z*Z
          SA5         A2+B5            .C4
          FX6         X4+X5            .C5*Z+C4 
          SA4         A5+B5            .C3
          FX1         X4*X0            .C3*Z
          FX6         X6+X3            .C6*Z*Z+C5*Z+C4=(1)
          FX2         X6*X7            .(1)*Z*Z 
          SA5         A4+B5            .C2
          FX6         X1+X5            .C3*Z+C2 
          SA4         A5+B5            .C1
          FX6         X2+X6            .(1)*Z*Z+C3*Z+C2=(2) 
          FX0         X0*X4            .C1*Z
          SA3         A4+B5            .C0
          FX7         X6*X7            .(2)*Z*Z 
          FX6         X7+X0            .(2)*Z*Z+C1*Z
          RX4    X6+X3             C3+REST OF SERIES
          RX0    X4+X3
          JP          COS7XXX          .JOIN COMMON ROUTE 
 COS6XXX  SA1         COSS5XX          .S5
          FX6         X1*X0            .S5*Z
          SA2         A1+B5            .S4
          FX7         X0*X0            .Z*Z 
          FX3         X2+X6            .S5*Z+S4 
          SA1         A2+B5            .S3
          SA2         A1+B5            .S2
          FX6         X3*X7            .(S5*Z+S4)*Z*Z 
          FX4         X1*X0            .S3*Z
          FX3         X6+X2            .(S5*Z+S4)*Z*Z+S2
          SA2         A2+B5            .S1
          FX3         X3+X4            .(S5*Z+S4)*Z*Z+S3*Z+S2=(3) 
          FX7         X3*X7            .(3)*Z*Z 
          FX0         X2*X0            .S1*Z
          SA1         A2+B5            .S0
          FX4         X0+X7            .
          RX3         X4+X1            .
          RX0         X5*X3            .FINAL SINE TERM 
 COS7XXX  SX5         B5-B6            .1-K 
          AX5         2                .SIGN(1-K) 
          BX5         X0-X5            .RESULT IN UV
 COS3XXX  BSS       0 
          MOVEREG   5,UV                MOVE RESULT TO UV 
          SA1       TSAVEB5 
          SB5       X1                  RESET B5
          EQ        SINCOSTN
 COS4XXX  BSS       0 
         SX0       B6 
          SB6    ERM150 
          EQ     B6,B7,SINMESS     SKIP IF SIN INVOLVED 
* 
          SB6    ERM152 
          EQ     B6,B7,COSMESS     SKIP IF COS INVOLVED 
* 
          SB6    ERM149 
          EQ   B6,B7,COTMESS       SKIP IF COT
* 
          SX7    ERMN151     *ARGUMENT TOO LARGE IN TAN*
          EQ     MESSX
* 
 SINMESS  BSS    0
          SX7    ERMN150     *ARGUMENT TOO LARGE IN SIN*
          EQ     MESSX
* 
 COSMESS  BSS    0
          SX7    ERMN152     *ARGUMENT TOO LARGE IN COS*
          EQ   MESSX
* 
 COTMESS  SX7    ERMN149           ERR NUMBER 
* 
* 
 MESSX    BSS    0
         SB6       X0 
          SA1    DBUGON            FETCH CID MODE FLAG
          ZR     X1,BASEGEN        BR, NOT IN CID MODE
          SA7    RNBLOCK+1         SAVE ERR MESSAGE NUMBER
          SX6    B7                FETCH ERR MESSAGE ADDR 
          SA6    A7+1 
          JP     =YDBUG.ON
         EQ        BASEGEN
* 
 COS2PIX  DATA        17175057460333447104B        .00,2*PI 
          DATA        17206220773250420550B        .01,DCSC1
          DATA        16406043230461461213B        .02,DCSC2
          DATA        61053301014524016617B        .03,C5 
          DATA        16634334143344163607B        .04,C6 
          DATA        17006400637375136457B        .05,C4 
          DATA        60712237223723423125B        .06,C3 
          DATA        17135252525252523467B        .07,C2 
          DATA        60610000000000000004B        .08,C1 
          DATA   17174000000000000000B .09,C0 
 COSS5XX  DATA        61111270663112476351B        .10,S5 
          DATA        16755616534201617573B        .11,S4 
          DATA        60741377140534357734B        .12,S3 
          DATA        17114210421041004142B        .13,S2 
          DATA        60622525252525255342B        .14,S1 
          DATA        17177777777777777770B        .15,S0 
 TSAVEB5  BSSZ      1 
* 
*         END OF SINCOSTN(X)
* 
 BATASIN  BSS       0 
 BATACOS  BSS       0 
 BATATAN  BSS       0 
 BATACOT  BSS    0
          END 
          IDENT     BASAATN 
          TITLE  ARCTAN   (BASAATN) 
*CALL COPYRITE
          ENTRY     BASAATN,BATAATN 
          COMMENT BASIC 3 - ARCTAN. 
* 
* 
 MOVEREG  MACRO     XX,YY 
          IFNE      XX,YY,1 
          BX.YY     X.XX                MOVE XX TO YY 
          ENDM
* 
 UV       EQU       5 
          EJECT 
* 
*         ARCTAN(X) - ARGUMENT IN UV AND RESULT LEFT IN UV
* 
          DATA      10HBASAATN
 BASAATN  BSSZ      1 
          SX7       B5
          SA7       ASAVEB5             SAVE B5 
          MOVEREG   UV,5                MOVE ARGUMENT TO X5 
          ID          X5,ATAN0XX       .EXIT DIRECTLY WITH INDEFINITE 
          OR          X5,ATAN3XX       .TO SPECIAL CASE - INFINITY
          SB5         1                .
          SB7         B0               .SIN OF ARG IS + 
          SA1         ATANONE          .
          SA4         A1+B5            .LOAD TAN(PI/16) 
          PL          X5,ATAN4XX       .
          SB7         B0-B5            .
          BX5         -X5              .X=ABS(ARG)
 ATAN4XX  FX7         X5-X1            .X-1 
          SA3         A4+B5            .SQ2-1=.414... 
          PL          X7,ATAN5XX       .IF X GE 1.0 - GO TO ATAN5XX 
          IX7         X5-X4            .X-TAN(PI/16)
          FX6         X5-X3            .X-(SQ2-1) 
          SB6         B0               .FLAG=0
          SA3         A3+B5            .LOAD TAN(3*PI/16) 
          NG          X7,ATAN6XX       .IF X LT TAN(PI/16) - TO ATAN6XX 
          PL          X6,ATAN7XX       .
          FX7         X5*X4            .X*TAN(PI/16)
          RX6         X5-X4            .X-TAN(PI/16)
          SB6         B5               .FLAG=1
          NX0         B0,X6               . 
          RX7         X1+X7            .1.0+X*TAN(PI/16)
          RX5         X0/X7            .DIVIDE TO GET R 
          JP          ATAN6XX          .JOIN COMMON 
 ATAN7XX  FX7         X5*X3            .X*TAN(3*PI/16)
          RX6         X5-X3            .X-TAN(3*PI/16)
          SB6         B5+B5            .FLAG=2
          NX0         B0,X6               . 
          RX7         X1+X7            .1.0+X*TAN(3*PI/16)
          RX5         X0/X7            .DIVIDE TO GET R 
          JP          ATAN6XX          .JOIN COMMON 
 ATAN8XX  FX7         X5*X4            .X*TAN(PI/16)
          FX0         X5+X4            .X+TAN(PI/16)
          SB6         B6+B6            .FLAG=4
          FX6         X7-X1            .X*TAN(PI/16)-1.0
          NX3         B0,X6               . 
          RX5         X3/X0            .R 
          JP          ATAN6XX          .JOIN COMMON 
 ATAN5XX  SA2         A1-B5            .SQ2+1=2.1414... 
          SA3         A3+B5            .TAN(3*PI/16)
          FX0         X5-X2            .X-(SQ2+1.0) 
          SB6         B5+B5            .
          PL          X0,ATAN8XX       .
          FX7         X5*X3            .X*TAN(3*PI/16)
          RX0         X5+X3            .
          RX6         X7-X1            .X*TAN(3*PI/16)-1.0
          NX3         B0,X6               . 
          RX5         X3/X0            .R 
          SB6         B6+B5            .FLAG=3
 ATAN6XX  RX0         X5*X5            .Z=R*R 
          SA1         A3+B5            .DB3 
          SA2         A1+B5            .DB2 
          FX7         X0*X0            .Z*Z 
          FX6         X1*X0            .DB3*Z 
          FX3         X6+X2            .(DB3*Z+DB2) 
          SA4         A2+B5            .DB1 
          FX1         X4*X0            .DB1*Z 
          FX2         X3*X7            .(...)*Z*Z 
          SA3         A4+B5            .DB0 
          FX6         X2+X1            .
          FX1         X6+X3            .TOTAL DENOMINATOR 
          RX6         X5/X1            .R/DENOM 
          SA2         A3+B5            .DA3 
          FX3         X2*X0            .DA3*Z 
          SA1         A2+B5            .DA2 
          SA4         A1+B5            .DA1 
          FX2         X3+X1            .(DA3*Z+DA2)=(2) 
          FX7         X7*X2            .(2)*Z*Z 
          FX0         X4*X0            .DA1*Z 
          SA1         A4+B5            .DA0 
          FX2         X7+X0            .(2)*Z*Z+DA1*Z 
          FX2         X1+X2            .DA0+
          RX7         X6*X2            .REST OF SERIES
          RX2         X5-X7            .ATAN(R) 
          SA4         ATANCOR+B6       .LOAD CORRECTION TERM 1
          SA1         A4+5             .LOAD SECOND CORRECTION TERM 
          NX2         B0,X2               . 
          RX3         X2+X4            .
          NX4         B0,X3               . 
          RX3         X4+X1            .
          NX5         B0,X3               . 
          SX1         B7               .LOAD SIGN OF ARG
          AX2         B5,X1            .SIGN(ARG)*ATAN(X) 
          BX5         X5-X2            .SIGN(ARG)*ATAN(ABS(ARG))
 ATAN0XX  BSS       0 
          MOVEREG   5,UV                MOVE RESULT TO UV 
          SA1       ASAVEB5 
          SB5       X1                  RESET B5
          EQ        BASAATN 
 ATAN3XX  SA1         ATANPI2          .PI/2 TO X1
          PL          X5,ATAN9XX       .IF POSITIVE - SKIP PAST 
          BX5         -X1              .-PI/2 TO UV 
          EQ        ATAN0XX 
 ATAN9XX  BX5         X1               .PI/2 TO UV
          EQ        ATAN0XX 
* 
 ATANPI2  DATA        1.57079632679490             .-2,PI/2 
          DATA        2.414213                     .-1,SQRT(2)+1
 ATANONE  DATA        1.0                          .00,1.0
          DATA        17156272765700524613B        .00,TAN(PI)
          DATA        .414213                      .01,SQRT(2)-1
          DATA        17175260670125337715B        .02,TAN(3*PI)
          DATA        17355170257740451612B        .03,DB3
          DATA        17405760164664461126B        .04,DB2
          DATA        17416476573535613424B        .05,DB1
          DATA        17414077370000000000B        .06,DB0
          DATA        17354115643217650102B        .07,DA3
          DATA        17375417632175023115B        .08,DA2
          DATA        17375377237777777770B        .09,DA1
          DATA        16507544514504101314B        .10,DA0
 ATANCOR  DATA        0.0                          .11,CORRECTION TERMS 
          DATA        16366000000000000000B        .12
          DATA        17156220773250420550B        .13
          DATA        17167665172122524702B        .14
          DATA        17175376673723356473B        .15
          DATA        0.0                          .16
          DATA        17156220773250420550B        .17
          DATA        17166220773250420551B        .18
          DATA        17167665172122524703B        .19
          DATA        17175376673723356474B        .20
 ASAVEB5  BSSZ      1 
* 
*         END OF ARCTAN(X)
* 
 BATAATN  BSS       0 
          END 
          IDENT     BASALEP 
          TITLE  LOG,EXP AND POWER
*CALL COPYRITE
          ENTRY     BASALOG,BATALOG 
          ENTRY  BASALGT,BATALGT
          ENTRY     BASAEXP,BATAEXP 
          ENTRY     BASAPWR,BATAPWR 
          EXT       BASEGEN 
          COMMENT BASIC 3 - LOG ROUTINES. 
          EXT    RNBLOCK,RNLIST,DBUGON
* 
* 
* 
*         710225 DAL ADD ENTRY BASALGT TO PROVIDE LOGS TO BASE 10 
* 
 MOVEREG  MACRO     XX,YY 
          IFNE      XX,YY,1 
          BX.YY     X.XX                MOVE XX TO YY 
          ENDM
* 
 INF      MACRO     XX
         SX.XX     3777B                INFINITY
         LX.XX     48 
          ENDM
* 
 UV       EQU       5 
 A        EQU       5 
 B        EQU       4 
* 
*CALL,ERMNUM
* 
*         ERROR-MESSAGES
* 
 ERM154   DATA   C* ARGUMENT NEGATIVE IN LOG *
 ERM155   DATA   C* ARGUMENT IS ZERO IN LOG * 
 ERM156   DATA   C* ARGUMENT TOO LARGE IN EXP * 
 ERM157   DATA   C* ZERO TO A NEGATIVE POWER *
 ERM158   DATA   C* NEGATIVE NUMBER TO A POWER *
 ERM159   DATA   C* POWER TOO LARGE * 
* 
* 
* 
 ER154    BSS    0
          RTERROR ERMN154,ERM154,BASEGEN   *NEGITIVE ARG IN LOG * 
* 
 ER155    BSS    0
          RTERROR ERMN155,ERM155,BASEGEN   *ZERO ARG IN LOG * 
* 
 ER157    BSS    0
          RTERROR ERMN157,ERM157,BASEGEN   *ZERO TO A NEGITIVE POWER *
* 
 ER158    BSS    0
          RTERROR ERMN158,ERM158,BASEGEN   *NEGITIVE NO TO A POWER *
* 
 ER159    BSS    0
          RTERROR ERMN159,ERM159,BASEGEN   *POWER TOO LARGE * 
* 
          TITLE  LOG(X)   (BASALOG) 
* 
*         LOG(X) -- THE ARGUMENT IS IN UV AND THE RESULT LEFT IN UV 
* 
          DATA      10HBASALOG
 BASALOG  BSSZ      1 
          SX7    0                 BASE E TAG 
          RJ     LOGLGT 
          EQ     BASALOG
*                END LOG(X) 
* 
* 
          DATA   10HBASALGT 
 BASALGT  BSSZ   1
          SX7    1                 BASE 10 TAG
          RJ     LOGLGT 
          EQ     BASALGT           GO EXIT
* 
*                END LGT(X)        BASE 10
* 
 LOGLGT   BSSZ   1
          SA7    LOGLGTSW          0 FOR LOG OR 1 FOR LGT (BASE 10) 
          SX7       B5
          SA7    SAVEB5 
          MOVEREG   UV,5                MOVE ARGUMENT TO X5 
          SA2         LOGSQ2X          .BEGIN EVALUATION - X5 IS UV 
         ID        X5,LOG3XXX           EXIT DIRECTLY WITH INDEF
         NG        X5,LOG2XXX           NEG 
          OR          X5,LOG3XXX       .EXIT DIRECTLY WITH +INFINITY
          SA1    LOGSQ2X+1         PICK UP 1.0
          BX1    X1-X5             CK FOR ARGUMENT OF ONE (1.0).
          NZ     X1,LOG4XXX        CONTINUE IF ARGUMENT IS NON-ZERO 
          BX5    X1                RESULT IS ZERO IF ARGUMENT IS ONE (1.0). 
          EQ     LOG3XXX           EXIT DIRECTLY WITH ZERO RESULT.
 LOG4XXX  BSS    0
          UX7         B6,X5            .
          ZR     X7,ER155    *ARGUMENT IS ZERO IN LOG*
          SB7         -47              .TRY K=-47 
          SB5         1                .
          IX6         X7-X2            .
          NG          X6,LOG5XXX       .
          SB7         B7-B5            .NEED K=-48
 LOG5XXX  PX7         B7,X7            .FORM W=2.K*C
          SA1         A2+B5            .LOAD 1.0
          FX0         X7-X1            .(W-1.0) 
          NX2         B0,X0               . 
          DX0         X7-X1            .
          RX0         X2+X0            .
          RX2         X7+X1            .
          RX0         X0/X2            .
          FX7         X0*X0            .Z=T*T 
          SA5         A1+B5            .D0
          SA2         A5+B5            .D1
          SA3         A2+B5            .D2
          FX6         X7*X2            .Z*D1
          FX1         X7*X7            .Z*Z 
          FX5         X5+X6            .D0+Z*D1 
          FX6         X1*X3            .D2*Z*Z
          FX4         X1*X7            .Z*Z*Z 
          SA2         A3+B5            .D3
          FX5         X5+X6            .D0+D1*Z+D2*Z*Z
          FX3         X4*X2            .D3*Z*Z*Z
          FX5         X5+X3            .DENOMINATOR 
          NX4         B0,X5               . 
          FX6         X0/X4            .
          SA2         A2+B5            .C1
          SA5         A2+B5            .C2
          FX7         X7*X2            .C1*Z
          FX1         X5*X1            .C2*Z*Z
          FX3         X3+X3            .2*C3*Z*Z*Z
          FX0         X0+X0            .2*T 
          FX4         X7+X3            .+C1*Z 
          SX3         B6-B7            .
          FX4         X4+X1            .+C2*Z*Z 
          PX5         X3               .
          FX7         X6*X4            .FINAL TERM
          NX1         B0,X5               . 
          SA3         A5+B5            .LOG(2.0)
          SA2         A3+B5            .
          FX6         X1*X3            .
          FX4         X0-X7            .
          FX5         X1*X2            .
          DX1         X0-X7            .
          NX4         B0,X4               . 
          RX1         X4+X1            .
          RX1         X1+X5            .
          RX1         X1+X6            .
          NX5         B0,X1               .RESULT IN UV 
          SA1    LOGLGTSW 
          ZR     X1,LOG3XXX        SKIP IF BASE E 
          SA1    LNEBS10           LOG E TO BASE 10 
          FX5    X5*X1             LOG TO BASE 10 IS (LOG BASE E)( TIMES
*                                  (LOG E TO BASE 10) 
          NX5    X5,B5             NORM LOG TO BASE 10
* 
 LOG3XXX  BSS       0 
          MOVEREG   5,UV                MOVE RESULT TO UV 
          SA1    SAVEB5 
          SB5       X1                  RESET B5
          SA1    LOGLGTSW          IS 0/1 FOR LOG/LGT 
          NZ     X1,BASALGT        USE APPROPRIATE EXIT 
          EQ        BASALOG             EXIT
 LOG2XXX  BSS       0 
          BX7       X5                  NEGATIVE ARGUMENT 
          SA7       LOGSAV
          EQ     ER154       *ARGUMENT NEGATIVE IN LOG* 
* 
* 
 LOGSAV   BSS       1 
* 
 LOGSQ2X  DATA        5520236314774736B            .01
          DATA        1.0                          .02,1.0
          DATA        10395.0                      .03,D0 
          DATA        60421030456556304033B        .04,D1 
          DATA        17344525326347004201B        .05,D2 
          DATA        -230.419130393980937         .06,D3 
          DATA        60431166777777776772B        .07,C11
          DATA        17345152701555267627B        .08,C2 
          DATA        17175427102775750000B        .09,LOGE2
          DATA        16530717363257110000B        .10
 LNEBS10  DATA   .434294481903252      LOG E TO BASE 10 
 SAVEB5   BSSZ   1
 BATALOG  BSS       0 
 LOGLGTSW BSSZ   1                 0/1 FOR  LOG BASE E/LOG BASE 10
* 
 BATALGT  BSS    0
* 
*         END OF LOG(X) 
* 
          TITLE  EXP(X)   BASAEXP)
* 
*         EXP(X) - ARGUMENT IN UV AND RESULT IN UV
* 
          DATA      10HBASAEXP
 BASAEXP  BSSZ      1 
          SX7       B5
          SA7       XSAVEB5             SAVE B5 
          SB7       ERM156              *ARGUMENT TOO LARGE IN EXP* 
          RJ        EXPLOCL 
          SA1       XSAVEB5 
          SB5       X1                  RESET B5
          EQ        BASAEXP 
* 
* 
 EXPLOCL  BSSZ      1 
          MOVEREG   UV,5                MOVE ARGUMENT TO X5 
          BX6         X5               .
          SA6         EXPTEMP          .SAVE ARGUMENT FOR LATER USE 
          ID          X5,EXP3XXX       .EXIT DIRECTLY WITH INDEFINITE 
          OR          X5,EXP4XXX       .TO OUT OF RANGE ANALYSIS
          SA2         LOG2EXX          .
          MX7         0                .
          FX6         X2*X5            .ARG*LOG2(E) 
          PX4         X7               .MASK
          FX7         X4+X6            .
          DX6         X4+X6            .
          SB5         1                .
          RX7         X7+X6            .N, AN INTEGER WITH EXPONENT 2000
          NX6         B6,X7            .N NORMALIZED FOR RANGE REDUCTION
          SA4         A2+B5            .LOG(2), UPPER 
          SA3         A4+B5            .LOG(2), LOWER 
          FX0         X6*X4            .N*LOG(2), UPPER 
          FX1         X6*X3            .N*LOG(2), LOWER 
          FX6         X5-X0            .
          NX2         B0,X6               . 
          DX5         X5-X0            .
          FX1         X5-X1            .
          FX5         X2+X1            .
          NX0         B0,X5               .FINAL VALUE OF X 
          SB6         X7               .N 
          RX7         X0*X0            .
          SA1         A3+B5            .C1=420.0
          SA2         A1+B5            .C0=15120.0
          FX6         X1*X7            .C1*Z
          FX3         X7*X7            .Z*Z 
          RX5         X6+X2            .C1*Z+C0 
          SA1         A2+B5            .C3=28.0 
          FX6         X1*X7            .C3*Z
          RX5         X5+X3            .C1*Z+C0+Z*Z=B 
          SA2         A1+B5            .C4=2520.0 
          FX3         X0*X5            .X*B 
          RX2         X6+X2            .C4+C3*Z 
          FX4         X7*X2            .Z*T 
          FX1         X5+X5            .2*B 
          RX6         X1-X3            .2*B-X*B 
          RX1         X6+X4            .Z*T+2*B-X*B=DENOM 
          NX1    X1          NORMALIZE DIVISOR
          RX7         X0/X1            .TERM1=X/DENOM 
          RX4         X3-X4            .X*B-Z*T=TERM2 
          RX3         X7*X4            .Q=TERM1*TERM2 
          SA1         A2+B5            .LOAD XMAX 
          SA5         A6               .LOAD ORIGINAL ARGUMENT
          FX6         X1-X5            .(XMAX-X)
          SA2         A1+B5            .LOAD XMIN 
          FX1         X5-X2            .(X-XMIN)
          BX5         X6-X1            .SIGN OF PROUCT OF ABOVE TWO 
          NG          X5,EXP4XXX       .TO OUT OF RANGE ANALYSIS
          SA1         A2+B5            .LOAD 1.0
          FX2         X1+X0            .
          DX5         X1+X0            .
          NX2         B0,X2               . 
          FX4         X2+X3            .
          DX7         X2+X3            .
          RX7         X5+X7            .
          RX6         X4+X7            .
          UX7         B5,X6 
          SB6         B6+B5 
          PX5         B6,X6 
 EXP3XXX  BSS       0 
          MOVEREG   5,UV                MOVE RESULT TO UV 
          EQ        EXPLOCL 
 EXP4XXX  SA5         A6               .RETRIEVE ARGUMENT 
          PL          X5,EXP5XXX       .IF POSITIVE - SKIP BY 
          SX5         B0               .0 RESULT
          EQ        EXP3XXX 
 EXP5XXX  BSS       0 
          SX7    ERMN156
          SB6    ERM156 
          NE     B6,B7,ER159       BR, POWER TOO LARGE
          RTERROR ERMN156,ERM156,BASEGEN   *ARG TOO LARGE IN EXP *
* 
 LOG2EXX  DATA        17205612507312256030B        .00
          DATA        17175427102775750000B        .01,LOG(2), UPPER
          DATA        16530717363257117073B        .02,LOG(2), LOWER
          DATA        420.0                        .03,C1 
          DATA        15120.0                      .04,C0 
          DATA        28.0                         .05,C3 
          DATA        2520.0                       .06,C4 
          DATA        741.67                       .07,XMAX 
          DATA        -675.82                      .08,XMIN 
          DATA        1.0                          .09,ONE
 EXPTEMP  BSS         1 
 XSAVEB5  BSSZ      1 
 BATAEXP  BSS       0 
* 
*         END OF EXP(X) 
* 
          TITLE  POWER   (BASAPWR)
* 
*         PWR(B)TO..(A) - ARGUMENTS IN B AND A RESULT IN UV 
* 
          DATA      10HBASAPWR
 BASAPWR  BSSZ      1 
          SX7       B5
          SA7       PSAVEB5             SAVE B5 
          ID        X.A,POWER6          RETURN UNDEFINED FOR EXP UNDEF. 
          ID        X.B,POWER5          RETURN UNDEFINED FOR BASE UNDEF.
         BX6       X.A                  SAVE ARGUMENTS
         BX7       X.B
         SA6       POWERSV1 
         SA7       POWERSV2 
         ZR        X.B,POWER31           BASE ZERO
         OR        X.B,POWER11          BASE INF
          OR     X.A,POWER11   EXP INF
          UX6       B5,X.A              CHECK FOR INTEGER 
          LX6       X6,B5 
          PX7       B0,X6 
          NX6       B7,X7 
          IX7       X6-X.A
          ZR        X7,POWER3           B TO INTEGER
          NG     X.B,ER158   *NEGATIVE NUMBER TO A POWER* 
          MOVEREG   B,UV
          RJ        BASALOG             LOG ( R ) 
          BX6       X.UV
          SA1       POWERSV1
          FX.UV     X1*X6 
          SB7    ERM159      *POWER TOO LARGE*
          RJ        EXPLOCL             EXP ( LOG ( R ) * S ) 
          EQ        POWER7              COMMON EXIT 
 POWER3   BSS       0 
          MOVEREG   B,5                 MOVE ARGUMENT TO X5 
          BX1       X6
* 
*         I POWER RAISES A NUMBER N TO AN INTEGER POWER I 
          SX0       1 
          PX0       B0,X0 
          NX0       B0,X0               FLOATING POINT 1 ( P )
 +        PL        X1,*+1              IF I GE 0 - SKIP
          BX1       -X1                 I=-I
          FX5       X0/X5               N=1/N 
          UX1       B5,X1               SEPARATE I INTO EXPONENT, ETC 
          NG        B5,MIP2             IF EXP LT 0 - SKIP
          ZR        B5,MIP2             IF EXP EQ 0 - SKIP
 MIP3     FX5       X5*X5               N=N*N 
          OR     X5,ER159    *POWER TOO LARGE*
          SB5       B5-1                EXP=EXP - 1 
          NZ        B5,MIP3             IF NOT DONE - GO BACK 
 MIP2     LX1       B5,X1               GET I TO RIGHT ADJUSTED INTEGER 
          MX2       59
          ZR        X1,MIP4             IF I = 0 - SKIP 
 MIP5     BX3       -X2*X1              MASK LOW BIT
          ZR        X3,*+1
          FX0       X0*X5               P = P * N 
          OR     X0,ER159    *POWER TOO LARGE*
          AX1       1                   I = I ./. 2 
          FX5       X5*X5 
          OR     X5,ER159    *POWER TOO LARGE*
          NZ        X1,MIP5             IF  I NE 0 - GO BACK
 MIP4     BSS       0 
          MOVEREG   0,UV
 POWER7   BSS       0                   COMMON EXIT 
          SA1       PSAVEB5 
          SB5       X1                  RESET B5
          EQ        BASAPWR 
 POWER5   BSS       0 
          MOVEREG   B,UV
          EQ        POWER7              COMMON EXIT 
 POWER6   BSS       0 
          MOVEREG   A,UV
          EQ        POWER7              COMMON EXIT 
POWER11  BSS       0
          NG     X.B,ER158   *NEGATIVE NUMBER TO A POWER* 
         NG        X.A,POWER12          EXP NEG 
POWER12  SX.UV     B0                   ZERO RESULT 
         EQ        POWER7 
POWER31  BSS       0
          ZR     X.A,POWER33
         PL        X.A,POWER12          EXP POS 
          EQ     ER157       *ZERO TO A NEGATIVE POWER* 
 POWER33  SX.UV  1
          PX.UV  X.UV,B0
          NX.UV  X.UV,B0
          EQ     POWER7 
* 
* 
 POWERSV1 BSS       1 
 POWERSV2 BSS       1 
 PSAVEB5  BSSZ      1 
* 
*         END OF PWR(B)TO..(A)
* 
 BATAPWR  BSS       0 
          END 
          IDENT     BASARST 
          TITLE  MISC FUNCTIONS 
*CALL COPYRITE
          ENTRY     BASASQR,BATASQR 
          ENTRY     BASAABS,BATAABS 
          ENTRY     BASAINT,BATAINT 
          ENTRY  BASAMAX,BATAMAX
          ENTRY  BASAMIN,BATAMIN
          ENTRY  BASAROF,BATAROF        ROF IS THE ROUND-OFF FUNCTION 
          ENTRY     BASASGN,BATASGN 
          ENTRY     BASARND,BATARND 
          ENTRY  BASARAN,BATARAN
          EXT       BASEGEN 
          EXT    RNBLOCK,RNLIST,DBUGON
          EXT    BASSYS=
 SYS=     EQU    BASSYS=
          COMMENT BASIC 3 - MISC. FUNCTIONS.
* 
 LBLCHK   MACRO  LABEL
          NG     X5,LABEL 
          SA1    MAXLN
          FX1    X1-X5
          NG     X1,LABEL 
          UX5    B6,X5
          LX5    B6,X5
          ENDM
* 
 MOVEREG  MACRO     XX,YY 
          IFNE      XX,YY,1 
          BX.YY     X.XX                MOVE XX TO YY 
          ENDM
* 
* 
 UV       EQU       5 
* 
*CALL,ERMNUM
* 
*         ERROR-MESSAGES
* 
 ERM160   DATA   C* ARGUMENT NEGATIVE IN SQR *
* 
* 
* 
 ER160    BSS    0
          RTERROR ERMN160,ERM160,BASEGEN   *ARG NEGITIVE IN SQR * 
* 
          TITLE  SQRT(X)   BASASQR) 
* 
*         SQRT(X) - ARGUMENT IN UV AND RESULT IN UV 
* 
          DATA      10HBASASQR
 BASASQR  BSSZ      1 
          SX7       B5
          SA7       SSAVEB5             SAVE B5 
          MOVEREG   UV,5                MOVE ARGUMENT TO X5 
          ID          X5,SQRT3XX       .EXIT DIRECTLY WITH INDEFINITE 
          OR        X5,SQRT4XX         .EXIT TO OUT OF RANGE ANALYSIS 
          NG        X5,SQRT5XX         .NEGATIVE ARGUMENT ERROR 
          ZR          X5,SQRT3XX       .CHECK FOR ZERO
          SB5         1                .
          SB6         -48              .
          SA1         SQRTCAX          .LOAD CA 
          PX7         B6,X5            .W*2 POWER -48 
          SA4          A1+B5           .LOAD CB 
          FX0         X1*X7            .CA*W
          UX1         B7,X5            .N-48 AND COEFFICIENT OF W 
          SX3         B7-B6            .N-48-(-48)=N=2*K+R
          FX2         X4+X0            .CA*W+CB=INITIAL GUESS 
          AX6         X3,B5            .K=N/2 
          IX1         X3-X6            .N-K 
          FX4         X2*X2            .B*B 
          IX3         X1-X6            .N-K-K=B 
          SA1         X3+SQRT2RX       .LOAD 2  POWER  (R/2-1)=(1)
          SB6         X6               .K IN BZ 
          FX0         X4+X7            .B*B+W 
          FX3         X2*X0            .B*(B*B+W)=DENOM 
          UX6         B7,X1            .
          SB6         B6+B7            .EXPONGNT OF (1)+K 
          PX6         B6,X6            .2  POWER  (R/2+K-1)=(2) 
          FX2         X6/X3            .(2)/DENOM=TERM1 
          FX1         X0*X0            .(B*B+W)  POWER  2 
          FX7         X7+X7            .2*W 
          FX7         X7+X7            .4*W 
          FX3         X7*X4            .4*W*B*B 
          FX7         X3+X1            .NUM=(B*B+W)  POWER  2+4*W*B*B 
          FX0         X7*X2            .TERM1*NUM=2*W 
          SA1         A4+B5            .LOAD .25
          FX2         X5/X0            .ARG/(2*U)=(3) 
          FX3         X1*X0            ..25*(2*U)=(4) 
          FX5         X2+X3            .SUM OF ABOVE=(3)+(4)=SQRT(ARG)
 SQRT3XX  BSS       0 
          MOVEREG   5,UV                MOVE RESULT TO UV 
          SA1       SSAVEB5 
          SB5       X1                  RESET B5
          EQ        BASASQR 
 SQRT4XX  NG          X5,SQRT5XX       .NG OUT OF RANGG - ERROR 
          EQ        SQRT3XX 
 SQRT5XX  BSS       0 
          BX6       -X5 
          SA6       SQRTSV
          EQ     ER160       *ARGUMENT NEGATIVE IN SQR* 
* 
* 
 SQRTSV   BSS       1 
 SSAVEB5  BSSZ      1 
* 
 SQRTCAX  DATA        .585786437                   .00
          DATA        .4204951288                  .01,CB 
          DATA        17164000000000000001B        .02,.25(APPROX)
          DATA        .353553390593                .03
 SQRT2RX  DATA        .5                           .04
          DATA        .707106781186                .05
 BATASQR  BSS       0 
* 
*         END OF SQRT(X)
* 
          TITLE  ABS(X), AND MAX AND MIN FUNCTIONS
* 
*         ABS(X)
* 
          DATA      10HBASAABS
 BASAABS  BSSZ      1 
          MOVEREG   UV,5
          BX6       X5
          AX5       59
          BX5       X6-X5 
          MOVEREG   5,UV
          EQ        BASAABS 
 BATAABS  BSS       0 
* 
*         END ABS(X)
* 
* 
* 
*         MAX(N1,N2,....N20)
* 
          DATA   10HBASAMAX 
 BASAMAX  PS
          SA4    A5 
          SA5    X5+B2
 MAX1     BSS    0
          SA4    A4+1 
          ZR     X4,BASAMAX 
          SA3    X4+B2
          FX6    X5-X3
          PL     X6,MAX1
          BX5    X3 
          EQ     MAX1 
 BATAMAX  BSS    0
* 
*         MIN(N1,N2,....N20)
* 
          DATA   10HBASAMIN 
 BASAMIN  PS
          SA4    A5 
          SA5    X5+B2
 MIN1     BSS    0
          SA4    A4+1 
          ZR     X4,BASAMIN 
          SA3    X4+B2
          FX6    X5-X3
          NG     X6,MIN1
          BX5    X3 
          EQ     MIN1 
 BATAMIN  BSS    0
          TITLE  INT(X)   (BASAINT) 
* 
*         ENTIER(X) 
* 
**               NB  INT IS CALLED BY ROF 
* 
* 
          DATA      10HBASAINT
 BASAINT  BSSZ      1 
          MOVEREG   UV,5
 +        SA1         ONEHALF          .0.5-
         PL        X5,INT001
         FX3       X5+X1
         NG        X3,INT001
         BX5       -X1
INT001   FX5       X5-X1
          BX2         X5
          MX0         1 
          AX2         59
          LX0         59
          BX5         X5-X2 
          RX5         X5+X0 
          BX5         X5-X2 
          NX5       B0,X5 
          MOVEREG   5,UV
          EQ        BASAINT 
* 
 ONEHALF  DATA        17167777777777777777B 
 BATAINT  BSS       0 
* 
*         END ENTIER(X) 
* 
          TITLE  ROF(X)  (BASAROF)
* 
*                ROF (THE ROUND-OFF FUNCTION) 
* 
* 
          DATA   10HBASAROF 
* 
* 
*                PURPOSE: TO ROUND OFF THE VALUE IN X5 TO THE NO OF 
*                         PLACES SPECIFIED BY THE VALUE IN X4.
* 
* 
*                ENTRY:X5 HAS THE VALUE TO BE ROUNDED 
*                      X4 HAS THE NO OF PLACES TO ROUND TO (B6=2) 
*                      B6 HAS NO OF PARAMETERS PASSED 
* 
* 
*                USES: X0  4  5    B6 
* 
*                CALLS: INT 
* 
* 
* 
 BASAROF  BSSZ   1
* 
* 
          SB6    B6-1 
          ZR     B6,ZRPLCS   SKIP IF ROUND-TO-NEAREST-INTEGER 
          SA1    =XBASANSI
          ZR     X1,ROF2
          BX1    X1-X1
          PX1    X1 
          RX4    X4+X1       ROUND THE ARG
 ROF2     BSS    0
          NG     X4,NEGPLCS        SKIP IF THE NO OF PLACES IS .LT.0
          NX4    B6,X4             NORMALIZE
          UX4    B6,X4             UNPACK 
          LX4    B6,X4             FIX
          SB6    X4                POWER TABLE INDEX
          SX0    X4-ROFLMT         CHECK FOR BOUND OVERFLOW 
          NG     X0,ROFPLOK        SKIP IF OK 
          SB6    ROFLMT-1          ELSE SET MAX. POSS. NO-OF-PLACES-TO- 
*                                  USE-IN-ROUNDING
* 
 ROFPLOK  BSS    0
          SA4    B6+MPYTBL
          FX5    X5*X4             VALUE*(10**NO-OF-PLACES-TO-ROUND)
* 
 ROFADD   BSS    0
          NX5    B6,X5
          SA1    POINT5 
          FX5    X5+X1             SCALED VALUE PLUS (.5) 
* 
          RJ     BASAINT           USE INT (BASIC)
*                                  ASSUME X4 HAS BEEN SAVED 
          FX5    X5/X4             INT(SCALED VALUE) OVER (10**RND-PWR) 
          NX5    B6,X5
* 
          EQ     BASAROF           EXIT 
* 
 ZRPLCS   BSS    0
 NEGPLCS  BSS    0
          SA4    MPYTBL 
          EQ     ROFADD            REJOIN 
* 
* 
 ROFLMT   EQU    14                BOUND FOR NO-OF-PLACES-TO-ROUND
* 
 POINT5   DATA   0.5
* 
 MPYTBL   BSS    0
          DATA   1.0
          DATA   1.0E1
          DATA   1.0E2
          DATA   1.0E3
          DATA   1.0E4
          DATA   1.0E5
          DATA   1.0E6
          DATA   1.0E7
          DATA   1.0E8
          DATA   1.0E9
          DATA   1.0E10 
          DATA   1.0E11 
          DATA   1.0E12 
          DATA   1.0E13 
* 
* 
 BATAROF  BSS    0
          TITLE  SIGN(X)  (BASASGN) 
* 
*         SIGN(X) 
* 
          DATA      10HBASASGN
 BASASGN  BSSZ      1 
          MOVEREG   UV,5
          SX4       -1
          NG        X5,SIGN001
          ZR        X5,SIGN002
          SX4       1 
 SIGN001  PX5       B0,X4 
          NX5       B6,X5 
 SIGN002  MOVEREG   5,UV
          EQ        BASASGN 
 BATASGN  BSS       0 
* 
*         END SIGN(X) 
* 
          TITLE  RND(X)   (BASARND) 
* 
*         RND(X)
* 
          DATA      10HBASARND
 BASARND  BSSZ      1 
          SB6       B0                  SET NORMAL
          MOVEREG   UV,5
          SA1       OLDRND1+B6
          ZR        X5,RANDOM1          FETCH OLD R-N FOR PRESET MEMORY 
          ID        X5,RANDOM1          FETCH OLD R-N FOR PRESET MEMORY 
          PL        X5,RANDOM3          USE ASE OLD R-N 
          SB6       1                   SET RANDOM-RANDOM 
          SA1       OLDRND2 
          NZ        X1,RANDOM1          NOT FIRST 
          CLOCK  OLDRND2
          MX4       1 
          SA5       OLDRND2             USE CLOCK AS OLD R-N
          SB7       -60B
          BX5       -X4*X5              MAKE IT POSITIVE
          EQ        RANDOM2 
 RANDOM3  BSS       0                   USE UV AS OLD R-N 
          SB7       -60B
          OR        X5,RANDOM2
          SX6       B0
          PX7       B7,X6 
          FX5       X5+X7               UNNORMALIZE OLD R-N 
 RANDOM2  BSS       0 
          MX7       59
          PX6       B7,X5 
          BX1       -X7+X6              MAKE IT A LEGAL OLD R-N 
 RANDOM1  BSS       0 
          SA2       FACTOR1+B6
          DX6       X1*X2 
          NX5       X6,B7               RETURN NORMALIZED 
          SA6       OLDRND1+B6          SAVE UNNORMALIZED 
          MOVEREG   5,UV
          EQ        BASARND             EXIT
* 
 OLDRND1  DATA      17171274321477413155B      NORMAL OLD 
 OLDRND2  DATA      0                          RANDOM-RANDOM OLD
 FACTOR1  DATA   20001207264271730565B     NORMAL FACTOR. 
          DATA      20000000000001050005B      RANDOM-RANDOM FACTOR 
* 
 BATARND  BSS       0 
* 
*         RANDOMIZE.
* 
          DATA   10HBASARAN 
 BASARAN  BSSZ   1
          RJ     =XBASACLK
          BX6    X5 
          SA6    RANDTMP
          RJ     =XBASATIM
          SA4    RANDTMP
          FX3    X5+X4
          NX5    X3 
          RJ     BASARND
          EQ     BASARAN
* 
 RANDTMP  DATA   0           CLOCK VALUE. 
 BATARAN  BSS    0
* 
*         END RND(X)
* 
          END 
