;
;	File:		FP881Arith.a
;
;	Contains:	Implementation of FP69K arithmetic functions calling an MC68881
;
;	Written by:	Clayton Lewis et al
;
;	Copyright:	© 1985-1990 by Apple Computer, Inc., all rights reserved.
;
;   This file is used in these builds:   Mac32
;
;	Change History (most recent first):
;
;		 <3>	 9/17/90	BG		Removed <2>. 040s are behaving more reliably now.
;		 <2>	  7/4/90	BG		Added EclipseNOPs for flakey 040s.
;	   <1.1>	11/11/88	CCH		Fixed Header.
;	   <1.0>	 11/9/88	CCH		Adding to EASE.
;	   <1.0>	 2/12/88	BBM		Adding file for the first time into EASEÉ

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; File: FP881arith.a
;; Implementation of FP68K arithmetic functions calling MC68881.
;; Copyright Apple Computer, Inc. 1985,1986,1987
;; All Rights Reserved
;; Confidential and Proprietary to Apple Computer,Inc.
;;
;; Written by Clayton Lewis, begun 8 Feb 85.
;; Debugged by Stuart McDonald.
;;
;; Modification history:
;;   Rev2: 16 May 85
;;   Rev3: 17 May 85
;;   Rev5: 27 May 85
;;   Rev9: 17 Jun 85
;;   Rev10:19 Dec 85  streamline convert and scalb in concert with FPCtrl
;;   Rev11:16 Jun 86 CRL moved to MPW
;;   Rev12:29 Sep 86 Made E2{int,long} handle {NaN,Inf,Out-of-range} ala SANE. -S.McD.
;;         29 Sep 86 Fixed spurious inexact in X2C's NanCreated. -S.McD.
;;         26 Dec 86 Comp2X no longer stomps on its input. -S.McD.
;;         27 Dec 86 Changes to ExitArgs routines:  -S.McD.
;;		1) Added entry ExitProcExit for ProcExit finale;
;;		2) Now restore FPSR/FPCR before halt check.
;;		3) CompareCtnd now returns CCR in A1 instead of D1.
;;         05 Jan 87 Fixed Classify; now handles DENORMALNUMs properly. -S.McD.
;;         05 Jan 87 Scalb doesn't truncate subnormals to zero anymore. -S.McD.
;;         05 Jan 87 Logb now handles zero and INF properly. -S.McD.
;;         07 Jan 87 Scalb two days ago was buggy.  Fixed now. -S.McD.
;;         11 Jan 87 Scalb doesn't truncate huge numbers to INF anymore. -S.McD.
;;         15 Jan 87 Changed status and copyright information. -S.McD.
;;         21 Jan 87 Cleaned up CompareCtnd code. -S.McD.
;;         21 Jan 87 Cleaned up CPXxxx entries. -S.McD.
;;         21 Jan 87 Cleaned up MoveQuot. -S.McD.
;;         21 Jan 87 Cleaned up NaNInput. -S.McD.
;;         23 Jan 87 Sqrt,Add,Div,Mul,Rem now return Apple's NaN codes. -S.McD.
;;         29 Jan 87 Apple NaN logic speeded up. -S.McD.
;;         29 Jan 87 Tossed FSCALE.  It prematurely UNFLs/OVFLs on A93N mask. -S.McD.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ADDITION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADDext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to the stack,
     ;;   add and branch to common exit.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FADD.X	(SP)+,FP0

	BRA	Return2Args
ADDdbl
	FADD.D	(A0),FP0

	BRA	Return2Args
ADDsgl
	FADD.S	(A0),FP0

	BRA	Return2Args
ADDint
	FADD.W	(A0),FP0

	BRA	Return2Args
ADDlong
	FADD.L	(A0),FP0
	BRA	Return2Args
ADDcomp
	BSR	Comp2X

	FADD.X	FP1,FP0

	BRA	Return2Args

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SUBTRACTION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SUBext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to the stack,
     ;;   subtract and branch to common exit.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FSUB.X	(SP)+,FP0

	BRA	Return2Args
SUBdbl
	FSUB.D	(A0),FP0

	BRA	Return2Args
SUBsgl
	FSUB.S	(A0),FP0

	BRA	Return2Args
SUBint
	FSUB.W	(A0),FP0

	BRA	Return2Args
SUBlong
	FSUB.L	(A0),FP0

	BRA	Return2Args
