;
;	File:		FP020CTRL.a
;
;	Contains:	xxx put contents here xxx
;
;	Written by:	xxx put writers here xxx
;
;	Copyright:	© 1990 by Apple Computer, Inc., all rights reserved.
;
;   This file is used in these builds:   Mac32
;
;	Change History (most recent first):
;
;		 <4>	 9/15/90	BG		Removed <3>. 040s are behaving more reliably now.
;		 <3>	  7/4/90	BG		Added EclipseNOPs for flakey 040s.
;		 <2>	 4/14/90	JJ		Made changes to support new binary-to-decimal, 96-bit precision,
;							and improved Pack 5.
;		 <1>	  3/2/90	JJ		First checked in.
;
;	To Do:
;

;-----------------------------------------------------------
; File:  FPCTRL.a
;-----------------------------------------------------------

;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPCONTROL
 ; Copyright Apple Computer, Inc., 1983,1984,1985,1989,1990
 ; All Rights Reserved
;-----------------------------------------------------------
;-----------------------------------------------------------

;-----------------------------------------------------------
; 04JUL82: WRITTEN BY JEROME COONEN
; 29AUG82: ACCESS TO STATE MADE EXPLICIT HERE. (JTC)
; 12OCT82: CLEAR D0.W TO GET QUO IN REM; RND-UP BIT. (JTC)
; 12DEC82: DON'T CLEAR D0.W HERE -- LET REM DO IT ALL (JTC)
; 28DEC82: ADD LOGBX AND SCALBX (JTC).
; 13APR83: ADD COMMENT ABOUT LABEL POP3 (JTC).
; 29APR83: ADD CLASS (JTC).
; 09MAY83: MAJOR CHANGES: SEE FPDRIVER. (JTC)
; 25AUG83: Change to Lisa Sane_Environ (JTC).
; 01NOV83: MOVE PRECISION CONTROL TO MODES (JTC).
; 15APR84: SOME CODE MOVEMENT FOR LISABUG'S SAKE (JTC & DGH).
; 26MAR85: VERSION 2; NEW LISA STATE NAME.
; 26SEP85: REMOVE LISA DEBUGGING MACRO CALL: DEBUGEND (CRL)
; 24JAN90: MODIFIED FOR 68020 SOFTWARE SANE (JPO)
;
;-----------------------------------------------------------

;-----------------------------------------------------------
;-----------------------------------------------------------
; THIS IS THE SOLE ENTRY POINT OF THE PACKAGE.
; THE STACK HAS THE FORM:
;	<RET> <OPWORD> <ADRS1> <ADRS2> <ADRS3>
; WHERE THE NUMBER OF ADDRESSES DEPENDS ON THE OPERATION.
; MOST USE 2, SOME 1, ONLY BIN->DEC USES 3.
;
; FIRST GROW THE STACK TO HOLD: <TRAP VECTOR> <BYTE COUNT>
; BELOW <RET> IN CASE A TRAP IS TAKEN.
;
; THEN SAVE REGISTERS D0-D7, A0-A4.
;-----------------------------------------------------------
;-----------------------------------------------------------

FP020	PROC	EXPORT
	LINK	A6,#-2			; RESERVE CNT WORD
	MOVEM.L	D0-D7/A0-A4,-(SP)	; SAVE REGISTERS

;-----------------------------------------------------------
; GET POINTER TO ENVIRONMENT AREA IN A0, USING SYSTEM CONVENTION.
;	MOVEA.W #FPState,A0
;	...WHERE FPState IS DEFINED IN FPEQUS.a
;-----------------------------------------------------------
	MOVEA.W	#FPSTATE,A0

	BRA.S	FPCOM		; CONTINUE BELOW

;-----------------------------------------------------------
; THIS IS A TABLE OF INFORMATION BITS FOR THE VARIOUS
; OPERATIONS.  SEE COMMENT BELOW FOR EXPLANATION
;-----------------------------------------------------------
OPMASKS:
	DC.W	$0E1	; ADD
	DC.W	$0E1	; SUB
	DC.W	$0E1	; MUL
	DC.W	$0E1	; DIV
	DC.W	$0C1	; CMP
	DC.W	$0C1	; CMPX
	DC.W	$0E1	; REM
	DC.W	$061	; 2EXT
	DC.W	$161	; EXT2
	DC.W	$0A0	; SQRT
	DC.W	$0A0	; RINT
	DC.W	$0A0	; TINT
	DC.W	$0A1	; SCALB -- LIKE SQRT, LEAVE INT
	DC.W	$0A0	; LOGB -- LIKE SQRT
	DC.W	$041	; CLASS -- SRC IN, INT PTR IS DST

;-----------------------------------------------------------
; ALTERNATIVE ENTRY POINT TO BYPASS RECALC OF STATE PTR.
;-----------------------------------------------------------
REFP020:
	LINK	A6,#-2		; RESERVE CNT WORD
	MOVEM.L	D0-D7/A0-A4,-(SP)

FPCOM:

;-----------------------------------------------------------
; GET OPWORD INTO D6.LO; AFTER DECODING, WILL GO TO D6.HI.
;-----------------------------------------------------------
	MOVE.W	LKOP(A6),D6

;-----------------------------------------------------------
; HANDLE ODD INSTRUCTIONS (STATE AND BIN-DEC) ELSEWHERE.
;-----------------------------------------------------------
	MOVEQ	#OPAMASK,D7	; ISOLATE OP INDEX
	AND.W	D6,D7

	BCLR	#0,D6		; TEST AND CLEAR ODD BIT
	BNE	ODDBALL

