mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-06-14 02:29:29 +00:00
4325cdcc78
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.
1210 lines
32 KiB
Plaintext
1210 lines
32 KiB
Plaintext
;
|
|
; File: FPCTRL.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):
|
|
;
|
|
; Terror Change History:
|
|
;
|
|
; <1> 11/14/90 BG Added to BBS for the first time.
|
|
;
|
|
; To Do:
|
|
;
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; FPCONTROL for MC68020
|
|
; Copyright Apple Computer, Inc., 1983,1984,1985,1989,1990
|
|
; All rights reserved
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; 9 JAN 90: WRITTEN BY JON OKADA FOR MC68020, BASED UPON
|
|
; LISA CODE BY JEROME COONEN
|
|
; 11 JUN 90: MODIFIED TO SUPPORT 96-BIT EXTENDED OPERANDS (JPO)
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; This is the main entry point of the package. The stack has
|
|
; the form:
|
|
; ret < opword < addr1 < addr2 < addr3,
|
|
; where the number of addresses (1, 2, or 3) depends on the
|
|
; operation.
|
|
;
|
|
; Dispatching is done to entry points for individual operations
|
|
; or for groups of similar operations.
|
|
;-----------------------------------------------------------
|
|
|
|
FP020 PROC EXPORT
|
|
;-----------------------------------------------------------
|
|
; Prepare for quick dispatching for operations
|
|
;-----------------------------------------------------------
|
|
; dc.w $a9ff
|
|
|
|
SUBQ.L #4,SP ; space for dispatching via RTS
|
|
MOVEM.L D0/A0,-(SP) ; save minimum # of registers
|
|
|
|
;-----------------------------------------------------------
|
|
; Get opword into D0.LO and dispatch quickly if format is
|
|
; extended or opword is odd.
|
|
;-----------------------------------------------------------
|
|
|
|
DISPBASE:
|
|
MOVEQ #0,D0 ; zero D0
|
|
MOVE.W 16(SP),D0 ; D0.W <- opcode
|
|
BFTST D0{18:3} ; test operation format:
|
|
BEQ.S DISP1 ; quick dispatch if extended
|
|
BTST #0,D0 ; test opcode for odd/even:
|
|
BEQ.S DISP2 ; even case uses second dispatch table
|
|
|
|
;-----------------------------------------------------------
|
|
; Dispatch via table for extended format or odd-numbered operations
|
|
;-----------------------------------------------------------
|
|
|
|
DISP1:
|
|
ANDI.W #$001F,D0 ; D0.W <- operation index
|
|
ADD D0,D0 ; double index to obtain table index
|
|
MOVE.W D1CASE(D0),D0 ; D0 <- operation addr offset
|
|
LEA DISPBASE(D0),A0 ; A0 <- operation addr
|
|
|
|
;-----------------------------------------------------------
|
|
; Accomplish entry to routine address in A0 via RTS. At this
|
|
; point, stack is:
|
|
; (SAVED D0/A0) < longword for addr < ret < opword < arg addresses
|
|
;-----------------------------------------------------------
|
|
|
|
VECTOROFF:
|
|
MOVE.L A0,8(SP) ; stuff addr in A0 into stack
|
|
MOVEM.L (SP)+,D0/A0 ; restore two registers
|
|
RTS ; quick entry to implementation
|
|
|
|
;-----------------------------------------------------------
|
|
; Dispatch via table for remaining even-numbered operations
|
|
;-----------------------------------------------------------
|
|
|
|
DISP2:
|
|
ANDI.W #$001E,D0 ; D0.W <- table index
|
|
MOVE.W D2CASE(D0),D0 ; D0 <- operation addr offset
|
|
LEA DISPBASE(D0),A0 ; A0 <- operation addr
|
|
BRA.S VECTOROFF ; dispatch after restoring registers
|
|
|
|
;-----------------------------------------------------------
|
|
; Tables for dispatching to operations
|
|
;-----------------------------------------------------------
|
|
|
|
D1CASE:
|
|
DC.W QADDX - DISPBASE
|
|
DC.W QSETENV - DISPBASE
|
|
DC.W QSUBX - DISPBASE
|
|
DC.W QGETENV - DISPBASE
|
|
DC.W QMULX - DISPBASE
|
|
DC.W QSETHV - DISPBASE
|
|
DC.W QDIVX - DISPBASE
|
|
DC.W QGETHV - DISPBASE
|
|
DC.W QCMPX - DISPBASE
|
|
DC.W QD2B - DISPBASE
|
|
DC.W QCMPX - DISPBASE
|
|
DC.W QB2D - DISPBASE
|
|
DC.W QREMX - DISPBASE
|
|
DC.W QNEG - DISPBASE
|
|
DC.W QX2X - DISPBASE
|
|
DC.W QABS - DISPBASE
|
|
DC.W QX2X - DISPBASE
|
|
DC.W QCPYSGN - DISPBASE
|
|
DC.W QSQRTX - DISPBASE
|
|
DC.W QNEXTB - DISPBASE
|
|
DC.W QRINTX - DISPBASE
|
|
DC.W QSETXCP - DISPBASE
|
|
DC.W QTINTX - DISPBASE
|
|
DC.W QPROCENTRY- DISPBASE
|
|
DC.W QSCALBX - DISPBASE
|
|
DC.W QPROCEXIT - DISPBASE
|
|
DC.W QLOGBX - DISPBASE
|
|
DC.W QTESTXCP - DISPBASE
|
|
DC.W QCLASSX - DISPBASE
|
|
|
|
D2CASE:
|
|
DC.W QADDB - DISPBASE
|
|
DC.W QSUBB - DISPBASE
|
|
DC.W QMULB - DISPBASE
|
|
DC.W QDIVB - DISPBASE
|
|
DC.W QCMPB - DISPBASE
|
|
DC.W QCMPB - DISPBASE
|
|
DC.W QREMB - DISPBASE
|
|
DC.W QB2X - DISPBASE
|
|
DC.W QX2B - DISPBASE
|
|
DC.W QSQRTX - DISPBASE
|
|
DC.W QRINTX - DISPBASE
|
|
DC.W QTINTX - DISPBASE
|
|
DC.W QSCALBX - DISPBASE
|
|
DC.W QLOGBX - DISPBASE
|
|
DC.W QCLASSB - DISPBASE
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; Code to store opword and unpack pairs of operands, assuming
|
|
; A6 link entry. Register usage:
|
|
; A0 continuation jmp address
|
|
; A3 DST exponent
|
|
; A4 SRC exponent
|
|
; D0 operand classification
|
|
; D3/A2 DST significand
|
|
; D4/D5 SRC significand
|
|
; D6 opword/exceptions/operand signs
|
|
; D7 round/stickies (initialized to zero)
|
|
; A1/D1 scratch
|
|
;
|
|
; D6 will contain the following information:
|
|
; opword in bits 16-31 (HI word)
|
|
; exceptions in bits 8-12 (initialized to zero)
|
|
; SRC sign in bit 7
|
|
; DST sign in bit 6
|
|
; XOR of signs in bit 5
|
|
;
|
|
; D0 low word will contain NaN information for easy dispatching:
|
|
; 0 neither operand is a NaN
|
|
; 2 SRC is a NaN
|
|
; 4 DST is a NaN
|
|
; 6 both operands are NaNs
|
|
;
|
|
; If the low word in D0 is zero, the high word contains further
|
|
; classification information:
|
|
; 0 both operands are finite nonzero numbers
|
|
; 2 DST is finite and nonzero; SRC is zero
|
|
; 4 DST is finite and nonzero; SRC is infinite
|
|
; 6 DST is zero; SRC is finite and nonzero
|
|
; 8 both operands are zero
|
|
; 10 DST is zero; SRC is infinite
|
|
; 12 DST is infinite; SRC is finite and nonzero
|
|
; 14 DST is infinite; SRC is zero
|
|
; 16 both operands are infinite
|
|
; In this case (no NaN input, the high and low words of D0 are
|
|
; swapped before the operation continues.
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; Extended SRC and DST
|
|
;-----------------------------------------------------------
|
|
UNPACKXX:
|
|
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 LKADR1(A6),A1 ; unpack extended DST
|
|
BSR UNPXOP
|
|
MOVEA.L A4,A3 ; move to A3/D3/A2
|
|
MOVE.L D4,D3
|
|
MOVEA.L D5,A2
|
|
LSR.B #1,D6 ; move sign to D6 bit 6
|
|
MOVE.L D0,D1 ; double NaN index (D0.LO) and
|
|
CLR.W D1
|
|
ADD.L D0,D0 ; and triple number index (D0.HI)
|
|
ADD.L D1,D0
|
|
|
|
MOVEA.L LKADR2(A6),A1 ; unpack extended SRC
|
|
BSR UNPXOP
|
|
|
|
;-----------------------------------------------------------
|
|
; Convenient to put XOR of signs in D6 bit 5
|
|
;-----------------------------------------------------------
|
|
UNPACKED2:
|
|
ASL.B #1,D6 ; V = XOR of signs
|
|
BVC.S @1
|
|
BSET #6,D6
|
|
@1:
|
|
ROXR.B #1,D6
|
|
MOVEQ #0,D7 ; zero D7
|
|
|
|
;-----------------------------------------------------------
|
|
; Branch to special code if NaN(s) unpacked
|
|
;-----------------------------------------------------------
|
|
TST.W D0 ; any NaN input?
|
|
BNE.S NAN2OPS ; yes; special processing
|
|
|
|
SWAP D0 ; no; swap D0 high/low
|
|
JMP (A0) ; do operation
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Non-extended SRC and extended DST
|
|
;-----------------------------------------------------------
|
|
UNPACKXB:
|
|
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 LKADR1(A6),A1 ; unpack extended DST
|
|
BSR UNPXOP
|
|
MOVEA.L A4,A3 ; move to A3/D3/A2
|
|
MOVE.L D4,D3
|
|
MOVEA.L D5,A2
|
|
LSR.B #1,D6 ; move sign to D6 bit 6
|
|
MOVE.L D0,D1 ; double NaN index (D0.LO) and
|
|
CLR.W D1
|
|
ADD.L D0,D0 ; and triple number index (D0.HI)
|
|
ADD.L D1,D0
|
|
|
|
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 non-extended SRC
|
|
BSR UNPBOP
|
|
BRA.S UNPACKED2 ; get XOR of signs & check for NaNs
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; This is the target of all invalid operations with extended
|
|
; results. Bits in D0 000000XX must go to 00XX0000.
|
|
;-----------------------------------------------------------
|
|
INVALIDOP:
|
|
BSET #ERRI+8,D6
|
|
SWAP D0 ; align code byte
|
|
BSET #QNANBIT,D0 ; mark it quiet
|
|
MOVE.L D0,D4
|
|
MOVEQ #0,D5 ; clear low half
|
|
MOVEA.W #$7FFF,A4 ; set exponent
|
|
BRA PACKX ; pack it
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; NaN input detected for binary operation. Take as preliminary
|
|
; result any single NaN input or, if both inputs are NaN, the
|
|
; NaN with the larger code. At this point, unpacked extended
|
|
; operands are in A3/D3/A2 (DST) and A4/D4/D5 (SRC), and the
|
|
; input NaN flags are in D0.W.
|
|
;-----------------------------------------------------------
|
|
NAN2OPS:
|
|
LEA FINI2OPS,A0 ; continuation addr
|
|
|
|
NANCOMMON:
|
|
SUBQ.W #2,D0
|
|
BEQ.S NANSRC ; SRC NaN only
|
|
SUBQ.W #2,D0
|
|
BEQ.S NANDST ; DST NaN only
|
|
|
|
MOVE.L D3,D7 ; two NaN inputs
|
|
MOVE.L #$00FF0000,D1 ; NaN code mask
|
|
AND.L D1,D7 ; DST code
|
|
AND.L D4,D1 ; SRC code
|
|
CMP.L D7,D1
|
|
BGT.S NANSRC ; SRC code >= DST code
|
|
|
|
NANDST: ; move DST NaN to SRC position
|
|
ADD.B D6,D6 ; sign
|
|
MOVEA.L A3,A4 ; exponent
|
|
MOVE.L D3,D4 ; significand
|
|
MOVE.L A2,D5
|
|
|
|
NANSRC:
|
|
BFEXTU D6{11:5},D1 ; D1 <- opcode
|
|
SUBQ #8,D1
|
|
BEQ.S NANCMP ; FCMP opcode (no signal on unordered)
|
|
SUBQ #2,D1
|
|
BNE.S FPNANOUT ; output extended NaN
|
|
|
|
BSET #ERRI+8,D6 ; FCPX signals invalid on unordered
|
|
NANCMP:
|
|
MOVEQ #CMPU,D7 ; mark unordered
|
|
BRA FINICMPS ; finish comparison
|
|
|
|
;-----------------------------------------------------------
|
|
; Output extended NaN after checking for interesting NaN bits,
|
|
; giving special code if there is none
|
|
;-----------------------------------------------------------
|
|
FPNANOUT:
|
|
BSR.S FPNANIN ; check for interesting NaN bits
|
|
BRA PACKX ; stuff NaN result
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine FPNANIN checks for interesting NaN bits and gives
|
|
; a special NaN code if there is none. Input NaN significand
|
|
; is in D4/D5. Uses D1 as scratch register
|
|
;-----------------------------------------------------------
|
|
FPNANIN:
|
|
MOVE.L D4,D1 ; check for all zeros
|
|
BCLR #QNANBIT,D1 ; disregard quiet bit
|
|
OR.L D5,D1
|
|
BNE.S @1
|
|
|
|
MOVEQ #NANZERO,D4 ; special NaN if no code
|
|
SWAP D4
|
|
BSET #QNANBIT,D4
|
|
@1:
|
|
RTS
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine UNPXOP unpacks an extended operand. Register usage
|
|
; is as follows:
|
|
; ENTRY:
|
|
; A1 operand addr
|
|
; D6.HI opword (includes 96-bit extended format bit (#21)
|
|
; EXIT:
|
|
; A4 exponent of operand sign-extended to 32 bits
|
|
; D4/D5 extended significand
|
|
; D0 classification code for operand (ADDed in)
|
|
; D6 sign of operand in bit 7 (ORed in)
|
|
; A1,D1 trashed
|
|
;-----------------------------------------------------------
|
|
UNPXOP:
|
|
MOVE.W (A1)+,D1 ; D1 <- sign/exp
|
|
BPL.S @1 ; + case
|
|
|
|
BSET #7,D6 ; - case; set flag in D6
|
|
BCLR #15,D1 ; and clr sign bit
|
|
@1:
|
|
BTST #21,D6 ; 96-bit extended?
|
|
BEQ.S @2 ; no. 80-bit
|
|
|
|
ADDQ #2,A1 ; yes. bump pointer by 2
|
|
@2:
|
|
MOVE.L (A1)+,D4 ; significand bits into D4/D5
|
|
MOVE.L (A1),D5
|
|
|
|
CMPI.W #$7FFF,D1 ; max exp?
|
|
BEQ.S UNPNIN ; yes; special handling
|
|
|
|
TST.L D4 ; normalized?
|
|
BPL.S UNPZUN ; no; special handling
|
|
|
|
UNPNRM: ; normalized case
|
|
EXT.L D1 ; 32-bit exponent in A4
|
|
MOVEA.L D1,A4
|
|
RTS ; return
|
|
|
|
;-----------------------------------------------------------
|
|
; Distinguish special case and set appropriate bit in D0:
|
|
; bit 17 for zero;
|
|
; bit 18 for infinite
|
|
; bit 1 for NaN
|
|
;-----------------------------------------------------------
|
|
UNPZUN:
|
|
TST.L D4 ; unnormalized or zero
|
|
BNE.S UNPUNR
|
|
TST.L D5
|
|
BNE.S UNPUNR ; do normalization
|
|
UNP0:
|
|
SUBA.L A4,A4 ; ZERO unpacked; zero exponent
|
|
ADD.L #$00020000,D0 ; mark in D0
|
|
RTS ; done
|
|
|
|
UNPUNR: ; enter here to normalize quietly
|
|
SUBQ.W #1,D1 ; decrement exponent
|
|
ADD.L D5,D5 ; shift significand left
|
|
ADDX.L D4,D4
|
|
BPL.S UNPUNR ; loop until high bit of D4 set, then
|
|
BRA.S UNPNRM ; treat as normalized
|
|
|
|
UNPNIN: ; NaN or infinity
|
|
MOVEA.W #$7FFF,A4 ; max exponent
|
|
BCLR #31,D4 ; ignore explicit bit
|
|
TST.L D4
|
|
BNE.S UNPNAN ; NaN if any other significand
|
|
TST.L D5 ; bit is set
|
|
BNE.S UNPNAN
|
|
|
|
ADD.L #$00040000,D0 ; INFINITE; mark INF operand in D0
|
|
RTS
|
|
|
|
;-----------------------------------------------------------
|
|
; NaN unpacked. Test and set the quiet NaN bit (#30 of upper
|
|
; half of the significand); if it was clear, then signal invalid.
|
|
;-----------------------------------------------------------
|
|
UNPNAN:
|
|
BSET #QNANBIT,D4 ; quiet the NaN
|
|
BNE.S @2 ; it was already quiet
|
|
BSET #ERRI+8,D6 ; signaling NaN raises invalid flag
|
|
@2:
|
|
ADDQ.W #2,D0 ; mark NaN in D0
|
|
RTS
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine UNPBOP unpacks a non-extended binary operand. Register
|
|
; usage is as follows:
|
|
; ENTRY:
|
|
; A1 operand addr
|
|
; D1 offset into jump table for unpack routine
|
|
; EXIT:
|
|
; A4 exponent of operand sign-extended to 32 bits
|
|
; D4/D5 extended significand
|
|
; D0 classification code for operand (ADDed in)
|
|
; D6 sign of operand in bit 7 (ORed in)
|
|
; A1,D1 trashed
|
|
; D2 scratch register for some formats
|
|
;-----------------------------------------------------------
|
|
UNPBOP:
|
|
MOVE.W UNPCASE(D1),D1 ; get addr of specific routine
|
|
JMP UNPBOP(D1) ; and jump there
|
|
|
|
UNPCASE:
|
|
DC.W UNPDBL - UNPBOP ; double precision
|
|
DC.W UNPSGL - UNPBOP ; single precision
|
|
DC.W UNPXOP - UNPBOP ; ---illegal format
|
|
DC.W UNPI16 - UNPBOP ; int16
|
|
DC.W UNPI32 - UNPBOP ; int32
|
|
DC.W UNPC64 - UNPBOP ; comp
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; 16-bit integer unpacking has special case of zero; else
|
|
; normalize and return
|
|
;-----------------------------------------------------------
|
|
UNPI16:
|
|
MOVEQ #0,D4 ; zero D4
|
|
MOVE.W #$400E,D1 ; set exponent for short integer
|
|
MOVE.L D4,D5 ; zero D5
|
|
MOVE.W (A1),D4 ; get operand
|
|
SWAP D4 ; left align in register
|
|
BRA.S UNPIGEN ; continue below
|
|
|
|
;-----------------------------------------------------------
|
|
; 32-bit integer unpacking has special case of zero; else
|
|
; normalize and return
|
|
;-----------------------------------------------------------
|
|
UNPI32:
|
|
MOVE.W #$401E,D1 ; set exponent for long integer
|
|
MOVEQ #0,D5 ; zero D5
|
|
MOVE.L (A1),D4 ; get operand
|
|
|
|
UNPIGEN:
|
|
BEQ.S UNP0 ; zero
|
|
BPL.S UNPIUNR ; positive. normalize
|
|
|
|
BSET #7,D6 ; negative. set sign in D6
|
|
NEG.L D4 ; negate D4
|
|
BMI.S UNPNRM ; already normalized if = $80000000
|
|
|
|
;-----------------------------------------------------------
|
|
; Normalization for D4 > 0 and D5 = 0
|
|
;-----------------------------------------------------------
|
|
UNPIUNR:
|
|
BFFFO D4{0:0},D2 ; find first one bit
|
|
SUB.W D2,D1 ; adjust exponent
|
|
LSL.L D2,D4 ; shift significand
|
|
BRA UNPNRM ; NORMALIZED
|
|
|
|
;-----------------------------------------------------------
|
|
; 64-bit comp unpacking has special cases of zero and NaN; else
|
|
; normalize and return
|
|
;-----------------------------------------------------------
|
|
UNPC64:
|
|
MOVE.W #$403E,D1 ; initialize exponent
|
|
MOVE.L (A1)+,D4 ; get operand into D4/D5
|
|
MOVE.L (A1),D5
|
|
BNE.S @1 ; low half nonzero
|
|
|
|
TST.L D4 ; test high half
|
|
BEQ UNP0 ; comp ZERO
|
|
BPL.S UNPIUNR ; normalize positive
|
|
|
|
BSET #7,D6 ; flag negative in D6
|
|
NEG.L D4 ; negate high significand
|
|
BPL.S UNPIUNR ; normalize if not NaN
|
|
|
|
MOVEA.W #$7FFF,A4 ; comp NaN; set exponent
|
|
BCLR #7,D6 ; clear sign bit
|
|
MOVEQ #NANCOMP,D4 ; NaN code in significand high word
|
|
SWAP D4
|
|
BSET #QNANBIT,D4 ; make it quiet
|
|
ADDQ.W #2,D0 ; mark NaN in D0
|
|
RTS ; done
|
|
|
|
@1: ; comp low half nonzero
|
|
TST.L D4 ; test high half
|
|
BPL.S @2 ; nonnegative
|
|
|
|
BSET #7,D6 ; mark as negative in D6
|
|
NEG.L D5 ; negate
|
|
NEGX.L D4
|
|
TST.L D4 ; test high half
|
|
@2:
|
|
BNE UNPUNR ; nonzero; normalize D4/D5
|
|
|
|
SUBI.W #$0020,D1 ; high half zero; reduce exponent
|
|
EXG D4,D5 ; exchange high/low halves
|
|
TST.L D4
|
|
BPL.S UNPIUNR ; normalize if necessary
|
|
BRA UNPNRM
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Single-precision unpacking has special cases of zero, NaN,
|
|
; and infinite
|
|
;-----------------------------------------------------------
|
|
UNPSGL:
|
|
MOVEQ #0,D5 ; zero significand low half
|
|
MOVE.L (A1),D4 ; read single-precision into D4
|
|
BPL.S @3 ; not negative
|
|
|
|
BSET #7,D6 ; negative; mark in D6
|
|
@3:
|
|
BFEXTU D4{1:8},D1 ; extract exponent into D1
|
|
BEQ.S @4 ; ZERO or subnormal single
|
|
|
|
LSL.L #8,D4 ; shift significand just short of bit 31
|
|
CMPI.B #$FF,D1 ; max exp?
|
|
BEQ UNPNIN ; yes; NaN or INFINITE
|
|
|
|
ADDI.W #$3F80,D1 ; normalized; bias exponent
|
|
BSET #31,D4 ; set explicit bit
|
|
BRA UNPNRM
|
|
|
|
@4:
|
|
LSL.L #8,D4 ; shift significand
|
|
BEQ UNP0 ; ZERO
|
|
|
|
MOVE.W #$3F81,D1 ; single subnormal; bias exponent
|
|
BRA UNPIUNR ; normalize
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Double-precision unpacking has special cases of zero, NaN,
|
|
; and infinite
|
|
;-----------------------------------------------------------
|
|
UNPDBL:
|
|
MOVE.L (A1),D4 ; high bits into D4
|
|
BPL.S @5
|
|
|
|
BSET #7,D6 ; set sign in D6
|
|
@5:
|
|
MOVE.L 4(A1),D5 ; low bits in D5
|
|
|
|
;-----------------------------------------------------------
|
|
; Double operands appear as: (1) (11) (1 implicit) (52), so
|
|
; must align bits left by 11 places and insert explicit lead
|
|
; bit. Do this via shifts and bit field instructions.
|
|
;-----------------------------------------------------------
|
|
BFEXTU D4{1:11},D1 ; extract exponent into D1
|
|
BFEXTU D5{0:11},D2 ; extract 11 high bits of D5
|
|
LSL.L #8,D4 ; shift D4 and D5 left 11 places
|
|
LSL.L #8,D5
|
|
LSL.L #3,D4
|
|
LSL.L #3,D5
|
|
OR.W D2,D4 ; move 11 bits to D4 low end
|
|
BCLR #31,D4 ; clr explicit bit initially
|
|
TST.L D1 ; test exponent
|
|
BNE.S @6 ; normalized, infinite, or NaN
|
|
|
|
MOVE.W #$3C01,D1 ; zero or unnormalized
|
|
BRA UNPZUN
|
|
@6:
|
|
CMPI.W #$07FF,D1 ; max exp?
|
|
BEQ UNPNIN ; yes, NaN or INF
|
|
|
|
BSET #31,D4 ; normalized number; set explicit bit
|
|
ADDI.W #$3C00,D1 ; bias exponent
|
|
BRA UNPNRM
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine RTSHIFT.
|
|
;
|
|
; This is the right shifter used in subnormal coercion, IPALIGN ...
|
|
; Shift count in D0 > 0; Shift registers are D4/D5/D7 (stickies)
|
|
; Uses D3 as scratch register.
|
|
;-----------------------------------------------------------
|
|
RTSHIFT:
|
|
CMPI.W #66,D0 ; high shift counts pin to 66
|
|
BLS.S @1
|
|
MOVE.W #66,D0
|
|
@1:
|
|
CMPI.W #32,D0 ; count < 32?
|
|
BLT.S @3 ; yes. do shift
|
|
TST.L D7 ; no. set stickies if D7 nonzero
|
|
SNE D3
|
|
MOVE.L D5,D7 ; shift D4/D5 into D5/D7
|
|
MOVE.L D4,D5
|
|
OR.B D3,D7 ; OR in low stickies
|
|
MOVEQ #0,D4 ; zero D4
|
|
SUBI.W #32,D0 ; decr count by 32
|
|
BNE.S @1 ; loop if nonzero
|
|
RTS ; otherwise, done
|
|
|
|
@3: ; right shift of 1-31 bits
|
|
BFINS D7,D3{0:D0} ; test low bits
|
|
SNE D3 ; set sticky state in D3
|
|
LSR.L D0,D7 ; shift D7 right
|
|
BFINS D5,D7{0:D0} ; shift bits from D5 low to D7 high
|
|
LSR.L D0,D5 ; shift D5 right
|
|
BFINS D4,D5{0:D0} ; shift bits from D4 low to D5 high
|
|
LSR.L D0,D4 ; shift D4
|
|
OR.B D3,D7 ; OR in low stickies
|
|
|
|
RTS ; done
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; COERCION routines assume post-operation register mask with
|
|
; result in:
|
|
; A4 exponent
|
|
; D4 significand high 32 bits
|
|
; D5 significand
|
|
; D7 round/stickies.
|
|
;-----------------------------------------------------------
|
|
|
|
;-----------------------------------------------------------
|
|
; Check value first, stuff if zero (with exp fix), otherwise,
|
|
; normalize and coerce. Called only by remainder routine,
|
|
; which is exact and which has default (extended) rounding
|
|
; precision.
|
|
;-----------------------------------------------------------
|
|
ZNORMCOERCEX:
|
|
MOVE.L #0,D7 ; make it exact
|
|
TST.L D4
|
|
BNE.S NORMX ; nonzero
|
|
TST.L D5
|
|
BNE.S NORMX ; nonzero
|
|
|
|
SUBA.L A4,A4 ; zero
|
|
BRA PACKX ; never coerce
|
|
|
|
NORMX:
|
|
TST.L D4 ; check for lead 1 bit
|
|
BMI COERCEX ; normalized, so coerce
|
|
|
|
@1:
|
|
SUBQ.L #1,A4 ; decr exponent
|
|
ADD.L D5,D5 ; shift significand
|
|
ADDX.L D4,D4
|
|
BPL.S @1 ; loop until normalized
|
|
BRA COERCEX ; coerce with default precision
|
|
|
|
;-----------------------------------------------------------
|
|
; ASSUME, AS AFTER SUBTRACT THAT VALUE IS NONZERO. USE 1ST
|
|
; BRANCH TO SHORTEN ACTUAL LOOP BY A BRANCH.
|
|
;-----------------------------------------------------------
|
|
NORMCOERCE:
|
|
TST.L D4 ; CHECK FOR LEAD 1
|
|
BMI.S COERCE
|
|
@1:
|
|
SUBQ.L #1,A4 ; DECREMENT EXP
|
|
ADD.L D7,D7 ; SHIFT RND
|
|
ADDX.L D5,D5 ; LO BITS
|
|
ADDX.L D4,D4
|
|
BPL.S @1 ; WHEN NORM, FALL THROUGH
|
|
|
|
;-----------------------------------------------------------
|
|
; COERCE MILESTONE +++++++++++++++++++++++++++++++++++++++ .
|
|
;
|
|
; RUN SEPARATE SEQUENCES FOR EXT, SGL, DBL TO SAVE TESTS.
|
|
; NOTE THAT FOR CONVENIENCE IN BRANCHING, THE SGL AND DBL
|
|
; COERCE SEQUENCES FOLLOW THE COERCE ROUTINES.
|
|
; SINCE OVERFLOW RESULTS IN A VALUE DEPENDING ON THE
|
|
; PRECISION CONTROL BITS, RETURN CCR KEY FROM OFLOW:
|
|
; EQ: OK NE: HUGE
|
|
;
|
|
; Extended result is in D6 bit 7 (sign), A4 (exp), D4/D5 (sig),
|
|
; and D7 (round/stickies).
|
|
; Uses D1.W to store environment word for rounding control info.
|
|
;-----------------------------------------------------------
|
|
COERCE:
|
|
MOVE.W (FPSTATE).W,D1 ; environment in D1
|
|
BFTST D1{25:2} ; check rounding precision
|
|
BEQ COERCEX ; default (extended)
|
|
BPL COERCED ; double
|
|
|
|
;-----------------------------------------------------------
|
|
; Coerce to single precision, obeying prescribed
|
|
; rounding direction.
|
|
;-----------------------------------------------------------
|
|
COERCES:
|
|
BSR.S SCOERCE ; coerce to single precision
|
|
BRA COERCESDONE
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine SCOERCE coerces extended value in A4/D4/D5/D7 to
|
|
; single precision, honoring prescribed rounding direction
|
|
; in environment word (D1.W). Uses D0, clobbers D1
|
|
;-----------------------------------------------------------
|
|
SCOERCE:
|
|
MOVE.L #$3F81,D0 ; single underflow threshold
|
|
SUB.L A4,D0 ; threshold - exponent
|
|
BLE.S @1 ; no underflow
|
|
|
|
BSET #ERRU+8,D6 ; signal underflow
|
|
MOVEA.W #$3F81,A4 ; minimum exponent
|
|
BSR RTSHIFT ; shift
|
|
@1:
|
|
TST.L D5 ; get single precision bits/stickies
|
|
SNE D0 ; nonzero D5 sets low stickies
|
|
OR.B D0,D7
|
|
ADD.B D4,D4 ; round bit to X
|
|
ROXR.L #1,D7 ; X to D7 high bit
|
|
OR.B D4,D7 ; last stickies to D7 low byte
|
|
|
|
MOVEQ #0,D5 ; clear low bits
|
|
CLR.B D4
|
|
|
|
TST.L D7 ; exact result?
|
|
BNE.S @3 ; no
|
|
BCLR #ERRU+8,D6 ; yes. suppress underflow
|
|
BRA.S RNDOVERS
|
|
|
|
@3:
|
|
BSET #ERRX+8,D6 ; signal inexact
|
|
BFTST D1{17:2} ; round to nearest?
|
|
BEQ.S @7 ; yes
|
|
BMI.S @5 ; chop or round downward
|
|
|
|
TST.B D6 ; round toward +°
|
|
BPL.S RNDUPS ; increment significand if positive
|
|
BRA.S RNDOVERS
|
|
|
|
@5:
|
|
BTST #13,D1 ; chop or round toward -°
|
|
BNE.S RNDOVERS ; chop requires no incrementing
|
|
|
|
TST.B D6 ; round toward -°
|
|
BPL.S RNDOVERS
|
|
BRA.S RNDUPS ; increment significand if negative
|
|
|
|
@7:
|
|
ADD.L D7,D7 ; round bit set?
|
|
BCC.S RNDOVERS ; no; significand OK
|
|
|
|
BNE.S RNDUPS ; yes, with stickies, so round up
|
|
|
|
BTST #8,D4 ; halfway case gets bumped if low single
|
|
BEQ.S RNDOVERS ; bit is set
|
|
|
|
RNDUPS:
|
|
ADD.L #$0100,D4 ; bump significand
|
|
BCC.S RNDOVERS
|
|
|
|
ROXR.L #1,D4 ; if overflow, shift right and bump exponent
|
|
ADDQ.L #1,A4
|
|
|
|
RNDOVERS:
|
|
MOVEA.W #$407E,A3 ; single overflow exponent threshold
|
|
CMPA.L A4,A3
|
|
BLT.S @9
|
|
|
|
RTS ; no overflow
|
|
|
|
@9: ; single precision overflow
|
|
BSET #ERRO+8,D6 ; signal overflow and inexact
|
|
BSET #ERRX+8,D6
|
|
MOVEA.W #$7FFF,A4 ; store INF initially
|
|
SUB.L D4,D4
|
|
SUB.L D5,D5
|
|
LSR.W #8,D1 ; check rounding direction
|
|
AND.B #RNDMSK,D1
|
|
BNE.S @11
|
|
|
|
RTS ; default rounding returns INF
|
|
|
|
@11:
|
|
CMPI.B #RNDMSK,D1 ; chopping returns single HUGE
|
|
BEQ.S HUGES
|
|
|
|
TST.B D6 ; check sign
|
|
BMI.S @15
|
|
|
|
CMPI.B #RNDUP,D1 ; positive
|
|
BNE.S HUGES ; round down returns single HUGE
|
|
RTS ; round up returns INF
|
|
|
|
@15:
|
|
CMPI.B #RNDDN,D1 ; negative
|
|
BNE.S HUGES ; round up returns single HUGE
|
|
RTS ; round down returns -INF
|
|
|
|
HUGES:
|
|
MOVEQ #-1,D4 ; set maximum single exponent and significand
|
|
MOVEA.L A3,A4
|
|
CLR.B D4
|
|
|
|
RTS
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Coerce to double precision, obeying prescribed
|
|
; rounding direction.
|
|
;-----------------------------------------------------------
|
|
COERCED:
|
|
BSR.S DCOERCE ; coerce to double precision
|
|
|
|
COERCESDONE:
|
|
BTST #ERRU+8,D6 ; underflow?
|
|
BEQ PACKX ; no; pack extended format
|
|
|
|
MOVE.W A4,D3 ; zero exponent?
|
|
BEQ PACKX ; yes; OK
|
|
|
|
TST.L D4 ; normalized or nonzero?
|
|
BNE.S @3 ; yes
|
|
|
|
TST.L D5
|
|
BNE.S @1 ; unnormalized
|
|
|
|
SUBA.L A4,A4 ; zero (inexact result); zero exponent
|
|
BRA PACKX ; pack extended format
|
|
|
|
@1:
|
|
SUBA.W #1,A4 ; normalize subnormal single/double
|
|
ADD.L D5,D5
|
|
ADDX.L D4,D4
|
|
@3:
|
|
BPL.S @1
|
|
|
|
BRA PACKX ; pack extended format
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Subroutine DCOERCE coerces extended value in A4/D4/D5/D7 to
|
|
; double precision, honoring prescribed rounding direction
|
|
; in environment word (D1.W). Uses D0/D2/A3, clobbers D1
|
|
;-----------------------------------------------------------
|
|
DCOERCE:
|
|
MOVE.L #$3C01,D0 ; double underflow threshold
|
|
SUB.L A4,D0 ; threshold - exponent
|
|
BLE.S @1 ; no underflow
|
|
|
|
BSET #ERRU+8,D6 ; signal underflow
|
|
MOVEA.W #$3C01,A4 ; minimum exponent
|
|
BSR RTSHIFT ; shift
|
|
@1:
|
|
MOVE.L #$07FF,D0 ; low bit mask
|
|
AND.W D5,D0
|
|
ANDI.W #$0F800,D5 ; clr low bits
|
|
LSL.W #5,D0 ; left align round/stickies
|
|
SWAP D0
|
|
TST.L D7 ; stickies from D7
|
|
SNE D0
|
|
MOVE.L D0,D7 ; round/stickies into D7
|
|
|
|
TST.L D7 ; exact result?
|
|
BNE.S @3 ; no
|
|
BCLR #ERRU+8,D6 ; yes. suppress underflow
|
|
BRA.S RNDOVERD
|
|
|
|
@3:
|
|
BSET #ERRX+8,D6 ; signal inexact
|
|
BFTST D1{17:2} ; round to nearest?
|
|
BEQ.S @7 ; yes
|
|
BMI.S @5 ; chop or round downward
|
|
|
|
TST.B D6 ; round toward +°
|
|
BPL.S RNDUPD ; increment significand if positive
|
|
BRA.S RNDOVERD
|
|
|
|
@5:
|
|
BTST #13,D1 ; chop or round toward -°
|
|
BNE.S RNDOVERD ; chop requires no incrementing
|
|
|
|
TST.B D6 ; round toward -°
|
|
BPL.S RNDOVERD
|
|
BRA.S RNDUPD ; increment significand if negative
|
|
|
|
@7:
|
|
ADD.L D7,D7 ; round bit set?
|
|
BCC.S RNDOVERD ; no; significand OK
|
|
|
|
BNE.S RNDUPD ; yes, with stickies, so round up
|
|
|
|
BTST #11,D5 ; halfway case gets bumped if low double
|
|
BEQ.S RNDOVERD ; bit is set
|
|
|
|
RNDUPD:
|
|
MOVEQ #0,D0
|
|
MOVE.L #$00000800,D2
|
|
ADD.L D2,D5 ; bump significand
|
|
ADDX.L D0,D4
|
|
BCC.S RNDOVERD
|
|
|
|
ROXR.L #1,D4 ; if overflow, shift right and bump exponent
|
|
ADDQ.L #1,A4
|
|
|
|
RNDOVERD:
|
|
MOVEA.W #$43FE,A3 ; double overflow exponent threshold
|
|
CMPA.L A4,A3
|
|
BLT.S @9
|
|
|
|
RTS ; no overflow
|
|
|
|
@9: ; double precision overflow
|
|
BSET #ERRO+8,D6 ; signal overflow and inexact
|
|
BSET #ERRX+8,D6
|
|
MOVEA.W #$7FFF,A4 ; store INF initially
|
|
SUB.L D4,D4
|
|
SUB.L D5,D5
|
|
LSR.W #8,D1 ; check rounding direction
|
|
AND.B #RNDMSK,D1
|
|
BNE.S @11
|
|
|
|
RTS ; default rounding returns INF
|
|
|
|
@11:
|
|
CMPI.B #RNDMSK,D1 ; chopping returns double HUGE
|
|
BEQ.S HUGED
|
|
|
|
TST.B D6 ; check sign
|
|
BMI.S @15
|
|
|
|
CMPI.B #RNDUP,D1 ; positive
|
|
BNE.S HUGED ; round down returns double HUGE
|
|
RTS ; round up returns INF
|
|
|
|
@15:
|
|
CMPI.B #RNDDN,D1 ; negative
|
|
BNE.S HUGED ; round up returns double HUGE
|
|
RTS ; round down returns -INF
|
|
|
|
HUGED:
|
|
MOVEQ #-1,D4 ; set maximum double exponent and significand
|
|
MOVEA.L A3,A4
|
|
MOVE.L #$FFFFF800,D5
|
|
|
|
RTS
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Coerce to default (extended) precision, obeying prescribed
|
|
; rounding direction.
|
|
;-----------------------------------------------------------
|
|
COERCEX:
|
|
MOVE.L A4,D0 ; exponent >= 0?
|
|
BPL.S ROUNDX ; yes, not subnormal
|
|
|
|
NEG.L D0 ; underflow; get count
|
|
BSET #ERRU+8,D6 ; signal underflow
|
|
SUBA.L A4,A4 ; zero exponent
|
|
BSR RTSHIFT ; shift significand right
|
|
|
|
ROUNDX:
|
|
TST.L D7 ; exact result?
|
|
BNE.S @1 ; no
|
|
BCLR #ERRU+8,D6 ; yes; suppress underflow
|
|
BRA.S RNDOVERX ; no rounding needed
|
|
|
|
;-----------------------------------------------------------
|
|
; Inexact result: signal and round
|
|
;-----------------------------------------------------------
|
|
@1:
|
|
BSET #ERRX+8,D6 ; signal inexact
|
|
BFTST D1{17:2} ; round to nearest?
|
|
BEQ.S @3 ; yes
|
|
BMI.S @2 ; chop or round downward
|
|
|
|
;-----------------------------------------------------------
|
|
; Round toward +°
|
|
;-----------------------------------------------------------
|
|
TST.B D6 ; bump significand if positive
|
|
BPL.S RNDUPX
|
|
BRA.S RNDOVERX
|
|
|
|
@2:
|
|
BTST #13,D1 ; chop or round downward?
|
|
BNE.S RNDOVERX ; chop requires no rounding
|
|
|
|
;-----------------------------------------------------------
|
|
; Round toward -°
|
|
;-----------------------------------------------------------
|
|
TST.B D6 ; bump significand if negative
|
|
BPL.S RNDOVERX
|
|
BRA.S RNDUPX
|
|
|
|
;-----------------------------------------------------------
|
|
; Default rounding (to nearest)
|
|
;-----------------------------------------------------------
|
|
@3:
|
|
ADD.L D7,D7 ; round bit set?
|
|
BCC.S RNDOVERX ; no; significand OK
|
|
|
|
BNE.S RNDUPX ; stickies set so round up
|
|
BTST #0,D5 ; halfway case gets bumped
|
|
BEQ.S RNDOVERX ; if lowest SIG bit is 1
|
|
|
|
RNDUPX:
|
|
MOVEQ #0,D0 ; increment significand
|
|
ADDQ.L #1,D5
|
|
ADDX.L D0,D4
|
|
BCC.S RNDOVERX
|
|
|
|
ROXR.L #1,D4 ; if overflow, shift right and
|
|
ADDQ.L #1,A4 ; bump exponent
|
|
|
|
;-----------------------------------------------------------
|
|
; Check for overflow result
|
|
;-----------------------------------------------------------
|
|
RNDOVERX:
|
|
MOVEA.W #$7FFF,A3 ; overflow?
|
|
CMPA.L A3,A4
|
|
BLT.S PACKX ; no; stuff result
|
|
|
|
;-----------------------------------------------------------
|
|
; Overflow detected. Return HUGE or INF depending on
|
|
; rounding direction and sign.
|
|
;-----------------------------------------------------------
|
|
BSET #ERRO+8,D6 ; signal overflow and inexact
|
|
BSET #ERRX+8,D6
|
|
MOVEA.W A3,A4 ; set max exp
|
|
SUB.L D4,D4 ; zero significand
|
|
SUB.L D5,D5
|
|
LSR.W #8,D1 ; check rounding direction
|
|
AND.B #RNDMSK,D1
|
|
BEQ.S PACKX ; default returns INF
|
|
|
|
CMPI.B #RNDMSK,D1 ; chopping returns HUGE
|
|
BEQ.S HUGEOUT
|
|
|
|
TST.B D6 ; check sign
|
|
BMI.S @5
|
|
|
|
CMPI.B #RNDUP,D1 ; positive
|
|
BEQ.S PACKX ; round up returns INF
|
|
BRA.S HUGEOUT ; round down returns huge
|
|
|
|
@5:
|
|
CMPI.B #RNDDN,D1 ; negative
|
|
BEQ.S PACKX ; round down returns INF
|
|
|
|
HUGEOUT:
|
|
SUBQ #1,A4 ; exponent = $7FFE
|
|
NOT.L D4 ; set all significand bits
|
|
NOT.L D5
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Pack an extended result into destination address
|
|
;-----------------------------------------------------------
|
|
PACKX:
|
|
MOVE.W A4,D3 ; exponent into D3
|
|
MOVEA.L LKADR1(A6),A3 ; get DST addr
|
|
TST.B D6 ; sign into D3
|
|
BPL.S @1 ; positive
|
|
BSET #15,D3 ; negative
|
|
@1:
|
|
MOVE.W D3,(A3)+ ; stuff result
|
|
BTST #21,D6 ; bump pointer if 96-bit extended
|
|
BEQ.S @2
|
|
|
|
ADDQ #2,A3
|
|
@2:
|
|
MOVE.L D4,(A3)+
|
|
MOVE.L D5,(A3)
|
|
|
|
JMP (A0) ; finish-up routine
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; Finish up and return after stack cleanup. Check for halts here.
|
|
;-----------------------------------------------------------
|
|
FINI2OPS:
|
|
CLR D7 ; clear CCR bits
|
|
FINICMPS:
|
|
MOVEA.W #FPSTATE,A1 ; A1 <- environment addr
|
|
MOVE.W (A1),D0 ; get environment word
|
|
CLR.B D6 ; kill signs
|
|
OR.W D6,D0 ; OR in new exceptions
|
|
MOVE.W D0,(A1)+ ; store new exceptions and bump A1 pointer
|
|
LSR.W #8,D6 ; align exceptions with trap enables
|
|
AND.W D6,D0
|
|
BNE.S HALT2OP ; halt enabled
|
|
|
|
FINISH2:
|
|
MOVE D7,CCR ; prepare CCR
|
|
MOVEM.L (SP)+,D0-D7/A0-A4 ; restore registers
|
|
UNLK A6 ; unlink
|
|
RTD #STKREM2 ; return, popping parameters
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; TO SET UP FOR TRAP:
|
|
; HAVE D0 ON TOP OF STACK.
|
|
; PUSH CCR TO HAVE 3-WORD STRUCTURE
|
|
; PUSH ADDRESS OF 3-WORD STRUCTURE
|
|
; BLOCK MOVE OPCODE < ADR1 < ADR2 < ADR3 < REGADR
|
|
; TO STACK
|
|
; CALL HALT PROCEDURE, EXPECTING PASCAL CONVENTIONS TO
|
|
; BE HONORED.
|
|
; THE BLOCK MOVE CAN BE DONE WITH A PAIR OF MOVEM'S SO LONG
|
|
; AS AN EXTRA WORD IS COPIED (TO HAVE A WHOLE NUMBER OF
|
|
; LONGS).
|
|
;-----------------------------------------------------------
|
|
HALT2OP:
|
|
LEA FINISH2,A4
|
|
HALTCOMMON:
|
|
MOVE.W D7,-(SP) ; push pending CCR
|
|
MOVE.W D0,-(SP) ; push halt exceptions
|
|
PEA (SP) ; ADDRESS OF CCR/D0
|
|
|
|
MOVEM.L LKRET+2(A6),D0-D3 ; PUSH ADDRESSES & OPCODE ON STACK
|
|
MOVEM.L D0-D3,-(SP)
|
|
ADDQ #2,SP ; adjust SP to point to opcode
|
|
|
|
MOVEA.L (A1),A1 ; CALL USER HALT HANDLER
|
|
JSR (A1)
|
|
|
|
MOVE.L (SP)+,D7 ; RESTORE CCR BITS AND STACK
|
|
JMP (A4)
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
FINI1OP:
|
|
MOVEA.W #FPSTATE,A1
|
|
CLR D7
|
|
MOVE.W (A1),D0 ; GET STATE WORD
|
|
CLR.B D6 ; KILL SIGNS
|
|
OR.W D6,D0
|
|
MOVE.W D0,(A1)+ ; BUMP ADRS TO VECTOR
|
|
ROR.W #8,D6 ; ALIGN BYTES
|
|
AND.W D6,D0
|
|
BNE.S HALT1OP ; ZERO IF NO TRAP
|
|
FINISH1:
|
|
MOVE D7,CCR
|
|
MOVEM.L (SP)+,D0-D7/A0-A4
|
|
UNLK A6
|
|
RTD #STKREM1
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
HALT1OP:
|
|
LEA FINISH1,A4
|
|
BRA.S HALTCOMMON
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; These routines handle the special cases in operations
|
|
; when the DST operand is the exact extended result.
|
|
; Subcase depends on whether the sign should also be stuffed.
|
|
; (The SRC-is-result case is always trivial).
|
|
;-----------------------------------------------------------
|
|
RDSTSGN:
|
|
ADD.B D6,D6 ; shift DST sign to bit 7
|
|
RDST:
|
|
MOVE.L A2,D5
|
|
MOVE.L D3,D4
|
|
MOVEA.L A3,A4 ; exponent, too
|
|
BRA PACKX ; coerce and pack result
|
|
|
|
|