SUBcomp
	BSR	Comp2X
	FSUB.X	FP1,FP0

	BRA	Return2Args

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MULTIPLICATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MULext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to the stack,
     ;;   multiply and branch to common exit.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FMUL.X	(SP)+,FP0

	BRA	Return2Args
MULdbl
	FMUL.D	(A0),FP0

	BRA	Return2Args
MULsgl
	FMUL.S	(A0),FP0

	BRA	Return2Args
MULint
	FMUL.W	(A0),FP0

	BRA	Return2Args
MULlong
	FMUL.L	(A0),FP0

	BRA	Return2Args
MULcomp
	BSR	Comp2X

	FMUL.X	FP1,FP0

	BRA	Return2Args

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DIVISION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DIVext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to the stack,
     ;;   divide and branch to common exit.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FDIV.X	(SP)+,FP0

	BRA	Return2Args
DIVdbl
	FDIV.D	(A0),FP0

	BRA	Return2Args
DIVsgl
	FDIV.S	(A0),FP0

	BRA	Return2Args
DIVint
	FDIV.W	(A0),FP0

	BRA	Return2Args
DIVlong
	FDIV.L	(A0),FP0

	BRA	Return2Args
DIVcomp
	BSR	Comp2X

	FDIV.X	FP1,FP0

	BRA	Return2Args

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPARISON
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CMPext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to the stack,
     ;;   compare and branch to common exit.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FCMP.X	(SP)+,FP0

	BRA.S	CompareCtnd
CMPdbl
	FCMP.D	(A0),FP0

	BRA.S	CompareCtnd
CMPsgl
	FCMP.S	(A0),FP0

	BRA.S	CompareCtnd
CMPint
	FCMP.W	(A0),FP0

	BRA.S	CompareCtnd
CMPlong
	FCMP.L	(A0),FP0

	BRA.S	CompareCtnd
CMPcomp
	BSR	Comp2X

	FCMP.X	FP1,FP0

CompareCtnd
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Collect the 68881 status and reset 68020 CCR
     ;;   as appropriate for the comparison.
     ;; Note: the Z bit must be checked before N since the
     ;;   68881 can set both N&Z for zeros and infinities.
     ;;			; put CCR in A1. -S.McD. 12/27/86
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	FBNE.W	@2	; Are they equal?
	MOVEA.W	#ZBIT,A1	;   if so, set Z in CCR
	BRA	Exit2Args	;   and exit
@2
	FBUGE.W	@4	; If not, do they compare LESSTHAN?
	MOVEA.W	#XNCBITS,A1	;   if so, set X,N,C in CCR
	BRA	Exit2Args	;   and exit
@4	
	FBULE.W	@8	; If not, do they compare GREATERTHAN?
	SUBA.W	A1,A1	;   if so, clear CCR bits
	BRA	Exit2Args	;   and exit
@8
			; If not, they must be UNORDERED.
	MOVEA.W	#VBIT,A1	;   set V in CCR
	BRA	Exit2Args	;   and exit

CPXext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to the stack,
     ;;   compare and branch to common exit.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FCMP.X	(SP)+,FP0

	FBST.W	CompareCtnd	; always, setting BSUN if unordered.
CPXdbl
	FCMP.D	(A0),FP0

	FBST.W	CompareCtnd	; always, setting BSUN if unordered.
CPXsgl
	FCMP.S	(A0),FP0

	FBST.W	CompareCtnd	; always, setting BSUN if unordered.
CPXint
	FCMP.W	(A0),FP0

	FBST.W	CompareCtnd	; always, setting BSUN if unordered.
CPXlong
	FCMP.L	(A0),FP0

	FBST.W	CompareCtnd	; always, setting BSUN if unordered.
CPXcomp
	BSR	Comp2X

	FCMP.X	FP1,FP0

	FBST.W	CompareCtnd	; always, setting BSUN if unordered.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REMAINDER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
REMext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to the stack,
     ;;   calculate remainder and branch to common exit.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FREM.X	(SP)+,FP0

	BRA.S	MoveQuot
REMdbl
	FREM.D	(A0),FP0

	BRA.S	MoveQuot
REMsgl
	FREM.S	(A0),FP0

	BRA.S	MoveQuot
REMint
	FREM.W	(A0),FP0

	BRA.S	MoveQuot
REMlong
	FREM.L	(A0),FP0

	BRA.S	MoveQuot
