Macintosh-SW/mac-rom
1
0
Fork 0
mirror of https://github.com/elliotnunn/mac-rom.git synced 2024-06-01 07:41:58 +00:00
Code Issues Projects Releases Wiki Activity
master
mac-rom/Toolbox/InSANE/FPHWArith.a
Elliot Nunn 4325cdcc78 Bring in CubeE sources 
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included.

The Tools directory, containing mostly junk, is also excluded.
2017-12-26 09:52:23 +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