mac-rom/Toolbox/SANE/FP020CTRL.a

1388 lines
39 KiB
Plaintext
Raw Normal View History

;
; File: FP020CTRL.a
;
; Contains: xxx put contents here xxx
;
; Written by: xxx put writers here xxx
;
; Copyright: <09> 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