REMcomp
	BSR	Comp2X

	FREM.X	FP1,FP0


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collect the quotient from the 68881 status register,
;;   convert from signed-magnitude to two's-complement,
;;   and exit through standard back end.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MoveQuot
	FMOVE	FPSR,D0	; gather QUOT

	SWAP	D0	; move to low order byte
	BCLR	#7,D0	; is QUOT negative?
	BEQ.S	@2	;   if not, skip negate code
	NEG.B	D0
@2
	EXT.W	D0	; word's worth
	MOVE.L	D0,-22(A6)	; overwrite saved value of D0 in stackframe
	BRA	Return2Args

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONVERSIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CVText2E
CVTE2ext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source address to A0, dest address to A1.
     ;; Then copy source to dest.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	MOVE.L	(A0)+,(A1)+
	MOVE.L	(A0)+,(A1)+
	MOVE.W	(A0),(A1)
	BRA	Exit2Args
CVTdbl2E
	FMOVE.D	(A0),FP0

	BRA	Return2Args
CVTsgl2E
	FMOVE.S	(A0),FP0

	BRA	Return2Args
CVTint2E
	FMOVE.W	(A0),FP0

	BRA	Return2Args

CVTlong2E
	FMOVE.L	(A0),FP0

	BRA	Return2Args
CVTcomp2E
	BSR	Comp2X

	FMOVE.X	FP1,FP0

	BRA	Return2Args

CVTE2dbl
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FMOVE.X	 (SP)+,FP0

	FMOVE.D	FP0,(A1)

	BRA	Exit2Args
CVTE2sgl
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FMOVE.X	 (SP)+,FP0

	FMOVE.S	FP0,(A1)

	BRA	Exit2Args
CVTE2int
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FMOVE.X	 (SP)+,FP0

	FMOVE.W	FP0,(A1)

	FMOVE	FPSR,D0		; {NaN,Inf,Out-of-Range} -> -2^15. -S.McD.

	BTST	#OPERR,D0		; OPERR error?
	BEQ.S	@1		; if not, branch;
	MOVE.W	#$8000,(A1)		; otherwise, stuff -2^15 
	BCLR	#$3,D0		; and clear inx.
	FMOVE	D0,FPSR
@1	
	BRA	Exit2Args
CVTE2long
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FMOVE.X	 (SP)+,FP0

	FMOVE.L	FP0,(A1)

	FMOVE	FPSR,D0		; {NaN,Inf,Out-of-Range} -> -2^31. -S.McD.

	BTST	#OPERR,D0		; OPERR error?
	BEQ.S	@1		; if not, branch;
	MOVE.L	#$80000000,(A1)	; otherwise, stuff -2^31 and clear inx.
	BCLR	#$3,D0
	FMOVE	D0,FPSR
@1	
	BRA	Exit2Args

CVTE2comp
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; CVTE2comp expects src address in A0 and dst address in A1.
     ;; Move source to FP0 and test for input NaN.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FMOVE.X	(SP)+,FP0
	FBOR.W	FromD2B

	BRA.S	NaNInput	; if not ordered, then input was NaN

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Not NaN, round to integral value.
     ;; Is exponent too large for comp ( >62 ),
     ;;   if so, deliver NaN,
     ;;   else shift significand right by (62-exp).
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
FromD2B
			; "fp881b2dc.a" uses this entry point, too.
	FINT	FP0,FP0
	FGETEXP	FP0,FP1
	FSUB.W	#62,FP1	; ( exp-62 ) --> FP1
	FBOLE.W	@1	; if exp²62 then create comp value

	BRA.S	NaNCreated	; if exp>62 then create comp NaN
@1
	MOVE.L	D2,A0	; use D2 as temp for next 9 instructions

	FMOVE.X	FP0,-(SP)	; move rounded value to stack
	FMOVE.W	FP1,D2	; move ( exp-62 ) to D2

	ADDQ.L	#4,SP	; point to significand
	NEG.W	D2	; ( 62-exp ) in D2

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Right shift significand.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	MOVE.L	(SP)+,D1	; significand.HI
	MOVE.L	(SP)+,D0	; significand.LO
