Trailing-Edge
-
PDP-10 Archives
-
bb-lw55a-bm
-
language-sources/pltmth.mac
There are 39 other files named pltmth.mac in the archive. Click here to see a list.
UNIVERSAL FORMSC %2.(120)
SUBTTL UNIVERSAL FILE TO ASSEMBLE THE FIX/FLOAT FUNCTIONS
SUBTTL D. TODD/DRT/DZN/PAH/HD/RJF 5-Feb-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; 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 PLTPRM
SALL
CUSTVR==0 ;CUSTOMER VERSION
DECVER==5 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==2417 ;DEC EDIT VERSION
SUBTTL REVISION HISTORY
;START OF VERSION 4A
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
;Start of Version 5.1
;2026 Update copyright notice.
;Start of Version 6.0
;2403 New corporate copywrite statement.
;2417 Update copywrite statement to 1988.
IF1,< ;PASS 1 ASSEMBLY ONLY
DEFINE FLT(X)<
ENTRY FLT.'X
SIXBIT /FLT.'X/
FLT.'X:
IFE CPU-KA10,<
HLRE X+1,X ;COPY THE HI HALT OF X TO LOW X+1
HLL X,X+1 ;FILL UPPER PART OF X WITH THE SIGH
FSC X,233 ;FLOAT THE LOW HALT OF THE INTEGER
SKIPGE X ;FOR NEGATIVE NUMBERS
AOJE X+1,FLT.XT ;CHANGE HIGH PART TO 2'S COMPLEMENT
FSC X+1,255 ;FLOAT THE HIGH PART
FADR X,X+1 ;COMBINE THE TWO PARTS
>
IFE CPU-KI10,<
FLTR X,X ;USE THE HARDWARE
>
FLT.XT: POPJ P, ;RETURN X=THE FLOATING POINT NUMBER
>
DEFINE IFX(X)<
ENTRY IFX.'X
SIXBIT /IFX.'X/
IFX.'X:
IFE CPU-KA10,<
MULI X,400 ;SEPERATE THE FRACTION AND EXPONENT
EXCH X,X+1 ;PUT PARTICAL RESULT IN X
JUMPGE X+1,IFX.XT ;JUMP IF POSITIVE
TRC X+1,-1 ;NEGATE THE EXPONENT
MOVNS X ;POSITIVE FRACTION
IFX.XT: ASH X,-243(X+1) ;USE EXPONENT AS INDEX
SKIPGE X+1 ;SKIP IF POSITIVE
MOVNS X ;NEGATE THE RESULT
>
IFE CPU-KI10,<
FIX X,X
>
POPJ P, ;RETRURN X=FIXED NUMBER
>
> ;END OF IF1,
PRGEND
TITLE FLOAT %2.(235) INTEGER TO REAL CONVERSION
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY FLOAT
EXTERN FLOAT.
FLOAT=FLOAT.
PRGEND
TITLE FLOAT. %2.(235) INTEGER TO REAL CONVERSION
SUBTTL D. TODD/DRT/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM LIB40 V32.(415)
;36 BIT FLOAT FUNCTION
;CONVERTS A SIGNED FIXED POINT INTEGER TO FLOATING POINT
;BY BREAKING THE INTEGER INTO HIGH ORDER AND LOW ORDER
;FRACTIONS, CALCULATING AN EXPONENT, THEN ADDING THE TWO
;TOGETHER. SINGLE CONVERSION.
;THE ROUTINE IS CALLED AS FOLLOWS:
; JSA Q, FLOAT
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
IFE HILOW,<
TWOSEG
RELOC 400000>
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (FLOAT,.) ;[235] ENTRY TO FLOAT ROUTINE
MOVE T0,@(L) ;GET THE ARGUMENT
PJRST FLT.0## ;USE FLT.0 ROUTINE
PRGEND
TITLE IFIX %2.(235) REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY IFIX
EXTERN IFIX.
IFIX=IFIX.
PRGEND
TITLE INT %2.(235) REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY INT
EXTERN INT.
INT=INT.
PRGEND
TITLE IFIX. %2.(235) REAL TO INTEGER CONVERSION
SUBTTL D. TODD/DRT/EY/KK/TWE/DMN/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;FROM LIB40 V.32(415)
;36 BIT FIX FUNCTION
;AN INTEGER RESULT IS OBTAINED BY SEPARATING FRACTION AND
;EXPONENT. THE FRACTION IS SHIFTED N PLACES RIGHT, WHERE
;N = 43 - (EXPONENT-200) (OCTAL)
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; JSA Q, IFIX
; EXP ARG
;OR
; JSA Q,INT
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
IFE HILOW,<
TWOSEG
RELOC 400000>
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (INT,.) ;[235] ENTRY TO INT ROUTINE.
JRST IFIX1 ;GO TO MAIN ROUTINE.
HELLO (IFIX,.) ;[235] ENTRY TO IFIX ROUTINE
IFIX1:
MOVE T0,@(L) ;GET THE ARGUMENT
PJRST IFX.0## ;USE IFX.0
PRGEND
TITLE FLT.0
SUBTTL /DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH FORMSC,PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
FLT 0
PRGEND
TITLE FLT.14
SUBTTL /DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH FORMSC,PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
FLT 14
PRGEND
TITLE IFX.0
SUBTTL /DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH FORMSC,PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
IFX 0
PRGEND
TITLE EXP2 %2.(216)
SUBTTL D. TODD/DMN/DRT/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;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.
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY EXP2.. ;%216% ENTRY FROM EXP3.
ENTRY EXP2.0,EXP2.2,EXP2.4,EXP2.6
ENTRY EXP2.
;ACCUMULATOR DEFINITIONS
A= 0
B= 1
C= 2
D= 3
E= 4
F= 5
G= 6
H= 7
SAVEA=10
SAVEB=11
P= 17
IFN F10LIB,<
SIXBIT /EXP2./
EXP2.: MOVE T0,@(L) ;GET THE BASE
MOVE T1,@1(L) ;GET THE EXPONENT
JRST EXP2.0 ;COMMON ROUNTINE
>
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: SAVE <C,SAVEA,SAVEB>
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: RESTOR <SAVEB,SAVEA,C>
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.
LIT
PRGEND
TITLE EXP %2.(235) FLOATING POINT SINGLE PRECISION EXPONENTIAL
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY EXP
EXTERN EXP.
EXP=EXP.
PRGEND
TITLE EXP. %2.(235) FLOATING POINT SINGLE PRECISION EXPONENTIAL
SUBTTL D. TODD/DRT/HPW/EY/KK/DMN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;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
ES2=5
Q= 16
IFE HILOW,<
TWOSEG
RELOC 400000>
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: SAVE <C>
SAVE <D>
SETZ 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
RESTOR <C>
RESTOR <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
LIT
PRGEND
TITLE ALOG %2.(235) LOG ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY ALOG
EXTERN ALOG.
ALOG=ALOG.
PRGEND
TITLE ALOG10 %2.(235) LOG ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
TWOSEG
RELOC 400000
ENTRY ALOG10
EXTERN ALG10.
ALOG10=ALG10.
PRGEND
TITLE ALOG. %2.(235) LOG ROUTINES
SUBTTL D. TODD/KK/DMN/DRT/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;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.
;ALOG IS THE ENTRY POINT FOR LOGE(X), AND
;ALOG10 IS THE ENTRY POINT FOR LOG10(X).
;FOR LOGE(X), THE ALGORITHM IS:
; LOGE(X) = (I + LOG2(F))*LOGE(2)
; WHERE X = (F/2)*2^(I+1), AND LOG2(F) IS GIVEN BY
; LOG2(F) = C1*Z + C3*Z^3 + C5*Z^5 - 1/2
; AND Z = (F-SQRT(2))/(F+SQRT(2))
;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
TEMP=10
LS=11
LZ=12
Q= 16
IFE HILOW,<
TWOSEG
RELOC 400000>
HELLO (ALG10.,ALOG10) ;[235] ENTRY TO LOG TO THE BASE 10 ROUTINE.
SAVE TEMP
MOVE TEMP,@(16) ;GET /X/ IN AC 0.
JUMPE TEMP,LZERO ;CHECK FOR ZERO ARG.
FUNCT ALOG.,<TEMP> ;CALC THE LOG TO THE
FMPR 0,LOG10A ;MULTIPLY IT BY LOG10(E).
RESTOR <TEMP>
GOODBY (1) ;RETURN
LOG10A: 177674557305
HELLO (ALOG,.) ;[235] ENTRY TO LOG TO THE BASE E ROUTINE.
SAVE <LS,LZ>
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.
ASHC A, -33 ;SEPARATE FRACTION FROM EXPONENT
ADDI A, 211000 ;FLOAT THE EXPONENT AND MULT. BY 2
MOVSM A, LS ;NUMBER NOW IN CORRECT FL. FORMAT
MOVSI A, 567377 ;SET UP -401.0 IN A
FADM A, LS ;SUBTRACT 401 FROM EXP.*2
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)
FDV B, A ;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
FMP A, LZ ;MULTIPLY BY Z
FAD A, LS ;ADD IN EXPONENT TO FORM LOG2(X)
FMP A, L7 ;MULTIPLY TO FORM LOGE(X)
RESTOR <LZ,LS>
GOODBY (1) ;RETURN
LZERO: ERROR (APR,5,1,.+1) ;ERROR MESSAGE
MOVE A,MIFI ;PICK UP MINUS INFINITY
RESTOR <LZ,LS>
GOODBY (1) ;RETURN
ZERANS: MOVEI A, 0 ;MAKE ANSWER ZERO
RESTOR <LZ,LS>
GOODBY (1) ;RETURN
;CONSTANTS
ONE: 201400000000
L1: 577225754146 ;-0.707106781187
L2: 201552023632 ;1.414213562374
L3: 200462532521 ;0.5989786496
L4: 200754213604 ;0.9614706323
L5: 202561251002 ;2.8853912903
L7: 200542710300 ;0.69314718056
MIFI: 400000000001 ;LARGEST NEGATIVE FLOATING NUMBER
PRGEND
TITLE SIND %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY SIND
EXTERN SIND.
SIND=SIND.
PRGEND
TITLE COSD %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY COSD
EXTERN COSD.
COSD=COSD.
PRGEND
TITLE SIN %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY SIN
EXTERN SIN.
SIN=SIN.
PRGEND
TITLE COS %2.(235) SIN AND COSINE ROUTINES
SUBTTL H. P. WEISS/HPW/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
IFE HILOW,<
TWOSEG
RELOC 400000>
ENTRY COS
EXTERN COS.
COS=COS.
PRGEND
TITLE SIN. %2.(235) SIN AND COSINE ROUTINES
SUBTTL D. TODD/DRT/HPW/EY/KK/DMN/DZN/PAH 6-Jan-83
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
;ALL RIGHTS RESERVED.
SEARCH PLTPRM
SALL
;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
IFE HILOW,<
TWOSEG
RELOC 400000>
A=0
B=1
C=2
SX=3
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: SAVE SX
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.
SAVE 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.
RESTOR C
SKIPA 0
S3A: MOVE A,SX ;ANSWER IN X.
RESTOR SX
GOODBY (1) ;EXIT
SC3: 577265210372
SC5: 175506321276
SC7: 606315546346
SC9: 164475536722
SP2: 170000000000
SP3: 0
CD1: 90.0
SCD1: 206712273406
PIOT: 201622077325
ONE: 1.0
END