
      SKP 
* *                *
**  COMPUTE ABS(X)  * 
* *                *
EABS  SSA           ARGUMENT NEGATIVE?
      JSB ARINV     YES, NEGATE IT
      JMP FRET,I    NO
* *                *
**  COMPUTE INT(X)  * 
* 
*  ENTER WITH NUMBER IN (A) AND (B).  EXIT WITH FLOATING
*  POINT FORM OF ENTIER IN (A) AND (B). 
* 
EINT  STB LBTMP     SAVE (B)
      JSB IFIX      TAKE ENTIER 
      JMP EINT1     ALL SIGNIFICANCE IN MANTISSA
      STB LBTMP     SAVE (B)
      LDB .+31      CORRECT FOR 
      STB EXP         BINARY POINT BIAS 
      LDB LBTMP     RETRIEVE (B)
      JSB .PACK     NORMALIZE AND PACK
      JMP FRET,I
EINT1 LDA TEMP6     RETRIEVE
      LDB LBTMP       NUMBER
      JMP FRET,I
* *                 * 
**  EXECUTE TIM(X)   *
* *                 * 
ETIM  JSB IFIX      INTEGERIZE ARGUMENT 
      JSB RERRS+43,I ILLEGAL ARGUMENT 
      SZA 
      JSB RERRS+43,I ILLEGAL ARGUMENT 
      LDA 1         IS ARGUMENT 
      AND .+3         <=3 AND 
      CPA 1             >=0 ? 
      RSS           YES 
      JSB RERRS+43,I NO--ILLEGAL ARGUMENT 
      ADA DTMTB     BRANCH TO 
      JMP 0,I         APPROPRIATE ROUTINE 
ETIM0 LDA DATIM+1   # OF 100 MS 
      ADA D36K        UNITS 
      CLB           CONVERT 
      DIV D600        TO MINUTES
      JMP ETIM3+1 
ETIM1 LDA DATIM     HOURS OF YEAR 
      CLB           CONVERT 
      DIV .+24        TO DAYS 
      LDA 1         REMAINDER IS HOUR OF DAY
      JMP ETIM3+1 
ETIM2 LDA DATIM     HOURS OF YEAR 
      CLB           CONVERT 
      DIV .+24        TO DAYS 
      RSS 
ETIM3 LDA YEAR      GET YEAR
      FLT                                        [B]
      JMP FRET,I    EXIT WITH RESULT IN (A) AND (B) 
DTMTB DEF *+1,I 
      DEF ETIM0 
      DEF ETIM1 
      DEF ETIM2 
      DEF ETIM3 
* *                *
**  COMPUTE RND(X)  * 
* *                *
* 
* THE RANDOM NUMBER FUNCTION COMPUTES A RANDOM NUMBER FROM THE
* FORMULAS: 
* 
*     X(N)=A*X(N-1)+C(MOD 2^30)    (A=5^11,C=2^30*(1/2-1/SQR(12)))
*     RND =X/2^30 MIN (1-2^-23) 
* 
ERND  EQU * 
      SSA,RSS       POSITIVE ARGUMENT?
      JMP ERND1     YES, USE PREVIOUS VALUE 
      RBL,CLE,ERB   NO, MAKE A
      ELA 
      STA RNDX1       A NEW SEED
      STB RNDX2 
ERND1 EQU * 
      LDA RNDX1     COMPUTE FIRST 
      MPY RNDA2      CROSS PRODUCT. 
      STA RNDX1     SAVE (ONLY NEED LOW ORDER PART) 
      LDA RNDX2     COMPUTE 2ND 
      MPY RNDA1      CROSS PRODUCT. 
      ADA RNDX1     ADD IN FIRST. 
      ADA RNDC1     ADD IN HIGH PART OF C.
      STA RNDX1     SAVE TOTAL. (THIS IS HIGH PART).
      CLA,CLE       SET EXP=0.
      STA EXP 
      LDA RNDX2     COMPUTE LOW ORDER PRODUCT.
      MPY RNDA2 
      ADA RNDC2     ADD IN LOW PART OF C. 
      SEZ           ADD ANY CARRY INTO
      INB            B. 
      RAL,CLE,ERA   E_A(15),A(15)_0.
      STA RNDX2     SAVE LOW ORDER RESULT.
      ELB           SHIFT HIGH ORDER PART & ADD IN
      ADB RNDX1      PREVIOUS TOTAL.
      ELB,CLE,ERB   CLEAR BIT 15 AND STORE. 
      STB RNDX1 
      RAL           SHIFT A ADJACENT TO B.
      SWP           EXCHANGE REGISTERS AND
      JSB .PACK      PACK.
      CPB .+2       TEST FOR RESULT=1.0 
      RSS 
      JMP FRET,I    EXIT IF NOT.
      LDA INF       SET RESULT TO 1-2^-23 
      LDB M256
      JMP FRET,I