@2
	LSR.L	#1,D1
	ROXR.L	#1,D0
	DBF	D2,@2

	MOVE.L	A0,D2	; restore D2

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Comp now in D1-D0.  Adjust sign if necessary.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	FTEST	FP0
	FBOGE.W	Deliver

	NEG.L	D0
	NEGX.L	D1

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Deliver to caller and return.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Deliver
	MOVE.L	D1,(A1)+
	MOVE.L	D0,(A1)
	BRA	Exit2Args

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Return NaN.  Set invalid if NaN was created here.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
NaNCreated
	FMOVE	FPSR,D0

	BSET	#7,D0
	BCLR	#3,D0		; Clear inexact for NaNs. -S.McD.

	FMOVE	D0,FPSR

NaNInput
	MOVEQ	#0,D0
	MOVEQ	#1,D1
	ROR.L	#1,D1
	BRA.S	Deliver

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SQUARE ROOT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SQRText
	FSQRT.X	FP0,FP0

	BRA	Return1Arg

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ROUND TO INTEGRAL VALUE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
RINText
	FINT.X	FP0,FP0

	BRA	Return1Arg

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TRUNCATE TO INTEGRAL VALUE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
TINText
	FINTRZ	FP0,FP0

	BRA	Return1Arg

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCALB
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Algorithm for computing X*2^N:
;;
;;	sum := X's exponent field + N;
;;	if  0 < sum < $7fff  then         ... usual case
;;	  begin
;;	    X's exponent field := sum;
;;	    return X;
;;	  end
;;	else if  sum >= $7fff  then       ... potential overflow case
;;	  begin		          ...  note: subnormal inputs can't OVFL.
;;	    X's exponent field := $7ffe;  ...  note: N=$7fff if X's expo is $0000.
;;	    return X * 2;	          ...  note: 881 post-normalizes for us.
;;	  end
;;	else if  sum =< 0  then	          ... potential underflow case
;;	  begin
;;	    p := max (sum,-65);
;;	    X's exponent field := $0000;
;;	    return X * 2^p;
;;	  end;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SCALBext
	FBEQ.W	Return2Args	; return zero for zero*2^n. -S.McD.
	FBUN.W	Return2Args	; return NaN for NaN*2^n. -S.McD.
	MOVEA.L	LKADR2(A6),A0

	MACHINE	MC68020
	BFEXTU	(A1){1:15},D0	; exponent field -> D0
	MACHINE	MC68000
	CMP.W	#$7fff,D0
	BEQ.W	Return2Args	; return INF for INF*2^n. -S.McD.
	MOVE.W	(A0),D1	; n -> D1
	EXT.L	D1	; sign extend n
	ADD.L	D1,D0	; exponent field + (sign extended) n -> D0
	BLE.S	SumTooSmall	; more work to do if sum =< 0

	CMPI.L	#$7fff,D0
	BGE.S	SumTooBig	; more work to do if sum >= 7fff
			; otherwise, stuff sum into exponent field and rtn
	ADDQ.L	#6,A1	; begin
	MOVE.L	(A1),-(SP)
	MOVE.L	-(A1),-(SP)	;    "Push 96 bit X"
	SUBQ.L	#2,A1
	MOVE.L	(A1),-(SP)	; end
	MACHINE	MC68020
	BFINS	D0,(SP){1:15}	; stuff sum into exponent field
	MACHINE	MC68000
	FMOVE.X	(SP)+,FP0	; pop into FP0 and return.

	BRA	Return2Args

;;  Note:  The below code is avoiding three hardware problems on the A93N mask 881:
;;	(1) for subnormal returns, FSCALE always returns zero;
;;	(2) for    normal returns, FSCALE prematurely underflows,
;;		e.g. cb5d00009d826f102a1c8e3c * 2^ffffb4fc returns
;;		     800000000000000000000000  when it should return
;;		     805900009d826f102a1c8e3c;
;;	(3) for    normal returns, FSCALE prematurely overflows,
;;		e.g. 946200009b1eede9a0958520 * 2^4c25 returns
;;		     ffff00000000000000000000  when it should return
;;		     e08700009b1eede9a0958520.
;;					-S.McD. 1/28/87
SumTooBig:
	FMOVEM.X	FP0,-(SP)		; push input X
	MOVE.W	#$7ffe,D0
	MACHINE	MC68020
	BFINS	D0,(SP){1:15}	; X's exponent field  <-  7ffe
	MACHINE	MC68000
	FMOVEM.X	(SP)+,FP0		; FP0 = X with exponent field 7ffe
	FADD.X	FP0,FP0		; return 2 * FP0
	BRA	Return2Args