;-----------------------------------------------------------
; FOR ARITHMETIC OPERATIONS, CLEAR ROUND INCREMENT BIT IN
; LOW BYTE OF STATE WORD.
;
; Also, clear 96-bit extended format bit (#FPX96) in D6 since
; that bit position identifies comparisons
;-----------------------------------------------------------
	BCLR	#RNDINC,1(A0)
	BCLR	#FPX96,D6
;-----------------------------------------------------------
; SAVE INDEX IN D7.LO FOR LATER JUMP.
; PICK UP USEFUL INFO BITS FROM TABLE, AFTER WHICH HAVE:
;	8000 - IF SINGLE OP
;	4000 - IF DOUBLE OP
;	3800 - "NONEXTENDED" OPERAND -- WILL BE SRC FORMAT
;	0100 - IF "NONEXTENDED" IS DST
;	0700 - WILL BE DST FORMAT
;	0080 - IF DST IS INPUT
;	0040 - IF SRC IS INPUT
;	0020 - IF DST IS OUTPUT (IDENTIFIES COMPARISONS)
;	001E - OP CODE
;	0001 - IF 2 ADDRESSES ON STACK
;-----------------------------------------------------------
	OR.W	OPMASKS(D7),D6

;-----------------------------------------------------------
; TWO CASES MUST BE DISTINGUISHED:
;	DST = EXTENDED, SRC = ANY	(USUAL)
;	DST = ANY,	SRC = EXTENDED	(CONVERSIONS)
; THE "ANY" FORMAT IS IN BITS 3800 (SRC).  BIT 0100
; DETERMINES WHETHER IT SHOULD BE DST IN BITS 0700.
; AFTER TEST ABOVE HAVE FORMAT BITS ISOLATED IN D0.
;
; IF FORMAT GOVERNS DST OPERAND, IT OVERRIDES 2 LEADING
; CONTROL BITS.	 NOTE THAT EVEN EXTRANEOUS INTEGER BITS
; OVERRIDE CONTROL BITS, BUT THEY HAVE NO EFFECT.
;
; IN ANY CASE, MOVE PRECISION CONTROL BITS TO HIGH BITS OF D6.
;-----------------------------------------------------------
	MOVEQ	#PRECMSK,D0	; GET ONLY PRECISION CONTROL
	AND.B	1(A0),D0
	ROR.W	#7,D0		; ALIGN $0060 AS $C000
	OR.W	D0,D6

        BTST    #8,D6
        BEQ.S   @2

        MOVE.W  D6,D0           ; SAVE FORMAT BITS
        ANDI.W  #$00FF,D6       ; KILL ALL FORMAT BITS

        ANDI.W  #$3800,D0       ; ISOLATE FORMAT BITS
        MOVE.W  D0,D1           ; COPY FOR CONTROL BITS
        LSR.W   #3,D0           ; SRC -> DST POSITION
        LSL.W   #3,D1           ; ALIGN 2 TRAILING BITS
        OR.W    D0,D6
        OR.W    D1,D6

;-----------------------------------------------------------
; PLACE OPWORD IN D6.HI WHERE IT WILL STAY.
; INIT TO ZERO D2,3 = INDEXES FOR CASES,
; D6.LO = FLAGS & SIGNS.
; BY NOW, D7.HI = JUNK, D7.LO = OPERATION INDEX.
;-----------------------------------------------------------
@2:
	SWAP	D6
	MOVEQ	#0,D2
	MOVE.L	D2,D3
	MOVE.W	D2,D6

;-----------------------------------------------------------
; POST-DECODE MILESTONE ++++++++++++++++++++++++++++++++++ .
;-----------------------------------------------------------

;-----------------------------------------------------------
; NOW UNPACK OPERANDS, AS NEEDED.  DST, THEN SRC.
; LAST OPERAND IS IN D4,5/A4/D6.B.#7
; FIRST OPERAND, IF 2, IS IN A1,2/A3/D6.B.#6
; UNPACK ROUTINE EXPECTS (FORMAT*2) IN DO AND ADRS IN A3.
;-----------------------------------------------------------
	BTST	#DSTIN+16,D6
	BEQ.S	@3

	MOVE.L	D6,D0		; GET OPWORD AND ALIGN DST
	SWAP	D0
	ROR.W	#7,D0
	MOVEA.L	LKADR1(A6),A3	; DST ADDRESS
	BSR	UNPACK
@3:

;-----------------------------------------------------------
; IF SOURCE IN, MOVE DST OP OVER (EVEN IF NONE INPUT)
; ALSO, BUMP INDEXES IN D2,D3.
; IN ORDER TO USE A3 TO CALL UNPACK, MUST SAVE DST EXP (IN
; A4) ACCROSS CALL, THEN RESTORE TO A3.
;-----------------------------------------------------------
	BTST	#SRCIN+16,D6
	BEQ.S	@4

	MOVEA.L	D4,A1		; HI BITS
	MOVEA.L	D5,A2		; LO BITS
	MOVE.L	A4,-(SP)	; SAVE EXP ON STACK FOR CALL
	ROR.B	#1,D6		; SIGN

	ADD.W	D2,D2		; NAN INDEX (NEG, 2, 4, 6)
	MOVE.W	D3,D0		; NUM INDEX (0 - 16)
	ADD.W	D3,D3
	ADD.W	D0,D3

	MOVE.L	D6,D0
	SWAP	D0
	ROL.W	#6,D0
	MOVEA.L	LKADR2(A6),A3	; SRC ADDRESS
	BSR	UNPACK
	MOVEA.L (SP)+,A3	; RESTORE DST EXP
@4:

;-----------------------------------------------------------
; CONVENIENT HERE TO PUT XOR OF SIGNS IN D6(#5).
;-----------------------------------------------------------
	ASL.B	#1,D6		; V = XOR OR SIGNS
	BVC.S	@6
	BSET	#6,D6
@6:
	ROXR.B	#1,D6

;-----------------------------------------------------------
; POST-UNPACK MILESTONE +++++++++++++++++++++++++++++++++++.
;-----------------------------------------------------------

;-----------------------------------------------------------
; NOW PUSH A RETURN ADDRESS AND JUMP TO 3 CASES.
; REMEMBER OPERATION INDEX IN D7, WHICH MUST BE ZEROED.
;-----------------------------------------------------------
	MOVE.W	D7,D0		; FREE D7 FOR INIT
	MOVEQ	#0,D7

	PEA	PREPACK

	TST.W	D2		; NANS DISCOVERED?
	BNE	NANS

;-----------------------------------------------------------
; DO-ARITHMETIC MILESTONE ++++++++++++++++++++++++++++++++ .
;-----------------------------------------------------------

ARITHOP:
	MOVE.W	ARITHTAB(D0),D0
	JMP	ARITHOP(D0)

;-----------------------------------------------------------
; JUMP TO ARITHMETIC ROUTINE BASED ON INDEX SAVED IN D7.
;-----------------------------------------------------------
ARITHTAB:
	DC.W	ADDTOP-ARITHOP
	DC.W	SUBTOP-ARITHOP
	DC.W	MULTOP-ARITHOP
	DC.W	DIVTOP-ARITHOP
	DC.W	CMPTOP-ARITHOP
	DC.W	CMPTOP-ARITHOP	; CMPX NOT SPECIAL
	DC.W	REMTOP-ARITHOP
	DC.W	CVT2E-ARITHOP
	DC.W	CVTE2-ARITHOP
	DC.W	SQRTTOP-ARITHOP
	DC.W	RINT-ARITHOP
	DC.W	TINT-ARITHOP
 	DC.W	SCALBTOP-ARITHOP
	DC.W	LOGBTOP-ARITHOP
	DC.W	CLASSTOP-ARITHOP

;-----------------------------------------------------------
; PRE-PACK MILESTONE +++++++++++++++++++++++++++++++++++++ .
;-----------------------------------------------------------

;-----------------------------------------------------------
; PACK AND DELIVER IF OUTPUT OPERAND (SKIP COMPARES)
;-----------------------------------------------------------
PREPACK:
	BTST	#DSTOUT+16,D6
	BEQ.S	CHKERR

	MOVE.L	D6,D0		; GET OPWORD AND ALIGN DST
	SWAP	D0
	ROR.W	#7,D0
	BSR	PACK

;-----------------------------------------------------------
; ALIGN CCR BITS FROM D7.HI TO D7.LO.
; OR ERROR FLAGS INTO STATE WORD, STUFF STATE WORD, AND
; CHECK FOR A TRAP.
;-----------------------------------------------------------
CHKERR:
	SWAP	D7		; RIGHT ALIGN CCR BITS

	MOVE.W	(A0),D0		; GET STATE WORD
	CLR.B	D6		; KILL SIGNS
	OR.W	D6,D0
	MOVE.W	D0,(A0)+	; BUMP ADRS TO VECTOR

	LSR.W	#8,D6		; ALIGN BYTES
	AND.W	D6,D0
	BEQ.S	PASTHALT	; ZERO IF NO TRAP

;-----------------------------------------------------------
; TO SET UP FOR TRAP:
;	HAVE D0 ON TOP OF STACK.
;	PUSH CCR
;	PUSH PENDING HALT EXCEPTIONS (D0.W)
;	PUSH ADDRESS OF 4-WORD STRUCTURE
;	BLOCK MOVE:  OPCODE < ADR1 < ADR2 < ADR3 < REGADR
;	  TO STACK
;	CALL HALT PROCEDURE, EXPECTING PASCAL CONVENTIONS TO
;	  BE HONORED.
; THE BLOCK MOVE CAN BE DONE WITH A PAIR OF MOVEM'S SO LONG
; AS AN EXTRA WORD IS COPIED (TO HAVE A WHOLE NUMBER OF
; LONGS).
;-----------------------------------------------------------

	MOVE.W	D7,-(SP)	; SAVE CCR BELOW D0
	MOVE.W	D0,-(sp)	; SAVE PENDING EXCEPTIONS
	PEA	(SP)		; ADDRESS OF CCR/D0

	MOVEM.L LKRET+2(A6),D0-D3
	MOVEM.L D0-D3,-(SP)	; PUSH ADDRESSES AND OPCODE ON STACK
	ADDQ.L	#2,SP 		; KILL EXTRA WORD

;-----------------------------------------------------------
; IN MAC ENVIRONMENT, MUST LOCK MATH PACKAGE BEFORE CALLING
; EXTERNAL PROCEDURE THAT WILL EXPECT TO RETURN.
;-----------------------------------------------------------

	MOVEA.L	(A0),A0		; GET VECTOR ADRS
	JSR	(A0)

	MOVE.L	(SP)+,D7	; RESTORE CCR BITS

;-----------------------------------------------------------
; AFTER TRAP JUST RESTORE REGISTERS, KILL STACK STUFF, AND
; RETURN.  TRICK: LOAD INCREMENT TO STACK JUST BELOW REGS,
; SO ACCESSIBLE AFTER MOVEM.L.
;-----------------------------------------------------------
PASTHALT:
	BTST	#TWOADRS+16,D6
	BEQ.S	POP1
POP2:
	MOVEQ	#STKREM2,D0
	MOVEQ	#LKADR2,D1
	BRA.S	POPIT
POP1:
	MOVEQ	#STKREM1,D0
	MOVEQ	#LKADR1,D1
POPIT:
	MOVE.W	D0,LKCNT(A6)		; KILL COUNT
	MOVE.L	LKRET(A6),0(A6,D1)	; MOVE RETURN DOWN
	MOVEA.L	(A6),A6			; UNLINK MANUALLY
	MOVE	D7,CCR
	MOVEM.L (SP)+,D0-D7/A0-A4
	ADDA.W	(SP),SP
	RTS

;-----------------------------------------------------------
; THE ONLY THREE-ADDRESS OPERATION IS BINARY TO DECIMAL
; CONVERSION.  POP3 IS JUMPED TO FROM THE END OF THAT OP.
; NOTE THAT BIN2DEC CANNOT ITSELF TRAP, SO THE CODE AFTER
; @1 ABOVE IS IRRELEVANT.
;-----------------------------------------------------------
POP3:
	MOVEQ	#STKREM3,D0
	MOVEQ	#LKADR3,D1
	BRA.S	POPIT



;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPUNPACK
;-----------------------------------------------------------
;-----------------------------------------------------------

;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 10AUG82: MINOR CLEANUPS (JTC)
; 18JAN83: FORCE COMP NAN CODE ON UNPACK OF COMP64.
; 29APR83: CLASS OPERATION NEEDS TO KNOW WHEN DENORM IS
;	UNPACKED.  USE HI BIT OF HI WORD OF D3, THE REG
;	HOLDING THE OPERAND TYPE INFO. (JTC)
; 09JUN83: USE A3 FOR ADRS, RATHER THAN A5 (JTC).
; 01NOV83: ALL NANS UNPACKED THE SAME; INVALID SET FOR SIGNALING (JTC).
; 26MAR85: FIX CLASS COMP BUG; FLIP STATE OF QUIET NAN BIT (JTC).
; 24JAN90: MODIFIED FOR 68020 INSTRUCTIONS (JPO)
; 20MAR90: MODIFIED FOR UNPACKING OF 96-BIT EXTENDED VALUES
;
; ASSUME REGISTER MASK: POST-DECODE, WITH DIRTY INDEX IN D0.
; UNPACK DST, SRC IN TURN, IF INPUT, AND SET UP D2 WITH
;	NAN INFORMATION, D3 WITH NUMBER INFORMATION.
;
;	D2:  2 --> LATTER OPERAND IS NAN
;	     4 --> FIRST OF TWO OPERANDS IS NAN
;	     6 --> BOTH NANS
;
;	D3:  0 --> BOTH ARE NUMS
;	     2 --> FORMER IS NUM, LATTER IS 0
;	     4 --> FORMER IS NUM, LATTER IS INF
;	     6 --> FORMER IS 0,	  LATTER IS NUM
;	     8 --> BOTH ARE 0
;	    10 --> FORMER IS 0,	  LATTER IS INF
;	    12 --> FORMER IS INF, LATTER IS NUM
;	    14 --> FORMER IS INF, LATTER IS 0
;	    16 --> BOTH ARE INF
;
; INPUT OPERAND ADDRESS IN A3.
; UNPACK LEAVES SIGN IN HIGH BIT OF D6 BYTE, EXP IN A4, AND
; DIGITS IN D4,5.  SINCE INPUT INTEGERS ARE ALWAYS CONVERTED
; TO EXTENDED, LOAD AND NORMALIZE THEM.
; UNPACKING IS DONE IN TWO STAGES; FIRST, UNPACK AS ABOVE
; BUT LEAVE A WORD EXP IN D0; SECOND, SET THE CONTROL BITS
; FOR SPECIAL CASES AND MOVE THE EXP TO A4.
; THE ADDRESS IN A3 IS UNCHANGED, IN CASE IT'S NEEDED FOR
; OUTPUT.
; D1 is a scratch register used in unpacking some formats.
;-----------------------------------------------------------

;-----------------------------------------------------------
; UNPACK-TOP MILESTONE +++++++++++++++++++++++++++++++++++ .
;-----------------------------------------------------------

UNPACK:
	ANDI.W	#$000E,D0	; GET FORMAT OFFSET

	MOVE.W	UNPCASE(D0),D0
	JMP	UNPACK(D0)

UNPCASE:
	DC.W	UNPEXT - UNPACK	; EXTENDED
	DC.W	UNPDBL - UNPACK	; DOUBLE
	DC.W	UNPSGL - UNPACK	; SINGLE
	DC.W	UNPEXT - UNPACK	; --- ILLEGAL
	DC.W	UNPI16 - UNPACK	; INT16
	DC.W	UNPI32 - UNPACK	; INT32
	DC.W	UNPC64 - UNPACK	; COMP64

;-----------------------------------------------------------
; INT16 HAS SPECIAL CASE 0, ELSE NORMALIZE AND GO.
;-----------------------------------------------------------
UNPI16:
	MOVE.W	#$400E,D0	; SET EXP FOR SHORT INTEGER
	MOVEQ	#0,D4		; ZERO D4 AND D5
	MOVE.L	D4,D5
	MOVE.W	(A3),D4		; GET OPERAND
	SWAP	D4		; LEFT ALIGN
	BRA.S	UNPIGEN

;-----------------------------------------------------------
; INT32 HAS SPECIAL CASE 0, ELSE NORMALIZE AND GO.
;-----------------------------------------------------------
UNPI32:
	MOVE.W	#$401E,D0	; SET EXP FOR LONG INTEGER
	MOVEQ	#0,D5		; ZERO D5
	MOVE.L	(A3),D4		; GET OPERAND
UNPIGEN:
	BEQ	UNP0		; zero
	BPL.S	UNPIUNR		; POSITIVE. NORMALIZE
	
	BSET	#7,D6		; NEGATIVE. SET SIGN IN D6
	NEG.L	D4		; NEGATE D4
	BMI	UNPNRM		; ALREADY NORMALIZED IF = $80000000

;-----------------------------------------------------------
; Normalization for D4 > 0 and D5 = 0
;-----------------------------------------------------------
UNPIUNR:
	BFFFO	D4{0:0},D1	; find first one bit
	SUB.W	D1,D0		; adjust exponent
	LSL.L	D1,D4		; shift significand
	BRA	UNPNRM		; NORMALIZED

;-----------------------------------------------------------
; COMP64 HAS SPECIAL CASES 0 AND INF, ELSE NORMALIZE AND GO.
;-----------------------------------------------------------
UNPC64:
	MOVE.W	#$403E,D0	; SET EXP FOR 64-BIT INTEGER
	MOVE.L	(A3),D4		; GET HI OPERAND
	MOVE.L	4(A3),D5	; GET LO OPERAND
	BNE.S	@7		; HAVE REGULAR NUMBER

	TST.L	D4		; LOW HALF ZERO. TEST HIGH HALF
	BEQ.S	UNP0		; COMP ZERO
	BPL.S	UNPIUNR		; FAST NORMALIZATION OF POSITIVE
	
	BSET	#7,D6		; FLAG NEGATIVE IN D6
	NEG.L	D4		; NEGATE HIGH HALF
	BPL.S	UNPIUNR		; FAST NORMALIZATION

	MOVEA.W	#$7FFF,A4	; COMP NAN. SET THE EXPONENT
	BCLR	#7,D6		; CLEAR SIGN BIT
	MOVEQ	#NANCOMP,D4	; SET COMP NAN CODE
	SWAP	D4		; ALIGN BYTE
	BSET	#QNANBIT,D4	; MAKE IT QUIET!
	ADDQ.W	#2,D2		; FLAG NAN
	RTS			; RETURN
	
@7:				; COMP LOW HALF NONZERO
	TST.L	D4		; TEST HIGH HALF
	BPL.S	@9		; NONNEGATIVE
	
	BSET	#7,D6		; MARK AS NEGATIVE
	NEG.L	D5		; NEGATE
	NEGX.L	D4
	TST.L	D4		; TEST HIGH HALF

@9:
	BNE.S	UNPCUNR		; NONZERO HIGH HALF. NORMALIZE
	
	SUBI.W	#$0020,D0	; HIGH HALF ZERO; REDUCE EXPONENT
	EXG	D4,D5		; EXCHANGE HIGH/LOW HALVES
	TST.L	D4
	BPL.S	UNPIUNR		; NORMALIZE IF NECESSARY
	BRA.S	UNPNRM

;-----------------------------------------------------------
; UNPACK AN EXTENDED: JUST SEPARATE THE SIGN AND LOOK FOR
; CASES.  NOTE THAT THIS CASE MAY FALL THROUGH TO UNPZUN.
; TEST THE OPWORD ON THE STACK TO DETERMINE WHICH FORMAT
; (80- OR 96-BIT EXTENDED) TO UNPACK.
;-----------------------------------------------------------
UNPEXT:
	MOVE.W	(A3),D0		; SIGN AND EXP
	BPL.S	@10

	BSET	#7,D6		; SET SIGN
	BCLR	#15,D0		; CLEAR OPERAND SIGN
@10:
	BTST	#FPX96,LKOP+1(A6) ; 96-BIT EXTENDED?
	BEQ.S	@11		;   NO. 80-BIT

	MOVE.L	4(A3),D4	; YES. GET SIG
	MOVE.L	8(A3),D5
	BRA.S	@12		; CONTINUE BELOW

@11:
	MOVE.L	2(A3),D4	; GET SIG FROM 80-BIT EXTENDED
	MOVE.L	6(A3),D5

@12:
	CMPI.W	#$7FFF,D0	; MAX EXP?
	BEQ.S	UNPNIN

	TST.L	D4		; LOOK AT LEAD BITS
	BMI.S	UNPNRM		; NORMALIZED CASE
				; BPL.S FALLS THROUGH

;-----------------------------------------------------------
; HERE DISTINGUISH SPECIAL CASES AND SET BITS IN D2,D3.
;-----------------------------------------------------------
UNPZUN:
	TST.L	D4		; LEAD DIGS = 0?
	BNE.S	UNPUNR
	TST.L	D5
	BNE.S	UNPUNR
UNP0:
	SUBA.L	A4,A4		; EXP <- 0
	ADDQ.W	#2,D3		; MARK AS ZERO
	RTS

;-----------------------------------------------------------
; HI BIT OF D3 USED TO MARK UNNORMAL OPERAND.  WHEN USED AS
; A JUMP TABLE INDEX, D3 IS ACCESSED AS A WORD.
;-----------------------------------------------------------
UNPUNR:
	BSET	#31,D3		; SPECIAL UNNORM FLAG
UNPCUNR:			; ENTER HERE TO NORMALIZE INTEGERS, QUIETLY	<26MAR85>
	SUBQ.W	#1,D0		; DECREMENT EXP
	ADD.L	D5,D5
	ADDX.L	D4,D4
	BPL.S	UNPCUNR		; NEW LABEL	<26MAR85>

UNPNRM:
	EXT.L	D0
	MOVEA.L D0,A4		; 32-BIT EXP
	RTS
UNPNIN:
	MOVEA.W #$7FFF,A4	; MAX EXP
	BCLR	#31,D4		; IGNORE INT BIT
	TST.L	D4
	BNE.S	UNPNAN
	TST.L	D5
	BNE.S	UNPNAN

	ADDQ.W	#4,D3		; MARK INF
	RTS
;-----------------------------------------------------------
; SET THE SIGNALING BIT (#30).  IF IT WAS CLEAR THEN SIGNAL
; INVALID.
;-----------------------------------------------------------
UNPNAN:
	BSET	#QNANBIT,D4	; TEST IT, TOO	<26MAR85>
	BNE.S	@1		; IF 1, THEN QUIET	<26MAR85>
	BSET	#ERRI+8,D6
@1:
	ADDQ.W	#2,D2		; JUST A NAN
	RTS


;-----------------------------------------------------------
; UNPACK A SINGLE.  NOTE THAT DENORMS ARE UNPACKED WITHOUT
; THE LEADING BIT, SO EXPONENT MUST BE ADJUSTED.
;-----------------------------------------------------------
UNPSGL:
	MOVEQ	#0,D5		; zero significand low half
	MOVE.L	(A3),D4		; read single-precision into D4
	BPL.S	@21		; not negative
	
	BSET	#7,D6		; negative; mark in D6
@21:
	BFEXTU	D4{1:8},D0	; extract exponent into D0
	BEQ.S	@23		; ZERO or subnormal single
	
	LSL.L	#8,D4		; shift significand just short of bit 31
	CMPI.B	#$0FF,D0	; max exp?
	BEQ.S	UNPNIN		;   yes; NaN or INFINITE
	
	ADDI.W	#$3F80,D0	; normalized; bias exponent
	BSET	#31,D4		; set explicit bit
	BRA.S	UNPNRM
	
@23:
	LSL.L	#8,D4		; shift significand	
	MOVE.W	#$3F81,D0	; assume single subnormal; bias exponent
	BRA.S	UNPZUN		; unpack zero or unnormalized


;-----------------------------------------------------------
; UNPACKING A DOUBLE IS LIKE A SINGLE, BUT HARDER BECAUSE
; OF THE SHIFT REQUIRED FOR ALIGNMENT.
;-----------------------------------------------------------
UNPDBL:
	MOVE.L	(A3),D4		; HI BITS
	BPL.S	@25

	BSET	#7,D6		; SET SIGN
@25:
	MOVE.L	4(A3),D5	; LO BITS

;-----------------------------------------------------------
; DOUBLE OPERANDS APPEAR AS:  (1) (11) (1 IMPLICIT) (53)
; SO MUST ALIGN BITS LEFT BY 11 AND INSERT LEAD BIT.
; Do via shifts and bit field instructions.
;-----------------------------------------------------------
	BFEXTU	D4{1:11},D0	; extract exponent into D0
	BFEXTU	D5{0:11},D1	; extract 11 high bits of D5
	LSL.L	#8,D4		; shift D4 and D5 left 11 places
	LSL.L	#8,D5
	LSL.L	#3,D4
	LSL.L	#3,D5
	OR.W	D1,D4		; move 11 bits to D4 low end
	BCLR	#31,D4		; clr explicit bit initially
	TST.L	D0		; test exponent
	BNE.S	@31		; normalized, infinite, or NaN
	
	MOVE.W	#$3C01,D0	; zero or unnormalized
	BRA	UNPZUN
@31:
	CMPI.W	#$07FF,D0	; max exp?
	BEQ.S	UNPNIN		; yes, NaN or INF
	
	BSET	#31,D4		; normalized number; set explicit bit
	ADDI.W	#$3C00,D0	; bias exponent
	BRA	UNPNRM


;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPNANS
;-----------------------------------------------------------
;-----------------------------------------------------------

;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 10AUG82: HAVE SINGLE JUMP POINT AGAIN. (JTC)
; 28DEC82: DELIVER INTEGER NANS RIGHT HERE, NOT IN CVT (JTC)
; 29APR83: CLASS FUNCTION ADDED, SO NEED A QUICK EXIT FROM
;	NAN HANDLER TO CODE TO RETURN APPROPRIATE VALUE.
;	SLEAZY TRICK: USE HI BIT OF OPCODE 001E TO
;	DISTINGUISH THE TWO INSTRUCTIONS. (JTC)
; 01NOV83: TREAT SIGNAL NAN AS ANY OTHER (JTC).
; 26MAR85: FLIP STATE OF QUIET NAN BIT (JTC).	<26MAR85>
;
; NAN HANDLER DEPENDS ON REGISTER MASK: POST-UNPACK.
; ON ENTRY HAVE JUST TST'ED D2, THE NAN CODE REGISTER.
;-----------------------------------------------------------

;-----------------------------------------------------------
; THIS IS TARGET OF ALL INVALID OPERATIONS FOUND DURING
; OPERATIONS.  BITS IN D0 000000XX MUST GO TO 00XX0000.
;-----------------------------------------------------------
INVALIDOP:
	BSET	#ERRI+8,D6
	SWAP	D0		; ALIGN CODE BYTE
	BSET	#QNANBIT,D0	; MARK IT QUIET	<26MAR85>
	MOVE.L	D0,D4
	MOVEQ	#0,D5		; CLEAR LO HALF
	MOVEA.W #$7FFF,A4	; SET EXPONENT
	BRA.S	NANCOERCE


NANS:
;-----------------------------------------------------------
; ONE NAN: STUFF IT.  TWO NANS: TAKE ONE WITH LARGER
; CODE, OR CONVENIENT (SRC) IF THE CODES ARE =.
; D2: 2-SRC 4-DST 6-BOTH
; MUST NOT DESTROY CODE IN D2.
;-----------------------------------------------------------
QNANS:
	CMPI.W	#2,D2
	BEQ.S	NANSRC
	CMPI.W	#4,D2
	BEQ.S	NANDST

NANPRE:
	MOVE.L	#$00FF0000,D0	; MASK FOR CODE
	MOVE.L	A1,D1		; DST.HI
	AND.L	D0,D1		; DST CODE BYTE
	AND.L	D4,D0		; SRC CODE BYTE
	CMP.L	D0,D1		; DST - SRC
	BLE.S	NANSRC
NANDST:
	ROL.B	#1,D6		; SIGN
	MOVEA.L	A3,A4		; EXP
	MOVE.L	A2,D5		; LO DIGS
	MOVE.L	A1,D4		; HI DIGS
NANSRC:


;-----------------------------------------------------------
; BE SURE NAN FITS IN DST, BY CHOPPING TRAILING BITS AND
; STORING "ZERO NAN" IF NECESSARY.
; FIRST, BRANCH OUT ON CMP, INTEGER CASES.  THE TRICK FOR
; INTEGER RESULTS IS TO FORCE THE MAX COMP VALUE
;-----------------------------------------------------------
NANCOERCE:
	BTST	#DSTINT+16,D6	; INTXX OR COMP64 RESULT?
	BEQ.S	NANFLOAT	; FLOATING RESULT...

;-----------------------------------------------------------
; DELIVER A MAXINT IN EACH OF THE 3 INTEGER FORMATS.
; SIGNAL INVALID FOR INT16 AND INT32 NAN RESULTS.
; FOR COMP64, WANT SIGNAL ONLY IF SNAN, BUT ALREADY HAVE
; SIGNAL FROM ABOVE SO DIFFERENCE IS IRRELEVANT HERE.
; FORMAT CODES:	 4-INT16  5-INT32  6-COMP64  IN D6.HI.
; VALUES: INT16 -- 00000000 00008000
;	  INT32 -- 00000000 80000000
;	  COMP  -- 80000000 00000000
;-----------------------------------------------------------
	MOVEQ	#0,D4		; 0 --> D4
	MOVEQ	#1,D5		; $80000000 --> D5
	ROR.L	#1,D5

	BTST	#DSTLO+16,D6	; BB1 --> INT32
	BNE.S	@21
	BTST	#DSTMD+16,D6	; B10 --> COMP64
	BNE.S	@41

	SWAP	D5
@21:
	BSET	#ERRI+8,D6
	RTS
@41:
	EXG	D4,D5
	RTS


;-----------------------------------------------------------
; THE NON-INTEGER OPERATIONS ARE OF TWO TYPES: THOSE THAT
; HAVE A FLOATING RESULT (THE USUAL) AND THOSE THAT DO NOT
; (COMPARE AND CLASS).  DISTINGUISH THE LATTER ACCORDING TO
; THE HI OPCODE BIT.  (0 FOR CMP, 1 FOR CLASS).
;-----------------------------------------------------------
NANFLOAT:
	BTST	#DSTOUT+16,D6	; IS IT A CMP OR CLASS?
	BNE.S	FPNANOUT

;-----------------------------------------------------------
; COMPARE OR CLASSIFY
;-----------------------------------------------------------
	BTST	#OPHIBIT+16,D6	; 0 = CMP
	BNE.S	@5
	MOVEQ	#CMPU,D0	; COMPARE; MARK UNORERED
	BRA	CMPFIN
@5:
	MOVEQ	#1,D0		; CLASSIFY. SNAN = 1, QNAN = 2
	BCLR	#ERRI+8,D6	; INVALID SET -> SNAN. CLR INVALID
	BNE.S	@7

	ADDQ.W	#1,D0
@7:
	BRA	CLASSFIN

;-----------------------------------------------------------
; FLOATING-POINT NAN RESULT
;-----------------------------------------------------------
FPNANOUT:
	BTST	#SPREC+16,D6	; CHECK FOR SINGLE
	BEQ.S	@1

	MOVEQ	#0,D5
	MOVE.B	D5,D4
	BRA.S	@2
@1:
	BTST	#DPREC+16,D6	; CHECK FOR DOUBLE
	BEQ.S	@2

	ANDI.W	#$0F800,D5

;-----------------------------------------------------------
; CHECK FOR INTERESTING NAN BITS, GIVE SPECIAL CODE IF NONE.
;-----------------------------------------------------------
@2:
	MOVE.L	D4,D0		; CHECK FOR ALL 0
	BCLR	#QNANBIT,D0	; DISREGARD THE QUIET BIT	<26MAR85>
	OR.L	D5,D0
	BNE.S	@3

	MOVEQ	#NANZERO,D4	; SPECIAL NAN
	SWAP	D4
	BSET	#QNANBIT,D4	; MARK IT QUIET			<26MAR85>
@3:
	RTS




;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPCOERCE
;-----------------------------------------------------------
;-----------------------------------------------------------

;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 11AUG82: CLEANUP
; 01SEP82: RND MODE ENCODING CHANGED (JTC)
; 12DEC82: UFLOW DEFINITION CHANGED TO SUPPRESS SIGNAL WHEN
;	RESULT IS EXACT, EVEN IF TINY (JTC)
; 13APR83: COMMENT OUT THE TRAP BYPASS CODES FOR OVERFLOW
;	AND UNDERFLOW, SO DEFAULT RESULT IS ALWAYS DELIVERED.
;	(JTC)
; 04APR84: FIXED BUG IN DCOERCE (JTC)
; 25JAN90: MODIFIED FOR 68020 SANE
;
; FOR LACK OF A BETTER PLACE, THESE FIRST UTILITIES ARE
; STUCK WITH THE COERCION ROUTINES.
;-----------------------------------------------------------

;-----------------------------------------------------------
; THESE ROUTINES HANDLE THE SPECIAL CASES IN OPERATIONS
; WHEN ONE OR THE OTHER OF THE OPERANDS IS THE RESULT.
; SUBCASES DEPEND ON WHETHER THE SIGN SHOULD BE
; STUFFED TOO.  THE SRC-IS-RES IS ALWAYS TRIVIAL.
;-----------------------------------------------------------
RDSTSGN:
	ADD.B	D6,D6		; SHIFT DST SIGN TO BIT #7
RDST:
	MOVE.L	A1,D4
	MOVE.L	A2,D5
	MOVEA.L A3,A4		; EXP TOO
RSRCSGN:
RSRC:
	RTS


;-----------------------------------------------------------
; Subroutine RTSHIFT.
;
; This is the right shifter used in subnormal coercion, IPALIGN ...
; Shift count in D0 > 0; Shift registers are D4/D5/D7.W (stickies)
; Uses D1 as scratch register.
;-----------------------------------------------------------
RTSHIFT:
	SWAP	D7		; put stickies in D7.HI
	CLR.W	D7		; zero D7.LOW
	CMPI.W	#66,D0		; high shift counts pin to 66
	BLS.S	@1
	MOVE.W	#66,D0
@1:
	CMPI.W	#32,D0		; count < 32?
	BLT.S	@3		; yes. do shift
	TST.L	D7		; no. set stickies if D7 nonzero
	SNE	D1
	MOVE.L	D5,D7		; shift D4/D5 into D5/D7
	MOVE.L	D4,D5
	OR.B	D1,D7		; OR in low stickies
	MOVEQ	#0,D4		; zero D4
	SUBI.W	#32,D0		; decr count by 32
	BNE.S	@1		; loop if nonzero
	BRA.S	@5		; otherwise, done

@3:				; right shift of 1-31 bits
	BFINS	D7,D1{0:D0}	; test low bits
	SNE	D1		; set sticky state in D1
	LSR.L	D0,D7		; shift D7 right
	BFINS	D5,D7{0:D0}	; shift bits from D5 low to D7 high
	LSR.L	D0,D5		; shift D5 right
	BFINS	D4,D5{0:D0}	; shift bits from D4 low to D5 high
	LSR.L	D0,D4		; shift D4
	OR.B	D1,D7		; OR in low stickies
	
@5:
	TST.W	D7		; shift stickies back to D7.W
	SNE	D1
	CLR.W	D7
	SWAP	D7
	OR.B	D1,D7

	RTS			; done





;-----------------------------------------------------------
; ASSUME POST-OPERATION REGISTER MASK, WITH RESULT IN
; D7.B, A4, D4,5.  COERCE ACCORDING TO BITS IN D6.W.
;
; USUALLY ASSUME OPERAND IS A NONZERO, FINITE NUMBER.
; VARIANTS WILL NORMALIZE THE NUMBER, EVEN CHECKING
; IT FOR ZERO FIRST.
;-----------------------------------------------------------

;-----------------------------------------------------------
; CHECK VALUE FIRST, EXIT IF ZER0, WITH EXP FIX.  Called only
; by remainder routine, which zeros D7 (REM is exact).
;-----------------------------------------------------------
ZNORMCOERCE:
	TST.L	D4
	BNE.S	NORMCOERCE
	TST.L	D5
	BNE.S	NORMCOERCE

	SUBA.L	A4,A4		; SET EXP TO 0
	RTS			; NEVER COERCE 0

;-----------------------------------------------------------
; ASSUME, AS AFTER SUBTRACT THAT VALUE IS NONZERO.  USE 1ST
; BRANCH TO SHORTEN ACTUAL LOOP BY A BRANCH.
;-----------------------------------------------------------
NORMCOERCE:
	TST.L	D4		; CHECK FOR LEAD 1
	BMI.S	COERCE
@1:
	SUBQ.L	#1,A4		; DECREMENT EXP
	ADD.W	D7,D7		; SHIFT RND
	ADDX.L	D5,D5		; LO BITS
	ADDX.L	D4,D4
	BPL.S	@1		; WHEN NORM, FALL THROUGH

;-----------------------------------------------------------
; COERCE MILESTONE +++++++++++++++++++++++++++++++++++++++ .
;
; RUN SEPARATE SEQUENCES FOR EXT, SGL, DBL TO SAVE TESTS.
; NOTE THAT FOR CONVENIENCE IN BRANCHING, THE SGL AND DBL
; COERCE SEQUENCES FOLLOW THE COERCE ROUTINES.
; SINCE OVERFLOW RESULTS IN A VALUE DEPENDING ON THE
; PRECISION CONTROL BITS, RETURN CCR KEY FROM OFLOW:
; EQ: OK  NE: HUGE
;-----------------------------------------------------------
COERCE:
	TST.L	D6		; CHEAP SUBST FOR #SPREC+16
	BMI	SCOERCE
	BTST	#DPREC+16,D6	; IS IT DOUBLE?
	BNE	DCOERCE

	SUBA.L	A3,A3		; EXT UFLOW THRESH
	BSR.S	UFLOW

	MOVEQ	#0,D1		; SET INCREMENT FOR RND
	MOVEQ	#1,D2
	BTST	#0,D5		; LSB = 1?
	BSR.S	ROUND

	MOVEA.W #$7FFE,A3	; OFLOW THRESH
	BSR.S	OFLOW
	BEQ.S	@1

;-----------------------------------------------------------
; STORE EXTENDED HUGE -- JUST A STRING OF 1'S.
;-----------------------------------------------------------
	MOVEA.L	A3,A4		; MAX FINITE EXP
	MOVEQ	#-1,D4
	MOVE.L	D4,D5
@1:
	RTS


;-----------------------------------------------------------
; UFLOW MILESTONE ++++++++++++++++++++++++++++++++++++++++ .
;
; UNDERFLOW TEST -- DENORMALIZED REGARDLESS
;-----------------------------------------------------------
UFLOW:
	MOVE.L	A3,D0		; COPY THRESHOLD
	SUB.L	A4,D0		; THRESH - EXP
	BGT.S	@1
	RTS
@1:
	BSET	#ERRU+8,D6	; SIGNAL UNDERFLOW
	MOVEA.L A3,A4		; EXP <- THRESH
	BRA	RTSHIFT



;-----------------------------------------------------------
; ROUND MILESTONE ++++++++++++++++++++++++++++++++++++++++ .
;
; ROUND BASED ON GUARD AND STICKY IN D7.W AND LSB WHOSE
; COMPLEMENT IS IN THE Z FLAG THANKS TO A BTST.
; SUPPRESS UFLOW FLAG IF EXACT AND NONTRAPPING.
;-----------------------------------------------------------
ROUND:;-----------------------------------------------------------

	SNE	D0		; RECORD LSB

	TST.W	D7		; ANY NONZERO BITS?
	BNE.S	@1		;   YES.
	
	BCLR	#ERRU+8,D6	;   NO. SUPPRESS UFLOW SIGNAL
	RTS

@1:
	BSET	#ERRX+8,D6	; SIGNAL INEXACT
	BTST	#RNDLO,(A0)	; NEAREST & TOWARD -INF: X0
	BEQ.S	@5		; LOOKING FOR 00 AND 10
	BTST	#RNDHI,(A0)	; CHOP: 11 TOWARD +INF: 01
	BEQ.S	@3
	RTS
@3:
	TST.B	D6		; PLUS?
	BPL.S	ROUNDUP
	RTS
@5:
	BTST	#RNDHI,(A0)	; NEAR: 00  TOWARD -INF: 10
	BNE.S	@7

	CMPI.W	#$8000,D7	; 1/2 CASE?
	BCC.S	@51
	RTS			; < 1/2
@51:
	BHI.S	ROUNDUP
	TST.B	D0		; CHECK LSB
	BNE.S	ROUNDUP
	RTS
@7:
	TST.B	D6		; MINUS?
	BMI.S	ROUNDUP
	RTS

;-----------------------------------------------------------
; RECORD INCREMENT OF SIGNIFICAND.
;-----------------------------------------------------------
ROUNDUP:
	BSET	#RNDINC,1(A0)

	ADD.L	D2,D5
	ADDX.L	D1,D4
	BCC.S	@9

	ROXR.L	#1,D4
	ADDQ.L	#1,A4
@9:
	RTS


;-----------------------------------------------------------
; OFLOW MILESTONE ++++++++++++++++++++++++++++++++++++++++ .
;
; CHECK FOR OVERFLOW WITH THRESH IN A3, IF SO, STUFF INF
; AND RETURN WITH CCR AS NE IF HUGE SHOULD BE STUFFED.
;-----------------------------------------------------------
OFLOW:
	CMPA.L	A4,A3
	BLT.S	@1
	CLR.W	D0		; SET EQ
	RTS
@1:
	BSET	#ERRO+8,D6	; SET FLAG REGARDLESS
	BSET	#ERRX+8,D6	; INEXACT, TOO

;-----------------------------------------------------------
; STORE INF WITH SIGN OF OVERFLOWED VALUE, THEN CHECK...
;-----------------------------------------------------------
	MOVEA.W	#$7FFF,A4	; MAX EXP
	MOVEQ	#0,D4		; MAKE INF
	MOVE.L	D4,D5

;-----------------------------------------------------------
; SINCE NONTRAPPING, RESULT IS EITHER 'INF' OR 'HUGE'.
; HAVE 'INF' ALREADY; RETURN WITH CCR SET TO 'NE' IF
; 'HUGE' IS NEEDED.
;
; RETURN WITH EQ IFF NEAR, (+ & RNDUP), OR (- & RNDDN).
;-----------------------------------------------------------
	MOVE.B	(A0),D1
	AND.B	#RNDMSK,D1
	BNE.S	@2		; ASSUME 00-NEAR
	RTS			; RETURN WITH INF
@2:
;-----------------------------------------------------------
; NOW USE TRICK TO RETURN WITH CCR SET JUST RIGHT.
;-----------------------------------------------------------
	CMPI.B	#RND0,D1	; CHOPPING?
	BNE.S	@4
	TST.B	D1		; TO SET NE -- ALWAYS HUGE
	RTS
@4:
	TST.B	D6		; CHECK SIGN
	BMI.S	@5

	CMPI.B	#RNDUP,D1	; MUST BE EQ TO KEEP INF
	RTS
@5:
	CMPI.B	#RNDDN,D1	; MUST BE EQ TO KEEP INF
	RTS



;-----------------------------------------------------------
; THE SINGLE AND DOUBLE COERCE ROUTINES WERE PLACED DOWN
; HERE SO THEY COULD ACCESS THE UTILITIES WITH SHORT BR'S.
;-----------------------------------------------------------
SCOERCE:
	MOVEA.W #$3F81,A3	; SGL UFLOW THRESH
	BSR	UFLOW

	TST.L	D5		; ANY LO BITS?
	SNE	D0
	OR.B	D0,D7		; SAVE AS STICKIES
	ADD.B	D4,D4		; GUARD TO X
	ROXR.W	#1,D7		; X TO GUARD
	OR.B	D4,D7		; LAST STICKIES

	MOVEQ	#0,D5		; CLEAR LO BITS
	CLR.B	D4

	MOVE.L	#$0100,D1	; SET INCREMENT FOR RND
	MOVE.L	D5,D2

	BTST	#8,D4		; LSB -> Z
	BSR	ROUND

	MOVEA.W #$407E,A3	; OFLOW THRESH
	BSR.S	OFLOW
	BEQ.S	@3

;-----------------------------------------------------------
; STORE SINGLE HUGE -- 24 ONES WITH BIASED 7F EXP.
;-----------------------------------------------------------
	MOVEA.L	A3,A4		; MAX SGL EXP
	MOVEQ	#-1,D4
	CLR.B	D4
@3:
	RTS


DCOERCE:
	MOVEA.W #$3C01,A3	; DBL UFLOW THRESH
	BSR	UFLOW

	MOVE.W	#$07FF,D0	; MASK FOR LOW BITS
	AND.W	D5,D0
	ANDI.W	#$0F800,D5	; CLEAR LO BITS
	LSL.W	#5,D0		; LEFT ALIGN
	LSR.W	#1,D7		; MAKE WAY FOR GUARD
	BCC.S	@1		; RECORD POSSIBLE STRAY STICKY BIT
	BSET	#0,D7
@1:
	OR.W	D0,D7

	MOVEQ	#0,D1		; SET INCREMENT FOR RND
	MOVE.L	#$00000800,D2

	BTST	#11,D5		; LSB -> Z
	BSR	ROUND

	MOVEA.W	#$43FE,A3	; OFLOW THRESH
	BSR	OFLOW
	BEQ.S	@5

;-----------------------------------------------------------
; STORE DOUBLE HUGE -- 53 ONES WITH BIASED 3FF EXP.
;-----------------------------------------------------------
	MOVEA.L A3,A4
	MOVEQ	#-1,D4		; LEAD 32 BITS
	MOVE.L	#$FFFFF800,D5	; FINAL 21 BITS
@5:
	RTS



;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPPACK
;-----------------------------------------------------------
;-----------------------------------------------------------

;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
;
; ASSUME REGISTER MASK: POST COERCE, WITH DIRTY INDEX IN D0
; HAVE RESULT SIGN IN D7, EXP IN A4, DIGS IN D4,5
; CRUCIAL THAT EXTRANEOUS SIGNIFICANT BITS BE CLEAR.
; USE D3 FOR EXP COMPUTATIONS.
;-----------------------------------------------------------

PACK:
	ANDI.W	#$000E,D0	; KILL EXTRANEOUS BITS
	MOVE.W	PACKCASE(D0),D0	; INDEX INTO TABLE
	MOVEA.L	LKADR1(A6),A3	; LOAD DST ADRS

;-----------------------------------------------------------
; USE TRICK TO SPARE SEVERAL COMPARISONS.
;-----------------------------------------------------------
	MOVE.W	A4,D3		; GET EXP
	CMPI.W	#$7FFF,D3	; INF OR NAN?

	JMP	PACK(D0)

PACKCASE:
	DC.W	PACKEXT - PACK	; EXTENDED
	DC.W	PACKDBL - PACK	; DOUBLE
	DC.W	PACKSGL - PACK	; SINGLE
	DC.W	0		; invalid format
	DC.W	PACKI16 - PACK	; INT16
	DC.W	PACKI32 - PACK	; INT32
	DC.W	PACKC64 - PACK	; COMP64

;-----------------------------------------------------------
; INT16: JUST STORE.
;-----------------------------------------------------------
PACKI16:
	MOVE.W	D5,(A3)
	RTS


;-----------------------------------------------------------
; INT32: CHECK FOR MAX EXP TO STORE MAX NEG INT, WHILE
;	SIGNALING INVALID.
;-----------------------------------------------------------
PACKI32:
	MOVE.L	D5,(A3)
	RTS

;-----------------------------------------------------------
; COMP64: CHECK FOR NAN CASE, BUT NO SIGNAL.
;-----------------------------------------------------------
PACKC64:
	MOVE.L	D4,(A3)+
	MOVE.L	D5,(A3)
	RTS


;-----------------------------------------------------------
; NOT SO EASY TO PACK AN EXTENDED.  JUST STUFF THE SIGN;
; BUT BE SURE TO NORMALIZE UNDERFLOWED S,D DENORMALS.
;
; 20 MAR 90 --- NOW DELIVERS 96-BIT EXTENDED RESULTS (JPO).
;-----------------------------------------------------------
PACKEXT:
	BTST	#ERRU+8,D6	; UNDERFLOW
	BEQ.S	@7		; OK IF NO UFLOW

	TST.W	D3		; MIN EXP?
	BEQ.S	@7		; IF 0, NO PROBLEM

	TST.L	D4		; NORMALIZED OR NONZERO?
	BNE.S	@5

	TST.L	D5		; IF ZERO THEN FORCE 0
	BNE.S	@1		; UNNORM BY > 32 BITS!

	MOVEQ	#0,D3		; FORCE ZERO EXP
	BRA.S	@7
@1:
	SUBQ.W	#1,D3 		; DECR EXP
	ADD.L	D5,D5
	ADDX.L	D4,D4
@5:
	BPL.S	@1		; PLS -> UNNORM
@7:
	TST.B	D6		; NEGATIVE?
	BPL.S	@11
	ADDI.W	#$8000,D3	; STUFF NEG SIGN
@11:
	MOVE.W	D3,(A3)+	; DELIVER SIGN/EXP
	BTST	#FPX96,LKOP+1(A6) ; 96-BIT EXTENDED?
	BEQ.S	@12		;   NO. 80-BIT

	ADDQ	#2,A3		;   YES. BUMP POINTER BY 2
@12:
	MOVE.L	D4,(A3)+	; DELIVER SIGNIFICAND
	MOVE.L	D5,(A3)
	RTS


;-----------------------------------------------------------
; PACK SINGLE: IF INF OR NAN PLACE TOO BIG EXP AND COUNT
; ON LEAD BIT=0 TO FORCE EXP DECREMENT.
;-----------------------------------------------------------
PACKSGL:
	BNE.S	@1		; NE -> INF OR NAN
	MOVE.W	#$4080,D3	; EXP TOO BIG, WILL DEC
	BRA.S	@5
@1:
	TST.W	D3		; EXP = 0?
	BNE.S	@5
	MOVE.W	#$3F81,D3
@5:
	SUBI.W	#$3F80,D3
	ADD.L	D4,D4		; KILL LEAD BIT AND TEST
	BCS.S	@7		; DEC EXP UNLESS NORMAL
	SUBQ.W	#1,D3
@7:
	OR.W	D3,D4		; STUFF EXP IN LOW BITS
	ROR.L	#8,D4
	ADD.B	D6,D6		; GET SIGN INTO X
	ROXR.L	#1,D4		; SHOVE SIGN
	MOVE.L	D4,(A3)
	RTS


;-----------------------------------------------------------
; PACK DOUBLE:
;-----------------------------------------------------------
PACKDBL:
	BNE.S	@1		; NE -> INF OR NAN
	MOVE.W	#$4400,D3	; EXP TOO BIG, WILL DEC
	BRA.S	@5
@1:
	TST.W	D3		; EXP = 0?
	BNE.S	@5
	MOVE.W	#$3C01,D3
@5:
	SUBI.W	#$3C00,D3
	TST.L	D4		; KILL LEAD BIT AND TEST
	BMI.S	@7		; DECR EXP UNLESS NORMAL
	SUBQ.W	#1,D3
@7:

;-----------------------------------------------------------
; SET UP LOW 32 BITS WITH TRAILING 11 BITS FROM HI BITS.
;-----------------------------------------------------------
	LSR.L	#8,D5		; shift low half right 11 bits
	LSR.L	#3,D5
	BFINS	D4,D5{0:11}	; insert low 11 bits of high half

	LSR.L	#8,D4		; shift high half right 10 bits
	LSR.L	#2,D4
	BFINS	D3,D4{0:11}	; insert exponent, killing lead bit
	ADD.B	D6,D6		; SIGN TO X
	ROXR.L	#1,D4

	MOVE.L	D4,(A3)+
	MOVE.L	D5,(A3)
	RTS