* 
* 
RNDA1 DEC 1490      A DIV 2^15
RNDA2 DEC 3805      A MOD 2^15
RNDC1 OCT 16441     C DIV 2^15
RNDC2 OCT 7701      C MOD 2^15
* *                *
**  COMPUTE SGN(X)  * 
* *                *
* 
*  ENTER WITH ARGUMENT IN (A) AND (B).  IF ARGUMENT IS
*  NEGATIVE RETURN -1.0, IF ZERO RETURN 0, IF POSITIVE
*  RETURN 1.0 . 
* 
ESGN  CLB           CLEAR LOW PART OF NUMBER
      SZA,RSS       ZERO? 
      JMP FRET,I    YES, RETURN 0 
      SSA,RSS       POSITIVE? 
      LDB .+2       YES, LOAD EXPONENT FOR +1 
      LDA FLGBT     NO, LOAD HIGH PART OF -1
      SZB           WAS ARGUMENT POSITIVE?
      RAR           YES, SET RESULT TO +1 
      JMP FRET,I    NO
* *                *
**  COMPUTE TYP(X)  * 
* *                *
* 
*  UPON ENTRY (A) AND (B) HOLD A FILE NUMBER IN FLOATING POINT
*  FORM.  FILE 0 REFERS TO THE <DATA STATEMENT>S.  IF THE FILE
*  NUMBER IS NEGATIVE RETURN 1.0, 2.0, 3.0, OR 4.0 IF THE NEXT
*  ITEM IN THE FILE IS A NUMBER, STRING, EMD-OF-FILE, OR END- 
*  OF-RECORD RESPECTIVELY.  IF THE FILE NUMBER IS POSITIVE RETURN 
*  WITH THE VALUE CORRESPONDING TO THE FIRST ITEM FOUND OF ONE
*  OF THE FIRST THREE TYPES.
* 
ETYP  STB LBTMP     SAVE (B)
      LDB FILE#     SAVE VALUE
      STB PINTG       OF FILE#
      SZA,RSS       'DATA' FILE?
      JMP ETYP3     YES 
      CCB           NO, IGNORE
      SSA             END-OF-RECORDS
      CLB               UNLESS ARGUMENT 
      STB EORFL           IS NEGATIVE 
      LDB LBTMP     RETRIEVE (B)
      SSA           TAKE ABSOLUTE VALUE 
      JSB ARINV       OF ARGUMENT 
      JSB SBFIX     15-BIT INTEGER? 
      JSB RERRS+35,I  NO
      STB FILE#     YES 
      LDA FILE#     VALIDATE
      LDB .-2 
      JSB RQSTR       FILE
      JSB GTTYP     GET TYPE
ETYP1 LDB PINTG     RESTORE 
      STB FILE#       FILE# 
      FLT                                        [B]
      JMP FRET,I      FLOATING POINT FORM 
ETYP2 LDA .+3 
      LDB NXTDT     OUT-OF-DATA 
      CPB SYMTB       CONDITION?
      JMP ETYP1     YES, (A) = 3
      JSB SETDP     NO, SEEK NEXT <DATA STATEMENT>
ETYP3 CCA           MORE DATA IN
      CPA DCCNT       CURRENT STATEMENT?
      JMP ETYP2     NO
      LDB NXTDT,I   YES, LOAD TYPE WORD 
      CLA,INA       SET NUMBER
      SSB,RSS       NUMBER? 
      LDA .+2       NO, SET FOR STRING
      JMP ETYP1 
      SKP 
**                          **
***  COMPUTE CHEBYSHEV(X)  ***
**                          **
#CHEB JSB .FMP
      DEF K2
      DST X2TMP     X2TMP = X*2 
      LDB .CHEB,I 
      STB CTMP      POINTER TO COEFFICIENT TABLE
      DLD 1,I 
      DST DTMP      DTMP = COEFF(N) 
      CLA 
      STA BTMP
      STA BTMP+1    B = 0 
CHEB1 ISZ CTMP
      ISZ CTMP      N = N-1 
      LDA CTMP,I
      SZA,RSS       C(N) = 0? 
      JMP CHEB2     YES 
      DLD BTMP      NO
      DST ATMP      A = B 
      DLD DTMP
      DST BTMP      B = D 
      JSB .FMP
      DEF X2TMP 
      JSB .FSB
      DEF ATMP
      JSB .FAD
      DEF CTMP,I
      DST DTMP      D = COEFF(N)-A+B*X2 
      JMP CHEB1 
