; ; File: Elems68K2.a ; ; Contains: xxx put contents here (or delete the whole line) xxx ; ; Written by: xxx put name of writer here (or delete the whole line) xxx ; ; Copyright: © 1983-1990 by Apple Computer, Inc., all rights reserved. ; ; This file is used in these builds: Mac32 ; ; Change History (most recent first): ; ; <3> 9/15/90 BG Removed <2>. 040s are behaving more reliably now. ; <2> 7/4/90 BG Added temporary EclipseNOPs to deal with flakey 040s. ; <1.1> 11/11/88 CCH Fixed Header. ; <1.0> 11/9/88 CCH Adding to EASE. ; <1.1> 5/16/88 BBM FBcc -> FBccL (new macros that donŐt conflict w/ 881) <1.1> ; <1.0> 2/12/88 BBM Adding file for the first time into EASEÉ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; File: Elems68K2.a ;; Implementation of Elems68K for machines using the Motorola MC68881 ;; Copyright Apple Computer, Inc. 1983,1984,1985,1986,1987 ;; All Rights Reserved ;; Confidential and Proprietary to Apple Computer,Inc. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; EXP(x) and EXP2(x) share the same exception code. To compute ; numerical results, express result as 2^K * ((2^frac - 1) + 1), ; and use EXPAPPROX to figure (2^frac - 1). ; EXPTOP BLANKS ON STRING ASIS SUBQ.B #1,D1 ; HAVE SUB #CLINF ALREADY BEQ P1STUFF ; EXP(+-0) IS +1 BGT.S EXPNONZERO TST.W D1 BMI P0STUFF ; EXP(-INF) IS +0 BRA RESULTDELIVERED ; ALREADY HAVE +INF EXPNONZERO BTST #BTLOGBASE2,D3 ; NONZERO IF EXP2X BEQ.S EXPR ; ; 2^T is easy, for general T. ; Set cell W to integer part of T. ; Set T to fraction part of itself. ; Use root computation to evaluate 2^T - 1 with LOGAPPROX; ; add 1 to T, and scale by W. ; EXP2R BSR.S SPLIT2 BRA.S EXPROOT ; ; EXP(T) is just slightly more complicated than EXP2(T) above. ; Let T = K * LN(2) + F ; Then EXP(T) is 2^K + ((2^(F/LN(2)) - 1) + 1). ; So use EXP2ROOT with W set to K and T set to F/LN(2). ; Find F with REM modulo LN(2); then subtract from T and divide by LN(2) ; to get K. ; EXPR BSR SPLIT BSR TESTOFLOW BEQ.S EXPROOT BSR FORCEINEXACT ; EITHER O/UFLOW TST.W D1 ; OPERAND SIGN BPL.S PINFSTUFF ; OFLOW TO +INF BSR CLEAROFLOW BSR FORCEUFLOW BRA P0STUFF ; ; This is the root of V^X where V is 2 or E. ; Compute ((2^T - 1) + 1) * 2*W. EXPAPPROX gives the innermost ; expression. W is presumed to be an integer, possibly huge. ; EXPROOT BSR EXPAPPROX ; 2^T - 1 PEA FPK1 ; (2^T - 1) + 1 PEA (A4) FADDX MOVEA.L A4,A0 ; RESULT PTR LEA STW(A6),A1 ; INTEGER PART BSR SCALBXX BRA RESULTDELIVERED ;ne 100 ; ; Given general number in T, split into integer part in W ; and fraction in T, rounding. ; SPLIT2 MOVEA.L A4,A0 LEA STW(A6),A1 BSR A0TOA1 ; COPY T PEA (A1) ; CELL W FRINTX ; INTEGER PART OF T, ROUNDED BSR CLEARINEXACT ; DON'T RECORD ROUNDING ERROR PEA (A1) ; INTEGER PART PEA (A4) ; ALL OF NUMBER FSUBX RTS ; ; Split T for EXP(x) and EXP(x)-1. ; Let T = K * LN(2) + F. Want W=K and T=F/LN(2). ; Find F with REM modulo LN(2); then subtract from T and divide by LN(2) ; to get K. ; SPLIT MOVEA.L A4,A0 ; T POINTER LEA STW(A6),A1 ; COPY T INTO CELL W BSR A0TOA1 PEA FPKLOGE2 ; NEED 3 COPIES OF LN(2) MOVE.L (SP),-(SP) MOVE.L (SP),-(SP) PEA (A4) FREMX ; T REM LN(2) IN T PEA (A4) PEA (A1) FSUBX ; T - (T REM LN(2)) IN W PEA (A1) FDIVX ; T - (T REM...) / LN(2) PEA (A1) FRINTX ; MAKE SURE IT'S AN INT PEA (A4) FDIVX ; (T REM LN(2)) / LN(2) BRA CLEARINEXACT ; ...AND EXIT ;ne 100 ; ; EXP(x)-1 and EXP2(x)-1 share the same exception code. Then both exploit ; EXPAPPROX for the root computation 2^frac - 1. ; EXP1TOP SUBQ.B #1,D1 ; SUBTRACTED #CLINF BEFORE BGT.S EXP1FINITE ; FINITE, NONZERO BEQ EXPEASY ; Y^+-0 - 1 IS +-0 TST.W D1 ; TEST SIGN OF INF BMI M1STUFF ; Y^-INF - 1 IS -1 EXPEASY BRA RESULTDELIVERED ; Y^+INF - 1 IS +INF EXP1FINITE ; ; If the number is denormalized, have easy case whether EXP1 or EXP21. ; Have subtracted #CLZERO so far. Subtracting 1 more from D1.B leaves ; 0 if normalized, 1 if denormalized. ; SUBQ.B #1,D1 ; 0-NORM 1-DENORM BTST #BTLOGBASE2,D3 ; NONZERO IF EXP2X BEQ.S EXP1R ; ; As above, for 2^T-1 split T into fraction part in T and integer ; in W, and go to root computation. ; EXP21R TST.B D1 BEQ.S EXP21RNORM PEA FPKLOGE2 ; 2^T-1 IS T*LN(2) FOR TINY T PEA (A4) FMULX EXP1OUT BSR FORCEUFLOW BSR FORCEINEXACT BRA.S EXP1RDONE EXP21RNORM BSR SPLIT2 ; ???? WAS BSR.S BRA.S EXP1ROOT ; ; For E^T-1, split T into K and F/LN(2), where T = K*LN(2) + F. ; If overflow, then force INF or -1... ; EXP1R TST.B D1 BNE.S EXP1OUT ; E^T-1 IS T, WITH UFLOW FOR NOW BSR.S SPLIT BSR TESTOFLOW BEQ.S EXP1ROOT BSR FORCEINEXACT ; EITHER O/UFLOW TST.W D1 ; OPERAND SIGN BPL PINFSTUFF ; OFLOW TO +INF BSR CLEAROFLOW ; LEAVE INEXACT SET BRA M1STUFF ; FORCE -1 ; ; This is the root of V^X-1 where V is 2 or E. ; Compute (2^T - 1) for fraction T. Then if (integer) W is ; nonzero, finish off with (((2^T - 1) + 1) * 2^W) - 1. ; EXP1ROOT BSR EXPAPPROX ; 2^T - 1 PEA FPK0 PEA STW(A6) FCMPX FBEQS EXP1RDONE PEA FPK1 ; (2^T - 1) + 1 PEA (A4) FADDX MOVEA.L A4,A0 ; RESULT PTR LEA STW(A6),A1 ; INTEGER PART BSR SCALBXX ; ((2^T - 1) + 1) * 2^W PEA FPK1 ; FINALLY, SUBTRACT 1 PEA (A4) FSUBX ; ; Reset underflow, which cannot occur if W (as in 2^W) is nonzero. ; BSR CLEARUFLOW EXP1RDONE BRA RESULTDELIVERED ; ne 100 ; ; Compute approximate (2^T - 1) for T in (A4). ; Uses cells X and Y, regs D0-D2/A0-A2. ; Expression has the form ; ( 2 * T * P(T*T) ) / ( Q(T*T) - (T * P(T*T)) ) ; One special case: if T is 0, just return 0, and don't set ; the inexact flag. ; EXPAPPROX PEA FPK0 ; COMPARE INPUT WITH 0 PEA (A4) FCMPX FBNES EXPHARD RTS ; EASY IF 0 EXPHARD LEA STY(A6),A1 ; CELL Y MOVEA.L A4,A0 BSR A0TOA1 ; COPY INPUT T PEA (A1) PEA (A1) FMULX ; T^2 INTO CELL Y LEA STX(A6),A0 ; PLACE P(Y) INTO X LEA EXP21P,A1 ; EXPONENT P COEFS LEA STY(A6),A2 ; VAR IS T^2 IN Y BSR POLYEVAL PEA STX(A6) PEA (A4) FMULX ; T * P(T^2) IN RESULT LEA STX(A6),A0 ; PLACE Q(Y) INTO X LEA EXP21Q,A1 LEA STY(A6),A2 BSR POLYEVAL PEA (A4) PEA STX(A6) FSUBX ; Q(Y) - T*P(Y) PEA FPK2 ; 2.0 PEA (A4) ; Y*P(Y) FMULX PEA STX(A6) PEA (A4) FDIVX ; ; Finally, set inexact and clear any underflow messages. ; BSR FORCEINEXACT BRA CLEARUFLOW ; AND EXIT... ; ; ;ne 100 ; ; Raise extended dst to integer src power. ; XPWRITOP MOVEA.L D4,A0 ; SRC PTR MOVE.W (A0),D2 ; I OVERWRITES BOGUS CLASS BEQ P1STUFF ; ANY^0 IS 1 SUBQ.B #1,D1 ; #CLINF ALREADY SUBTRACTED BGT.S FINPWRI ; GT MEANS NONZERO^I ; ; Get here if INF^I or 0^I. If I is negative, must reciprocate ; (signaling div by 0 in case of 0^-N). If I is even, must clear ; sign. ; ASR.W #1,D2 ; GET ODD BIT OF I INTO C,X BCS.S @1 ; CARRY SET IF ODD BCLR #7,(A4) ; ABS OF DST (LEAVES X BIT ALONE) @1 ADDX.W D2,D2 ; REGAIN ORIGINAL VALUE I BPL RESULTDELIVERED ; (INF OR ZERO)^POS ???? WAS BPL.S TST.B D1 ; INF OR ZERO? BPL.S ZPWRNEG TST.B (A4) BPL P0STUFF ; +INF^NEG IS +0 BRA M0STUFF ; -INF^NEG IS -0 ZPWRNEG TST.B (A4) BPL DIVP0STUFF ; +0^NEG IS +INF BRA DIVM0STUFF ; -0^NEG IS -INF ; ; NONZERO^I is broken into two cases: ; If I is small, then just multiply out. Note that sign perseveres if ; I is odd. ; Otherwise, convert I to extended and evaluate with exponentials. ; FINPWRI MOVE.W D2,D0 ; ABS(D2) --> D0 BPL.S @1 NEG.W D0 @1 CMPI.W #SMALLEXP,D0 BHI.S XPWRBIG ; USE LOG AND EXP BSR.S XPWRK ; MULTIPLY OUT BRA RESULTDELIVERED ; ; Integer power is too large to multiply out, so convert to extended ; and use general x^y routine. Make copy of integer in cell W. ; XPWRBIG MOVE.W (A4),-(SP) ; SAVE SIGN OF INPUT BCLR #7,(A4) ; ABS(DST) IN T MOVE.L D4,-(SP) ; ADRS OF INT PEA STW(A6) ; ADRS OF CELL W MOVE.L (SP),D4 ; PRETEND IT'S SRC FI2X ; CONVERT INT TO EXT IN W BSR XPWRY ; COMPUTE (A4)^(D4) ; ; Note that XPWRY must preserve the integer value in D2. ; MOVE.W (SP)+,D0 ; RETRIEVE SIGN OF INPUT BPL.S @3 ; IF POSITIVE, DON'T CARE ASR.W #1,D2 ; LOW BIT TO CARRY BCC.S @3 BSET #7,(A4) ; NEGATE OUTPUT @3 BRA RESULTDELIVERED ;ne 100 ; ; Raise T to the power D2, leaving the result in (A4). D0 = abs(D2). ; If D2 is negative, evaluate the positive power and reciprocate at ; the end. Know D2 is nonzero. Sign of (A4) is propagated correctly. ; Trash A0, A1, D0, and cells I, W and X. ; XPWRK MOVEA.L A4,A0 ; COPY T LEA STX(A6),A1 ; INTO CELL W BSR A0TOA1 BSR.S XPWRKLOOP ; ; Now that loop is finished, produce 1 * T^|I| or 1 / T^|I|, depending ; on sign of I. If overflow or underflow has occurred and I is negative, ; redo computation with pre-reciprocated T. ; TST.W D2 ; IS I NEGATIVE? BMI.S XPWRKDIV XPWRKSTORE MOVEA.L A1,A0 ; T^|I| MOVEA.L A4,A1 ; RESULT ADRS BRA A0TOA1 ; T <-- T^|I|, AND EXIT XPWRKDIV LEA FPK1,A0 LEA (A4),A1 ; LOSE ADRS OF CELL X FROM LOOP BSR A0TOA1 ; T <-- 1 BSR TESTUFLOW BNE.S XPWRKCLEAR BSR TESTOFLOW BNE.S XPWRKCLEAR PEA STW(A6) ; W = T^|I| FROM XPWRKLOOP PEA (A4) ; RES=1 FDIVX RTS XPWRKCLEAR BSR CLEAROFLOW BSR CLEARUFLOW PEA STX(A6) ; SAVED INPUT T ATOP T^|I| PEA (A4) FDIVX MOVE.W D2,D0 ; GET K AGAIN BPL.S @11 NEG.W D0 @11 BSR.S XPWRKLOOP BRA.S XPWRKSTORE ; ; Input: D0 = positive integer K ; A4 = X ; Output: A1 = W = X^K ; Uses: cell W, A0 ; Trashes: D0 XPWRKLOOP LEA FPK1,A0 LEA STW(A6),A1 BSR A0TOA1 ; SEED RESULT WITH 1.0 BRA.S XKLPENTRY XKLPTOP PEA (A4) PEA (A4) FMULX ; T^(2^(I+1)) XKLPENTRY LSR.W #1,D0 ; GET LOW BIT INTO C BCC.S XKLPSKIP PEA (A4) ; T^(2^I) PEA (A1) ; RESULT SO FAR FMULX XKLPSKIP TST.W D0 ; ANY MORE BITS? BNE.S XKLPTOP RTS ;ne 100 ; ; Simple routine to compute (A4)^(D4) into (A4). ; Know that (A4) is positive. Know that the FMULX will never ; encounter 0 * INF, so extreme cases, like INF^3, will be handled ; correctly. Fixed to use temp X while computing, in case sources and ; dest are the same. ; XPWRY MOVEA.L A4,A0 ; COPY DST ARG LEA STX(A6),A1 BSR A0TOA1 ; CELL X <-- INPUT X PEA (A1) ; X = INPUT MOVE.W #FOLOG2X,-(SP) IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; LOG2((A1)) ENDIF IF FPFORLISA THEN BSR elems68k ENDIF MOVE.L D4,-(SP) PEA (A1) FMULX ; (D4) * LOG2((A1)) PEA (A1) MOVE.W #FOEXP2X,-(SP) IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; (A1) ^ (D4) ENDIF IF FPFORLISA THEN BSR elems68k ENDIF MOVEA.L A1,A0 MOVEA.L A4,A1 BRA A0TOA1 ;ne 100 ; ; General function x^y is beset by exceptional cases. ; XPWRYTOP TST.W D1 ; IS X=DST NEG? BMI.S NEGPWRY BSR XPWRYCOM BRA RESULTDELIVERED ; ; Signal X^Y error and stuff a NAN. Special entry accommodates branches from ; within subroutines, in which case a return address must be popped. ; XPWRY9ERR ADDQ.L #4,SP ; KILL RETURN ADDRESS XPWRYERR BSR CLEARINEXACT ; SIGNAL INVALID ONLY MOVEQ #NANPOWER,D0 BRA ERRORNAN ; ; If X is negative, check that Y is integral; otherwise error. ; Save parity of Y to fix sign at end of XPWRYCOM. ; NEGPWRY TST.B D2 ; Y CLASS - INF BEQ.S XPWRYERR MOVEA.L D4,A0 ; Y=SRC LEA STW(A6),A1 ; CELL W TEMP BSR A0TOA1 PEA (A1) ; Y=SRC FRINTX ; ROUND TO INTEGER BSR TESTINEXACT BNE XPWRYERR ; ; NEG ^ INT requires that parity of Y be saved in cell J for later ; setting of sign. To find low bit of floating integer, divide by ; 2 and test inexact. ; PEA FPK2 ; 2.0 PEA (A1) ; CELL W FDIVX ; W/2 PEA (A1) FRINTX ; STRIP OFF ODD BIT OF W PEA STJ(A6) FGETENV ; SAVE FLAGS BSR CLEARINEXACT BCLR #7,(A4) ; ABS((A4)) BSR XPWRYCOM ; ABS((A4))^(D4) ; ; Fix sign of power, according to parity of Y. The parity is stored in ; the inexact flag, saved in cell J. It's in the high byte so just to ; a bit test. ; BTST #FBINEXACT,STJ(A6) BEQ.S @1 BCHG #7,(A4) ; NEGATE IF ODD (INEXACT) @1 BRA RESULTDELIVERED ;ne 100 ; ; Common routine to raise (A4) to (D4) power. ; Know (A4) >= 0 and (D4) is not a NAN. ; Have class codes, less CLINF, in D1 and D2, respectively. ; Can run through 2 ^ Y*LOG2(X) code so long as won't multiply ; INF and 0 to compute exponent. As a minor detail, if Y is 0 or INF, ; clear any inexact that may have been set by LOG2(X). ; ; Since this is called as a subroutine, exits to XPWRYERR must have a special ; pop for the return address. ; XPWRYCOM SUBQ.B #1,D1 ; CLINF ALREADY SUBTRACTED BNE.S NONPWRY ; ; 0 ^ some ; SUBQ.B #1,D2 ; CLINF ALREADY SUBTRACTED BEQ XPWRY9ERR ; 0^0, 0^INF ERRORS, WITH RTS POP TST.W D2 ; SIGN OF Y BPL.S @1 ; ; 0 ^ nonzero ; BSR FORCEDIVZER ; SIGNAL DIV BY ZERO LEA FPKINF,A0 BRA.S @2 @1 LEA FPK0,A0 @2 MOVEA.L A4,A1 ; RESULT PTR BRA A0TOA1 ; STUFF RESULT AND EXIT ; ; nonzero ^ some ; NONPWRY BPL.S FINPWRY ; EXIT IF X FINITE ; ; inf ^ some ; SUBQ.B #1,D2 ; CLINF ALREADY SUBTRACTED BNE.S XPWRYOK BRA XPWRY9ERR ; INF^O IS AN ERROR ; ; finite ^ some ; FINPWRY SUBQ.B #1,D2 BPL.S XPWRYOK ; FIN ^ FIN IS OK ; ; finite ^ inf has the special case 1^INF which is an error. ; PEA FPK1 PEA (A4) FCMPX FBEQL XPWRY9ERR ; <1.1> ; ; Finally, compute finite^reasonable and return. ; Two cases: if exponent is a small integer, then just multiply; ; else use log and exp. To check for an integer, try converting to ; 16 bits. Overflow is Invalid, rounding error is Inexact. ; Must reset Invalid, but if Inexact the result will be anyway. ; Save D2=YClass in D6 across possible call to XPWRK. ; XPWRYOK MOVE.W D2,D6 ; COPY OF Y'S CLASS LESS CLNORM MOVE.L D4,-(SP) ; EXPONENT ADDRESS PEA STI(A6) ; INTEGER CELL I FX2I ; CONVERT TO INTEGER BSR TESTINVALID ; X2I OFLOW IS INVALID SNE D7 BSR CLEARINVALID ; CLEAR UNDESERVED ERROR BSR TESTINEXACT ; MAY HAVE JUST ROUNDED OFF SNE D1 OR.B D1,D7 ; EITHER ERROR? BNE.S XPWRYHARD MOVE.W STI(A6),D2 ; GET INTEGER TO REG. MOVE.W D2,D0 BPL.S @1 NEG.W D0 @1 CMPI.W #SMALLEXP,D0 BLE XPWRK ; DO IT AS INTEGER AND EXIT XPWRYHARD BSR CLEARINEXACT BSR XPWRY TST.B D6 ; CHECK FOR Y 0 OR INF BMI CLEARINEXACT ; AND RETURN FROM THERE RTS ;ne 100 ; ; Compute dst <-- (1 + src2)^src r = src2 n = src ; Watch for special cases: ; src2 < -1 is invalid ; else src = 0 yields 1 ; else src2 = 0 and src = INF is invalid ; else src = INF yields 0 or INF according to src2 ; else src2 = -1 yields 0, 1, or INF according to src ; else actually compute (1 + r)^n !! ; COMPOUNDTOP PEA FPKM1 ; -1 MOVE.L D5,-(SP) ; SRC2 FCMPX FBULTL ERRFINAN ; UNORDERED OR LESS THAN -1 <1.1> FBGTL CMPGTM1 ; <1.1> ; ; Get here if SRC2 is -1. Check SRC (D2) for 0 or nonzero. ; SUBQ.B #1,D2 ; CLINF ALREADY SUBTRACTED BNE.S CMPM1N CMPTOZERO BRA P1STUFF ; (1 + SOME)^0 IS +1 CMPM1N MOVEA.L D4,A0 ; CHECK SIGN OF SRC TST.B (A0) BMI DIVP0STUFF ; (1 - 1)^NEG IS +INF CMPZERO BRA P0STUFF ; (1 - 1)^POS IS +0 ; ; Get here if SRC2 (r) is > -1. ; CMPGTM1 SUBQ.B #1,D2 ; CLINF ALREADY SUBTRACTED BEQ.S CMPTOZERO ; (1 + SOME)^0 IS +1 BGT.S CMPTOFIN ; GO DO (1 + SOME)^FINITE ; ; Get here if (1 + SOME)^INF. Check for 1^INF, an error, else have ; INF or 0 according to SRC and SRC2. ; SUBQ.B #1,D1 ; CLINF ALREADY SUBTRACTED BEQ.S ERRFINAN EOR.W D2,D1 ; GET XOR OF SRC, SRC2 SIGNS BMI.S CMPZERO ; SIGNS DIFFER --> ZERO BRA PINFSTUFF ; SIGNS SAME --> +INF ; ; Finally, compute (1 + reasonable)^finite with the usual... ; CMPTOFIN LEA STX(A6),A1 ; CELL X MOVEA.L D5,A0 ; R = SRC2 BSR A0TOA1 ; COPY R TO X MOVE (a1),d0 ; D0 gets sign/exponent of R. BCLR #15,d0 ; Clear sign. CMP #$3f7f,d0 ; Exponent -64. BLT.S cmpbasee ; Natural log/exp for tiny ; exponents. ; COMPOUND BASE 2. PEA (A1) MOVE.W #FOLOG21X,-(SP) IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; LOG2(1 + (A1)) ENDIF IF FPFORLISA THEN BSR elems68k ENDIF MOVE.L D4,-(SP) ; N = SRC ADDRESS PEA (A1) ; LOG2(1+R) FMULX ; N * LOG2(1+R) PEA (A1) MOVE.W #FOEXP2X,-(SP) BRA.S cmpresult cmpbasee ; COMPOUND BASE E. MOVE.L D4,-(SP) ; N = SRC ADDRESS PEA (A1) ; LOG2(1+R) FMULX ; N * LOG2(1+R) PEA (A1) MOVE.W #FOEXPX,-(SP) cmpresult BSR clearuflow ; Irrelevant! IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; EXP2 OR EXPE((A1)) ENDIF IF FPFORLISA THEN BSR elems68k ENDIF MOVEA.L A1,A0 ; CELL X MOVEA.L A4,A1 BSR A0TOA1 BRA RESULTDELIVERED ; ; Routine to stuff the financial NAN and go. ; ERRFINAN MOVEQ #NANFINAN,D0 BRA ERRORNAN ;ne 100 ; ; Compute annuity factor: ; ( 1 - (1 + r)^-n ) / r ; for r = SRC2 and n = SRC. ; Multitudinous special cases handled piece by piece. ; ANNUITYTOP PEA FPKM1 ; -1 MOVE.L D5,-(SP) ; R = SRC2 FCMPX ; R VS. -1 FBULTL ERRFINAN ; R < -1 IS AN ERROR <1.1> FBNES ANNOK ; ; Get here if have (1 - 1)^ANY. Just check n = SRC. ; SUBQ.B #1,D2 ; CLINF ALREADY SUBTRACTED BEQ.S ANN0 ; ANN(-1, 0) IS +0 TST.W D2 ; CHECK SIGN OF NONZERO N BPL DIVP0STUFF ANNM1 BRA M1STUFF ; ; Know that R=SRC2 exceeds -1. Check first for N=SRC=0. ; ANNOK SUBQ.B #1,D2 ; CLINF ALREADY SUBTRACTED BNE.S ANNXN ANN0 BRA P0STUFF ; ; Now check for unusual, 0 or INF, R=SRC2. ; ANNXN SUBQ.B #1,D1 ; CLINF ALREADY SUBTRACTED BGT.S ANNROK BLT.S ANNRINF ; ; R=SRC2=0. Limit gives result of N=SRC. ; ANNSRC MOVEA.L A4,A1 ; DST PTR MOVEA.L D4,A0 ; SRC=N PTR BSR A0TOA1 BRA RESULTDELIVERED ; ; R=SRC2=+INF. If N=SRC is nonnegative have 0, else test N=SRC versus -1. ; ANNRINF TST.W D2 ; IT'S NONZERO, JUST TEST SIGN BPL.S ANN0 ; FORCE +0 PEA FPKM1 ; -1 MOVE.L D4,-(SP) ; SRC FCMPX FBEQL ANNM1 ; N = -1, STUFF -1 <1.1> FBGTL M0STUFF ; <1.1> BRA MINFSTUFF ; ; Way down here, we have R=SRC2 a normal or denormal number. ; Last check is for N=SRC=INF. ; ANNROK TST.B D2 ; (CLINF + 1) ALREADY SUB BPL.S ANNDOIT EOR.W D2,D1 ; DO R AND N SIGNS MATCH BMI ANNSRC MOVEA.L D5,A0 ; ADDRESS OF 4=SRC2, DIVISOR LEA STX(A6),A1 BSR A0TOA1 PEA (A1) ; FOR DIVIDE BELOW MOVEA.L A4,A1 LEA FPK1,A0 BSR A0TOA1 ; DST <-- +1 PEA (A1) ; ADDRESS OF DST FDIVX ; RESULT IS 1/R BRA RESULTDELIVERED ; ; Finally, compute ( 1 - (1 + r)^-n ) / r. ; Distinguish two cases: ; r normal: ; log2(1 + r) ; n * log2(1 + r) ; -n * log2(1 + r) ; 2^(...) - 1 ; 1 - 2^(...) ; (1 - 2^(...)) / r ; ; r denormal: ; log(1 + r) is about r ; n * r ; -n * r ; e^(...) - 1 ; 1 - e^(...) ; (1 - e^(...)) / r ; Use D1.B, from which CLZERO has already been subtracted. ; Subtracting one more (CLNORMAL) leaves D1.B 0 for normal, 1 for denormal. ; ANNDOIT LEA STX(A6),A1 ; CELL X FOR TEMP MOVEA.L D5,A0 ; SRC2 PTR BSR A0TOA1 MOVE (a1),d0 ; D0 gets sign/exponent of R. BCLR #15,d0 ; Clear sign. CMP #$3f7f,d0 ; Exponent -64. BLT.S annbasee ; Natural log/exp for tiny ; exponents. ; Annuity base two. PEA (A1) ; X MOVE.W #FOLOG21X,-(SP) IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; LOG2(1 + R) ENDIF IF FPFORLISA THEN BSR elems68k ENDIF MOVE.L D4,-(SP) ; N=SRC PTR PEA (A1) FMULX ; N * LOG2(1 + R) BCHG #7,(A1) ; -(N * LOG2(1 + R)) CMP #$4007,(a1) BLT.S @1 ; Branch if exp(-n*log(1+r)) not huge. MOVE.L d5,a0 CMP #$407f,(a0) BGE.S annspecial ; Branch if r huge. @1 PEA (A1) MOVE.W #FOEXP21X,-(SP) BRA.S annresult annbasee ; Annuity base e. MOVE.L D4,-(SP) ; N=SRC PTR PEA (A1) FMULX ; N * LOG2(1 + R) BCHG #7,(A1) ; -(N * LOG2(1 + R)) PEA (A1) MOVE.W #FOEXP1X,-(SP) annresult IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; (1 + R)^-N - 1 ENDIF IF FPFORLISA THEN BSR elems68k ENDIF BCHG #7,(A1) ; 1 - (1 + R)^-N MOVE.L D5,-(SP) ; R=SRC2 PEA (A1) FDIVX ; ( 1 - (1 + R)^-N ) / R annclear BSR CLEARUFLOW BSR CLEAROFLOW MOVEA.L A1,A0 ; SET UP REGS FOR CLASS BSR CLASSIFY SUBQ.B #FCINF,D0 ; IS IT INF? BNE.S @1 BSR FORCEOFLOW BRA.S ANNDOUT @1 SUBQ.B #2,D0 ; IS IT NORMAL? BEQ.S ANNDOUT BSR FORCEUFLOW ANNDOUT LEA STX(A6),A0 ; STORE TO DESTINATION MOVEA.L A4,A1 BSR A0TOA1 BRA RESULTDELIVERED annspecial MOVEA.L D5,A0 ; SRC2 PTR BSR A0TOA1 PEA (A1) ; X := r MOVE.W #FOLOG2X,-(SP) IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; x := LOG2( R) ENDIF IF FPFORLISA THEN BSR elems68k ENDIF LEA sty(a6),a1 MOVE.L d4,a0 BSR a0toa1 ; Y gets N. PEA fpk1 PEA (a1) FADDX ; Y gets N+1. PEA (A1) LEA stx(a6),a1 ; A1 gets X again. PEA (a1) FMULX ; x gets (n+1) * LOG2( R) BCHG #7,(A1) ; -(N+1) * LOG2( R) PEA (A1) MOVE.W #FOEXP2X,-(SP) IF FPFORMAC+FPFORDEBUG THEN BSR ELEMS68K ; ( R)^-(n+1) ENDIF IF FPFORLISA THEN BSR elems68k ENDIF BCHG #7,(A1) ; - (R)^-(N+1) BRA.S annclear ;ne 100