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