mac-rom/Toolbox/SANE/FPCtrl.a
Elliot Nunn 4325cdcc78 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-12-26 09:52:23 +08:00

1466 lines
40 KiB
Plaintext

;
; File: FPCtrl.a
;
; Contains: Floating Point Stuff
;
; Written by: Jerome T. Coonen
;
; Copyright: © 1982-1990 by Apple Computer, Inc., all rights reserved.
;
; This file is used in these builds: Mac32
;
; Change History (most recent first):
;
; <3> 9/17/90 BG Removed <2>. 040s are behaving more reliably now.
; <2> 7/4/90 BG Added EclipseNOPs for flakey 040s.
; <1.1> 11/11/88 CCH Fixed Header.
; <1.0> 11/9/88 CCH Adding to EASE.
; <1.0> 2/12/88 BBM Adding file for the first time into EASEÉ
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPControl
;-----------------------------------------------------------
;-----------------------------------------------------------
;
;-----------------------------------------------------------
; 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).
; 14JAN85: MDS (JTC)
; 26MAR85: COLLECT FPCONTROL, FPUNPACK, FPNANS, FPCOERCE, FPPACK!
; LISA ENVIRONMENT NAME = %%%ZENVIRON.
; 03APR85: MODIFY CALL OUT TO HALT RTN USING ROMRSRC EQU. (JTC)
; 31JUL85: BACK TO PORKSHOP. <31JUL85>
;
;-----------------------------------------------------------
BLANKS ON
STRING ASIS
IF FPFORMAC+FPFORDEB THEN ; PACKAGE HEADER MESSES UP LISABUG
BRA.S FPBEGIN
DC.W $00 ; MAC SPECIFIC STUFF
DC.L ('PACK')
DC.W $4
DC.W $0002 ; VERSION 2 <26MAR85>
ENDIF
;-----------------------------------------------------------
; FOR TESTING, DEFINE STATEADRS RIGHT HERE
;-----------------------------------------------------------
IF FPFORDEB THEN
STATEADRS:
DC.W 0
DC.W 0
DC.W 0
ENDIF
;-----------------------------------------------------------
; 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.
;-----------------------------------------------------------
FPBEGIN:
LINK A6,#-2 ; RESERVE CNT WORD
MOVEM.L D0-D7/A0-A4,-(SP)
;-----------------------------------------------------------
;
; GET POINTER TO STATE AREA IN A0, USING SYSTEM CONVENTION.
; SAMPLE USES ARE:
;
; (DEBUGGING)
; LEA STATEADRS,A0
;
; (LISA)
; Get state address from library routine.
;
; (MACINTOSH)
; MOVEA.W #FPState,A0
; ...WHERE FPState IS DEFINED IN
; TOOLEQU.TEXT, TO BE INCLUDED AT THE
; TOP OF THE PROGRAM IN FPDRIVER.TEXT
;
;
;-----------------------------------------------------------
IF FPFORMAC THEN
MOVEA.W #FPState,A0
ENDIF
IF FPFORDEB THEN
LEA STATEADRS,A0
ENDIF
IF FPFORLISA THEN
SUBQ.L #4,SP ; MAKE WAY FOR PTR
; THE FOLLOWING LABELS DELETED FOR MDS BUG <26MAR85>
; XREF %%%ZEnviron ; GOOFY LISA LABEL <26Mar85>
; JSR %%%ZEnviron ; COMPUTE STATE ADRS <26Mar85>
MOVEA.L (SP)+,A0
ENDIF
BRA.S FPCOM ; NOW DO IT
;-----------------------------------------------------------
; 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
IF FPFORlisa THEN
DEBUGEND 'FP68K '
ENDIF
;-----------------------------------------------------------
; ALTERNATIVE ENTRY POINT TO BYPASS RECALC OF STATE PTR.
;-----------------------------------------------------------
REFP68K:
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.
;-----------------------------------------------------------
BCLR #RNDINC,1(A0)
;-----------------------------------------------------------
; 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
;-----------------------------------------------------------
IF PCOK THEN
OR.W OPMASKS(PC,D7),D6
ELSE
OR.W OPMASKS(D7),D6
ENDIF
;-----------------------------------------------------------
; 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
LSL.W #3,D1 ; ALIGN 2 TRAILING BITS
ROR.W #3,D0 ; SRC -> DST POSITION
OR.W D0,D6
OR.W D1,D6
@2:
;-----------------------------------------------------------
; 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.
;-----------------------------------------------------------
SWAP D6
CLR.L 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
CLR.L D7
IF PCOK THEN
PEA PREPACK(PC) ; WHERE TO COME BACK TO
ELSE
PEA PREPACK
ENDIF
TST.W D2 ; NANS DISCOVERED?
BNE NANS
;-----------------------------------------------------------
; DO-ARITHMETIC MILESTONE ++++++++++++++++++++++++++++++++ .
;-----------------------------------------------------------
ARITHOP:
IF PCOK THEN
MOVE.W ARITHTAB(PC,D0),D0 ; GET INDEX
JMP ARITHOP(PC,D0)
ELSE
MOVE.W ARITHTAB(D0),D0
JMP ARITHOP(D0)
ENDIF
;-----------------------------------------------------------
; 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
ROR.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 TO HAVE 3-WORD STRUCTURE
; PUSH ADDRESS OF 3-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)
PEA (SP) ; ADDRESS OF CCR/D0
MOVEM.L LKRET+2(A6),D0-D3
MOVEM.L D0-D3,-(SP)
ADDQ.L #2,SP ; KILL EXTRA WORD
;-----------------------------------------------------------
; IN MAC ENVIRONMENT, MUST LOCK MATH PACKAGE BEFORE CALLING
; EXTERNAL PROCEDURE THAT WILL EXPECT TO RETURN.
;-----------------------------------------------------------
IF ROMRSRC THEN
MOVE.L AppPacks+16,A4 ; GET FP68K HANDLE
MOVE.B (A4),D7 ; SAVE STATE OF LOCK BIT, CHANGED TO BYTE <03APR85>
BSET #Lock,(A4) ; FORCE LOCKING
MOVEA.L (A0),A0 ; GET VECTOR ADRS
JSR (A0)
MOVE.B D7,(A4) ; RESTORE LOCK BIT STATE, BYTE <03APR85>
ELSE
MOVEA.L (A0),A0
JSR (A0)
ENDIF
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).
; 14JAN85: MDS (JTC)
; 26MAR85: FIXED CLASS-COMP BUG AT LABEL UNPCUNR. CHANGE STATE OF NAN BIT. <26MAR85>
;
; 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.
;-----------------------------------------------------------
;-----------------------------------------------------------
; UNPACK-TOP MILESTONE +++++++++++++++++++++++++++++++++++ .
;-----------------------------------------------------------
UNPACK:
;-----------------------------------------------------------
; HANDY TO KILL SIGNIFICANT BITS AT OUTSET; ALREADY ROOM FOR
; SIGN.
;-----------------------------------------------------------
CLR.L D4 ; HANDY TO KILL BITS HERE
MOVE.L D4,D5
ANDI.W #$000E,D0 ; KILL EXTRANEOUS BITS
IF PCOK THEN
MOVE.W UNPCASE(PC,D0),D0
JMP UNPACK(PC,D0)
ELSE
MOVE.W UNPCASE(D0),D0
JMP UNPACK(D0)
ENDIF
UNPCASE:
DC.W UNPEXT-UNPACK
DC.W UNPDBL-UNPACK
DC.W UNPSGL-UNPACK
DC.W UNPEXT-UNPACK
DC.W UNPI16-UNPACK
DC.W UNPI32-UNPACK
DC.W UNPC64-UNPACK
;-----------------------------------------------------------
; INT16 HAS SPECIAL CASE 0, ELSE NORMALIZE AND GO.
;-----------------------------------------------------------
UNPI16:
MOVEQ #15,D0 ; SET EXP FOR INTEGER
MOVE.W (A3),D4 ; GET OPERAND
SWAP D4 ; LEFT ALIGN
BRA.S UNPIGEN
;-----------------------------------------------------------
; INT32 HAS SPECIAL CASE 0, ELSE NORMALIZE AND GO.
;-----------------------------------------------------------
UNPI32:
MOVEQ #31,D0 ; SET EXP FOR INTEGER
MOVE.L (A3),D4 ; GET OPERAND
BRA.S UNPIGEN
;-----------------------------------------------------------
; COMP64 HAS SPECIAL CASES 0 AND INF, ELSE NORMALIZE AND GO.
;-----------------------------------------------------------
UNPC64:
MOVEQ #63,D0 ; SET EXP FOR INTEGER
MOVE.L (A3),D4 ; GET HI OPERAND
MOVE.L 4(A3),D5 ; GET LO OPERAND
BEQ.S @7 ; HAVE REGULAR NUMBER
TST.L D4
BRA.S UNPCGEN
@7:
CMPI.L #$80000000,D4 ; IS IT NAN?
BNE.S UNPIGEN ; IF NOT, MAY BE 0
MOVEA.W #$7FFF,A4 ; SET THE EXPONENT
MOVEQ #nancomp,d4 ; SET TO COMP NAN
SWAP D4 ; ALIGN BYTE
BSET #QNANBIT,D4 ; MAKE IT QUIET! <27MAR85>
BRA.S UNPNAN ; AND GO...
UNPIGEN:
TST.L D4
BEQ.S UNP0 ; 0 IS SPECIAL CASE
UNPCGEN:
BPL.S @9
BSET #7,D6 ; SET MINUS SIGN
NEG.L D5
NEGX.L D4
@9:
ADDI.W #$3FFF,D0 ; BIAS EXPONENT
TST.L D4
BMI.S UNPNRM
BRA.S UNPCUNR ; GO NORMALIZE, SANS SIGNAL <26MAR85>
;-----------------------------------------------------------
; UNPACK AN EXTENDED: JUST SEPARATE THE SIGN AND LOOK FOR
; CASES. NOTE THAT THIS CASE MAY FALL THROUGH TO UNPZUN.
;-----------------------------------------------------------
UNPEXT:
MOVE.W (A3),D0 ; SIGN AND EXP
BPL.S @13
BSET #7,D6 ; SET SIGN
BCLR #15,D0 ; CLEAR OPERAND SIGN
@13:
MOVE.L 2(A3),D4 ; LEAD SIG BITS
MOVE.L 6(A3),D5
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: ; ENTRY POINT WHEN INTEGER IN <26MAR85>
SUBQ.W #1,D0 ; DECREMENT EXP
ADD.L D5,D5
ADDX.L D4,D4
BPL.S UNPCUNR ; NEW LABEL TODAY <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 IT WAS ZERO, SIGNAL! <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:
CLR.L D0 ; SET UP EXP
MOVE.L (A3),D4 ; GET NUMBER
ADD.B D6,D6 ; UN-ALIGN SIGN WORD
ADD.L D4,D4 ; SHIFT SIGN OUT OF NUM...
ROXR.B #1,D6 ; AND INTO SIGN BYTE
ROL.L #8,D4 ; ALIGN EXPONENT
MOVE.B D4,D0 ; ISOLATE EXPONENT
BEQ.S @21 ; HAVE 0 OR DENORM
MOVE.B #1,D4 ; CLEAR EXP BITS, THEN
ROR.L #1,D4 ; PLACE LEADING BIT
CMPI.B #$0FF,D0 ; MAX EXP?
BEQ.S UNPNIN
ADDI.W #$3F80,D0 ; IT'S NORMALIZED
BRA.S UNPNRM
@21:
MOVE.W #$3F81,D0 ; ASSUME DENORMALIZED
ROR.L #1,D4 ; ALIGN BITS
BRA.S UNPZUN ; AND GO TEST
;-----------------------------------------------------------
; 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.
; FASTEST BY ROTATE AND MASK.
;-----------------------------------------------------------
ROL.L #8,D5 ; MUST ALIGN BY 11 BITS
ROL.L #3,D5
ROL.L #8,D4 ; ALIGN EXP AND LEAD DIGS
ROL.L #4,D4 ; BY 12 TO GET EXP RIGHT
MOVE.W D4,D0 ; SAVE EXP, WITH EXTRA BITS
LSR.L #1,D4 ; MAKE WAY FOR LEAD BIT
ANDI.W #$0F800,D4 ; CLEAR LO 11 BITS
MOVE.W D5,D1
ANDI.W #$07FF,D1 ; GET REPLACEMENTS
OR.W D1,D4
ANDI.W #$0F800,D5 ; CLEAR MOVED BITS
ANDI.W #$07FF,D0 ; ISOLATE EXP
BNE.S @31
MOVE.W #$3C01,D0
BRA UNPZUN ; ZERO OR DENORMALIZED ???? WAS BRA.S
@31:
CMPI.W #$07FF,D0 ; MAX EXP?
BEQ UNPNIN ; ???? WAS BEQ.S
BSET #31,D4 ; SET LEAD BIT
ADDI.W #$3C00,D0 ; CORRECT EXP BIAS
BRA UNPNRM ; ???? WAS BRA.S
;-----------------------------------------------------------
;-----------------------------------------------------------
; 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).
; 14JAN85: MDS (JTC)
; 26MAR85: CHANGE 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
CLR.L 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
;-----------------------------------------------------------
CLR.L 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
;-----------------------------------------------------------
;
;-----------------------------------------------------------
BTST #OPHIBIT+16,D6 ; 0 = CMP
BNE.S @5
MOVEQ #CMPU,D0 ; MARK UNORERED
BRA CMPFIN
@5:
MOVEQ #1,D0 ; SNAN = 1, QNAN = 2
BCLR #ERRI+8,D6 ; INVALID SET -> SNAN
BNE.S @7
ADDQ.W #1,D0
@7:
BRA CLASSFIN
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
;-----------------------------------------------------------
; CLEAR QUIET BIT AND CHECK FOR ANY OTHERS NONZERO...
;-----------------------------------------------------------
@2:
MOVE.L D4,D0 ; CHECK FOR ALL 0
BCLR #QNANBIT,D0 ; ...EXCEPT QNANBIT <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)
; 4APR84: FIXED BUG IN DCOERCE (JTC)
; 14JAN85: MDS (JTC)
;
; 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
;-----------------------------------------------------------
; RTSHIFT MILESTONE ++++++++++++++++++++++++++++++++++++++ .
;
; THIS IS THE RIGHT SHIFTER USED IN ADD/SUB, DENORM,...
; VARIANT SKIPS CHECK FOR SUPERFLUOUS SHIFTS OVER 66.
;-----------------------------------------------------------
RTSHIFT:
CMPI.W #66,D0
BLS.S QRTSHIFT
MOVE.W #66,D0
QRTSHIFT:
LSR.L #1,D4 ; SHIFT 0 IN
ROXR.L #1,D5
ROXR.W #1,D7
SCS D1 ; SAVE C-OUT
OR.B D1,D7
SUBQ.W #1,D0
BNE.S QRTSHIFT
RTS
;-----------------------------------------------------------
; 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.
;-----------------------------------------------------------
ZNORMCOERCE:
TST.L D4
BNE.S NORMCOERCE
TST.L D5
BNE.S NORMCOERCE
TST.W D7 ; MAY BE JUST ROUND BITS
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
BRA.S @2
@1:
SUBQ.L #1,A4 ; DECREMENT EXP
ADD.W D7,D7 ; SHIFT RND
ADDX.L D5,D5 ; LO BITS
ADDX.L D4,D4
@2:
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
CLR.L 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
;-----------------------------------------------------------
******** DELETED - NO IEEE TRAP SUPPORT
; BTST #ERRU,1(A0) ; TRAP BITS IN STATE.LO
; BEQ.S @3
; RTS
;@3:
;-----------------------------------------------------------
MOVEA.L A3,A4 ; EXP <- THRESH
BRA.S 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
;-----------------------------------------------------------
; IF NOT TRAPPING ON UFLOW, JUST SUPPRESS ANY UFLOW SIGNAL.
; SINCE WE DON'T SUPPORT TRAPPING, ALWAYS SUPPRESS SIGNAL.
;-----------------------------------------------------------
;
; BTST #ERRU,1(A0) ; TRAPPING <-- 1
; BNE.S @101
;-----------------------------------------------------------
BCLR #ERRU+8,D6 ; SUPPRESS UFLOW SIGNAL
;-----------------------------------------------------------
;@101:
;-----------------------------------------------------------
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
;-----------------------------------------------------------
; REMOVE TRAP CODE TO BYPASS DEFAULT RESULT ON TRAP
;
; BTST #ERRO,1(A0) ; CHECK FOR TRAP
; BEQ.S @10
;
; CLR.W D0 ; SET EQ
; RTS
;@10:
;-----------------------------------------------------------
BSET #ERRX+8,D6 ; INEXACT, TOO
;-----------------------------------------------------------
; STORE INF WITH SIGN OF OVERFLOWED VALUE, THEN CHECK...
;-----------------------------------------------------------
MOVEA.W #$7FFF,A4 ; MAX EXP
CLR.L 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 PLACE DOWN
; HERE SO THEY COULD ACCESS THE UTILITIES WITH SHORT BR'S.
;-----------------------------------------------------------
SCOERCE:
MOVEA.W #$3F81,A3 ; SGL UFLOW THRESH
BSR UFLOW ; ???? WAS BSR.S
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
CLR.L D5 ; CLEAR LO BITS
CLR.B D4
MOVE.L #$0100,D1 ; SET INCREMENT FOR RND
CLR.L D2
BTST #8,D4 ; LSB -> Z
BSR ROUND ; WAS BSR.S
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 ; WAS BSR.S
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
CLR.L D1 ; SET INCREMENT FOR RND
MOVE.L #$00000800,D2
BTST #11,D5 ; LSB -> Z
BSR ROUND ; WAS BSR.S
MOVEA.W #$43FE,A3 ; OFLOW THRESH
BSR OFLOW ; WAS BSR.S
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
; 14JAN85: MDS (JTC)
;
; 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
IF PCOK THEN
MOVE.W PACKCASE(PC,D0),D0
ELSE
MOVE.W PACKCASE(D0),D0
ENDIF
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?
IF PCOK THEN
JMP PACK(PC,D0)
ELSE
JMP PACK(D0)
ENDIF
PACKCASE:
DC.W PACKEXT-PACK
DC.W PACKDBL-PACK
DC.W PACKSGL-PACK
DC.W 0
DC.W PACKI16-PACK
DC.W PACKI32-PACK
DC.W PACKC64-PACK
;-----------------------------------------------------------
; 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.
;-----------------------------------------------------------
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!
CLR.L D3 ; FORCE ZERO EXP
BRA.S @7
@1:
SUBQ.W #1,D3 ; DEC 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)+
MOVE.L D4,(A3)+
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 ; DEC EXP UNLESS NORMAL
SUBQ.W #1,D3
@7:
;-----------------------------------------------------------
; SET UP LOW 32 BITS WITH TRAILING 11 BITS FROM HI BITS.
;-----------------------------------------------------------
MOVE.L #$000007FF,D0 ; MASK HI BITS OF 2ND HALF
AND.L D4,D0
OR.L D0,D5
ROR.L #8,D5
ROR.L #3,D5 ; NOW LO 32 BITS READY
ANDI.W #$0F800,D4 ; CLEAR LO BITS JUST USED
ADD.L D4,D4 ; KILL LEAD BIT
OR.W D3,D4 ; PLACE EXP
ROR.L #8,D4
ROR.L #3,D4
ADD.B D6,D6 ; SIGN TO X
ROXR.L #1,D4
MOVE.L D4,(A3)+
MOVE.L D5,(A3)
RTS