SumTooSmall:
	FMOVEM.X	FP0,-(SP)		; push input X
	CMP	#-65,D0		; sum >= -65?
	BGE.S	@1		; if so, keep sum.
	MOVE.L	#-65,D0		; otherwise, use -65 for p.
				; i.e. D0 = p = max(sum,-65)
@1
				; begin constructing float 2^p
				; add float bias. e.g., for p=-65=bf,
	ADD.L	#$7f,D0		;      ffffffbf+0000007f -> 0000003e
	LSL.W	#7,D0		;      0000003e -> 00001f00
	SWAP	D0		;      00001f00 -> 1f000000.
				; Claim: 2^p as a float is now in D0.
	FMOVE.S	D0,FP0		; D0 = 2^p -> FP0
	MACHINE	MC68020
	BFCLR	(SP){1:15}		; X's exponent field  <-  0000
	MACHINE	MC68000
	FMUL.X	(SP)+,FP0		; return X * 2^p
	BRA	Return2Args
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOGB
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
LOGBexT
	FBNE.W	@1	; Is FP0 zero?  -S.McD. NOTE: assumes FPCC is set.
	FLOG2	FP0	;    If so, signal divide-by-zero and return -INF.
	BRA	Return1Arg
@1
	FMOVE	FPSR,D0
	BTST	#25,D0	; Is FP0 INF?   -S.McD.
	BEQ.S	@2	;    if not, do usual get exponent.
	FABS	FP0	;    otherwise
	BRA	Return1Arg	;         return INF for +-INF.
@2	
	FGETEXP	FP0,FP0

	BRA	Return1Arg

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CLASSIFY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CLASSext
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Move the source value to FP0.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     	MOVEA.L	LKADR2(A6),A0	; address of ext source
	MOVEA.L	LKADR1(A6),A1	; address of integer dest.
	ADDQ.L	#6,A0
	MOVE.L	(A0),-(SP)
	MOVE.L	-(A0),-(SP)
	SUBQ.L	#2,A0
	MOVE.L	(A0),-(SP)

	FMOVE.X	(SP)+,FP0
	MACHINE	MC68020
	BFEXTU	(A0){1:16},D1	; exponent field+1bit to D1.  -S.McD.
	MACHINE	MC68000

	BRA.S	TestIt
CLASSdbl
     	MOVEA.L	LKADR2(A6),A0	; address of dbl source
	MOVEA.L	LKADR1(A6),A1	; address of integer dest.
	FMOVE.D	(A0),FP0
	MACHINE	MC68020
	BFEXTU	(A0){1:11},D1	; exponent field to D1.  -S.McD.
	MACHINE	MC68000

	BRA.S	TestIt
CLASSsgl
     	MOVEA.L	LKADR2(A6),A0	; address of sgl source
	MOVEA.L	LKADR1(A6),A1	; address of integer dest.
	FMOVE.S	(A0),FP0
	MACHINE	MC68020
	BFEXTU	(A0){1:8},D1	; exponent field to D1.  -S.McD.
	MACHINE	MC68000

	BRA.S	TestIt
CLASScomp
     	MOVEA.L	LKADR2(A6),A0	; address of comp source
	MOVEA.L	LKADR1(A6),A1	; address of integer dest.
	BSR.S	Comp2X

	FMOVE.X	FP1,FP0
	MOVEQ	#-1,D1		; non-zero exponent to D1. -S.McD.

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Check for zero, infinity, or nan.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
TestIt
	FMOVE	FPSR,D0

	BTST	#26,D0	; is it zero?
	BEQ.S	@2
	MOVEQ	#ZERO,D1	;   if so, return class = zero
	BRA.S	SignCheck
@2
	BTST	#25,D0	; is it infinity?
 	BEQ.S	@4
	MOVEQ	#INFINITY,D1	;   if so, return class = infinity
	BRA.S	SignCheck
@4
	BTST	#24,D0	; is it QNaN OR SNaN?
	BEQ.S	@8

	FMOVE	FPCR,D1

	BTST	#14,D1	;   if so, check signalling
	BEQ.S	@6
	MOVEQ	#SNAN,D1	;     if signal, return class = snan
	BRA.S	SignCheck
@6
	MOVEQ	#NAN,D1	;     if no signal return class = qnan
	BRA.S	SignCheck
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Check for norms & denorms.
     ;; Use the stack but don't bother to clean up.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@8
	TST.W	D1	;   Is the exponent field zero?  -S.McD.
	BNE.S	@10	;   if not, then normal. -S.McD.

	MOVEQ	#DENORM,D1	;   else denormal
	BRA.S	SignCheck
