mirror of
https://github.com/elliotnunn/sys7.1-doc-wip.git
synced 2024-06-06 06:29:27 +00:00
2907 lines
80 KiB
Plaintext
2907 lines
80 KiB
Plaintext
;
|
|
; File: FPOPS.a
|
|
;
|
|
; Contains: xxx put contents here xxx
|
|
;
|
|
; Written by: The Apple Numerics Group
|
|
;
|
|
; Copyright: © 1990-1993 by Apple Computer, Inc., all rights reserved.
|
|
;
|
|
; This file is used in these builds: Mac32
|
|
;
|
|
; Change History (most recent first):
|
|
;
|
|
; <SM2> 2/3/93 CSS Update from Horror:
|
|
; <H2> 9/29/92 BG Rolling in Jon Okada's latest fixes.
|
|
; <1> 11/14/90 BG Added to BBS for the first time.
|
|
;
|
|
; To Do:
|
|
;
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; PACK4 FP operations for MC68020
|
|
; Copyright Apple Computer, Inc., 1983,1984,1985,1989,1990,1991,1992,1993
|
|
; All rights reserved
|
|
;-----------------------------------------------------------
|
|
|
|
; CHANGE LOG:
|
|
; 23 Mar 92 JPO Modified subroutines IPALIGN and IALIGN to fix rounding
|
|
; error for FTINTX and FRINTX when rounding precision is
|
|
; less than extended.
|
|
|
|
;-----------------------------------------------------------
|
|
; Entry points for individual operations or clusters of
|
|
; operations with different data formats.
|
|
;
|
|
; Stack has identical form as at the main entry point of the
|
|
; package:
|
|
; ret < opword < addr1 < addr2 < addr3,
|
|
; where the number of addresses (1, 2, or 3) depends on the
|
|
; operation.
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; MACRO performs setup with numerous entry points (functions
|
|
; which require all D and A registers).
|
|
;-----------------------------------------------------------
|
|
MACRO
|
|
FINIT
|
|
|
|
LINK A6,#0
|
|
MOVEM.L D0-D7/A0-A4,-(SP) ; save all registers
|
|
|
|
ENDM
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; FP ADDITION/SUBTRACTION
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QADDX---Add extended to extended
|
|
;-----------------------------------------------------------
|
|
QADDX:
|
|
FINIT
|
|
LEA ADDTOP,A0 ; continue below
|
|
BRA UNPACKXX ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; QADDB---Add non-extended SRC to extended DST
|
|
;-----------------------------------------------------------
|
|
QADDB:
|
|
FINIT
|
|
LEA ADDTOP,A0 ; continue below
|
|
BRA UNPACKXB ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; QSUBX---Subtract extended SRC from extended DST
|
|
;-----------------------------------------------------------
|
|
QSUBX:
|
|
FINIT
|
|
LEA SUBTOP,A0 ; continue below
|
|
BRA UNPACKXX ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; QSUBB---Subtract non-extended SRC from extended DST
|
|
;-----------------------------------------------------------
|
|
QSUBB:
|
|
FINIT
|
|
LEA SUBTOP,A0 ; continue below
|
|
BRA UNPACKXB ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; To subtract, just flip the sign and XOR-sign bits in D6.B
|
|
;-----------------------------------------------------------
|
|
SUBTOP:
|
|
EORI.B #$A0,D6
|
|
|
|
;-----------------------------------------------------------
|
|
; Add 2 numbers. Dispatch to one of 9 cases depending on
|
|
; class of operands: [finite] number, zero, or infinite.
|
|
; NaNs have already been filtered out.
|
|
;-----------------------------------------------------------
|
|
ADDTOP:
|
|
LEA FINI2OPS,A0 ; finish-up routine
|
|
MOVE.W ADDCASE(D0),D0 ; index to D0
|
|
JMP ADDTOP(D0) ; do special case
|
|
|
|
ADDCASE: ; DST + SRC
|
|
|
|
DC.W ADDNUM - ADDTOP ; NUM + NUM
|
|
DC.W ADDS0 - ADDTOP ; NUM + 0
|
|
DC.W PACKX - ADDTOP ; NUM + INF
|
|
|
|
DC.W ADDD0 - ADDTOP ; 0 + NUM
|
|
DC.W ADD00 - ADDTOP ; 0 + 0
|
|
DC.W PACKX - ADDTOP ; 0 + INF
|
|
|
|
DC.W RDSTSGN- ADDTOP ; INF + NUM
|
|
DC.W RDSTSGN- ADDTOP ; INF + 0
|
|
DC.W ADDINF - ADDTOP ; INF + INF
|
|
|
|
;-----------------------------------------------------------
|
|
; First align so value in DST position has smaller exponent.
|
|
; Then shift with special cases. "Larger" digits are in D3/A2.
|
|
; Assume SRC exponent is "larger", so swap its significand with DST.
|
|
;-----------------------------------------------------------
|
|
ADDNUM:
|
|
EXG D4,D3
|
|
EXG D5,A2
|
|
MOVE.W A4,D0 ; SRC exponent
|
|
SUB.W A3,D0 ; SRC exp - DST exp
|
|
BEQ ADDEM ; no shift if exponents equal
|
|
BGT.S @1 ; just shift DST in D4/5
|
|
|
|
;-----------------------------------------------------------
|
|
; SRC exp < DST exp, so swap operands. Move DST sign to bit
|
|
; 7 of D6 byte without moving the XOR (bit 5)
|
|
;-----------------------------------------------------------
|
|
EXG D5,A2 ; swap significands
|
|
EXG D4,D3
|
|
MOVEA.L A3,A4 ; larger exponent in A4
|
|
ADD.B D6,D6 ; shift src sign out
|
|
NEG.W D0 ; negate exponent difference
|
|
ASR.B #1,D6 ; duplicate DST sign and restore XOR to bit 5
|
|
|
|
;-----------------------------------------------------------
|
|
; Do fast right shift of D4/D5 into D4/D5/D7.
|
|
;-----------------------------------------------------------
|
|
@1:
|
|
MOVE.L D0,D2 ; D2 used to dispatch to fast shift routine
|
|
CMPI #66,D0
|
|
BHI ADDSHLOTS ; special fast routine if > 66 bits to shift
|
|
|
|
ADD D2,D2 ; jmp to appropriate routine
|
|
MOVE ADDSHCASE(D2),D2
|
|
JMP ADDNUM(D2)
|
|
|
|
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
|
|
NOT.B 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 ADDEM ; fix stickies
|
|
|
|
;-----------------------------------------------------------
|
|
; Shift of 33-63 bits
|
|
;-----------------------------------------------------------
|
|
ADDSH33TO63:
|
|
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 ADDEM ; 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 ADDEM ; fix stickies
|
|
|
|
ADDSH32:
|
|
MOVE.L D5,D7 ; 32-bit shift is easy
|
|
MOVE.L D4,D5
|
|
MOVEQ #0,D4
|
|
BRA ADDEM ; fix stickies
|
|
|
|
;-----------------------------------------------------------
|
|
; Shift of 2-31 bits
|
|
;-----------------------------------------------------------
|
|
ADDSH2TO31:
|
|
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
|
|
BRA.S ADDEM
|
|
|
|
;-----------------------------------------------------------
|
|
; Special quick shift routines
|
|
;-----------------------------------------------------------
|
|
ADDSH16:
|
|
MOVE.W D5,D7
|
|
MOVE.W D4,D5
|
|
CLR.W D4
|
|
SWAP D5
|
|
SWAP D4
|
|
SWAP D7
|
|
BRA.S ADDEM
|
|
|
|
ADDSH8:
|
|
BFINS D5,D7{0:8}
|
|
MOVE.B D4,D5
|
|
LSR.L #8,D4
|
|
ROR.L #8,D5
|
|
BRA.S ADDEM
|
|
|
|
ADDSH7:
|
|
BFINS D5,D7{0:7}
|
|
LSR.L #7,D5
|
|
BFINS D4,D5{0:7}
|
|
LSR.L #7,D4
|
|
BRA.S ADDEM
|
|
|
|
ADDSH6:
|
|
BFINS D5,D7{0:6}
|
|
LSR.L #6,D5
|
|
BFINS D4,D5{0:6}
|
|
LSR.L #6,D4
|
|
BRA.S ADDEM
|
|
|
|
ADDSH5:
|
|
BFINS D5,D7{0:5}
|
|
LSR.L #5,D5
|
|
BFINS D4,D5{0:5}
|
|
LSR.L #5,D4
|
|
BRA.S ADDEM
|
|
|
|
ADDSH4:
|
|
BFINS D5,D7{0:4}
|
|
LSR.L #4,D5
|
|
BFINS D4,D5{0:4}
|
|
LSR.L #4,D4
|
|
BRA.S ADDEM
|
|
|
|
ADDSH3:
|
|
BFINS D5,D7{0:3}
|
|
LSR.L #3,D5
|
|
BFINS D4,D5{0:3}
|
|
LSR.L #3,D4
|
|
BRA.S ADDEM
|
|
|
|
ADDSH2:
|
|
BFINS D5,D7{0: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.L #1,D7
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Operands are now aligned; test for +/- then do it
|
|
;-----------------------------------------------------------
|
|
ADDEM:
|
|
BTST #5,D6 ; test XOR of signs
|
|
BNE.S SUBMAG
|
|
|
|
;-----------------------------------------------------------
|
|
; Add magnitudes: 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.L #1,D7 ; no stickies can be lost
|
|
SCS D1
|
|
OR.B D1,D7
|
|
ADDQ.L #1,A4 ; bump exponent
|
|
@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 change
|
|
SUB.L A2,D5
|
|
SUBX.L D3,D4
|
|
BEQ.S ZEROSUM ; store zero with sign
|
|
BCC NORMCOERCE ; got it right
|
|
|
|
NEG.L D7 ; flip digits
|
|
NEGX.L D5
|
|
NEGX.L D4
|
|
NOT.B D6 ; flip sign back
|
|
@7:
|
|
BRA NORMCOERCE
|
|
|
|
;-----------------------------------------------------------
|
|
; Now set exponent to 0 and fix sign according to rounding
|
|
; mode.
|
|
; In the special case of two 0's, avoid the underflow.
|
|
; Coercion will signal in single/double restriction.
|
|
;-----------------------------------------------------------
|
|
ADD00:
|
|
BTST #5,D6 ; same sign?
|
|
BEQ PACKX ; yes, easy
|
|
ZEROSUM:
|
|
SUBA.L A4,A4 ; 0 exp
|
|
MOVEA.W #FPSTATE,A1 ; A1 points to environment
|
|
CLR.B D6 ; assume positive
|
|
BTST #RNDHI,(A1) ; 10 -- RND MINUS
|
|
BEQ.S ADDQ00
|
|
BTST #RNDLO,(A1)
|
|
BNE.S ADDQ00
|
|
NOT.B D6 ; make negative
|
|
ADDQ00:
|
|
BRA PACKX ; don't coerce 0
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; If DST = 0, have result = SRC. If SRC=0, must set
|
|
; result = DST.
|
|
;-----------------------------------------------------------
|
|
ADDS0:
|
|
MOVE.L A2,D5 ; LO DIGS
|
|
MOVE.L D3,D4 ; HI DIGS
|
|
MOVE.L A3,A4 ; EXP
|
|
ADD.B D6,D6 ; SIGN
|
|
ADDD0:
|
|
BRA COERCE
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Sum of two INFs depends on their signs.
|
|
;-----------------------------------------------------------
|
|
ADDINF:
|
|
BTST #5,D6 ; same sign?
|
|
BNE.S @25
|
|
BRA PACKX ; yes
|
|
@25:
|
|
MOVEQ #NANADD,D0 ; mark error
|
|
BRA INVALIDOP
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; FP MULTIPLICATION
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QMULX---Multiply extended with extended
|
|
;-----------------------------------------------------------
|
|
QMULX:
|
|
FINIT
|
|
LEA MULTOP,A0 ; continue below
|
|
BRA UNPACKXX ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; QMULB---Multiply non-extended SRC with extended DST
|
|
;-----------------------------------------------------------
|
|
QMULB:
|
|
FINIT
|
|
LEA MULTOP,A0 ; continue below
|
|
BRA UNPACKXB ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; Multiply 2 numbers. Dispatch to one of 9 cases depending on
|
|
; class of operands: [finite] number, zero, or infinite.
|
|
; NaNs have already been filtered out.
|
|
;-----------------------------------------------------------
|
|
MULTOP:
|
|
LEA FINI2OPS,A0 ; continuation address
|
|
LSL.B #2,D6 ; get XOR of signs in D6 bit 7
|
|
|
|
MOVE.W MULCASE(D0),D0
|
|
JMP MULTOP(D0)
|
|
|
|
MULCASE: ; DST * SRC
|
|
DC.W MULNUM - MULTOP ; NUM * NUM
|
|
DC.W PACKX - MULTOP ; NUM * 0
|
|
DC.W PACKX - MULTOP ; NUM * INF
|
|
|
|
DC.W RDST - MULTOP ; 0 * NUM
|
|
DC.W PACKX - MULTOP ; 0 * 0
|
|
DC.W INVMUL - MULTOP ; 0 * INF
|
|
|
|
DC.W RDST - MULTOP ; INF * NUM
|
|
DC.W INVMUL - MULTOP ; INF * 0
|
|
DC.W PACKX - 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 normalized to 2^0 * 1.000000...
|
|
;-----------------------------------------------------------
|
|
ADDA.L A3,A4 ; add exponents
|
|
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 D3,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.
|
|
;-----------------------------------------------------------
|
|
MULDONE:
|
|
MOVE.L A1,D6 ; restore D6
|
|
|
|
BRA NORMCOERCE ; normalize if necessary & coerce
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Cases 0*INF and INF*0 are invalid operations.
|
|
;-----------------------------------------------------------
|
|
INVMUL:
|
|
MOVEQ #NANMUL,D0 ; NaN code in D0
|
|
BRA INVALIDOP ; Output NaN and signal invalid
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; FP DIVISION
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QDIVX---Divide extended DST by extended SRC
|
|
;-----------------------------------------------------------
|
|
QDIVX:
|
|
FINIT
|
|
LEA DIVTOP,A0 ; continue below
|
|
BRA UNPACKXX ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; QDIVB---Divide extended DST by non-extended SRC
|
|
;-----------------------------------------------------------
|
|
QDIVB:
|
|
FINIT
|
|
LEA DIVTOP,A0 ; continue below
|
|
BRA UNPACKXB ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; Division. Dispatch to one of 9 cases depending on
|
|
; class of operands: [finite] number, zero, or infinite.
|
|
; NaNs have already been filtered out.
|
|
;-----------------------------------------------------------
|
|
DIVTOP:
|
|
LEA FINI2OPS,A0 ; continuation address
|
|
LSL.B #2,D6 ; XOR of signs in D6 bit 7
|
|
|
|
MOVE.W DIVTBL(D0),D0
|
|
JMP DIVTOP(D0)
|
|
|
|
DIVTBL: ; DST / SRC
|
|
DC.W DIVNUM - DIVTOP ; NUM / NUM
|
|
DC.W DIVBY0 - DIVTOP ; NUM / 0
|
|
DC.W DIVBYI - DIVTOP ; NUM / INF
|
|
|
|
DC.W DIVBYI - DIVTOP ; 0 / NUM
|
|
DC.W INVDIV - DIVTOP ; 0 / 0
|
|
DC.W DIVBYI - DIVTOP ; 0 / INF
|
|
|
|
DC.W RDST - DIVTOP ; INF / NUM
|
|
DC.W RDST - DIVTOP ; INF / 0
|
|
DC.W INVDIV - DIVTOP ; INF / INF
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Case NUM/0: set the DIV-BY-ZERO error bit, stuff INF, pack.
|
|
;-----------------------------------------------------------
|
|
DIVBY0:
|
|
BSET #ERRZ+8,D6
|
|
MOVEA.W #$7FFF,A4 ; stuff infinity
|
|
MOVEQ #0,D4
|
|
MOVEQ #0,D5
|
|
BRA PACKX
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Cases NUM/INF, 0/NUM, and 0/INF: store zero.
|
|
;-----------------------------------------------------------
|
|
DIVBYI:
|
|
SUBA.L A4,A4 ; ZERO EXP
|
|
MOVE.L A4,D4 ; AND DIGS...
|
|
MOVE.L D4,D5
|
|
BRA PACKX
|
|
|
|
;-----------------------------------------------------------
|
|
; Cases 0/0 and INF/INF: signal invalid and store NaN.
|
|
;-----------------------------------------------------------
|
|
INVDIV:
|
|
MOVEQ #NANDIV,D0 ; NaN code in D0
|
|
BRA INVALIDOP ; output NaN result
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; 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 D3,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 BGNDV ; 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
|
|
|
|
BGNDV:
|
|
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.
|
|
;-----------------------------------------------------------
|
|
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.L #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 DIVOFL ; 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.
|
|
;-----------------------------------------------------------
|
|
DIVOFL:
|
|
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
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; FP REMAINDER
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QREMX---Extended DST REM extended SRC
|
|
;-----------------------------------------------------------
|
|
QREMX:
|
|
FINIT
|
|
LEA REMTOP,A0 ; continue below
|
|
BRA UNPACKXX ; unpack opword and operands, NaN check
|
|
|
|
;-----------------------------------------------------------
|
|
; QREMB---Extended DST REM non-extended SRC
|
|
;-----------------------------------------------------------
|
|
QREMB:
|
|
FINIT
|
|
LEA REMTOP,A0 ; continue below
|
|
BRA UNPACKXB ; unpack opword and operands, NaN check
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; ******** 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 the MOVEM.L, D0 was
|
|
; left at the top of stack. Thus, DO.W, which gets the
|
|
; integer quotient, is at 2(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.
|
|
;-----------------------------------------------------------
|
|
REMTOP:
|
|
LEA FINI2OPS,A0 ; continuation addr
|
|
CLR.W 2(SP) ; QUO set to 0 (D0.W on stack)
|
|
|
|
ADD.B D6,D6 ; move DST sign to D6 bit 7 and
|
|
; QUO sign to bit 6
|
|
MOVE.W REMCASE(D0),D0
|
|
JMP REMTOP(D0)
|
|
|
|
REMCASE: ; DST REM SRC
|
|
DC.W REMNUM - REMTOP ; NUM REM NUM
|
|
DC.W INVREM - REMTOP ; NUM REM 0
|
|
DC.W REMDST - REMTOP ; NUM REM INF
|
|
|
|
DC.W RDST - REMTOP ; 0 REM NUM
|
|
DC.W INVREM - REMTOP ; 0 REM 0
|
|
DC.W RDST - REMTOP ; 0 REM INF
|
|
|
|
DC.W INVREM - REMTOP ; INF REM NUM
|
|
DC.W INVREM - REMTOP ; INF REM 0
|
|
DC.W INVREM - REMTOP ; INF REM INF
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Invalid REMAINDER operands
|
|
;-----------------------------------------------------------
|
|
INVREM:
|
|
MOVEQ #NANREM,D0 ; NaN code in D0
|
|
BRA INVALIDOP ; output NaN result
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; 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 D3,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 D3,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,2(SP) ; STORE IN SAVED D0.W
|
|
|
|
MOVE.L D1,D4 ; STUFF REM BITS
|
|
MOVE.L D2,D5
|
|
REMFIN:
|
|
BRA ZNORMCOERCEX ; 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 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
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; FP COMPARISONS---Common entry points for routines which
|
|
; signal or do not signal on unordered.
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QCMPX---Compare two extendeds.
|
|
;-----------------------------------------------------------
|
|
QCMPX:
|
|
FINIT
|
|
LEA CMPTOP,A0 ; continue below
|
|
BRA UNPACKXX ; unpack opword and operands, unordered check
|
|
|
|
;-----------------------------------------------------------
|
|
; QCMPB---Compare a non-extended SRC with an extended DST
|
|
;-----------------------------------------------------------
|
|
QCMPB:
|
|
FINIT
|
|
LEA CMPTOP,A0 ; continue below
|
|
BRA UNPACKXB ; unpack opword and operands, unordered check
|
|
|
|
;-----------------------------------------------------------
|
|
; Comparison. Dispatch to one of 9 cases depending on
|
|
; class of operands: [finite] number, zero, or infinite.
|
|
; NaNs have already been filtered out.
|
|
;-----------------------------------------------------------
|
|
CMPTOP:
|
|
MOVE.W CMPCASE(D0),D0
|
|
JMP CMPTOP(D0)
|
|
|
|
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,D7 ; ASSUME >
|
|
TST.B D6 ; TST SRC SIGN
|
|
BMI.S @1
|
|
MOVEQ #CMPL,D7 ; 0 < POSITIVE
|
|
@1:
|
|
BRA FINICMPS
|
|
|
|
;-----------------------------------------------------------
|
|
; INF VS. INF: EITHER =, OR SAME AS 0 VS. NUM.
|
|
;-----------------------------------------------------------
|
|
CMPINF:
|
|
BTST #5,D6 ; EQ -> SIGNS =
|
|
BNE.S CMPD0
|
|
CMP0: ; 0 = 0 regardless of sign
|
|
MOVEQ #CMPE,D7
|
|
BRA FINICMPS
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; 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
|
|
CMP.L D4,D3 ; 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,D7
|
|
TST.B D6
|
|
BPL FINICMPS
|
|
MOVEQ #CMPG,D7
|
|
@21:
|
|
BRA FINICMPS
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; CONVERSION to extended format
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QX2X---Convert extended to extended
|
|
;-----------------------------------------------------------
|
|
QX2X:
|
|
FINIT
|
|
LEA FINI2OPS,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6 ; zero D6.LO
|
|
MOVEA.L LKADR2(A6),A1 ; unpack extended SRC
|
|
BSR UNPXOP
|
|
|
|
C2XCOMMON:
|
|
MOVEQ #0,D7 ; zero D7
|
|
TST.W D0 ; check if NaN input
|
|
BNE FPNANOUT ; output NaN
|
|
|
|
TST.L D0 ; check if zero or INF
|
|
BEQ COERCE ; coerce if not
|
|
BRA PACKX ; pack if zero or INF
|
|
|
|
;-----------------------------------------------------------
|
|
; QB2X---Convert non-extended binary format to extended
|
|
;-----------------------------------------------------------
|
|
QB2X:
|
|
FINIT
|
|
LEA FINI2OPS,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6 ; zero D6.LO
|
|
MOVE.L D6,D1 ; extract offset from format
|
|
CLR.W D1 ; code in opword
|
|
ROL.L #6,D1
|
|
ANDI.W #$000E,D1
|
|
SUBQ.W #2,D1
|
|
MOVEA.L LKADR2(A6),A1 ; unpack nonextended SRC
|
|
BSR UNPBOP
|
|
|
|
BRA.S C2XCOMMON
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; FP SQUARE ROOT
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QSQRTX---extended square root of the extended DST operand
|
|
;-----------------------------------------------------------
|
|
QSQRTX:
|
|
FINIT
|
|
LEA FINI1OP,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6
|
|
MOVEA.L LKADR1(A6),A1 ; unpack extended DST
|
|
BSR UNPXOP
|
|
|
|
TST.L D0 ; check if finite nonzero input
|
|
BEQ.S @10 ; yes; check sign next
|
|
|
|
TST.W D0 ; check if NaN input
|
|
BNE FPNANOUT ; yes; output NaN
|
|
BTST #17,D0 ; check if zero
|
|
BNE PACKX ; yes; SQRT(+/-0) = +/- 0
|
|
|
|
TST.B D6 ; INF input
|
|
BPL PACKX ; pack if +INF
|
|
|
|
@1:
|
|
MOVEQ #NANSQRT,D0 ; invalid op: SQRT(negative nonzero number)
|
|
BRA INVALIDOP
|
|
|
|
|
|
|
|
@10:
|
|
TST.B D6 ; test sign of finite, nonzero input
|
|
BMI.S @1 ; negative; invalid op
|
|
;--------------------------------------------------------------------
|
|
; 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 ; save D6
|
|
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
|
|
|
|
BSET #31,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
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; ROUND TO INTEGER
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QRINTX:
|
|
FINIT
|
|
LEA FINI1OP,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6
|
|
MOVEA.L LKADR1(A6),A1 ; unpack extended DST
|
|
BSR UNPXOP
|
|
|
|
TST.L D0 ; check if finite nonzero input
|
|
BEQ.S @1 ; yes; do rounding
|
|
|
|
TST.W D0 ; check if NaN input
|
|
BNE FPNANOUT ; yes; output NaN
|
|
BRA PACKX ; no; zero or INF propagate
|
|
|
|
@1:
|
|
BSR IPALIGN ; align binary point to right of D5
|
|
BGT.S RINT1 ; shift was done
|
|
|
|
COMINT1: ; no shift was done. Coercion will do rounding.
|
|
BFTST D1{25:2} ; check rounding precision
|
|
BEQ COERCEX ; default (extended)
|
|
BPL COERCED ; double
|
|
BRA COERCES ; single
|
|
|
|
RINT1: ; round extended integral value
|
|
BSR RNDINT
|
|
TST.L D4 ; check if normalized
|
|
BMI PACKX ; done if so
|
|
|
|
;-----------------------------------------------------------
|
|
; After shifting and rounding, may have 0 or unnormalized. Normalize, then
|
|
; stuff result
|
|
;-----------------------------------------------------------
|
|
COMINT2:
|
|
BFFFO D4{0:0},D0 ; find first one in D4
|
|
BEQ.S @5 ; D4 = 0
|
|
|
|
SUBA.W D0,A4 ; decrease exponent
|
|
LSL.L D0,D4 ; shift D4 left
|
|
BFEXTU D5{0:D0},D2 ; extract D5 high bits
|
|
LSL.L D0,D5 ; shift D5 left
|
|
OR.L D2,D4 ; put D5 high bits into D4 low
|
|
BRA PACKX ; stuff result
|
|
|
|
@5:
|
|
SUBA.W #32,A4 ; D4 = 0, decrease exponent by 32
|
|
EXG D4,D5 ; exchange D4/D5
|
|
BFFFO D4{0:0},D0 ; find first one in D4
|
|
BEQ.S @7 ; zero result
|
|
BMI PACKX ; normalized; stuff result
|
|
|
|
SUBA.W D0,A4 ; subnormal; decrease exponent
|
|
LSL.L D0,D4 ; shift D4 left
|
|
BRA PACKX ; stuff result
|
|
|
|
@7:
|
|
SUBA.L A4,A4 ; zero result
|
|
BRA PACKX ; stuff result
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; TRUNCATE TO INTEGER
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QTINTX:
|
|
FINIT
|
|
LEA FINI1OP,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6
|
|
MOVEA.L LKADR1(A6),A1 ; unpack extended DST
|
|
BSR UNPXOP
|
|
|
|
TST.L D0 ; check if finite nonzero input
|
|
BEQ.S @1 ; yes; do rounding
|
|
|
|
TST.W D0 ; check if NaN input
|
|
BNE FPNANOUT ; yes; output NaN
|
|
BRA PACKX ; no; zero or INF propagate
|
|
|
|
@1:
|
|
;-----------------------------------------------------------
|
|
; Align binary point to right of D5 and chop to integer value,
|
|
; setting INEXACT if necessary. If number is too big,
|
|
; force chop mode and coerce. IPALIGN places environment in
|
|
; D1.W.
|
|
;-----------------------------------------------------------
|
|
BSR.S IPALIGN ; align binary pt to right of D5
|
|
BGT.S @3 ; shift was done
|
|
|
|
OR.W #$6000,D1 ; big number, force truncation mode
|
|
BRA COMINT1
|
|
|
|
@3:
|
|
TST.L D7 ; flag inexact if any stickies set
|
|
BEQ.S COMINT2
|
|
BSET #ERRX+8,D6
|
|
BRA.S COMINT2 ; exit through normalization routine
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine IPALIGN sets up binary point no further right than 24,
|
|
; 53, 64 bits as specified by the coercion info. The environment
|
|
; word is read into D1.W. Scratch register are D0/D2
|
|
;-----------------------------------------------------------
|
|
;IPALIGN: ; old IPALIGN and IALIGN DELETED <3/23/92, JPO>
|
|
; MOVE.W (FPSTATE).W,D1 ; environment in D1
|
|
; BFTST D1{25:2} ; check rounding precision
|
|
; BEQ.S IALIGN ; default (extended)
|
|
; BMI.S @1 ; single
|
|
;
|
|
; MOVEQ #52,D0 ; double precision
|
|
; BRA.S FINALIGN
|
|
;@1:
|
|
; MOVEQ #23,D0
|
|
; BRA.S FINALIGN
|
|
;IALIGN:
|
|
; MOVEQ #63,D0
|
|
;FINALIGN:
|
|
; MOVEQ #0,D7 ; zero D7
|
|
; ADDI.W #$3FFF,D0 ; adjust exponent
|
|
; MOVE.W D0,D2 ; save possible new exponent
|
|
; SUB.L A4,D0 ; INT exp - exp
|
|
; BGT.S @7
|
|
; RTS ; return LE in CCR if too big
|
|
;@7:
|
|
; MOVEA.W D2,A4 ; use new exponent
|
|
; BSR RTSHIFT
|
|
; MOVE #0000,CCR ; fudge CCR = GT
|
|
; RTS
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine IPALIGN sets up binary point just to the right of D5
|
|
; (64th significand bit) by unnormalizing input value in A4/D4/D5
|
|
; if its magnitude is less than a limit determined by the current
|
|
; rounding precision.
|
|
;
|
|
; INPUT: normalized extended value in A4/D4/D5
|
|
; OUTPUT: CCR value LE (nonzero) and D7 cleared if input too large and
|
|
; CCR value GT (zero) if right shift took place and
|
|
; unnormalized (shifted) value in A4/D4/D5 with
|
|
; fractional stickies in D7.
|
|
; Environment setting in D1.W in both cases
|
|
; USES: D0
|
|
;-----------------------------------------------------------
|
|
IPALIGN: ; new IPALIGN and IALIGN ADDED <3/23/92, JPO>
|
|
MOVE.W (FPSTATE).W,D1 ; environment in D1
|
|
BFTST D1{25:2} ; check rounding precision
|
|
BEQ.B IALIGN ; default (extended)
|
|
BMI.B @1 ; single
|
|
|
|
MOVE.W #$4033,D0 ; double precision: set exponent limit (biased 52)
|
|
BRA.B @2
|
|
@1: ; single precision
|
|
MOVE.W #$4016,D0 ; set exponent limit for single precision (biased 23)
|
|
@2:
|
|
MOVEQ #0,D7 ; zero stickies
|
|
CMP.W A4,D0 ; is magnitude small enough for right shifting?
|
|
BGT.B @3 ; yes
|
|
|
|
RTS ; no. return with "LE" in CCR
|
|
@3:
|
|
MOVE.W #$403E,D0 ; yes. D0 <- count for right shifting of
|
|
SUB.W A4,D0 ; binary point to right of D5
|
|
BRA.B DOSHIFT
|
|
|
|
IALIGN: ; extended rounding precision
|
|
MOVE.W #$403E,D0 ; D0 <- exponent limit (biased 63)
|
|
MOVEQ #0,D7 ; zero stickies
|
|
SUB.W A4,D0 ; D0 <- right shift count
|
|
BGT.B DOSHIFT ; do shift
|
|
|
|
RTS ; magnitude too big. return with "LE" in CCR
|
|
|
|
DOSHIFT: ; unnormalize via right shift, putting fractional part into D7
|
|
MOVEA.W #$403E,A4 ; set post-shift exponent (biased 63)
|
|
BSR RTSHIFT ; do the shift (count in D0): D4/D5 -> D4/D5/D7
|
|
MOVE.W #$0000,CCR ; fudge "GT" in CCR
|
|
RTS ; return
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine RNDINT rounds a subnormal significand in D4/D5
|
|
; and D7 (stickies) according to the environment in D1.W
|
|
; Scratch register are D0/D2
|
|
;-----------------------------------------------------------
|
|
RNDINT:
|
|
TST.L D7 ; exact result?
|
|
BNE.S @1 ; no
|
|
RTS ; yes; done.
|
|
|
|
;-----------------------------------------------------------
|
|
; Inexact result: signal and round
|
|
;-----------------------------------------------------------
|
|
@1:
|
|
BSET #ERRX+8,D6 ; signal inexact
|
|
BFTST D1{17:2} ; round to nearest?
|
|
BEQ.S @4 ; yes
|
|
BMI.S @2 ; chop or round downward
|
|
|
|
;-----------------------------------------------------------
|
|
; Round toward +∞
|
|
;-----------------------------------------------------------
|
|
TST.B D6 ; bump significand if positive
|
|
BPL.S RNDUPI
|
|
RTS ; otherwise, done
|
|
|
|
@2:
|
|
BTST #13,D1 ; chop or round downward?
|
|
BEQ.S @3 ; downward
|
|
RTS ; done if chop
|
|
|
|
;-----------------------------------------------------------
|
|
; Round toward -∞
|
|
;-----------------------------------------------------------
|
|
@3:
|
|
TST.B D6 ; bump significand if negative
|
|
BMI.S RNDUPI
|
|
RTS ; otherwise, return
|
|
|
|
;-----------------------------------------------------------
|
|
; Default rounding (to nearest)
|
|
;-----------------------------------------------------------
|
|
@4:
|
|
ADD.L D7,D7 ; round bit set?
|
|
BCS.S @5 ; yes
|
|
RTS ; no; done
|
|
|
|
@5:
|
|
BNE.S RNDUPI ; stickies set so round up
|
|
BTST #0,D5 ; halfway case gets bumped
|
|
BNE.S RNDUPI ; if lowest SIG bit is 1
|
|
RTS ; otherwise, done
|
|
|
|
RNDUPI:
|
|
MOVEQ #0,D0 ; increment significand
|
|
ADDQ.L #1,D5
|
|
ADDX.L D0,D4 ; cannot carry out of D4
|
|
RTS ; done
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; CONVERSIONS from extended format
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QX2B---Convert extended SRC to nonextended DST
|
|
;-----------------------------------------------------------
|
|
QX2B:
|
|
FINIT
|
|
LEA FINI2OPS,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6 ; zero D6.LO
|
|
MOVEA.L LKADR2(A6),A1 ; unpack extended SRC
|
|
BSR UNPXOP
|
|
|
|
MOVEQ #26,D7 ; extract offset from format
|
|
MOVE.L D6,D1 ; code in opword
|
|
LSR.L D7,D1
|
|
ANDI.W #$000E,D1
|
|
SUBQ.W #2,D1
|
|
MOVEQ #0,D7
|
|
MOVE.W X2BCASE(D1),D1 ; get addr of specific routine
|
|
JMP QX2B(D1) ; and jump there
|
|
|
|
|
|
X2BCASE:
|
|
DC.W QX2D - QX2B ; double precision
|
|
DC.W QX2S - QX2B ; single precision
|
|
DC.W QX2X - QX2B ; ---illegal format
|
|
DC.W QX2I - QX2B ; int16
|
|
DC.W QX2L - QX2B ; int32
|
|
DC.W QX2C - QX2B ; comp
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QX2D---convert extended SRC to double precision DST
|
|
;-----------------------------------------------------------
|
|
QX2D:
|
|
MOVEA.L LKADR1(A6),A2 ; A2 <- DST addr for PACKD
|
|
TST.L D0 ; finite nonzero input?
|
|
BEQ.S @1 ; yes; must coerce
|
|
|
|
TST.W D0 ; no; is it a NaN?
|
|
BEQ.S PACKD ; zero or INF need no coercion
|
|
|
|
ANDI.W #$0F800,D5
|
|
BSR FPNANIN ; NaN input needs valid code
|
|
BRA.S PACKD ; and no coercion
|
|
|
|
@1:
|
|
MOVE.W (FPSTATE).W,D1 ; D1.W <- environment
|
|
BTST #6,D1 ; Coerce to double precision
|
|
BEQ.S @3 ; unless single precision is set
|
|
BSR SCOERCE ; in the environment
|
|
BRA.S PACKD
|
|
|
|
@3:
|
|
BSR DCOERCE
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; PACKD---pack and deliver a double precision result to (A2)
|
|
;-----------------------------------------------------------
|
|
PACKD:
|
|
MOVE.W A4,D3 ; D3.W <- exponent
|
|
CMPI.W #$7FFF,D3 ; INF or NAN?
|
|
BNE.S @1 ; no
|
|
MOVE.W #$4400,D3 ; exp too big, will decr below
|
|
BRA.S @5
|
|
@1:
|
|
TST.W D3 ; exp = 0?
|
|
BNE.S @5
|
|
MOVE.W #$3C01,D3
|
|
@5:
|
|
SUBI.W #$3C00,D3
|
|
TST.L D4 ; test lead bit
|
|
BMI.S @7 ; decr exp unless normalized
|
|
SUBQ.W #1,D3
|
|
@7:
|
|
|
|
;-----------------------------------------------------------
|
|
; SET UP LOW 32 BITS WITH TRAILING 11 BITS FROM HI BITS.
|
|
;-----------------------------------------------------------
|
|
LSR.L #8,D5 ; shift low half right 11 bits
|
|
LSR.L #3,D5
|
|
BFINS D4,D5{0:11} ; insert low 11 bits of high half
|
|
|
|
LSR.L #8,D4 ; shift high half right 10 bits
|
|
LSR.L #2,D4
|
|
BFINS D3,D4{0:11} ; insert exponent, killing lead bit
|
|
ADD.B D6,D6 ; insert sign
|
|
ROXR.L #1,D4
|
|
|
|
MOVE.L D4,(A2)+ ; write result
|
|
MOVE.L D5,(A2)
|
|
|
|
JMP (A0) ; continuation routine
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QX2S---convert extended SRC to single precision DST
|
|
;-----------------------------------------------------------
|
|
QX2S:
|
|
MOVEA.L LKADR1(A6),A2 ; A2 <- DST addr for PACKS
|
|
TST.L D0 ; finite nonzero input?
|
|
BEQ.S @1 ; yes; must coerce
|
|
|
|
TST.W D0 ; no; is it a NaN?
|
|
BEQ.S PACKS ; zero or INF need no coercion
|
|
|
|
MOVEQ #0,D5
|
|
CLR.B D4
|
|
BSR FPNANIN ; NaN input needs valid code
|
|
BRA.S PACKS ; and no coercion
|
|
|
|
@1:
|
|
MOVE.W (FPSTATE).W,D1 ; D1.W <- environment
|
|
BSR SCOERCE ; coerce to single precision
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; PACKS---pack and deliver a single precision result to (A2)
|
|
;-----------------------------------------------------------
|
|
PACKS:
|
|
MOVE.W A4,D3 ; D3.W <- exponent
|
|
CMPI.W #$7FFF,D3 ; INF or NAN?
|
|
BNE.S @1 ; no
|
|
MOVE.W #$4080,D3 ; exp too big, will decr below
|
|
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 ; decr exponent unless normalized
|
|
SUBQ.W #1,D3
|
|
@7:
|
|
OR.W D3,D4 ; stuff exponent in low bits
|
|
ROR.L #8,D4 ; rotate to high bits
|
|
ADD.B D6,D6 ; insert sign
|
|
ROXR.L #1,D4
|
|
MOVE.L D4,(A2) ; deliver result
|
|
|
|
JMP (A0) ; continuation routine
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QX2C---convert extended SRC to comp DST
|
|
;-----------------------------------------------------------
|
|
QX2C:
|
|
TST.L D0 ; any special input?
|
|
BEQ.S @3 ; no, normalized value
|
|
|
|
BTST #17,D0 ; zero?
|
|
BNE.S PACKC ; yes, deliver it
|
|
|
|
TST.B D0 ; NaN input?
|
|
BNE.S @2 ; yes, invalid flag OK
|
|
|
|
@1: ; invalid result (INF, comp overflow)
|
|
BSET #ERRI+8,D6 ; set invalid flag
|
|
BCLR #ERRX+8,D6 ; clr inexact
|
|
@2:
|
|
MOVEQ #1,D4 ; deliver COMP NaN
|
|
MOVEQ #0,D5
|
|
ROR.L #1,D4
|
|
BRA.S PACKC ; deliver result
|
|
|
|
@3:
|
|
BSR IALIGN ; align binary point to right of D5
|
|
BLE.S @1 ; overflow
|
|
|
|
MOVE.W (FPSTATE).W,D1 ; round to integer value
|
|
BSR RNDINT
|
|
|
|
TST.L D4 ; overflow?
|
|
BMI.S @1 ; yes
|
|
|
|
TST.B D6 ; negative?
|
|
BPL.S PACKC ; no; done
|
|
NEG.L D5 ; yes; make it so
|
|
NEGX.L D4
|
|
|
|
PACKC: ; deliver the comp result to DST addr
|
|
MOVEA.L LKADR1(A6),A2
|
|
MOVE.L D4,(A2)+
|
|
MOVE.L D5,(A2)
|
|
|
|
JMP (A0) ; finish up
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QX2L---convert extended SRC to long integer DST
|
|
;-----------------------------------------------------------
|
|
QX2L:
|
|
TST.L D0 ; any special input?
|
|
BEQ.S @3 ; no, normalized value
|
|
|
|
BTST #17,D0 ; zero?
|
|
BNE.S PACKL ; yes, deliver it
|
|
|
|
@1: ; invalid result (INF, NaN, longint overflow)
|
|
MOVEQ #1,D5 ; deliver default result ($80000000)
|
|
BSET #ERRI+8,D6 ; set invalid flag
|
|
ROR.L #1,D5
|
|
BCLR #ERRX+8,D6 ; clr inexact
|
|
BRA.S PACKL ; deliver result
|
|
|
|
@3:
|
|
BSR IALIGN ; align binary point to right of D5
|
|
BLE.S @1 ; overflow
|
|
|
|
MOVE.W (FPSTATE).W,D1 ; round to integer value
|
|
BSR RNDINT
|
|
|
|
TST.L D4 ; overflow?
|
|
BNE.S @1 ; yes
|
|
|
|
TST.L D5
|
|
BPL.S @5 ; no overflow
|
|
|
|
NEG.L D5 ; most likely
|
|
BPL.S @1 ; overflow
|
|
|
|
TST.B D6 ; $80000000 OK if negative integer
|
|
BPL.S @1
|
|
@5
|
|
TST.B D6 ; negative?
|
|
BPL.S PACKL ; no; done
|
|
NEG.L D5 ; yes; make it so
|
|
|
|
PACKL: ; deliver the longint result to DST addr
|
|
MOVEA.L LKADR1(A6),A2
|
|
MOVE.L D5,(A2)
|
|
|
|
JMP (A0) ; finish up
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QX2I---convert extended SRC to 16-bit integer DST
|
|
;-----------------------------------------------------------
|
|
QX2I:
|
|
TST.L D0 ; any special input?
|
|
BEQ.S @3 ; no, normalized value
|
|
|
|
BTST #17,D0 ; zero?
|
|
BNE.S PACKI ; yes, deliver it
|
|
|
|
@1: ; invalid result (INF, NaN, overflow)
|
|
MOVE.W #$8000,D5 ; deliver default result ($8000)
|
|
BSET #ERRI+8,D6 ; set invalid flag
|
|
BCLR #ERRX+8,D6 ; clr inexact
|
|
BRA.S PACKI ; deliver result
|
|
|
|
@3:
|
|
BSR IALIGN ; align binary point to right of D5
|
|
BLE.S @1 ; overflow
|
|
|
|
MOVE.W (FPSTATE).W,D1 ; round to integer value
|
|
BSR RNDINT
|
|
|
|
TST.L D4 ; overflow?
|
|
BNE.S @1 ; yes
|
|
|
|
CMPI.L #$08000,D5
|
|
BCS.S @5 ; no overflow
|
|
BHI.S @1 ; overflow
|
|
TST.B D6 ; $8000 OK if negative integer
|
|
BPL.S @1
|
|
|
|
@5
|
|
TST.B D6 ; negative?
|
|
BPL.S PACKI ; no; done
|
|
NEG.W D5 ; yes; make it so
|
|
|
|
PACKI: ; deliver the longint result to DST addr
|
|
MOVEA.L LKADR1(A6),A2
|
|
MOVE.W D5,(A2)
|
|
|
|
JMP (A0) ; finish up
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QLOGBX---binary logarithm [ DST <- logb(DST) ]
|
|
;-----------------------------------------------------------
|
|
QLOGBX:
|
|
FINIT
|
|
LEA FINI1OP,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6
|
|
MOVEA.L LKADR1(A6),A1 ; unpack extended DST
|
|
BSR UNPXOP
|
|
CLR.B D6 ; sign is irrelevant
|
|
|
|
TST.L D0 ; check if finite nonzero input
|
|
BEQ.S @10 ; yes; evaluate logb
|
|
|
|
TST.W D0 ; check if NaN input
|
|
BNE FPNANOUT ; yes; output NaN
|
|
|
|
BTST #17,D0 ; check if zero input
|
|
BEQ PACKX ; no; INF propagates (with + sign)
|
|
|
|
;-----------------------------------------------------------
|
|
; 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
|
|
BRA PACKX
|
|
|
|
;-----------------------------------------------------------
|
|
; 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
|
|
|
|
SUBA.L A4,A4 ; zero result
|
|
MOVE.L D5,D4
|
|
BRA PACKX
|
|
|
|
@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
|
|
BRA PACKX
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QSCALBX---binary scaling [ DST <- DST * 2**SRC ]
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QSCALBX:
|
|
FINIT
|
|
LEA FINI2OPS,A0 ; finish up routine
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.HI
|
|
MOVEQ #0,D0 ; and zero D0
|
|
SWAP D6
|
|
CLR.W D6
|
|
MOVEA.L LKADR1(A6),A1 ; unpack extended DST
|
|
BSR UNPXOP
|
|
|
|
TST.L D0 ; check if finite nonzero input
|
|
BEQ.S @1 ; yes; evaluate scalb
|
|
|
|
TST.W D0 ; check if NaN input
|
|
BNE FPNANOUT ; yes; output NaN
|
|
|
|
BRA PACKX ; zero and INF propagate with sign
|
|
|
|
;-----------------------------------------------------------
|
|
; SCALB is evaluated by adding the integer adjustment into
|
|
; the exponent in A4 and checking for over/underflow via the
|
|
; COERCE routine.
|
|
;-----------------------------------------------------------
|
|
@1:
|
|
MOVEA.L LKADR2(A6),A2 ; SRC addr
|
|
ADDA.W (A2),A4 ; adjust exponent
|
|
MOVEQ #0,D7 ; zero stickies
|
|
BRA COERCE ; coerce
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; CLASSIFY routines place an integer code of SRC class at
|
|
; the DST address. Classify is unexceptional. Codes are:
|
|
; SNAN 1
|
|
; QNAN 2
|
|
; INF 3
|
|
; ZERO 4
|
|
; NORMAL 5
|
|
; SUBNORM 6
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; QCLASSX---DST <- class of extended SRC
|
|
;-----------------------------------------------------------
|
|
QCLASSX:
|
|
MOVEM.L A0/D0-D1,-(SP) ; save small # of registers
|
|
MOVEA.L 22(SP),A0 ; SRC addr
|
|
MOVE.W (A0)+,D0 ; get sign/exp in D0.W
|
|
BTST #5,17(SP) ; 96-bit extended SRC?
|
|
BEQ.S @1 ; no
|
|
|
|
ADDQ #2,A0 ; yes, bump pointer to significand
|
|
@1:
|
|
ADD.L D0,D0 ; sign in D0 bit 16
|
|
LSR.W #1,D0 ; positive exp in D0.W
|
|
|
|
BSET #31,D0 ; sign flag is D0 bit 31
|
|
BCLR #15,D0 ; clr sign in exp
|
|
|
|
CMPI.W #$7FFF,D0 ; max exp?
|
|
BEQ.S @5 ; yes, NAN or INF class
|
|
|
|
MOVE.L (A0)+,D1 ; normalized?
|
|
BPL.S @8 ; zero or unnormalized
|
|
|
|
@2:
|
|
MOVEQ #5,D1 ; NORMAL
|
|
|
|
@3:
|
|
BTST #16,D0 ; negate class code if
|
|
BEQ.S @4 ; sign bit is set
|
|
NEG.W D1
|
|
@4:
|
|
MOVEA.L 18(SP),A0 ; DST addr
|
|
MOVE.W D1,(A0) ; deliver classify result
|
|
MOVEM.L (SP)+,A0/D0-D1 ; restore registers
|
|
RTD #STKREM2 ; done
|
|
|
|
|
|
@5: ; INF or NAN class
|
|
MOVE.L (A0)+,D1 ; read high half of significand
|
|
ADD.L D1,D1 ; clr explicit bit of sig
|
|
LSR.L #1,D1
|
|
BEQ.S @7 ; INF or SNAN class since sig high is zero
|
|
|
|
BTST #QNANBIT,D1 ; QNAN or SNAN
|
|
BEQ.S @6 ;
|
|
|
|
MOVEQ #2,D1 ; QNAN
|
|
BRA.S @3
|
|
@6:
|
|
MOVEQ #1,D1 ; SNAN
|
|
BRA.S @3
|
|
|
|
@7:
|
|
MOVE.L (A0),D1 ; INF or SNAN?
|
|
BNE.S @6 ; SNAN
|
|
|
|
MOVEQ #3,D1 ; INF
|
|
BRA.S @3
|
|
|
|
@8:
|
|
BEQ.S @11 ; ZERO or SUBNORM
|
|
|
|
@9:
|
|
SUBQ.W #1,D0 ; normalization loop
|
|
ADD.L D1,D1
|
|
BPL.S @9
|
|
|
|
@10:
|
|
TST.W D0 ; negative exponent means SUBNORM
|
|
BPL.S @2 ; nonnegative means NORMAL
|
|
|
|
MOVEQ #6,D1 ; SUBNORM
|
|
BRA.S @3
|
|
|
|
@11: ; high significand is zero
|
|
SUB.W #32,D0 ; decrease exponent
|
|
MOVE.L (A0),D1 ; D1 <- low significand
|
|
BEQ.S @12 ; ZERO
|
|
BPL.S @9 ; still unnormalized
|
|
BRA.S @10 ; check exponent
|
|
|
|
@12:
|
|
MOVEQ #4,D1 ; ZERO
|
|
BRA.S @3
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QCLASSB---DST <- class of single/double/comp SRC
|
|
; X bit trick thanks to S. McDonald
|
|
;-----------------------------------------------------------
|
|
QCLASSB:
|
|
MOVEM.L A0/D0-D1,-(SP) ; save small # of registers
|
|
MOVE.W 16(SP),D0 ; D0.W <- opcode
|
|
MOVEA.L 22(SP),A0 ; A0 <- SRC addr
|
|
BTST #11,D0 ; double precision classify?
|
|
BNE.S QCLASSD ; yes
|
|
|
|
BTST #13,D0 ; classify comp?
|
|
BNE.S QCLASSC ; yes
|
|
|
|
;-----------------------------------------------------------
|
|
; Classify single precision SRC
|
|
;-----------------------------------------------------------
|
|
MOVE.L (A0),D0 ; D0 <- SRC
|
|
ADD.L D0,D0 ; sign in X bit with shifted SRC (S. McDonald)
|
|
BEQ.S CLBZ ; ZERO
|
|
|
|
BFEXTU D0{0:8},D1 ; D1.B <- exponent
|
|
BEQ.S CLBSUB ; SUBNORMAL
|
|
|
|
CMPI.B #$FF,D1
|
|
BNE.S CLBN ; NORMAL
|
|
|
|
BFTST D0{8:23} ; NAN or INF
|
|
BEQ.S CLBI ; INF
|
|
|
|
BTST #23,D0 ; SNAN or QNAN
|
|
BNE.S CLBQN ; QNAN
|
|
|
|
BRA.S CLBSN
|
|
|
|
;-----------------------------------------------------------
|
|
; QCLASSD --- classify double precision SRC
|
|
;-----------------------------------------------------------
|
|
QCLASSD:
|
|
MOVE.L (A0)+,D0 ; D0 <- high half of SRC
|
|
OR.W (A0)+,D0 ; OR low half of SRC into D0.W
|
|
OR.W (A0),D0 ; (S. McDonald)
|
|
ADD.L D0,D0 ; save sign in X bit (SRC shifted)
|
|
BEQ.S CLBZ ; ZERO
|
|
|
|
BFEXTU D0{0:11},D1 ; D1 low <- exponent
|
|
BEQ.S CLBSUB ; SUBNORMAL
|
|
|
|
CMPI.W #$07FF,D1
|
|
BNE.S CLBN ; NORMAL
|
|
|
|
BFTST D0{11:20} ; NAN or INF
|
|
BEQ.S CLBI ; INF
|
|
|
|
BTST #20,D0 ; SNAN or QNAN
|
|
BEQ.S CLBSN ; SNAN
|
|
|
|
CLBQN:
|
|
MOVEQ #2,D0 ; QNAN case
|
|
BRA.S CLBOUT ; exit
|
|
|
|
CLBZ:
|
|
MOVEQ #4,D0 ; ZERO case
|
|
BRA.S CLBOUT
|
|
|
|
CLBSUB:
|
|
MOVEQ #6,D0 ; SUBNORMAL case
|
|
BRA.S CLBOUT
|
|
|
|
CLBN:
|
|
MOVEQ #5,D0 ; NORMAL case
|
|
|
|
CLBOUT: ; common exit code
|
|
MOVEA.L 18(SP),A0 ; DST addr
|
|
ROXR.W #1,D1 ; get sign bit back from X
|
|
BPL.S @1
|
|
NEG.W D0 ; negate class code if SRC negative
|
|
@1:
|
|
MOVE.W D0,(A0)
|
|
MOVEM.L (SP)+,A0/D0-D1 ; restore registers
|
|
RTD #STKREM2 ; done
|
|
|
|
CLBI:
|
|
MOVEQ #3,D0 ; INF case
|
|
BRA.S CLBOUT
|
|
|
|
CLBSN:
|
|
MOVEQ #1,D0 ; SNAN case
|
|
BRA.S CLBOUT
|
|
|
|
;-----------------------------------------------------------
|
|
; QCLASSC --- classify comp SRC (only NORM, ZERO, or QNAN
|
|
; are possible)
|
|
;-----------------------------------------------------------
|
|
QCLASSC:
|
|
MOVE.L (A0)+,D0 ; D0 <- high half of comp
|
|
ADD.L D0,D0 ; sign bit shifted out of D0 into X
|
|
OR.L (A0),D0 ; OR in low half of comp
|
|
BNE.S CLBN ; NORMAL with sign in X
|
|
|
|
ADDX.W D0,D0 ; test and clear X bit
|
|
BEQ.S CLBZ ; ZERO
|
|
BRA.S CLBQN ; QNAN
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QSETENV---set environment to word value at DST addr
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QSETENV:
|
|
MOVE.L A0,-(SP) ; save single register
|
|
MOVEA.L 10(SP),A0 ; DST addr
|
|
MOVE.W (A0),(FPSTATE).W ; set environment
|
|
MOVEA.L (SP)+,A0 ; restore register
|
|
RTD #STKREM1 ; done
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QGETENV---write environment word to DST addr
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QGETENV:
|
|
MOVE.L A0,-(SP)
|
|
MOVEA.L 10(SP),A0
|
|
MOVE.W (FPSTATE).W,(A0) ; get environment
|
|
MOVEA.L (SP)+,A0
|
|
RTD #STKREM1
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QSETHV---set haltvector to longword at DST addr
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QSETHV:
|
|
MOVE.L A0,-(SP) ; save single register
|
|
MOVEA.L 10(SP),A0 ; DST addr
|
|
MOVE.L (A0),(FPSTATE+2).W ; set haltvector
|
|
MOVEA.L (SP)+,A0 ; restore register
|
|
RTD #STKREM1 ; done
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QGETHV---write haltvector to DST addr
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QGETHV:
|
|
MOVE.L A0,-(SP)
|
|
MOVEA.L 10(SP),A0
|
|
MOVE.L (FPSTATE+2).W,(A0) ; get haltvector
|
|
MOVEA.L (SP)+,A0
|
|
RTD #STKREM1
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QNEG---negate floating point number at DST addr
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QNEG:
|
|
MOVE.L A0,-(SP)
|
|
MOVEA.L 10(SP),A0 ; DST addr
|
|
BCHG #7,(A0) ; negate sign bit
|
|
MOVEA.L (SP)+,A0
|
|
RTD #STKREM1
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QABS---absolute value of floating point number at DST addr
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QABS:
|
|
MOVE.L A0,-(SP)
|
|
MOVEA.L 10(SP),A0 ; DST addr
|
|
BCLR #7,(A0) ; clear sign bit
|
|
MOVEA.L (SP)+,A0
|
|
RTD #STKREM1
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QCPYSGN---copies sign of DST operand to SRC operand
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QCPYSGN:
|
|
MOVEM.L A0,-(SP) ; stack: A0sv < ret < opword < &DST < &SRC
|
|
MOVEA.L 14(SP),A0 ; A0 <- &SRC
|
|
BCLR #7,(A0) ; clr sign of SRC
|
|
TST.B ([10,SP]) ; test sign of DST
|
|
BPL.S @1
|
|
|
|
BSET #7,(A0) ; DST is negative, so echo sign in SRC
|
|
@1:
|
|
MOVEA.L (SP)+,A0
|
|
RTD #STKREM2
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QPROCENTRY---saves environment word at DST address, then
|
|
; sets default environment
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QPROCENTRY:
|
|
MOVE.L A0,-(SP) ; stack: A0sv < ret < opword < &DST
|
|
MOVEA.L 10(SP),A0 ; DST addr
|
|
MOVE.W (FPSTATE).W,(A0) ; save environment in DST
|
|
CLR.W (FPSTATE).W ; set default environment
|
|
|
|
MOVEA.L (SP)+,A0
|
|
RTD #STKREM1
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QTESTXCP---test an exception whose index is in low byte
|
|
; of word DST. Set result of test (1 for TRUE and 0 for FALSE)
|
|
; in high byte of DST.
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QTESTXCP:
|
|
MOVEM.L D0/A0,-(SP)
|
|
MOVEA.L 14(SP),A0
|
|
MOVE.W (A0),D0 ; fetch input index
|
|
BTST D0,(FPSTATE).W ; test exception bit in high
|
|
SNE D0 ; byte of environment word
|
|
NEG.B D0
|
|
MOVE.B D0,(A0) ; boolean result in DST high byte
|
|
MOVEM.L (SP)+,D0/A0
|
|
RTD #STKREM1
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QSETXCP---set an exception whose index is in low byte
|
|
; of word DST and halt if enabled.
|
|
;-----------------------------------------------------------
|
|
QSETXCP:
|
|
MOVEM.L D0/D6/A0,-(SP) ; Use 3 register
|
|
MOVE.W #$0015,D6 ; opword into D6.HI
|
|
SWAP D6
|
|
CLR.W D6 ; clr D6.LO
|
|
MOVEA.L 18(SP),A0 ; DST addr
|
|
MOVE.W (A0),D0 ; fetch exception index
|
|
ADDQ.W #8,D0 ; align to second byte
|
|
BSET D0,D6 ; set exception in D6.W
|
|
MOVE.W (FPSTATE).W,D0 ; environment into D0.W
|
|
BRA.S FASTFIN ; share back end with PROCEXIT routine
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; QPROCEXIT---restore old environment at DST address with
|
|
; current exceptions ORed in. Halt if any of the current
|
|
; exceptions are enabled in the old environment. Back end
|
|
; is shared with SETEXCEPTION routine.
|
|
;-----------------------------------------------------------
|
|
QPROCEXIT:
|
|
MOVEM.L D0/D6/A0,-(SP) ; Use 3 registers
|
|
MOVEA.L 18(SP),A0 ; old environment addr
|
|
MOVE.W #$0019,D6 ; opword into D6.HI
|
|
SWAP D6
|
|
MOVE.W #$1F00,D6 ; exception mask in D6.W
|
|
AND.W ($0A4A).W,D6 ; current exceptions in D6.W
|
|
MOVE.W (A0),D0 ; old environment into D0.W for restoration
|
|
|
|
FASTFIN:
|
|
OR.W D6,D0 ; OR new exceptions with old environment
|
|
MOVE.W D0,($0A4A).W ; store resulting environment
|
|
LSR.W #8,D6 ; check for halt
|
|
AND.W D6,D0
|
|
BNE.S FASTHALT ; handle halt
|
|
|
|
FASTEX:
|
|
MOVE D0,CCR ; zero CCR
|
|
MOVEM.L (SP)+,D0/D6/A0 ; restore registers
|
|
RTD #STKREM1 ; done
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Fast halt vectoring routine for SETEXCEPTION and PROCEXIT
|
|
;-----------------------------------------------------------
|
|
FASTHALT:
|
|
LEA 18(SP),A0 ; A0 points to DST addr on stack
|
|
CLR.W -(SP) ; push CCR = 0 below D0 save
|
|
MOVE.W D0,-(SP) ; push HALT exceptions
|
|
PEA (SP) ; push MISCHALTINFO record pointer
|
|
MOVE.L 8(A0),-(SP) ; push bogus SRC2 addr
|
|
MOVE.L 4(A0),-(SP) ; push bogus SRC addr
|
|
MOVE.L (A0),-(SP) ; push DST addr
|
|
SWAP D6 ; push opword
|
|
MOVE.W D6,-(SP)
|
|
MOVEA.L ($0A4C).W,A0 ; call user halt handler
|
|
JSR (A0)
|
|
|
|
MOVE.L (SP)+,D0 ; pop HALT exception/CCR off stack
|
|
BRA.S FASTEX ; exit
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; QNEXTB---NEXTAFTER function changes the SRC operand by one
|
|
; ulp in the direction of the DST operand. This function
|
|
; behaves like nonarithmetic operations, but it may set
|
|
; exceptions. This function calls via BSR routines for
|
|
; comparison, multiplication, classification, and conversion.
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
QNEXTB:
|
|
FINIT
|
|
MOVE.W LKOP(A6),D6 ; get opword into D6.W
|
|
MOVEM.L LKADR1(A6),A1-A2 ; A1 <- &DST, A2 <- &SRC
|
|
|
|
SUBA.W #22,SP ; reserve stack for 2 extendeds and one int
|
|
MOVEA.L SP,A4 ; A4 is local frame pointer
|
|
|
|
MOVE.W (FPSTATE).W,D3 ; save old environment in D3 for duration
|
|
CLR.W (FPSTATE).W ; set default environment
|
|
|
|
MOVEQ #0,D2 ; zero D2
|
|
MOVE.W D6,D5 ; copy opcode into D5
|
|
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:
|
|
SWAP D6 ; opword in D6.HI 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 extended
|
|
OR.W D5,D0 ; ...with format
|
|
MOVE.W D0,-(SP)
|
|
BSR FP020
|
|
TST.W D5 ; if extended format, overwrite
|
|
BNE.S @3 ; SRC with converted SRC to
|
|
; avoid problem of unnormalized input
|
|
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 FP020
|
|
|
|
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 FP020
|
|
|
|
;-----------------------------------------------------------
|
|
; 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 FP020
|
|
|
|
;-----------------------------------------------------------
|
|
; 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 FP020
|
|
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 FP020
|
|
|
|
;-----------------------------------------------------------
|
|
; 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 (FPSTATE).W,D7 ; D7 <- flags due to conversions
|
|
MOVE.W D3,(FPSTATE).W ; restore old environment
|
|
OR.W D7,D6 ; OR all flags together
|
|
BRA FINI2OPS
|
|
|
|
;-----------------------------------------------------------
|
|
; 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
|
|
|
|
|