Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50242/pooexp.mac
There are no other files named pooexp.mac in the archive.
00010	        TITLE   POOEXP - POOMAS EXPONENTIAL AS OF 11/30/70.
00020	        SUBTTL  LIFTED FROM FORTRAN.
00030	;
00040	;    MODIFIED TO BLISS CALLING SEQUENCE AND STACK.
00050	;    ASSUMES BLISS RUN-TIME REGISTERS TO BE 0,1,2,3.
00060	;
00070		;TITLE	EXP  V.021
00080		;SUBTTL	8 AUGUST 1969		ED YOURDON/KK
00090
00100	;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION
00110	;IF X<=-89.415..., THE PROGRAM RETURNS ZERO AS THE ANSWER
00120	;IF X>=88.029..., THE PROGRAM RETURNS 377777777777 AS THE ANSWER
00130	;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS:
00140	;EXP(X) = 2**(X*LOG(E)BASE2) = 2**(M+F)
00150	;WHERE M IS AN INTEGER AND F IS A FRACTION
00160	;2**M IS CALCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT
00170	;OF THE RESULT OF 2**F. 2**F IS CALCULATED AS
00180
00190	;2**F = 2(0.5+F(A+B*F^2 - F-C(F^2 + D)**-1)**-1
00200
00210	;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
00220	;       PUSH    0,<ARGUMENT>
00230	;       PUSHJ   0,POOEXP
00240	;THE ANSWER IS RETURNED IN THE VALUE REGISTER, ACC. 3.
00250
00260		A=	14;
00270		B=	15;
00280		C=	16;
00290		D=	17;
00300	        SREG=0;
00310	        FREG=2;
00320	        VREG=3;
00330
00340		EXTERNAL BLIPPE;
00350		ENTRY	POOEXP
00360
00370
00380
00390	POOEXP: PUSH    SREG,FREG;    STANDARD BLISS PROLOG.
00400	        HRRZ    FREG,SREG;
00410	        PUSH    SREG,A;       SAVE WORKING REGISTERS.
00420	        PUSH    SREG,B;
00430	        PUSH    SREG,C;
00440	        PUSH    SREG,D;
00450	        ADD     SREG,[1000001];  SPACE FOR ONE LOCAL.
00460	        SETZM   ,5(FREG);       AND ZERO IT.
00470		MOVE	B, -2(FREG);    PICK UP THE ARGUMENT IN B
00480		CAMGE	B,E77		;IS EXP. < -89.41...?
00490		JRST	OUT2		;YES, GO TO EXIT.
00500		CAMG	B,E7		;IS EXP. > +88.029...?
00510		JRST	EXP1		;GO TO STANDARD ALGORITHM.
00520	        PUSH    SREG,ERR;       CALL BLIPPERROR FOR LARGE ARG.
00530	        PUSHJ   SREG,BLIPPE;
00540	        SUB     SREG,[1000001];
00550		HRLOI	VREG, 377777	;GET LARGEST FLOATING NUMBER
00560		JRST	EXIT		;EXIT
00570	OUT2:	PUSH    SREG,ERR;    CALL BLIPPERROR FOR SMALL ARG.
00580	        PUSHJ   SREG,BLIPPE;
00590	        SUB     SREG,[1000001];
00600		MOVEI	VREG,0		;ANSWER IS 0.
00610		JRST    EXIT		;EXIT
00620
00630
00640
00650	EXP1:   MULI	B, 400		;SEPARATE FRACTION AND EXPONENT
00660		TSC	B, B		;GET A POSITIVE EXPONENT
00670		MUL	C, E5		;FIXED POINT MULTIPLY BY LOG2(E)
00680		ASHC	C, -242(B)	;SEPARATE FRACTION AND INTEGER
00690		AOSG	C		;ALGORITHM CALLS FOR MULT. BY 2
00700		AOS	C		;ADJUST IF FRACTION WAS NEGATIVE
00710		HRRM	C, EX1		;SAVE FOR FUTURE SCALING
00720		JUMPG	D,ASHH		;GO AHEAD IF ARG > 0.
00730		TRNN	D,377		;ARE ALL THESE BITS 0?
00740		JRST	ASHH		;YES, GO AHEAD.
00750		ADDI	D,200		;NO, FIX UP.
00760	ASHH:	ASH	D, -10		;MAKE ROOM FOR EXPONENT
00770		TLC	D, 200000	;PUT 200 IN EXPONENT BITS
00780		FADB	D, 5(FREG)	;NORMALIZE, RESULTS TO D AND ES2
00790		FMP	D, D		;FORM X^2
00800		MOVE	A, E2		;GET FIRST CONSTANT
00810		FMP	A, D		;E2*X^2 IN A
00820		FAD	D, E4		;ADD E4 TO RESULTS IN D
00830		MOVE	B, E3		;PICK UP E3
00840		FDV	B, D		;CALCULATE E3/(F^2 + E4)
00850		FSB	A, B		;E2*F^2-E3(F^2 + E4)**-1
00860		MOVE	C,5(FREG)	;GET F AGAIN
00870		FSB	A, C		;SUBTRACT FROM PARTIAL SUM
00880		FAD	A, E1		;ADD IN E1
00890		FDVM	C, A		;DIVIDE BY F
00900		FAD	A, E6		;ADD 0.5
00910	EX1:	FSC	A, 0		;SCALE THE RESULTS
00920	        MOVE    VREG,A;      RESULT TO VAALUE REG.
00930	EXIT:   SUB     SREG,[1000001];   STANDARD EPILOG.
00940	        POP     SREG,D;        RESTORE WORKING REGISTEERS.
00950	        POP     SREG,C;
00960	        POP     SREG,B;
00970	        POP     SREG,A;
00980	        POP     SREG,FREG;
00990	        POPJ    SREG,0;
01000
01010	E1:	204476430062		;9.95459578
01020	E2:	174433723400		;0.03465735903
01030	E3:	212464770715		;617.97226953
01040	E4:	207535527022		;87.417497202
01050	E5:	270524354513		;LOG(E), BASE 2
01060	E6:	0.5
01070	E7:	207540074636		;88.029...
01080	E77:	570232254037		;-89.415986
01090	ERR:    21;        ERROR MESSAGE FOR BLIPPERROR.
01100
01110		END
01120