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/InSANE/FPHWArith.a
Elliot Nunn 2e16381318 Bring in sources, and document
2019-06-29 23:17:50 +08:00

1231 lines
35 KiB
Plaintext
Raw Permalink Blame History

;
; File: FPHWArith.a
;
; Contains: HW Floating Point routines for arithmetic functions of FP68K
;
; Written by: Apple Numerics Group, DSG
;
; Copyright: © 1985-1993 by Apple Computer, Inc., all rights reserved.
;
; Change History (most recent first):
;
; <SM2> 2/3/93 CSS Update from Horror:
; <H2> 9/29/92 BG Rolling in Jon Okada's latest fixes.
; <1> 10/24/91 SAM/KSM Rolled in Regatta file.
;
; Regatta Change History:
;
; <2> 5/28/91 SAM Merged from TERROR [<3> Added Stuart McDonald's latest fixes
; (see below for details)]
; <1> 5/15/91 SAM Split off from TERROR Proj.
;
; Terror Change History:
;
; <2> 1/9/91 BG Corrected an INCLUDE which did not have the filename changed.
; <1> 01/06/90 BG Added to TERROR/BBS for the time.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; File: FP881arith.a
;; Implementation of FP68K arithmetic functions calling MC68881.
;; Copyright Apple Computer, Inc. 1985,1986,1987,1989,1990
;; 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.
;; Rev13:18 Dec 89 Complete rewrite begins. -S.McD.
;; 22 May 90 Goes alpha for waimea. Copyrights updated. -S.McD.
;; 7 Sep 90 Goes beta for Tim. Updated version number. -S.McD.
;; 30 Sep 90 Goes final for Terror alpha. -S.McD.
;; 19 May 91 Fixed spurious flag errors for FMOVEs in trap enabled cases.-S.McD.
;; 21 May 91 After first trap, futher traps MUST be disabled fix. -S.McD.
;; 30 Mar 92 Fixed Scalb bug for SRC = $8000 and replaced FSCALEs with FMULs. - JPO
;; Fixed X2C conversion bug for single/double rounding precision. - JPO
;; Modified Logb to not trap on denormal input. - JPO
;; 6 Apr 92 Modified subroutine COMP2FP1r to correctly handle negative comp
;; input when rounding precision is less than extended. - JPO
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Convert (on stack) source comp to FP1. - DELETED <4/6/92, JPO>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;COMP2FP1r:
; MOVEA.L LKSRC(A6),A0
; ADDQ #4,a0
; MOVE.L (A0),-(SP)
; MOVE.L -(A0),-(SP)
; MOVE.L #$403E403E,-(SP)
; FMOVE.X (SP)+,FP1
; TST.B (A0)
; BPL.S @1
; FSUB.S #"$5f800000",FP1
; FCMP.S #"$df000000",FP1
; FBNE.W @1
; FMOVE.S #"$7fc01400",FP1
;@1: RTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Convert (on stack) source comp to FP1. - New routine avoids
;; loading unnormalized extended values <4/6/92, JPO>
;;
;; Stack: &ret
;; Uses: A0, FP1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
COMP2FP1r:
movem.l d0-d3,-(sp) ; save four D registers, STACK: D0-D3 save < &ret
movea.l LKSRC(a6),a0 ; move comp to D1-D2
move.w #$403e,d0 ; D0.W <- sign/exponent of +2^63
move.l 4(a0),d2 ; D2 <- comp.LO
move.l (a0),d1 ; D1 <- comp.HI
bpl.b @1 ; nonnegative input
neg.l d2 ; comp is negative or NaN: negate comp
or.w #$8000,d0 ; set sign bit in D0.W (doesn't affect X bit)
negx.l d1
bpl.b @1 ; valid negative comp
; comp NaN result is NaN(20)
fmove.s #"$7fc01400",fp1 ; get result into FP1
bra.b @restore ; restore D registers
; unnormalized extended value (may be zero) in D0.W, D1, D2.
@1:
bne.b @2 ; D1 (sig.HI) > 0
exg d1,d2 ; D1 is zero, exchange D1/D2
sub.w #32,d0 ; adjust exponent
bfffo d1{0:32},d3 ; find leading one in D1 (new sig.HI)
beq.b @zero ; zero result
sub.w d3,d0 ; nonzero D1, adjust exponent
suba.w #12,sp ; reserve stack space for result
lsl.l d3,d1 ; normalize significand (D2 <- 0)
move.w d0,(sp) ; write sign/exponent to stack
bra.b @wrsig ; write significand to stack
; zero result (D1, D2 <- 0)
@zero:
fmove.s d1,fp1 ; load result into FP1
bra.b @restore ; restore D registers
; sig.HI > 0
@2:
bfffo d1{0:32},d3 ; find leading one in sig.HI
suba.w #12,sp ; reserve stack space for result
sub.w d3,d0 ; adjust exponent
lsl.l d3,d1 ; shift sig.HI to normalize
move.w d0,(sp) ; write sign/exponent to stack
bfextu d2{0:d3},d0 ; extract high bits to be shifted out of sig.LO
lsl.l d3,d2 ; shift sig.LO
or.l d0,d1 ; insert new low bits into sig.HI
@wrsig:
move.l d2,8(sp) ; write significand to stack
move.l d1,4(sp)
fmove.x (sp)+,fp1 ; pop result into FP1, STACK: D0-D3 save < &ret
@restore:
movem.l (sp)+,d0-d3 ; restore D registers, STACK: &ret
rts ; return
MACRO
COMP2FP1
.* Convert (on stack) source comp to FP1.
BSR.W COMP2FP1r
ENDM
MACRO
SRC2STK
.* Convert 80bit source to 96bits on stack.
MOVEA.L LKSRC(A6),A0
ADDQ #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ #2,A0
MOVE.L (A0),-(SP)
ENDM
MACRO
DST2STK
.* Convert 80bit destination to 96bits on stack.
MOVEA.L LKDST(A6),A0
ADDQ #6,A0
MOVE.L (A0),-(SP)
MOVE.L -(A0),-(SP)
SUBQ #2,A0
MOVE.L (A0),-(SP)
ENDM
MACRO
FOPSRC.&SZ &FOP
IF &SZ = 'X' THEN
&FOP..X (SP),FP0
.*
ELSEIF &SZ = 'C' THEN
&FOP..X FP1,FP0
.*
ELSE
.* All others (.W, .L, .S, .D): operate directly into FP0.
&FOP..&SZ ([LKSRC,A6]),FP0
ENDIF
ENDM
MACRO
POPFOPSRC.&SZ &FOP
IF &SZ = 'X' THEN
&FOP..X (SP)+,FP0
.*
ELSEIF &SZ = 'C' THEN
&FOP..X FP1,FP0
.*
ELSE
.* All others (.W, .L, .S, .D): operate directly into FP0.
&FOP..&SZ ([LKSRC,A6]),FP0
ENDIF
ENDM
MACRO
FPU2DST
.* Convert FP0 to 80bits destination pointed to by A0.
FMOVE.X FP0,(SP)
MOVE.W (SP)+,(A0)+
ADDQ.L #2,SP
MOVE.L (SP)+,(A0)+
MOVE.L (SP)+,(A0)
ENDM
MACRO
FPU2DST8096
BTST #FPX96BIT,LKOP+3(A6); 96 BIT SET?
BEQ.S @1 ; IF NOT, BRANCH: WRITE 80 BIT ANSWER
; WRITE 96 BIT ANSWER CASE:
FMOVE.X FP0,(A0) ; (NOTE: A0 SET IN CORRESPONDING 96 BIT ROUTINE)
BRA.S @2 ; BRANCH: EXIT
@1: ; WRITE 80 BIT ANSWER CASE:
FPU2DST
@2:
ENDM
MACRO
PUSHFPU2DST
.* Convert FP0 to 80bits destination pointed to by A0.
FMOVE.X FP0,-(SP)
MOVE.W (SP)+,(A0)+
ADDQ.L #2,SP
MOVE.L (SP)+,(A0)+
MOVE.L (SP)+,(A0)
ENDM
MACRO
FPU2SRC
.* Convert FP0 to 80bits source pointed to by A0; A0 unchanged.
.* This macro is used by QNEXTX in file "FP881nonarith.a".
FMOVE.X FP0,-(SP)
MOVE.W (SP)+,(A0)+
ADDQ #2,SP
MOVE.L (SP)+,(A0)+
MOVE.L (SP)+,(A0)
SUBQ #6,A0
ENDM
MACRO
QOP.&SZ &FOP,&OPCODE
.* Link required by trap handler to determine arguments.
LINK A6,#-LK2SIZE
.*
.* Popsize and opcode required by trap handler.
MOVE.L #LK2POP+&OPCODE,LKOP(A6)
.*
MOVE.L A0,-(SP)
IF &SZ = 'X' THEN
.* Convert extended source onto stack.
SRC2STK
.*
ELSEIF &SZ = 'C' THEN
.* Convert comp sources into FP1.
COMP2FP1
ENDIF
IF &FOP <> 'FMOVE' THEN
.* Skip picking up DST if doing a conversion (FMOVE).
DST2STK
.*
IF &SZ = 'X' THEN
FMOVEM.X (SP)+,FP0 ;<5/19/91-S.McD.> <T3>
ELSE
FMOVEM.X (SP),FP0 ;<5/19/91-S.McD.> <T3>
ENDIF
.*
ENDIF
FOPSRC.&SZ &FOP
IF &FOP <> 'FMOVE' THEN
FPU2DST
ELSE
MOVEA.L LKDST(A6),A0
IF &SZ = 'X' THEN
FPU2DST
ELSE
PUSHFPU2DST
ENDIF
ENDIF
MOVE.L (SP)+,A0
UNLK A6
RTD #8
ENDM
MACRO
FPSR2CC
.* Map FPU's CC's to CPU's CC's.
FMOVE.L FPSR,D0
BFEXTU D0{4:4},D0
MOVE (CCMAP,PC,D0*2),CCR
ENDM
MACRO
FPSR2CCX
.* Map FPU's CC's to CPU's CC's AND SIGNAL!
FPSR2CC
FBSF.W CCMAP ; NEVER BRANCHES. SIDE-EFFECT: SIGNALS
FNOP ; FNOP CATCHES SIGNAL BEFORE FINAL RTD
ENDM
MACRO
QCPX.&SZ &FOP,&OPCODE
.*
.* Link required by trap handler to determine arguments.
LINK A6,#-LK2SIZE
.*
.* Popsize and opcode required by trap handler.
MOVE.L #LK2POP+&OPCODE,LKOP(A6)
.*
MOVEM.L D0/A0,-(SP) ; MOVEM USED BECAUSE CCR IS UNAFFECTED
IF &SZ = 'X' THEN
.* Convert extended source onto stack.
SRC2STK
.*
ELSEIF &SZ = 'C' THEN
.* Convert comp sources into FP1.
COMP2FP1
ENDIF
DST2STK
FMOVEM.X (SP)+,FP0 ;<5/19/91-S.McD.> <T3>
POPFOPSRC.&SZ &FOP
FPSR2CCX
MOVEM.L (SP)+,D0/A0 ; MOVEM USED BECAUSE CCR IS UNAFFECTED
UNLK A6
RTD #8
ENDM
MACRO
QCMP.&SZ &FOP,&OPCODE
.*
.* Link required by trap handler to determine arguments.
LINK A6,#-LK2SIZE
.*
.* Popsize and opcode required by trap handler.
MOVE.L #LK2POP+&OPCODE,LKOP(A6)
.*
MOVEM.L D0/A0,-(SP) ; MOVEM USED BECAUSE CCR IS UNAFFECTED
IF &SZ = 'X' THEN
.* Convert extended source onto stack.
SRC2STK
.*
ELSEIF &SZ = 'C' THEN
.* Convert comp sources into FP1.
COMP2FP1
ENDIF
DST2STK
FMOVEM.X (SP)+,FP0 ;<5/19/91-S.McD.> <T3>
POPFOPSRC.&SZ &FOP
FPSR2CC
MOVEM.L (SP)+,D0/A0 ; MOVEM USED BECAUSE CCR IS UNAFFECTED
UNLK A6
RTD #8
ENDM
MACRO
QREM.&SZ &FOP,&OPCODE
.*
.* Link required by trap handler to determine arguments.
LINK A6,#-LK2SIZE
.*
.* Popsize and opcode by trap handler.
MOVE.L #LK2POP+&OPCODE,LKOP(A6)
.*
MOVE.L A0,-(SP)
IF &SZ = 'X' THEN
.* Convert extended source onto stack.
SRC2STK
.*
ELSEIF &SZ = 'C' THEN
.* Convert comp sources into FP1.
COMP2FP1
ENDIF
DST2STK
.*
IF &SZ = 'X' THEN
FMOVEM.X (SP)+,FP0 ;<5/19/91-S.McD.> <T3>
ELSE
FMOVEM.X (SP),FP0 ;<5/19/91-S.McD.> <T3>
ENDIF
FOPSRC.&SZ &FOP
FPU2DST
BSR MOVEQUOT
MOVE.L (SP)+,A0
UNLK A6
RTD #8
ENDM
MACRO
QX2Z.&SZ &FOP,&OPCODE
.*
.* Link required by trap handler to determine arguments.
LINK A6,#-LK2SIZE
.*
.* Popsize and opcode required by trap handler.
MOVE.L #LK2POP+&OPCODE,LKOP(A6)
.*
MOVE.L A0,-(SP)
SRC2STK
IF &SZ = 'C' THEN
; CONVERT EXTENDED TO COMP CODE:
FMOVEM.X (SP),FP0 ; FETCH SRC, AVOIDS SPURIOUS UNFL <5/19/91-S.McD.> <T3>
; Old X2C conversion routines DELETED <3/30/92, JPO>
;
;QX2CENTRY: FTEST.X FP0 ; SNAN SIGNALS, SUBNORMS DON'T <5/19/91-S.McD.> <T3>
; FBOR.W @0 ; NAN? IF NOT, BRANCH: ORDERED <T3>
;
; ; NAN CASE:
; FMOVECR #$32,FP0 ; FP0'S SIGNIFICAND: 8000000000000000
; BRA.S @3 ; BRANCH: WRITE SIGNIFICAND
;
;@0: ; ORDERED CASE:
; FMOVEM.L FPCR/FPSR,-(SP) ; SAVE ENV. TO AVOID SPURIOUS SIGS.
; MOVE.L (SP),-(SP) ; REPLICATE FPCR
; CLR.B 2(SP) ; CLEAR FPCR EXCEPTION ENABLES (FIG.1-1, 881/2 MAN.)
; FMOVE.L (SP)+,FPCR ; DISABLE TRAPPING FOR NEXT OPS
; FINT.X FP0,FP0 ; SPURIOUS INEXACT DISABLED!
;
; FGETEXP FP0,FP1 ; FP1 := BINADE OF FINT(SRC)
;
; FSUB.W #63,FP1 ; |FINT(SRC)| < 2^63?
; FBOLT.W @1 ; IF SO, BRANCH: TYPICAL CASE
;
; ; OUT-OF-RANGE CASE: (RTN COMP NAN)
; FMOVEM.L (SP)+,FPCR/FPSR ; RESTORE ORIGINAL ENVIRONMENT
; FMOVECR #$32,FP0 ; FP0'S SIGNIFICAND: 8000000000000000
; FMOVE.S #"$7FBFFFFF",FP1 ; SIGNAL INVALID USING FLOAT SNAN
; FNOP ; (FNOP CATCHES SIG. BEFORE RTS)
; BRA.S @3 ; BRANCH: WRITE SIGNIFICAND
;
;@1: ; TYPICAL CASE:
; FMOVEM.L (SP)+,FPCR/FPSR ; RESTORE ENVIRONMENT
; FINT.X (SP),FP0 ; RE-FETCH INPUT FOR INEXACT SIG.
; FBUGE.W @2 ; FINT(SRC) >= 0? BRANCH: POS. CASE
;
; ; NEGATIVE CASE:
; FADD.S #"$5f800000",FP0 ; CONVERT SIGN-MAG TO 2'S COMPLEMENT
; BRA.S @3 ; BRANCH: WRITE SIGNIFICAND
;
;@2: ; POSITIVE CASE:
; FMOVE.X FP0,(SP) ; TEMPORARILY WRITE EXTENDED TO MEM
; CLR.W (SP) ; CLEAR ITS EXPONENT FIELD
; FMOVE.X (SP),FP0 ; RESTORE AS SUBNORMAL
;
; FMOVE.L FPCR,-(SP) ; SAVE FPCR (…ONLY IF UNFL ENABLED)
; FMOVE.L #0,FPCR ; DISABLE UNFL (…ONLY IF UNFL ENABLED)
; FSCALE FP1,FP0 ; AND RIGHT JUSTIFY SIGNIFICAND EXACTLY!
; FMOVE.L (SP)+,FPCR ; RESTORE FPCR (…ONLY IF UNFL ENABLED)
;
;@3: ; WRITE SIGNIFICAND CASE:
; FMOVEM.X FP0,(SP) ; GRAB EXPONENT AND SIGNIFICAND
; ADDQ #4,SP ; POP EXPONENT, LEAVING 64BIT COMP
; MOVEA.L LKDST(A6),A0 ; A0 := ADDRESS OF DST
; MOVE.L (SP)+,(A0)+ ; POP 1ST HALF OF COMP TO DST
; MOVE.L (SP)+,(A0) ; POP 2ND HALF OF COMP TO DST
; New X2C conversion routine avoids flushing to zero via FSCALE when rounding precision is
; single or double. This routine avoids FSCALE, FINT, and FGETEXP instructions. <3/30/92, JPO>
QX2CENTRY:
move.l d0,-(sp) ; save D0
fmove.l fpcr,d0 ; D0 <- user's FPCR
move.l d0,-(sp) ; push user's FPCR on stack, STACK: FPCR < D0 < xsrc < A0 < . . .
andi.w #$ff3f,d0 ; set rounding precision to extended
fmove.l d0,fpcr
ftest.x fp0 ; SNaN will signal
fboge @xpos ; xsrc >= 0.0
fcmp.x @LIMNEG,fp0 ; negative xsrc definitely in comp range?
fbogt @xneg ; yes
fbun @xnan ; xsrc is a NaN
fblt @xinval ; xsrc is out of range of comp
; Negative xsrc is borderline (out of range if rounding is down or to nearest)
btst.l #4,d0 ; round down or to nearest?
bne.b @xneg ; no
; Out-of-range conversion signals invalid and returns comp NaN
@xinval:
fmove.s #"$7fbfffff",fp1 ; signal invalid
; NaN input returns comp NaN (invalid signaled by signaling NaN input)
@xnan:
fmove.w #1,fp0 ; put comp NaN pattern in significand
fmove.l (sp)+,FPCR ; restore user's FPCR, stack: D0 save < x < A0 < ...
fmove.x fp0,4(sp) ; put extended result on stack
bra.b @deliver ; deliver comp result
@LIMNEG: ; nextextended(-2.0^63,0.0)
dc.l $c03d0000, $ffffffff, $ffffffff
@LIMPOS: ; nextextended(2.0^63,0.0)
dc.l $403d0000, $ffffffff, $ffffffff
; Negative xsrc will be in range of comp after rounding to integral value. Subtract
; 2^63 from xsrc, thus rounding to integral value and placing (comp) abs(xsrc) in lowest
; 63 bits of significand while setting explicit bit.
@xneg:
fsub.s #"$5f000000",fp0 ; subtract 2^63, forcing rounding (sets deserved INEX)
bra.b @inrange ; deliver in-range result
; Source argument is nonnegative
@xpos:
fcmp.x @LIMPOS,fp0 ; in comp range?
fbolt @xpos1 ; definitely
fbogt @xinval ; definitely not
; positive xsrc is borderline (out of range if rounding is up or to nearest
addi.b #$10,d0 ; round up or to nearest?
lsl.b #2,d0
bpl.b @xinval ; yes. out-of-range case
; Nonnegative xsrc will be in range of comp after rounding to integral value. Add
; 2^63 to xsrc, thus rounding to integral value and placing (comp) xsrc in lowest
; 63 bits of significand while setting explicit bit.
@xpos1:
fadd.s #"$5f000000",fp0 ; add 2^63, forcing rounding (sets deserved INEX)
@inrange:
fmove.l (sp)+,FPCR ; restore caller's FPCR, stack: D0 save < x < A0 < ...
fmovem.x fp0,4(sp) ; write rounded intermediate to stack
bclr.b #7,8(sp) ; clear explicit bit
tst.b 4(sp) ; negative xsrc?
bpl.b @deliver ; no, deliver result
neg.l 12(sp) ; yes, negate significand on stack
negx.l 8(sp)
@deliver:
move.l (sp)+,d0 ; restore D0, stack: x < A0 < ...
movea.l LKDST(a6),a0 ; A0 <- addr of DST
addq #4,sp ; pop significand
move.l (sp)+,(a0)+ ; write comp result (significand)
move.l (sp)+,(a0)
.*
ELSEIF (&SZ = 'W') OR (&SZ = 'L') THEN
.* ; X-TO-{W OR L}; AVOIDS (INV,INX) RTN
FMOVEM (SP)+,FP0 ; FP0 := SRC <5/19/91-S.McD.> <T3>
FMOVEM.L FPCR/FPSR,-(SP) ; SAVE ENV. TO AVOID SPURIOUS INX
MOVE.L (SP),-(SP) ; REPLICATE FPCR
CLR.B 2(SP) ; CLEAR ALL TRAP ENABLES <5/21/91-S.McD.> <T3>
FMOVE.L (SP)+,FPCR ; DISABLE TRAPPING FOR NEXT FOP
MOVEA.L LKDST(A6),A0 ; A0 := ADDRESS OF DST
FMOVE.&SZ FP0,(A0) ; SPURIOUS INEXACT DISABLED!
FMOVE.L FPSR,-(SP) ; PICK UP PREVIOUS OP FLAGS
BTST.B #5,2(SP) ; DID IT SIGNAL INVALID?
ADDQ #4,SP ; POP IT (CC NOT EFFECTED)
FMOVEM.L (SP)+,FPCR/FPSR ; RESTORE OLD ENV (CC NOT EFFECTED)
BEQ.S @0 ; IF NOT, BRANCH: TYPICAL CASE
; INVALID CASE:
FMOVE.S #"$7FBFFFFF",FP1 ; SIGNAL INVALID USING FLOAT SNAN
BRA.S @1
@0: ; TYPICAL CASE:
FMOVE.&SZ FP0,(A0) ; RE-EXECUTE TO PICK UP INX SIG.
@1:
FNOP ; (FNOP CATCHES SIG. BEFORE RTS)
ELSE
.*
.* All others {.S OR .D}: move directly into memory.
FMOVEM (SP)+,FP0 ;<5/19/91-S.McD.> <T3>
MOVEA.L LKDST(A6),A0
&FOP..&SZ FP0,(A0)
FNOP ; (FNOP CATCHES SIG. BEFORE RTS)
ENDIF
MOVE.L (SP)+,A0
UNLK A6
RTD #8
ENDM
MACRO
QOP1.&SZ &FOP,&OPCODE
.* This macro is used by the one argument functions: FSQRT, FINT, FINTRZ.
.*
.* Link required by trap handler to determine arguments.
LINK A6,#-LK1SIZE
.*
.* Popsize and opcode required by trap handler.
MOVE.L #LK1POP+&OPCODE,LKOP(A6)
.*
MOVE.L A0,-(SP)
DST2STK
&FOP..X (SP),FP0
FPU2DST
MOVE.L (SP)+,A0
UNLK A6
RTD #4
ENDM
INCLUDE 'FPHWArith96.A'
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ADDITION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QADDX:
QOP.X FADD, FFEXT+FOADD
QADDS:
QOP.S FADD, FFSGL+FOADD
QADDD:
QOP.D FADD, FFDBL+FOADD
QADDI:
QOP.W FADD, FFINT+FOADD
QADDL:
QOP.L FADD, FFLNG+FOADD
QADDC:
QOP.C FADD, FFCOMP+FOADD
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SUBTRACTION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QSUBX:
QOP.X FSUB, FFEXT+FOSUB
QSUBS:
QOP.S FSUB, FFSGL+FOSUB
QSUBD:
QOP.D FSUB, FFDBL+FOSUB
QSUBI:
QOP.W FSUB, FFINT+FOSUB
QSUBL:
QOP.L FSUB, FFLNG+FOSUB
QSUBC:
QOP.C FSUB, FFCOMP+FOSUB
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MULTIPLICATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QMULX:
QOP.X FMUL, FFEXT+FOMUL
QMULS:
QOP.S FMUL, FFSGL+FOMUL
QMULD:
QOP.D FMUL, FFDBL+FOMUL
QMULI:
QOP.W FMUL, FFINT+FOMUL
QMULL:
QOP.L FMUL, FFLNG+FOMUL
QMULC:
QOP.C FMUL, FFCOMP+FOMUL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DIVISION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QDIVX:
QOP.X FDIV, FFEXT+FODIV
QDIVS:
QOP.S FDIV, FFSGL+FODIV
QDIVD:
QOP.D FDIV, FFDBL+FODIV
QDIVI:
QOP.W FDIV, FFINT+FODIV
QDIVL:
QOP.L FDIV, FFLNG+FODIV
QDIVC:
QOP.C FDIV, FFCOMP+FODIV
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPARISON
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QCPXX:
QCPX.X FCMP, FFEXT+FOCPX
QCPXS:
QCPX.S FCMP, FFSGL+FOCPX
QCPXD:
QCPX.D FCMP, FFDBL+FOCPX
QCPXI:
QCPX.W FCMP, FFINT+FOCPX
QCPXL:
QCPX.L FCMP, FFLNG+FOCPX
QCPXC:
QCPX.C FCMP, FFCOMP+FOCPX
CCMAP:
DC.W $0000,$0002,$0000,$0002,$0004,$0002,$0002,$0002
DC.W $0019,$0002,$0019,$0002,$0004,$0002,$0002,$0002
QCMPX:
QCMP.X FCMP, FFEXT+FOCMP
QCMPS:
QCMP.S FCMP, FFSGL+FOCMP
QCMPD:
QCMP.D FCMP, FFDBL+FOCMP
QCMPI:
QCMP.W FCMP, FFINT+FOCMP
QCMPL:
QCMP.L FCMP, FFLNG+FOCMP
QCMPC:
QCMP.C FCMP, FFCOMP+FOCMP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REMAINDER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QREMX:
QREM.X FREM, FFEXT+FOREM
QREMS:
QREM.S FREM, FFSGL+FOREM
QREMD:
QREM.D FREM, FFDBL+FOREM
QREMI:
QREM.W FREM, FFINT+FOREM
QREML:
QREM.L FREM, FFLNG+FOREM
QREMC:
QREM.C FREM, FFCOMP+FOREM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collect the quotient from the 68881 status register,
;; convert from signed-magnitude to two's-complement,
;; and stuff quotient bits into user's D0.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MOVEQUOT:
FMOVE FPSR,D0 ; gather QUOT
SWAP D0 ; move to low order byte
BCLR #7,D0 ; is QUOT negative?
BEQ.S @1 ; if not, skip negate code
NEG.B D0
@1
EXT.W D0 ; word's worth
RTS ; PROBLEM: USER'S FREM TRAP HANDLER CAN'T GET AT D0!
; SOLUTION: ...emulator will handle
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONVERSIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QX2X:
QOP.X FMOVE, FFEXT+FOZ2X
QS2X:
QOP.S FMOVE, FFSGL+FOZ2X
QD2X:
QOP.D FMOVE, FFDBL+FOZ2X
QI2X:
QOP.W FMOVE, FFINT+FOZ2X
QL2X:
QOP.L FMOVE, FFLNG+FOZ2X
QC2X:
QOP.C FMOVE, FFCOMP+FOZ2X
QX2S:
QX2Z.S FMOVE, FFSGL+FOX2Z
QX2D:
QX2Z.D FMOVE, FFDBL+FOX2Z
QX2I:
QX2Z.W FMOVE, FFINT+FOX2Z
QX2L:
QX2Z.L FMOVE, FFLNG+FOX2Z
QX2C:
QX2Z.C FMOVE, FFCOMP+FOX2Z
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SQUARE ROOT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QSQRTX:
QOP1.X FSQRT, FOSQRT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ROUND TO INTEGRAL VALUE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QRINTX:
QOP1.X FINT, FORTI
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TRUNCATE TO INTEGRAL VALUE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QTINTX:
QOP1.X FINTRZ, FOTTI
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCALB ...THIS CODE WILL FLUSH SUBNORMS TO ZERO ON OLD MASK A93N 881s!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QSCALBX: ; NOTE: FSCALE.W REQUIRES |D0| < 2^14.
LINK A6,#-LK2SIZE
MOVE.L #LK2POP+FFINT+FOSCALB,LKOP(A6)
MOVEM.L D0/A0,-(SP)
DST2STK
FMOVEM.X (SP),FP0 ;<5/19/91-S.McD.> <T3>
QSCALBENTRY:
SUBA.W #12,SP ; reserve 12 bytes for 2^n factor <3/30/92, JPO>
MOVE.L #$80000000,4(SP) ; initialize significand of factor <3/30/92, JPO>
CLR.L 8(SP) ; <3/30/92, JPO>
MOVE.W ([LKSRC,A6]),D0 ; DO := SCALE FACTOR
BPL.S @1 ; BRANCH: D0 >= 0
; D0 < 0 CASE:
CMP #$C000,D0 ; D0 > -2^14?
BGT.S @2 ; IF SO, ONE FSCALE WILL DO
; IF NOT, D0 =< -2^14 CASE:
; ADD #$4000,D0 ; D0 := D0 + 2^14 - DELETED <3/30/92, JPO>
; FSCALE.W #$E000,FP0 ; FP0 := - DELETED <3/30/92, JPO>
; FSCALE.W #$E000,FP0 ; FP0 * 2^(-2^14) - DELETED <3/30/92, JPO>
; BRA.S @2 ; BRANCH: MULTIPLY BY 2^D0 - DELETED <3/30/92, JPO>
CLR.W (SP) ; zero sign/exponent of factor <3/30/92, JPO>
ADD.W #$3FFF,D0 ; adjust scale factor up by 2^14 - 1 <3/30/92, JPO>
FMUL.X (SP),FP0 ; scale by -(2^14 - 1) <3/30/92, JPO>
CMP.W #$C000,D0 ; final scaling still out of range? <3/30/92, JPO>
BGT.S @2 ; no. do final scaling below <3/30/92, JPO>
FMUL.X (SP),FP0 ; yes. scale down by 2^14 - 1 again <3/30/92, JPO>
ADD.W #$3FFF,D0 ; adjust scale factor again <3/30/92, JPO>
BRA.S @2 ; finish up below <3/30/92, JPO>
@1: ; D0 >= 0 CASE:
CMP #$4000,D0 ; D0 < 2^14?
BLT.S @2 ; IF SO, ONE FSCALE WILL DO
; IF NOT, D0 >= 2^14
MOVE.W #$7FFE,(SP) ; create factor of 2^(2^14 - 1) <3/30/92, JPO>
SUB #$4000,D0 ; D0 := D0 - 2^14
; FSCALE.W #$2000,FP0 ; FP0 := - DELETED <3/30/92, JPO>
; FSCALE.W #$2000,FP0 ; FP0 * 2^( 2^14) - DELETED <3/30/92, JPO>
FMUL.X (SP),FP0 ; scale by 2^14 <3/30/92, JPO>
FADD.X FP0,FP0 ; <3/30/92, JPO>
@2: ; MULTIPLY BY 2^D0 CASE:
; FSCALE.W D0,FP0 ; FP0 := FP0 * 2^D0 - DELETED <3/30/92, JPO>
ADD.W #$3FFF,D0 ; bias scale factor to create exponent of factor <3/30/92, JPO>
MOVE.W D0,(SP) ; <3/30/92, JPO>
FMUL.X (SP)+,FP0 ; scale via multiplication, popping factor <3/30/92, JPO>
FPU2DST8096
MOVEM.L (SP)+,D0/A0
UNLK A6
RTD #8
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOGB - Modified to prevent spurious underflow and to avoid using
;; the FGETEXP instruction - <3/30/92, JPO>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QLOGBX:
LINK A6,#-LK1SIZE
MOVE.L #LK1POP+FOLOGB,LKOP(A6)
; MOVE.L A0,-(SP) ; DELETED <3/30/92, JPO>
movem.l a0/d0,-(sp) ; save A0/D0 <3/30/92, JPO>
DST2STK
movea.l sp,a0 ; A0 <- SP <3/30/92, JPO>
; FABS.X (SP),FP0 ; DELETED <3/30/92, JPO>
QLOGBXENTRY:
; FBEQ.W @1 ; ZERO? RETURN LOG2'S EXCEPTIONS. DELETED <3/30/92, JPO>
; FCMP.S #"INF",FP0 ; DELETED <3/30/92, JPO>
; FBNE.W @2 ; NOT ZERO OR INF? RETURN FGETEXP. DELETED <3/30/92, JPO>
;@1 ; DELETED <3/30/92, JPO>
; FLOG2 FP0 ; OTHERWISE, RETURN LOG2'S EXCEPTIONS. DELETED <3/30/92, JPO>
; BRA.S @3 ; DELETED <3/30/92, JPO>
;@2 ; DELETED <3/30/92, JPO>
; FGETEXP FP0 ; DELETED <3/30/92, JPO>
;@3 DELETED <3/30/92, JPO>
move.w (a0),d0 ; D0 <- exponent <3/30/92, JPO>
andi.w #$7fff,d0 ; <3/30/92, JPO>
cmpi.w #$7fff,d0 ; NaN or INF? <3/30/92, JPO>
beq.b @naninf ; yes <3/30/92, JPO>
subi.w #$3fff,d0 ; no, unbias exponent <3/30/92, JPO>
tst.l 4(a0) ; normalized? <3/30/92, JPO>
bmi.b @norm ; yes <3/30/92, JPO>
beq.b @1 ; no, SIG.HI is zero <3/30/92, JPO>
move.l d1,-(sp) ; unnormalized. save D1 <3/30/92, JPO>
bfffo 4(a0){0:32},d1 ; find first nonzero significand bit <3/30/92, JPO>
bra.b @unnorm ; <3/30/92, JPO>
@naninf: ; NaN/INF returns NaN/+INF <3/30/92, JPO>
fabs.x (a0),fp0 ; SNaN signals here <3/30/92, JPO>
bra.b @deliver ; <3/30/92, JPO>
@zero: ; zero returns -INF with divide-by-zero exception
fmove.w #-1,fp0 ; <3/30/92, JPO>
fdiv.w #0,fp0 ; <3/30/92, JPO>
bra.b @deliver ; <3/30/92, JPO>
@1: ; SIG.HI is zero
sub.w #32,d0 ; high significand zero, adjust exponent <3/30/92, JPO>
tst.l 8(a0) ; zero? <3/30/92, JPO>
beq.b @zero ; yes <3/30/92, JPO>
move.l d1,-(sp) ; unnormalized. save D1 <3/30/92, JPO>
bfffo 8(a0){0:32},d1 ; find first nonzero signficand bit
@unnorm: ; unnormalized/denormalized case <3/30/92, JPO>
sub.w d1,d0 ; adjust exponent for leading significand zeros <3/30/92, JPO>
move.l (sp)+,d1 ; restore D1 <3/30/92, JPO>
@norm: ; unbiased exponent in D0.W <3/30/92, JPO>
fmove.w d0,fp0 ; FP0 <- binary exponent of input <3/30/92, JPO>
@deliver: ; deliver results <3/30/92, JPO>
movea.l LKDST(a6),a0 ; A0 <- &DST once more <3/30/92, JPO>
FPU2DST8096
; MOVE.L (SP)+,A0 ; DELETED <3/30/92, JPO>
movem.l (sp)+,a0/d0 ; restore registers <3/30/92, JPO>
UNLK A6
RTD #4
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CLASSIFY
;; CLASS PLACES INTEGER CODE AT DST ADDRESS. THE CODE TIES
;; IN USEFULLY WITH THE PASCAL ENUMERATED TYPES IN SANE.
;; IT IS THE SANE VALUE PLUS ONE, WITH THE SIGN OF THE INPUT
;; OPERAND. IN SANE, THE SIGN IS PLACED IN A SEPARATE INT.
;; THE VALUES ARE THUS:
;; SNAN 1 ...GADZOOKS! WHY ALL THIS CODE FOR CLASSIFY?!!?
;; QNAN 2 ...WELL, WE NOW NORMALIZE UNNORMAL NUMS BEFORE
;; INF 3 ...CLASSIFICATION. ALSO, THIS CODE AVOIDS USING
;; ZERO 4 ...THE FPU AND IS OPTIMIZED FOR THE TYPICAL CASE.
;; NORMAL 5 ...IT'S STILL GROSS, IN RETROSPECT.
;; DENORM 6
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QCLASSX:
MOVEM.L D0/A0,-(SP); D0 < A0 < RTS < &DST < &SRC
MOVEA.L 16(SP),A0 ; A0 := EXTENDED SRC ADDR
MOVE.L (A0)+,D0 ; D0 := HIGH LONG OF EXTENDED
SWAP D0
BPL.S @3 ; BRANCH: LEAD BIT ZERO
LSL #1,D0
ROR #1,D0 ; SAVE SIGN BIT IN X
BEQ.S @0 ; BRANCH: NORMAL
CMPI.W #$7FFF,D0
BEQ.S @4 ; BRANCH: MAX EXP CASE
@0
MOVEQ #5,D0 ; NORMAL CASE:
@1 ; EXIT.
MOVEA.L 12(SP),A0 ; A0 := DST ADDR
MOVE.W D0,(A0) ; STUFF ANSWER, AFFIX SIGN AND EXIT
ROXR #1,D0 ; BRING BACK SIGN FROM X
BPL.S @2
NEG.W (A0) ; NEGATE (IN MEMORY) ONLY IF X BIT SET
@2
MOVEM.L (SP)+,D0/A0
RTD #8 ; EXIT
; LEAD BIT ZERO CASE:
@3 ; EITHER 0, UN- OR SUBNORMAL, INF, NAN
LSL #1,D0
ROR #1,D0 ; SAVE SIGN BIT IN X
BEQ.S @31 ; BRANCH: MIN EXP CASE
CMPI.W #$7FFF,D0
BEQ.S @4 ; BRANCH: MAX EXP CASE
BRA.S @34 ; BRANCH: UNNORMAL
@31 ; MIN EXP CASE:
MOVE.W (A0)+,D0 ; SMASH REST OF SIGNIFICAND
OR.L (A0), D0 ; BITS INTO DO.L .
BNE.S @33 ; BRANCH: SUBNORMAL
@32
MOVEQ #4,D0 ; ZERO:
BRA.S @1 ; EXIT.
@33
MOVEQ #6,D0 ; SUBNORMAL:
BRA.S @1 ; EXIT.
@34 ; UNNORMAL CASE: (EXP IN D0.W, SGN IN XBIT!!!)
; EITHER ZERO, NORMAL, OR SUBNORMAL
MOVE.L A1,-(SP) ; SAVE A1
MOVE D0,A1 ; EXP.W IN A1
; NORMALIZATION CODE (WOW SAYS JON):
SUBQ #2,A0 ; RESET A0 TO POINT TO 63-0 OF 79-0
BFFFO (A0){0:0},D0
BNE.S @35 ; BRANCH: (NON-ZERO .L), .L
SUBA D0,A1 ; CC NOT AFFECTED
BFFFO 4(A0){0:0},D0
BEQ.S @36 ; BRANCH: UNNORMALIZED ZER0
@35 ; (NON-ZERO .L), .L CASE.
SUBA D0,A1 ; CC NOT AFFECTED
TST A1 ; SHIFT EXCEEDS EXP?
MOVEA.L (SP)+,A1 ; RESTORE A1 (CC NOT AFFECTED)
BPL.S @0 ; BRANCH: NORMAL, SHIFT <= EXP
BMI.S @33 ; BRANCH: SUBNORMAL, SHIFT > EXP
@36 ; UNNORMALIZED ZERO CASE:
MOVEA.L (SP)+,A1 ; RESTORE A1
BRA.S @32 ; BRANCH: ZERO
@4 ; MAX EXP CASE.
BTST.L #30,D0 ; TEST QUIET/SIGNAL BIT
BEQ.S @41 ; BRANCH: SNAN OR INF CASE
MOVEQ #2,D0 ; QNAN:
BRA.S @1 ; EXIT.
@41 ; SNAN OR INF CASE:
BCLR.L #31,D0 ; BITS 63-62 OF 79-0 NOW CLEAR
MOVE.W (A0)+,D0 ; SMASH REST OF SIGNIFICAND
OR.L (A0), D0 ; BITS INTO DO.L .
BNE.S @42 ; BRANCH: SNAN
MOVEQ #3,D0 ; INF:
BRA.S @1 ; EXIT.
@42
MOVEQ #1,D0 ; SNAN:
BRA.S @1 ; EXIT.
QCLASSS:
MOVEM.L D0/A0,-(SP); D0 < A0 < RTS < &DST < &SRC
MOVEA.L 16(SP),A0 ; A0 := SRC ADDR
MOVE.L (A0),D0 ; D0 := SRC FLOAT
ADD.L D0,D0 ; SAVE SIGN BIT IN X BIT
; NOTE: FLOAT LOGICALLY SHIFTED LEFT ONE BIT,
; MAKING BIT OFFSETS SEEM OFF BY ONE.
BEQ.S @2 ; BRANCH: ZERO
BFCHG D0{0:8}
BEQ.S @3 ; BRANCH: DENORM
BFTST D0{0:8}
BEQ.S @4 ; BRANCH: INF OR NAN
MOVEQ #5,D0 ; NORMAL CASE:
; EXIT.
@0
MOVEA.L 12(SP),A0 ; A0 := DST ADDR
MOVE.W D0,(A0) ; WRITE ANSWER, AFFIX SIGN AND EXIT
ROXR #1,D0 ; BRING BACK SIGN FROM X BIT
BPL.S @1
NEG.W (A0) ; NEGATE ONLY IF X BIT WAS SET
@1
MOVEM.L (SP)+,D0/A0
RTD #8
@2
MOVEQ #4,D0 ; ZERO CASE:
BRA.S @0 ; EXIT.
@3
MOVEQ #6,D0 ; DENORM CASE:
BRA.S @0 ; EXIT.
@4 ; INF OR NAN CASE:
BFTST D0{8:23} ; F != 0?
BNE.S @5 ; BRANCH: NAN
MOVEQ #3,D0 ; INF CASE:
BRA.S @0 ; EXIT.
@5 ; NAN CASE:
BTST #23,D0 ; QUIET BIT OFF?
BEQ.S @51 ; BRANCH: SNAN
MOVEQ #2,D0 ; QNAN CASE:
BRA.S @0 ; EXIT.
@51
MOVEQ #1,D0 ; SNAN CASE:
BRA.S @0 ; EXIT.
QCLASSD: ; SAME AS FLOAT CODE ABOVE (BUT OFFSETS DIFFERENT)
MOVEM.L D0/A0,-(SP); D0 < A0 < RTS < &DST < &SRC
MOVEA.L 16(SP),A0 ; A0 := SRC ADDR
MOVE.L (A0)+,D0 ; D0 := HIGH HALF OF DOUBLE
OR.W (A0)+,D0 ; 'OR' IN LOW HALF OF DOUBLE INTO
OR.W (A0),D0 ; BOTTOM HALF OF HIGH HALF.
ADD.L D0,D0 ; SAVE SIGN BIT IN X BIT
; NOTE: DOUBLE LOGICALLY SHIFTED LEFT ONE BIT,
; MAKING BIT OFFSETS SEEM OFF BY ONE.
BEQ.S @2 ; BRANCH: ZERO
BFCHG D0{0:11}
BEQ.S @3 ; BRANCH: DENORM
BFTST D0{0:11}
BEQ.S @4 ; BRANCH: INF OR NAN
MOVEQ #5,D0 ; NORMAL CASE:
; EXIT.
@0
MOVEA.L 12(SP),A0 ; A0 := DST ADDR
MOVE.W D0,(A0) ; WRITE ANSWER, AFFIX SIGN AND EXIT
ROXR #1,D0 ; BRING BACK SIGN FROM X BIT
BPL.S @1
NEG.W (A0) ; NEGATE ONLY IF X BIT WAS SET
@1
MOVEM.L (SP)+,D0/A0
RTD #8
@2
MOVEQ #4,D0 ; ZERO CASE:
BRA.S @0 ; EXIT.
@3
MOVEQ #6,D0 ; DENORM CASE:
BRA.S @0 ; EXIT.
@4 ; INF OR NAN CASE:
BFTST D0{11:20} ; F != 0?
BNE.S @5 ; BRANCH: NAN
MOVEQ #3,D0 ; INF CASE:
BRA.S @0 ; EXIT.
@5 ; NAN CASE:
BTST #20,D0 ; QUIET BIT OFF?
BEQ.S @51 ; BRANCH: SNAN
MOVEQ #2,D0 ; QNAN CASE:
BRA.S @0 ; EXIT.
@51
MOVEQ #1,D0 ; SNAN CASE:
BRA.S @0 ; EXIT.
*QCLASSD: ; FROM THE "STUART HATES BRANCHES" SCHOOL OF PROGRAMMING.
* ; IF YOU LIKE BRANCHES, COMPARE WITH ABOVE CODE AND VOTE.
* MOVEM.L D0/A0,-(SP) ; D0 < A0 < RTS < &DST < &SRC
* MOVEA.L 16(SP),A0 ; A0 := SRC ADDR
* MOVEM.L (A0)+,D0 ; D0 := HIGH HALF OF DOUBLE
* BFCHG D0{1:11} ; TOGGLE EXPONENT FIELD
* SEQ D1 ; D1.B := -1 IF EXPONENT IS ALL ONES, ELSE 0
* NEG.B D1 ; "PUSH" 'EXP ALL ONES' BIT ONTO END OF D1.B
* ADD.B D1,D1 ; MAKE ROOM FOR NEXT BIT
* BFCHG D0{1:11} ; TOGGLE EXPONENT FIELD
* SNE -(SP) ; (SP).B := 0 IF EXPONENT WAS ALL ZEROS, ELSE -1
* SUB.B (SP)+,D1 ; "PUSH" 'EXP ALL ZEROS' BIT ONTO END OF D1.B
* ADD.L D0,D0 ; X BIT := DOUBLE'S SIGN (REMOVED)
* ROXL.B D1 ; "PUSH" SIGN BIT ONTO END OF D1.B
* ASL.L #12,D0 ; X BIT := QNAN BIT (ONLY 19 F BITS REMAIN)
* ROXL.B D1 ; "PUSH" 'QNAN BIT' ONTO END OF D1.B
* ADD.B D1,D1 ; MAKE ROOM FOR NEXT BIT
* OR.L (A0),D0 ; D0 := F BITS OR'D TOGETHER (WITHOUT QNAN BIT)
* SNE -(SP) ; (SP).B := 0 IF LOWER 51 BITS ALL ZERO, ELSE -1
* SUB.B (SP)+,D1 ; "PUSH" '51 BITS OF ZERO' BIT ONTO END OF D1.B
* MOVEA.L 12(SP),A0 ; A0 := DST ADDR
* EXT.W D1 ; D0.W := 0 THRU 31 ("PUSHED" FIVE BITS SELECTOR)
* MOVE.W CLASSDTBL(D1.W*2),(A0) ; PICK UP AND STUFF ANSWER
* MOVEM.L (SP)+,D0/A0
* RTD #8
*
*CLASSDTBL: DC.W 0, 1, 2, 3, 4, 5, 6, 7 ; TABLE NOT FILLED IN YET!!!
* DC.W 8, 9,10,11,12,13,14,15
* DC.W 16,17,18,19,20,21,22,23
* DC.W 24,25,26,27,28,29,30,31
QCLASSC:
MOVEM.L D0/A0,-(SP) ; D0 < A0 < RTS < &DST < &SRC
MOVEA.L 16(SP),A0 ; A0 := SRC ADDR
MOVE.L (A0)+,D0 ; D0 := HIGH HALF OF COMP
ADD.L D0,D0 ; X BIT := SIGN BIT (REMOVED)
OR.L (A0),D0 ; D0 := TWO HALVES OR'D TOGETHER
SNE D0 ; D0.B := -1 IF NON-ZERO 63 BITS, ELSE 0
ROXL.B #1,D0 ; D0.B := $FE, $FF, $00, OR $01
MOVEA.L 12(SP),A0 ; A0 := DST ADDR
EXT.W D0 ; D0.W := $FFFE, $FFFF, $0000, $0001
MOVE.W CLASSCTBL(D0.W*2),(A0) ; PICK UP AND STUFF ANSWER
MOVEM.L (SP)+,D0/A0
RTD #8
DC.W 5 ; CLASS OF SRC COMP: NORMALIZED
DC.W -5 ; CLASS OF SRC COMP:-NORMALIZED
CLASSCTBL: DC.W 4 ; CLASS OF SRC COMP: ZERO
DC.W 2 ; CLASS OF SRC COMP: QUIET NAN
Reference in New Issue View Git Blame Copy Permalink