Trailing-Edge
-
PDP-10 Archives
-
AP-D480B-SB_1978
-
forsin.mac
There is 1 other file named forsin.mac in the archive. Click here to see a list.
TITLE AMAX1 %4.(235) MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY AMAX1
EXTERN AMAX1.
AMAX1=AMAX1.
PRGEND
TITLE MAX1 %4.(235) MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY MAX1
EXTERN MAX1.
MAX1=MAX1.
PRGEND
TITLE AMAX0 %4.(235) MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY AMAX0
EXTERN AMAX0.
AMAX0=AMAX0.
PRGEND
TITLE MAX0 %4.(235) MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY MAX0
EXTERN MAX0.
MAX0=MAX0.
PRGEND
TITLE MAX. %4.(235) MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.005.
;AMAX1, MAX1, AMAX0, AND MAX0 CALCULATE THE MAXIMUM OF A
;STRING OF ARGUMENTS, THE FIRST ADDRESS OF WHICH IS IN
;ACCUMULATOR Q.
;THE ROUTINES ARE CALLED IN THE FOLLOWING MANNER:
; JSA Q,AMAX1 OR MAX1 OR AMAX0 OR MAX0
; EXP A
; EXP B
; ETC
;FOR AMAX1 AND MAX1, A,B,... ARE REAL. THE ANSWER
;RETURNED IS REAL FOR AMAX1 AND INTEGER FOR MAX1.
;FOR AMAX0 AND MAX0, A,B,... ARE INTEGER. THE ANSWER
;RETURNED IS REAL FOR AMAX0 AND INTEGER FOR MAX0.
;THE ANSWER IS RETURNED IN ACCUMULATOR A.
SEARCH FORPRM
LIBSEG ;SEGMENT CONTROL
A=0
B=1
Q=16
P=17
HELLO (AMAX1,.) ;[235] ENTRY TO AMAX1 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
GOODBY (2) ;AMAX1 RETURN
HELLO (MAX0,.) ;[235] ENTRY TO MAX0 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
GOODBY (2) ;MAX0 RETURN
HELLO (MAX1,.) ;[235] ENTRY TO MAX1 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
IFE CPU-KI10,<FIX 0,0>
IFE CPU-KA10,<PUSHJ P,IFX.0##> ;FIX THE ARGUMENT
GOODBY (2) ;MAX1 RETURN
HELLO (AMAX0,.) ;[235] ENTRY TO AMAX0 ROUTINE.
PUSHJ P,MAX. ;FIND THE MAXIMUM AND
IFE CPU-KI10,<FLTR 0,0>
IFE CPU-KA10,<PUSHJ P,FLT.0##> ;FLOAT THE ARG
GOODBY (2) ;AMAX0 RETURN
MAX.:
IFN F40LIB,<
PUSH P,L ;SAVE THE LINK
TLZN L,-1 ;F40 CALL
>
HLL L,-1(L) ;NO F10 GET THTE ARG COUNT
JRST MAX.2 ;DON'T COMPARE FIRST TIME
MAX.1: CAMGE A,@(L) ;IS CURRENT ARG > NEXT ARG?
MAX.2: MOVE A,@(L) ;NO, PUT ARG IN A.
AOBJN L,MAX.1 ;CONTINUE THRU THE ARG LIST
IFN F40LIB,<
TLNN L,-1 ;F40 CALL
PJRST MAX.3 ;NO F10 CALL RETURN
MOVE B,(L) ;GET THE NEXT ARG
TLC B,(<JUMP>) ;CHECK FOR AN ARG CALL
TLNN B,777000 ;OP CODE JUMP
JRST MAX.1 ;YES, GE THE NEXT ARG
MAX.3: POP P,L ;RESTORE THE LINK
>
POPJ P, ;NO, RETURN
PRGEND
TITLE AMIN1 %4.(235) MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY AMIN1
EXTERN AMIN1.
AMIN1=AMIN1.
PRGEND
TITLE MIN1 %4.(235) MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY MIN1
EXTERN MIN1.
MIN1=MIN1.
PRGEND
TITLE AMIN0 %4.(235) MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY AMIN0
EXTERN AMIN0.
AMIN0=AMIN0.
PRGEND
TITLE MIN0 %4.(235) MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY MIN0
EXTERN MIN0.
MIN0=MIN0.
PRGEND
TITLE MIN. %4.(235) MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.005.
;AMIN1, MIN1, AMIN0, AND MIN0 CALCULATE THE MINIMUM OF A
;STRING OF ARGUMENTS, THE FIRST ADDRESS OF WHICH IS IN
;ACCUMULATOR Q.
;THE ROUTINES ARE CALLED IN THE FOLLOWING MANNER:
; JSA Q,AMIN1 OR MIN1 OR AMIN0 OR MIN0
; EXP A
; EXP B
; ETC
;FOR AMIN1 AND MIN1, A,B,... ARE REAL. THE ANSWER
;RETURNED IS REAL FOR AMIN1 AND INTEGER FOR MIN1.
;FOR AMIN0 AND MIN0, A,B,... ARE INTEGER. THE ANSWER
;RETURNED IS REAL FOR AMIN0 AND INTEGER FOR MIN0.
;THE ANSWER IS RETURNED IN ACCUMULATOR A.
SEARCH FORPRM
LIBSEG ;SEGMENT CONTROL
A=0
B=1
Q=16
P=17
HELLO (AMIN1,.) ;[235] ENTRY TO AMIN1 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
GOODBY (2) ;AMIN1 RETURN
HELLO (MIN0,.) ;[235] ENTRY TO MIN0 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
GOODBY (2) ;MIN0 RETURN
HELLO (MIN1,.) ;[235] ENTRY TO MIN1 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
IFE CPU-KI10,<FIX 0,0>
IFE CPU-KA10,<PUSHJ P,IFX.0##> ;FIX THE ARG
GOODBY (2) ;MIN1 RETURN
HELLO (AMIN0,.) ;[235] ENTRY TO AMIN0 ROUTINE.
PUSHJ P,MIN. ;FIND THE MINIMUM AND
IFE CPU-KI10,<FLTR 0,0> ;FLOAT THE ARG
IFE CPU-KA10,<PUSHJ P,FLT.0##> ;FLOAT THE ARG
GOODBY (2) ;AMIN0 RETURN
MIN.:
IFN F40LIB,<
PUSH P,L ;SAVE THE LINK
TLZN L,-1 ;F40 CALL
>
HLL L,-1(L) ;NO GET THE F10 ARG COUNT
JRST MIN.2 ;DON'T COMPARE FIRST TIME
MIN.1: CAMLE A,@(L) ;IS CURRENT ARG < NEXT ARG?
MIN.2: MOVE A,@(L) ;NO, PUT ARG IN A.
AOBJN L,MIN.1 ;CONTINUE THRU THE ARG LIST
IFN F40LIB,<
TLNN L,-1 ;F40 CALL
PJRST MIN.3 ;NO F10 CALL
MOVE B,(Q) ;NEXT ARG ADDR TO B.
TLC B,(<JUMP>) ;IS THE OPCODE OF THE
TLNN B,777000 ;NEXT ARG A JUMP?
JRST MIN.1 ;YES, LOOP.
MIN.3: POP P,L ;RESTORE THE LINK
>
POPJ P, ;EXIT.
PRGEND
TITLE ACOS %4.(235) ARC COSINE ROUTINE
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY ACOS
EXTERN ACOS.
ACOS=ACOS.
PRGEND
TITLE ACOS. %4.(235) ARC COSINE ROUTINE
SUBTTL KAREN KOLLING/DMN
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.022
;FLOATING POINT SINGLE PRECISION ARCCOSINE FUNCTION
;ACOS(X) IS CALCULATED IN THE FOLLOWING MANNER:
; IF X > 0, ACOS(X)=ATAN((SQRT(1-X^2))/X)
; IF X < 0, ACOS(X)=PI + ATAN((SQRT(1-X^2))/X)
; IF X = 0, ACOS(X)=PI/2
;THE RANGE OF DEFINITION FOR ACOS IS -1.0 TO +1.0.
;ARGUMENTS OUTSIDE OF THIS RANGE WILL CAUSE AN ERROR MESSAGE
;TO BE TYPED AND WILL RETURN AN ANSWER OF ZERO.
;THE CALLING SEQUENCE FOR ACOS IS:
; JSA 16,ACOS
; EXP ARG
SEARCH FORPRM
HELLO (ACOS,.) ;[235] ENTRY TO ACOS ROUTINE.
MOVM 0,@(16) ;GET /ARG./ IN AC 0.
CAMLE 0,ONE ;IS MAGNITUDE OF ARG. GT 1.0?
JRST TOOLRG ;YES, GO TO ERROR RETURN.
JUMPE 0,ZERARG ;IF ARG=0, GO TO ZERARG.
FMPR 0,0 ;X^2 IN AC 0.
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP, IF NECESSARY.
MOVNS 0 ;-X^2 IN AC 0.
FAD 0,ONE ;1.0-X^2 IN AC 0.
MOVEM 0,TEMPSV ;ARG TO LOC NE 0 OR 1.
FUNCT SQRT.,<TEMPSV> ;CALC. SQRT(1.0-X^2).
FDVR 0,@(16) ;(SQRT(1.0-X^2))/X IS IN AC 0.
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP, IF NECESSARY.
MOVEM 0,TEMPSV ;ARG TO LOC NE 0 OR 1.
FUNCT ATAN.,<TEMPSV> ;FIND ATAN(SQRT(1.0-X^2)/X).
SKIPGE @(16) ;SKIP IF ORIGINAL ARG >= 0.
FAD 0,PII ;ANSWER IS PI - ORIGINAL ANSWER.
GOODBY (1) ;ACOS RETURN
ZERARG: MOVE 0,PI2 ;ANSWER IS PI/2.
GOODBY (1) ;ACOS RETURN
TOOLRG: ERROR (LIB,7,2,[ASCIZ /ACOS OF ARG > 1.0 IN MAGNITUDE/])
SETZ 0, ;SET ANSWER TO ZERO.
GOODBY (1) ;ACOS RETURN
ONE: 201400000000 ;1.0
PI2: 201622077325
PII: 202622077325
TEMPSV: 0
PRGEND
TITLE ASIN %4.(235) ARC SIN ROUTINE
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY ASIN
EXTERN ASIN.
ASIN=ASIN.
PRGEND
TITLE ASIN. %4.(235) ARC SINE ROUTINE
SUBTTL ED YOURDON/KK/DMN
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.022
;FLOATING POINT SINGLE PRECISION ARCSINE FUNCTION
;THE ARCSINE IS CALCULATED WITH THE FOLLOWING ALGORITHM:
; ASIN(X) = ATAN(X/SQRT(1-X^2))
;THE RANGE OF DEFINITION FOR ASIN IS (-1.0,1.0)
;OTHER ARGUMENTS WILL CAUSE AN ERROR MESSAGE TO BE
;TYPED AND AN ANSWER OF ZERO TO BE RETURNED.
A= 0
B= 1
Q= 16
SEARCH FORPRM
HELLO (ASIN,.) ;[235] ENTRY TO ASIN ROUTINE
MOVM B,@(Q) ;GET MAGNITUDE OF ARG. IN B
CAMLE B,ONE ;IS THE MAGNITUDE OF THE ARG. LE 1.0?
JRST TOOLRG ;NO, GO TO ERROR RETURN.
MOVN A,@(Q) ;GET THE NEGATIVE OF ARG
FMP A,@(Q) ;CALCULATE -(X^2)
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP, IF NECESSARY.
FAD A, ONE ;CALCULATE 1-(X^2)
JUMPE A, ASIN1 ;WAS X EITHER -1.0 OR 1.0?
MOVEM A,ASIN2 ;NO,
FUNCT SQRT.,<ASIN2> ;CALCULATE SQRT(1-X^2)
MOVE B,@(Q) ;GET THE ARGUMENT BACK AGAIN
FDV B, A ;CALCULATE X/SQRT(1-X^2)
MOVEM B,ASIN2 ;THEN
FUNCT ATAN.,<ASIN2> ;CALCULATE ATAN(X/SQRT(1-X^2))
GOODBY (1) ;ASIN RETURN
ASIN1: MOVE A, PIOT ;ANSWER IS EITHER PI/2 OR-PI/2
SKIPG @(Q) ;WAS ORIGINAL ARGUMENT POSITIVE?
MOVNS A ;NO, GET -PI/2
GOODBY (1) ;ASIN RETURN
TOOLRG: ERROR (LIB,10,2,[ASCIZ /ASIN OF ARG > 1.0 IN MAGNITUDE/])
SETZ A, ;SET ANSWER TO ZERO.
GOODBY (1) ;ASIN RETURN
ASIN2: 0 ;STORAGE FOR ARGUMENT
PIOT: 201622077325 ;PI/2
ONE: 1.0
PRGEND
TITLE ATAN2 %4.(235) ARC TAN ROUTINE WITH 2 ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY ATAN2
EXTERN ATAN2.
ATAN2=ATAN2.
PRGEND
TITLE ATAN2. %4.(235) ARC TAN ROUTINE WITH 2 ARGUMENTS
SUBTTL D. TODD /TWE/KK/DMN/DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V0.27 17-JUL-70
;FROM V.021 29-OCT-69
;FLOATING POINT SINGLE PRECISION ARCTANGENT OF TWO ARGUMENTS
;RETURNS ARCTANGENT OF A/B
;IF ARGUMENT IS IN 2ND QUADRANT, ATAN2(A/B) = PI + ATAN(A/B)
;IF ARGUMENT IS IN 3RD QUADRANT, ATAN2(A/B) = ATAN(A/B) - PI
;IF A/B OVERFLOWS (OR DIVIDE CHECK), THEN RETURN
; +PI/2 IF A>=0, AND
; -PI/2 IF A<0.
;IF A/B UNDERFLOWS, THEN RETURN
; 0 IF B>=0, AND
; +PI IF B<0 AND A >=0,
; -PI IF B<0 AND A<0.
;THERE IS NO RESTRICTION ON THE ARGUMENTS
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, ATAN2
; EXP A
; EXP B
;THE ANSWER IS RETURNED IN ACCUMULATOR A.
SEARCH FORPRM
A= 0
B= 1
Q= 16
HELLO (ATAN2,.) ;[235] ENTRY POINT TO ATAN2 ROUTINE
MOVE A, @(Q) ;PICK UP FIRST ARGUMENT
MOVE B, @1(Q) ;PICK UP SECOND ARGUMENT
MOVEM A,SAVEA ;SAVE 1ST ARG.
MOVEM B, SAVEB ;SAVE 2ND ARG.
JUMPE B,DIVCHK ; INTERCEPT IF DIVCHK WILL OCCUR
FDVR A, B ;FORM A/B
JFCL 11,OVUNFO ; SUPPRESS ERROR MESSAGE FROM OVTRAP IF NECESSARY.
MOVEM A,TEMP ;ARG TO NE 0 OR 1.
FUNCT ATAN.,<TEMP> ;CALCULATE ATAN (A/B)
SKIPL SAVEB ;IF B>0, SGN(ATAN2)=SGN(A)
GOODBY (2) ;ATAN2 RETURN
JUMPGE A, ATAN2A ;IS A POSITIVE?
FADR A, PII ;NO, SECOND QUADRANT, ADD PI
GOODBY (2) ;ATAN2 RETURN
ATAN2A: FSBR A, PII ;YES,3RD QUADRANT, SUBTRACT PI
GOODBY (2) ;ATAN2 RETURN
OVUNFO: MOVE A,.JBTPC ;PICK UP FLAGS.
TLNE A,000100 ;SKIP IF OVERFLOW.
JRST UNDER ;O'E GO TO UNDERFLOW CASE.
DIVCHK: JUMPE A,UNDER-1 ; IF BOTH ARGS 0 THEN RETURN 0
MOVE A,HALFPI ;ANSWER SET TO PI OVER TWO.
SKIPGE SAVEA ;SKIP IF ANS IS TO BE POSITIVE.
MOVNS A ;SET ANSWER NEGATIVE.
GOODBY (2) ;ATAN2 RETURN
UNDER: JUMPL B,.+5 ;IF B >=0,
ERROR (APR,7,1,.+1) ;GIVE AN ERROR MESSAGE
MOVEI A,0 ;RETURN ANSWER OF 0.
GOODBY (2) ;ATAN2 RETURN
MOVE A,PII ;SET ANSWER TO PI
SKIPGE SAVEA ;SKIP IF 1ST ARG WAS >= 0.
MOVNS A ;O'E, SET ANSWER NEGATIVE.
GOODBY (2) ;RETURN
PII: 202622077325 ;3.141592653589793238462643...
HALFPI: 201622077325
SAVEA: 0
SAVEB: 0
TEMP: 0
PRGEND
TITLE ATAN %4.(235) ARC TAN ROUTINE WITH 1 ARGUMENTS
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY ATAN
EXTERN ATAN.
ATAN=ATAN.
PRGEND
TITLE ATAN. %4.(235) ARC TAN ROUTINE WITH 1 ARGUMENT
SUBTTL ED YOURDON/KK
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.005.
;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B2-A3(Z+B3)**-1)**-1)**-1)
;WHERE Z=X^2, IF 0<X<=1
;IF X>1, THEN ATAN(X) = PI/2 - ATAN(1/X)
;IF X>1, THEN RH(D) =-1, AND LH(D) = -SGN(X)
;IF X<1, THEN RH(D) = 0, AND LH(D) = SGN(X)
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, ATAN
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
SEARCH FORPRM
A= 0
B= 1
C= 2
D= 3
Q= 16
HELLO (ATAN,.) ;[235] ENTRY TO ARCTANGENT ROUTINE
MOVE A, @(Q) ;PICK UP THE ARGUMENT IN A
ATAN1: MOVM B, A ;GET ABSF OF ARGUMENT
CAMG B, A1 ;IF X<2^-33, THEN RETURN WITH...
JRST AT5 ;ATAN(X) = X
MOVEM D, D1 ;SAVE ACCUMULATOR D
HLLO D, A ;SAVE SIGN, SET RH(D) = -1
CAML B, A2 ;IF A>2^33, THEN RETURN WITH
JRST AT4 ;ATAN(X) = PI/2
MOVEM C, C1 ;SAVE ACCUMULATOR C
MOVSI C, 201400 ;FORM 1.0 IN C
CAMG B, C ;IS ABSF(X)>1.0?
TRZA D, -1 ;IF B .LE. 1.0, THEN RH(D) = 0
FDVM C, B ;B IS REPLACED BY 1.0/B
TLC D, (D) ;XOR SIGN WITH .G. 1.0 INDICATOR
MOVEM B, C3 ;SAVE THE ARGUMENT
FMP B, B ;GET B^2
MOVE C, KB3 ;PICK UP A CONSTANT
FAD C, B ;ADD B^2
MOVE A, KA3 ;ADD IN NEXT CONSTANT
FDVM A, C ;FORM -A3/(B^2 + B3)
FAD C, B ;ADD B^2 TO PARTIAL SUM
FAD C, KB2 ;ADD B2 TO PARTIAL SUM
MOVE A, KA2 ;PICK UP -A2
FDVM A, C ;DIVIDE PARTIAL SUM BY -A2
FAD C, B ;ADD B^2 TO PARTIAL SUM
FAD C, KB1 ;ADD B1 TO PARTIAL SUM
MOVE A, KA1 ;PICK UP A1
FDV A, C ;DIVIDE PARTIAL SUM BY A1
FAD A, KB0 ;ADD B0
FMP A, C3 ;MULTIPLY BY ORIGINAL ARGUMENT
TRNE D, -1 ;CHECK .G. 1.0 INDICATOR
FSB A, PIOT ;ATAN(A) = -(ATAN(1/A)-PI/2)
SKIPA C, C1 ;RESTORE ACCUMULATOR C AND SKIP
AT4: MOVE A, PIOT ;GET PI/2 AS ANSWER
SKIPGE D ;LH(D) = -SGN(B) IF B>1.0
MOVNS A ;NEGATE ANSWER
MOVE D, D1 ;RESTORE ACCUMULATOR
AT5: GOODBY (1) ;ATAN RETURN
A1: 145000000000 ;2**-33
A2: 233000000000 ;2**33
KB0: 176545543401 ;0.1746554388
KB1: 203660615617 ;6.762139240
KB2: 202650373270 ;3.316335425
KB3: 201562663021 ;1.448631538
KA1: 202732621643 ;3.709256262
KA2: 574071125540 ;-7.106760045
KA3: 600360700773 ;-0.2647686202
C1: 0
C3: 0
D1: 0
PIOT: 201622077325 ;PI/2
PRGEND
TITLE SQRT %4.(235) SQUARE ROOT
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY SQRT
EXTERN SQRT.
SQRT=SQRT.
PRGEND
TITLE SQRT. %5.(235) SQUARE ROOT
SUBTTL JUDD LEONARD 13-AUG-75
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS
;CALCULATED. THE FIRST GUESS IS CALCULATED TO BE OPTIMUM
;FOR NUMBERS BETWEEN 1/2 AND 2
;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD.
;THE CALLING SEQUENCE FOR THE SQUARE ROOT IS AS FOLLOWS:
; MOVEI M,ARGLIST
; PUSHJ P,SQRT.
;THE ANSWER IS RETURNED IN ACCUMULATOR A.
A=0
B=1
M=16
SEARCH FORPRM
HELLO (SQRT,.) ;[235] ENTRY TO SQUARE ROOT ROUTINE
SKIPG B,@(M) ;PICK UP ARG. CHECK IF > 0
JRST SQRTLE ;NO, HANDLE NON-POSITIVE ARGUMENT
SQRTP: MOVE A,B ;SAVE NUMBER
LSH B,-1 ;DIVIDE EXP BY 2
TLZE B,400 ;WAS EXPONENT ODD?
JRST SQRT2 ;YES
;HERE WHEN EXPONENT WAS EVEN. B 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 B,[XWD 267,607000] ;COMPUTE LINEAR APPROXIMATION
IFN CPU-PDP6,<
FMPRI B,301454 ;RESCALE EXPONENT
>
IFE CPU-PDP6,<
FMP B,[301454000000]
>
JRST SQRT3
;HERE WITH ODD EXPONENT, USE Y0 = SO * (X+C).
SQRT2: ADD B,[XWD 267,607000] ;LINEAR APPROXIMATION
IFN CPU-PDP6,<
FMPRI B,301650 ;RESCALE EXPONENT
>
IFE CPU-PDP6,<
FMP B,[301650000000]
>
SQRT3: FDV A,B ;ORIGINAL / INITIAL GUESS
FAD B,A ;AVERAGE THEM
FSC B,-1
MOVM A,@(M) ;GET ORIGINAL NUMBER
FDV A,B ;SECOND ITERATION
FADR A,B
FSC A,-1 ;AVERAGE THIRD GUESS WITH SECOND
GOODBY (1) ;SQRT RETURN
SQRTLE: JUMPE B,ZERO
ERROR (LIB,6,2,[ASCIZ /attempt to take SQRT of negative arg/])
MOVM B,@(M) ;GET MAGNITUDE
JRST SQRTP ;POSITIVE NOW
ZERO: MOVEI A,0 ;HERE ON NON-POSITIVE ARG. RETURN ZERO
GOODBY (1) ;SQRT RETURN
PRGEND
TITLE SINH %4.(235) HYPERBOLIC SIN ROUTINE
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY SINH
EXTERN SINH.
SINH=SINH.
PRGEND
TITLE SINH. %4.(235) HYPERBOLIC SIN ROUTINE
SUBTTL KAREN KOLLING/DMN
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.021 19-NOV-69
;FLOATING POINT SINGLE PRECISION HYPERBOLIC SINE FUNCTION.
;SINH IS CALCULATED AS FOLLOWS:
; IF ABS(X)>88.029,
; SINH(X)=(EXP[ABS(X)-LN(2)])*SIGN(X)
; IF ABS(X)<=0.10,
; SINH(X)=X+(X**3)/6+(X**5)/120
; FOR ALL OTHER VALUES OF X,
; SINH(X)=1/2[EXP(X)-1/EXP(X)]
;THE CALLING SEQUENCE IS:
; JSA Q,SINH
; EXP ARG
;THE ANSWER IS RETURNED IN AC 0.
SEARCH FORPRM
HELLO (SINH,.) ;[235] ENTRY TO HYPERBOLIC SINE ROUTINE.
MOVE 0,@(16) ;PICK UP THE ARG.
MOVEM 2,SAVE2 ;SAVE AC 2.
MOVEM 0,ARGTMP ;SAVE ARG.
MOVM 2,0 ;GET MAGNITUDE OF ARG IN AC 2.
CAMLE 2,EIGHT8 ;IF ABS(X)>88.029,
JRST OV88 ;THEN GO TO OV88.
CAMG 2,ONE10T ;IF ABS(X)<=0.10,
JRST SERIES ;THEN GO TO SERIES.
FUNCT EXP.,<2> ;FIND EXP(ABS(X)).
;ABS(X) IS IN AC 2.
HRLZI 1,576400 ;PUT -1.0 IN AC 1.
FDVR 1,0 ;CALC. -EXP(-ABS(X)).
FADR 0,1 ;CALC. EXP(ABS(X))-EXP(-ABS(X)).
FDVRI 0,202400 ;CALC. THIS/2.0
SKIPGE ARGTMP ;ANSWER IS POSITIVE.
MOVNS 0,0 ;ANSWER IS NEGATIVE.
MOVE 2,SAVE2 ;RESTORE AC 2.
GOODBY (1) ;SINH RETURN
SERIES: FMPR 2,2 ;CALC. X^2.
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP.
MOVEM 2,SX2 ;SAVE X^2 IN SX2.
FDVR 2,ONE120 ;CALC.X^2/120
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP.
FADR 2,ONESIX ;CALC. (X^2/120)+1/6
FMPR 2,SX2 ;MULTIPLY IT BY X^2.
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP.
FADRI 2,201400 ;ADD 1.0.
FMPR 0,2 ;MULTIPLY BY X.
MOVE 2,SAVE2 ;RESTORE AC 2.
GOODBY (1) ;SINH RETURN
OV88: FSBR 2,LN2BE ;CALC.ABS(X)-LN(2)
CAMG 2,EIGHT8 ;OVERFLOW?
JRST EXPP ;NO,GO TO CALC.
ERROR (APR,5,1,.+1) ;TYPE AN ERROR MESSAGE
HRLOI 0,377777 ;SET ANS.=INFINITY.
JRST EXPP1 ;GO TO SET SIGN OF ANS.
EXPP: FUNCT EXP.,<2> ;CALC. EXP
EXPP1: SKIPGE ARGTMP ;RETURN ANS. >0 IF X>0.
MOVNS 0 ;O'E, ANS. <0.
MOVE 2,SAVE2 ;RESTORE AC 2.
GOODBY (1) ;SINH RETURN
SAVE2: 0
LN2BE: 200542710300 ;LN(2)
EIGHT8: 207540074636 ;88.029
ARGTMP: 0
ONE10T: 0.10
SX2: 0
ONE120: 207740000000 ;120.0
ONESIX: 0.16666667
PRGEND
TITLE COSH %4.(235) HYPERBOLIC COSINE ROUTINE
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY COSH
EXTERN COSH.
COSH=COSH.
PRGEND
TITLE COSH. %4.(235) HYPERBOLIC COSINE ROUTINE
SUBTTL ED YOURDAN/KK/DMN
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.021 26-AUG-69
;FLOATING POINT SINGLE PRECISION HYPERBOLIC COSINE FUNCTION.
;COSH(X) IS CALCULATED AS FOLLOWS:
; IF ABS(X) <= 88.029,
; COSH(X) = 1/2(EXP(X) + 1.0/EXP(X))
; IF ABS(X) > 88.029 AND (ABS(X)-LN(2)) <= 88.029,
; COSH(X) = EXP(ABS(X)-LN(2))
; IF (ABS(X)-LN(2)) > 88.029,
; COSH(X)=377777777777
; AND AN ERROR MESSAGE IS RETURNED.
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA 16,COSH
; EXP ARG
;THE ANSWER IS RETURNED IN AC 0.
SEARCH FORPRM
HELLO (COSH,.) ;[235] ENTRY TO HYPERBOLIC COSINE ROUTINE.
MOVE 0,@(16) ;PICK UP THE ARGUMENT.
MOVEM 2,SAVE2 ;SAVE AC 2.
MOVM 2,0 ;PUT ABS(X) IN AC 2.
CAMLE 2,EIGHT8 ;IF ABS(X) > 88.029,
JRST OV88 ;GO TO OV88.
FUNCT EXP.,<2> ;O'E, CALC. EXP(ABS(X))
MOVSI 2,201400 ;PUT 1.0 IN AC 2.
FDVR 2,0 ;CALC. 1.0/EXP(ABS(X)).
FADR 0,2 ;CALC. EXP(ABS(X)) + EXP(-ABS(X)).
FDVRI 0,202400 ;DIVIDE THIS BY 2.0.
MOVE 2,SAVE2 ;RESTORE AC 2.
GOODBY (1) ;COSH RETURN
OV88: FSBR 2,LN2BE ;FORM ABS(X)-LN(2).
CAMG 2,EIGHT8 ;OVERFLOW?
JRST EXPP ;NO,GO AHEAD.
ERROR (APR,5,1,.+1) ;TYPE AN ERROR MESSAGE
HRLOI 0,377777 ;ANSWER = +INFINITY.
MOVE 2,SAVE2 ;RESTORE AC 2.
GOODBY (1) ;COSH RETURN
EXPP: FUNCT EXP.,<2> ;CALC. EXP(ABS(X)-LN(2)).
MOVE 2,SAVE2 ;RESTORE AC 2.
GOODBY (1) ;COSH RETURN
SAVE2: 0
EIGHT8: 207540074636 ;88.029
LN2BE: 200542710300 ;LOG(2) BASE E.
PRGEND
TITLE TANH %4.(235) HYPERBOLIC TANGENT ROUTINE
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY TANH
EXTERN TANH.
TANH=TANH.
PRGEND
TITLE TANH. %4.(235) HYPERBOLIC TANGENT ROUTINE
SUBTTL ED YOURDAN/KK
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FLOATING POINT SINGLE PRECISION HYPERBOLIC TANGENT ROUTINE
;THIS ROUTINE CALCULATES THE TANH BY THE FOLLOWING ALGORITHM:
;IF ABSF(X) <.00034, THEN TANH(X) = X
;IF ABSF(X) >12.0, THEN TANH(X) = 1.0*SIGN(X)
;IF 0.17 <= X < 12.0, THEN TANH IS CALCULATED AS
; TANH(X) = 1.0 - 2(1.0 + EXP(2*X))**-1
;IF .00034 <= X < 0.17, THEN TANH IS CALCULATED AS
;TANH(X) = F(A+F^2(B+C(D+F^2)**-1))**-1
;WHERE X = 4*LOG(E) (BASE 2)
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, TANH
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
SEARCH FORPRM
A= 0
B= 1
Q= 16
HELLO (TANH,.) ;[235] ENTRY TO TANH ROUTINE
MOVE A, @(Q) ;PICK UP THE ARGUMENT
MOVM B, A ;GET ABSF(ARGUMENT)
CAMGE B, KT1 ;RETURN TANH(X)=X IF
JRST TH2 ;ABSF(X) .LE. .00034
CAMLE B, KT2 ;RETURN TANH(X) = 1.0 IF
JRST TH5 ;ARGUMENT GREATER THAN 12.0
CAMGE B, KT3 ;USE RATIONAL APPROXIMATION IF
JRST TH3 ;ARGUMENT IS LESS THAN 0.17
MOVEM A,SAVEA ;SAVE ARG.
FMPRI B,202400 ;GET 2*ARG.
MOVEM B,TM1 ;ARG TO NE 0 OR 1.
FUNCT EXP.,<TM1> ;CALCULATE EXP(2X)
MOVSI B, 201400 ;FORM 1.0
FAD A, B ;1 + EXP(2X)
FDVM B, A ;(1 + EXP(2X))**-1
FMPRI A,202400 ;2*(1 + EXP(2X))**-1
FSBRM B, A ;1 - 2*(1 + EXP(2X))**-1
SKIPGE SAVEA ;SKIP AHEAD IF ARG WAS >=0.
MOVNS A ;OTHERWISE,NEGATE THE ANSWER.
TH2: GOODBY (1) ;TANH RETURN
TH3: FMP A, KT7 ;FORM 4*X*LOG(E) BASE 2
MOVEM A, TM1 ;SAVE IT IN TM1
FMP A, A ;SQUARE IT
MOVEM A, TM2 ;SAVE IT
FAD A, KT4 ;FORM F^2 + T4
MOVE B, KT5 ;GET T5 IN ACCUMULATOR B
FDV B, A ;KT5/(F^2 + KT4)
FAD B, KT6 ;KT6 + KT5/(F^2 + KT4)
FMP B, TM2 ;MULTIPLY BY F^2
FAD B, KT7 ;ADD T7 (4*LOG(E) BASE 2)
MOVE A, TM1 ;GET F IN ACCUMULATOR A
TH5: FDV A, B ;DIVIDE F BY PARTIAL SUM
GOODBY (1) ;TANH RETURN
KT1: 165544410070 ;0.00034
KT2: 204600000000 ;12.0
KT3: 176534121727 ;0.17
KT4: 211535527022 ;349.6699888
KT5: 204704333567 ;14.1384514018
KT6: 173433723376 ;0.01732867951
KT7: 203561250731 ;5.7707801636
TM1: 0
TM2: 0
SAVEA: 0
PRGEND
TITLE EXP1 %4.(120) ;FROM LIB40 VERSION 32(341)
SUBTTL D. TODD /DRT 15-FEB-1973 B/KK/DMN/TWE/DMN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;SINGLE PRECISION INTEGER TO INTEGER EXP FUNCTION.
;EXP CALCULATES I**J, WHERE
; J=Q(0) + Q(1)*2 + Q(2)*4 + ..., WHERE Q(I)=0 OR 1.
;THE CALLING SEQUENCE FOR THE ROUTINES IS:
; PUSHJ 17,EXP1.N WHERE N=0,2,4, OR 6.
;THE BASE IS IN AC N AND THE EXPONENT IS IN AC N+1.
;THE ANSWER IS RETURNED IN AC N.
SEARCH FORPRM
IFN F40LIB,<ENTRY EXP1.0,EXP1.2,EXP1.4,EXP1.6>
IFN F10LIB,<ENTRY EXP1.>
A=0
B=1
C=2
D=3
E=4
F=5
G=6
H=7
P=17
IFN F10LIB,<
SIXBIT /EXP1./
EXP1.: MOVE T0,@(L) ;GET THE BASE
MOVE T1,@1(L) ;GET THE EXPONENT
IFN F40LIB,<
JRST EXP1.0 ;COMMON ROUTINE
>>
IFN F40LIB,<
SIXBIT/EXP1.6/
EXP1.6: MOVE A,G ;SET UP BASE.
MOVE B,H ;SET UP EXPONENT.
PUSHJ P,EXP1.0 ;GO TO MAIN ROUTINE.
MOVEM A,G ;STORE ANSWER.
POPJ P, ;RETURN.
SIXBIT/EXP1.4/
EXP1.4: MOVE A,E ;SET UP BASE.
MOVE B,F ;SET UP EXPONENT.
PUSHJ P,EXP1.0 ;GO TO MAIN ROUTINE.
MOVEM A,E ;STORE ANSWER.
POPJ P, ;RETURN.
SIXBIT/EXP1.2/
EXP1.2: MOVE A,C ;SET UP BASE.
MOVE B,D ;SET UP EXPONENT.
PUSHJ P,EXP1.0 ;GO TO MAIN ROUTINE.
MOVEM A,C ;STORE ANSWER.
POPJ P, ;RETURN.
SIXBIT/EXP1.0/
EXP1.0:>
JUMPE B,[MOVEI A,1 ;BASE**0 RETURNS 1
POPJ P,]
JUMPN A,BASNT0 ;GO AHEAD IF BASE NE 0.
JUMPGE B,IEXP4 ;RETURN IF BASE=0, EXP >= 0.
IOVFL: ERROR (APR,5,1,.+1) ;O'E, SET UP
HRLOI 0,377777 ;ANS.= INFINITY
POPJ 17, ;AND RETURN.
BASNT0: JUMPL B,[TRNN B,1 ;TEST FOR EXP<0. IS EXP ODD?
MOVMS A ;EXP IS EVEN. GET ABS(BASE)
CAIE A,1 ;IS BASE +-1?
CAMN A,[-1]
POPJ P, ;YES, RETURN +-1
MOVEI A,0 ;NO, RETURN 0
POPJ P,]
PUSH P,C ;SAVE A WORKING AC.
MOVEI C,1 ;INITIALIZE ANSWER TO 0.
MOVEM C,SAVEC ;INITIALIZE FLAG WORD TO > 0.
JUMPG A,IEXP2 ;GO TO CALC. IF ANSWER WILL BE > 0.
TRNN B,1 ;IS EXP ODD OR EVEN?
JRST IEXP2 ;EXP IS EVEN, ANS WILL BE > 0.
SETCMM SAVEC ;EXP IS ODD, BASE < 0, ANS WILL BE <0.
JRST IEXP2 ;GO TO CALC.
IEXP1: IMUL A,A ;
JFCL 1,OVER ;TRANSFER TO OVER IF OVERFLOW.
LSH B,-1 ;DIVIDE B BY 2.
IEXP2: TRZE B,1 ;CHECK LAST BIT OF B.
IMUL C,A ;
JFCL 1,OVER ;TRANSFER TO OVER IF OVERFLOW.
JUMPG B,IEXP1 ;GO TO RETURN IF B HAS BECOME 0.
IEXP3: MOVE A,C ;PUT ANSWER IN AC A.
IEXP3A: POP P,C ;RESTORE AC C.
IEXP4: POPJ P, ;RETURN.
OVER: PUSHJ P,IOVFL ;SET ANSWER TO + INFINITY.
SKIPL SAVEC ;SKIP IF ANS IS TO BE < 0.
JRST IEXP3A ;GO TO RETURN.
MOVNS A,A ;SET UP -
SUBI A,1 ;INFINITY
JRST IEXP3A ;GO TO RETURN.
SAVEC: 0
LIT
PRGEND
TITLE EXP3 %5A(624)
SUBTTL D. TODD /DMN/DRT/HPW/CLRH/SWG 29-NOV-76
VERWHO==0
VERVER==5
VERUPD==1
VERPAT==624
XP3VER=BYTE (3)VERWHO(9)VERVER(6)VERUPD(18)VERPAT
PURGE VERWHO,VERVER,VERUPD,VERPAT
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.32(377) LIB40
;FROM V.021 22-SEP-69
;SINGLE PRECISION FORTRAN IV EXP.3 FUNCTIONS
;THESE ROUTINES CALCULATE A FLOATING POINT NUMBER RAISED TO A
;FLOATING POINT POWER. THE CALCULATION IS
; A**B= EXP(B*LOG(A))
;IF THE EXPONENT IS AN INTEGER < 2**35 IN MAGNITUDE, THE
;RESULT WILL BE COMPUTED USING "EXP2.." AND THE ANSWER
;WILL HAVE THE CORRECT SIGN. (REMEMBER THAT THE "INTEGER"
;HAS ONLY 27 SIGNIFCANT BITS.)
;SINCE NEGATIVE NUMBERS RAISED TO NON-INTEGER POWERS YIELD
;COMPLEX ANSWERS, THE MAIN ALGORITHM CALCULATES
; EXP(B*LOG(ABSF(A)))
;THE CALLING SEQUENCE FOR THE ROUTINES IS AS FOLLOWS:
; PUSHJ P, EXP3.'N'
;WHERE N IS EITHER 0,2,4, OR 6. THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE
;IS CALLED. THE RESULT IS RETURNED IN ACCUMULATOR N.
;REVISION HISTORY
;EDIT SPR COMMENT
;---- --- -------
;572 ----- ALLOW CEXP TO LOAD WHEN F40LIB TURNED OFF BY DEFINING
; EXP3.. LIKE EXP2..
;****** END OF REVISION HISTORY ******
EXTERN EXP2.. ;STANDARD FP TO INT EXPONENTIATION
SEARCH FORPRM
IFN F40LIB,<ENTRY EXP3.0,EXP3.2,EXP3.4,EXP3.6>
IFN F10LIB,<ENTRY EXP3.>
;**; [572] INSERT BEFORE AC DEFINITIONS CLRH 2-AUG-76
ENTRY EXP3.. ;[572] ENTRY FOR CEXP
;ACCUMULATOR DEFINITIONS
A= 0
B= 1
C= 2
D= 3
E= 4
F= 5
G= 6
H= 7
Q= 16
P= 17
IFN F10LIB,<
SIXBIT /EXP3./
EXP3.: MOVE T0,@(L) ;GET THE BASE
MOVE T1,@1(L) ;GET THE EXPONENT
IFN F40LIB,<
JRST EXP3.0 ;COMMON ROUTINE
>>
IFN F40LIB,<
SIXBIT/EXP3.6/
EXP3.6: MOVE A, G ;SET UP ACCUMULATOR A
MOVE B, H ;SET UP ACCUMULATOR B
PUSHJ P, EXP3.0 ;GO TO MAIN ROUTINE.
MOVE G,A ;ANSWER IN CORRECT AC.
POPJ P, ;EXIT
SIXBIT/EXP3.4/
EXP3.4: MOVE A, E ;SET UP ACCUMULATOR A
MOVE B, F ;SET UP ACCUMULATOR B
PUSHJ P, EXP3.0 ;GO TO MAIN ROUTINE.
MOVE E,A ;ANSWER IN CORRECT AC.
POPJ P, ;EXIT
SIXBIT/EXP3.2/
EXP3.2: MOVE A, C ;SET UP ACCUMULATOR A
MOVE B, D ;SET UP ACCUMULATOR B
PUSHJ P, EXP3.0 ;GO TO MAIN ROUTINE.
MOVE C,A ;ANSWER IN CORRECT AC.
POPJ P, ;EXIT
SIXBIT/EXP3.0/
EXP3.0:>
;**; [572] INSERT AFTER IFN F40LIB EXP3.0 CLRH 2-AUG-76
EXP3..: ;[572] ENTRY FOR CEXP
JUMPE B,[MOVSI A,(1.0) ;BASE**0, RETURNS 1
POPJ P,]
JUMPN A,EXP30A ;GO AHEAD IF BASE NE 0.
JUMPGE B,EXP3A ;EXIT IF BASE = 0, EXP >= 0,
ERROR (APR,5,1,.+1) ;O'E, TYHE AN ERROR MESSAGE
HRLOI A,377777 ;ANS.=+INFINITY
POPJ 17, ;AND EXIT.
EXP30A: PUSH P,C ;SAVE AC C
PUSH P,D ;SAVE AC D
MOVM D,B ;SET EXP. POSITIVE.
MOVEI C,0 ;CLEAR AC C TO ZERO
LSHC C,11 ;SHIFT 9 PLACES LEFT
SUBI C,200 ;TO OBTAIN SHIFTING FACTOR
PUSH P,E ;SAVE AC E.
JUMPLE C,EXP3GO ;IS C > 0
HRR E,C ;SET UP E AS AN INDEX REG.
MOVEI C,0 ;CLEAR OUT AC C
LSH D,-1 ;RIGHT ADJUST EXP TO BIT 1.
ASHC C,(E) ;SHIFT LFT BY CONTENTS OF E
JFCL EXP3GO ;IF OVERFLOW, GO TO EXP3GO.
JUMPN D,EXP3GO ;IS EXPONENT AN INTEGER ?
JUMPGE B,.+2 ;YES, WAS IT NEG. ?
MOVNS C ;YES, NEGATE IT
MOVE B,C ;MOVE INTEGER INTO B
PUSHJ P,EXP2.. ;%216% OBTAIN RESULT USING EXP2..
JRST EXPPOP ;RETURN TO RESTORE ACS C&D&E.
EXP3GO: MOVM E,A ;GET ABS(BASE) IN NE 0 OR 1.
MOVE D,A ;SAVE SIGN OF A
MOVE C,B ;SAVE AC B.
FUNCT ALOG.,<E> ;CALCULATE LOG OF A
FMPRM A, C ;CALCULATE B*LOG(A)
FUNCT EXP.,<C> ;CALCULATE EXP(B*LOG(A))
JUMPGE D,EXPPOP ;SHOULD SIGN BE NEGATIVE?
;**; [624] DELETE AND INSERT @EXPPOP-1 SWG 29-NOV-76
;[624] DELETE MOVN A,A ;YES, NEGATE RESULT
ERROR (LIB,1,2,[ASCIZ/Attempt to raise negative single precision number to non-integer power/]) ;[624]
EXPPOP: POP P,E ;RESTORE AC E.
POP P,D ;RESTORE AC D.
POP P,C ;RESTORE AC C.
EXP3A: POPJ P, ;EXIT
LIT
PRGEND
TITLE EXP2 %4.(216)
SUBTTL D. TODD /DMN/DRT/HPW/ 16-OCT-1973
VERWHO==0
VERVER==2
VERUPD==0
VERPAT==216
XP2VER=BYTE (3)VERWHO(9)VERVER(6)VERUPD(18)VERPAT
PURGE VERWHO,VERVER,VERUPD,VERPAT
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.32(415) LIB40
;SINGLE PRECISION EXP.2 FUNCTIONS
;THESE ROUTINES CALCULATE A FLOATING POINT NUMBER TO A FIXED
;POINT POWER. THE CALCULATION IS A**B, WHERE B IS OF THE FORM
; B=Q(0) + Q(1)*2 + Q(2)*4 + ...WHERE Q(I)=0 OR 1
;THERE ARE NO RESTRICTIONS ON THE BASE OR EXPONENT
;THE CALLING SEQUENCES FOR THE ROUTINES ARE AS FOLLOWS:
; PUSHJ P, EXP2.'N'
;WHERE N IS EITHER 0,2,4, OR 6. THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE IS
;CALLED. THE ANSWER IS RETURNED IN ACCUMULATOR N.
SEARCH FORPRM
ENTRY EXP2.. ;%216% ENTRY FROM EXP3.
IFN F40LIB,<ENTRY EXP2.0,EXP2.2,EXP2.4,EXP2.6>
IFN F10LIB,<ENTRY EXP2.>
;ACCUMULATOR DEFINITIONS
A= 0
B= 1
C= 2
D= 3
E= 4
F= 5
G= 6
H= 7
P= 17
IFN F10LIB,<
SIXBIT /EXP2./
EXP2.: MOVE T0,@(L) ;GET THE BASE
MOVE T1,@1(L) ;GET THE EXPONENT
IFN F40LIB,<
JRST EXP2.0 ;COMMON ROUNTINE
>>
IFN F40LIB,<
SIXBIT/EXP2.6/
EXP2.6: MOVE A, G ;SET UP ACCUMULATOR A
MOVE B, H ;SET UP ACCUMULATOR B
PUSHJ P, EXP2.0 ;GO TO MAIN ROUTINE.
MOVEM A, G ;MOVE ANSWER TO CORRECT AC.
POPJ P, ;RETURN
SIXBIT/EXP2.4/
EXP2.4: MOVE A, E ;SET UP ACCUMULATOR A
MOVE B, F ;SET UP ACCUMULATOR B
PUSHJ P, EXP2.0 ;GO TO MAIN ROUTINE.
MOVEM A, E ;MOVE ANSWER TO CORRECT AC.
POPJ P, ;RETURN
SIXBIT/EXP2.2/
EXP2.2: MOVE A, C ;SET UP ACCUMULATOR A
MOVE B, D ;SET UP ACCUMULATOR B
PUSHJ P, EXP2.0 ;GO TO MAIN ROUTINE.
MOVEM A, C ;MOVE ANSWER TO CORRECT AC.
POPJ P, ;RETURN
SIXBIT/EXP2.0/
EXP2.0:>
EXP2..: JUMPE B,[MOVSI A,(1.0) ;BASE**0, RETURNS 1
POPJ P,]
JUMPN A,EXP2A ;GO AHEAD IF BASE NE 0.
JUMPGE B,FEXP4 ;EXIT IF BASE =0, EXP >= 0,
ERROR (APR,5,1,.+1) ;O'E, SET UP
HRLOI 0,377777 ;AN ANSWER OF INFINITY.
POPJ 17, ;RETURN.
EXP2A: MOVEM C,SAVEC ;SAVE A WORKING ACCUMULATOR.
MOVSI C, 201400 ;GET 1.0 IN ACCUMULATOR C.
MOVEM A,SAVEA ;STORE BASE IN SAVEA.
MOVEM B,SAVEB ;STORE EXP. IN SAVEB.
JUMPGE B, FEXP2 ;IS EXPONENT POSITIVE?
MOVMS B ;NO, MAKE IT POSITIVE
JFCL MININF ;IF EXP WAS 400000,,0 GO TO MININF.
PUSHJ P, FEXP2 ;CALL MAIN PART OF PROGRAM.
INV: MOVSI B, 201400 ;GET 1.0 IN B.
FDVM B, A ;FORM 1/(A**B) FOR NEG. EXPONENT.
POPJ P, ;RETURN.
FEXP1: FMP A, A ;FORM A**N, FLOATING POINT.
JFCL OVER ;IF OVER/UNDERFLOW, GO TO OVER.
LSH B, -1 ;SHIFT EXPONENT FOR NEXT BIT.
FEXP2: TRZE B, 1 ;IS THE BIT ON?
FMP C, A ;YES, MULTIPLY ANSWER BY A**N.
JFCL OVER ;IF OVER/UNDERFLOW, GO TO OVER.
JUMPN B, FEXP1 ;UPDATE A**N UNLESS ALL THROUGH.
FEXP3: MOVE A, C ;PICK UP RESULT FROM C.
FEXP3A: MOVE C,SAVEC ;RESTORE A WORKING ACCUMULATOR.
FEXP4: POPJ P, ;RETURN.
OVER: MOVE C,.JBTPC ;PICK UP FLAGS.
SKIPG SAVEB ;JUMP TO INVERT IF
JRST INVERT ;EXP. WAS NEGATIVE.
TLNE C,(1B11) ;UNDERFLOW, IN WHICH CASE,
ERROR (APR,7,1,OUT) ;UNDER FLOW
ERROR (APR,5,1,OUT) ;OVER FLOW
OUT: HRLOI A,377777 ;ANS. IS SET TO + INFINITY.
TLNE C,(1B11) ;SKIP IF OVERFLOW FLAG SET.
SETZ A, ;O'E, SET ANSWER TO 0.
OUT2: SKIPL SAVEA ;ANS. IS >= 0, IF
JRST FEXP3A ;A WAS >= 0.
MOVE B,SAVEB ;PICK UP THE EXP.
TRNE B,1 ;ANS. IS < 0, IF A < 0 AND
MOVNS A ;THE EXP. WAS ODD.
JRST FEXP3A ;GO TO RETURN.
INVERT: SUB P,[XWD 1,1] ;ADJUST PDP.
TLCN C,(1B11) ;IF TRUE UNDERFLOW, GO
JRST ALOGRT ;TO ALOGRT.
ERROR (APR,1,1,OUT) ;TYPE AN ERROR MESSAGE
ALOGRT: MOVM C,SAVEA ;PICK UP ABS(BASE).
FUNCT ALOG.,<C> ;CALC. LOG(ABS(A)).
MOVEM A,C ;RESULTS TO C.
IFE CPU-KI10,<FLTR 0,SAVEB>
IFE CPU-KA10,<FUNCT FLOAT.,<SAVEB> ;MAKE EXP. A FLOATING
>
FMPRM A,C ;CALC. B*ALOG(ABS(A)).
FUNCT EXP.,<C> ;FIND EXP. OF THIS.
JRST OUT2 ;GO AND TYPE ERROR MESSAGE.
MININF: HRLOI B,377777 ;SET EXP = +INFINITY.
PUSHJ P,FEXP2 ;GO TO MAIN ROUTINE.
FMPR A,SAVEA ;ANS. = ANS. TIMES A.
JFCL OVER ;GO TO OVER IF OVERFLOW.
JRST INV ;OTHERWISE, GO TO INV.
SAVEA: 0 ;TEMP FOR A.
SAVEB: 0 ;TEMP FOR B.
SAVEC: 0 ;TEMP FOR C.
LIT
PRGEND
TITLE EXP %4.(235) FLOATING POINT SINGLE PRECISION EXPONENTIAL
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY EXP
EXTERN EXP.
EXP=EXP.
PRGEND
TITLE EXP. %4.(235) FLOATING POINT SINGLE PRECISION EXPONENTIAL
SUBTTL ED YOURDON/KK/DMN
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.021 8-AUG-69
;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION
;IF X<=-89.415..., THE PROGRAM RETURNS ZERO AS THE ANSWER
;IF X>=88.029..., THE PROGRAM RETURNS 377777777777 AS THE ANSWER
;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS:
;EXP(X) = 2**(X*LOG(E)BASE2) = 2**(M+F)
;WHERE M IS AN INTEGER AND F IS A FRACTION
;2**M IS CALCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT
;OF THE RESULT OF 2**F. 2**F IS CALCULATED AS
;2**F = 2(0.5+F(A+B*F^2 - F-C(F^2 + D)**-1)**-1
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; JSA Q, EXP
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
A= 0
B= 1
C= 2
D= 3
Q= 16
SEARCH FORPRM
HELLO (EXP,.) ;[235] ENTRY TO EXPONENTIAL ROUTINE
MOVE B,@(Q) ;PICK UP THE ARGUMENT IN B
CAMGE B,E77 ;IS EXP. < -89.41...?
JRST OUT2 ;YES, GO TO EXIT.
CAMG B,E7 ;IS EXP. > +88.029...?
JRST EXP1 ;GO TO STANDARD ALGORITHM.
ERROR (APR,5,1,.+1) ;TYPE AN ERROR MESSAGE
HRLOI A, 377777 ;GET LARGEST FLOATING NUMBER
GOODBY (1) ;RETURN
OUT2: ERROR (APR,7,1,.+1) ;ERROR MESSAGE
MOVEI A,0 ;ANSWER IS 0.
GOODBY (1) ;RETURN
EXP1: MOVEM C, ES1 ;SAVE ACCUMULATOR C
MOVEM D, ES3 ;SAVE ACCUMULATOR D
SETZM ES2 ;INITIALIZE ES2
MULI B, 400 ;SEPARATE FRACTION AND EXPONENT
TSC B, B ;GET A POSITIVE EXPONENT
MUL C, E5 ;FIXED POINT MULTIPLY BY LOG2(E)
ASHC C, -242(B) ;SEPARATE FRACTION AND INTEGER
AOSG C ;ALGORITHM CALLS FOR MULT. BY 2
AOS C ;ADJUST IF FRACTION WAS NEGATIVE
HRRM C, EX1 ;SAVE FOR FUTURE SCALING
JUMPG D,ASHH ;GO AHEAD IF ARG > 0.
TRNN D,377 ;ARE ALL THESE BITS 0?
JRST ASHH ;YES, GO AHEAD.
ADDI D,200 ;NO, FIX UP.
ASHH: ASH D, -10 ;MAKE ROOM FOR EXPONENT
TLC D, 200000 ;PUT 200 IN EXPONENT BITS
FADB D, ES2 ;NORMALIZE, RESULTS TO D AND ES2
FMP D, D ;FORM X^2
MOVE A, E2 ;GET FIRST CONSTANT
FMP A, D ;E2*X^2 IN A
FAD D, E4 ;ADD E4 TO RESULTS IN D
MOVE B, E3 ;PICK UP E3
FDV B, D ;CALCULATE E3/(F^2 + E4)
FSB A, B ;E2*F^2-E3(F^2 + E4)**-1
MOVE C, ES2 ;GET F AGAIN
FSB A, C ;SUBTRACT FROM PARTIAL SUM
FAD A, E1 ;ADD IN E1
FDVM C, A ;DIVIDE BY F
FAD A, E6 ;ADD 0.5
EX1: FSC A, 0 ;SCALE THE RESULTS
MOVE C, ES1 ;RESTORE ACCUMULATOR C
MOVE D, ES3 ;RESTORE ACCUMULATOR D
GOODBY (1) ;RETURN
E1: 204476430062 ;9.95459578
E2: 174433723400 ;0.03465735903
E3: 212464770715 ;617.97226953
E4: 207535527022 ;87.417497202
E5: 270524354513 ;LOG(E), BASE 2
E6: 0.5
E7: 207540074636 ;88.029...
E77: 570232254037 ;-89.415986
ES1: 0
ES2: 0
ES3: 0
LIT
PRGEND
TITLE ALOG %4.(235) LOG ROUTINES
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY ALOG
EXTERN ALOG.
ALOG=ALOG.
PRGEND
TITLE ALOG10 %4.(235) LOG ROUTINES
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
ENTRY ALOG10
EXTERN ALG10.
ALOG10=ALG10.
PRGEND
TITLE ALOG. %5A(642) LOG ROUTINES
SUBTTL D. TODD /KK/DMN/DRT/HPW/MHP 6-JAN-77
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.022 18-DEC-69
;FROM V.020.
;FLOATING POINT SINGLE PRECISION LOGARITHM FUNCTION
;LOG(ABSF(X)) IS CALCULATED BY THE SUBROUTINE, AND AN
;ARGUMENT OF ZERO IS RETURNED AS MINUS INFINITY.
;EDIT 642 TO ALOG IS A REWORKING OF THE ALGORITHM. THE
;ALGORITHM USED IS DESCRIBED BELOW.
;ALOG IS THE ENTRY POINT FOR LOGE(X), AND
;ALOG10 IS THE ENTRY POINT FOR LOG10(X).
;FOR LOGE(X) THE ALGORITHM IS DESCRIBED BELOW. THE
;REFERENCE IS:
;
;'COMPUTER APPROXIMATIONS' BY HART ET. AL.
;WILEY, 1968; ALGORITHM # 2662
;SEE PAGE 227 FOR THE COEFFICIENTS AND PAGE 111 FOR THE
;RANGE OF VALIDITY. IT HAS A PRECISION OF 12-13 DECIMAL
; DIGITS.
;THERE ARE TWO BRANCHES, ONE FOR VALUES OF X NEAR ONE
;(I.E., (SQRT(2))>X>1/(SQRT(2))) AND THE OTHER FOR VALUES OF X
;NOT NEAR ONE.
;FOR X NOT NEAR ONE -
;LOGE(X)=(K-1/2)*LOGE(2)+LOGE(F*SQRT(2))
;WHERE X=2**K*F
;LOGE(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))
;FOR X NEAR ONE -
;LOGE(X)=L3*Z**7+L4*Z**5+L5*Z**3+L6*Z
;WHERE Z=(X-1)/(X+1)
;FOR LOG10(X), THE ALGORITHM IS:
; LOG10(X) = LOGE(X)*LOG10(E)
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; JSA Q, ALOG OR ALOG10
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
A= 0
B= 1
Q= 16
SEARCH FORPRM
HELLO (ALG10.,ALOG10) ;[235] ENTRY TO LOG TO THE BASE 10 ROUTINE.
MOVE 0,@(16) ;GET /X/ IN AC 0.
JUMPE 0,LZERO ;CHECK FOR ZERO ARG.
MOVEM 0,TEMP ;ARG TO LOC NE 0 OR 1.
FUNCT ALOG.,<TEMP> ;CALC THE BASE E LOG TO THE
FMPR 0,LOG10A ;MULTIPLY IT BY LOG10(E).
GOODBY (1) ;RETURN
LOG10A: 177674557305
TEMP: 0
HELLO (ALOG,.) ;[235] ENTRY TO LOG TO THE BASE E ROUTINE.
MOVE A, @(Q) ;GET ABSF(X)
JUMPG A,ALOGOK ;ARG IS GREATER THAN 0
JUMPE A, LZERO ;CHECK FOR ZERO ARGUMENT
ERROR (LIB,11,2,[ASCIZ /Attempt to take log of negative arg/])
MOVM A,@(Q) ;GET ABSF(X)
ALOGOK: CAMN A, ONE ;CHECK FOR 1.0 ARGUMENT
JRST ZERANS ;IT IS 1.0 RETURN ZERO ANS.
;**; [642] INSERT AT ALOGOK+3 MHP 6-JAN-77
CAML A,HI ;[642]IS ARG > SQRT(2)?
JRST GEN ;[642]YES GOTO GENERAL CASE
CAMG A,LO ;[642]IS ARG < 1/SQRT(2)?
JRST GEN ;[642]YES GO TO GENERAL CASE
SETZM LS ;[642]IGNORE EXP FOR ARG NEAR 1
MOVE B,A ;[642]SERIES VARIABLE IS
FAD A,ONE ;[642](ARG-1)/(ARG+1) IF ARG NEAR 1
FSB B,ONE ;[642]
JRST MERGE ;[642]SKIP HANDLING OF EXP IN GENL CASE
;**; [642] ADD LABEL GEN: MHP 6-JAN-77
GEN: ASHC A, -33 ;SEPARATE FRACTION FROM EXPONENT
ADDI A, 211000 ;FLOAT THE EXPONENT
MOVS A, A ;NUMBER NOW IN CORRECT FL. FORMAT
;**; [642] CHANGE AT GEN+3 MHP 6-JAN-77
FAD A,BIAS ;[642]REMOVE BIAS + COMPENSATE FOR
;[642]SQRT(2) FACTOR; A HAS EXP - 1/2
FMP A,LN2 ;[642]MULT BY LN2
MOVEM A,LS ;[642]STORE FOR FUTURE - LS=(K-1/2)*LN2
ASH B, -10 ;SHIFT FRACTION FOR FLOATING
TLC B, 200000 ;FLOAT THE FRACTION PART
FAD B, L1 ;B = B-SQRT(2.0)/2.0
MOVE A, B ;PUT RESULTS IN A
FAD A, L2 ;A = A+SQRT(2.0) = B+(SQRT(2)/2)
;**; [642] ADD LABEL MERGE: MHP 6-JAN-77
MERGE: FDV B, A ;[642]B = B/A
MOVEM B, LZ ;STORE NEW VARIABLE IN LZ
FMP B, B ;CALCULATE Z^2
MOVE A, L3 ;PICK UP FIRST CONSTANT
FMP A, B ;MULTIPLY BY Z^2
FAD A, L4 ;ADD IN NEXT CONSTANT
FMP A, B ;MULTIPLY BY Z^2
FAD A, L5 ;ADD IN NEXT CONSTANT
;**; [642] INSERT AT MERGE+8 MHP 6-JAN-77
FMP A,B ;MULTIPLY BY Z^2
FAD A,L6 ;[642]ADD IN NEXT CONSTANT
FMP A, LZ ;MULTIPLY BY Z
;**;[642] CHANGE AT LZERO-1 MHP 6-JAN-77
FADR A, LS ;[642]ADD IN EXPONENT TO FORM LOG2(X)
GOODBY (1) ;RETURN
LZERO: ERROR (APR,5,1,.+1) ;ERROR MESSAGE
MOVE A,MIFI ;PICK UP MINUS INFINITY
GOODBY (1) ;RETURN
ZERANS: MOVEI A, 0 ;MAKE ANSWER ZERO
GOODBY (1) ;RETURN
;CONSTANTS
ONE: 201400000000
L1: 577225754146 ;-0.707106781187 = -(SQRT(2)/2)
L2: 201552023632 ;1.414213562374 = SQRT(2)
L3: 177464164321 ;[642] .301003281
L4: 177631177674 ;[642] .39965794919
L5: 200525253320 ;[642] .666669484507
L6: 202400000000 ;[642] 2.0
LN2: 200542710300 ;[642] 0.69314718056
MIFI: 400000000001 ;LARGEST NEGATIVE FLOATING NUMBER
HI: 201552023632 ;[642] IF ARG IS BETWEEN HI AND LO
LO: 200552023632 ;[642] NO SCALING BY SQRT(2) NEEDED.
BIAS: 567377000000 ;[642] -(401)/2
LS: 0
LZ: 0
PRGEND
TITLE SIN %4.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY SIN
EXTERN SIN.
SIN=SIN.
PRGEND
TITLE COS %4.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY COS
EXTERN COS.
COS=COS.
PRGEND
TITLE SIND %4.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY SIND
EXTERN SIND.
SIND=SIND.
PRGEND
TITLE COSD %4.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY COSD
EXTERN COSD.
COSD=COSD.
PRGEND
TITLE SIN. %4.(235) SIN AND COSINE ROUTINES
SUBTTL ED YOURDAN/KK/DMN
SUBTTL D. TODD /DRT/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM V.020
;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
;IF THE ARGUMENT IS IN DEGREES, THE PROPER ENTRY POINTS ARE
;SIND AND COSD, WHILE IF THE ARGUMENT IS IN RADIANS, THE
;PROPER ENTRY POINTS ARE SIN AND COS.
;COSD CALLS SIND TO CALCULATE SIND(PI/2+X)
;COS CALLS SIN TO CALCULATE SIN (PI/2+X)
;SIND CALLS SIN AFTER A CONVERSION FROM DEGREES TO RADIANS.
;THIS ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
;THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
;THE QUADRANT OF THE ORIGINAL ARGUMENT.
;000 - 1ST QUADRANT
;001 - 2ND QUADRANT
;010 - 3RD QUADRANT
;011 - 4TH QUADRANT
;THE ALGORITHM USES A MODIFIED TAYLOR SERIES TO CALCULATE
;THE SINE OF THE NORMALIZED ARGUMENT.
;THE ROUTINES ARE CALLED IN THE FOLLOWING MANNER:
; JSA Q,SIN (OR COS,SIND, OR COSD)
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
SEARCH FORPRM
A=0
B=1
C=2
Q=16
HELLO (COSD,.) ;[235] ENTRY TO COSINE DEGREES ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
FADR B,CD1 ;ADD 90 DEGREES.
FDVR B,SCD1 ;CONVERT TO RADIANS.
JFCL ;SUPPRESS ERROR MESSAGE FROM OVTRAP.
JRST S1 ;ENTER SINE ROUTINE.
HELLO (SIND,.) ;[235] ENTRY TO SINE DEGREES ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
FDVR B,SCD1 ;CONVERT TO RADIANS
JFCL ;SUPPRESS ERROR MESSAGE ON UNDERFLOW.
JRST S1 ;ENTER SINE ROUTINE.
HELLO (COS,.) ;[235] ENTRY TO COSINE RADIANS ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
FADR B,PIOT ;ADD PI/2.
JRST S1 ;ENTER SINE ROUTINE.
HELLO (SIN,.) ;[235] ENTRY TO SINE RADIANS ROUTINE.
MOVE B,@(Q) ;PICK UP THE ARG.
S1: MOVEM B,SX ;SAVE THE ARG.
MOVMS B ;GET ABS OF ARG.
CAMG B,SP2 ;SIN(X)=X IF X<2^-9.
JRST S3A ;EXIT WITH ARG. IN A.
MOVEM C,SC ;SAVE AC C.
FDV B,PIOT ;DIVIDE X BY PI/2.
CAMG B,ONE ;IS X/(PI/2) < 1.0 ?
JRST S2 ;YES,ARG IN 1ST QUADRANT ALREADY.
MULI B,400 ;NO,SEPARATE FRACTION AND EXP.
LSH C,-202(B) ;GET X MODULO 2PI.
TLZ C,(1B0) ;SUPRESS ERROR MESSAGE FROM OVTRAP.
MOVEI B,200 ;PREPARE FLOATING FRACTION.
ROT C,3 ;SAVE THREE BITS TO DETERMINE QUADRANT.
LSHC B,33 ;ARGUMENT NOW IN THE RANGE (-1,1).
FAD B,SP3 ;NORMALIZE THE ARGUMENT.
JUMPE C,S2 ;REDUCED TO 1ST QUAD IF BITS 000.
TLCE C,1000 ;SUBTRACT 1.0 FROM ARG IF BITS ARE
FSB B,ONE ;001 OR 011.
TLCE C,3000 ;CHECK FOR FIRST QUADRANT, 001.
TLNN C,3000 ;CHECK FOR THIRD QUADRANT, 010.
MOVNS B ;001,010.
S2: SKIPGE SX ;CHECK SIGN OF ORIGINAL ARG.
MOVNS B ;SIN(-X)=-SIN(X).
MOVEM B,SX ;STORE REDUCED ARG.
FMPR B,B ;CALCULATE X^X
MOVE A,SC9 ;GET 1ST CONSTANT.
FMP A,B ;MULTIPLY BY X^2
FAD A,SC7 ;ADD IN NEXT CONSTANT.
FMP A,B ;MULTIPLY BY X^2.
FAD A,SC5 ;ADD IN NEXT CONSTANT.
FMP A,B ;MULTIPLY BY X^2.
FAD A,SC3 ;ADD IN NEXT CONSTANT.
FMP A,B ;MULTIPLY BY X^2.
FAD A,PIOT ;ADD IN LAST CONSTANT.
S2B: FMPR A,SX ;MULTIPLY BY X.
SKIPA C,SC ;RESTORE AC C.
S3A: MOVE A,SX ;ANSWER IN X.
GOODBY (1) ;EXIT
SC3: 577265210372
SC5: 175506321276
SC7: 606315546346
SC9: 164475536722
SP2: 170000000000
SP3: 0
SX: 0
CD1: 90.0
SCD1: 206712273406
PIOT: 201622077325
SC: 0
ONE: 1.0
END