CHEB2 DLD DTMP
      JSB .FSB
      DEF ATMP
      JSB .FMP
      DEF HALF
      ISZ .CHEB     ANS = (D-A)/2 
      JMP .CHEB,I 
      SPC 1 
      SPC 1 
**                    **
***  LIBRARY ENTIER  ***
**                    **
* 
*  ENTER WITH NUMBER IN (A) AND (B).  IF EXPONENT > 14
*  THEN EXIT TO (P+1), ELSE EXIT TO (P+2) WITH THE
*  ENTIER OF THE ARGUMENT IN (A). 
* 
#IENT STA LBTMP     SAVE (A)
      LDA 1         EXTRACT 
      AND B377        EXPONENT
      SLA,RAR       NEGATIVE? 
      JMP IENT1     YES 
      ADA .-15      NO, LESS THAN 
      SSA,RSS         OR EQUAL TO 14? 
      JMP .IENT,I   NO
IENT1 ISZ .IENT     YES 
      LDA LBTMP     RESTORE (A) 
      JSB IFIX      TAKE ENTIER 
      NOP 
      LDA 1         LOAD INTEGER
      JMP .IENT,I     INTO (A)
      SPC 2 
**                              **
***  MULTIPLY BY A POWER OF 2  ***
**                              **
* 
*  ENTER WITH NUMBER IN (A) AND (B).  AUGMENT EXPONENT
*  BY THE VALUE POINTED TO BY (P+1) AND EXIT TO (P+2).
*  NO CHECK ON EXPONENT UNDERFLOW OR OVERFLOW.
* 
#PWR2 SZA,RSS       ARGUMENT ZERO?
      JMP PWR2A     YES, RETURN 0 
      STA X2TMP     NO, SAVE HIGH PART OF MANTISSA
      JSB .FLUN     UNPACK LOW PART OF NUMBER 
      STB X2TMP+1   SAVE LOW MANTISSA 
      LDB .PWR2,I   COMPUTE NEW 
      ADA 1,I         EXPONENT
      RAL           POSITION
      AND B377        AND MASK IT 
      STA 1         COMPUTE NEW LOW 
      ADB X2TMP+1     PART OF NUMBER
      LDA X2TMP     RETRIEVE HIGH MANTISSA
PWR2A ISZ .PWR2 
      JMP .PWR2,I 
* *                *
**  COMPUTE COS(X)  * 
* *                *
ECOS  JSB .FAD      COMPUTE 
      DEF PIBY2       SIN(X+PI/2) 
* *                *
**  COMPUTE SIN(X)  * 
* *                *
ESIN  JSB .FMP
      DEF TOPI
      DST XTEMP     X = 2*X/PI
      JSB .FAD
      DEF K1
      JSB .PWR2 
      DEF .-2 
      JSB .IENT 
      JSB RERRS+31,I  EXPONENT EXCEEDS 14 
      FLT                                        [B]
      JSB .FMP
      DEF MM4 
      JSB .FAD
      DEF XTEMP 
      DST XTEMP     X = X-4*ENTIER((X+1)/4) 
      JSB .FSB
      DEF K1
      SSA           X<1?
      JMP ESIN1     YES 
      DLD K2        NO
      JSB .FSB
      DEF XTEMP 
      DST XTEMP     X = 2-X 
ESIN1 DLD XTEMP 
      JSB .FMP
      DEF XTEMP 
      JSB .PWR2 
      DEF .+1 
      JSB .FSB
      DEF K1
      JSB .CHEB 
      DEF COEF2 
      JSB .FMP
      DEF XTEMP 
      JMP FRET,I    ANS = X*CHEBY(2*X^2 -1) 
* 
TOPI  DEC .636619772     2/PI 
MM4   DEC -4. 
COEF2 DEC 1.18496E-6
      DEC -1.365875E-4
      DEC 9.118016E-3 
      DEC -.2852615692
      DEC 2.5525579248
      OCT 0 
* *                *
**  COMPUTE TAN(X)  * 
* *                *
ETAN  JSB .FMP
      DEF FOPI      4/PI
      DST XTEMP 
      JSB .FAD
      DEF K1
      JSB .PWR2 
      DEF .-2 
      JSB .IENT 
      JSB RERRS+31,I
      FLT                                        [B]
      JSB ARINV 
      JSB .PWR2 
      DEF .+2 
      JSB .FAD
      DEF XTEMP 
      DST XTEMP     X = X-4*ENTIER((X+1)/4) 
      JSB .FSB
      DEF K1
      STA LBTMP 
      SSA           X<1?
      JMP ETAN2     YES 
      DLD K2        NO
      JSB .FSB
      DEF XTEMP 
