Trailing-Edge
-
PDP-10 Archives
-
bb-4157j-bm_fortran20_v11_16mt9
-
fortran-ots-debugger/mthsng.mac
There are 9 other files named mthsng.mac in the archive. Click here to see a list.
SEARCH MTHPRM
TV MTHSNG SINGLE PRECISION ROUTINES,2(4012)
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SUBTTL REVISION HISTORY
COMMENT \
***** Begin Revision History *****
1345 EDS 16-Mar-1981 Q10-04806
Fix ASIN and ACOS library error message.
1350 EDS 16-Mar-81 Q10-04761
Fix TWOSEG and RELOC problems.
1405 DAW 6-Apr-81
Support extended addressing.
1464 DAW 12-May-81
Error messages.
1524 DAW 6-Jul-81
Shorten error message in EXP3. so it doesn't get truncated.
1673 CDM 9-Sept-81
Add single precision routines.
(ANINT, NINT)
1677 JLC 10-Sep-81 Q10-6510
Use seed and multiplier from version 5A for RAN.
1724 BL 17-Sep-81
Clean up error messages.
***** Begin Version 7 *****
3024 CDM 17-Nov-81
Equate REAL. to FLOAT. to give it integer arguments instead
of complex.
3200 JLC 10-May-82
Mathlib integration. Change all LERRs to $LCALLs. Change
TWOSEG/RELOC to SEGMENT macros.
3221 BCM 29-Oct-82
Moved SNGL, SNGL., and SNG.nn routines to the end of file
MTHSNG and out of MTHDBL. Resolves forward reference problem.
3223 CDM 11-Nov-82
Replace IFX.n routines due to customer QAR.
***** Begin Version 1A *****
3231 CKS 23-Mar-83
Work on RANS. Change the constant multiplier of the seed
from 16807 to 630360016 so that RANS matches RAN. Don't
use a FLTR to float the integer number, instead use a
MOVSI and a DFAD, since this will not cause the number to
be rounded. Optimize the routine by doing away with a
dead subtract instruction and by using an EXCH
instruction.
3235 RVM 24-Mar-83
Equate REAL to FLOAT. so that REAL is defined.
3243 BCM 29-Mar-83
Get and clear PC flags with new GETFLG and RESFLG macros. Fixes
always clearing underflow in MTHTRP. Only applies to JOV branches.
3257 MRB 6-Nov-84
Clear out the extra bits if the COS routine when the result
is greater than one. This routine has a 3-bit error range and
in some cases, when the result is very close to one, this
three bit error range can put us over the maximum result of
one. This edit will scale the result down to one.
***** End Revision History *****
***** Begin Version 2 *****
4002 JLC 3-Aug-83
Move EXP. to after TAN., which calls EXP.
4011 JLC 4-May-84
Add code for MOD, AMOD, DMOD, and GMOD for 2nd arg=0.
4012 MRB 6-Jun-84
Change the names of the SETRAN and the SAVRAN routines.
Change them to STRAN. and SVRAN. From now on the symbols
SETRAN and SAVRAN will be in module FORCOM so the flagger
can work.
\
PRGEND
TITLE ALOG10 LOG BASE 10 FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY ALOG10
EXTERN ALG10.
ALOG10=ALG10.
PRGEND
TITLE ALOG NATURAL LOG FUNCTION
; (SINGLE PRECISION FLOATING PRECISION)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY ALOG
EXTERN ALOG.
ALOG=ALOG.
PRGEND
TITLE ALOG. NATURAL LOG FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;ALOG10(X) AND ALOG(X) ARE CALCULATED AS FOLLOWS
; FOR REFERENCE SEE 'COMPUTER APPROXIMATIONS', BY HART ET. AL.
; WILEY, 1968; ALGORITHM # 2662.
; SEE PAGE 227 FOR THE COEFFICIENTS AND PAGE 111 FOR THE
; RANGE OF VALIDITY.
;
; FOR X CLOSE TO ONE -
; ALOG(X) = L3*Z**7+L4*Z**5+L5*Z**3+L6*Z
; WHERE Z = (X-1)/(X+1)
; ALOG10(X) = ALOG(X)*ALOG10(E)
; FOR X NOT NEAR ONE -
; ALOG(X) = (K-1/2)*ALOG(2)+ALOG(F*SQRT(2)) WHERE X = 2**K*F
; ALOG(F*SQRT(2)) = L3*Z**7+L4*Z**5+L5*Z**3+L6*Z
; WHERE L3, L4, L5, AND L6 ARE CONSTANTS AND
; Z = (F-(SQRT(2)/2))/(F+(SQRT(2)/2))
;THE RANGE OF DEFINITION FOR ALOG/ALOG10 IS GIVEN ABOVE, AND ERROR MESSAGES
; WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE
;REQUIRED (CALLED) ROUTINES: NONE
;REGISTERS T2, T3, AND T4 WERE SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,ALOG
; OR
; PUSHJ P,ALOG10
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (ALG10.,ALOG10) ;ENTRY TO LOG TO THE BASE 10 ROUTINE.
MOVE T0,@(L) ;GET X IN T0.
JUMPE T0,LZERO ;CHECK FOR ZERO ARG.
MOVEM T0,TEMP ;SAVE ARGUMENT.
FUNCT ALOG.,<TEMP> ;CALC THE BASE E LOG TO THE
FMPR T0,LOG10A ;MULTIPLY IT BY LOG10(E).
GOODBY (1) ;RETURN
HELLO (ALOG,.) ;ENTRY TO LOG TO THE BASE E ROUTINE.
MOVE T0,@(L) ;GET X
JUMPG T0,ALOGOK ;ARG IS GREATER THAN 0
JUMPE T0,LZERO ;CHECK FOR ZERO ARGUMENT
$LCALL NAA
;LERR (LIB,%,<ALOG or ALOG10: negative arg; result=log(ABS(arg))>)
MOVN T0,T0 ;GET |X|
ALOGOK: CAMN T0,ONE ;CHECK FOR 1.0 ARGUMENT
JRST ZERANS ;IT IS 1.0 RETURN ZERO ANS.
CAML T0,HI ;IS ARG >/= SQRT(2)?
JRST GEN ;YES GO TO GENERAL CASE
CAMG T0,LO ;IS ARG </= 1/SQRT(2)?
JRST GEN ;YES GO TO GENERAL CASE
SETZM LS ;IGNORE EXP FOR ARG NEAR 1
MOVE T1,T0 ;SERIES VARIABLE IS
FADR T0,ONE ;(ARG-1)/(ARG+1) IF ARG NEAR 1
FSBR T1,ONE
JRST MERGE ;SKIP HANDLING OF EXP IN GENL CASE
GEN: ASHC T0,-33 ;SEPARATE FRACTION FROM EXPONENT
ADDI T0,211000 ;FLOAT THE EXPONENT
MOVS T0,T0 ;NUMBER NOW IN CORRECT FL. FORMAT
FADR T0,BIAS ;REMOVE BIAS + COMPENSATE FOR
;SQRT(2) FACTOR; T0 HAS EXP - 1/2
FMPR T0,LN2 ;MULT BY LN2
MOVEM T0,LS ;STORE FOR FUTURE - LS=(K-1/2)*LN2
ASH T1,-10 ;SHIFT FRACTION FOR FLOATING
TLC T1,200000 ;FLOAT THE FRACTION PART
MOVE T0,T1 ;COPY FRACTION
FADR T1,L1 ;SUBTRACT (SQRT(2))/2 FROM T1
FSBR T0,L1 ; AND ADD IT TO T0
MERGE: FDVR T1,T0 ;T1 = T1/T0
MOVEM T1,LZ ;STORE NEW VARIABLE IN LZ
FMPR T1,T1 ;CALCULATE Z**2
MOVE T0,L3 ;PICK UP FIRST CONSTANT
FMPR T0,T1 ;MULTIPLY BY Z**2
FADR T0,L4 ;ADD IN NEXT CONSTANT
FMPR T0,T1 ;MULTIPLY BY Z**2
FADR T0,L5 ;ADD IN NEXT CONSTANT
FMPR T0,T1 ;MULTIPLY BY Z**2
MOVE T1,LZ ;GET Z INTO T1
FMPR T0,T1 ;T0 NOW HAS ALL BUT FIRST
; TERM OF SERIES APPROX.
FSC T1,1 ;MUL Z BY 2
FADR T0,T1 ;DO LAST ADD FOR SERIES WITH
; ROUNDING AND OVERHANG OF
; AT LEAST 2 BITS
FADR T0,LS ;ADD IN EXPONENT PART
GOODBY (1)
LZERO: $LCALL AZM
;LERR (LIB,%,ALOG or ALOG10: zero arg; result overflow)
MOVE T0,MIFI ;PICK UP MINUS INFINITY
GOODBY (1) ;RETURN
ZERANS: MOVEI T0,0 ;MAKE ANSWER ZERO
GOODBY (1) ;RETURN
LOG10A: 177674557305
ONE: 201400000000
L1: 577225754146 ;-0.707106781187 = -(SQRT(2)/2)
L3: 177464164321 ;.301003281
L4: 177631177674 ;.39965794919
L5: 200525253320 ;.666669484507
LN2: 200542710300 ;0.69314718056
MIFI: 400000000001 ;LARGEST NEGATIVE FLOATING NUMBER
HI: 201552023632 ;IF ARG IS BETWEEN HI AND LO
LO: 200552023632 ;NO SCALING BY SQRT(2) NEEDED.
BIAS: 567377000000 ;-(401)/2
SEGMENT DATA
TEMP: 0
LS: 0
LZ: 0
PRGEND
TITLE AMOD SINGLE PRECISION REMAINDER FUNCTION
SUBTTL MARY PAYNE /MHP/CKS 25-Jan-80
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY AMOD
AMOD=AMOD.##
PRGEND
TITLE AMOD. SINGLE PRECISION REMAINDER
SUBTTL BOB HANEK/CKS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
SEGMENT CODE
SALL
; Single precision AMOD routine with no limit on the magnitudes
; of the arguments. This routine calculates
;
; |ARG1| - [|ARG1/ARG2|]*|ARG2|
;
; and returns the result with the sign of ARG1. Special code is
; provided for avoiding intermediate exceptions. The final result
; will not overflow. It may underflow, in which case a result of 0
; is returned and an error message is written.
;
; For A and B positive floating point numbers, let A = 2^n*F and
; B = 2^m*G. We would like to compute R = A - B*int[A/B]. We introduce
; the following sequences of numbers to assist in computing R. For
; p and d positive integers, let J = 2^p*G, I = 2^p*F and define
; I(0) = I - q*J, where q = 0 if I < J and 1 otherwise. For i >= 0 let
;
; L(i+1) = 2^d*I(i)
;
; I(i+1) = L(i+1) - J*int[L(i+1)/J].
;
; Using an induction argument it is not difficult to show that
;
; I(k) = 2^(kd)*I(0) - J*int[2^(kd)*I(0)/J].
;
; Now let 0 = < n - m = kd + r, where 0 =< r < d, then
;
; R = A - B*int[A/B]
; = 2^n*F - 2^m*G*int[2^(n-m)*F/G]
; ==> 2^p*R = 2^n*[I(0) + q*J] - 2^m*J*int[2^(n-m)*(I(0) + q*J)/J]
; = 2^n*I(0) - 2^m*J*int[2^(n-m)*I(0)]
; ==> 2^(p-m)*R = 2^(kd+r)*I(0) - J*int[2^(kd+r)*I(0)/J]
; = 2^r*I(k) - J*int[2^r*I(k)/J]
; = L - J*int[L/J],
;
; where L = 2^r*I(k).
;
; Based on the above, we have the following algorithm for computing R:
;
; Step 1: m <--- the exponent value of B
; c <--- the exponent value of A - m
; if c < 0, end with R = A
; Step 2: I <--- 2^p*(fraction field of A)
; J <--- 2^p*(fraction field of B)
; If I >= J, I <--- I - J
; go to step 5
; Step 3: L <--- 2^d*I
; Step 4: L <--- L - J*int[L/J]
; Step 5: c <--- c - d
; Step 6: if c > 0 go to step 3
; Step 7: if c = -d, exit with R = L
; Step 8: L <--- 2^(d+c)*I = 2^r*I
; Step 9: L <--- L - J*int[L/J]
; Step 10: R <--- 2^(m-p)*L
; Bob Hanek, July 19, 1982
HELLO (AMOD,.)
DMOVEM T2, SAV23 ;Save registers 2, 3,
MOVEM T4, SAV4 ; and 4
MOVM T0, @0(L) ; T0 = |A|
MOVM T2, @1(L) ; T2 = |B|
JUMPE T2, RETA2 ;If arg2 is zero, return 0 with msg
;
; Step 1
;
MOVE T3, T2 ; T3 = |B|
AND T3, [777000000000]
; T3 = Exponent field of B (including bias)
MOVE T4, T0 ; T4 = |A|
SUB T4, T3 ; high 9 bits of T4 = c
JUMPL T4, TSTSGN ; Done if c < 0
;
; Step 2
;
STEP2: ASHC T3, -33 ; Get c in the low bits of T4
; and m+200 in low bits of T3
TLZ T0, 777000 ; T0 = I
TLZ T2, 777000 ; T2 = J
CAML T0, T2 ; Compare I to J
SUB T0, T2 ; If I >= J, I <--- I - J
JRST STEP5
;
; Steps 3 through 6
;
STEP3: SETZ T1, ; T0/T1 = L = 2^35*I -- d = 35
DIV T0, T2 ; T0 = int(L/J), T1 = L - J*int(L/J)
MOVE T0, T1 ; T0 = L - J*int(L/J)
STEP5: SUBI T4, 43 ; c <--- c - d
JUMPG T4, STEP3 ; If c > 0 go to Step 3
;
; Steps 7 and 8: At this point c = r - d or r = c + d;
;
SETZ T1, ; T0/T1 = 2^35*I
ASHC T0, (T4) ; T0/T1 = 2^(d+c)*I = 2^r*I
DIV T0, T2 ; T1 = 2^(p-m)*R
;
; Step 9 - Obtain R in floating point format and check for underflow
;
MOVE T0, T1 ; Copy fraction into T0
FSC T0, (T3) ; Insert biased exponent and normalize
JFCL UNDER ; Can underflow
TSTSGN: SKIPGE @0(L) ;Remainder in T0. If A < 0
MOVN T0,T0 ; negate it
RESTOR: DMOVE T2,SAV23 ;Restore registers 2, 3
MOVE T4,SAV4 ; and 4
POPJ P, ; Return
;
; If processing continues here, the remainder has underflowed.
;
UNDER: $LCALL RUN ;Result underflow
SETZ T0, ;Store 0 for result
JRST RESTOR ;Restore registers and return
RETA2: MOVE T0,@0(L) ;Return the original argument 1
$LCALL MZZ ;MOD with arg2=0, result=0
JRST RESTOR ;Restore registers and return
SEGMENT DATA
SAV23: BLOCK 2
SAV4: BLOCK 1
PRGEND
TITLE ACOS ARC SINE AND ARC COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JANUARY 18, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY ACOS
EXTERN ACOS.
ACOS=ACOS.
PRGEND
TITLE ASIN ARC SINE AND ARC COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JANUARY 18, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY ASIN
EXTERN ASIN.
ASIN=ASIN.
PRGEND
TITLE ASIN. ARC SINE AND ARC COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JANUARY 18, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;ASIN(X) AND ACOS(X) ARE CALCULATED AS FOLLOWS
; LET R(Z) = Z*(P0 + Z*(P1 + Z*P2))/(Q0 + Z*(Q1 + Z))
; (P(I) AND Q(I) ARE GIVEN BELOW)
; LET S = Y + Y*R(Z)
; FOR SITUATIONS 1. AND 3. BELOW,
; Z = Y**2, WHERE Y = ABS(X)
; FOR SITUATIONS 2. AND 4., Z = (1.0 - ABS(X))/2.0
; AND Y = -2.0*SQRT(Z)
; LET W = ABS(X) AND TERM THE RESULT T.
; THEN, CONSIDER THE FOUR SITUATIONS:
; 1. ASIN, FOR W <= 0.5. T = S, AND T IS NEGATED
; FOR NEGATIVE X
; 2. ASIN, FOR W > 0.5. T = PI/2 + S, AND T IS NEGATED
; FOR NEGATIVE X
; 3. ACOS, FOR W <= 0.5. T = PI/2 - S IF X > 0
; = PI/2 + S IF X < 0
; 4. ACOS FOR W > 0.5. T = -S IF X > 0
; = PI + S IF X < 0.
;THE RANGE OF DEFINITION FOR ASIN/ACOS IS ABS(X) <= 1.0. AND ERROR MESSAGES
; WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE. ASIN/ACOS WILL BE SET
; TO + MACHINE INFINITY.
;REQUIRED (CALLED) ROUTINES: SQRT
;REGISTERS T2, T3, T4, AND T5 WERE SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,ASIN
; OR
; PUSHJ P,ACOS
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (ACOS,.) ;ENTRY TO ACOS ROUTINE
PUSH P,T5 ;SAVE REGISTER T5
MOVEI T5,1 ;SET ACOS FLAG
JRST ALG ;GO TO MAIN CODE
HELLO (ASIN,.) ;ENTRY TO ASIN ROUTINE
PUSH P,T5 ;SAVE REGISTER T5
MOVEI T5,0 ;SET ASIN FLAG
ALG: MOVE T1,@(L) ;OBTAIN X
MOVM T0,T1 ;OBTAIN ABS(X) = Y
CAMG T0,CHALF ;IF Y < .5
JRST LEHF ;JUMP TO LABEL LEHF
CAMLE T0,CONE ;OTHERWISE, IF Y > 1,
JRST ERR0 ;GO TO WRITE ERROR MESSAGE
PUSH P,T2 ;SAVE REGISTER T2
MOVN T0,T0 ;OBTAIN NEW Y AND Z; (-Y
FADRI T0,201400 ;+1)
FSC T0,-1 ;/2 = Z
MOVE T2,T0 ;T2 CONTAINS Z
PUSH P,T1 ;SAVE REGISTER T1 BEFORE CALL
MOVEM T0,TEMP
FUNCT SQRT.,<TEMP> ;OBTAIN SQUARE ROOT OF Z
POP P,T1 ;RESTORE REGISTER T1
MOVN T0,T0 ;SQRT(Z)=-SQRT(Z)
FSC T0,1 ;-2*SQRT(Z)=Y
JRST SRES ;GO TO OBTAIN RESULT
LEHF: PUSH P,T2 ;SAVE REGISTER T2
CAMGE T0,CEPS ;IF Y < EPS,
JRST MSIGN ;JUMP TO LABEL MSIGN
MOVE T2,T0 ;MOVE Y TO T2
FMPR T2,T0 ;Y*Y=Z
SRES: PUSH P,T3 ;SAVE REGISTER T3
PUSH P,T4 ;SAVE REGISTER T4
MOVE T3,T0 ;MOVE Y
MOVE T4,T2 ;MOVE Z
FMPR T2,PP2 ;((P2*Z
FADR T2,PP1 ;+P1)
FMPR T2,T4 ;*Z
FADR T2,PP0 ;+P0)
FMPR T2,T4 ;*Z = R(Z) NUMERATOR
FMPR T0,T2 ;*Y
MOVE T2,T4 ;(Z
FADR T2,Q1 ;+Q1)
FMPR T2,T4 ;*Z
FADR T2,Q0 ;+Q0 = R(Z) DENOMINATOR
FDVR T0,T2 ;R(Z)
FADR T0,T3 ;+Y = RESULT
POP P,T4 ;RESTORE REGISTER T4
POP P,T3 ;RESTORE REGISTER T3
MSIGN: MOVM T2,T1 ;T2 CONTAINS ABS(X)
JUMPG T5,COS ;IF FLAG NOT ZERO, GO TO ACOS
CAMLE T2,CHALF ;IF ABS(X) GREATER THAN .5
FADR T0,CPI2 ;ADD PI/2 TO RESULT
JUMPGE T1,RET ;IF X IS POSITIVE, RETURN
MOVN T0,T0 ;OTHERWISE, RESULT=-RESULT
JRST RET ;RETURN
COS: JUMPL T1,BCOEF ;IF X IS NEGATIVE, JUMP TO BCOEF
MOVN T0,T0 ;RESULT=-RESULT
CAMG T2,CHALF ;IF ABS(X) <= .5
FADR T0,CPI2 ;ADD PI/2 TO RESULT
JRST RET ;RETURN
BCOEF: MOVE T1,CPI2 ;T1 CONTAINS PI/2
CAMLE T2,CHALF ;IF ABS(X) > .5
FSC T1,1 ;CONSTANT BECOMES PI
FADR T0,T1 ;ADD CONSTANT TO RESULT
RET: POP P,T2 ;RESTORE REGISTER T2
POP P,T5 ;RESTORE REGISTER T5
GOODBY (1) ;RETURN TO CALLING PROGRAM
ERR0: $LCALL AOI
;LERR (LIB,%,ASIN or ACOS: ABS(arg) > 1.0; result = +infinity)
HRLOI T0,377777 ;RESULT=POSITIVE MACHINE INFINITY
POP P,T5 ;RESTORE REGISTER T5
GOODBY (1) ;RETURN TO CALLING PROGRAM
CONE: 201400000000 ;1.0
CHALF: 200400000000 ;.5
CEPS: 1.0E-8
PP0: 200441171213 ;0.564915737
PP1: 600134535161 ;-0.409490163
PP2: 173475014642 ;1.93496723E-2
CPI: 202622077325 ;3.14159265
CPI2: 201622077325 ;1.57079633
Q0: 202661665706 ;3.38949412
Q1: 575002216372 ;-3.98220081
SEGMENT DATA
TEMP: 0 ;TEMPORARY STORAGE USED FOR SQRT ARG
PRGEND
TITLE ATAN2 TWO ARGUMENT ARC TAN FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY ATAN2
EXTERN ATAN2.
ATAN2=ATAN2.
PRGEND
TITLE ATAN ARC TAN FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY ATAN
EXTERN ATAN.
ATAN=ATAN.
PRGEND
TITLE ATAN. ARC TAN FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL Chris Smith/CKS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;ATAN(X) is computed as follows:
;
;If X < 0, compute ATAN(|X|) below, then ATAN(X) = -ATAN(-X).
;
;If X > 0, use the identity
;
; ATAN(X) = ATAN(XHI) + ATAN(Z)
; Z = (X - XHI) / (1 + X*XHI)
;
;where XHI is chosen so that |Z| <= tan(pi/32).
;
;XHI is chosen to be exactly representable as a single precision number,
;and so Z can be calculated without loss of significance.
;
;ATAN(XHI) is found by table lookup. It is stored as ATANHI + ATANLO to
;provide guard bits for the final addition to ATAN(Z).
;
;ATAN(Z) is evaluated by means of a polynomial approximation from Hart et al.
;(formula 4901).
;
;If X < tan(pi/32), ATAN(X) = ATAN(Z).
;If X > 1/tan(pi/32), ATAN(X) = pi/2 - ATAN(1/X).
;
;If tan(pi/32) < X < 1/tan(pi/32), an appropriate XHI is obtained by indexing
;into a table. The table tells which XHI to use for various ranges of X.
;The index into the table is formed from the low 3 exponent bits and the high
;3 fraction bits of X.
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (ATAN,.) ;ATAN ENTRY
PUSH P,T2 ;SAVE REGISTERS
PUSH P,T3
MOVE T0,@(L) ;GET ARGUMENT X
MOVEM T0,SGNFLG ;SAVE ARGUMENT SIGN FOR RESULT
MOVM T0,T0 ;GET |X|
CAML T0,MAXX ;IS X LARGE?
JRST LARGEX ;YES, GO USE ATAN(X) = PI/2 - ATAN(1/X)
SETZ T2, ;T2 WILL GET OFFSET INTO XHI TABLES
CAMG T0,MINX ;IS X SMALL ENOUGH THAT NO ARG REDUCTION IS REQUIRED?
JRST CALC ;YES, JOIN CALCULATION BELOW
MOVE T3,T0 ;GET A COPY OF X
LSHC T2,9 ;GET EXPONENT, SHIFT HIGH FRACTION BIT
;(ALWAYS 1) INTO SIGN BIT OF T3
ASHC T2,3 ;GET THREE FRACTION BITS, LEAVING
;THE 1 BEHIND
HRRZ T2,OFFSET-2000+24(T2) ;GET OFFSET INTO XHI TABLES
MOVE T1,T0 ;GET A COPY OF X
FSBR T0,XHI(T2) ;GET X-XHI
FMPR T1,XHI(T2) ; X*XHI
FADRI T1,(1.0) ; 1 + X*XHI
FDVR T0,T1 ; (X-XHI) / (1 + X*XHI)
;Here T0 has the reduced argument Z with |Z| <= tan(pi/32). T2 has the
;index into the ATAN(XHI) tables ATANHI and ATANLO. SGNFLG is set negative
;if the result should be negated.
CALC: MOVM T1,T0 ;GET |Z|
CAMG T1,EPS ;IS IT SMALL ENOUGH THAT ATAN(Z) = Z?
JRST SMALLX ;YES, BE FAST, AVOID UNDERFLOW
FMPR T1,T1 ;GET Z**2
MOVE T3,P03 ;GET P(Z**2)
FMPR T3,T1
FADR T3,P02
FMPR T3,T1
FADR T3,P01
FMPR T1,T3
FMPR T1,T0 ; * Z
FADR T0,T1 ; + Z = ATAN(Z)
SMALLX: FAD T0,ATANLO(T2) ; + ATAN(XHI) LOW
FADR T0,ATANHI(T2) ; + ATAN(XHI) HI = ATAN(X)
SKIPG SGNFLG ;ATTACH SIGN TO RESULT
MOVN T0,T0
RET: POP P,T3 ;RETURN
POP P,T2
POPJ P,
LARGEX: MOVSI T1,(-1.0) ;GET -1/X
FDVRM T1,T0
MOVEI T2,PI2OFFS ;GET OFFSET OF PI/2
JRST CALC ;GO COMPUTE PI/2 + ATAN(-1/X)
SUBTTL ATAN2 (Y,X)
;To compute ATAN2(Y,X), let U = |Y| and V = |X|, and compute ATAN(U/V).
;Then find ATAN2(Y,X) based on the signs of Y and X as follows:
;
; X Y ATAN2(Y/X)
;
; pos pos ATAN(U/V)
; pos neg -ATAN(U/V)
; neg pos -(ATAN(U/V) - pi)
; neg neg ATAN(U/V) - pi
;
;The add of -pi is combined with the add of ATAN(XHI) which is the last step
;of the ATAN algorithm.
;
;The reduced argument for ATAN is Z = (U/V - XHI) / (1 + U/V * XHI).
;This is rewritten as (U - V*XHI) / (V + U*XHI). To accurately calculate the
;numerator, find VHI and VLO with
;
; V = VHI + VLO
; VHI has at most 14 significant bits
; VLO has at most 13 significant bits
;
;and choose XHI with at most 13 significant bits. Then VHI*XHI and VLO*XHI can
;be exactly represented as single precision numbers, and the numerator is
;
; U - V*XHI = (U - VHI*XHI) - VLO*XHI
HELLO (ATAN2,.) ;ATAN2 ENTRY
PUSH P,T2 ;SAVE REGISTERS
PUSH P,T3
MOVE T0,@0(L) ;GET Y
FDVR T0,@1(L) ;GET Y/X
JFCL EXCEP ;OVERFLOW AND UNDERFLOW CAN OCCUR
MOVEM T0,SGNFLG ;RESULT SHOULD BE MULTIPLIED BY SGN(Y/X)
MOVM T3,T0 ;GET |Y/X|, ATAN ARG
CAML T3,MAXX ;IS |Y/X| LARGE?
JRST LARGE2 ;YES, GO USE ATAN(Y/X) = PI/2 - ATAN(X/Y)
SETZ T2, ;GET OFFSET INTO ATAN TABLES
CAMG T3,MINX ;IS |Y/X| SMALL ENOUGH TO USE POLYNOMIAL DIRECTLY?
JRST [MOVE T0,T3 ;YES, DO SO
JRST SMALL2]
LSHC T2,9 ;GET INDEX INTO OFFSET TABLES
ASHC T2,3
HRRZ T2,OFFSET-2000+24(T2) ;GET INDEX INTO XHI TABLES
PUSH P,T4 ;SAVE ANOTHER REGISTER
MOVM T0,@0(L) ;GET |Y| = U
MOVM T1,@1(L) ;GET |X| = V
MOVE T3,T1 ;GET A COPY OF V
MOVE T4,T1 ;GET ANOTHER
AND T3,[777777760000] ;GET HIGH 14 BITS OF V = VHI
FSBR T4,T3 ;GET LOW 13 BITS OF V = VLO
FMPR T3,XHI(T2) ;GET V*XHI = VHI * XHI
FMPR T4,XHI(T2) ; + VLO * XHI
FSBR T0,T3 ;GET (U - VHI*XHI)
FSBR T0,T4 ; - VLO*XHI
MOVM T3,@0(L) ;GET U
FMPR T3,XHI(T2) ;GET U * XHI
FADR T1,T3 ;GET V + U*XHI
FDVR T0,T1 ;GET (U - V*XHI) / (V + U*XHI)
POP P,T4 ;RESTORE T4
SMALL2: SKIPGE @1(L) ;IF SECOND ARG (X) IS NEGATIVE
ADDI T2,MPIOFFS ; ADD -PI TO RESULT
JRST CALC ;GO GET ATAN AND RETURN
LARGE2: MOVN T0,@1(L) ;GET -X/Y
FDVR T0,@0(L)
MOVMM T0,SGNFLG ;SET SGNFLG POSITIVE
MOVEI T2,PI2OFFS ;ADD PI/2 TO RESULT IF FIRST ARG (Y) IS POSITIVE
SKIPGE @0(L)
MOVEI T2,MPI2OFFS ;ADD -PI/2 TO RESULT IF FIRST ARG (Y) IS NEGATIVE
JRST CALC ;GO COMPUTE +/- PI/2 + ATAN(-X/Y)
EXCEP: SKIPN @1(L) ;CHECK FOR DIVIDE BY 0
JRST DIVCHK ;IF DIVIDE CHECK, GO CHECK FOR ATAN2(0,0)
JUMPN T0,OVER ;IF OVERFLOW, RESULT IS +/- PI/2
SKIPL @1(L) ;IF UNDERFLOW, CHECK SECOND ARGUMENT
$LCALL RUN,RET
; LERR (LIB,%,<ATAN2: result underflow>,,RET)
;IF SECOND ARG (X) POSITIVE, RESULT UNDERFLOWS
MOVN T0,MPI ;ELSE RESULT IS PI WITH SIGN OF FIRST ARG
JRST YSIGN ;GO ATTACH SIGN AND RETURN
DIVCHK: SKIPE @0(L) ;CHECK FOR BOTH ARGS 0
JRST OVER ;ATAN2(NONZERO,0) IS SAME AS OVERFLOW
$LCALL BAZ
;LERR (LIB,%,<ATAN2: both arguments are zero, result=0.0>)
SETZ T0, ;RETURN 0
JRST RET
OVER: MOVE T0,PI2 ;OVERFLOW, RESULT IS PI/2 WITH SIGN OF FIRST ARG
YSIGN: SKIPGE @0(L) ;ATTACH SIGN OF FIRST ARGUMENT (Y)
MOVN T0,T0
JRST RET ;RETURN
SUBTTL TABLES
;This table is indexed by the low 3 exponent bits and the high 3 fraction bits
;of X, where MINX < X < MAXX. It gives the offset into XHI, ATANHI, and ATANLO
;of a suitable XHI.
OFFSET: DEC 1,1,1,2,2,3,3,4,4,4,5,5,5,6,6,7,7,7,8,8,8,9,9,9
DEC 10,10,10,10,11,11,11,12,12,12,12,12,13,13,13,13
DEC 13,13,14,14,14,14,14,14,14,14,14,14,14,14,14
PI2OFFS=^D15 ;OFFSET INTO ATANHI AND ATANLO OF PI/2
MPIOFFS=^D16 ;OFFSET OF -PI
MPI2OFFS=^D31 ;OFFSET OF -PI/2
XHI: EXP 000000000000 ; .000000000 not used
EXP 175657740000 ; .105453491 X1
EXP 176407740000 ; .128875732 X2
EXP 176477740000 ; .156219482
EXP 176617640000 ; .195220947
EXP 176777400000 ; .249755859
EXP 177477540000 ; .312194824
EXP 177617200000 ; .389892578
EXP 177776300000 ; .498413086
EXP 200515740000 ; .652221680
EXP 200674040000 ; .867309570
EXP 201453440000 ; 1.17016602
EXP 201645100000 ; 1.64501953
EXP 202511040000 ; 2.57080078
EXP 203527000000 ; 5.35937500 X14
ATANHI: EXP 000000000000 ; .000000000 ATAN(0)
EXP 175656261521 ; .105065183 ATAN(X1)
EXP 176406373155 ; .128169263 ATAN(X2)
EXP 176475276501 ; .154966952
EXP 176612661306 ; .192796122
EXP 176765175625 ; .244748870
EXP 177465675100 ; .302606821
EXP 177574536625 ; .371762831
EXP 177731362666 ; .462377273
EXP 200447716237 ; .577935450
EXP 200555632634 ; .714457721
EXP 200672140433 ; .863649569
EXP 201406227205 ; 1.02459152
EXP 201463117110 ; 1.19982255
EXP 201542714675 ; 1.38632865 ATAN(X14)
PI2: EXP 201622077325 ; 1.57079633 PI/2
MPI: EXP 575155700452 ;-3.14159268 -PI
EXP 575173246104 ;-3.03652751 -PI + ATAN(X1)
EXP 575176220221 ;-3.01342341 -PI + ATAN(X2)
EXP 575201554376 ;-2.98662573
EXP 575206433526 ;-2.94879657
EXP 575215150343 ;-2.89684382
EXP 575224470162 ;-2.83898586
EXP 575235354335 ;-2.76982984
EXP 575251036741 ;-2.67921540
EXP 575267664122 ;-2.56365722
EXP 575311247221 ;-2.42713496
EXP 575334330561 ;-2.27794310
EXP 575361014154 ;-2.11700118
EXP 576016720235 ;-1.94177012
EXP 576076516022 ;-1.75526401 -PI + ATAN(X14)
EXP 576155700453 ;-1.57079633 -PI/2
ATANLO: EXP 000000000000 ; .000000000
EXP 636247477474 ;-.313207918E-09
EXP 636051035473 ;-.428319397E-09
EXP 635130365140 ;-.770380426E-09
EXP 637267032057 ;-.149588704E-09
EXP 142516146051 ; .607905122E-09
EXP 634037666255 ;-.174675323E-08
EXP 636153733615 ;-.367500207E-09
EXP 635370616245 ;-.478798078E-09
EXP 635035566432 ;-.877241210E-09
EXP 143723624120 ; .170180781E-08
EXP 144654652224 ; .312016779E-08
EXP 632252164020 ;-.497345720E-08
EXP 145452272305 ; .434176811E-08
EXP 145613704216 ; .576086101E-08
EXP 143420550604 ; .992093574E-09
EXP 147735722717 ; .278181351E-07
EXP 150564207746 ; .433374110E-07
EXP 147566433274 ; .218018803E-07
EXP 147760532442 ; .289103999E-07
EXP 150515527434 ; .388444175E-07
EXP 150504133030 ; .377392659E-07
EXP 147677716232 ; .260713819E-07
EXP 147427462256 ; .162747642E-07
EXP 147525537265 ; .198887566E-07
EXP 147516656470 ; .194903134E-07
EXP 147773114124 ; .295199429E-07
EXP 147623410142 ; .234877224E-07
EXP 150504167752 ; .377458393E-07
EXP 147450401401 ; .172587422E-07
EXP 147500703763 ; .186778351E-07
EXP 634357227174 ;-.992093574E-09
;COEFFICIENTS OF APPROXIMATION POLYNOMIAL ATAN(X) = X*P(X**2)
P01: EXP 600252525261 ;-.333333308
P02: EXP 176631445546 ; .199987124
P03: EXP 601337626575 ;-.140725380
EPS: EXP 163721135503 ;LARGEST X WITH ATAN(X)=X
MINX: EXP 175623327343 ;TAN(PI/32)
MAXX: EXP 204504715427 ;1/TAN(PI/32)
SEGMENT DATA
SGNFLG: BLOCK 1 ;SIGN TO BE ATTACHED TO RESULT
PRGEND
TITLE COSH HYPERBOLIC COSINE FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY COSH
EXTERN COSH.
COSH=COSH.
PRGEND
TITLE COSH. HYPERBOLIC COSINE FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;COSH(X) IS CALCULATED AS FOLLOWS
; LET V BE APPROXIMATELY 2 SO THAT LN V AND ABS(X) + LN V CAN
; BE EXACTLY REPRESENTED WHEN X IS EXACTLY REPRESENTABLE.
; THEN, THE CALCULATION IS (LETTING X = ABS(X)),
; IF X <= 88.029678, RESULT 1 IS CALCULATED, AS
; COSH(X) = (EXP(X) + 1/EXP(X))/2.0
; IF 88.028678 < W < 128 * LN(2)
; RESULT 2 IS OBTAINED, AS
; COSH(X) = (V/2)*EXP(X - LN(V))
; IF X >= 128 * LN(2)
; COSH(X) = +MACHINE INFINITY
; AND AN ERROR MESSAGE IS RETURNED
;THE RANGE OF DEFINITION FOR COSH IS ABS(X)<=88.722,
; AND ARGUMENTS OUT OF THIS RANGE WILL CAUSE AN ERROR
; MESSAGE TO BE TYPED. A RESULT OF + MACHINE INFINITY
; WILL BE RETURNED
;REQUIRED (CALLED) ROUTINES: EXP
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,COSH
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (COSH,.) ;ENTRY TO HYPERBOLIC COSINE ROUTINE.
MOVE T0,@(L) ;OBTAIN THE ARGUMENT
MOVM T1,T0 ;X=ABS(ARG)
CAMG T1,EPS ;IF ABS(X) <= EPS
JRST SMALL ;ANSWER IS ONE
CAMLE T1,XMAX ;IF X > 88.029,
JRST OV88 ;GO TO OV88
; ;OTHERWISE, OBTAIN RESULT 1
MOVEM T1,TEMP
FUNCT EXP.,<TEMP> ;EXP(X)
CAML T1,TWO14 ;IF EXP(X) .GT. 2**14
JRST HALVE ;NEGLECT EXP(-X)
MOVSI T1,201400 ;1.0
FDVR T1,T0 ;/EXP(X).
FADR T0,T1 ;+ EXP(-X).
HALVE: FSC T0,-1 ;/2.0
GOODBY (1) ;RETURN
OV88: CAMGE T1,XXMAX ;TOO LARGE?
JRST EXPP ;NO. GO TO EXPP
OVFL: $LCALL ROV
;LERR (LIB,%,COSH: result overflow)
HRLOI T0,377777 ;ANSWER = +INFINITY.
GOODBY (1) ;RETURN
EXPP: FSBR T1,LN2VE ;X-LN(V)
MOVEM T1,TEMP
FUNCT EXP.,<TEMP> ;OBTAIN RESULT 2
MOVE T1,T0 ;SAVE A COPY OF EXP (2 - LN2VE)
FMPR T0,CON1 ;MULTIPLY BY (LN2VE - LN2)
FADR T0,T1 ;SUM = (1/2)*EXP(W)
JFCL OVFL ;(ROUNDING ERRORS MIGHT CAUSE OVERFLOW)
GOODBY (1) ;COSH RETURN
SMALL: MOVSI T0,201400 ;RESULT IS ONE
GOODBY (1) ;RETURN
LN2VE: 200542714000 ;LN(V)=.693161011
XMAX: 207540074620 ;88.029678
XXMAX: 207542710300 ;128 * LN(2)
CON1: 160720040562 ;LN2VE - LN(2)
SEGMENT DATA
TEMP: 0 ;TEMPORARY STORAGE FOR EXP CALL
TWO14: 217400000000 ;2**14
EPS: 163400000000 ;2**(-14)
PRGEND
TITLE EXP1. INTEGER ** INTEGER EXPONENENTIATION
SUBTTL CHRIS SMITH/CKS 28-Jan-80
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
SEGMENT CODE
HELLO (EXP1,.)
MOVEI T0,1 ;SET RESULT TO 1
MOVE T1,@1(L) ;GET EXPONENT
PUSH P,T2 ;SAVE TEMP REGISTER
SKIPN T2,@0(L) ;GET BASE
JRST E1ZERO ;BASE IS ZERO, GO HANDLE
JUMPG T1,E1POS ;EXPONENT POSITIVE, GO HANDLE
JUMPE T1,E1RET ;EXPONENT ZERO, RETURN 1
TRNE T1,1 ;EXPONENT NEGATIVE, IS IT ODD?
MOVE T0,T2 ;YES, RESULT IS -1 IF BASE IS -1
CAME T2,[-1] ;IS BASE -1?
CAIN T2,1 ;OR +1?
JRST E1RET ;YES, RESULT IS 1 OR -1
E1RTZ: SETZ T0, ;ELSE RESULT IS 0
JRST E1RET ;RETURN
E1LP: IMUL T2,T2 ;SQUARE BASE
JFCL E1OVFL ;CATCH OVERFLOW
E1POS: TRNE T1,1 ;CHECK LOW BIT OF EXPONENT
IMUL T0,T2 ;MULTIPLY ANSWER BY BASE
JFCL E1OVFL ;CATCH OVERFLOW
LSH T1,-1 ;DIVIDE EXPONENT BY 2
JUMPN T1,E1LP ;HANDLE ALL BITS OF EXPONENT
E1RET: POP P,T2 ;RESTORE TEMP REGISTERS
POPJ P, ;DONE
E1ZERO: JUMPG T1,E1RTZ ;BASE 0, RESULT IS 0 IF EXPONENT POSITIVE
JUMPE T1,E1ZZZ ;RESULT IS INDETERMINATE IF EXPONENT ZERO
;ELSE FALL INTO OVERFLOW
E1OVFL: $LCALL ROV ;RESULT OVERFLOW
HRLOI T0,377777 ;GUESS POSITIVE RESULT
SKIPL @0(L) ;CHECK SIGN OF BASE
JRST E1RET ;BASE NONNEGATIVE, GO RETURN +INFINITY
MOVE T1,@1(L) ;BASE NEGATIVE, CHECK FOR ODD EXPONENT
TRNE T1,1 ;ODD EXPONENT?
MOVSI T0,400000 ;NEGATIVE**ODD, RETURN -INFINITY
JRST E1RET
E1ZZZ: $LCALL ZZZ ;0**0 IS INDETERMINATE
SETZ T0, ;RETURN 0
JRST E1RET
PRGEND
TITLE EXP2. REAL**INTEGER EXPONENTIATION
SUBTTL MARY PAYNE/MHP/CKS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
SEGMENT CODE
SALL
; Mary Payne, July 30, 1982
HELLO (EXP2,.)
DMOVEM T2,SAVE2 ;[3243] Save T2-T3
MOVSI T0,(1.0) ;Floating 1 to T0
MOVM T1,@1(L) ;|exponent| to T1
JUMPE T1,EXP0 ;Exponent = 0 is special
SKIPE T2,@0(L) ;Base to T2. If base not 0
JRST STEP1 ; go to main flow
JRST BASE0 ;Else to special code
LOOP: FMPR T2,T2 ;Square current result
JOV OVER2 ;Over/underflow possible
STEP1: TRNE T1,1 ;If exponent is odd
FMPR T0,T2 ; update current result
JOV OVER ; Branch on over/underflow
LSH T1,-1 ;Discard low bit of exponent
JUMPN T1,LOOP ;Iterate if not 0
SKIPL @1(L) ;If exponent > 0
JRST RET ;[3243] return
MOVSI T1,(1.0) ;Else get reciprocal of
FDVRM T1,T0 ;result; Underflow impossible
JOV OVMSG ; On overflow get message
JRST RET ;[3243] Else return
EXP0: SKIPE @0(L) ;Exponent 0. If base not
JRST RET ;[3243] 0, result is 1. Return
$LCALL ZZZ ;zero**zero is indeterminate, result=zero
SETZ T0, ;Store 0
JRST RET
BASE0: ;[3243] Base is 0, exponent is not.
SKIPL @1(L) ;If exponent > 0
JRST ZERO ; result is 0
$LCALL ROV ;Else overflow
HRLOI T0,377777 ;Store +biggest
JRST RET
ZERO: SETZ T0, ;Result is 0
JRST RET ;Return
;
;The following block of code deals with over/underflow in the
;square operation at LOOP:. Note that the "exponent" cannot be
;0 -- LOOP: is entered only if T1 is not 0. Moreover, if T1 is
;not 1 subsequent operations will aggravate the over/underflow
;condition in such a way that both the result of the iteration
;and its reciprocal will have the same exception as currently
;indicated. If, however, T1 = 1, and the square overflowed, it
;is possible that its reciprocal will be in range. We therefore
;complete the current pass through the loop, and if the LSH of T1
;makes it zero, we join the handling at OVER: for overflow/underflow
;on the MUL of T0 by T2. Note that no exception can occur on the
;MUL of T0 by a wrapped over/underflow of the square, so that the
;exception flags will still be valid after this step.
;
OVER2: FMPR T0,T2 ;No over/underflow. Hence flags
; from square of T2 still valid
LSH T1,-1 ;Discard low bit of exponent
JUMPE T1,OVER ;If T1 = 0, T0 has wrapped final
; result or its reciprocal
; which may be in range
GETFLG T2 ;[3243] get exception flags into T2
TLNE T2,(PC%FUF) ;[3243] If underflow flag set, reciprocal
JRST UNDER ; overflows. Go test sign of exponent
SKIPL @1(L) ;For overflow, if exponent > 0
JRST UNDMSG ; final result underflows.
JRST OVMSGF ;Else reciprocal gives overflow
;[3243]
;The rest of the code handles over/underflow on the product of
;T0 by T2 and calculation of the reciprocal, if this is done.
;
OVER: GETFLG T2 ;[3243] get exception flags into T2
TLNE T2,(PC%FUF) ;[3243] If underflow flag set
JRST UNDER ; underflow on product
SKIPL @1(L) ;[3243] Else, overflow on result if
JRST OVMSGF ;[3243] exponent > 0. Get message, clear flags
MOVSI T3,(1.0) ;[3243] For exponent < 0, get
FDVRM T3,T0 ;[3243] reciprocal of wrapped overflow
JOV RETF ;[3243] Underflow impossible; overflow
; compensates previous overflow
JRST UNDMSG ;Else, get underflow message
UNDER: SKIPL @1(L) ;Product underflowed. If exponent
JRST UNDMSG ; >/= 0, result underflows
;Else reciprocal overflows
;[3243] entry point necessary because other branches join OVMSG
OVMSGF: RESFLG T2 ;[3243] reset the flags, T2-T3 are dbl wd PC
OVMSG: $LCALL ROV ;Result overflow
JUMPL T0,NEGOV ;If result > 0
HRLOI T0,377777 ;Store +BIGGEST
JRST RET ; and return
NEGOV: MOVE T0,[400000000001] ;If result < 0, store -BIGGEST
JRST RET ; and return
UNDMSG: $LCALL RUN ;result underflow
SETZ T0,
RETF: RESFLG T2 ;[3243] reset flags now, T2-T3 are dbl wd PC
RET: DMOVE T2,SAVE2 ;[3243] restore T2-T3
POPJ P,
SEGMENT DATA
SAVE2: BLOCK 2 ;Temp for T2-T3
PRGEND
TITLE EXP3. POWER FUNCTION
; (SINGLE PRECISION)
SUBTTL IMSL, INC. JUNE 4, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;EXP3 CALCULATES X**Y WHERE X AND Y ARE FLOATING POINT VALUES IN THE
;FOLLOWING RANGES
; 0.0 < X < + MACHINE INFINITY (X MAY EQUAL 0.0 IF Y > 0.0 AND
; X MAY BE LESS THAN 0.0 IF Y IS AN INTEGER. IF X IS < 0.0
; AND Y IS NOT AN INTEGER, A WARNING ERROR IS ISSUED AND
; ABS(X)**Y IS CALCULATED.)
; -129.0 <= FLOAT(INT((Y*LOG2(X))*16))/16 < 127.0
; X**Y IS CALCULATED AS 2**W WHERE W = Y*LOG2(X). LOG2(X) IS
; CALCULATED AS FOLLOWS;
; X = F*(2**M), 1/2 <= F < 1. PICK P SUCH THAT P IS AN ODD
; INTEGER < 16 AND LET A = 2**(-P/16). NOW X = ((2**M)*A)*(F/A)
; LOG2(X) = M+LOG2(A) + LOG2(F/A) OR
; LOG2(X) = M-(P/16) + LOG2(F/A) .
; LET U1 = M-(P/16) AND
; U2 = LOG2(F/A) = LOG2((1+S)/(1-S)).
; THEN LOG2(X) = U1 + U2.
; AND S = (F-A)/(F+A). A RATIONAL
; APPROXIMATION IS USED TO EVALUATE U2. U1 AND U2 ARE THEN
; USED TO DETERMINE W1 AND W2 WHERE W=W1+W2
; AND W1 = FLOAT(INT(W*16.0))/16.0. FINALLY Z=X**Y=2**W
; IS RECONSTRUCTED AS Z = (2**W1) * (2**W2) WHERE
; W1 = M1-P1/16 AND 2**W2 IS EVALUATED FROM ANOTHER RATIONAL
; FUNCTION.
;THE RANGE OF DEFINITION FOR EXP3 IS GIVEN ABOVE, AND ERROR MESSAGES
; WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE
;REQUIRED (CALLED) ROUTINES: NONE
;REGISTERS T2, T3, T4, AND T5 WERE SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,EXP3
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (EXP3,.) ;ENTRY TO EXP3. ROUTINE
MOVE T0,@(L) ;GET THE BASE
MOVE T1,@1(L) ;GET THE EXPONENT
STRT: SETZM IFLAG ;SET INTEGER EXP FLAG TO 0
JUMPG T0,XOK ;IF X IS NOT GT 0
JUMPE T0,X0 ;AND IF X IS NOT = 0
PUSH P,T2 ;SAVE ACCUMULATORS
PUSH P,T3
PUSH P,T4
MOVM T2,T1 ;GET A COPY OF ABS(Y)
MOVE T4,T2 ;PUT ABS(Y) IN T4
SETZ T3, ;SET T3 TO ZERO
LSHC T3,11 ;GET EXPONENT OF ABS(Y)
SUBI T3,170 ;GET SHIFTING FACTOR
LSH T2,(T3) ;SHIFT OFF EXP AND PART OF INTEGER
TLNE T2,400000 ;IF Y IS ODD
SETOM IFLAG ;SET IFLAG TO ONES
LSH T2,1 ;SHIFT OFF REST OF INTEGER PART
MOVM T0,T0 ;GET ABS(X) IN T0
JUMPN T2,ERR0 ;ERROR IF Y NOT AN INTEGER.
CAME T0,A1 ;IF X NOT -1
JRST YINT ; REJOIN MAIN FLOW.
JRST RET2 ;ELSE RESULT = + OR - 1
ERR0: $LCALL NNA
;LERR (LIB,%,<EXP3: negative ** non-integer; ABS(base) used instead of base>)
JRST CONT ;GO TO CONT
X0: JUMPG T1,RET1 ;0 ** POSITIVE IS +1
JUMPE T1,ZERZER ;0 ** 0 IS AN ERROR
$LCALL ZNI
;LERR (LIB,%,<EXP3: 0.0 ** negative; result = infinity>)
HRLOI T0,377777 ;RESULT = INFINITY
GOODBY ;RETURN
ZERZER: $LCALL ZZZ
;LERR (LIB,%,<EXP3: 0.0 ** 0.0 is undefined; result = 0.0>)
GOODBY
XOK: CAMN T0,A1 ;IF X = 1, RESULT IS 1
JRST RET1 ;RETURN
PUSH P,T2 ;SAVE ACCUMULATORS
PUSH P,T3
PUSH P,T4
YINT: CAMN T1,A1 ;IF Y = 1.0
JRST RET2 ;GO TO RET2
JUMPN T1,CONT ;IF Y IS NOT 0, GO TO CONT
MOVE T0,A1 ;SET RESULT TO 1.0
JRST RET2 ;GO TO RET2
CONT: PUSH P,T5
MOVE T2,T0 ;OBTAIN THE EXPONENT
ASH T2,-33 ;SHIFT MANTISSA OFF
SUBI T2,200 ;SUBTRACT 128 FROM EXPONENT
MOVEM T2,M
MOVE T2,T0 ;OBTAIN FRACTIONAL PART
AND T2,MASK1 ;EXTRACT MANTISSA
IOR T2,MASK2 ;SET EXPONENT TO 0
MOVEI T5,1 ;NP = 1
CAMLE T2,A1+10 ;IF F GT A1(9)
JRST NXT1 ;THEN GO TO NXT1
ADDI T5,10 ;OTHERWISE NP=9
NXT1: CAMLE T2,A1+3(T5) ;IF F GT A1(P+4)
JRST NXT2 ;THEN GO TO NXT2
ADDI T5,4 ;OTHERWISE NP = NP+4
NXT2: CAMLE T2,A1+1(T5) ;IF F GT A1(P+2)
JRST NXT3 ;THEN GO TO NXT3
ADDI T5,2 ;OTHERWISE NP=NP+2
NXT3: MOVE T3,T5 ;NA = NP
ADDI T3,1 ; + 1
ASH T3,-1 ; / 2
MOVE T0,T2 ;Z1 =
FADR T0,A1(T5) ;F + A1(P+1)
MOVE T4,T2 ;Z =
FSBR T4,A1(T5) ;[F-A1(P+1)
FSBR T4,A2-1(T3) ; -A2(NA)]
FDVR T4,T0 ;/Z1
FSC T4,1 ;Z = Z+Z
MOVE T0,T4 ;RZ =
FMPR T0,T0 ;Z**2
MOVE T2,T0 ;SAVE A COPY OF Z**2
FMPR T0,RP2 ;*RP2
FADR T0,RP1 ;+RP1
FMPR T0,T2 ; * Z**2
FMPR T0,T4 ; * Z
FADR T0,T4 ; + Z
MOVE T4,T0 ; U2 =
FMPR T0,XK ;RZ*XK
FADR T4,T0 ;+ RZ
MOVE T2,M ;GET U1
ASH T2,4 ;M*16
SUB T2,T5 ;-NP
FLTR T2,T2 ;FLOAT
FSC T2,-4 ; /16 = U1
SETZB T3,T5 ;
DFAD T4,T2 ;U = U1+U2
SETZ T2, ;
DFMP T4,T1 ;W = Y*U
JFCL EXCEP ;CAN OVERFLOW OR UNDERFLOW
CAMGE T4,BIGW ;IF W IS NOT TOO BIG
JRST WOK ;THEN PROCEED
OVFL: $LCALL ROV
;LERR (LIB,%,EXP3: result overflow)
HRLOI T0,377777 ; RESULT = INFINITY
JRST RET ; RETURN
EXCEP: JUMPN T4,OVER ;JUMP IF W = Y*U OVERFLOWS
MOVE T0,A1 ;IF W UNDERFLOWS, RESULT IS 1
JRST RET3 ;RETURN
OVER: JUMPL T4,UNDFL ;W NEGATIVE, RESULT UNDERFLOWS
JRST OVFL ;W POSITIVE, RESULT OVERFLOWS
WOK: CAML T4,SMALLW ;IF W IS NOT TOO SMALL
JRST WOK2 ;THEN PROCEED
UNDFL: $LCALL RUN
;LERR (LIB,%,EXP3: result underflow)
SETZ T0, ; RESULT = 0
JRST RET ; RETURN
WOK2: DMOVE T0,T4 ;SAVE A COPY OF DABS(W)
JUMPGE T4,WPOS
DMOVN T0,T4
WPOS: LDB T1,[POINT 8,T0,8] ;GET BIASED EXPONENT OF ABS(W)
SUBI T1,175 ;GET SHIFTING FACTOR
JUMPGE T1,GETW1 ;IF T1 IS .GE. 0
;THEN GO TO GETW1
SETZB T1,T3 ;M1 = 0; NP1+1 = 0
PUSHJ P,SNG.4## ;W2 = W ROUNDED TO SINGLE PRECISION
JRST REST
GETW1: AND T0,MASK(T1) ;GET W1
JUMPG T4,GETW2 ;IF W IS NEGATIVE
DMOVN T4,T4 ;GET |W|.
SETZ T1, ;ZERO EXTEND |W1|
DFSB T4,T0 ; AND SUBTRACT FROM |W|.
PUSHJ P,SNG.4## ;ROUND |W2| TO SINGLE
MOVN T4,T4 ;AND NEGATE TO GET W2
FSC T0,4 ;GET 16*|W1|
FIX T3,T0 ; AND CONVERT TO INTEGER
MOVN T3,T3 ;AND MAKE NEGATIVE
JRST GETSCL ;GO GET M1 AND NP1+1
GETW2: SETZ T1,
DFSB T4,T0 ;W2 = W-W1
PUSHJ P,SNG.4## ;ROUND W2 TO SINGLE PRECISION
FSC T0,4 ;W1*16
FIX T3,T0 ; INT(W1*16)
GETSCL: MOVE T5,T3
JUMPGE T3,NPOS
ADDI T3,17
NPOS: ASH T3,-4 ; /16
CAIL T5,0 ;IF N1 IS GE 0
ADDI T3,1 ;M1 = M1+1
MOVE T1,T3
ASH T3,4 ; M1 * 16
SUB T3,T5 ; - N1 = NP1
REST: MOVE T0,T4 ;GET(2**W2)-1
FMPR T0,Q5 ;Z = Q5*W2
FADR T0,Q4 ; +Q4
FMPR T0,T4 ;*W2
FADR T0,Q3 ;+Q3
FMPR T0,T4 ;*W2
FADR T0,Q2 ;+Q2
FMPR T0,T4 ;*W2
FADR T0,Q1 ;+Q1
FMPR T0,T4 ;*W2
FMPR T0,A1(T3) ; Z = Z*A1(NP1+1)
FADR T0,A1(T3) ; + A1(NP1+1)
FSC T0,(T1) ; ADD M1 TO THE EXP OF Z
RET: POP P,T5
RET2: SKIPE IFLAG ;IF IFLAG IS ON
MOVN T0,T0 ; NEGATE RESULT
RET3: POP P,T4
POP P,T3
POP P,T2
RET1: GOODBY (1) ;RETURN
BIGW: 127.0E0 ;UPPER BOUND FOR WW
SMALLW: -129.0E0 ;LOWER BOUND FOR W
XK: 0.4426950409E0 ;LOG2(E)-1.0
RP1: 0.8333332862E-1 ;
RP2: 0.1250648500E-1 ;
Q1: 0.6931471806E+0 ;USED TO DETERMINE
Q2: 0.2402265061E+0 ;2**W2
Q3: 0.5550404881E-1 ;
Q4: 0.9616206596E-2 ;
Q5: 0.1305255159E-2 ;
A1: 1.0E0 ;A1(I), I=1,17 =
A12: 200752225751 ;2**((1-I))/16. THIS
A13: 200725403067 ;TABLE IS SEARCHED
A14: 200701463367 ;TO DETERMINE P.
A15: 200656423746 ;
A16: 200634222141 ;
A17: 200612634521 ;
A18: 200572042435 ;
A19: 200552023632 ;
A110: 200532540767 ;
A111: 200513773265 ;
A112: 200475724623 ;
A113: 200460337603 ;
A114: 200443417234 ;
A115: 200427127017 ;
A116: 200413253033 ;
A117: 0.5E0 ;
A2: 633244441546 ;
A22: 144605245161 ;
A23: 633243741100 ;
A24: 637260060666 ;
A25: 144510250245 ;
A26: 140443204215 ;
A27: 633165304342 ;
A28: 143763044173 ;
MASK1: 000777777777 ;MASK FOR MANTISSA
MASK2: 200000000000 ;MASK FOR EXPONENT
MASK: 777400000000 ;MASKS FOR FINDING W1
MSK1: 777600000000 ;
MSK2: 777700000000 ;
MSK3: 777740000000 ;
MSK4: 777760000000 ;
MSK5: 777770000000 ;
MSK6: 777774000000 ;
MSK7: 777776000000 ;
MSK8: 777777000000 ;
MSK9: 777777400000 ;
MSK10: 777777600000 ;
MSK11: 777777700000 ;
SEGMENT DATA
IFLAG: 0 ;ODD INT EXP FLAG
M: 0 ;
PRGEND
TITLE RANS SHUFFLED RANDOM NUMBER GENERATOR
; (SINGLE PRECISION)
SUBTTL IMSL, INC. FEBRUARY 26, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;RANS IS A PRIME-MODULUS RANDOM NUMBER GENERATOR WITH SHUFFLING WHICH
;COMPUTES PSEUDO RANDOM NUMBERS AS FOLLOWS:
; ON THE INITIAL REFERENCE TO RANS, RAN IS CALLED 128 TIMES TO
; GENERATE S(1),S(2),...,S(128) (UNIFORM RANDOM DEVIATES IN (0,1)) AND A
; NEW SEED X(0). X(0) IS OBTAINED BY CALLING SAVRAN AFTER S(128) HAS BEEN
; GENERATED.
; THEN X(I+1) = (630360016*X(I) MOD ((2**31)-1)
; J = (X(I+1) MOD 128) +1
; T = S(J)
; S(J) = X(I+1)/(2**31)
; RANS RETURNS T AS ITS FUNCTION VALUE.
;REQUIRED (CALLED) ROUTINES: RAN
;REGISTER T2 WAS SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE;
; PUSHJ P,RAN
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (RANS) ;ENTRY TO RANS
PUSH P,T2 ;
SKIPN T1,IOPT ;IF THIS IS NOT INITIAL ENTRY
JRST GGUW ;THEN GO GENERATE AND SHUFFLE
SETZM IOPT ;
MOVE T2,SETCNT ;SET COUNTERS
GGUB: FUNCT RAN,<IOPT> ;GENERATE A RANDOM NUMBER
MOVEM T0,WK-1(T2)
AOBJN T2,GGUB ;RETURN TO GGUB UNTIL 128
;NUMBERS HAVE BEEN GENERATED
GGUW: FUNCT SVRAN.,<ICEED> ;[4012]GET LAST SEED GENERATED
MOVE T1,ICEED ;GET SEED
MUL T1,CON3 ;SEED = SEED*630360016
DIV T1,CON4 ;MOD(SEED,(2**31)-1)
MOVEM T2,ICEED ;MOVE NEW SEED TO MEMORY
FUNCT STRAN.,<ICEED> ;[4012]SET NEW SEED
ANDI T2,177 ;SEED = MOD(SEED,128.)
MOVE T1,ICEED ;RETRIEVE SEED
MOVSI T0,237000 ;[3231] FLOAT SEED AND DIVIDE BY 2**31
DFAD T0,DZERO ;[3231] NORMALIZE RESULT
EXCH T0,WK(T1) ;[3231]SWAP RESULT WITH OLD TABLE ENTRY
POP P,T2
GOODBY (1)
SETCNT: 777600000001 ;SET COUNTERS
CON4: 017777777777 ;(2**31)-1
CON3: ^D630360016 ;[3231] 630360016
DZERO: EXP 0,0 ;[3231] Used to normalize seed
SEGMENT DATA
ICEED: 0 ;
IOPT: 1 ;OPTION SWITCH
WK: BLOCK 200 ;ALLOCATE WORK AREA
PRGEND
TITLE SAVRAN
SUBTTL M. R. BOUCHER/MRB 11-JUN-84
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY SAVRAN
EXTERN SVRAN.
SAVRAN=SVRAN.
PRGEND
TITLE SETRAN
SUBTTL M. R. BOUCHER/MRB 11-JUN-84
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY SETRAN
EXTERN STRAN.
SETRAN=STRAN.
PRGEND
TITLE RAN RANDOM NUMBER GENERATOR
; (INTEGER)
SUBTTL IMSL, INC. JANUARY 23, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORRANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;STRAN. (Formally SETRAN), MAY BE USED AS FOLLOWS
; THE SEED FOR RAN MAY BE INITIALIZED TO AN INTEGER VALUE IN THE
; EXCLUSIVE RANGE (1,2147483647) BY A CALL TO SETRAN(I) WITH I = SEED.
; SETRAN PROTECTS AGAINST AN ILLEGAL SEED BY SETTING SEED EQUAL TO
; MOD(ABS(SEED),2147483648).
; A CALL TO SETRAN WITH I = 0 WILL SET THE SEED TO THE DEFAULT VALUE
; USED BY RAN. THE DEFAULT VALUE OF SEED IS 524287.
; UPON EACH CALL TO RAN A NEW SEED IS GENERATED FOR SUBSEQUENT USE.
;RAN(I) IS CALCULATED AS FOLLOWS
; FIRST THE NEW SEED IS CALCULATED AS
; SEED = MOD(SEED*630360016,2147483647)
; THE RANDOM NUMBER IS THEN CALCULATED AS
; RAN = SEED/2147483648
;A CALL TO SAVRAN, CALL SAVRAN(I), RETURNS THE LAST SEED USED BY
; RAN IN I.
;
;REQUIRED (CALLED) ROUTINES: NONE
;THE ROUTINES STRAN.(SETRAN) AND SVRAN.(SAVRAN) HAVE THE FOLLOWING
;CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,STRAN.
; OR
; PUSHJ P,SVRAN.
;THE RESULT FOR SAVRAN IS RETURNED IN ARG
;THE ROUTINE RAN HAS THE FOLLOWING CALLING SEQUENCE:
; PUSHJ P,RAN
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (STRAN.) ;[4012]ENTRY TO SETRAN
MOVM T0,@(L) ;OBTAIN ABSOLUTE VALUE OF ARGUMENT
AND T0,CON4 ;T0=MOD(T0,2**31)
CAIN T0,0 ;IF T0 IS ZERO
MOVE T0,JSEED ;SET T0 TO DEFAULT SEED
MOVEM T0,ISEED ;MOVE NEW SEED TO MEMORY
GOODBY (1) ;RETURN
HELLO (RAN) ;ENTRY TO RAN
MOVE T0,ISEED ;OBTAIN CURRENT SEED
MUL T0,CON3 ;SEED=SEED*630360016
DIV T0,CON4 ;MOD(SEED,(2**31)-1)
MOVEM T1,ISEED ;MOVE NEW SEED TO MEMORY
MOVSI T0,237000 ;FLOAT SEED AND DIVIDE BY 2**31
DFAD T0,DZERO ;NORMALIZE RESULT
GOODBY (1) ;RETURN
HELLO (SVRAN.) ;[4012]ENTRY TO SAVRAN
MOVE T0,ISEED ;OBTAIN CURRENT SEED
MOVEM T0,@(L) ;MOVE CURRENT SEED TO ARGUMENT
GOODBY (1) ;RETURN
DZERO: EXP 0,0 ;ZEROS
CON3: ^D630360016 ;MULTIPLIER FROM VERSION 5A
CON4: 017777777777 ;(2**31) - 1
SEGMENT DATA
ISEED: ^D524287 ;SEED FROM VERSION 5A
JSEED: ^D524287 ;SEED FROM VERSION 5A
PRGEND
TITLE COS SINE AND COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY COS
EXTERN COS.
COS=COS.
PRGEND
TITLE SIN SINE AND COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY SIN
EXTERN SIN.
SIN=SIN.
PRGEND
TITLE COSD SINE AND COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY COSD
EXTERN COSD.
COSD=COSD.
PRGEND
TITLE SIND SINE AND COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY SIND
EXTERN SIND.
SIND=SIND.
PRGEND
TITLE SIN. SINE AND COSINE FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;COS(X) AND SIN(X) ARE CALCULATED AS FOLLOWS
; NOTE THAT COS(X) = COS(-X) AND SIN(X) = -SIN(-X)
; LET ABS(X) = N*PI + F WHERE ABS(F) <= PI/2
; WHEN ABS(F) < EPS (SEE CONSTANTS, BELOW), SIN(F) = F
; OTHERWISE, THE ARGUMENT REDUCTION IS:
; N = THE NEAREST INTEGER TO ABS(X)/PI, FOR SIN, OR
; THIS INTEGER + 1/2 FOR COS
; THEN THE REDUCED ARGUMENT F = ABS(X)-N*PI
; LET G = F**2
; THEN R(G) = ((((R5*G + R4)*G + R3)*G + R2)*G + R1)*G
; AND SIN(F) = F + F*R(G). THE R(I) APPEAR BELOW
; FINALLY,
; SIN(X) = SIGN(X)*SIN(F)*(-1)**N, AND
; COS(X) = SIN(X + PI/2)
; THE RANGE OF DEFINITION IS GIVEN BY [|X|/PI] < 2**26 FOR RADIANS, AND BY
; [|X|/180] < 2**20 FOR DEGREES.
; SIN(X) = COS(X) = 0.0 AND AN
; ERROR MESSAGE WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE
;REQUIRED (CALLED) ROUTINES: NONE
;REGISTERS T2 AND T3 WERE SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,SIN
; OR
; PUSHJ P,COS
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (COSD,.)
PUSH P,T2 ;SAVE REGISTERS
PUSH P,T3
PUSH P,T4
MOVM T0,@(L) ;GET DABS(X) IN T0 AND T2
SETZ T1,
CAMGE T0,K180 ;IS ARG REDUCTION NECESSARY?
JRST GTCOSD ;NO, SKIP IT
DMOVE T2,T0
FDVRI T2,(180.0) ;GET X / 180
CAML T2,[225400000000] ;MORE THAN 20 BITS?
JRST OV ;YES, CAN'T RETURN ACCURATE RESULT
FIX T4,T2 ;GET N
FLTR T2,T4
FADRI T2,(0.5)
FMPR T2,K180
FSBR T0,T2 ;GET |X| - ([|X|/180] + 1/2) * 180
DFMP T0,PI180 ;CONVERT TO RADIANS
AOJA T4,GETABS ;CONTINUE BELOW
GTCOSD: FSBRI T0,(90.0) ;OFFSET ARG TO [-90,90]
MOVEI T4,1 ;SET SIGN TO MINUS
JRST GETRAD ;GO CONVERT TO RADIANS
HELLO (SIND,.)
PUSH P,T2 ;SAVE REGISTERS
PUSH P,T3
PUSH P,T4
MOVM T0,@(L) ;GET DABS(X) IN T0 AND T2
SETZB T1,T4 ;CLEAR SIGN FLAG
CAMGE T0,[90.0] ;IS ARG REDUCTION NECESSARY?
JRST GTSIND ;NO, SKIP IT
DMOVE T2,T0
FDVRI T2,(180.0) ;GET X / 180
CAML T2,[225400000000] ;MORE THAN 20 BITS?
JRST OV ;YES, CAN'T RETURN ACCURATE RESULT
FIXR T4,T2 ;GET N
FLTR T2,T4
FMPR T2,K180
FSBR T0,T2 ;GET X - [X/180]*180
GTSIND: SKIPGE @(L) ;CHECK ARG SIGN
TRC T4,1 ;NEGATIVE, COMPLEMENT RESULT SIGN
GETRAD: DFMP T0,PI180 ;CONVERT TO RADIANS
JRST GETABS ;CONTINUE BELOW
HELLO (COS,.)
PUSH P,T2 ;SAVE REGISTERS
PUSH P,T3
PUSH P,T4
MOVM T0,@(L) ;GET DABS(X) IN T0-T1
SETZ T1,
CAMG T0,PI ;IS ARG REDUCTION NECESSARY?
JRST GETCOS ;NO, SKIP IT
DMOVE T2,T0 ;COPY X
DFMP T2,ONEDPI ;GET X / PI
CAML T2,[233400000000] ;MORE THAN 26 BITS?
JRST OV ;YES, CAN'T RETURN ACCURATE RESULT
FIX T4,T2 ;GET [|X|/PI]
FLTR T2,T4
FADRI T2,(0.5) ;GET [|X|/PI] + 1/2
SETZ T3, ;CLEAR LOW WORD
DFMP T2,PI ;GET |X| - ([|X|/PI] + 1/2) * PI
DFSB T0,T2
AOJA T4,GETABS ;CONTINUE ARG REDUCTION BELOW
GETCOS: DFSB T0,PI2 ;OFFSET ARG TO [-PI/2,PI/2]
MOVEI T4,1 ;SET SIGN TO MINUS
JRST GETABS ;CONTINUE BELOW
HELLO (SIN,.)
PUSH P,T2 ;SAVE REGISTERS
PUSH P,T3
PUSH P,T4
MOVM T0,@(L) ;GET DABS(X) IN T0-T1
SETZB T1,T4 ;CLEAR SIGN FLAG
CAMG T0,PI2 ;IS ARG REDUCTION NECESSARY?
JRST GETSIN ;NO, SKIP IT
DMOVE T2,T0 ;GET DBLE(X) IN T2
DFMP T2,ONEDPI ;GET X / PI
CAML T2,[233400000000] ;MORE THAN 26 BITS?
JRST OV ;YES, CAN'T RETURN ACCURATE RESULT
FIXR T4,T2 ;GET [X/PI] = N
FLTR T2,T4
SETZ T3, ;CLEAR LOW WORD
DFMP T2,PI ;GET X - [X/PI] * PI
DFSB T0,T2
GETSIN: SKIPGE @(L) ;CHECK SIGN OF ARG
TRC T4,1 ;NEGATIVE, COMPLEMENT RESULT SIGN
GETABS: JUMPGE T0,RND ;IF X POSITIVE, GO ROUND IT
DMOVN T0,T0 ;GET ABS(X)
TRC T4,1 ;COMPLEMENT SIGN OF RESULT
RND: TLNN T1,(1B1) ;NEED ROUNDING?
JRST CALC ;NO, WON
ADDI T0,1 ;YES, INCREMENT FRACTION OF HIGH WORD
TLO T0,400 ;FIX POSSIBLE SPILL INTO EXPONENT
CALC: CAMGE T0,EPS ;IF F .LT. EPS,
JRST RET1 ;SIN OR COS = F (WITHIN SIGN)
MOVE T3,T0
FMPR T3,T3 ;OBTAIN G
MOVE T2,T3
FMPR T2,R5 ;((((G*R5
FADR T2,R4 ;+R4)
FMPR T2,T3 ;*G
FADR T2,R3 ;+R3)
FMPR T2,T3 ;*G
FADR T2,R2 ;+R2)
FMPR T2,T3 ;*G
FADR T2,R1 ;+R1)
FMPR T2,T3 ;*G = R(G)
FMPR T2,T0 ;*F
FADR T0,T2 ;+F
CAMLE T0,[201400,,0] ;[3257]Is the result greater than 1.0
HLLZ T0,T0 ;[3257] Clear out the extra bits
RET1: TRNE T4,1 ;IF SIGN FLAG SET,
MOVN T0,T0 ;NEGATE RESULT
RET: POP P,T4 ;RESTORE ACCUMULATORS
POP P,T3
POP P,T2
GOODBY(1) ;RETURN
OV: MOVEI T0,0 ;RETURN ZERO
$LCALL ATZ
;LERR (LIB,%,SIN or COS: ABS(arg) too large; result = zero)
JRST RET
PI: EXP 202622077325,021026430215 ;PI
PI2: EXP 201622077325,021026430215 ;PI/2
ONEDPI: EXP 177505746033,162344202513 ;1/PI
PI180: EXP 173435750650,224516471053 ;PI/180
K180: EXP 180.0,0 ;180
R1: 601252525253 ;-.166666666
R2: 172421042056 ;.833333072E-2
R3: 613137720533 ;-.198408328E-3
R4: 156561327224 ;.275239711E-5
R5: 630145743634 ;-.238683464E-7
EPS: 163552023642 ;0.863167530E-4
PRGEND
TITLE SINH HYPERBOLIC SINE FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY SINH
EXTERN SINH.
SINH=SINH.
PRGEND
TITLE SINH. HYPERBOLIC SINE FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;SINH IS CALCULATED AS FOLLOWS:
; LET V BE APPROXIMATELY 2 SO THAT LN V AND ABS(X)+LN V
; CAN BE EXACTLY REPRESENTED WHEN X IS EXACTLY REPRESENTABLE.
; THEN, LETTING W = ABS(X), AND NOTING THAT -SINH(-X)=SINH(X),
; FOR
; 0 <= W < EPS, SINH = W*SIGN(X)
; EPS <= W <= 1, SINH = (W*P4(W**2))*SIGN(X), ALGORITHM 1
; 1 < W <= 88.029678, SINH = SIGN(X)*(EXP(W)-EXP(-W))/2, ALGORITHM 2
; 88.029678 < W < 128 * LN(2)
; SINH = SIGN(X)*((V/2)*EXP(W - LN V)), ALGORITHM 3
; W >= 128 * LN(2), SINH = SIGN(X) * MACHINE INFINITY
; LET Z = W**2. THEN
; P4(Z) = 1 + Z*(C1 + Z*(C2 + Z*(C3 + C4*Z)))
; WHERE THE C(I) ARE GIVEN BELOW
;THE RANGE OF DEFINITION FOR SINH IS ABS(X) <= 88.722,
; AND ARGUMENTS OUT OF THIS RANGE WILL CAUSE AN ERROR MESSAGE
; TO BE TYPED. A RESULT OF SIGN(X)*MACHINE INFINITY WILL BE RETURNED
;REQUIRED (CALLED) ROUTINES: EXP
;REGISTER T2 IS SAVED, USED, AND RESTORED
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; XMOVEI L,ARG
; PUSHJ P,SINH
;THE ANSWER IS RETURNED IN AC T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (SINH,.)
MOVM T0,@(L) ;ABS(X) = W
CAMGE T0,EPS ;IF W < EPS,
JRST EXPP1 ;RETURN--SINH = X
CAMLE T0,EIGHT8 ;IF W > 88.029678,
JRST ALG3 ;GO TO ALGORITHM 3
CAMG T0,ONE ;IF W <= 1,
JRST ALG1 ;GO TO ALGORITHM 1
; OTHERWISE, ALGORITHM 2:
MOVEM T0,TEMP
FUNCT EXP.,<TEMP> ;EXP(ABS(X))
CAML T0,TWO14 ;IF EXP(ABS(X)).GT.2**14
JRST HALVE ;NEGLECT EXP(-ABS(X))
HRLZI T1,576400 ;-1.0
FDVR T1,T0 ;-EXP(-ABS(X))
FADR T0,T1 ;EXP(ABS(X))-EXP(-ABS(X))
HALVE: FSC T0,-1 ;/2.0
JRST EXPP1
; ALGORITHM 1
ALG1: PUSH P,T2
MOVE T1,T0 ;W
FMPR T0,T0 ;W**2
MOVE T2,T0
FMPR T0,C4 ;C4*W**2
FADR T0,C3 ;+C3
FMPR T0,T2 ;*W**2
FADR T0,C2 ;+C2
FMPR T0,T2 ;*W**2
FADR T0,C1 ;+C1
FMPR T0,T2 ;*W**2
FMPR T0,T1 ;*W
FADR T0,T1 ;+W = W*P4(Z)
POP P,T2 ;RESTORE T2
JRST EXPP1
; ALGORITHM 3
ALG3: CAMGE T0,XXMAX ;IF ARGUMENT IS NOT TOO LARGE
JRST EXPP ;CALCULATE AT EXPP
OVFL: $LCALL ROV
;LERR (LIB,%,SINH: result overflow)
HRLOI T0,377777 ;SINH = +MACHINE INFINITY.
JRST EXPP1
EXPP: FSBR T0,LN2VE ;W-LN(V)
MOVEM T0,TEMP
FUNCT EXP.,<TEMP> ;EXP(W - LN V)
MOVE T1,T0 ;SAVE A COPY OF EXP(2 - LN2VE)
FMPR T0,CON1 ;MULTIPLY BY (LN2VE - LN2)
FADR T0,T1 ;SUM = (1/2)*EXP(2)
JFCL OVFL ;(ROUNDING ERRORS MIGHT CAUSE OVERFLOW)
EXPP1: SKIPGE @(L) ;CONSIDER SIGN OF SINH
MOVN T0,T0
GOODBY (1) ;SINH RETURN
LN2VE: 200542714000 ;LN(V)=.693161011
EIGHT8: 207540074620 ;88.029678
XXMAX: 207542710300
C1: 176525252524 ;1.666666643E-1
C2: 172421042352 ;8.333352593E-3
C3: 164637771324 ;1.983581245E-4
C4: 156572227373 ;2.818523951E-6
CON1: 160720040562 ;LN2VE - LN(2)
ONE: 1.0E0
EPS: 164400000000
TWO14: 217400000000
SEGMENT DATA
TEMP: 0 ;TEMPORARY STORAGE FOR EXP ARG
PRGEND
TITLE SQRT SQUARE ROOT FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY SQRT
EXTERN SQRT.
SQRT=SQRT.
PRGEND
TITLE SQRT. SQUARE ROOT FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;SQRT(X) IS CALCULATED AS FOLLOWS
; THE SQUARE ROOT OF ABS(X) IS CALCULATED; THERE IS AN ERROR MESSAGE NOTING
; WHEN X IS NEGATIVE. THE INITIAL GUESS IS OPTIMUM FOR NUMBERS
; BETWEEN 0.5 AND 1.0. THIS GUESS IS FOLLOWED BY TWO ITERATIONS
; OF NEWTON'S METHOD.
;THE RANGE OF DEFINITION FOR SQRT IS THE NON-NEGATIVE REPRESENTABLE
; REAL NUMBERS
;REQUIRED (CALLED) ROUTINES: NONE
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,SQRT
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (SQRT,.) ;ENTRY TO SQRT ROUTINE
SKIPG T1,@(L) ;OBTAIN X AND CHECK FOR NEGATIVITY
JRST SQRTLE ;NO, HANDLE NON-POSITIVE ARGUMENT
SQRTP: MOVE T0,T1 ;SAVE NUMBER
LSH T1,-1 ;DIVIDE EXP BY 2
TLZE T1,400 ;WAS EXPONENT ODD?
JRST SQRT2 ;YES
;HERE WHEN EXPONENT IS EVEN. T1 CONTAINS AN UNNORMALIZED FLOATING
; POINT NUMBER, THE FRACTION PART OF WHICH IS 1/2 THE FRACTION OF
; THE ARGUMENT. OUR INITIAL GUESS IS MADE BY A LINEAR APPROXIMATION
; USING Y0 = SE (X + C), WHERE SE AND C ARE CONSTANTS USED FOR
; EVEN EXPONENTS IN X.
ADD T1,[XWD 267,607000] ;COMPUTE LINEAR APPROXIMATION
FMPRI T1,301454 ;RESCALE EXPONENT
JRST SQRT3
;HERE, WITH ODD EXPONENT, USE Y0 = SO * (X+C).
SQRT2: ADD T1,[XWD 267,607000] ;LINEAR APPROXIMATION
FMPRI T1,301650 ;RESCALE EXPONENT
SQRT3: FDV T0,T1 ;ORIGINAL / INITIAL GUESS
FAD T1,T0 ;AVERAGE THEM
FSC T1,-1
MOVM T0,@(L) ;GET ORIGINAL NUMBER
FDV T0,T1 ;SECOND ITERATION
FADR T0,T1
FSC T0,-1 ;AVERAGE THIRD GUESS WITH SECOND
GOODBY (1) ;SQRT RETURN
SQRTLE: JUMPE T1,ZERO
$LCALL NAA
;LERR (LIB,%,<SQRT: negative arg; result = SQRT(ABS(arg))>)
MOVM T1,T1 ;GET MAGNITUDE
JRST SQRTP ;POSITIVE NOW
ZERO: MOVEI T0,0 ;HERE ON ZERO ARG. RETURN ZERO
GOODBY (1) ;SQRT RETURN
PRGEND
TITLE COTAN TANGENT AND COTANGENT FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY COTAN
EXTERN COTAN.
COTAN=COTAN.
PRGEND
TITLE TAN TANGENT AND COTANGENT FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY TAN
EXTERN TAN.
TAN=TAN.
PRGEND
TITLE TAN. TANGENT AND COTANGENT FUNCTIONS
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;TAN(X) AND COTAN(X) ARE CALCULATED AS FOLLOWS;
; THE IDENTITIES
; TAN(PI/2.0-G)=1.0/TAN(G)
; TAN(N*PI+H)=TAN(H), -PI/2.0 < H <= PI/2.0
; TAN(-X)=-TAN(X)
; COTAN(X)=1.0/TAN(X)
; COTAN(-X)=-COTAN(X)
; ARE USED TO REDUCE THE ORIGINAL PROBLEM TO A PROBLEM WITH
; AN ARGUMENT GREATER THAN -PI/2.0 AND LESS THAN OR EQUAL TO
; PI/2.0, PI=3.14159265.
; THEN DEFINE N AND F SO THAT
; X=N*PI/4.0+F, 0.0 <= F <= PI/4.0, WITH PI=3.14159265.
; THEN
; TAN(F) = F, IF F < 2**(-14)
; = F*R(F**2), OTHERWISE
; WHERE
; R(F**2) = (P0+F**2*(P1+F**2*P2))/(Q0+F**2*(Q1+F**2))
; AND
; P0=62.604
; P1=-6.9716
; P2=6.7309
; Q0=P0
; Q1=-27.839
; THE RESULT IS THEN RECIPROCATED, IF NECESSARY, AND GIVEN
; THE APPROPRIATE SIGN.
; COEFFICIENTS ARE DERIVED FROM THOSE GIVEN IN CODY AND WAITE, "SOFTWARE
; MANUAL FOR ELEMENTARY FUNCTIONS", FOR MACHINES WITH 25-32 BIT PRECISION
;THE RANGE OF DEFINITION FOR TAN IS ABS(X) <= 2**26*(PI/2)
; AND FOR COTAN(X), 2**(-126) * (1/2+2**(-27)) < ABS(X) <= 2**26 * (PI/2)
; IS NECESSARY. OTHERWISE, ERROR MESSAGES WILL RESULT.
;REQUIRED (CALLED) ROUTINES: NONE
;REGISTERS T2, T3, T4, AND T5 WERE SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,TAN
; OR
; PUSHJ P,COTAN
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (COTAN,.) ;ENTRY TO COTAN ROUTINE
PUSH P,T2
MOVM T2,@(L) ;OBTAIN Y = ABS(X)
MOVEI T1,1 ;1 = COTAN FLAG
CAML T2,EPS1 ;IF Y IS NOT TOO SMALL FOR COTAN,
JRST ALG ;CONTINUE
$LCALL ROV
;LERR (LIB,%,COTAN: result overflow)
HRLOI T0,377777 ;ANSWER = + MACHINE INFINITY
SKIPGE T2,@(L) ;IF X IS NEGATIVE
MOVN T0,T0 ;RESULT = -RESULT
POP P,T2 ;RESTORE ACCUMULATOR
GOODBY (1) ;RETURN
HELLO (TAN,.) ;ENTRY TO TAN ROUTINE
PUSH P,T2
MOVM T2,@(L) ;OBTAIN Y = ABS(X)
SETZ T1,
ALG: CAMG T2,XMAX ;IF Y IS NOT TOO LARGE,
JRST ALGC ;CONTINUE ALGORITHM
$LCALL ATZ
;LERR (LIB,%,TAN or COTAN: ABS(arg) too large; result = zero)
SETZ T0,
POP P,T2 ;RESTORE ACCUMULATOR
GOODBY (1) ;RETURN
ALGC: PUSH P,T3 ;SAVE ACCUMULATORS
PUSH P,T4
PUSH P,T5
SETZ T3,
CAMG T2,PID4 ;SKIP ARGUMENT REDUCTION IF
JRST COMP1 ;ARG .LT. PI/4
DFMP T2,FORDPI ;T2+T3=(N+G)
FIX T4,T2
MOVE T0,T4 ;SAVE N IN T0
TRNE T4,1 ;TEST N
JRST ODD ;JUMP TO ODD IF N IS ODD
FLTR T4,T4
SETZ T5,
DFSB T2,T4 ;T2,T3 = G
DFMP T2,PIDD4 ;T4 = PI/4*G = F
TLNE T3,(1B1) ;ROUND T2 AND
ADDI T2,1 ;GUARD AGAINST SPILL
TLO T2,(1B9) ;INTO EXPONENT
JRST COMP
ODD: ADDI T4,1 ;T4 = N+1
FLTR T4,T4
SETZ T5,
DFSB T4,T2 ;T2,T3 = 1-G
DFMP T4,PIDD4 ;T4 = PI/4(1-G) = PI/4-F
TLNE T5,(1B1) ;ROUND T2 AND
ADDI T4,1 ;GUARD AGAINST SPILL
TLO T4,(1B9) ;INTO EXPONENT
MOVE T2,T4 ;T2 = PI/4-F
COMP: MOVE T3,T0 ;MOVE N TO T3
COMP1: CAMGE T2,EPS ;IF F IS LESS THAN EPS
JRST LT ;GO TO LT
MOVE T5,T2 ;OTHERWISE
FMPR T5,T5 ;G=F*F
MOVE T4,T5 ;RESULT = F*(R-Q)/Q + F
FMPR T4,R2 ;FORM R
FADR T4,R1
FMPR T4,T5
MOVE T0,T5
FADR T0,Q1 ;FORM Q
FMPR T5,T0
FSBR T4,T5 ;FORM R-Q
FADR T5,R0 ;COMPLETE Q BY ADDING R0
FDVR T4,T5 ;(R-Q)/Q
FMPR T4,T2 ;*F
FADR T2,T4 ;+F
LT: MOVE T0,T2
ANDI T3,3
CAIGE T3,2 ;IS N .GE. 2 ?
JRST NLE2 ;NO, GO TO NLE2
MOVN T0,T0 ;RESULT = -RESULT
MOVN T3,T3
ADDI T3,3 ;N =3-N
NLE2: CAMN T3,T1 ;IF N IS EQUAL TO IFLAG
JRST SSGN ;GO TO SSGN
HRLZI T3,201400 ;PUT 1 IN T3
FDVR T3,T0 ;RESULT = 1/RESULT
MOVE T0,T3
SSGN: SKIPGE T2,@(L) ;IF X IS NEGATIVE
MOVN T0,T0 ;RESULT = -RESULT
POP P,T5
POP P,T4
POP P,T3
POP P,T2
GOODBY (1) ;RETURN
EPS1: 002400000001 ;2**(-126)*(1/2 + 2**(-27))
XMAX: 233622077325 ;PI/2 * 2**26
PID4: 200622077325 ;PI/4
PIDD4: DOUBLE 200622077325,021026430216 ;PI/4 (DOUBLE PRECISION)
FORDPI: DOUBLE 201505746033,162344202512 ;4/PI (DOUBLE PRECISION)
EPS: 163400000000 ;2**(-14)
R0: 206764652343 ;62.60411195
R1: 574101637670 ;-6.971684006
R2: 175423545327 ;6.730910259*(10**(-2))
Q1: 572102441002 ;-27.83972122
PRGEND
TITLE TANH HYPERBOLIC TANGENT FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY TANH
EXTERN TANH.
TANH=TANH.
PRGEND
TITLE TANH. HYPERBOLIC TANGENT FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;TANH(X) IS CALCULATED AS FOLLOWS
; TANH(X) = -TANH(-X). LET F = ABS(X)
; IF F > 9.8479016, TANH = 1.0*SIGN(X)
; IF F > LN(3)/2 AND F <= 9.8479016, TANH = RESULT 1 =
; SIGN(X)*(1 - 2/(EXP(2*F) + 1)))
; IF F < 2**(-15), TANH = F*SIGN(X)
; OTHERWISE, LET G = F**2, AND OBTAIN RESULT 2 AS
; TANH = SIGN(X)*(F + F*R(G)), WHERE
; R(G) = G*(A + B*G)/(C + G). A, B, AND C APPEAR BELOW
;THE RANGE OF DEFINITION FOR TANH IS THE REPRESENTABLE REAL NUMBERS
;REQUIRED (CALLED) ROUTINES: EXP
;REGISTER T2 WAS SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,TANH
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (TANH,.) ;ENTRY TO TANH ROUTINE
MOVM T0,@(L) ;ABS(X) = F
CAMLE T0,AMAX ;IF F > 9.84...,
JRST CAREA ;GO TO COMPLETION AREA
CAMGE T0,A215 ;IF F < 2**(-15),
JRST COMP1 ;GO TO COMPLETION AREA
PUSH P,T2 ;SAVE A REGISTER.
MOVE T1,T0 ;COPY F INTO T1
MOVE T2,T0 ; AND T2.
CAMLE T2,ALN3 ;IF F > (LN 3)/2,
JRST RES1 ;GO TO OBTAIN RESULT 1
; OBTAIN RESULT 2
FMPR T1,T1 ;R(G) CALCULATION. F*F = G
MOVE T0,T1
FMPR T0,B ;*B
FADR T0,A ;+A
FMPR T0,T1 ;*G = G*(A + B*G)
FADR T1,C
FDVR T0,T1 ;R(G) = G*(A + B*G) / (C + G)
FMPR T0,T2 ;*F
FADR T0,T2 ;F + F*R(G) IS IN T0
JRST COMPL ;GO TO COMPLETION AREA
; COMPUTE RESULT 1
RES1: FSC T1,1 ;2*F
MOVEM T1,TEMP
FUNCT EXP.,<TEMP> ;EXP(2*F)
FADRI T0,201400 ;+1.0
MOVSI T1,575400 ;OBTAIN -2.0
FDVR T1,T0 ;/EXP(2*F)+1)
FADRI T1,201400 ;+1. RESULT 1 COMPLETE
MOVE T0,T1 ;PUT IT IN T0
COMPL: POP P,T2 ;RESTORE ACCUMULATORS
COMP1: SKIPGE @(L) ;CHANGE TANH SIGN IF NECESSARY
MOVN T0,T0
GOODBY (1) ;TANH RETURN
CAREA: MOVSI T0,201400 ;RESULT = 1.0 IS IN T0
JRST COMP1
AMAX: 204473104012 ;9.8479016
A215: 162400000000 ;2**(-15)
ALN3: 200431175237 ;0.549306145
A: 577132164714 ;-0.823772813
B: 607011671163 ;-0.383101067E-2
C: 202474250317 ;2.47131965
SEGMENT DATA
TEMP: 0 ;TEMPORARY STORAGE FOR EXP ARG
PRGEND
TITLE EXP EXPONENTIAL FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY EXP
EXTERN EXP.
EXP=EXP.
PRGEND
TITLE EXP. EXPONENTIAL FUNCTION
; (SINGLE PRECISION FLOATING POINT)
SUBTTL IMSL, INC. JUNE 1, 1979
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;EXP(X) IS CALCULATED AS FOLLOWS
; IF X < -89.4159863, EXP = 0
; IF X > 88.0296919, EXP = +MACHINE INFINITY
; OTHERWISE,
; THE ARGUMENT REDUCTION IS:
; LET N = THE NEAREST INTEGER TO X/LN(2)
; THE REDUCED ARGUMENT IS G = X-N*LN(2)
; THE CALCULATION IS:
; EXP = R(G)*2**(N+1)
; WHERE R(G) = 0.5 + G*P/(Q - G*P)
; P = P1*G**2 + 0.25
; Q = Q1*G**2 + 0.5
; P1 AND Q1 ARE GIVEN BELOW AS XP1 AND XQ1
;THE RANGE OF DEFINITION FOR EXP IS GIVEN ABOVE, AND ERROR MESSAGES
; WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE
;REQUIRED (CALLED) ROUTINES: NONE
;REGISTERS T2 AND T3 WERE SAVED, USED, AND RESTORED
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; XMOVEI L,ARG
; PUSHJ P,EXP
;THE ANSWER IS RETURNED IN ACCUMULATOR T0
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (EXP,.) ;ENTRY TO EXPONENTIAL ROUTINE
MOVE T0,@(L) ;OBTAIN THE ARGUMENT X
CAMGE T0,E77 ;IF X< -89.415...
JRST OUT2 ;GO TO EXIT.
CAMG T0,E7 ;IF X LE 88.029...
JRST EXP1 ;GO TO ALGORITHM. OTHERWISE.
$LCALL ROV
;LERR (LIB,%,EXP: result overflow)
HRLOI T0, 377777 ;EXP = +MACHINE INFINITY
GOODBY (1) ;RETURN
OUT2: $LCALL RUN
;LERR (LIB,%,EXP: result underflow)
MOVEI T0,0 ;EXP = 0
GOODBY (1) ;RETURN
EXP1: PUSH P,T2 ;SAVE ACCUMULATORS
PUSH P,T3
SETZ T1,0 ;T0,T1=X=N*LN(2)+G
MOVE T2,T0
SETZ T3,0 ;T2,T3=X
DFMP T2,RLN2 ;T2,T3=N+G/LN(2)
FIXR T2,T2 ;T4=N
MOVEM T2,TEMP ;SAVE N
FLTR T2,T2 ;FLOAT N
SETZ T3,0 ;T2,T3=FLOAT(N)
DFMP T2,LN2 ;T2,T3=N*LN(2)
DFSB T0,T2 ;T0,T1=G
MOVE T2,T0 ;GET ABS(G)
JUMPGE T2,GPOS ;IF G IS NEGATIVE NEGATE G
DMOVN T0,T0
GPOS: TLNE T1,(1B1) ;IF 2ND BIT OF 2ND WORD IS ON
ADDI T0,1 ;ROUND G
TLO T0,(1B9) ;GUARD AGAINST SPILL INTO EXPONENT
JUMPGE T2,GOTG ;REGAIN SIGN OF G
MOVN T0,T0
GOTG: MOVE T1,T0
FMPR T1,T1 ;G**2
JFCL
MOVE T2,T1
FMPR T2,XP1 ;P1*G**2
JFCL
FADRI T2,177400 ;+0.25 = P
FMPR T0,T2 ;*G
JFCL
FMPR T1,XQ1 ;Q1*G**2
JFCL
FADRI T1,200400 ;+0.5 = Q
FSBR T1,T0 ;Q - G*P
FDVR T0,T1 ;G*P/(Q - G*P)
FADRI T0,200400 ;+ 0.5 = R(G)
MOVE T3,TEMP ;RETRIEVE N
FSC T0,1(T3) ;R(G)*2**(N+1)
POP P,T3 ;RESTORE ACCUMULATORS
POP P,T2
RET: GOODBY (1) ;RETURN
E7: 207540074636 ;88.0296919
E77: 570232254037 ;-89.4159863
RLN2: DOUBLE 201561250731,112701375747 ;1./LN(2)=1.44269504
LN2: DOUBLE 200542710277,276434757260 ;LN(2)
XP1: 171420514076 ;.00416028863
XQ1: 174631375331 ;.0499871789
SEGMENT DATA
TEMP: 0
PRGEND
TITLE REAL. Integer to real conversion
SUBTTL H. P. WEISS/HPW/CDM 17-Nov-81
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY REAL.
REAL.=FLOAT.##
PRGEND
TITLE REAL Integer to real conversion
SUBTTL H. P. WEISS/HPW/CDM/RVM 24-Mar-83
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY REAL
REAL=FLOAT.##
PRGEND
TITLE FLOAT INTEGER TO REAL CONVERSION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY FLOAT
FLOAT=FLOAT.##
PRGEND
TITLE FLOAT. INTEGER TO REAL CONVERSION
SUBTTL D. TODD /DRT 15-FEB-1973
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (FLOAT,.) ;ENTRY TO FLOAT ROUTINE
MOVE T0,@(L) ;GET THE ARGUMENT
FLTR T0,T0 ;FLOAT IT
POPJ 17,
PRGEND
TITLE IFIX REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY IFIX
IFIX=IFIX.##
PRGEND
TITLE INT REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY INT
INT=INT.##
PRGEND
TITLE IFIX. REAL TO INTEGER CONVERSION
SUBTTL D. TODD /DRT/ED YOURDON/KK/TWE/DMN Feb-1973
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (INT,.) ;ENTRY TO INT ROUTINE.
JRST IFIX1 ;GO TO MAIN ROUTINE.
HELLO (IFIX,.) ;ENTRY TO IFIX ROUTINE
IFIX1: MOVE T0,@(L) ;GET THE ARGUMENT
FIX T0,T0 ;FIX IT
POPJ 17,
PRGEND
TITLE ABS SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY ABS
ABS=ABS.##
PRGEND
TITLE IABS SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY IABS
IABS=IABS.##
PRGEND
TITLE ABS. SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL D. TODD /DRT/ED YOURDON/KK/TWE 15-Feb-1973
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (ABS,.) ;ENTRY TO ABS ROUTINE
MOVM T0,@(L) ;GET /ARG/.
GOODBY (1) ;RETURN
HELLO (IABS,.) ;ENTRY TO IABS ROUTINE.
MOVM T0,@(L) ;GET /ARG/. IF OVERFLOW, SET ANSWER TO +INF
JOV [HRLOI T0,377777
GOODBY (1)]
GOODBY (1) ;RETURN
PRGEND
TITLE DIM SINGLE PRECISION POSITIVE DIFFERENCE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY DIM
DIM=DIM.##
PRGEND
TITLE DIM. SINGLE PRECISION DIFFERENCE FUNCTION
SUBTTL D. TODD /DRT/ED YOURDON/TWE 15-Feb-1973
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (DIM,.) ;ENTRY TO DIM ROUTINE
MOVE T0,@0(L) ;PICK UP FIRST ARGUMENT
CAMG T0,@1(L) ;IF A .GT. B, GO TO SUBTRACT.
TDZA T0,T0 ;O'E, ZERO A AND GO TO EXIT.
FSBR T0,@1(L) ;CALC A - B.
JFCL EXCEP ;CAN UNDERFLOW AND OVERFLOW
RET: POPJ P, ;RETURN
EXCEP: JUMPE T0,UNDER ;UNDERFLOW?
$LCALL ROV,RET ;NO, OVERFLOW
UNDER: $LCALL RUN,RET ;YES, UNDERFLOW
PRGEND
TITLE IDIM INTEGER POSITIVE DIFFERENCE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY IDIM
IDIM=IDIM.##
PRGEND
TITLE IDIM. INTEGER POSITIVE DIFFERENCE FUNCTION
SUBTTL D. TODD /DRT/ED YOURDON/KK/TWE 15-Feb-1973
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;IDIM RETURNS THE POSITIVE DIFFERENCE OF A AND B:
;IF (A-B) .LE. 0, THEN DIM(A,B)=0
;IF(A-B) .G. 0 , THEN DIM(A,B)=(A-B)
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (IDIM,.) ;ENTRY TO IDIM ROUTINE
MOVE T0, @(L) ;PICK UP FIRST ARGUMENT
CAMG T0,@1(L) ;IF A .LE. B,
TDZA T0,T0 ;SET ANSWER TO 0
SUB T0,@1(L) ;IF A .GT. B,
JFCL OVER ;OVERFLOW CAN OCCUR
RET: GOODBY (2) ;RETURN
OVER: $LCALL ROV ;RESULT OVERFLOW
HRLOI T0,377777 ;STORE +BIGGEST
JRST RET ;RETURN
PRGEND
TITLE SIGN SINGLE PREICISION XFER OF SIGN FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY SIGN
SIGN=SIGN.##
PRGEND
TITLE ISIGN SINGLE PREICISION XFER OF SIGN FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY ISIGN
ISIGN=ISIGN.##
PRGEND
TITLE SIGN. SINGLE PRECISION AND INTEGER XFER OF SIGN FUNCTION
SUBTTL D. TODD /DRT/ED YOURDON/KK/TWE 12-Feb-1973
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;FROM LIB40 V.32(323)
;SIGN(A,B) AND ISIGN(A,B)
;IF B .GE. 0, THEN ABSF(A) IS RETURNED IN ACCUMULATOR 0
;IF B .L. 0, THEN -ABSF(A) IS RETURNED IN ACCUMULATOR 0
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (SIGN,.) ;ENTRY TO SIGN
MOVM T0,@(L) ;GET MAGNITUDE OF FIRST ARGUMENT
SKIPGE @1(L) ;IS SECOND ARGUMENT POSITIVE?
MOVN T0,T0 ;NO, NEGATE RESULT
GOODBY (2) ;RETURN
HELLO (ISIGN,.) ;ENTRY TO ISIGN
MOVM T0,@(L) ;GET MAGNITUDE OF FIRST ARGUMENT
SKIPGE @1(L) ;IS SECOND ARGUMENT POSITIVE?
MOVN T0,T0 ;NO, NEGATE RESULT
JFCL OVER ;CAN OVERFLOW
RET: GOODBY (2) ;RETURN
OVER: $LCALL ROV ;RESULT OVERFLOW
HRLOI T0,377777 ;RETURN +BIGGEST
JRST RET ;RETURN
PRGEND
TITLE AINT FLOATING POINT TRUNCATION FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY AINT
AINT=AINT.##
PRGEND
TITLE AINT. FLOATING POINT TRUNCATION FUNCTION
SUBTTL ED YOURDON /KK/TWE 15-FEB-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;FROM LIB40 V.32(323)
;FLOATING POINT TRUNCATION FUNCTION.
;TRUNCATES FRACTIONAL PART OF FLOATING POINT NUMBER
;AND RETURNS ANSWER AS A FLOATING POINT NUMBER.
;THE ANSWER IS RETURNED IN AC 0.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (AINT,.) ;ENTRY TO AINT ROUTINE.
MOVM T0,@(L) ;GET ABS(ARG)
CAML T0,MOD1 ;IS ABS(ARG) .LT. 2**26?
JRST AINT1 ;NO, NO FRACTION BITS, EXIT.
FAD T0,MOD1 ;YES, REMOVE
FSB T0,MOD1 ;THE FRACTION BITS.
AINT1: SKIPGE @(L) ;SET THE
MOVN T0,T0 ;CORRECT SIGN AND
GOODBY (1) ;RETURN
MOD1: 233400000000 ;2**26
PRGEND
TITLE MOD INTEGER MOD FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY MOD
MOD=MOD.##
PRGEND
TITLE MOD. INTEGER MOD FUNCTION
SUBTTL D. TODD /DRT/ED YOURDON/KK 15-Feb-1973
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;FROM LIB40 V.32(323)
;INTEGER MOD FUNCTION
;MOD(A,B) = A-[A/B]*B, WHERE [A/B] IS THE GREATEST (IN
;MAGNITUDE) INTEGER IN A/B. THAT IS, THE MOD FUNCTION
;RETURNS THE REMAINDER OF THE QUOTIENT OF A AND B. HENCE,
;9 MOD 2 IS 1, AND SO FORTH.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (MOD,.) ;ENTRY TO MOD ROUTINE
MOVE T0,@(L) ;FIRST ARG TO AC 0.
SKIPN T1,@1(L) ;GET 2ND ARG
JRST MODA1 ;IF ZERO, RETURN 0 WITH MSG
IDIV T0,T1 ;DIVIDE, REMAINDER IN AC 1.
MOVE T0,T1 ;PUT THE ANSWER IN AC 0.
GOODBY
MODA1: SETZ T0,
$LCALL MZZ ;MOD 2ND ARG ZERO, RESULT=0
GOODBY
PRGEND
TITLE AMAX1 MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY AMAX1
AMAX1=AMAX1.##
PRGEND
TITLE MAX1 MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY MAX1
MAX1=MAX1.##
PRGEND
TITLE AMAX0 MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY AMAX0
AMAX0=AMAX0.##
PRGEND
TITLE MAX0 MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY MAX0
MAX0=MAX0.##
PRGEND
TITLE MAX. MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;FROM LIB40 V.005.
;AMAX1, MAX1, AMAX0, AND MAX0 CALCULATE THE MAXIMUM OF A
;STRING OF ARGUMENTS
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (AMAX1,.) ;ENTRY TO AMAX1 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
GOODBY (2) ;AMAX1 RETURN
HELLO (MAX0,.) ;ENTRY TO MAX0 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
GOODBY (2) ;MAX0 RETURN
HELLO (MAX1,.) ;ENTRY TO MAX1 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
FIX T0,T0 ;FIX IT
GOODBY (2) ;MAX1 RETURN
HELLO (AMAX0,.) ;ENTRY TO AMAX0 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
FLTR T0,T0 ;FLOAT IT
GOODBY (2) ;AMAX0 RETURN
MAX.: PUSH P,T3 ;Save an ac
HLLZ T3,-1(L) ;Get the F10 arg count
JRST MAX.2 ;DON'T COMPARE FIRST TIME
MAX.1: CAMGE T0,@(L) ;IS CURRENT ARG .GT. NEXT ARG?
MAX.2: MOVE T0,@(L) ;NO, PUT ARG IN A.
ADDI L,1 ;Bump arg pointer
AOBJN T3,MAX.1 ;Continue thru the arg list
POP P,T3 ;Restore ac
POPJ P, ;RETURN
PRGEND
TITLE AMIN1 MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY AMIN1
AMIN1=AMIN1.##
PRGEND
TITLE MIN1 MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY MIN1
MIN1=MIN1.##
PRGEND
TITLE AMIN0 MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY AMIN0
AMIN0=AMIN0.##
PRGEND
TITLE MIN0 MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
NOSYM
ENTRY MIN0
MIN0=MIN0.##
PRGEND
TITLE MIN. MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;FROM LIB40 V.005.
;AMIN1, MIN1, AMIN0, AND MIN0 CALCULATE THE MINIMUM OF A
;STRING OF ARGUMENTS
SEARCH MTHPRM
SEGMENT CODE
NOSYM
SALL
HELLO (AMIN1,.) ;ENTRY TO AMIN1 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
GOODBY (2) ;AMIN1 RETURN
HELLO (MIN0,.) ;ENTRY TO MIN0 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
GOODBY (2) ;MIN0 RETURN
HELLO (MIN1,.) ;ENTRY TO MIN1 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
FIX T0,T0 ;FIX IT
GOODBY (2) ;MIN1 RETURN
HELLO (AMIN0,.) ;ENTRY TO AMIN0 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
FLTR T0,T0 ;FLOAT IT
GOODBY (2) ;AMIN0 RETURN
MIN.: PUSH P,T3 ;Save an ac
HLLZ T3,-1(L) ;Get the F10 arg count
JRST MIN.2 ;DON'T COMPARE FIRST TIME
MIN.1: CAMLE T0,@(L) ;IS CURRENT ARG .LT. NEXT ARG?
MIN.2: MOVE T0,@(L) ;NO, PUT ARG IN A.
ADDI L,1 ;Bump arg pointer
AOBJN T3,MIN.1 ;Continue thru the arg list
POP P,T3 ;Restore ac
POPJ P, ;EXIT.
PRGEND
TITLE ANINT Floating point nearest whole number
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
ENTRY ANINT
EXTERN ANINT.
ANINT=ANINT.
PRGEND
TITLE ANINT. Floating point nearest whole number.
SUBTTL C. McCutcheon - 6/25/81
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
; Fortran Instrinsic Function to return a single precision
; nearest whole number of the single precision number passed.
; (Both the number passed and returned are floating point.)
; Number returned is: Integer(A+.5) if A .GE. 0
; Integer(A-.5) if A .LT. 0.
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (ANINT,.) ;Enter routine
MOVM T0,@0(L) ;Get argument to truncate.
JUMPN T0,NZERO ;Number passed = 0?
GOODBYE ;Yes - Return
; Now shift out the fractional part of the number.
NZERO: TLNN T0,200000 ;Is num .LT. 1/2?
JRST ZERO ;Yes, go return zero.
FAD T0,[200400,,0] ;Add .5 before truncation.
HLRZ T1,T0 ;Get new exponent.
LSH T1,-^D9 ;Put rightmost.
CAILE T1,233 ;If no fractional part,
JRST DONE ; return the number passed.
;ANINT(232777,,777777) must fall through.
LSH T0,-233(T1) ;Shift into integer position.
MOVN T1,T1 ;Negate exponent.
LSH T0,233(T1) ;Shift back to where found.
SKIPGE @0(L) ;If original number .LT. zero,
MOVN T0,T0 ; negate it again.
GOODBYE ;Return
ZERO: TDZA T0,T0 ;Set result to zero and skip
DONE: MOVE T0,@0(L) ;No fractional part, return
GOODBYE ;Return
PRGEND
TITLE NINT Integer nearest whole numer of floating
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
SEARCH MTHPRM
SEGMENT CODE
NOSYM
ENTRY NINT
EXTERN NINT.
NINT=NINT.
PRGEND
TITLE NINT. Integer nearest whole number of floating.
SUBTTL C. McCutcheon - 6/25/81
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
; Fortran Instrinsic Function to return the nearest integer
; to the single precision floating point number passed.
; Number returned is: Integer(A+.5) if A .GE. 0
; Integer(A-.5) if A .LT. 0.
SEARCH MTHPRM
SEGMENT CODE
SALL
HELLO (NINT,.) ;Enter routine
MOVM T0,@0(L) ;Get argument to truncate.
JUMPN T0,NZERO ;If 0 was passed,
GOODBYE ; return.
NZERO: FAD T0,[200400,,0] ;Add .5 before truncation.
; Now shift out the fractional part of the number.
HLRZ T1,T0 ;Get exponent.
LSH T1,-^D9 ;Put rightmost.
CAILE T1,243 ;If not representable as integer,
JRST DONE ; return largest integer.
FIX T0,T0 ;Make it into an integer
SKIPGE @0(L) ;If original number .LT. zero,
MOVN T0,T0 ; negate it again.
GOODBYE ;Return
; Number not representable as integer, return largest integer.
DONE: $LCALL ROV
;LERR (LIB,%,<NINT: result overflow>)
HRLOI T0,377777 ;Largest positive number.
SKIPGE @0(L) ;If original number .LT. zero,
HRLZI T0,400000 ;Largest negative number.
GOODBYE ;Return
PRGEND
TITLE SNGL DOUBLE PRECISION TO REAL CONVERSION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
;ALL RIGHTS RESERVED.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
ENTRY SNGL
EXTERN SNGL.
SNGL=SNGL.
PRGEND
TITLE SNGL. DOUBLE PRECISION TO REAL CONVERSION
SUBTTL /DMN/TWE
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
;ALL RIGHTS RESERVED.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;DOUBLE PRECISION TO SINGLE PRECISION CONVERSION FUNCTION
;THIS ROUTINE OBTAINS THE MOST SIGNIFICANT PART OF A DOUBLE
;PRECISION ARGUMENT.
SEARCH MTHPRM
EXTERN SNG.0
NOSYM
SEGMENT CODE
SALL
HELLO (SNGL,.) ;[235] ENTRY TO SNGL ROUTINE
DMOVE T0,@(L) ;GET THE ARGUMENT IN AC 0
PJRST SNG.0 ;USE AC0 SINGLE ROUTINE
PRGEND
TITLE SNG.0
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH MTHPRM
NOSYM
SEGMENT CODE
SNG 0
PRGEND
TITLE SNG.2
SEARCH MTHPRM
NOSYM
SEGMENT CODE
SNG 2
PRGEND
TITLE SNG.4
SEARCH MTHPRM
NOSYM
SEGMENT CODE
SNG 4
PRGEND
TITLE SNG.6
SEARCH MTHPRM
NOSYM
SEGMENT CODE
SNG 6
PRGEND
TITLE SNG.10
SEARCH MTHPRM
NOSYM
SEGMENT CODE
SNG 10
PRGEND
TITLE SNG.12
SEARCH MTHPRM
NOSYM
SEGMENT CODE
SNG 12
PRGEND
TITLE SNG.14
SEARCH MTHPRM
NOSYM
SEGMENT CODE
SNG 14
PRGEND ;[3223]
TITLE IFX.0 ;[3223] Replace routines
SEARCH MTHPRM
ENTRY IFX.0
SEGMENT CODE
NOSYM
IFX.0: FIX 0,0
POPJ 17,
PRGEND
TITLE IFX.1
SEARCH MTHPRM
ENTRY IFX.1
SEGMENT CODE
NOSYM
IFX.1: FIX 1,1
POPJ 17,
PRGEND
TITLE IFX.2
SEARCH MTHPRM
ENTRY IFX.2
SEGMENT CODE
NOSYM
IFX.2: FIX 2,2
POPJ 17,
PRGEND
TITLE IFX.3
SEARCH MTHPRM
ENTRY IFX.3
SEGMENT CODE
NOSYM
IFX.3: FIX 3,3
POPJ 17,
PRGEND
TITLE IFX.4
SEARCH MTHPRM
ENTRY IFX.4
SEGMENT CODE
NOSYM
IFX.4: FIX 4,4
POPJ 17,
PRGEND
TITLE IFX.5
SEARCH MTHPRM
ENTRY IFX.5
SEGMENT CODE
NOSYM
IFX.5: FIX 5,5
POPJ 17,
PRGEND
TITLE IFX.6
SEARCH MTHPRM
ENTRY IFX.6
SEGMENT CODE
NOSYM
IFX.6: FIX 6,6
POPJ 17,
PRGEND
TITLE IFX.7
SEARCH MTHPRM
ENTRY IFX.7
SEGMENT CODE
NOSYM
IFX.7: FIX 7,7
POPJ 17,
PRGEND
TITLE IFX.10
SEARCH MTHPRM
ENTRY IFX.10
SEGMENT CODE
NOSYM
IFX.10: FIX 10,10
POPJ 17,
PRGEND
TITLE IFX.11
SEARCH MTHPRM
ENTRY IFX.11
SEGMENT CODE
NOSYM
IFX.11: FIX 11,11
POPJ 17,
PRGEND
TITLE IFX.12
SEARCH MTHPRM
ENTRY IFX.12
SEGMENT CODE
NOSYM
IFX.12: FIX 12,12
POPJ 17,
PRGEND
TITLE IFX.13
SEARCH MTHPRM
ENTRY IFX.13
SEGMENT CODE
NOSYM
IFX.13: FIX 13,13
POPJ 17,
PRGEND
TITLE IFX.14
SEARCH MTHPRM
ENTRY IFX.14
SEGMENT CODE
NOSYM
IFX.14: FIX 14,14
POPJ 17,
PRGEND
TITLE IFX.15
SEARCH MTHPRM
ENTRY IFX.15
SEGMENT CODE
NOSYM
IFX.15: FIX 15,15
POPJ 17,
PRGEND
TITLE MTHNRM UNNORMALIZE UNDERFLOWED RESULT
SEARCH MTHPRM
ENTRY SPRUNM,DPRUNM
SEGMENT CODE
SPRUNM: DMOVEM T2,SAVE2 ;SAVE T2 AND T3
DMOVE T2,@(16) ;GET RESULT STORED BY THE HARDWARE, HAS
;CORRECT FRACTION AND EXPONENT TOO LARGE
;BY 400
HLRE T1,T2 ;GET EXPONENT AND SIGN AND SOME FRACTION BITS
ASH T1,-9 ;GET RID OF FRACTION BITS
TSCE T1,T1 ;GET ABS(EXPONENT), SKIP IF POSITIVE FRACTION
TLOA T2,777000 ;NEGATIVE FRACTION, SET EXPONENT TO ALL ONES
TLZ T2,777000 ;POSITIVE FRACTION, SET EXPONENT TO ALL ZEROS
CAME T1,[377,,377] ;SUPPRESS ZERO-BIT SHIFT (-0 IS -256)
ASHC T2,400001(T1) ;UNNORMALIZE FRACTION, KEEP 1 BIT FOR ROUNDING
ADDI T2,1 ;ROUND HIGH WORD OF FRACTION
ASH T2,-1 ;DISCARD ROUNDING BIT
MOVE T0,T2 ;RETURN IN T0
DMOVE T2,SAVE2 ;RESTORE T2 AND T3
POPJ P,
DPRUNM: DMOVEM T2,SAVE2 ;SAVE T2 AND T3
DMOVE T2,@(16) ;GET RESULT STORED BY THE HARDWARE, HAS
;CORRECT FRACTION AND EXPONENT TOO LARGE
;BY 400
HLRE T1,T2 ;GET EXPONENT AND SIGN AND SOME FRACTION BITS
ASH T1,-9 ;GET RID OF FRACTION BITS
TSCE T1,T1 ;GET ABS(EXPONENT), SKIP IF POSITIVE FRACTION
TLOA T2,777000 ;NEGATIVE FRACTION, SET EXPONENT TO ALL ONES
TLZ T2,777000 ;POSITIVE FRACTION, SET EXPONENT TO ALL ZEROS
CAME T1,[377,,377] ;SUPPRESS ZERO-BIT SHIFT (-0 IS -256)
ASHC T2,400001(T1) ;UNNORMALIZE FRACTION, KEEP 1 BIT FOR ROUNDING
TLO T3,(1B0) ;PREVENT INTEGER OVERFLOW WHEN WE ROUND
ADDI T3,1 ;ROUND LOW WORD
TLZN T3,(1B0) ;DID FRACTION OVERFLOW INTO SIGN BIT?
ADDI T2,1 ;YES, PROPAGATE CARRY TO HIGH WORD
ASHC T2,-1 ;DISCARD ROUNDING BIT
DMOVE T0,T2 ;RETURN IN T0 AND T1
DMOVE T2,SAVE2 ;RESTORE T2 AND T3
POPJ P,
SEGMENT DATA
SAVE2: BLOCK 2 ;FOR SAVING T2,T3
END