;
;	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