PDP-10 Archive: language-sources/pltmth.mac from BB-4172G-BM

Trailing-Edge - PDP-10 Archives - BB-4172G-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)	UNIVERSAL FILE TO ASSEMBLE THE FIX/FLOAT FUNCTIONS
SUBTTL	D. TODD/DRT/DZN	24-Aug-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


SEARCH	PLTPRM
SALL


CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==1		;DEC MINOR VERSION
DECEVR==1220		;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).

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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


SEARCH FORMSC,PLTPRM
SALL

	IFE HILOW,<
	TWOSEG
	RELOC	400000>
FLT 0
PRGEND

TITLE FLT.14
SUBTTL	/DZN	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


SEARCH FORMSC,PLTPRM
SALL

	IFE HILOW,<
	TWOSEG
	RELOC	400000>
FLT 14
PRGEND

TITLE IFX.0
SUBTTL	/DZN	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


SEARCH FORMSC,PLTPRM
SALL

	IFE HILOW,<
	TWOSEG
	RELOC	400000>
IFX 0
PRGEND

TITLE	EXP2	%2.(216)
SUBTTL	D. TODD/DMN/DRT/HPW/DZN	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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/DMN25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


	TWOSEG
	RELOC 400000
ENTRY	ALOG10
EXTERN	ALG10.
ALOG10=ALG10.
PRGEND

TITLE	ALOG.	%2.(235) LOG ROUTINES
SUBTTL	D. TODD/KK/DMN/DRT/HPW/DZN	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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	25-Jul-79


;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


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