@10
	MOVEQ	#NORMAL,D1
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Check sign.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SignCheck
	BTST	#27,D0
	BEQ.S	@1
	NEG.W	D1
@1
	MOVE.W	D1,(A1)
	BRA.S	Exit2Args

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Comp2X moves a comp value from (A0) to FP1.
;;   Destroys D1 and uses the address passed in A0.
;;   Presents a non-normal number to the 68881 with abs(comp) in
;;   significand, sign bit set properly, and exponent 63.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Comp2X
	TST.L	(A0)
	BPL.S	@2
	CLR.L	-(SP)	; begin
	MOVE.L	4(A0),D1	;    "NEG.L 4(A0),-(SP)"
	SUB.L	D1,(SP)	; end		-S.McD.
			; begin "NEGX.L (A0),-(SP)"
	ROXR.L	#1,D1	;    X bit --> sign bit
	SMI	D1	;    D1.B := $FF if X=1,
	MACHINE	MC68020	;         := $00 if X=0.
	BFEXTS	D1{24:8},D1	;    sign extended D1.B to .L
	MACHINE	MC68000	; That is,
	MOVE.L	D1,-(SP)	;    PUSH.L -1 for X=1,
			;            0 for X=0.
	MOVE.L	(A0),D1	;		-S.McD.
	SUB.L	D1,(SP)	; end   "NEGX.L (A0),-(SP)"

	BPL.S	@1	; all ok if no longer negative
	CLR.L	4(SP)	;   else comp nan
	MOVE.L	#$40140000,(SP)	; $7FFF (0000) 4014 0000 0000 0000
	MOVE.L	#$7FFF0000,-(SP)
	BRA.S	@3
@1
	MOVE.L	#$C03E0000,-(SP)	; sign -, exponent 63, junk word
	BRA.S	@3
@2
	MOVE.L	4(A0),-(SP)
	MOVE.L	(A0),-(SP)
	MOVE.L	#$403E0000,-(SP)	; sign +, exponent 63, junk word
@3
	FMOVE.X	(SP)+,FP1

	RTS

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Return2Args and Return1Arg move an extended result from FP0 via the
;;   stack to the destination (whose address is in A1), then clears the
;;   stack and returns to caller.
;;
;; Exit2Args and Exit1Arg just clear the stack and return without
;;   returning a value.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Exit1Arg
	MOVEQ	#STKREM1,D0
	LEA	LKADR1(A6),A0
	BRA.S	Exit2
Exit2Args
	MOVEQ	#STKREM2,D0
	LEA	LKADR2(A6),A0
	BRA.S	Exit2
Exit3Args
	MOVEQ	#STKREM3,D0
	LEA	LKADR3(A6),A0
	BRA.S	Exit2
Return1Arg
	MOVEQ	#STKREM1,D0
	LEA	LKADR1(A6),A0
	BRA.S	Exit
Return3Args
	MOVEQ	#STKREM3,D0
	LEA	LKADR3(A6),A0
	BRA.S	Exit
Return2Args
	MOVEQ	#STKREM2,D0
	LEA	LKADR2(A6),A0
Exit
	FMOVEM.X	FP0,-(SP)
Exit1
	MOVE.W	(SP)+,(A1)+
	ADDQ.L	#2,SP
	MOVE.L	(SP)+,(A1)+
 	MOVE.L	(SP)+,(A1)
Exit2
	MOVE.W	D0,LKCNT(A6)	; final stack adjust
Exit3
	FMOVE	FPSR,D0
	BTST	#OPERR,D0	; Have we signaled invalid?
	BNE.S	AppleNaN	; if so, branch to Apple NaN check.
AppleNaNRtn
	MOVE.W	D0,D1

	SWAP	D5
	OR.B	D5,D0

	FMOVE	D0,FPSR
ExitProcEx
			; FP881NONARITH.A's ProcEx uses this entry point.
	SWAP	D5
	MOVEQ	#0,D0
	MOVE.W	D5,D0

	FMOVE	D0,FPCR	; high half of D0 is zero at this point. -S.McD.

	LSR.W	#8,D0	; shift halt-enables to lo byte
	BEQ.S	PastHalter	; if none enabled then skip halt check

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Halt check.
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ASR.B	#2,D1	; [inv/inv/inv/of/uf/dz/x2/0] xcps in D1
	AND.B	D0,D1	; any halt-enable intersections?
	BEQ.S	PastHalter	;   if not, skip halt code