ETAN1 DST YTEMP     Y = 2-X 
      JSB .FMP
      DEF YTEMP 
      JSB .FMP
      DEF K2
      JSB .FSB
      DEF K1
      JSB .CHEB 
      DEF COEF0 
      JSB .FMP
      DEF YTEMP 
      DST YTEMP     Y = Y*CHEBY(2*Y^2 -1) 
      LDA LBTMP 
      SSA           X<1?
      JMP ETAN3     YES 
      DLD K1        NO
      JSB .FDV
      DEF YTEMP 
      JMP FRET,I    ANS = 1/Y 
ETAN2 DLD XTEMP 
      JMP ETAN1     Y = X 
ETAN3 DLD YTEMP 
      JMP FRET,I    ANS = Y 
* 
FOPI  DEC 1.273239545 
K1    DEC 1.
K2    DEC 2.
COEF0 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 
* *                *
**  COMPUTE ATN(X)  * 
* *                *
EATN  DST XTEMP 
      LDA 1 
      AND B377
      STA LBTMP 
      SZA 
      SLA           ABS(X) > 1? 
      JMP EATN2     NO
      DLD K1        YES 
      JSB .FDV
      DEF XTEMP     U = 1/X 
EATN1 DST UTEMP 
      JSB .FMP
      DEF UTEMP 
      JSB .FMP
      DEF K2
      JSB .FSB
      DEF K1
      JSB .CHEB 
      DEF COEF1 
      JSB .FMP
      DEF UTEMP 
      DST YTEMP     Y = U*CHEBY(2*U^2 -1) 
      LDA LBTMP 
      SZA 
      SLA           ABS(X) > 1? 
      JMP EATN3     NO
      LDA XTEMP     YES 
      SSA           X<0?
      JMP EATN4     YES 
      DLD PIBY2     NO
      JMP EATN4+2 
EATN2 DLD XTEMP 
      JMP EATN1     U = X 
EATN3 DLD YTEMP 
      JMP FRET,I    ANS = Y 
EATN4 DLD MP2 
      JSB .FSB
      DEF YTEMP 
      JMP FRET,I    ANS = -PI/2-Y 
* 
PIBY2 DEC 1.5707963268   PI/2 
MP2   DEC -1.5707963268  -PI/2
COEF1 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 
* *                *
**  COMPUTE EXP(X)  * 
* *                *
EEXP  JSB .EXP
      JMP FRET,I
#EXP  JSB .FMP
      DEF L2E 
      DST XTEMP     X = ARG*LOG2(E) 
      JSB .IENT 
      JMP .EXP2 
      STA LBTMP 
      FLT                                        [B]
      DST YTEMP     Y = ENTIER(X) 
      LDA LBTMP 
      ADA M124
      SSA,RSS       X >= 124? 
      JMP .EXP2     YES 
      ADA .244      NO
      SSA           X < -120? 
      JMP .EXP1     YES 
      DLD XTEMP     NO
      JSB .FSB
      DEF YTEMP 
      DST XTEMP     X = X-ENTIER(X) 
      JSB .FMP
      DEF XTEMP 
      DST UTEMP     U = X^2 
      JSB .FAD
      DEF AAAA
      DST YTEMP     Y = X^2+AAAA
      DLD BBBB
      JSB .FDV
      DEF YTEMP 
      DST YTEMP     Y = BBBB/Y
      DLD CCCC
      JSB .FMP
      DEF UTEMP 
      JSB .FAD
      DEF DDDD
      JSB .FSB
      DEF XTEMP 
      JSB .FSB
      DEF YTEMP 
      DST YTEMP     Y = -X+DDDD+CCCC*X^2-Y
      DLD XTEMP 
      JSB .FDV
      DEF YTEMP 
      JSB .FAD
      DEF HALF
      ISZ LBTMP 
      NOP 
      JSB .PWR2 
      DEF LBTMP 
      JMP .EXP,I    ANS = (0.5+X/Y)*2^ENTIER(ARG*LE)
.EXP1 CLA 
      CLB 
      JMP .EXP,I    ANS = 0 
.EXP2 LDA LBTMP     LARGE ARGUMENT
      SSA           NEGATIVE? 
      JMP .EXP1     YES 
      JSB WERRS+4,I NO
      LDA INF 
      LDB .-2       ANS = POSITIVE INFINITY 
      JMP .EXP,I
* 
M124  DEC -124
.244  DEC 244 
AAAA  DEC 87.417497202
BBBB  DEC 617.9722695 
CCCC  DEC .03465735903
DDDD  DEC 9.9545957821
L2E   DEC 1.4426950409
