Macintosh-SW/mac-rom
1
0
Fork 0
mirror of https://github.com/elliotnunn/mac-rom.git synced 2024-12-29 07:29:15 +00:00
Code Issues Projects Releases Wiki Activity
3d17253346
mac-rom/Toolbox/SANE/FP020CTRL.a

1388 lines
39 KiB
Plaintext
Raw Normal View History

Bring in CubeE sources Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
2017-09-17 09:09:04 +00:00
;
; 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
Reference in New Issue Copy Permalink