mac-rom/Toolbox/SANE/FP020OPS.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

2187 lines
61 KiB
Plaintext

;
; File: FP020OPS.a
;
; Contains: xxx put contents here xxx
;
; Written by: xxx put writers here xxx
;
; Copyright: © 1990 by Apple Computer, Inc., all rights reserved.
;
; This file is used in these builds: Mac32
;
; Change History (most recent first):
;
; <5> 9/15/90 BG Removed <3>, <4>. 040s are behaving more reliably now.
; <4> 7/17/90 BG Found more places to add EclipseNOPs.
; <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: FPOPS.a
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; FPOPS ---Floating point operations
; Copyright Apple Computer, Inc., 1983,1984,1985,1989,1990
; All Rights Reserved
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 02JUL82: WRITTEN J. COONEN
; 12AUG82: TIDIED UP (JTC)
; 01SEP82: RND MODE ENCODINGS CHANGED (JTC)
; 12DEC82: PROJ MODE OUT (JTC)
; 25JAN90: modified for 68020 SANE (JPO)
;
; ASSUME REGISTER MASK: DO-ARITHMETIC
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPADD---ADDITION/SUBTRACTION OPERATIONS
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; TO SUBTRAC JUST FLIP THE SIGN AND XOR-SIGN BITS IN D6.B.
;-----------------------------------------------------------
SUBTOP:
EORI.B #$A0,D6 ; BITS #7 AND #5
ADDTOP:
MOVE.W ADDCASE(D3),D3 ;
JMP ADDTOP(D3)
ADDCASE: ; DST + SRC
DC.W ADDNUM - ADDTOP ; NUM + NUM
DC.W ADDS0 - ADDTOP ; NUM + 0
DC.W RSRC - ADDTOP ; NUM + INF
DC.W ADDD0 - ADDTOP ; 0 + NUM
DC.W ADD00 - ADDTOP ; 0 + 0
DC.W RSRC - ADDTOP ; 0 + INF
DC.W RDSTSGN- ADDTOP ; INF + NUM
DC.W RDSTSGN- ADDTOP ; INF + 0
DC.W ADDINF - ADDTOP ; INF + INF
;-----------------------------------------------------------
; ADD 2 FINITE NUMBERS HAS TWO SPECIAL CASES, WHEN ONE OF
; THE SRC OR DST IS 0. IN THAT CASE JUST BE SURE NONZERO
; OPERAND IS PLACED IN RESULT BUFFER, TO BE SUBJECT TO THE
; COERCION TO THE DESTINATION.
;-----------------------------------------------------------
ADDNUM:
;-----------------------------------------------------------
; FIRST ALIGN SO "LARGER" EXP IN A4, LARGER SIGN IN D6.#7
; "SMALLER" DIGITS ARE IN D4,5 FOR SHIFTING; "LARGER" DIGITS
; ARE IN D3,A2 (CANNOT USE A1 SINCE NEED TO ADDX.L.
; ASSUME SRC IS "LARGER", SO SWAP ITS DIGS WITH DST.
;-----------------------------------------------------------
MOVE.L D4,D3 ; CAN'T ADDX FROM A REGS
MOVE.L A1,D4
EXG D5,A2
MOVE.W A4,D0 ; SEXP, WORD IS ENOUGH
SUB.W A3,D0 ; SEXP - DEXP
BEQ ADDEM ; NO SHIFT IF EXP'S =
BGT.S @1 ; JUST SHIFT DST IN D4,5
;-----------------------------------------------------------
; DST IS LARGER:
; AS PART OF SWAP, MUST MOVE DST SIGN TO LEAD BIT OF D7 BYTE
; BUT WITHOUT MOVING THE XOR, WHICH WILL BE TESTED...
;-----------------------------------------------------------
EXG D5,A2 ; SWAP LO BITS
EXG D4,D3 ; SWAP HI BITS
NEG.W D0 ; TRUE SHIFT COUNT
MOVEA.L A3,A4 ; LARGER EXP
ADD.B D6,D6 ; SHIFT SRC SIGN OUT
ASR.B #1,D6 ; RESTORE X0R TO PLACE & DUPLICATE DST SIGN
;-----------------------------------------------------------
; Do fast right shift of D4/D5 into D4/D5/D7. Translate sticky
; information in D7.L into D7.W.
;-----------------------------------------------------------
@1:
CMPI #66,D0 ; SPECIAL FAST ROUTINE IF SHIFT OF > 66 BITS
BHI ADDSHLOTS
MOVEA.L D0,A3 ; save shift value in A3
ADD D0,D0 ; jmp to appropriate routine
MOVE ADDSHCASE(D0),D0
JMP ADDNUM(D0)
ADDSHCASE:
DC.W ADDEM - ADDNUM
DC.W ADDSH1 - ADDNUM
DC.W ADDSH2 - ADDNUM
DC.W ADDSH3 - ADDNUM
DC.W ADDSH4 - ADDNUM
DC.W ADDSH5 - ADDNUM
DC.W ADDSH6 - ADDNUM
DC.W ADDSH7 - ADDNUM
DC.W ADDSH8 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH16 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH2TO31 - ADDNUM
DC.W ADDSH32 - ADDNUM
DC.W ADDSH33 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH33TO63 - ADDNUM
DC.W ADDSH64 - ADDNUM
DC.W ADDSH65 - ADDNUM
DC.W ADDSH66 - ADDNUM
ADDSHLOTS:
MOVEQ #0,D4
MOVEQ #0,D5
ST D7
BRA ADDEM
ADDSH66:
OR D4,D5
TST.L D5
SNE D7
LSR.L #2,D4
BRA.S BIGSTICK
ADDSH65:
OR D4,D5
TST.L D5
SNE D7
LSR.L #1,D4
BRA.S BIGSTICK
ADDSH64:
TST.L D5
SNE D7 ; gather stickies
BIGSTICK:
OR.L D4,D7
MOVEQ #0,D4
MOVEQ #0,D5
BRA.S FIXST ; fix stickies
;-----------------------------------------------------------
; SHIFT OF 33-63 BITS
;-----------------------------------------------------------
ADDSH33TO63:
MOVE.L A3,D0 ; restore shift count to D0
MOVE.L D5,D7 ; D7 <- D5
SUBI #32,D0 ; decr shift count by 32
MOVE.L D4,D5 ; D5 <- D4
ROR.L D0,D7 ; rotate D7 right by new count
LSR.L D0,D5 ; shift D5 right by new count
BFTST D7{0:D0} ; test for low sticky
BEQ.S @3
ORI #$FF,D7
@3:
BFINS D4,D7{0:D0} ; shift high sticky bits in
MOVEQ #0,D4 ; zero D4
BRA.S FIXST ; fix stickies
ADDSH33:
MOVE.L D5,D7 ; shift right 32 bits
MOVE.L D4,D5
MOVEQ #0,D4
LSR.L #1,D5 ; shift right one more bit
ROXR.L #1,D7
SCS D7 ; keep low sticky
BRA.S FIXST ; fix stickies
ADDSH32:
MOVE.L D5,D7 ; 32-bit shift is easy
MOVE.L D4,D5
MOVEQ #0,D4
BRA.S FIXST ; fix stickies
;-----------------------------------------------------------
; SHIFT OF 2-31 BITS
;-----------------------------------------------------------
ADDSH2TO31:
MOVE.L A3,D0 ; D0 <- shift count
BFINS D5,D7{0:D0} ; shift bits into D7 from D5
LSR.L D0,D5 ; shift D5 right
BFINS D4,D5{0:D0} ; shift bits into D5 from D4
LSR.L D0,D4 ; shift D4
;-----------------------------------------------------------
; Fix stickies (convert from D7.L to D7.W)
;-----------------------------------------------------------
FIXST:
TST.W D7 ; test D7.W
SNE D1 ; set D1 if nonzero
CLR.W D7 ; zero D7.W and swap
SWAP D7
OR.B D1,D7 ; OR in D1.B
BRA.S ADDEM ; done
ADDSH16:
MOVE.W D5,D7
MOVE.W D4,D5
SWAP D5
CLR.W D4
SWAP D4
BRA.S ADDEM
ADDSH8:
BFINS D5,D7{16:8}
MOVE.B D4,D5
ROR.L #8,D5
LSR.L #8,D4
BRA.S ADDEM
ADDSH7:
BFINS D5,D7{16:7}
LSR.L #7,D5
BFINS D4,D5{0:7}
LSR.L #7,D4
BRA.S ADDEM
ADDSH6:
BFINS D5,D7{16:6}
LSR.L #6,D5
BFINS D4,D5{0:6}
LSR.L #6,D4
BRA.S ADDEM
ADDSH5:
BFINS D5,D7{16:5}
LSR.L #5,D5
BFINS D4,D5{0:5}
LSR.L #5,D4
BRA.S ADDEM
ADDSH4:
BFINS D5,D7{16:4}
LSR.L #4,D5
BFINS D4,D5{0:4}
LSR.L #4,D4
BRA.S ADDEM
ADDSH3:
BFINS D5,D7{16:3}
LSR.L #3,D5
BFINS D4,D5{0:3}
LSR.L #3,D4
BRA.S ADDEM
ADDSH2:
BFINS D5,D7{16:2}
LSR.L #2,D5
BFINS D4,D5{0:2}
LSR.L #2,D4
BRA.S ADDEM
ADDSH1:
LSR.L #1,D4
ROXR.L #1,D5
ROXR.W #1,D7
;-----------------------------------------------------------
; OPERANDS ARE NOW ALIGNED. TEST FOR +/- AND DO IT.
;-----------------------------------------------------------
ADDEM:
BTST #5,D6 ; TEST XOR OF SIGNS
BNE.S SUBMAG
;-----------------------------------------------------------
; ADD MAGNITUDE: ADD THE WORDS AND CHECK FOR CARRY-OUT.
;-----------------------------------------------------------
ADD.L A2,D5
ADDX.L D3,D4
BCC COERCE
ROXR.L #1,D4 ; ADJUST RIGHT
ROXR.L #1,D5
ROXR.W #1,D7 ; NO STICKIES CAN BE LOST
SCS D1
OR.B D1,D7
ADDQ.L #1,A4 ; BUMP EXP
@15:
BRA COERCE
;-----------------------------------------------------------
; SIMPLIFY BY SUBTRACTING LARGE OP IN D3,A2 FROM SMALL IN
; D4,5,7 AND THEN CHECKING FOR SPECIAL CASES. IF ZERO, JUMP
; OUT TO 0+0 CODE. IF GREATER, FLIP SIGN. IF LESS (USUAL)
; JUST NEGATE.
;-----------------------------------------------------------
SUBMAG:
NOT.B D6 ; ASSUME >, WITH SIGN CHG
SUB.L A2,D5
SUBX.L D3,D4
BEQ.S ZEROSUM ; STORE ZERO WITH SIGN
BCC NORMCOERCE ; GOT IT RIGHT
NEG.W D7 ; FLIP DIGITS
NEGX.L D5
NEGX.L D4
NOT.B D6 ; FLIP SIGN BACK
@7:
BRA NORMCOERCE
;-----------------------------------------------------------
; NOW SET EXP=0 AND FIX SIGN ACCORDING TO ROUNDING MODE.
; IN THE SPECIAL CASE OF TWO 0'S, AVOID THE UNDERFLOW
; COERCION WILL SIGNAL IN S/D RESTRICTION.
;-----------------------------------------------------------
ADD00:
BTST #5,D6 ; SAME SIGN?
BEQ.S ADDQ00 ; YES, EASY
ZEROSUM:
SUBA.L A4,A4 ; 0 EXP
CLR.B D6 ; ASSUME POSITIVE
BTST #RNDHI,(A0) ; 10 -- RND MINUS
BEQ.S ADDQ00
BTST #RNDLO,(A0)
BNE.S ADDQ00
NOT.B D6 ; MAKE NEG
ADDQ00:
RTS ; DON'T COERCE 0
;-----------------------------------------------------------
; IF DST=0, HAVE RES=SRC. BUT IF SRC=0 MUST SET RES=DST.
; THESE CASES AVOID EXTRANEOUS SHIFTING OF ZERO OPERAND.
;-----------------------------------------------------------
ADDS0:
MOVE.L A2,D5 ; LO DIGS
MOVE.L A1,D4 ; HI DIGS
MOVE.L A3,A4 ; EXP
ADD.B D6,D6 ; SIGN
ADDD0:
BRA COERCE
;-----------------------------------------------------------
; SINCE PROJECTIVE MODE OUT,
; SUM OF TWO INFS ALWAYS DEPENDS UPON THEIR SIGNS.
;-----------------------------------------------------------
ADDINF:
BTST #5,D6 ; SAME SIGN?
BNE.S @25
RTS
@25:
MOVEQ #NANADD,D0 ; MARK ERROR
BRA INVALIDOP
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPMUL
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 07JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: MULU32 ROUTINE TIGHTENED.
; 09JUN83: DON'T USE A5 AS TEMP CELL.
; 26JAN89: MODIFIED FOR 68020 SANE (JPO).
;
;-----------------------------------------------------------
MULTOP:
ROL.B #2,D6 ; GET XOR SIGNS
MOVEQ #NANMUL,D0 ; ASSUME THE WORST
MOVE.W MULCASE(D3),D3
JMP MULTOP(D3)
MULCASE: ; DST * SRC
DC.W MULNUM - MULTOP ; NUM * NUM
DC.W RSRC - MULTOP ; NUM * 0
DC.W RSRC - MULTOP ; NUM * INF
DC.W RDST - MULTOP ; 0 * NUM
DC.W RSRC - MULTOP ; 0 * 0
DC.W INVALIDOP - MULTOP ; 0 * INF
DC.W RDST - MULTOP ; INF * NUM
DC.W INVALIDOP - MULTOP ; INF * 0
DC.W RSRC - MULTOP ; INF * INF
MULNUM:
;-----------------------------------------------------------
; HAVE: X.XXXXX * Y.YYYYYY --> ZZ.ZZZZZZZ BEFORE
; NORMALIZATION AND COERCION. SO SUBTRACT (BIAS-1) TO
; ACCOUNT FOR BINARY POINT ONE BIT TO RIGHT. FOR EXAMPLE,
; 1 * 1 COMES OUT: 2^1 * 0.10000000... WHICH IN TURN
; IS NORAMALIZED TO 2^0 * 1.000000...
;-----------------------------------------------------------
ADDA.L A3,A4 ; ADD EXP'S
SUBA.W #$3FFE,A4 ; SUBTRACT (BIAS - 1)
;-----------------------------------------------------------
; Multiply is a D register hog, so some state must be saved.
;
; 64*64 multiply is accomplished in 4 32*32 products, using
; the MULU.L 32*32 instruction of the MC68020.
;
; Special provisions are made for the three special cases:
; both operands have 32 trailing zeros or any one operand
; has 32 trailing zeros.
;
; The basic register mask throughout is:
; A1: D6 save
; A2,A3: SRC bits
; A4: result exponent
; D0,D1: used to pass operands to 32*32 mult and return results
; D2,3: DST bits
; D4,5,7: 64-bit product and round bits
; D6: zero
;-----------------------------------------------------------
MOVE.L A1,D2 ; D2 <- DST.HI
MOVE.L A2,D3 ; D3 <- DST.LO
MOVEA.L D6,A1 ; save D6 in A1
MOVEA.L D4,A2 ; A2 <- SRC.HI
MOVEA.L D5,A3 ; A3 <- SRC.LO
MOVEQ #0,D7 ; exact at first
MOVEQ #0,D6 ; D6 <- 0
MOVE.L A2,D5 ; D4/5 = SRC.HI * DST.HI
MULU.L D2,D4:D5
MOVE.L A3,D7 ; SRC.LO * DST.HI
BEQ.S HILO ; skip if SRC.LO = 0
MULU.L D2,D0:D7 ; RESULT.LO in D7
ADD.L D0,D5 ; RESULT.HI added to D4/5
ADDX.L D6,D4
HILO:
MOVE.L D3,D0 ; SRC.HI * DST.LO
BEQ.S MULDONE ; done if DST.LO = 0
MOVE.L A2,D1
MULU.L D0,D0:D1
ADD.L D1,D7 ; result added to D4/5/7
ADDX.L D0,D5
ADDX.L D6,D4
;-----------------------------------------------------------
; Fourth 32*32 product is SRC.LO * DST.LO. High result is
; added into D7 with carry propagating through D5/4. Nonzero
; low result causes low order stickies to be set in D7.
;-----------------------------------------------------------
MOVE.L A3,D1 ; SRC.LO
BEQ.S MULDONE ; done if SRC.LO = 0
MULU.L D3,D0:D1
ADD.L D0,D7 ; add to D7
ADDX.L D6,D5 ; propagate carry to D4/5
ADDX.L D6,D4
TST.L D1 ; set low sticky if D1 != 0
SNE D1
OR.B D1,D7
;-----------------------------------------------------------
; Clean up after multiplication. Restore D6 and transfer
; stickies down to D7.W.
;-----------------------------------------------------------
MULDONE:
MOVE.L A1,D6 ; restore D6
TST.W D7 ; test D7.W
SNE D1 ; set D1 if nonzero
CLR.W D7 ; zero D7.W and swap
SWAP D7
OR.B D1,D7 ; OR in D1.B
BRA NORMCOERCE ; normalize if necessary & coerce
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPDIV
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: SINGLE CASE FIXED UP (JTC)
; 26JAN90: MODIFIED FOR 68020 SANE (JPO)
;
; ASSUME REGISTER MASK: DO-ARITHMETIC
;-----------------------------------------------------------
DIVTOP:
ROL.B #2,D6 ; GET XOR SIGNS
MOVEQ #NANDIV,D0 ; JUST IN CASE...
MOVE.W DIVDCASE(D3),D3
JMP DIVTOP(D3)
DIVDCASE: ; DST / SRC
DC.W DIVNUM - DIVTOP ; NUM / NUM
DC.W DIVBY0 - DIVTOP ; NUM / 0
DC.W DIVBYI - DIVTOP ; NUM / INF
DC.W RDST - DIVTOP ; 0 / NUM
DC.W INVALIDOP - DIVTOP ; 0 / 0
DC.W RDST - DIVTOP ; 0 / INF
DC.W RDST - DIVTOP ; INF / NUM
DC.W RDST - DIVTOP ; INF / 0
DC.W INVALIDOP - DIVTOP ; INF / INF
;-----------------------------------------------------------
; DIV BY ZERO: SET THE ERROR BIT, STUFF INF, RET.
;-----------------------------------------------------------
DIVBY0:
BSET #ERRZ+8,D6
MOVEA.W #$7FFF,A4 ; BIG EXP
MOVEQ #0,D4 ; ZERO DIGS
MOVE.L D4,D5
RTS
;-----------------------------------------------------------
; DIV BY INF: STORE 0 AND RET.
;-----------------------------------------------------------
DIVBYI:
SUBA.L A4,A4 ; ZERO EXP
MOVE.L A4,D4 ; AND DIGS...
MOVE.L D4,D5
RTS
;-----------------------------------------------------------
; Dividing numbers involves the nonrestoring divide subroutine
; DIV32 shared with the REMAINDER algorithm. This subroutine
; essentially calculates 32 bits of quotient of a 64 / 64
; division and also returns a shifted remainder.
;-----------------------------------------------------------
DIVNUM:
;-----------------------------------------------------------
; FIGURE RESULT EXPONENT AS THOUGH DST >= SRC. WILL COMPUTE
; AN EXTRA QUOTIENT BIT JUST IN CASE DST < SRC, IN WHICH
; CASE EXP WILL BE DECREMENTED.
;-----------------------------------------------------------
EXG A3,A4 ; SWAP EXPS
SUBA.L A3,A4 ; DEXP - SEXP
ADDA.W #$3FFF,A4 ; REBIAS
;-----------------------------------------------------------
; DST >= SRC: 64+1 QUO BITS, LAST IS ROUND.
; DST < SRC: 64+1 QUO BITS, FIRST IS 1, LAST IS ROUND.
; TRICK: IN ORDER TO GET EXTRA (ROUND) BIT IN D4,5, LET
; LEADING BIT (KNOWN TO BE 1) BE SHIFTED OUT OF
; D4,5 DURING DIVISION. THEN PUT IT BACK ON RETURN.
; USE SPECIAL CASE STARTUP CODE TO DISTINGUISH THE DST < SRC
; CASE THAT REQUIRES TWEAKS OF REMAINDER AND EXPONENT.
;
; Set up funny register mask for nonrestoring division
; A2 - quotient high longword
; A3 - D6 save
; A4 - exponent of result
; D2,D3 - dividend cum shifted remainder
; D4,D5 - divisor
; D1 - holds 0
; scratch registers are D0,D6,D7
; *** NOTE CAN DO BETTER ON FIRST STEP BECAUSE OF TEST ABOVE
;-----------------------------------------------------------
DIVNONRESTORING:
MOVE.L D6,A3 ; save D6 contents in A3 for duration
MOVE.L A1,D2 ; D2 <- DST.HI
MOVE.L A2,D3 ; D3 <- DST.LO
MOVEQ #0,D1 ; D1 <- 0
MOVE.L D2,D6 ; save DST.HI for case DST < SRC below
SUB.L D5,D3 ; get leading 1 bit in quotient via subtraction
SUBX.L D4,D2 ; of SRC (divisor) from DST (dividend)
BCC.S BGNDIVD ; DST >= SRC; begin division steps
SUBQ.L #1,A4 ; DST < SRC; decrement exponent and
ADD.L A2,D3 ; correct remainder by adding DST to it
ADDX.L D6,D2
BGNDIVD:
BSR.S DIV32 ; get first quotient longword
MOVE.L D0,A2 ; save in A2
BSR.S DIV32 ; get second quotient longword
MOVE.L D0,D5 ; put quotient in D4/D5
MOVE.L A2,D4
MOVE.L A3,D6 ; restore D6
;-----------------------------------------------------------
; Clean up prior to return.
; Remainder is in D2/D3 and shifted quotient is in D4/5.
; Adjust quotient and put round/stickies in D7.W
;-----------------------------------------------------------
MOVEQ #1,D7 ; it's almost zero
LSR.L #1,D7 ; D7 = 0 and X bit set
ROXR.L #1,D4 ; shift leading 1 bit into quotient
ROXR.L #1,D5
ROXR.W #1,D7 ; shift round bit into D7.W
OR.L D2,D3 ; test all remainder bits
SNE D7 ; set stickies if nonzero
BRA COERCE ; coerce result
;-----------------------------------------------------------
; Subroutine DIV32 calculates a 32-bit quotient from a 64-bit
; dividend and a 64-bit divisor. It also returns a shifted
; (by 32 bits) remainder. This subroutine uses the MULU.L and
; DIVU.L instructions of the MC68020.
;
; D2,D3 - dividend cum shifted remainder
; D1 - bits to be shifted into low half of remainder (usually zero)
; D4,D5 - divisor
; D0 - 32-bit quotient
; D6,D7 - scratch registers
;-----------------------------------------------------------
DIV32:
DIVU.L D4,D2:D3 ; divide step (64-bit / 32-bit)
BVS.S DIVDONE ; rare overflow handler
MOVE.L D3,D0 ; initialize quotient word
MOVE.L D3,D7 ; multiply quotient by rest
MULU.L D5,D6:D7 ; of divisor (32 bits)
CTNDIV:
MOVE.L D1,D3 ; shifted remainder in D1/D2
SUB.L D7,D3 ; subtract correction from remainder
SUBX.L D6,D2
BCC.S DIVOK ; OK if no carry
ONEMORE:
SUBQ.L #1,D0 ; correction produced carry; decr quotient
ADD.L D5,D3 ; and adjust remainder upward until positive
ADDX.L D4,D2
BCC.S ONEMORE
DIVOK:
RTS ; return
;-----------------------------------------------------------
; Division has produced an overflow (very rare case). Fix
; it up.
;-----------------------------------------------------------
DIVDONE:
MOVE.L D5,D6 ; DIVU.L overflow
MOVEQ #0,D7 ; set D6/7 to $100000000 * D5
MOVE.L D3,D2 ; simulate remainder for quotient of $100000000
MOVEQ #0,D0 ; quotient effectively $100000000
BRA.S CTNDIV ; adjust remainder and quotient
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPREM
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 07JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP. (JTC)
; 12OCT82: RETURN QUO TO D0 FIXED. (JTC)
; 12DEC82: ONLY PLACE WHERE D0.W MODIFIED (JTC)
; 05AUG83: FIX BUG IN QUOTIENT WHEN SIGN MUST BE ADJUSTED (JTC)
; 26JAN90: MODIFIED FOR MC68020 SANE (JPO)
;
; ******** IMPORTANT STACK DEPENDENCY -- SEE BELOW ********
;
; THE REMAINDER OPERATION DIVIDES DST/SRC TO GET ----ALL---
; QUOTIENT BITS (POSSIBLY THOUSANDS OF THEM) AND THEN
; RETURNS THE RESULTING REMAINDER, REDUCED TO LESS THAN OR
; EQUAL TO (1/2)*DVR. IT ALSO RETURNS THE SIGN AND LOW
; SEVEN INTEGER QUOTIENT BITS IN REGISTER D0.W AS A
; TWO'S-COMPLEMENT INTEGER. THIS KLUGE IS
; EXTREMELY USEFUL FOR ELEMENTARY FUNCTION EVALUATION
; WHERE, SAY, REMAINDER BY (PI/4) IS NOT USEFUL WITHOUT
; AN INDICATION OF THE OCTANT (GIVEN BY THE QUOTIENT) AS
; WELL AS THE REMAINDER.
;
; TO GET THE PROPERLY REDUCED QUOTIENT, IT IS EASIEST TO
; DIVIDE ALL THE WAY THROUGH THE FIRST FRACTION QUOTIENT
; BIT, AND THEN PATCH UP. IF THE QUOTIENT TURNS OUT TO BE
; ZERO, ITS SIGN IS ARBITRARILY SET TO THAT OF THE DST.
;
; Integer quotient reduction is accomplished in one of two
; ways, depending upon the difference in exponent value for
; the two operands. For small values (< 9) of this difference,
; a standard restoring division algorithm is used. For larger
; values, repeated calls are made to the DIV32 subroutine,
; which chews off 32 bits of quotient at a time. In the latter
; case, the original dividend is preshifted to accommodate extra
; bits (MOD 32)
;
; ASSUME THE MASK: DO-ARITHMETIC, WITH D7=0 FOR THE
; CCR AND ROUND INFO.
;
; SOME ASSUMPTIONS ABOUT THE STACK ARE NECESSARY.
; WHEN THE REGISTERS WERE SAVED WITH MOVEM.L, D0 WAS
; LEFT NEAREST THE TOP OF THE STACK. ALL THAT IS ABOVE
; IT NOW IS THE RETURN ADDRESS, "PREPACK:" IN FPCONTROL.
; THUS DO.W, WHICH GETS THE INTEGER QUOTIENT, IS AT 6(SP).
;-----------------------------------------------------------
;-----------------------------------------------------------
; DO SOME BOOKKEEPING FIRST. PLACE DEFAULT 0 QUO IN D0.
; ASSUME THE RESULT WILL HAVE DST SIGN, AND NOTE THAT QUO
; SIGN IS MOVED TO BIT #6 OF D6.
; AND STORE ERROR CODE IN D0 IN CASE OF INVALID.
;
; P754 REQUIRES THAT THE PRECISION CONTROL BE DISABLED HERE.
;-----------------------------------------------------------
REMTOP:
CLR.W 6(SP) ; QUO SET TO 0 (D0.W saved on stack)
ADD.B D6,D6 ; ALIGN DST SIGN, MOVING QUO
MOVEQ #NANREM,D0 ; ASSUME THE WORST...
ANDI.L #$3FFFFFFF,D6 ; SET DST TO EXT'D PRECISION
MOVE.W REMCASE(D3),D3
JMP REMTOP(D3)
REMCASE: ; DST REM SRC
DC.W REMNUM - REMTOP ; NUM REM NUM
DC.W INVALIDOP - REMTOP ; NUM REM 0
DC.W REMDST - REMTOP ; NUM REM INF
DC.W RDST - REMTOP ; 0 REM NUM
DC.W INVALIDOP - REMTOP ; 0 REM 0
DC.W RDST - REMTOP ; 0 REM INF
DC.W INVALIDOP - REMTOP ; INF REM NUM
DC.W INVALIDOP - REMTOP ; INF REM 0
DC.W INVALIDOP - REMTOP ; INF REM INF
;-----------------------------------------------------------
; DEXP - SEXP + 1 = NUMBER OF INTEGER QUO BITS. GET ONE
; MORE TO AID IN ROUNDING. CASES ON (DEXP - SEXP + 1):
; >= 0 -- RUN DIVDE AND RESTORE TO GET THOSE BITS
; < 0 -- DST IS ALREADY LESS THAN HALF SRC, SO JUST
; COERCE (AND QUO = 0).
;-----------------------------------------------------------
REMNUM:
MOVE.L A3,D0 ; DST EXP
ADDQ.L #1,D0
SUB.L A4,D0 ; DEXP - SEXP + 1
BPL.S REMDIV ; MUST DO IT ALL...
REMDST:
MOVE.L A1,D4 ; RESULT IS DST
MOVE.L A2,D5
MOVEA.L A3,A4
BRA.S REMFIN
;-----------------------------------------------------------
; Set tentative REM exponent to SEXP-1, since REM will be reduced
; to at most half of SRC. Then determine from size of exponent
; difference in D0 which algorithm to use.
;-----------------------------------------------------------
REMDIV:
SUBQ.L #1,A4 ; tentative exponent
CMPI.L #9,D0
BGT.S REMSHIFT ; many integer bits to chew off
;-----------------------------------------------------------
; OFF TO RESTORE WITH ITS REGISTER MASK:
; D0: MAGNITUDE COUNT D1,D2: DIVIDEND
; D4,D5: QUOTIENT D3,A2: DIVISOR
;-----------------------------------------------------------
MOVE.L A1,D1 ; DST IS DIVIDEND
MOVE.L A2,D2
MOVE.L D4,D3 ; SRC IS DIVISOR
MOVEA.L D5,A2
ADDQ.L #1,D0 ; INITIALIZE LOOP COUNT
BSR.S RESTORE
;-----------------------------------------------------------
; AFTER ALL QUOTIENT BITS AND FIRST FRACTION BIT HAVE BEEN
; EVALUATED INTO D4,5 (LEADING BITS ARE LOST OFF THE LEFT)
; THERE ARE THREE CASES ("REM" IS RESULT OF DIV LOOP):
;
; LOW QUO BIT = 0 --> REM < HALF DVR, ALL DONE
;
; LOW QUO BIT = 1 AND REM = 0 --> HALF-WAY CASE, WHERE
; SIGN OF REM (= HALF DIVISOR) IS DETERMINED
; SO LOW INT QUO BIT WILL BE 0
;
; LOW QUO BIT = 1 AND REM > 0 --> TRUE REM > HALF DVR,
; SO FLIP SIGN AND SUBTACT. THIS IS TRICKY
; AND RATHER NONINTUITIVE. THE POINT IS THAT
; DIVIDING THROUGH TO THE FIRST FRAC QUO BIT
; REDUCES THE EXP OF REM TO DVR-1; BUT THE
; DIV ALGORITHM DOES NOT SHIFT ON THE LAST
; STEP, SO THE REM LINES UP PROPERLY WITH
; THE DVR FOR THE SUBTRACTION (THOUGH THEIR
; EXPONENTS SEEM TO DIFFER BY ONE). AND THE
; DIV ALGORITHM GUARANTEES THAT THE REM IT
; LEAVES IS LESS THAN THE DVR, SO THERE CAN
; BE NO CARRY OUT.
;-----------------------------------------------------------
REMPOSTRESTORING:
BTST #0,D5 ; LOW QUO BIT
BEQ.S REMQUO ; 0 --> JUST STUFF QUO
TST.L D1
BNE.S @3 ; CASE 3
TST.L D2
BNE.S @3 ; CASE 3
BTST #1,D5 ; CASE 2 DECIDED ON LO INT
BEQ.S @5 ; IF EVEN, LEAVE QUO BUT SET REM
@3:
BCHG #7,D6 ; FLIP REM SIGN
ADDQ.W #2,D5 ; INCREMENT QUO BY 1 (IN SECOND BIT)
@5:
EXG D2,A2 ; SWAP DVR AND REM
EXG D1,D3
SUB.L A2,D2 ; DVR - REM
SUBX.L D3,D1
;-----------------------------------------------------------
; NOW EXTRACT LOW 7 INTEGER BITS (REMEMBER GOT FIRST FRAC),
; NEGATE IF NECESSARY, EXTEND TO WORD, AND STORE.
;-----------------------------------------------------------
REMQUO:
LSR.B #1,D5 ; KILL FRAC BIT
BTST #6,D6 ; TEST QUO SIGN
BEQ.S @9
NEG.B D5
@9:
EXT.W D5 ; EXTEND SIGNED BYTE TO WORD
MOVE.W D5,6(SP) ; STORE IN SAVED D0.W
MOVE.L D1,D4 ; STUFF REM BITS
MOVE.L D2,D5
REMFIN:
MOVEQ #0,D7 ; zero stickies
BRA ZNORMCOERCE ; STORE THE RESULT
;-----------------------------------------------------------
; ASSUME FUNNY REGISTER MASK: RESTORING-DIVISION
; D0 - QUO BIT COUNT
; D1,2 - DIVIDEND CUM REMAINDER
; D3,A2 - DIVISOR (CAN ADD, NOT ADDX FROM A-REG)
; D4,5 - WILL BE QUOTIENT
;-----------------------------------------------------------
RESTORE:
MOVEQ #0,D4 ; CLEAR QUOTIENT
MOVE.L D4,D5
BRA.S @2 ; SKIP SHIFT ON 1ST STEP
@1:
ADD.L D5,D5 ; SHIFT QUO
ADDX.L D4,D4 ; IGNORE CARRY ON LAST STEP
ADD.L D2,D2 ; SHIFT REM
ADDX.L D1,D1
BCS.S @4 ; HAVE TO SUBTRACT
@2:
CMP.L D3,D1 ; DVD.HI - DVR.HI
BNE.S @3
CMP.L A2,D2
@3:
BCS.S @5 ; SKIP SUB IF DVD < DVR
@4:
ADDQ.B #1,D5 ; SET QUO BIT (NO CARRY)
SUB.L A2,D2
SUBX.L D3,D1
@5:
SUBQ.W #1,D0 ; LOOP COUNT
BNE.S @1
RTS
;-----------------------------------------------------------
; Remainder algorithm using DIV32 subroutine handles larger
; exponent differences much faster than RESTORE algorithm.
;
; D2/D3/D1: dividend/shifted remainder (96 bits)
; D4/D5: divisor
; D0/D6/D7: scratch
; A1: loop count
;-----------------------------------------------------------
REMSHIFT:
MOVEA.L D6,A3 ; A3 <- D6 value
MOVE.L A1,D3 ; D3 <- dividend.HI
MOVE.L A2,D1 ; D1 <- dividend.LO
MOVEQ #0,D2 ; D2 <- 0
MOVEA.L D0,A2 ; A2 <- shift count (ÆEXP + 1)
ANDI.L #$1F,D0 ; D0 <- alignment shift count (0 to 31 possible)
BEQ.S @1 ; if zero, do first DIV32
; shift dividend in D3/D1 left into D2/D3/D1
BFEXTU D3{0:D0},D2 ; shift bits from D3 high to D2 low
LSL.L D0,D3 ; shift D3 left
BFEXTU D1{0:D0},D6 ; extract D1 high bits
LSL.L D0,D1 ; shift D1 left
OR.L D6,D3 ; insert extracted D1 bits into shifted D3
;-----------------------------------------------------------
; Do initial division of D2:D3:D1 by D4/D5. 32-bit quotient in
; D0, remainder (shifted by 32 bits) in D2/D3.
;-----------------------------------------------------------
@1:
BSR DIV32
;-----------------------------------------------------------
; Remaining number of REM steps, if any, are done 32 at a time,
; using DIV32. Final D0 value is lowest 32 bits of the
; quotient, and the REM result is in D2/D3.
;-----------------------------------------------------------
MOVE.L A2,D6 ; Get number of remaining 32-bit steps
BFEXTU D6{16:11},D6
BEQ.S REMDIVDONE ; If zero, clean up
MOVE.L D6,A1 ; A1 <- # OF 32-bit REM steps
MOVEQ #0,D1 ; zero trailing remainder bits
REMLP32:
BSR DIV32
SUBQ.L #1,A1
MOVE.L A1,D6
BNE.S REMLP32
REMDIVDONE:
MOVE.L D2,D1 ; remainder to D1/D2
MOVE.L D3,D2
MOVE.L D4,D3 ; divisor to D3/A2
MOVEA.L D5,A2
MOVE.L D0,D5 ; quotient to D5
MOVE.L A3,D6 ; restore A6
BRA REMPOSTRESTORING ; finish up REM
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPCMP
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP (JTC)
; 12DEC82: PROJ MODE OUT (JTC)
;
; WITH ALL NUMBERS NORMALIZED, COMPARISONS ARE QUITE EASY.
; THE TRICK IS TO PICK UP THE UNORDERED CASES FROM NAN
; COERCIONS AND TO AVOID FLOATING COERCIONS (SINCE THE ONLY
; RESULT IS A CCR VALUE).
;-----------------------------------------------------------
;-----------------------------------------------------------
; DO A JSR RATHER THAN JMP TO SPECIAL CASE ROUTINES IN ORDER
; TO TIDY UP END CASES: EXPECT CCR SETTING IN D0.W.
; AT END: MOVE FROM D0.LO TO D7.HI AND SIGNAL INVALID
; IN CMPX ON UNORD.
;-----------------------------------------------------------
CMPTOP:
MOVE.W CMPCASE(D3),D3
JSR CMPTOP(D3)
CMPFIN: ; PICK UP HERE FROM NANS
CMPI.W #CMPU,D0 ; UNORDERED?
BNE.S @1
BTST #OPIFCPX+16,D6 ; CHECK WHETHER TO BARF
BEQ.S @1
BSET #ERRI+8,D6
@1:
MOVE.W D0,D7 ; ALIGN CCR BITS IN D7.HI
SWAP D7
RTS
CMPCASE: ; DST - SRC
DC.W CMPNUM - CMPTOP ; NUM - NUM
DC.W CMPS0 - CMPTOP ; NUM - 0
DC.W CMPD0 - CMPTOP ; NUM - INF
DC.W CMPD0 - CMPTOP ; 0 - NUM
DC.W CMP0 - CMPTOP ; 0 - 0
DC.W CMPD0 - CMPTOP ; 0 - INF
DC.W CMPS0 - CMPTOP ; INF - NUM
DC.W CMPS0 - CMPTOP ; INF - 0
DC.W CMPINF - CMPTOP ; INF - INF
;-----------------------------------------------------------
; NUM VS. 0: DISGUISE AS (0 VS. -NUM) AND FALL THROUGH.
;-----------------------------------------------------------
CMPS0:
ADD.B D6,D6 ; DST SGN -> SRC SLOT
NOT.B D6
;-----------------------------------------------------------
; 0 VS. NUM: SIGN OF NUM DETERMINES >.
;-----------------------------------------------------------
CMPD0:
MOVEQ #CMPG,D0 ; ASSUME >
TST.B D6 ; TST SRC SIGN
BMI.S @1
MOVEQ #CMPL,D0 ; 0 < POSITIVE
@1:
RTS
;-----------------------------------------------------------
; INF VS. INF: EITHER =, OR SAME AS 0 VS. NUM.
;-----------------------------------------------------------
CMPINF:
BTST #5,D6 ; EQ -> SIGNS =
BNE.S CMPD0
CMP0:
MOVEQ #CMPE,D0
RTS
;-----------------------------------------------------------
; NUM VS. NUM: IF SIGNS DIFFER, SAME AS 0 VS. NUM.
; IF SAME JUST COMPARE THE WORDS, TAKING ACCOUNT FOR COMMON
; SIGN.
;-----------------------------------------------------------
CMPNUM:
BTST #5,D6 ; NE -> TRIVIAL
BNE.S CMPD0
CMPA.L A4,A3 ; DST - SRC EXP'S
BGT.S @1
BLT.S @2
CMPA.L D4,A1 ; DST.HI - SRC.HI
BHI.S @1 ; HI -> UNSIGNED GREATER
BCS.S @2 ; CS -> UNSIGNED LESS
CMPA.L D5,A2
BEQ.S CMP0 ; THEY ARE =
BCS.S @2
;-----------------------------------------------------------
; THEY'RE > UNLESS NEGATIVE.
;-----------------------------------------------------------
@1:
NOT.B D6
;-----------------------------------------------------------
; THEY'RE < UNLESS NEGATIVE.
;-----------------------------------------------------------
@2:
MOVEQ #CMPL,D0
TST.B D6
BPL.S @21
MOVEQ #CMPG,D0
@21:
RTS
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPCVT
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP (JTC)
; 13OCT82: CHANGE INVALID SIGNALS ON EXT --> COMP (JTC).
; 28DEC82: FIX CASE OF LEFT SHIFT IN IALIGN (JTC).
; 29DEC82: FIX BUG IN FORCING CHOP MODE. (JTC)
; 30DEC82: UNFIX 28DEC82 FIX -- UNNECESSARY (JTC).
;
;-----------------------------------------------------------
;-----------------------------------------------------------
; CONVERSIONS TO EXTENDED ARE TRIVIAL, REQUIRING COERCION
; ONLY FOR FINITE, NONZERO VALUES
;-----------------------------------------------------------
CVT2E:
TST.W D3 ; IS IT 0 OR INF?
BEQ COERCE ; COERCE IF NOT
RTS
;-----------------------------------------------------------
; ROUND TO INTEGER REQUIRES RIGHT ALIGNMENT FOR TINIES,
; NOTHING FOR LARGE, 0, OR INF VALUES
;-----------------------------------------------------------
RINT:
TST.W D3 ; 0 OR INF?
BEQ.S @1
RTS ; SKIP IF 0 OR INF
@1:
BSR.S IPALIGN ; ALIGN BIN PT AT RIGHT
MOVEA.W (A0),A2 ; SAVE MODES, ARTIFICIALLY
BRA.S COMINT
;-----------------------------------------------------------
; TRUNC TO INTEGER REQUIRES RIGHT ALIGNMENT FOR TINIES,
; NOTHING FOR LARGE, 0, OR INF VALUES
;-----------------------------------------------------------
TINT:
TST.W D3 ; 0 OR INF?
BEQ.S @1
RTS ; SKIP IF 0 OR INF
@1:
;-----------------------------------------------------------
; NOW FAKE CHOP MODE BITS, BUT BE CAREFUL NOT TO LOSE
; ERROR FLAGS OR OLD MODE.
; BUG: CHOP CHANGED FROM 01 TO 11 AT LAST MINUTE IN DESIGN,
; BUT CHANGE WAS MISSED HERE.
;-----------------------------------------------------------
BSR.S IPALIGN ; ALIGN BIN PT AT RIGHT
MOVEA.W (A0),A2 ; SAVE MODES ETC.
BSET #RNDHI,(A0) ; CHOP = 11
BSET #RNDLO,(A0)
COMINT:
BSR COERCE ; COERCE, MAYBE 0
MOVE.W A2,(A0) ; RECALL MODES
;-----------------------------------------------------------
; AFTER COERCE MAY HAVE 0, UNNORM, OR NORMALIZED.
;-----------------------------------------------------------
TST.L D4 ; IF NORMALIZED, ALL SET
BMI.S @9
BNE.S @5
TST.L D5
BNE.S @5
SUBA.L A4,A4 ; SET TO 0
RTS
@5:
SUBQ.L #1,A4
ADD.L D5,D5
ADDX.L D4,D4
BPL.S @5
@9:
RTS
;-----------------------------------------------------------
; IPALIGN SETS UP BINARY POINT NO FURTHER RIGHT THAN 24,
; 53, 64 BITS AS SPECIFIED BY THE COERCION INFO.
;-----------------------------------------------------------
IPALIGN:
TST.L D6 ; IS IT SINGLE? (#SPREC)
BMI.S @1
BTST #DPREC+16,D6 ; IS IT DOUBLE?
BEQ.S IALIGN ; USUAL EXTD CASE
MOVEQ #52,D0
BRA.S FINALIGN
@1:
MOVEQ #23,D0
BRA.S FINALIGN
IALIGN:
MOVEQ #63,D0
FINALIGN:
ADDI.W #$3FFF,D0
MOVE.W D0,D1 ; SAVE POSSIBLE NEW EXP
SUB.L A4,D0 ; INTEXP - EXP
BGT.S @7
RTS ; RETURN LE IF TOO BIG
@7:
MOVEA.W D1,A4 ; PLACE NEW EXP
BSR RTSHIFT
MOVE #0000,CCR ; FUDGE CCR = GT
RTS
;-----------------------------------------------------------
; CONVERSIONS FROM EXTENDED ARE MORE COMPLICATED, IF THE
; RESULT IS INTXX OR COMP64, BECAUSE OF THE OVERFLOW CASES.
;-----------------------------------------------------------
CVTE2:
BTST #DSTINT+16,D6 ; 1 -> INTEGER
BEQ.S CVT2E ; AS ABOVE FOR FLOATS
;-----------------------------------------------------------
; FIRST BYPASS O, INF CASES.
;-----------------------------------------------------------
CMPI.W #2,D3 ; 2 -> ZERO, DONE
BNE.S @2
RTS
@2:
CMPI.W #4,D3 ; 4 -> INF -> OFLOW
BNE.S @4
MOVEQ #-1,D4 ; ENSURE OVERFLOW FOUND
BRA.S IOFLOW
;-----------------------------------------------------------
; USE IALIGN TO PUT BIN PT TO RIGHT OF D5, RETURNING LE IF
; INTEGER OVERFLOW (NO SPECIAL HANDLING REQUIRED SINCE THE
; VALUE IS ASSURED TO BE NORMALIZED, FORCING OVERFLOW).
;-----------------------------------------------------------
@4:
BSR.S IALIGN
BLE.S IOFLOW ; MUST HAVE LEADING ONE
;-----------------------------------------------------------
; SET UP CALL TO ROUND AS THOUGH RESULT IS EXT. SINCE LEAD
; BIT IS 0, ROUNDING CANNOT CARRY OUT AND MODIFY EXP.
;-----------------------------------------------------------
MOVEQ #0,D1 ; PUT EXT INC INFO
MOVEQ #1,D2
BTST #0,D5 ; GET NOT LSB TO Z FOR ROUND
BSR ROUND
;-----------------------------------------------------------
; NOW CHECK THE HORRENDOUS CASES FOR INTEGER OVERFLOW,
; FOR EACH OF THE THREE FORMATS.
; FORMAT CODES: 4-INT16 5-INT32 6-COMP64
; LET INTXX CASES SHARE CODE.
;-----------------------------------------------------------
IOFLOW:
MOVEQ #1,D1 ; $80000000 --> D1
ROR.L #1,D1
BTST #DSTLO+16,D6 ; CHECK FOR INT32
BNE.S @21
BTST #DSTMD+16,D6 ; CHECK FOR COMP64
BNE.S @41
SWAP D1 ; $00008000 --> D1
@21:
TST.L D4 ; ANY HI BITS?
BNE.S @25
CMP.L D1,D5 ; BIGGEST MAGNITUDE
BHI.S @25
BCS.S @23 ; NO OFLOW
TST.B D6 ; IS IT NEGATIVE?
BPL.S @25 ; NO, OFLOW
@23:
TST.B D6 ; NEGATIVE INTEGER?
BPL.S @24
NEG.L D5 ; NEGATE ALL 64 BITS
NEGX.L D4
@24:
RTS
@25:
MOVE.L D1,D5
@27:
BSET #ERRI+8,D6
BCLR #ERRX+8,D6 ; CLEAR INEXACT IF INVALID
RTS
@41:
TST.L D4 ; JUST CHECK LEAD BIT
BPL.S @23
MOVEQ #0,D5
MOVE.L D1,D4 ; D1 IS $80000000
BRA.S @27
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPSQRT
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP (JTC)
; 12DEC82: PROJ MODE OUT (JTC)
; 29JAN90: MODIFIED FOR MC68020 SANE (JPO)
;-----------------------------------------------------------
SQRTTOP:
CMPI.W #2,D3 ; IS THE OPERAND 0?
BNE.S @1
RTS ; ROOT(+-0) = +-0
@1:
MOVEQ #NANSQRT,D0 ; CODE BYTE, JUST IN CASE
TST.B D6 ; NEGATIVE, POSSIBLY INF?
BMI INVALIDOP ; WHETHER NUM OR INF
CMPI.W #4,D3 ; IS THE OPERAND +INF?
BNE.S @10
RTS ; ROOT(AFF +INF) = +INF
@10:
;--------------------------------------------------------------------
; Square root of a normalized positive extended number is evaluated
; using a modified version of the K. C. Johnson algorithm. This bit
; chop method attempts to find the largest extended number whose square
; is no larger than the radicand (operand). The rood is evaluated to
; 65 bits in order to determine the rounding bit, and the sticky bit is
; obtained from any residual remainder.
;
; The basic register mask is:
; radicand/remainder significand: D1.B D2 D3
; square root exponent: A4.W
; square root significand: D0.B D4 D5
; loop: bit mask/counter D6
; scratch: D7
; D6 save register: A3
;
; First step is to halve the exponent and adjust the bias, keeping
; track of whether the true exponent is odd or even. Cases, after
; right shift are:
; C=1---(2K) + $3FFF -> K + 1FFF, so rebias by $2000
; C=0---(2K + 1) + $3FFF -> K + 2000, so rebias by $1FFF
; and shift radicand 1 extra bit left.
;--------------------------------------------------------------------
MOVE.W A4,D0 ; divide exponent by 2
ASR.W #1,D0
MOVE SR,D7 ; save carry for later
BCC.S @2
ADDQ.W #1,D0
@2:
ADDI.W #$1FFF,D0 ; rebias
MOVEA.W D0,A4 ; store result exponent
;--------------------------------------------------------------------
; Initialize radicand for rooting. Use A3 as temp for D6
;--------------------------------------------------------------------
MOVEA.L D6,A3
MOVE.L D5,D3 ; radicand in D2/D3 initially
MOVE.L D4,D2
;--------------------------------------------------------------------
; Now shift radicand to align binary point between D0 and D2.
; Requires 1 shift for even exp, 2 shifts for odd, for which
; we saved flags above in D7.
;--------------------------------------------------------------------
ADD.L D3,D3
ADDX.L D2,D2
MOVEQ #1,D1
MOVE D7,CCR ; CARRY=0 -> odd exp -> extra shift
BCS.S @4
ADD.L D3,D3
ADDX.L D2,D2
ADDX.W D1,D1
;--------------------------------------------------------------------
; Now initialize remainder by subtracting 1 from D1.B
;--------------------------------------------------------------------
@4:
SUBQ.W #1,D1
;--------------------------------------------------------------------
; Initialize root in D0.B (low bit only), D4/D5. After J
; iterations of the bit chop loop, these 65 bits will hold:
; <CURRENT ROOT (J BITS)>0, followed by 64 - J zeros.
; At the end of each iteration, bit J+1 (from MSB) is evaluated:
; <NEW ROOT (J+1 BITS)>0, followed by 63 - J zeros.
;
; Since the root will be normalized, we can bypass the first iteration
; of the loop and initialize the root for the second iteration:
; D0 <- 1, D4 <- 0, AND D5 <- 0.
;--------------------------------------------------------------------
MOVEQ #1,D0
MOVEQ #0,D4
MOVE.L D4,D5
;--------------------------------------------------------------------
; Initialize bit mask D6 to $40000000
;--------------------------------------------------------------------
MOVE.L #$40000000,D6
BRA.S @8 ; branch into loop
;--------------------------------------------------------------------
; Top of loop for high longword (D4)
;--------------------------------------------------------------------
@6:
ADD.L D3,D3 ; double remainder
ADDX.L D2,D2
ADDX.W D1,D1
@8:
OR.L D6,D4 ; create <CURRENT ROOT>01000....
;--------------------------------------------------------------------
; Try remainder - root (short version since D5 = 0)
;--------------------------------------------------------------------
SUB.L D4,D2
SUBX.W D0,D1
BCC.S @11 ; no carry -> new root bit = 1
ADD.L D4,D2 ; carry -> new root bit = 0
ADDX.W D0,D1 ; restore previous positive remainder
EOR.L D6,D4 ; clr final 1 bit in D4
BRA.S @12
@11:
ADD.L D6,D4
@12:
LSR.L #1,D6 ; shift mask bit right for next iteration
BCC.S @6
;--------------------------------------------------------------------
; Evaluate 33rd bit by brute force (transition between D4 and D5).
; Set D6 = $80000000.
;--------------------------------------------------------------------
MOVE.L #$80000000,D6 ; D6 <- $80000000
ADD.L D3,D3 ; double remainder
ADDX.L D2,D2
ADDX.W D1,D1
SUB.L D6,D3 ; remainder - root
SUBX.L D4,D2
SUBX.W D0,D1
BCC.S @14 ; no carry; set D4 bit 0
ADD.L D6,D3 ; carry; restore positive remainder
ADDX.L D4,D2
ADDX.W D0,D1
BRA.S @16 ; D4 bit 0 remains clear
@14:
ADDQ.W #1,D4
;--------------------------------------------------------------------
; Quick exit if remainder after 33 bits is zero
;--------------------------------------------------------------------
@16:
MOVE.L D3,D7 ; current remainder zero?
OR.W D1,D7
OR.L D2,D7
BNE.S @18 ; no; do 33 more bits (inexact with sticky set)
LSR.W #1,D0 ; yes; shift result into D4/D5
ROXR.L #1,D4
ROXR.L #1,D5
BRA.S ROOTDONE ; finish up SQRT with round/stickies clear
;--------------------------------------------------------------------
; Set up for 34th-64th bits of root (D5 bits 31 through 1)
;--------------------------------------------------------------------
@18:
ROR.L #1,D6 ; bit mask (D6) = $40000000
;--------------------------------------------------------------------
; Loop for root bits 31 through 1 in D5
;--------------------------------------------------------------------
@20:
ADD.L D3,D3 ; double remainder
ADDX.L D2,D2
ADDX.W D1,D1
OR.L D6,D5 ; create <CURRENT ROOT>010000...
SUB.L D5,D3 ; remainder - root (wider subtraction)
SUBX.L D4,D2
SUBX.W D0,D1
BCC.S @22 ; no carry; new root bit = 1
ADD.L D5,D3 ; carry; restore positive remainder
ADDX.L D4,D2
ADDX.W D0,D1
EOR.L D6,D5 ; zero trailing 1 bit in D5
BRA.S @24 ; new root bit remains clear
@22:
ADD.L D6,D5
@24:
LSR.L #1,D6 ; update bit mask
BCC.S @20
;--------------------------------------------------------------------
; Evaluate round bit by brute force. First shift root 1 bit right
; into D4/D5. Next force the setting of the X bit. Then subtract
; (with extend) D7(zero)/D4/D5 from unshifted remainder in D1/D2/D3.
; Set round bit if no carry results. Sticky bits will always be set
; because root is irrational.
;--------------------------------------------------------------------
MOVEQ #0,D7 ; clr D7
ADDQ.W #1,D5 ; set lowest bit
LSR.W #1,D0 ; shift 64-bit root into D4/D5,
ROXR.L #1,D4 ; setting X bit on final shift
ROXR.L #1,D5
SUBX.L D5,D3 ; subtract root from unshifted remainder
SUBX.L D4,D2 ; with initial borrow
SUBX.W D7,D1
BCS.S @26 ; carry -> round bit is zero
MOVE.W #$8000,D7 ; no carry -> round bit is one
@26:
ADD.W #$00FF,D7 ; set sticky bits
ROOTDONE:
MOVE.L A3,D6 ; restore D6
BRA COERCE ; coerce result
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPSLOG
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 28DEC82: BUILT FROM SQRT BY JEROME COONEN
; 29APR83: CLASS ADDED (JTC)
; 09JUN83: PRESERVE A5,A6 (JTC)
; 30JAN90: MODIFIED FOR MC68020 SANE (JPO)
;-----------------------------------------------------------
LOGBTOP:
CLR.B D6 ; SIGN IS IRRELEVANT
CMPI.W #2,D3 ; IS THE OPERAND +-0?
BNE.S @1
;-----------------------------------------------------------
; LOGB(+-0) --> DIV BY ZERO --> ERROR BIT, STUFF -INF, RET.
;-----------------------------------------------------------
ORI.W #$0880,D6 ; POOR MAN'S BSET'S
MOVEA.W #$7FFF,A4 ; BIG EXP
MOVEQ #0,D4 ; ZERO DIGS
MOVE.L D4,D5
RTS
@1:
CMPI.W #4,D3 ; IS THE OPERAND +-INF?
BNE.S @10
;-----------------------------------------------------------
; LOGB(+-INF) --> +INF --> RET.
;-----------------------------------------------------------
RTS
;-----------------------------------------------------------
; LOGB(finite and nonzero) --> exponent, normalized as a
; floating-point number. Never exceptional. Uses fast
; normalization.
;-----------------------------------------------------------
@10:
MOVEQ #0,D5 ; clear the low significant bits
SUBA.W #$3FFF,A4 ; unbias exponent
MOVE.L A4,D4 ; move as integer
BGT.S @12 ; positive
BLT.S @11 ; negative
RTS ; zero
@11:
ORI.B #$80,D6 ; negative; set sign
NEG.L D4 ; magnitude of value
@12:
MOVEA.W #$401E,A4 ; exponent = 31, biased
BFFFO D4{0:0},D0 ; find first one bit in D4
LSL.L D0,D4 ; shift left to normalize
SUBA.W D0,A4 ; adjust exponent
RTS
;-----------------------------------------------------------
; SCALB BEHAVES MUCH LIKE LOGB, EXCEPT THAT THE INTEGER
; ARGUMENT MUST BE PULL FROM ITS SOURCE LOCATION, IT IS
; MORE CONVENIENT NOT TO UNPACK THE INPUT INTEGER TO
; FLOATING-POINT FORM. COUNT ON INTEGER'S ADDRESS IN
; LKADR2(A6).
; EASY CASES -- SCALB(N, ZERO/INF/NAN) --> ZERO/INF/NAN.
;-----------------------------------------------------------
SCALBTOP:
TST.W D3 ; IS THE OPERAND +-0, +-INF?
BEQ.S @1
RTS
;-----------------------------------------------------------
; JUST ADD THE INTEGER ADJUSTMENT INTO THE EXPONENT IN A4,
; AND CHECK FOR OVER/UNDERFLOW.
;-----------------------------------------------------------
@1:
MOVEA.L LKADR2(A6),A3 ; SRC ADDRESS
ADDA.W (A3),A4
BRA COERCE
;-----------------------------------------------------------
; CLASS PLACES INTEGER CODE AT DST ADDRESS. THE CODE TIES
; IN USEFULLY WITH THE PASCAL ENUMERATED TYPES IN SANE.
; IT IS THE SANE VALUE PLUS ONE, WITH THE SIGN OF THE INPUT
; OPERAND. IN SANE, THE SIGN IS PLACED IN A SEPARATE INT.
; THE VALUES ARE THUS:
; SNAN 1
; QNAN 2
; INF 3
; ZERO 4
; NORMAL 5
; DENORM 6
;-----------------------------------------------------------
CLASSTOP:
MOVEQ #5,D0 ; ASSUME NORMAL NUMBER
TST.L D3 ; CHECK FOR DENORM
BMI.S @98 ; possible subnormal
BEQ.S CLASSFIN
SUBQ.W #2,D0 ; ASSUME INF
CMPI.W #4,D3 ; INF CODE
BEQ.S CLASSFIN
BRA.S @99 ; otherwise, zero
@98: ; possible subnormal
MOVE.W LKOP(A6),D1 ; isolate format
ANDI.W #$1800,D1
BNE.S @99 ; subnormal if single or double classify
MOVE.L A4,D1 ; subnormal if exponent is negative
BPL.S CLASSFIN ; otherwise, normal
@99:
ADDQ.W #1,D0 ; subnormal; code value is 6
CLASSFIN:
TST.B D6 ; NONZERO -> NEGATIVE
BEQ.S @100
NEG.W D0
@100:
MOVEA.L LKADR1(A6),A3
MOVE.W D0,(A3)
RTS
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPODDS
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 05JUL82: WRITTEN BY JEROME COONEN
; 27APR83: NEGATE, ABS, COPYSIGN ADDED. (JTC)
; 02MAY83: NEXTAFTER ADDED. (JTC)
; 04MAY83: SETXCP ADDED. (JTC)
; 09JUN83: A5,A6 PRESERVED.
; 09JUL83: ENTRY/EXIT, TESTXCP ADDED. (JTC)
; 30JAN90: MODIFIED FOR MC68020 SANE. (JPO)
;
; FOR CONVENIENCE, MOVE DST->A1, SRC->A2 TO HAVE POINTERS.
;
; JUMP TO MISCELLANEOUS ROUTINE BASED ON INDEX IN OPCODE IN
; D6. DEPEND ON REGISTER MASK: ODDBALLS WITH STATE POINTER
; IN A0 AND ONE OPERAND ADDRESS IN A1.
; AT END, MUST JUMP TO FINISHUP SEQUENCES POPX, AS
; APPROPRIATE.
;-----------------------------------------------------------
ODDBALL:
MOVEM.L LKADR1(A6),A1-A2 ; GET DST, SRC ADRS
MOVE.W ODDTAB(D7),D7 ; INDEX INTO TABLE
JMP ODDBALL(D7) ; DO ODD-NUMBERED OP
;-----------------------------------------------------------
; JUMP FROM INDEX-1, AFTER CHECK FOR LEGITIMACY.
;-----------------------------------------------------------
ODDTAB:
DC.W PUTW - ODDBALL ; PUT STATE WORD
DC.W GETW - ODDBALL ; GET STATE WORD
DC.W PUTV - ODDBALL ; PUT TRAP VECTOR
DC.W GETV - ODDBALL ; GET TRAP VECTOR
DC.W D2B - ODDBALL ; DECIMAL TO BINARY
DC.W B2D - ODDBALL ; BINARY TO DECIMAL
DC.W NEGZ - ODDBALL ; NEGATE -- ANY FORMAT
DC.W ABSZ - ODDBALL ; ABS -- ANY FORMAT
DC.W CPSZ - ODDBALL ; COPY SIGN -- ANY FORMAT
DC.W NEXTZ - ODDBALL ; NEXTAFTER: S, D, X
DC.W SETXCP - ODDBALL ; SET EXCEPTION, HALT IF...
DC.W ENTRYP - ODDBALL ; ENTRY PROTOCOL
DC.W EXITP - ODDBALL ; EXIT PROTOCOL
DC.W TESTXCP- ODDBALL ; TEST AN EXCEPTION.
;-----------------------------------------------------------
; THE STATE ROUTINES ARE TRIVIAL, AND ALL "RETURN" TO POP1.
;-----------------------------------------------------------
PUTW:
MOVE.W (A1),(A0)
BRA POP1
ENTRYP:
MOVE.W (A0),(A1)
CLR.W (A0)
BRA POP1
GETW:
MOVE.W (A0),(A1)
BRA POP1
PUTV:
MOVE.L (A1),2(A0)
BRA POP1
GETV:
MOVE.L 2(A0),(A1)
BRA POP1
NEGZ:
BCHG #7,(A1)
BRA POP1
ABSZ:
BCLR #7,(A1)
BRA POP1
;-----------------------------------------------------------
; TEST AN EXCEPTION WHOSE INDEX IS (A1). SET BYTE (A1) TO
; 1 (TRUE) IF THE EXCEPTION IS SET, SET IT TO 0 (FALSE) IF
; N0T SET.
;-----------------------------------------------------------
TESTXCP:
MOVE.W (A1),D0 ; FETCH INPUT INDEX
BTST D0,(A0) ; EXCEPTION BITS IN HI BYTE
SNE D0
NEG.B D0
MOVE.B D0,(A1) ; RESULT CODE
BRA POP1
;-----------------------------------------------------------
; NOTE THAT COPYSIGN COPIES THE SIGN OF THE "DST" ARGUMENT
; ONTO THAT OF THE "SRC" ARGUMENT.
;-----------------------------------------------------------
CPSZ:
BTST #7,(A1)
BEQ.S @1
BSET #7,(A2)
BRA.S @2
@1:
BCLR #7,(A2)
@2:
BRA POP2
;-----------------------------------------------------------
; NEXTAFTER FUNCTION: BEHAVES LIKE NONARITHMETIC OPS, BUT
; MAY SET ERROR FLAGS, SO EXITS THROUGH CHKERR RATHER THAN
; POP2. CALLS REFP020 FOR COMPARE, MULTIPLY (NAN PRECEDENCE),
; CLASS, AND CONVERT.
; NOTE THAT NEXTAFTER CHANGES ITS *****SOURCE***** ARGUMENT
; IN THE DIRECTION OF THE DESTINATION ARGUMENT.
;-----------------------------------------------------------
NEXTZ:
;-----------------------------------------------------------
; ON ENTRY, D6.W IS OPCODE, A1 IS DST, A2 IS SRC, A0 STATE.
; USE OTHER REGISTERS FREELY, BUT MUST ALIGN OPWORD IN D6.HI
; WITH PROPER MASK FOR EXIT THROUGH CHKERR. D6.L0 WILL HOLD
; ERROR FLAGS. MASK OF OPERAND FORMAT BITS INTO D5 FOR USE
; AS MASK FOR CALLING CONVERSION AND INC/DEC ROUTINES.
; STACK FRAME = (A4) = DST-EXT; INT; SRC-EXT
;
; Code modified to support 96-bit extended operands. <23 MAR 90; JPO>
; Added normalization of SRC operand, atomic exception
; signaling, and default rounding during calculation
; of NEXTAFTER values. <3 APR 90; JPO>
;
;-----------------------------------------------------------
SUBA.W #22,SP ; NEED 2 EXTENDEDS AND 1 INTEGER
MOVEA.L SP,A4 ; FRAME POINTER THROUGHOUT WHOLE FCN
MOVE.W (A0),D3 ; save old environment in D3 for duration
CLR.W (A0) ; set default environment
MOVEQ #0,D2 ; zero D2
MOVE.W D6,D5 ; COPY OPCODE
ANDI.W #$3800,D5 ; isolate format bits in D5
BNE.S @2 ; single or double format
MOVE.B #$20,D2 ; isolate FPX96 bit in D2
AND.B D6,D2
BEQ.S @2 ; 80-bit extended
MOVE.W (A2),2(A2) ; convert 96-bit SRC to 80-bit and
ADDQ.L #2,A2 ; update pointer to latter
@2:
ADDQ.W #1,D6 ; SET #TWOADRS BIT CHEAPLY
SWAP D6 ; ALIGN IN HI WORD, LIKE ARITH OPS
CLR.W D6 ; ZERO FLAG AND SIGN BITS
;-----------------------------------------------------------
; CONVERT SRC TO EXTENDED
;-----------------------------------------------------------
PEA (A2) ; SRC OPERAND ADDRESS
PEA 12(A4) ; STACK FRAME ADDR
MOVEQ #OP2EXT,D0 ; CONVERT TO 80-BIT EXT OPCODE
OR.W D5,D0 ; ...WITH FORMAT
MOVE.W D0,-(SP)
BSR REFP020
TST.W D5 ; IF EXTENDED FORMAT, OVERWRITE
BNE.S @3 ; SRC WITH CONVERTED SRC TO
; AVOID PROBLEM OF UNNORMALIZED VALUES
MOVE.L 12(A4),(A2)
MOVE.L 16(A4),4(A2)
MOVE.W 20(A4),8(A2)
;-----------------------------------------------------------
; COMPARE SRC WITH ZERO. IF IT'S EQUAL, ADJUSTMENTS WILL
; BE MADE IN DECREMENT ROUTINES BELOW.
;-----------------------------------------------------------
@3:
BFEXTU 12(A4){1:15},D1 ; extract EXP field from SRC
OR.L 14(A4),D1 ; OR in SIG.HI and SIG.LO
OR.L 18(A4),D1
SNE D4 ; D4.BYTE IS 1'S IF SRC IS ZERO
;-----------------------------------------------------------
; CONVERT DST TO EXTENDED
;-----------------------------------------------------------
PEA (A1)
PEA (A4)
OR.B D2,D0 ; may be 96-bit DST
MOVE.W D0,-(SP)
BSR REFP020
TST.B D2 ; if 96-bit DST, shrink to 80-bit
BEQ.S @4 ; in stack frame
MOVE.L 4(A4),2(A4)
MOVE.L 8(A4),6(A4)
;-----------------------------------------------------------
; COMPARE THE TWO EXTENDED OPERANDS
;-----------------------------------------------------------
@4:
PEA (A4) ; DST OPERAND
PEA 12(A4) ; SRC OPERAND
MOVE.W #OPCMP,-(SP)
BSR REFP020
;-----------------------------------------------------------
; IF OVERFLOW IS SET, THE OPERANDS ARE UNORDERED, THAT IS,
; ONE OF THEM IS A NAN. USE THE MULTIPLY OPERATION TO FORCE
; THE PRECEDENT NAN (IF THERE ARE TWO) TO THE SRC
;-----------------------------------------------------------
BVC.S NXORD
PEA (A4) ; DST OPERAND
PEA 12(A4) ; SRC OPERAND
MOVE.W #OPMUL,-(SP)
BSR REFP020
;-----------------------------------------------------------
; NOW CONVERT THE PRECEDENT NAN BACK TO INPUT FORMAT.
;-----------------------------------------------------------
PEA 12(A4) ; SRC OPERAND IS OUTPUT
PEA (A2) ; SRC ADDRESS
MOVEQ #OPEXT2,D0 ; CVT FROM 80-BIT EXT OPCODE
OR.W D5,D0 ; OVERLAY THE FORMAT
MOVE.W D0,-(SP)
BSR REFP020
BRA NXFIN
;-----------------------------------------------------------
; GET HERE IF THE TWO OPERANDS ARE ORDERED. IF THEY ARE
; EQUAL, THERE IS NOTHING TO DO; OTHERWISE MUST INC OR DEC
; THE SRC OP AS APPROPRIATE. NOTE THE ONE *****FUNNY*****
; CASE: IF THE SRC IS ZERO, THEN ITS SIGN MAY BE MISLEADING.
; FOR INSTANCE, NEXT(-0, 3) SHOULD BE +0INC1. BUT THE MINUS
; SIGN ON 0 CAUSES A DEC TO BE ISSUED INSTEAD. THE FIX IS
; TO MAKE DEC SMART ENOUGH TO KNOW THAT IF 0 IS DEC-ED, THE
; SIGN SHOULD BE FLIPPED AND THE OPERAND SHOULD BE INC-ED
; INSTEAD.
;-----------------------------------------------------------
NXORD:
BEQ NXFIN
BCC.S NXGREAT
;-----------------------------------------------------------
; GET HERE WHEN SRC < DST. INC IF SRC IS +, DEC IF -
;-----------------------------------------------------------
BTST #7,(A2) ; SIGN BIT OF SRC OPERAND
BEQ.S NXINC
BRA NXDEC
;-----------------------------------------------------------
; GET HERE WHEN SRC > DST. DEC IF SRC IS +, INC IF -
;-----------------------------------------------------------
NXGREAT:
BTST #7,(A2)
BEQ NXDEC
;-----------------------------------------------------------
; INCREMENT BY A UNIT IN THE LAST PLACE, ACCORDING TO THE
; FORMAT MASK IN D5. THE FORMAT IS IN BITS $3800. THE ONLY
; POSSIBLE CASES ARE:
; $1000 -- SINGLE
; $0800 -- DOUBLE
; $0000 -- EXTENDED
;-----------------------------------------------------------
NXINC:
;-----------------------------------------------------------
; SINGLE CASE:
;-----------------------------------------------------------
BTST #SRCMD,D5 ; TEST $1000 BIT
BEQ.S @11
ADDQ.L #1,(A2)
BRA.S NXERR
;-----------------------------------------------------------
; DOUBLE CASE:
;-----------------------------------------------------------
@11:
BTST #SRCLO,D5 ; TEST $0800 BIT
BEQ.S @15
ADDQ.L #1,4(A2)
BCC.S @13
ADDQ.L #1,(A2)
@13:
BRA.S NXERR
;-----------------------------------------------------------
; EXTENDED CASE: BE SURE OUTPUT INFINITY HAS LEADING 0 BIT.
;-----------------------------------------------------------
@15:
ADDQ.L #1,6(A2)
BCC.S NXERR
ADDQ.L #1,2(A2)
BCC.S NXERR
ROXR 2(A2)
ADDQ.W #1,(A2)
CMPI.W #$7FFF,(A2)
BEQ.S @16
CMPI.W #$FFFF,(A2)
BNE.S NXERR
@16:
BCLR #7,2(A2) ; Clr explicit bit in infinite result
;-----------------------------------------------------------
; TEST FOR EXCEPTIONS ACCORDING TO IEEE. NEXT(HUGE, INF)
; YIELDS INF WITH OVERFLOW AND INEXACT SIGNALED.
; NEXT(TINY, 0) YIELDS SOME DENORMAL WITH UNDERFLOW
; AND INEXACT. JUST SET THE APPROPRIATE BITS IN D6.LO AND
; EXIT AS THOUGH A TRUE ARITHMETIC OPERATION. THE FIRST
; STEP IS TO FIND THE CLASS OF THE INC/DEC-ED SRC OPERAND.
;-----------------------------------------------------------
NXERR:
PEA (A2)
PEA 10(A4) ; ADDRESS OF INTEGER
MOVEQ #OPCLASS,D0
OR.W D5,D0
MOVE.W D0,-(SP)
BSR REFP020
;-----------------------------------------------------------
; KILL THE SIGN OF THE CLASS RESULT AND PLACE IN REGISTER
; THE CODES ARE:
; 1 SNAN -- CAN'T HAPPEN
; 2 QNAN -- CAN'T HAPPEN
; 3 INF -- OVERFLOW AND INEXACT
; 4 ZERO -- UNDERFLOW AND INEXACT
; 5 NORMAL -- OK
; 6 DENORMAL -- UNDERFLOW AND INEXACT
;-----------------------------------------------------------
MOVE.W 10(A4),D1
BPL.S @1
NEG.W D1
@1:
;-----------------------------------------------------------
; CHECK FOR INFINITE RESULT (WHICH MUST HAVE COME FROM FIN).
;-----------------------------------------------------------
CMPI.W #CLINF,D1
BNE.S @3
ORI.W #ERRWXO,D6 ; SET INEXACT AND OVERFLOW
BRA.S NXFIN
@3:
CMPI.W #CLNORM,D1
BEQ.S NXFIN
ORI.W #ERRWXU,D6 ; SET INEXACT AND UNDERFLOW
;-----------------------------------------------------------
; EXIT THROUGH POINT IN FPCONTROL AFTER CLEANING STACK
;-----------------------------------------------------------
NXFIN:
ADDA.W #22,SP ; RESTORE STACK
TST.B D2 ; if 96-bit extended result,
BEQ.S @1 ; expand result
MOVE.W (A2),-2(A2)
@1:
MOVE.W (A0),D7 ; D7 <- flags due to conversions
MOVE.W D3,(A0) ; restore old environment
OR.W D7,D6 ; OR all flags together
MOVEQ #0,D0 ; clr D7 (will be CCR value)
BRA CHKERR
;-----------------------------------------------------------
; DECREMENT, WATCHING FOR ZERO VALUE. BRANCH TREE IS LIKE
; THAT OF INC ABOVE.
;-----------------------------------------------------------
NXDEC:
BTST #SRCMD,D5 ; CHECK $1000 BIT FOR SINGLE
BEQ.S @21
TST.B D4 ; D4.B IS NON0 IF OPERAND IS
BNE.S @201
BCHG #7,(A2)
ADDQ.L #1,(A2)
BRA.S NXERR
@201:
SUBQ.L #1,(A2)
BRA.S NXERR
;-----------------------------------------------------------
; DOUBLE CASE
;-----------------------------------------------------------
@21:
BTST #SRCLO,D5 ; CHECK $0800 BIT FOR DOUBLE
BEQ.S @25
TST.B D4 ; D4.B IS NON0 IF OP IS
BNE.S @211
BCHG #7,(A2)
ADDQ.W #1,6(A2)
BRA.S NXERR
@211:
SUBQ.L #1,4(A2)
BCC.S @213
SUBQ.L #1,(A2)
@213:
BRA.S NXERR
;-----------------------------------------------------------
; EXTENDED CASE
;-----------------------------------------------------------
@25:
TST.B D4
BNE.S @251
BCHG #7,(A2)
ADDQ.W #1,8(A2)
BRA NXERR
@251:
SUBQ.L #1,6(A2) ; DEC LOW LONG
BCC.S @259 ; NO C MEANS FINE
SUBQ.L #1,2(A2)
BMI.S @257 ; MAY HAVE BORROWED
TST.W (A2) ; MIN EXP?
BEQ.S @259 ; YES --> DONE
CMPI.W #$8000,(A2)
BEQ.S @259
ADDI.W #$8000,2(A2)
BRA.S @258
@257:
BCC.S @259 ; NO CARRY --> DONE
@258:
SUBQ.W #1,(A2)
@259:
BRA NXERR
;-----------------------------------------------------------
; SET EXCEPTION AND HALT IF ENABLED. SIMPLY SET THE
; SUITABLE BIT IN THE BYTE MASK $00001F00 IN D6 AND EXIT
; THROUGH FPCONTROL, AS THOUGH ARITHMETIC WERE PERFORMED.
;-----------------------------------------------------------
SETXCP:
SWAP D6 ; ALIGN IN HI WORD, LIKE ARITH OPS
CLR.W D6 ; ZERO FLAG AND SIGN BITS
MOVE.W (A1),D0 ; FETCH INPUT WORD INDEX
ADDQ.W #8,D0 ; ALIGN TO SECOND BYTE
BSET D0,D6
BRA CHKERR ; EXIT THROUGH FPCONTROL
;-----------------------------------------------------------
; RESTORE OLD ENVIRONMENT, AND CHECK CURRENT ERRS FOR HALT
;-----------------------------------------------------------
EXITP:
SWAP D6 ; ALIGN OPWORD, LIKE ARITH
MOVE.W #$1F00,D6 ; SET UP FLAG MASK #ERRO
; #ERRU #ERRX #ERRI #ERRZ
AND.W (A0),D6 ; SAVE CURRENT ERRORS
MOVE.W (A1),(A0) ; RESTORE OLD STATE
EPEXIT:
BRA CHKERR ; EXIT VIA FPCONTROL