HaltCode
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Make the FP68K halt stack frame.
     ;;   Save & restore A0 (end of stack frame ptr).
     ;;   Set up stack frame:
     ;;	------------------
     ;;    	Pending D0 - 	long
     ;;	-----------------
     ;;	Pending CCR - 	word
     ;;	------------------
     ;;	halts^xcps - 	word < ----
     ;;	------------------         	^
     ;;	MISC rec ptr 	----------->
     ;;	------------------
     ;;	SRC2 addr -	long
     ;;	------------------
     ;;	SRC  addr -	long
     ;;	------------------
     ;;	DST  addr -	long
     ;;	------------------
     ;;	opcode - 	word
     ;;	------------------
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     	MOVE.L	A0,-(SP)	; save A0 so halt handler can't trash it
	MOVE.L	-22(A6),-(SP)	; pending D0
	MOVE.W	A1,-(SP)	; pending CCR

	MOVEQ	#$1F,D0	; set mask for lo 5 bits
	LSR.B	#1,D1	; move halts&exceptions to low bits
	AND.B	D1,D0	; show only 5 bits
	MOVE.B	ToSANE(PC,D0),D0	; place in SANE order
	MOVE.W	D0,-(SP)	; halts&exceptions to stack frame
	MOVE.L	SP,-(SP)	; push pointer to stuff now on stack (MISC REC)
	MOVE.L	LKADR3(A6),-(SP)	; &SRC2
	MOVE.L	LKADR2(A6),-(SP)	; &SRC
	MOVE.L	LKADR1(A6),-(SP)	; &DST
	MOVE.W	LKOP(A6),-(SP)	; Opcode
	MOVEA.L	#FPSTATE,A1
	MOVEA.L	2(A1),A1	; haltvector
	JSR	(A1)	; transfer to user halt handler routine

	MOVE.L	(SP)+,A1	; pending CCR from stack frame->A1.lo (junk->A1.hi)
	MOVE.L	(SP)+,-22(A6)	; pending-D0 from stack frame -> saved regs
	MOVE.L	(SP)+,A0	; restore A0 saved at top of halt code

PastHalter

	MOVE.L	LKRET(A6),(A0)	; put return address at end of stack frame
	MOVE.W	A1,D1	; -S.McD. 12/27/86
	MOVE	D1,CCR	; (only) compare operations return meaningful CCR
	MOVEA.L	(A6),A6	; unlink
	MOVEM.L	(SP)+,D0/D1/D5/A0/A1	; restore registers
	ADDA.W	(SP),SP	; clear stack leaving only &return
	RTS

;; Invalid has been signaled.  Replace +,-,*,/,REM,Sqrt NaNs with Apple NaNs.
AppleNaN
	MOVE.W	LKOP(A6),D1	; Opcode -> D1
	ROR.B	#1,D1	; Halve opcode and branch on odd parity.
	BMI.S	AppleNaNRtn	; Odd? must be non-Arith. Done.
	CMPI.B	#9,D1	; ROR leaves +,-,*,/,rem,sqrt as 0,1,2,3,6,9.
	BGT.S	AppleNaNRtn	; Cmp,cmpx,conv,conv are 4,5,7,8.

;; Case +,-,*,/,cmp,cmpx,rem,conv,conv,sqrt, is handled by the following mapping:
;;      0 1 2 3  4   5    6    7    8    9  is mapped to
;;      2 2 8 4 -1  -1    9   -1   -1    1.  Neg cases are used for flow, not data.

	EXT.W	D1	; zero out most significant byte of word
	MOVE.B	NaNcode(PC,D1.W),D1	; NaN code byte -> D1
	BMI.S	AppleNaNRtn	; Nope, didn't want to do anything for 4,5,7,8.
	CLR.L	(A1)	; clear least significant 32 bits of existing NaN
	MOVE.L	#$40000000,-(A1)	; set up next 32 bits
	OR.B	D1,1(A1)	; stuff NaN code byte xx into 40xx0000.
	BRA.W	AppleNaNRtn
NaNcode
	DC.B	02,02,08,04,-1,-1,09,-1,-1,01    ; +,-,*,/,-1,-1,rem,-1,-1,sqrt