mirror of
https://github.com/elliotnunn/sys7.1-doc-wip.git
synced 2024-05-31 13:41:30 +00:00
671 lines
16 KiB
Plaintext
671 lines
16 KiB
Plaintext
;EASE$$$ READ ONLY COPY of file “Elems68K3.a”
|
|
; 1.1 CCH 11/11/1988 Fixed Header.
|
|
; 1.0 CCH 11/ 9/1988 Adding to EASE.
|
|
; OLD REVISIONS BELOW
|
|
; 1.0 BBM 2/12/88 Adding file for the first time into EASE…
|
|
; END EASE MODIFICATION HISTORY
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; File: Elems68K3.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.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; Sine function.
|
|
; Input: A4 = operand T
|
|
; D1 = class (1..6) reduced by #FCINF
|
|
; Output: A4 = result
|
|
; Uses: A0-A2
|
|
;
|
|
;
|
|
; About the argument reduction: T is reduced MOD approximate pi/2,
|
|
; leaving its magnitude no bigger than approximate pi/4.
|
|
; Recall the identities:
|
|
; sin(T) = sin(T)
|
|
; sin(pi/2 + T) = cos(T)
|
|
; sin(pi + T) = -sin(T)
|
|
; sin(3pi/2 + T) = -cos(T)
|
|
; sin(2pi + T) = sin(T)
|
|
; Then if input T = q*(pi/2) + r,
|
|
; q mod 2 determines whether to use sin (0) or cos (1), and
|
|
; q mod 4 determines whether to negate result (2 or 3).
|
|
; Note that KLH takes (q + 128) mod 4; this is because of the
|
|
; braindamaged Pascal MOD function, which cannot handle a negative
|
|
; numerator.
|
|
;
|
|
SINTOP
|
|
|
|
BLANKS ON
|
|
STRING ASIS
|
|
|
|
MOVEQ #NANTRIG,D0 ; ASSUME THE WORST
|
|
MOVEQ #0,D2 ; QUOTIENT ADJUSTMENT
|
|
SUBQ.B #1,D1 ; -1 FOR INF, 0 OR 0, ...
|
|
BEQ RESULTDELIVERED ; SIN(+-0) IS +-0
|
|
SINCOSCOM
|
|
BMI ERRORNAN ; INF IS ILLEGAL
|
|
|
|
;
|
|
; Have finite, nonzero argument.
|
|
;
|
|
BSR.S TRIGREDUCTION ; T <-- T REM PI/2
|
|
BTST #0,D2 ; QUO MOD 2
|
|
BNE.S @1
|
|
BSR.S SINGUTS ; EVEN, USE SIN
|
|
BRA.S @3
|
|
@1
|
|
BSR COSGUTS ; ODD, USE COS
|
|
@3
|
|
ANDI.W #3,D2 ; QUO MOD 4
|
|
SUBQ.W #2,D2 ; >= 0 ONLY IF MOD 2 OR 3
|
|
BMI.S @5
|
|
BCHG #7,(A4) ; NEGATE RESULT
|
|
@5
|
|
|
|
;
|
|
; Common trig finish:
|
|
; Clear uflow, except when denormalized.
|
|
; Set inexact.
|
|
; If result is denormal, set underflow.
|
|
; Exit.
|
|
;
|
|
TRIGFINI
|
|
BSR CLEARUFLOW ; WILL CHECK FOR ERROR LATER
|
|
BSR FORCEINEXACT
|
|
|
|
PEA (A4)
|
|
PEA STI(A6) ; CELL I FOR RETURN CODE
|
|
FCLASSX
|
|
MOVE.W STI(A6),D0 ; -6, -5, ..., -1, 1, ..., 6
|
|
BPL.S @11
|
|
NEG.W D0 ; 1, 2, ..., 6
|
|
@11
|
|
SUBQ.W #FCDENORM,D0 ; LEAVES ZERO IF DENORMAL
|
|
BNE.S @13
|
|
BSR FORCEUFLOW
|
|
@13
|
|
BRA RESULTDELIVERED
|
|
|
|
|
|
;
|
|
; Cosine function.
|
|
; Input: A4 = operand T
|
|
; D1 = class (1..6) reduced by #FCINF
|
|
; Output: A4 = result
|
|
; Uses: A0-A2
|
|
;
|
|
;
|
|
; About the argument reduction: T is reduced MOD approximate pi/2,
|
|
; leaving its magnitude no bigger than approximate pi/4.
|
|
; Recall the identities:
|
|
; cos(T) = cos(T)
|
|
; cos(pi/2 + T) = -sin(T)
|
|
; cos(pi + T) = -cos(T)
|
|
; cos(3pi/2 + T) = sin(T)
|
|
; cos(2pi + T) = cos(T)
|
|
; Then if input T = q*(pi/2) + r,
|
|
; q mod 2 determines whether to use cos (0) or sin (1), and
|
|
; (q+1) mod 4 determines whether to negate result (2 or 3).
|
|
; Note that KLH takes (q + 129) mod 4; this is because of the
|
|
; braindamaged Pascal MOD function, which cannot handle a negative
|
|
; numerator.
|
|
;
|
|
COSTOP
|
|
MOVEQ #NANTRIG,D0 ; ASSUME THE WORST
|
|
MOVEQ #1,D2 ; QUO ADJUSTMENT
|
|
SUBQ.B #1,D1 ; -1 FOR INF, 0 OR 0, ...
|
|
BNE.S SINCOSCOM
|
|
BRA P1STUFF ; COS(+-0) IS 1
|
|
|
|
;
|
|
; Reduce A4 mod approximate pi/2, adding quotient to D2.
|
|
; Input: A4 = operand T
|
|
; D2 = quotient adjustment
|
|
; Output: A4 = reduced argument
|
|
; D2 = adjusted quotient
|
|
; Uses: D0
|
|
;
|
|
TRIGREDUCTION
|
|
PEA FPKPI2 ; APPROXIMATE PI/2
|
|
PEA (A4) ; T
|
|
FREMX ; T REM (PI/2), QUO IN D0
|
|
ADD.W D0,D2
|
|
RTS
|
|
|
|
;ne 100
|
|
;
|
|
; Evaluate sin(T) for reduced |T| <= pi/4.
|
|
; Use approximation (S = T*T) T - (T*S*(P(S) / Q(S)))
|
|
; Input: A4 = T
|
|
; Output: A4 = sin(T)
|
|
; Uses: A0-A2, cells W, X, Y
|
|
; Note use of sin/cos common routine depends on placement of Q coef table
|
|
; immediately before P coef table.
|
|
;
|
|
SINGUTS
|
|
LEA SINQ,A2 ; ADDRESS OF SIN Q TABLE
|
|
BSR.S POVERQ ; X <-- P/Q
|
|
|
|
PEA (A4) ; T
|
|
PEA (A2) ; T*T
|
|
FMULX ; W <-- T * (T*T)
|
|
|
|
PEA (A2) ; W = T^3
|
|
PEA (A0) ; X = P/Q
|
|
FMULX ; X <-- (T * (T*T)) * (P/Q)
|
|
|
|
PEA (A0) ; X
|
|
PEA (A4) ; T
|
|
FSUBX ; RES <-- T - (...)
|
|
RTS
|
|
|
|
|
|
;
|
|
; Common routine for trig functions guts.
|
|
; Input: A4 = operand T
|
|
; A2 = ptr to Q coef table, with P immediately after in memory
|
|
; Output: cell W = T*T
|
|
; cell X = (T*T) * (P(T*T) / Q(T*T))
|
|
; A0 = X
|
|
; A2 = W
|
|
; Uses: A0, A2, cell Y
|
|
;
|
|
T2POVERQ
|
|
BSR.S POVERQ
|
|
|
|
PEA (A2) ; W = T*T
|
|
PEA (A0) ; X = P/Q
|
|
FMULX ; X <-- (T*T) * P(T*T) / Q(T*T)
|
|
RTS
|
|
|
|
;
|
|
; Common routine for trig functions guts.
|
|
; Called by T2POVERQ and ATANGUTS.
|
|
; Input: A4 = operand T
|
|
; A2 = ptr to Q coef table, with P immediately after in memory
|
|
; Output: cell W = T*T
|
|
; cell X = P(T*T) / Q(T*T)
|
|
; A0 = X
|
|
; A2 = W
|
|
; Uses: A0, A2, cell Y
|
|
;
|
|
POVERQ
|
|
MOVEA.L A4,A0 ; T
|
|
LEA STW(A6),A1 ; W
|
|
BSR A0TOA1 ; COPY W <-- T
|
|
|
|
PEA (A1) ; W
|
|
PEA (A1) ; W
|
|
FMULX ; W <-- W*W = T*T
|
|
|
|
EXG A1,A2 ; A1 = Q COEF TABLE, A2 = W
|
|
LEA STY(A6),A0 ; CELL Y
|
|
BSR POLYEVAL ; EVAL Y <-- Q(T*T)
|
|
; LEAVES A1 = P COEF TABLE
|
|
PEA (A0) ; NEED Y FOR P/Q DIVIDE LATER
|
|
|
|
LEA STX(A6),A0 ; CELL X
|
|
BSR POLYEVAL ; EVAL X <-- P(T*T)
|
|
|
|
PEA (A0) ; X
|
|
FDIVX ; X <-- P(T*T) / Q(T*T)
|
|
RTS
|
|
|
|
|
|
;
|
|
; Evaluate cos(T) for reduced |T| <= pi/4.
|
|
; Use approximation (S = T*T):
|
|
; (S < 1/4): 1 - S/2 + S*S*(P(S) / Q(S))
|
|
; else: with Z = |X| - 0.5
|
|
; 0.875 - (Z/2 + (Z*Z/2 - S*S*(P(S) / Q(S))))
|
|
; Input: A4 = T
|
|
; Output: A4 = cos(T)
|
|
; Uses: A0-A2, cells W, X, Y
|
|
; Note use of sin/cos common routine depends on placement of Q coef table
|
|
; immediately before P coef table.
|
|
;
|
|
COSGUTS
|
|
LEA COSQ,A2 ; COS Q COEF TABLE, P THEREAFTER
|
|
BSR.S T2POVERQ ; W <-- T*T, X <-- T*T*P/Q
|
|
|
|
PEA (A2) ; W = T*T
|
|
PEA (A0) ; X = (T*T) * P/Q
|
|
FMULX ; X <-- T^4 * P/Q
|
|
|
|
;
|
|
; Now compare T*T in W with 1/4, to determine which formula to continue with.
|
|
;
|
|
PEA FPKFOURTH ; 1/4
|
|
PEA (A2) ; W
|
|
FCMPX ; COMPARE AS W - 1/4
|
|
FBGTS CGBIG
|
|
|
|
;
|
|
; Finish with first formula above.
|
|
;
|
|
PEA FPKHALF ; 1/2
|
|
PEA (A2) ; W = T*T
|
|
FMULX ; W <-- T*T/2
|
|
|
|
PEA (A2) ; W
|
|
PEA (A0) ; X = T^4 * P/Q
|
|
FSUBX ; X <-- (T^4 * P/Q) - T*T/2
|
|
|
|
MOVEA.L A4,A1 ; A1 = RESULT
|
|
BSR A0TOA1 ; RESULT = CURRENT X
|
|
|
|
PEA FPK1 ; 1
|
|
PEA (A4) ; RESULT
|
|
FADDX ; RES = 1 - T*T/2 + T^4*P/Q
|
|
RTS
|
|
|
|
;
|
|
; Evaluate long form of expression.
|
|
;
|
|
CGBIG
|
|
BCLR #7,(A4) ; RES <-- |T|
|
|
|
|
PEA FPKHALF ; 1/2
|
|
PEA (A4) ; RES
|
|
FSUBX ; RES <-- T' = |T| - 0.5
|
|
|
|
PEA (A0) ; SAVE X FOR LATER SUB
|
|
MOVEA.L A4,A0 ; RES
|
|
MOVEA.L A2,A1 ; W
|
|
BSR A0TOA1 ; W <-- T'
|
|
|
|
PEA FPKHALF ; 1/2
|
|
PEA (A1) ; W
|
|
FMULX ; W <-- T'/2
|
|
|
|
PEA (A1) ; W
|
|
PEA (A4) ; RES
|
|
FMULX ; RES <-- T'*T'/2
|
|
|
|
; X = T^4*P/Q PUSHED ABOVE
|
|
PEA (A4) ; RES
|
|
FSUBX ; RES <-- T'*T'/2 - T^4*P/Q
|
|
|
|
PEA (A1) ; W = T'/2
|
|
PEA (A4) ; RES
|
|
FADDX ; RES <-- T'/2 + (T'*T'/2 ...)
|
|
|
|
BCHG #7,(A4) ; RES <-- -RES
|
|
|
|
PEA FPK78 ; 0.875 = 7/8
|
|
PEA (A4) ; RES
|
|
FADDX ; RES <-- 0.875 + ...
|
|
RTS
|
|
|
|
;ne 100
|
|
;
|
|
; Tangent function.
|
|
; Input: A4 = operand T
|
|
; D1 = class (1..6) reduced by #FCINF
|
|
; Output: A4 = result
|
|
; Uses: A0-A2, D0-D2
|
|
;
|
|
;
|
|
; About the argument reduction: T is reduced MOD approximate pi/2,
|
|
; leaving its magnitude no bigger than approximate pi/4.
|
|
; Recall the identities:
|
|
; tan(T) = tan(T)
|
|
; tan(pi/2 + T) = -1/tan(T)
|
|
; tan(pi + T) = tan(T)
|
|
; Then if input T = q*(pi/2) + r,
|
|
; q mod 2 determines whether to negate and reciprocate tan.
|
|
;
|
|
TANTOP
|
|
MOVEQ #NANTRIG,D0 ; ASSUME THE WORST
|
|
MOVEQ #0,D2 ; NO QUO ADJUSTMENT FOR TAN
|
|
SUBQ.B #1,D1 ; -1 FOR INF, 0 OR 0, ...
|
|
BMI ERRORNAN ; INF IS ILLEGAL
|
|
BEQ RESULTDELIVERED ; TAN(+-0) IS +-0
|
|
|
|
;
|
|
; Have finite, nonzero argument.
|
|
;
|
|
BSR TRIGREDUCTION
|
|
BSR.S TANGUTS
|
|
|
|
;
|
|
; Check q mod 2 ...
|
|
;
|
|
ROR.W #1,D2 ; C BIT <-- QUO MOD 2
|
|
BCC.S @21
|
|
|
|
BCHG #7,(A4) ; NEGATE TAN
|
|
MOVEA.L A4,A0
|
|
LEA STW(A6),A1 ; MOVE TAN FOR RECIPROCAL
|
|
BSR A0TOA1 ; W <-- -TAN
|
|
PEA (A1) ; NEED W FOR DIVIDE
|
|
|
|
LEA FPK1,A0 ; A0 = 1
|
|
MOVEA.L A4,A1 ; RES
|
|
BSR A0TOA1 ; RES <-- 1
|
|
|
|
PEA (A4) ; RES
|
|
FDIVX ; RES <-- -1/TAN
|
|
|
|
; If TAN was 0 in last step, have infinity as result. In this case, copy the
|
|
; sign of the argument onto the resulting infinity. By the nature of the
|
|
; algorithm, flipping the result sign corrects the error.
|
|
|
|
BSR TESTDIVZER
|
|
BEQ.S @21
|
|
|
|
BCHG #7,(A4)
|
|
@21
|
|
BRA TRIGFINI
|
|
|
|
|
|
;
|
|
; Evaluate tan(T) for |T| <= pi/4.
|
|
; Use formulas: (S = T*T)
|
|
; S <= 1/4: T + (T^3/3 + T^5*P(S)/Q*S))
|
|
; else: T' = (T - 3/4)/3
|
|
; T + S/4 + S*(T' + T^3*P(S)/Q(S))
|
|
;
|
|
TANGUTS
|
|
LEA TANQ,A2 ; TAN Q COEFS, P IMMED AFTER
|
|
BSR T2POVERQ ; X <-- T^2*P/Q
|
|
|
|
;
|
|
; Compute T^5*P/Q, common to both formulas; save T^3 in cell Z.
|
|
;
|
|
MOVEA.L A4,A0 ; RES = T
|
|
LEA STZ(A6),A1
|
|
BSR A0TOA1 ; Z = T
|
|
|
|
PEA (A2) ; W = T*T
|
|
PEA (A1) ; Z
|
|
FMULX ; Z = T^3
|
|
|
|
PEA (A1) ; Z = T^3
|
|
LEA STX(A6),A0
|
|
PEA (A0) ; X
|
|
FMULX ; T^5*P/Q
|
|
|
|
;
|
|
; Compare T*T with 1/4 to decide which formula to continue.
|
|
;
|
|
PEA FPKFOURTH ; 1/4
|
|
PEA (A2) ; W = T*T
|
|
FCMPX ; COMPARE AS W - 1/4
|
|
FBGTS TGBIG
|
|
|
|
;
|
|
; Using first, simpler formula.
|
|
;
|
|
PEA FPK3 ; 3
|
|
PEA (A1) ; Z = T^3
|
|
FDIVX ; Z <-- T^3/3
|
|
|
|
PEA (A1) ; Z
|
|
PEA (A0) ; X
|
|
FADDX ; X <-- T^3/3 + T^5*P/Q
|
|
BRA.S TGFIN ; GO ADD TO T AND EXIT
|
|
|
|
;
|
|
; Using more complicated formula.
|
|
;
|
|
TGBIG
|
|
PEA (A0) ; SAVE X ADRS FOR LATER ADD
|
|
|
|
MOVEA.L A4,A0 ; A0 = T
|
|
LEA STY(A6),A1 ; A1 = Y
|
|
BSR A0TOA1 ; Y <-- T
|
|
|
|
PEA FPK34 ; 3/4
|
|
PEA (A1) ; Y
|
|
FSUBX ; Y <-- T - 3/4
|
|
|
|
PEA FPK3 ; 3
|
|
PEA (A1) ; Y
|
|
FDIVX ; Y <-- (T - 3/4)/3
|
|
|
|
PEA (A2) ; W = T*T
|
|
PEA (A1) ; Y = T'
|
|
FMULX ; Y <-- T*T*T'
|
|
|
|
; X = T^5*P/Q ALREADY PUSHED
|
|
PEA (A1) ; Y
|
|
FADDX ; Y <-- T*T*T' + T^5*P/Q
|
|
|
|
PEA FPKFOURTH ; 1/4
|
|
PEA (A2) ; W = T*T
|
|
FMULX ; W <-- T*T/4
|
|
|
|
PEA (A2) ; W
|
|
PEA (A1) ; Y
|
|
FADDX ; Y <-- T*T/4 + T*T*T'/3 + ...
|
|
|
|
MOVEA.L A1,A0 ; SET UP FOR LAST ADD...
|
|
|
|
;
|
|
; Finish off tangent, adding (A0) into T in RES.
|
|
;
|
|
TGFIN
|
|
PEA (A0) ; EITHER X OR Y
|
|
PEA (A4) ; RES = T
|
|
FADDX ; RES <-- T + (...)
|
|
RTS
|
|
|
|
;ne 100
|
|
;
|
|
; Arctan(T) for any -INF <= T <= INF.
|
|
; Input: A4 = operand T
|
|
; D1 = class (1..6) reduced by #FCINF
|
|
; Output: A4 = result
|
|
; Uses: A0-A2, D0-D2
|
|
;
|
|
;
|
|
; About the argument reduction: ATAN(T) is evaluated for 0 <= T <= 1.
|
|
; Recall the identities:
|
|
; atan(T) = atan(T)
|
|
; atan(-T) = -atan(T)
|
|
; atan(1/T) = pi/2 - atan(T)
|
|
; If T < 0 then atan(-T) is computed, and the result negated.
|
|
; If |T| > 1 then atan(1/|T|) is computed, and the result subtracted from pi/2.
|
|
; To compute atan of reduced T use formulas:
|
|
; T <= ATnCons = 0.267... T - T * P(T*T) / Q(T*T)
|
|
; else T - (A + (B*P(B*B)/Q(B*B) + x2fx2))
|
|
; where x2 and x2fx2 are constants, about 0.5 and 0.05, and
|
|
; A = (T - x2)/(1 + (1/(T*x2))), and
|
|
; B = (T - x2)/(1 + (T*x2)).
|
|
;
|
|
ATANTOP
|
|
SUBQ.B #1,D1 ; #FCINF ALREADY SUBTRACTED
|
|
BGE.S ATFINITE
|
|
|
|
LEA FPKPI2,A0 ; GET PI/2
|
|
MOVEA.L A4,A1 ; RESULT FIELD
|
|
BSR A0TOA1
|
|
CLR.B D1 ; ISOLATE SIGN IN HI BIT
|
|
OR.W D1,(A4) ; FORCE SIGN OF RESULT
|
|
BRA.S ATQUICK
|
|
ATFINITE
|
|
BNE.S ATHARD ; ZERO IF RESULT IS ZERO
|
|
ATQUICK
|
|
BRA RESULTDELIVERED
|
|
ATHARD
|
|
BCLR #7,(A4) ; |T|, SIGN IN D1.W
|
|
BSR.S ATANGUTS
|
|
CLR.B D1 ; CLEAR CLASS CODE
|
|
OR.W D1,(A4) ; REPLACE SIGN OF ATAN
|
|
BRA TRIGFINI
|
|
|
|
;
|
|
; Use D2 to store Boolean about whether input T was inverted in order
|
|
; to obtain an argument no bigger than one.
|
|
;
|
|
ATANGUTS
|
|
MOVEQ #0,D2 ; SET TO FALSE
|
|
PEA FPK1 ; 1
|
|
PEA (A4) ; T
|
|
FCMPX ; COMPARE AS T-1
|
|
FBLES AGNOINV
|
|
|
|
MOVEQ #-1,D2 ; SET TO TRUE
|
|
MOVEA.L A4,A0 ; RES = T
|
|
LEA STW(A6),A1 ; CELL W
|
|
BSR A0TOA1 ; W <-- T
|
|
PEA (A1) ; ADRS OF W FOR DIV BELOW
|
|
|
|
LEA FPK1,A0 ; 1
|
|
MOVEA.L A4,A1 ; RES
|
|
BSR A0TOA1 ; RES <-- 1
|
|
|
|
PEA (A1)
|
|
FDIVX ; RES <-- 1/T
|
|
AGNOINV
|
|
;
|
|
; Store a copy of reduced T on stack for later.
|
|
;
|
|
MOVE.L (A4)+,-(SP) ; HI ORDER LONG
|
|
MOVE.L (A4)+,-(SP) ; MED LONG
|
|
MOVE.W (A4),-(SP) ; LOW WORD
|
|
SUBQ.L #8,A4 ; RESTORE RES PTR
|
|
|
|
;
|
|
; Select short or long form based on RES vs ATnCons, about 0.268.
|
|
;
|
|
PEA FPKATNCONS
|
|
PEA (A4) ; RES
|
|
FCMPX ; COMPARE AS RES - ATNCONS
|
|
FBGTS AGLONGFORM
|
|
;
|
|
; Short form.
|
|
;
|
|
LEA ATANQ,A2
|
|
BSR POVERQ ; X <-- P(T*T)/Q(T*T)
|
|
PEA (A0) ; X = P(T*T)/Q(T*T)
|
|
PEA (A4) ; RES = T
|
|
FMULX ; RES <-- T*P/Q
|
|
BRA AGFINI
|
|
|
|
;
|
|
; Long form.
|
|
;
|
|
AGLONGFORM
|
|
MOVEA.L A4,A0 ; RES = T
|
|
LEA STW(A6),A1 ; CELL W
|
|
BSR A0TOA1 ; W <-- T
|
|
|
|
PEA FPKX2 ; X2
|
|
PEA (A1) ; W = T
|
|
FMULX ; W <-- T*X2
|
|
PEA (A1) ; SAVE W FOR DIV BELOW
|
|
|
|
LEA FPK1,A0 ; 1
|
|
LEA STY(A6),A1 ; CELL Y
|
|
BSR A0TOA1 ; Y <-- 1
|
|
|
|
; W = T*X2 PUSHED ABOVE
|
|
PEA (A1) ; Y
|
|
FDIVX ; Y <-- 1/(T*X2)
|
|
|
|
PEA FPK1 ; 1
|
|
PEA (A1) ; Y = 1/(T*X2)
|
|
FADDX ; Y <-- 1 + 1/(T*X2)
|
|
|
|
PEA FPK1 ; 1
|
|
PEA STW(A6) ; W = T*X2
|
|
FADDX ; W <-- 1 + T*X2
|
|
|
|
PEA FPKX2 ; CONSTANT X2
|
|
PEA (A4) ; RES = T
|
|
FSUBX ; RES <-- T-X2
|
|
|
|
MOVEA.L A4,A0 ; RES = T-X2
|
|
LEA STZ(A6),A1 ; CELL Z
|
|
BSR A0TOA1 ; Z <-- T-X2
|
|
|
|
PEA STW(A6) ; W = 1 + T*X2
|
|
PEA (A4) ; RES = T-X2
|
|
FDIVX ; RES <-- (T-X2)/(1 + T*X2) = B
|
|
|
|
PEA STY(A6) ; Y = 1 + 1/(T*X2)
|
|
PEA (A1) ; Z = T-X2
|
|
FDIVX ; Z <-- (T-X2)/(1+1/(T*X2)) = A
|
|
|
|
LEA ATANQ,A2
|
|
BSR POVERQ ; X <-- P(B*B)/Q(B*B)
|
|
; W <-- B*B, UNUSED
|
|
; Y <-- JUNK
|
|
; Z = A, STILL
|
|
; RES = B, STILL
|
|
|
|
PEA (A0) ; X = P(B*B)/Q(B*B)
|
|
PEA (A4) ; RES = B
|
|
FMULX ; RES <-- B*P/Q
|
|
|
|
PEA FPKX2FX2 ; CONSTANT X2FX2
|
|
PEA (A4) ; RES = B*P/Q
|
|
FADDX ; RES <-- B*P/Q + X2FX2
|
|
|
|
PEA STZ(A6) ; Z = A
|
|
PEA (A4) ; RES = ...
|
|
FADDX ; RES = A + B*P/Q + X2FX2
|
|
|
|
;
|
|
; Finish up by computing:
|
|
; no inversion above: T - RES in RES
|
|
; inversion above: pi/2 - (T - RES) in RES
|
|
; Remember that T was pushed onto stack earlier.
|
|
;
|
|
AGFINI
|
|
LEA STW+8(A6),A1 ; 8 BYTES INTO CELL W
|
|
MOVE.W (SP)+,(A1) ; LOW WORD
|
|
MOVE.L (SP)+,-(A1)
|
|
MOVE.L (SP)+,-(A1) ; W <-- SAVED T
|
|
|
|
PEA (A1) ; W = SAVED T
|
|
PEA (A4) ; RES
|
|
FSUBX ; RES - T
|
|
|
|
TST.W D2 ; NONZERO IF INVERTED
|
|
BNE.S AGSUBPI2
|
|
|
|
BCHG #7,(A4) ; NEGATE TO T-RES
|
|
RTS ; RETURN TO BELOW ATANTOP
|
|
AGSUBPI2
|
|
PEA FPKPI2 ; PI/2
|
|
PEA (A4) ; RES
|
|
FADDX ; PI/2 - (T - RES)
|
|
RTS ; RETURN TO BELOW ATANTOP
|
|
|
|
;ne 100
|
|
;
|
|
; Random number generator. Adapted from "A More Portable FORTRAN Random
|
|
; Number Generator," Linus Schrage, ACM Transactions on Mathematical
|
|
; Software, Vol. 5, No. 2, June 1979, pp. 132-138.
|
|
;
|
|
; NextT <-- ARand * T + PRand
|
|
; where ARand = 7^5 and PRand = 2^31-1
|
|
; X is presumed to be an integer strictly between 0 and 2^31-1.
|
|
; Input: A4 = T
|
|
; Output: A4 = NextT
|
|
; Uses: D0
|
|
;
|
|
RANDTOP
|
|
PEA FPKARAND
|
|
PEA (A4) ; T
|
|
FMULX ; RES <-- T * ARAND
|
|
|
|
PEA FPKPRAND
|
|
PEA (A4) ; RES = T * ARAND
|
|
FREMX ; RES <-- (T * ARAND) REM PRAND
|
|
|
|
TST.B (A4) ; IF RES < 0, MUST ADJUST UP
|
|
BPL.S @1
|
|
|
|
PEA FPKPRAND
|
|
PEA (A4)
|
|
FADDX ; RES <-- (...) + PRAND
|
|
@1
|
|
BRA RESULTDELIVERED
|
|
|
|
|