Macintosh-SW/supermario
1
0
Fork 0
mirror of https://github.com/elliotnunn/supermario.git synced 2025-02-20 10:28:57 +00:00
Code Issues Projects Releases Wiki Activity
supermario/base/SuperMarioProj.1994-02-09/Toolbox/SANE/FP881Arith.a
Elliot Nunn 2e16381318 Bring in sources, and document
2019-06-29 23:17:50 +08:00

979 lines
25 KiB
Plaintext
Raw Blame History

;
; File: FP881Arith.a
;
; Contains: Implementation of FP69K arithmetic functions calling an MC68881
;
; Written by: Clayton Lewis et al
;
; Copyright: © 1985-1990 by Apple Computer, Inc., all rights reserved.
;
; This file is used in these builds: Mac32
;
; Change History (most recent first):
;
; <3> 9/17/90 BG Removed <2>. 040s are behaving more reliably now.
; <2> 7/4/90 BG Added EclipseNOPs for flakey 040s.
; <1.1> 11/11/88 CCH Fixed Header.
; <1.0> 11/9/88 CCH Adding to EASE.
; <1.0> 2/12/88 BBM Adding file for the first time into EASE…
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; File: FP881arith.a
;; Implementation of FP68K arithmetic functions calling MC68881.
;; Copyright Apple Computer, Inc. 1985,1986,1987
;; All Rights Reserved
;; Confidential and Proprietary to Apple Computer,Inc.
;;
;; Written by Clayton Lewis, begun 8 Feb 85.
;; Debugged by Stuart McDonald.
;;
;; Modification history:
;; Rev2: 16 May 85
;; Rev3: 17 May 85
;; Rev5: 27 May 85
;; Rev9: 17 Jun 85
;; Rev10:19 Dec 85 streamline convert and scalb in concert with FPCtrl
;; Rev11:16 Jun 86 CRL moved to MPW
;; Rev12:29 Sep 86 Made E2{int,long} handle {NaN,Inf,Out-of-range} ala SANE. -S.McD.
;; 29 Sep 86 Fixed spurious inexact in X2C's NanCreated. -S.McD.
;; 26 Dec 86 Comp2X no longer stomps on its input. -S.McD.
;; 27 Dec 86 Changes to ExitArgs routines: -S.McD.
;; 1) Added entry ExitProcExit for ProcExit finale;
;; 2) Now restore FPSR/FPCR before halt check.
;; 3) CompareCtnd now returns CCR in A1 instead of D1.
;; 05 Jan 87 Fixed Classify; now handles DENORMALNUMs properly. -S.McD.
;; 05 Jan 87 Scalb doesn't truncate subnormals to zero anymore. -S.McD.
;; 05 Jan 87 Logb now handles zero and INF properly. -S.McD.
;; 07 Jan 87 Scalb two days ago was buggy. Fixed now. -S.McD.
;; 11 Jan 87 Scalb doesn't truncate huge numbers to INF anymore. -S.McD.
;; 15 Jan 87 Changed status and copyright information. -S.McD.
;; 21 Jan 87 Cleaned up CompareCtnd code. -S.McD.
;; 21 Jan 87 Cleaned up CPXxxx entries. -S.McD.
;; 21 Jan 87 Cleaned up MoveQuot. -S.McD.
;; 21 Jan 87 Cleaned up NaNInput. -S.McD.
;; 23 Jan 87 Sqrt,Add,Div,Mul,Rem now return Apple's NaN codes. -S.McD.
;; 29 Jan 87 Apple NaN logic speeded up. -S.McD.
;; 29 Jan 87 Tossed FSCALE. It prematurely UNFLs/OVFLs on A93N mask. -S.McD.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ADDITION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to the stack,
;; add and branch to common exit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FADD.X (SP)+,FP0
BRA Return2Args
ADDdbl
FADD.D (A0),FP0
BRA Return2Args
ADDsgl
FADD.S (A0),FP0
BRA Return2Args
ADDint
FADD.W (A0),FP0
BRA Return2Args
ADDlong
FADD.L (A0),FP0
BRA Return2Args
ADDcomp
BSR Comp2X
FADD.X FP1,FP0
BRA Return2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SUBTRACTION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SUBext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to the stack,
;; subtract and branch to common exit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FSUB.X (SP)+,FP0
BRA Return2Args
SUBdbl
FSUB.D (A0),FP0
BRA Return2Args
SUBsgl
FSUB.S (A0),FP0
BRA Return2Args
SUBint
FSUB.W (A0),FP0
BRA Return2Args
SUBlong
FSUB.L (A0),FP0
BRA Return2Args
SUBcomp
BSR Comp2X
FSUB.X FP1,FP0
BRA Return2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MULTIPLICATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MULext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to the stack,
;; multiply and branch to common exit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FMUL.X (SP)+,FP0
BRA Return2Args
MULdbl
FMUL.D (A0),FP0
BRA Return2Args
MULsgl
FMUL.S (A0),FP0
BRA Return2Args
MULint
FMUL.W (A0),FP0
BRA Return2Args
MULlong
FMUL.L (A0),FP0
BRA Return2Args
MULcomp
BSR Comp2X
FMUL.X FP1,FP0
BRA Return2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DIVISION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DIVext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to the stack,
;; divide and branch to common exit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FDIV.X (SP)+,FP0
BRA Return2Args
DIVdbl
FDIV.D (A0),FP0
BRA Return2Args
DIVsgl
FDIV.S (A0),FP0
BRA Return2Args
DIVint
FDIV.W (A0),FP0
BRA Return2Args
DIVlong
FDIV.L (A0),FP0
BRA Return2Args
DIVcomp
BSR Comp2X
FDIV.X FP1,FP0
BRA Return2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPARISON
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CMPext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to the stack,
;; compare and branch to common exit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FCMP.X (SP)+,FP0
BRA.S CompareCtnd
CMPdbl
FCMP.D (A0),FP0
BRA.S CompareCtnd
CMPsgl
FCMP.S (A0),FP0
BRA.S CompareCtnd
CMPint
FCMP.W (A0),FP0
BRA.S CompareCtnd
CMPlong
FCMP.L (A0),FP0
BRA.S CompareCtnd
CMPcomp
BSR Comp2X
FCMP.X FP1,FP0
CompareCtnd
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collect the 68881 status and reset 68020 CCR
;; as appropriate for the comparison.
;; Note: the Z bit must be checked before N since the
;; 68881 can set both N&Z for zeros and infinities.
;; ; put CCR in A1. -S.McD. 12/27/86
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
FBNE.W @2 ; Are they equal?
MOVEA.W #ZBIT,A1 ; if so, set Z in CCR
BRA Exit2Args ; and exit
@2
FBUGE.W @4 ; If not, do they compare LESSTHAN?
MOVEA.W #XNCBITS,A1 ; if so, set X,N,C in CCR
BRA Exit2Args ; and exit
@4
FBULE.W @8 ; If not, do they compare GREATERTHAN?
SUBA.W A1,A1 ; if so, clear CCR bits
BRA Exit2Args ; and exit
@8
; If not, they must be UNORDERED.
MOVEA.W #VBIT,A1 ; set V in CCR
BRA Exit2Args ; and exit
CPXext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to the stack,
;; compare and branch to common exit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FCMP.X (SP)+,FP0
FBST.W CompareCtnd ; always, setting BSUN if unordered.
CPXdbl
FCMP.D (A0),FP0
FBST.W CompareCtnd ; always, setting BSUN if unordered.
CPXsgl
FCMP.S (A0),FP0
FBST.W CompareCtnd ; always, setting BSUN if unordered.
CPXint
FCMP.W (A0),FP0
FBST.W CompareCtnd ; always, setting BSUN if unordered.
CPXlong
FCMP.L (A0),FP0
FBST.W CompareCtnd ; always, setting BSUN if unordered.
CPXcomp
BSR Comp2X
FCMP.X FP1,FP0
FBST.W CompareCtnd ; always, setting BSUN if unordered.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REMAINDER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
REMext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to the stack,
;; calculate remainder and branch to common exit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FREM.X (SP)+,FP0
BRA.S MoveQuot
REMdbl
FREM.D (A0),FP0
BRA.S MoveQuot
REMsgl
FREM.S (A0),FP0
BRA.S MoveQuot
REMint
FREM.W (A0),FP0
BRA.S MoveQuot
REMlong
FREM.L (A0),FP0
BRA.S MoveQuot
REMcomp
BSR Comp2X
FREM.X FP1,FP0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collect the quotient from the 68881 status register,
;; convert from signed-magnitude to two's-complement,
;; and exit through standard back end.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MoveQuot
FMOVE FPSR,D0 ; gather QUOT
SWAP D0 ; move to low order byte
BCLR #7,D0 ; is QUOT negative?
BEQ.S @2 ; if not, skip negate code
NEG.B D0
@2
EXT.W D0 ; word's worth
MOVE.L D0,-22(A6) ; overwrite saved value of D0 in stackframe
BRA Return2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONVERSIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CVText2E
CVTE2ext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source address to A0, dest address to A1.
;; Then copy source to dest.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MOVE.L (A0)+,(A1)+
MOVE.L (A0)+,(A1)+
MOVE.W (A0),(A1)
BRA Exit2Args
CVTdbl2E
FMOVE.D (A0),FP0
BRA Return2Args
CVTsgl2E
FMOVE.S (A0),FP0
BRA Return2Args
CVTint2E
FMOVE.W (A0),FP0
BRA Return2Args
CVTlong2E
FMOVE.L (A0),FP0
BRA Return2Args
CVTcomp2E
BSR Comp2X
FMOVE.X FP1,FP0
BRA Return2Args
CVTE2dbl
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FMOVE.X (SP)+,FP0
FMOVE.D FP0,(A1)
BRA Exit2Args
CVTE2sgl
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FMOVE.X (SP)+,FP0
FMOVE.S FP0,(A1)
BRA Exit2Args
CVTE2int
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FMOVE.X (SP)+,FP0
FMOVE.W FP0,(A1)
FMOVE FPSR,D0 ; {NaN,Inf,Out-of-Range} -> -2^15. -S.McD.
BTST #OPERR,D0 ; OPERR error?
BEQ.S @1 ; if not, branch;
MOVE.W #$8000,(A1) ; otherwise, stuff -2^15
BCLR #$3,D0 ; and clear inx.
FMOVE D0,FPSR
@1
BRA Exit2Args
CVTE2long
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FMOVE.X (SP)+,FP0
FMOVE.L FP0,(A1)
FMOVE FPSR,D0 ; {NaN,Inf,Out-of-Range} -> -2^31. -S.McD.
BTST #OPERR,D0 ; OPERR error?
BEQ.S @1 ; if not, branch;
MOVE.L #$80000000,(A1) ; otherwise, stuff -2^31 and clear inx.
BCLR #$3,D0
FMOVE D0,FPSR
@1
BRA Exit2Args
CVTE2comp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CVTE2comp expects src address in A0 and dst address in A1.
;; Move source to FP0 and test for input NaN.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FMOVE.X (SP)+,FP0
FBOR.W FromD2B
BRA.S NaNInput ; if not ordered, then input was NaN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Not NaN, round to integral value.
;; Is exponent too large for comp ( >62 ),
;; if so, deliver NaN,
;; else shift significand right by (62-exp).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
FromD2B
; "fp881b2dc.a" uses this entry point, too.
FINT FP0,FP0
FGETEXP FP0,FP1
FSUB.W #62,FP1 ; ( exp-62 ) --> FP1
FBOLE.W @1 ; if exp≤62 then create comp value
BRA.S NaNCreated ; if exp>62 then create comp NaN
@1
MOVE.L D2,A0 ; use D2 as temp for next 9 instructions
FMOVE.X FP0,-(SP) ; move rounded value to stack
FMOVE.W FP1,D2 ; move ( exp-62 ) to D2
ADDQ.L #4,SP ; point to significand
NEG.W D2 ; ( 62-exp ) in D2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Right shift significand.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MOVE.L (SP)+,D1 ; significand.HI
MOVE.L (SP)+,D0 ; significand.LO
@2
LSR.L #1,D1
ROXR.L #1,D0
DBF D2,@2
MOVE.L A0,D2 ; restore D2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Comp now in D1-D0. Adjust sign if necessary.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
FTEST FP0
FBOGE.W Deliver
NEG.L D0
NEGX.L D1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Deliver to caller and return.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Deliver
MOVE.L D1,(A1)+
MOVE.L D0,(A1)
BRA Exit2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Return NaN. Set invalid if NaN was created here.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
NaNCreated
FMOVE FPSR,D0
BSET #7,D0
BCLR #3,D0 ; Clear inexact for NaNs. -S.McD.
FMOVE D0,FPSR
NaNInput
MOVEQ #0,D0
MOVEQ #1,D1
ROR.L #1,D1
BRA.S Deliver
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SQUARE ROOT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SQRText
FSQRT.X FP0,FP0
BRA Return1Arg
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ROUND TO INTEGRAL VALUE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
RINText
FINT.X FP0,FP0
BRA Return1Arg
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TRUNCATE TO INTEGRAL VALUE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
TINText
FINTRZ FP0,FP0
BRA Return1Arg
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCALB
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Algorithm for computing X*2^N:
;;
;; sum := X's exponent field + N;
;; if 0 < sum < $7fff then ... usual case
;; begin
;; X's exponent field := sum;
;; return X;
;; end
;; else if sum >= $7fff then ... potential overflow case
;; begin ... note: subnormal inputs can't OVFL.
;; X's exponent field := $7ffe; ... note: N=$7fff if X's expo is $0000.
;; return X * 2; ... note: 881 post-normalizes for us.
;; end
;; else if sum =< 0 then ... potential underflow case
;; begin
;; p := max (sum,-65);
;; X's exponent field := $0000;
;; return X * 2^p;
;; end;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SCALBext
FBEQ.W Return2Args ; return zero for zero*2^n. -S.McD.
FBUN.W Return2Args ; return NaN for NaN*2^n. -S.McD.
MOVEA.L LKADR2(A6),A0
MACHINE MC68020
BFEXTU (A1){1:15},D0 ; exponent field -> D0
MACHINE MC68000
CMP.W #$7fff,D0
BEQ.W Return2Args ; return INF for INF*2^n. -S.McD.
MOVE.W (A0),D1 ; n -> D1
EXT.L D1 ; sign extend n
ADD.L D1,D0 ; exponent field + (sign extended) n -> D0
BLE.S SumTooSmall ; more work to do if sum =< 0
CMPI.L #$7fff,D0
BGE.S SumTooBig ; more work to do if sum >= 7fff
; otherwise, stuff sum into exponent field and rtn
ADDQ.L #6,A1 ; begin
MOVE.L (A1),-(SP)
MOVE.L -(A1),-(SP) ; "Push 96 bit X"
SUBQ.L #2,A1
MOVE.L (A1),-(SP) ; end
MACHINE MC68020
BFINS D0,(SP){1:15} ; stuff sum into exponent field
MACHINE MC68000
FMOVE.X (SP)+,FP0 ; pop into FP0 and return.
BRA Return2Args
;; Note: The below code is avoiding three hardware problems on the A93N mask 881:
;; (1) for subnormal returns, FSCALE always returns zero;
;; (2) for normal returns, FSCALE prematurely underflows,
;; e.g. cb5d00009d826f102a1c8e3c * 2^ffffb4fc returns
;; 800000000000000000000000 when it should return
;; 805900009d826f102a1c8e3c;
;; (3) for normal returns, FSCALE prematurely overflows,
;; e.g. 946200009b1eede9a0958520 * 2^4c25 returns
;; ffff00000000000000000000 when it should return
;; e08700009b1eede9a0958520.
;; -S.McD. 1/28/87
SumTooBig:
FMOVEM.X FP0,-(SP) ; push input X
MOVE.W #$7ffe,D0
MACHINE MC68020
BFINS D0,(SP){1:15} ; X's exponent field <- 7ffe
MACHINE MC68000
FMOVEM.X (SP)+,FP0 ; FP0 = X with exponent field 7ffe
FADD.X FP0,FP0 ; return 2 * FP0
BRA Return2Args
SumTooSmall:
FMOVEM.X FP0,-(SP) ; push input X
CMP #-65,D0 ; sum >= -65?
BGE.S @1 ; if so, keep sum.
MOVE.L #-65,D0 ; otherwise, use -65 for p.
; i.e. D0 = p = max(sum,-65)
@1
; begin constructing float 2^p
; add float bias. e.g., for p=-65=bf,
ADD.L #$7f,D0 ; ffffffbf+0000007f -> 0000003e
LSL.W #7,D0 ; 0000003e -> 00001f00
SWAP D0 ; 00001f00 -> 1f000000.
; Claim: 2^p as a float is now in D0.
FMOVE.S D0,FP0 ; D0 = 2^p -> FP0
MACHINE MC68020
BFCLR (SP){1:15} ; X's exponent field <- 0000
MACHINE MC68000
FMUL.X (SP)+,FP0 ; return X * 2^p
BRA Return2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOGB
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
LOGBexT
FBNE.W @1 ; Is FP0 zero? -S.McD. NOTE: assumes FPCC is set.
FLOG2 FP0 ; If so, signal divide-by-zero and return -INF.
BRA Return1Arg
@1
FMOVE FPSR,D0
BTST #25,D0 ; Is FP0 INF? -S.McD.
BEQ.S @2 ; if not, do usual get exponent.
FABS FP0 ; otherwise
BRA Return1Arg ; return INF for +-INF.
@2
FGETEXP FP0,FP0
BRA Return1Arg
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CLASSIFY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CLASSext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move the source value to FP0.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MOVEA.L LKADR2(A6),A0 ; address of ext source
MOVEA.L LKADR1(A6),A1 ; address of integer dest.
ADDQ.L #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ.L #2,A0
MOVE.L (A0),-(SP)
FMOVE.X (SP)+,FP0
MACHINE MC68020
BFEXTU (A0){1:16},D1 ; exponent field+1bit to D1. -S.McD.
MACHINE MC68000
BRA.S TestIt
CLASSdbl
MOVEA.L LKADR2(A6),A0 ; address of dbl source
MOVEA.L LKADR1(A6),A1 ; address of integer dest.
FMOVE.D (A0),FP0
MACHINE MC68020
BFEXTU (A0){1:11},D1 ; exponent field to D1. -S.McD.
MACHINE MC68000
BRA.S TestIt
CLASSsgl
MOVEA.L LKADR2(A6),A0 ; address of sgl source
MOVEA.L LKADR1(A6),A1 ; address of integer dest.
FMOVE.S (A0),FP0
MACHINE MC68020
BFEXTU (A0){1:8},D1 ; exponent field to D1. -S.McD.
MACHINE MC68000
BRA.S TestIt
CLASScomp
MOVEA.L LKADR2(A6),A0 ; address of comp source
MOVEA.L LKADR1(A6),A1 ; address of integer dest.
BSR.S Comp2X
FMOVE.X FP1,FP0
MOVEQ #-1,D1 ; non-zero exponent to D1. -S.McD.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check for zero, infinity, or nan.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
TestIt
FMOVE FPSR,D0
BTST #26,D0 ; is it zero?
BEQ.S @2
MOVEQ #ZERO,D1 ; if so, return class = zero
BRA.S SignCheck
@2
BTST #25,D0 ; is it infinity?
BEQ.S @4
MOVEQ #INFINITY,D1 ; if so, return class = infinity
BRA.S SignCheck
@4
BTST #24,D0 ; is it QNaN OR SNaN?
BEQ.S @8
FMOVE FPCR,D1
BTST #14,D1 ; if so, check signalling
BEQ.S @6
MOVEQ #SNAN,D1 ; if signal, return class = snan
BRA.S SignCheck
@6
MOVEQ #NAN,D1 ; if no signal return class = qnan
BRA.S SignCheck
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check for norms & denorms.
;; Use the stack but don't bother to clean up.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@8
TST.W D1 ; Is the exponent field zero? -S.McD.
BNE.S @10 ; if not, then normal. -S.McD.
MOVEQ #DENORM,D1 ; else denormal
BRA.S SignCheck
@10
MOVEQ #NORMAL,D1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check sign.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SignCheck
BTST #27,D0
BEQ.S @1
NEG.W D1
@1
MOVE.W D1,(A1)
BRA.S Exit2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Comp2X moves a comp value from (A0) to FP1.
;; Destroys D1 and uses the address passed in A0.
;; Presents a non-normal number to the 68881 with abs(comp) in
;; significand, sign bit set properly, and exponent 63.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Comp2X
TST.L (A0)
BPL.S @2
CLR.L -(SP) ; begin
MOVE.L 4(A0),D1 ; "NEG.L 4(A0),-(SP)"
SUB.L D1,(SP) ; end -S.McD.
; begin "NEGX.L (A0),-(SP)"
ROXR.L #1,D1 ; X bit --> sign bit
SMI D1 ; D1.B := $FF if X=1,
MACHINE MC68020 ; := $00 if X=0.
BFEXTS D1{24:8},D1 ; sign extended D1.B to .L
MACHINE MC68000 ; That is,
MOVE.L D1,-(SP) ; PUSH.L -1 for X=1,
; 0 for X=0.
MOVE.L (A0),D1 ; -S.McD.
SUB.L D1,(SP) ; end "NEGX.L (A0),-(SP)"
BPL.S @1 ; all ok if no longer negative
CLR.L 4(SP) ; else comp nan
MOVE.L #$40140000,(SP) ; $7FFF (0000) 4014 0000 0000 0000
MOVE.L #$7FFF0000,-(SP)
BRA.S @3
@1
MOVE.L #$C03E0000,-(SP) ; sign -, exponent 63, junk word
BRA.S @3
@2
MOVE.L 4(A0),-(SP)
MOVE.L (A0),-(SP)
MOVE.L #$403E0000,-(SP) ; sign +, exponent 63, junk word
@3
FMOVE.X (SP)+,FP1
RTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Return2Args and Return1Arg move an extended result from FP0 via the
;; stack to the destination (whose address is in A1), then clears the
;; stack and returns to caller.
;;
;; Exit2Args and Exit1Arg just clear the stack and return without
;; returning a value.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Exit1Arg
MOVEQ #STKREM1,D0
LEA LKADR1(A6),A0
BRA.S Exit2
Exit2Args
MOVEQ #STKREM2,D0
LEA LKADR2(A6),A0
BRA.S Exit2
Exit3Args
MOVEQ #STKREM3,D0
LEA LKADR3(A6),A0
BRA.S Exit2
Return1Arg
MOVEQ #STKREM1,D0
LEA LKADR1(A6),A0
BRA.S Exit
Return3Args
MOVEQ #STKREM3,D0
LEA LKADR3(A6),A0
BRA.S Exit
Return2Args
MOVEQ #STKREM2,D0
LEA LKADR2(A6),A0
Exit
FMOVEM.X FP0,-(SP)
Exit1
MOVE.W (SP)+,(A1)+
ADDQ.L #2,SP
MOVE.L (SP)+,(A1)+
MOVE.L (SP)+,(A1)
Exit2
MOVE.W D0,LKCNT(A6) ; final stack adjust
Exit3
FMOVE FPSR,D0
BTST #OPERR,D0 ; Have we signaled invalid?
BNE.S AppleNaN ; if so, branch to Apple NaN check.
AppleNaNRtn
MOVE.W D0,D1
SWAP D5
OR.B D5,D0
FMOVE D0,FPSR
ExitProcEx
; FP881NONARITH.A's ProcEx uses this entry point.
SWAP D5
MOVEQ #0,D0
MOVE.W D5,D0
FMOVE D0,FPCR ; high half of D0 is zero at this point. -S.McD.
LSR.W #8,D0 ; shift halt-enables to lo byte
BEQ.S PastHalter ; if none enabled then skip halt check
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Halt check.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ASR.B #2,D1 ; [inv/inv/inv/of/uf/dz/x2/0] xcps in D1
AND.B D0,D1 ; any halt-enable intersections?
BEQ.S PastHalter ; if not, skip halt code
HaltCode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make the FP68K halt stack frame.
;; Save & restore A0 (end of stack frame ptr).
;; Set up stack frame:
;; ------------------
;; Pending D0 - long
;; -----------------
;; Pending CCR - word
;; ------------------
;; halts^xcps - word < ----
;; ------------------ ^
;; MISC rec ptr ----------->
;; ------------------
;; SRC2 addr - long
;; ------------------
;; SRC addr - long
;; ------------------
;; DST addr - long
;; ------------------
;; opcode - word
;; ------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MOVE.L A0,-(SP) ; save A0 so halt handler can't trash it
MOVE.L -22(A6),-(SP) ; pending D0
MOVE.W A1,-(SP) ; pending CCR
MOVEQ #$1F,D0 ; set mask for lo 5 bits
LSR.B #1,D1 ; move halts&exceptions to low bits
AND.B D1,D0 ; show only 5 bits
MOVE.B ToSANE(PC,D0),D0 ; place in SANE order
MOVE.W D0,-(SP) ; halts&exceptions to stack frame
MOVE.L SP,-(SP) ; push pointer to stuff now on stack (MISC REC)
MOVE.L LKADR3(A6),-(SP) ; &SRC2
MOVE.L LKADR2(A6),-(SP) ; &SRC
MOVE.L LKADR1(A6),-(SP) ; &DST
MOVE.W LKOP(A6),-(SP) ; Opcode
MOVEA.L #FPSTATE,A1
MOVEA.L 2(A1),A1 ; haltvector
JSR (A1) ; transfer to user halt handler routine
MOVE.L (SP)+,A1 ; pending CCR from stack frame->A1.lo (junk->A1.hi)
MOVE.L (SP)+,-22(A6) ; pending-D0 from stack frame -> saved regs
MOVE.L (SP)+,A0 ; restore A0 saved at top of halt code
PastHalter
MOVE.L LKRET(A6),(A0) ; put return address at end of stack frame
MOVE.W A1,D1 ; -S.McD. 12/27/86
MOVE D1,CCR ; (only) compare operations return meaningful CCR
MOVEA.L (A6),A6 ; unlink
MOVEM.L (SP)+,D0/D1/D5/A0/A1 ; restore registers
ADDA.W (SP),SP ; clear stack leaving only &return
RTS
;; Invalid has been signaled. Replace +,-,*,/,REM,Sqrt NaNs with Apple NaNs.
AppleNaN
MOVE.W LKOP(A6),D1 ; Opcode -> D1
ROR.B #1,D1 ; Halve opcode and branch on odd parity.
BMI.S AppleNaNRtn ; Odd? must be non-Arith. Done.
CMPI.B #9,D1 ; ROR leaves +,-,*,/,rem,sqrt as 0,1,2,3,6,9.
BGT.S AppleNaNRtn ; Cmp,cmpx,conv,conv are 4,5,7,8.
;; Case +,-,*,/,cmp,cmpx,rem,conv,conv,sqrt, is handled by the following mapping:
;; 0 1 2 3 4 5 6 7 8 9 is mapped to
;; 2 2 8 4 -1 -1 9 -1 -1 1. Neg cases are used for flow, not data.
EXT.W D1 ; zero out most significant byte of word
MOVE.B NaNcode(PC,D1.W),D1 ; NaN code byte -> D1
BMI.S AppleNaNRtn ; Nope, didn't want to do anything for 4,5,7,8.
CLR.L (A1) ; clear least significant 32 bits of existing NaN
MOVE.L #$40000000,-(A1) ; set up next 32 bits
OR.B D1,1(A1) ; stuff NaN code byte xx into 40xx0000.
BRA.W AppleNaNRtn
NaNcode
DC.B 02,02,08,04,-1,-1,09,-1,-1,01 ; +,-,*,/,-1,-1,rem,-1,-1,sqrt
Reference in New Issue View Git Blame Copy Permalink