Macintosh-SW/mac-rom
1
0
Fork 0
mirror of https://github.com/elliotnunn/mac-rom.git synced 2024-11-03 05:04:29 +00:00
Code Issues Projects Releases Wiki Activity
283a0c5ba8
mac-rom/Toolbox/SANE/FPOps.a

1820 lines
52 KiB
Plaintext
Raw Normal View History

Bring in CubeE sources Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
2017-09-17 09:09:04 +00:00
;
; File: FPOps.a
;
; Contains: Floating Point Stuff
;
; Written by: Jerome T. Coonen
;
; Copyright: <09> 1982-1990 by Apple Computer, Inc., all rights reserved.
;
; This file is used in these builds: Mac32
;
; Change History (most recent first):
;
; <4> 9/17/90 BG Removed <2>, <3>. 040s are behaving more reliably now.
; <3> 7/4/90 BG Missed a spot to add an EclipseNOP.
; <2> 7/4/90 BG Added EclipseNOPs for flakey 040s.
; <1.1> 11/11/88 CCH Fixed Header.
; <1.0> 11/9/88 CCH Adding to EASE.
; <1.0> 2/12/88 BBM Adding file for the first time into EASE<53>
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPADD
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 02JUL82: WRITTEN J. COONEN
; 12AUG82: TIDIED UP (JTC)
; 01SEP82: RND MODE ENCODINGS CHANGED (JTC)
; 12DEC82: PROJ MODE OUT (JTC)
; 14JAN85: MDS (JTC)
; 01AUG85: BACK TO WORKSHOP (JTC)
;
; ASSUME REGISTER MASK: DO-ARITHMETIC
;-----------------------------------------------------------
;-----------------------------------------------------------
; TO SUBTRAC JUST FLIP THE SIGN AND XOR-SIGN BITS IN D6.B.
;-----------------------------------------------------------
SUBTOP:
BLANKS ON
STRING ASIS
EORI.B #$A0,D6 ; BITS #7 AND #5
ADDTOP:
IF PCOK THEN
MOVE.W ADDCASE(PC,D3),D3 ; INDEX TO D3
JMP ADDTOP(PC,D3) ; CALL SPECIAL CASE
ELSE
MOVE.W ADDCASE(D3),D3
JMP ADDTOP(D3)
ENDIF
ADDCASE: ; DST + SRC
DC.W ADDNUM-ADDTOP ; NUM + NUM
DC.W ADDS0-ADDTOP ; NUM + 0
DC.W RSRC-ADDTOP ; NUM + INF
DC.W ADDD0-ADDTOP ; 0 + NUM
DC.W ADD00-ADDTOP ; 0 + 0
DC.W RSRC-ADDTOP ; 0 + INF
DC.W RDSTSGN-ADDTOP ; INF + NUM
DC.W RDSTSGN-ADDTOP ; INF + 0
DC.W ADDINF-ADDTOP ; INF + INF
;-----------------------------------------------------------
; ADD 2 FINITE NUMBERS HAS TWO SPECIAL CASES, WHEN ONE OF
; THE SRC OR DST IS 0. IN THAT CASE JUST BE SURE NONZERO
; OPERAND IS PLACED IN RESULT BUFFER, TO BE SUBJECT TO THE
; COERCION TO THE DESTINATION.
;-----------------------------------------------------------
ADDNUM:
;-----------------------------------------------------------
; FIRST ALIGN SO "LARGER" EXP IN A4, LARGER SIGN IN D6.#7
; "SMALLER" DIGITS ARE IN D4,5 FOR SHIFTING; "LARGER" DIGITS
; ARE IN D3,A2 (CANNOT USE A1 SINCE NEED TO ADDX.L.
; ASSUME SRC IS "LARGER", SO SWAP ITS DIGS WITH DST.
;-----------------------------------------------------------
MOVE.L D4,D3 ; CAN'T ADDX FROM A REGS
MOVE.L A1,D4
EXG D5,A2
MOVE.W A4,D0 ; SEXP, WORD IS ENOUGH
SUB.W A3,D0 ; SEXP - DEXP
BEQ.S @3 ; NO SHIFT IF EXP'S =
BGT.S @1 ; JUST SHIFT DST IN D4,5
;-----------------------------------------------------------
; DST IS LARGER:
; AS PART OF SWAP, MUST MOVE DST SIGN TO LEAD BIT OF D7 BYTE
; BUT WITHOUT MOVING THE XOR, WHICH WILL BE TESTED...
;-----------------------------------------------------------
EXG D5,A2 ; SWAP LO BITS
EXG D4,D3 ; SWAP HI BITS
NEG.W D0 ; TRUE SHIFT COUNT
MOVEA.L A3,A4 ; LARGER EXP
ADD.B D6,D6 ; SHIFT SRC SIGN OUT
ASR.B #1,D6 ; RESTORE X0R TO PLACE
@1:
BSR RTSHIFT
@3:
;-----------------------------------------------------------
; OPERANDS ARE NOW ALIGNED. TEST FOR +/- AND DO IT.
;-----------------------------------------------------------
BTST #5,D6 ; TEST XOR OF SIGNS
BNE.S SUBMAG
;-----------------------------------------------------------
; ADD MAGNITUDE: ADD THE WORDS AND CHECK FOR CARRY-OUT.
;-----------------------------------------------------------
ADD.L A2,D5
ADDX.L D3,D4
BCC.S @15
ROXR.L #1,D4 ; ADJUST RIGHT
ROXR.L #1,D5
ROXR.W #1,D7 ; NO STICKIES CAN BE LOST
ADDQ.L #1,A4 ; BUMP EXP
@15:
BRA COERCE
;-----------------------------------------------------------
; SIMPLIFY BY SUBTRACTING LARGE OP IN D3,A2 FROM SMALL IN
; D4,5,7 AND THEN CHECKING FOR SPECIAL CASES. IF ZERO, JUMP
; OUT TO 0+0 CODE. IF GREATER, FLIP SIGN. IF LESS (USUAL)
; JUST NEGATE.
;-----------------------------------------------------------
SUBMAG:
NOT.B D6 ; ASSUME >, WITH SIGN CHG
SUB.L A2,D5
SUBX.L D3,D4
BEQ.S ZEROSUM ; STORE ZERO WITH SIGN
BCC.S @7 ; GOT IT RIGHT
NEG.W D7 ; FLIP DIGITS
NEGX.L D5
NEGX.L D4
NOT.B D6 ; FLIP SIGN BACK
@7:
BRA NORMCOERCE
;-----------------------------------------------------------
; NOW SET EXP=0 AND FIX SIGN ACCORDING TO ROUNDING MODE.
; IN THE SPECIAL CASE OF TWO 0'S, AVOID THE UNDERFLOW
; COERCION WILL SIGNAL IN S/D RESTRICTION.
;-----------------------------------------------------------
ADD00:
BTST #5,D6 ; SAME SIGN?
BEQ.S ADDQ00 ; YES, EASY
ZEROSUM:
SUBA.L A4,A4 ; 0 EXP
CLR.B D6 ; ASSUME POSITIVE
BTST #RNDHI,(A0) ; 10 -- RND MINUS
BEQ.S ADDQ00
BTST #RNDLO,(A0)
BNE.S ADDQ00
NOT.B D6 ; MAKE NEG
ADDQ00:
RTS ; DON'T COERCE 0
;-----------------------------------------------------------
; IF DST=0, HAVE RES=SRC. BUT IF SRC=0 MUST SET RES=DST.
; THESE CASES AVOID EXTRANEOUS SHIFTING OF ZERO OPERAND.
;-----------------------------------------------------------
ADDS0:
MOVE.L A2,D5 ; LO DIGS
MOVE.L A1,D4 ; HI DIGS
MOVE.L A3,A4 ; EXP
ADD.B D6,D6 ; SIGN
ADDD0:
BRA COERCE
;-----------------------------------------------------------
; SINCE PROJECTIVE MODE OUT,
; SUM OF TWO INFS ALWAYS DEPENDS UPON THEIR SIGNS.
;-----------------------------------------------------------
ADDINF:
BTST #5,D6 ; SAME SIGN?
BNE.S @25
RTS
@25:
MOVEQ #nanadd,D0 ; MARK ERROR
BRA INVALIDOP
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPMUL
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 07JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: MULU32 ROUTINE TIGHTENED.
; 09JUN83: DON'T USE A5 AS TEMP CELL.
; 14JAN85: MDS (JTC)
;
;-----------------------------------------------------------
MULTOP:
ROL.B #2,D6 ; GET XOR SIGNS
MOVEQ #nanmul,D0 ; ASSUME THE WORST
IF PCOK THEN
MOVE.W MULCASE(PC,D3),D3
JMP MULTOP(PC,D3)
ELSE
MOVE.W MULCASE(D3),D3
JMP MULTOP(D3)
ENDIF
MULCASE: ; DST * SRC
DC.W MULNUM-MULTOP ; NUM * NUM
DC.W RSRC-MULTOP ; NUM * 0
DC.W RSRC-MULTOP ; NUM * INF
DC.W RDST-MULTOP ; 0 * NUM
DC.W RSRC-MULTOP ; 0 * 0
DC.W INVALIDOP-MULTOP ; 0 * INF
DC.W RDST-MULTOP ; INF * NUM
DC.W INVALIDOP-MULTOP ; INF * 0
DC.W RSRC-MULTOP ; INF * INF
MULNUM:
;-----------------------------------------------------------
; HAVE: X.XXXXX * Y.YYYYYY --> ZZ.ZZZZZZZ BEFORE
; NORMALIZATION AND COERCION. SO SUBTRACT (BIAS-1) TO
; ACCOUNT FOR BINARY POINT ONE BIT TO RIGHT. FOR EXAMPLE,
; 1 * 1 COMES OUT: 2^1 * 0.10000000... WHICH IN TURN
; IS NORAMALIZED TO 2^0 * 1.000000...
;-----------------------------------------------------------
ADDA.L A3,A4 ; ADD EXP'S
SUBA.W #$3FFE,A4 ; SUBTRACT (BIAS - 1)
;-----------------------------------------------------------
; MULTIPLY IS A REGISTER HOG, BECAUSE OF THE FINAGLING
; NEEDED TO GET A FULL 32*32 MULTIPLY (SHAME ON MOTOROLA).
; SAVE D6 AND A0 ON THE STACK TO FREE THE SPACE.
;
; 64*64 MULTIPLY IS ACCOMPLISHED IN 4 32*32 PRODUCTS.
; SPECIAL PROVISION IS MADE FOR THE TWO SPECIAL CASES:
; BOTH OPERANDS HAVE 32 TRAILING 0'S, SRC OPERAND HAS
; 32 TRAILING 0'S.
;
; THE BASIC REGISTER MASK THROUGHOUT: IS
; A0: CARRY PROPAGATE FOR 64-BIT CROSS PRODUCTS
; A1,A2: DST BITS
; A3,(SP): SRC BITS
; A4: RESULT EXPONENT
; D0,D1: USED TO PASS OPERANDS TO 32*32 MULT
; D2,3,6: JUNK
; D4,5,7: 64 PRODUCT AND ROUND BITS
;-----------------------------------------------------------
MOVEM.L D5-D6/A0,-(SP) ; SAVE TWO REGS AND SRC.LO
MOVEA.L D4,A3 ; PLACE SRC.HI BITS
CLR.L D4 ; CLEAR ALL BITS
MOVE.L D4,D5
MOVEA.L D4,A0
MOVE.L (SP),D1 ; SRC LOW BITS
BNE.S SRC64 ; GO TO IT IF WIDE
MOVE.L A2,D0 ; DST LOW BITS
BEQ.S BOTH32 ; JUST 32*32 PRODUCT
BRA.S SRC32 ; 64*32
SRC64:
MOVE.L A2,D0 ; DST LOW BITS
BSR.S MULU32
TST.L D5 ; RIGHT ALIGN LOW PROD
SNE D7 ; STICKIES
MOVE.L D4,D5
CLR.L D4
MOVE.L (SP),D1 ; SRC LOW BITS
MOVE.L A1,D0 ; DST HI BITS
BSR.S MULU32
SRC32:
MOVE.L A3,D1 ; SRC HI BITS
MOVE.L A2,D0 ; DST LO BITS
BSR.S MULU32
TST.W D5 ; MORE STICKIES
SNE D0
OR.B D0,D7 ; ON TOP OF EARLIER
SWAP D5
OR.W D5,D7
MOVE.L D4,D5
MOVE.L A0,D4
BOTH32:
MOVE.L A3,D1 ; SRC HI
MOVE.L A1,D0 ; DST HI
BSR.S MULU32
MOVEM.L (SP)+,D0/D6/A0 ; RESTORE REGS D6,A0; D0 JUNK
BRA NORMCOERCE
;-----------------------------------------------------------
; 32 BY 32 MULTIPLY AND ADD INTO D4,D5 WITH CARRY TO A0.
; D0,D1 ARE INPUT OPERANDS, D2,D3,D6 ARE SCRATCH.
; EASIEST TO VIEW PRODUCT AS D0=AB, D1=XY SO THAT:
; A B
; * X Y
; ------
; B--Y
; A--Y
; B--X
; + A--X
; ------------
; ????????
;-----------------------------------------------------------
MULU32:
MOVE.W D1,D2 ; Y
MOVE.W D1,D3 ; Y
MULU D0,D2 ; D2 = B--Y
MOVE.W D0,D6 ; B
SWAP D0 ; A
SWAP D1 ; X
MULU D1,D6 ; D6 = B--X
MULU D0,D3 ; D3 = A--Y
MULU D0,D1 ; D1 = A--X
;-----------------------------------------------------------
; STRATEGY: COMPUTE 64-BIT PRODUCT INTO D1,D2. THE CROSS
; TERMS INVOLVE SUMS OF THREE 16-BIT QUANTITIES, SO MUST BE
; CAREFUL OF CARRIES.
;
; FIRST ADD (B--Y).HI INTO (A--Y). SINCE THE LATTER CAN
; BE AT MOST $FFFE0001, THERE CANNOT BE A CARRY FROM THE
; HIGHEST BIT.
;-----------------------------------------------------------
SWAP D2 ; RIGHT ALIGN (B--Y).HI
CLR.L D0
MOVE.W D2,D0 ; (B--Y).HI PADDED LEFT WITH 0'S
ADD.L D0,D3 ; CANNOT CARRY OUT OF (A--Y)
;-----------------------------------------------------------
; NOW ADD THE OTHER 32-BIT CROSS-TERM, (B--X), INTO D3 AND
; ALIGN LO HALF OF SUM INTO D2. THE CARRY IS RECORDED, AND
; KEPT, IN THE CCR X BIT.
;-----------------------------------------------------------
ADD.L D6,D3 ; (A--Y) + (B--X) + (B--Y).HI
MOVE.W D3,D2
SWAP D2 ; LO ORDER 32 BITS OF PRODUCT
;-----------------------------------------------------------
; NOW REPLACE THE LOW HALF OF THE ABOVE SUM WITH THE CARRY
; BIT, REALIGN, AND ADD INTO (A--X) FOR HI 32 BITS OF PROD.
;-----------------------------------------------------------
CLR.W D3
ADDX.W D3,D3 ; X BIT FROM "ADD.L D6,D3" ABOVE
SWAP D3
ADD.L D3,D1 ; HI 32 BITS OF PRODUCT
;-----------------------------------------------------------
; ACCUMULATE PRODUCT INTO D4,D5 WITH CARRY IN A0.
;-----------------------------------------------------------
ADD.L D2,D5
ADDX.L D1,D4
BCC.S @1
ADDQ.W #1,A0
@1:
RTS
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPDIV
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: SINGLE CASE FIXED UP (JTC)
; 14JAN85: MDS (JTC)
;
; ASSUME REGISTER MASK: DO-ARITHMETIC
;-----------------------------------------------------------
DIVTOP:
ROL.B #2,D6 ; GET XOR SIGNS
MOVEQ #nanDIV,D0 ; JUST IN CASE...
IF PCOK THEN
MOVE.W DIVCASE(PC,D3),D3
JMP DIVTOP(PC,D3)
ELSE
MOVE.W DIVCASE(D3),D3
JMP DIVTOP(D3)
ENDIF
DIVCASE: ; DST / SRC
DC.W DIVNUM-DIVTOP ; NUM / NUM
DC.W DIVBY0-DIVTOP ; NUM / 0
DC.W DIVBYI-DIVTOP ; NUM / INF
DC.W RDST-DIVTOP ; 0 / NUM
DC.W INVALIDOP-DIVTOP ; 0 / 0
DC.W RDST-DIVTOP ; 0 / INF
DC.W RDST-DIVTOP ; INF / NUM
DC.W RDST-DIVTOP ; INF / 0
DC.W INVALIDOP-DIVTOP ; INF / INF
;-----------------------------------------------------------
; DIV BY ZERO: SET THE ERROR BIT, STUFF INF, RET.
;-----------------------------------------------------------
DIVBY0:
BSET #ERRZ+8,D6
MOVEA.W #$7FFF,A4 ; BIG EXP
CLR.L D4 ; ZERO DIGS
MOVE.L D4,D5
RTS
;-----------------------------------------------------------
; DIV BY INF: STORE 0 AND RET.
;-----------------------------------------------------------
DIVBYI:
SUBA.L A4,A4 ; ZERO EXP
MOVE.L A4,D4 ; AND DIGS...
MOVE.L D4,D5
RTS
;-----------------------------------------------------------
; DIVIDING NUMBERS INVOLVES THE RESTORING DIVIDE ALGORITHM
; SHARED WITH REMAINDER BIN->BCD CONVERSION. TO EXPEDITE
; SINGLE CASES, TEST FOR COERCION WITH SHORT OPERANDS.
;-----------------------------------------------------------
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: 65+1 QUO BITS, FIRST IS 0, 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.
;-----------------------------------------------------------
MOVEQ #65,D0 ; QUO BIT COUNT
;-----------------------------------------------------------
; FOR SINGLE OPERATIONS, COMPUTE JUST 32 OR 33 (WITH LEAD 0)
; BITS, THEN SWAP D4,D5.
;-----------------------------------------------------------
TST.L D6 ; SINGLE OPERATION? (#OPSGL)
BPL.S @3
MOVEQ #33,D0
@3:
CMP.L A1,D4 ; DVR - DVD
BNE.S @5
CMP.L A2,D5
@5:
BLS.S @7 ; DVR <= DVD
ADDQ.W #1,D0 ; GET ONE MORE QUO BIT
SUBQ.L #1,A4 ; DECREMENT EXP
@7:
;-----------------------------------------------------------
; SET UP 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
;-----------------------------------------------------------
MOVE.L A1,D1 ; DVD HI
MOVE.L A2,D2 ; DVD LO
MOVE.L D4,D3 ; DVR HI
MOVEA.L D5,A2 ; DVR LO
;-----------------------------------------------------------
; FOR SINGLE ONLY OPERATIONS, MAY WANT TO TEST FOR TRAILING
; ZEROS AND RUN SHORTER LOOP.
;-----------------------------------------------------------
BSR.S RESTORE
;-----------------------------------------------------------
; RETURN WITH REMAINDER IN D1,2 AND SHIFTED QUO IN D4,5.
; FIRST ADJUST QUO, THEN TEST REMAINDER FOR STICKY.
; IN CASE OF SINGLE OPERATION, LEFT ALIGN 32-BIT QUO, AND
; THROW AWAY LEAD BIT IN D4.0.
;-----------------------------------------------------------
TST.L D6 ; CHEAP #OPSGL
BPL.S @9
MOVE.L D5,D4
CLR.L D5
@9:
MOVE #$10,CCR ; SET X BIT
ROXR.L #1,D4
ROXR.L #1,D5
ROXR.W #1,D7
OR.L D2,D1 ; OR OF ALL REM BITS
SNE D7 ; SET STICKIES
BRA COERCE
;-----------------------------------------------------------
; 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:
CLR.L 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
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPREM
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 07JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP. (JTC)
; 12OCT82: RETURN QUO TO D0 FIXED. (JTC)
; 12DEC82: ONLY PLACE WHERE D0.W MODIFIED (JTC)
; 05AUG83: FIX BUG IN QUOTIENT WHEN SIGN MUST BE ADJUSTED (JTC)
; 14JAN85: MDS (JTC)
;
; ******** 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.
;
; MUST BE CAREFUL IN CALLING THE RESTORING DIVISION
; ALGORITHM. IN THE WORST CASE OF EXTENDED OPERANDS:
; HUGE / DENORMALIZED
; THE EXPONENT DIFFERENCE IN D0 WILL BE OF THE FORM:
; 7FFF - NEGATIVE > 8000
; IN MAGNITUDE, WHICH SAYS THE EXPONENT DIFFERENCE,
; WHEN VIEWED AS A WORD, MUST BE TAKEN AS A
; MAGNITUDE.
;
; ASSUME THE MASK: DO-ARITHMETIC, WITH D7=0 FOR THE
; CCR AND ROUND INFO.
;
; SOME ASSUMPTIONS ABOUT THE STACK ARE NECESSARY.
; WHEN THE REGISTERS WERE SAVED WITH MOVEM.L, D0 WAS
; LEFT NEAREST THE TOP OF THE STACK. ALL THAT IS ABOVE
; IT NOW IS THE RETURN ADDRESS, "PREPACK:" IN FPCONTROL.
; THUS DO.W, WHICH GETS THE INTEGER QUOTIENT, IS AT 6(SP).
;-----------------------------------------------------------
;-----------------------------------------------------------
; DO SOME BOOKKEEPING FIRST. PLACE DEFAULT 0 QUO IN D0.
; ASSUME THE RESULT WILL HAVE DST SIGN, AND NOTE THAT QUO
; SIGN IS MOVED TO BIT #6 OF D6.
; AND STORE ERROR CODE IN D0 IN CASE OF INVALID.
;
; P754 REQUIRES THAT THE PRECISION CONTROL BE DISABLED HERE.
;-----------------------------------------------------------
REMTOP:
CLR.W 6(SP) ; QUO SET TO 0
ADD.B D6,D6 ; ALIGN DST SIGN, MOVING QUO
MOVEQ #nanREM,D0 ; ASSUME THE WORST...
ANDI.L #$3FFFFFFF,D6 ; SET DST TO EXT'D
IF PCOK THEN
MOVE.W REMCASE(PC,D3),D3
JMP REMTOP(PC,D3)
ELSE
MOVE.W REMCASE(D3),D3
JMP REMTOP(D3)
ENDIF
REMCASE: ; DST / SRC
DC.W REMNUM-REMTOP ; NUM / NUM
DC.W INVALIDOP-REMTOP ; NUM / 0
DC.W REMDST-REMTOP ; NUM / INF
DC.W RDST-REMTOP ; 0 / NUM
DC.W INVALIDOP-REMTOP ; 0 / 0
DC.W RDST-REMTOP ; 0 / INF
DC.W INVALIDOP-REMTOP ; INF / NUM
DC.W INVALIDOP-REMTOP ; INF / 0
DC.W INVALIDOP-REMTOP ; INF / INF
;-----------------------------------------------------------
; DEXP - SEXP + 1 = NUMBER OF INTEGER QUO BITS. GET ONE
; MORE TO AID IN ROUNDING. CASES ON (DEXP - SEXP + 2):
; > 0 -- RUN 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 #2,D0
SUB.L A4,D0 ; DEXP - SEXP + 2
BGT.S REMDIV ; MUST DO IT ALL...
REMDST:
MOVE.L A1,D4 ; RESULT IS DST
MOVE.L A2,D5
MOVEA.L A3,A4
BRA.S REMFIN
;-----------------------------------------------------------
; SET TENTATIVE REM EXP TO SEXP-1, SINCE REM WILL BE REDUCED
; TO AT MOST HALF OF SRC. THEN OFF TO RESTORE WITH ITS
; REGISTER MASK:
; D0: MAGNITUDE COUNT D1,D2: DIVIDEND
; D4,D5: QUOTIENT D3,A2: DIVISOR
;-----------------------------------------------------------
REMDIV:
SUBQ.L #1,A4
MOVE.L A1,D1 ; DST IS DIVIDEND
MOVE.L A2,D2
MOVE.L D4,D3 ; SRC IS DIVISOR
MOVEA.L D5,A2
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.
;-----------------------------------------------------------
BTST #0,D5 ; LOW QUO BIT
BEQ.S REMQUO ; 0 --> JUST STUFF QUO
TST.L D1
BNE.S @3 ; CASE 3
TST.L D2
BNE.S @3 ; CASE 3
BTST #1,D5 ; CASE 2 DECIDED ON LO INT
BEQ.S @5 ; IF EVEN, LEAVE QUO BUT SET REM
@3:
BCHG #7,D6 ; FLIP REM SIGN
ADDQ.W #2,D5 ; INCREMENT QUO BY 1 (IN SECOND BIT)
@5:
EXG D2,A2 ; SWAP DVR AND REM
EXG D1,D3
SUB.L A2,D2 ; DVR - REM
SUBX.L D3,D1
;-----------------------------------------------------------
; NOW EXTRACT LOW 7 INTEGER BITS (REMEMBER GOT FIRST FRAC),
; NEGATE IF NECESSARY, EXTEND TO WORD, AND STORE.
;-----------------------------------------------------------
REMQUO:
LSR.B #1,D5 ; KILL FRAC BIT
BTST #6,D6 ; TEST QUO SIGN
BEQ.S @9
NEG.B D5
@9:
EXT.W D5 ; EXTEND SIGNED BYTE TO WORD
MOVE.W D5,6(SP) ; STORE IN SAVED D0.W
MOVE.L D1,D4 ; STUFF REM BITS
MOVE.L D2,D5
REMFIN:
BRA ZNORMCOERCE ; STORE THE RESULT
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPCMP
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP (JTC)
; 12DEC82: PROJ MODE OUT (JTC)
; 14JAN85: MDS (JTC)
;
; WITH ALL NUMBERS NORMALIZED, COMPARISONS ARE QUITE EASY.
; THE TRICK IS TO PICK UP THE UNORDERED CASES FROM NAN
; COERCIONS AND TO AVOID FLOATING COERCIONS (SINCE THE ONLY
; RESULT IS A CCR VALUE).
;-----------------------------------------------------------
;-----------------------------------------------------------
; DO A JSR RATHER THAN JMP TO SPECIAL CASE ROUTINES IN ORDER
; TO TIDY UP END CASES: EXPECT CCR SETTING IN D0.W.
; AT END: MOVE FROM D0.LO TO D7.HI AND SIGNAL INVALID
; IN CMPX ON UNORD.
;-----------------------------------------------------------
CMPTOP:
IF PCOK THEN
MOVE.W CMPCASE(PC,D3),D3
ELSE
MOVE.W CMPCASE(D3),D3
ENDIF
IF PCOK THEN
JSR CMPTOP(PC,D3)
ELSE
JSR CMPTOP(D3)
ENDIF
CMPFIN: ; PICK UP HERE FROM NANS
CMPI.W #CMPU,D0 ; UNORDERED?
BNE.S @1
BTST #OPIFCPX+16,D6 ; CHECK WHETHER TO BARF
BEQ.S @1
BSET #ERRI+8,D6
@1:
MOVE.W D0,D7 ; ALIGN CCR BITS IN D7.HI
SWAP D7
RTS
;-----------------------------------------------------------
; WITH PROJ MODE OUT SEVERAL CASES COLLAPSE:
; NUM - INF --> 0 - NUM
; INF - NUM --> NUM - 0
;
;-----------------------------------------------------------
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 ; O - NUM
DC.W CMP0-CMPTOP ; 0 - 0
DC.W CMPD0-CMPTOP ; 0 - INF
DC.W CMPS0-CMPTOP ; INF - NUM
DC.W CMPS0-CMPTOP ; INF - 0
DC.W CMPINF-CMPTOP ; INF - INF
;-----------------------------------------------------------
; NUM VS. 0: DISGUISE AS (0 VS. -NUM) AND FALL THROUGH.
;-----------------------------------------------------------
CMPS0:
ADD.B D6,D6 ; DST SGN -> SRC SLOT
NOT.B D6
;-----------------------------------------------------------
; 0 VS. NUM: SIGN OF NUM DETERMINES >.
;-----------------------------------------------------------
CMPD0:
MOVEQ #CMPG,D0 ; ASSUME >
TST.B D6 ; TST SRC SIGN
BMI.S @1
MOVEQ #CMPL,D0 ; 0 < POSITIVE
@1:
RTS
;-----------------------------------------------------------
; INF VS. INF: EITHER =, OR SAME AS 0 VS. NUM.
;-----------------------------------------------------------
CMPINF:
BTST #5,D6 ; EQ -> SIGNS =
BNE.S CMPD0
CMP0:
MOVEQ #CMPE,D0
RTS
;-----------------------------------------------------------
; NUM VS. NUM: IF SIGNS DIFFER, SAME AS 0 VS. NUM.
; IF SAME JUST COMPARE THE WORDS, TAKING ACCOUNT FOR COMMON
; SIGN.
;-----------------------------------------------------------
CMPNUM:
BTST #5,D6 ; NE -> TRIVIAL
BNE.S CMPD0
CMPA.L A4,A3 ; DST - SRC EXP'S
BGT.S @1
BLT.S @2
CMPA.L D4,A1 ; DST.HI - SRC.HI
BHI.S @1 ; HI -> UNSIGNED GREATER
BCS.S @2 ; CS -> UNSIGNED LESS
CMPA.L D5,A2
BEQ.S CMP0 ; THEY ARE =
BCS.S @2
;-----------------------------------------------------------
; THEY'RE > UNLESS NEGATIVE.
;-----------------------------------------------------------
@1:
NOT.B D6
;-----------------------------------------------------------
; THEY'RE < UNLESS NEGATIVE.
;-----------------------------------------------------------
@2:
MOVEQ #CMPL,D0
TST.B D6
BPL.S @21
MOVEQ #CMPG,D0
@21:
RTS
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPCVT
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP (JTC)
; 13OCT82: CHANGE INVALID SIGNALS ON EXT --> COMP (JTC).
; 28DEC82: FIX CASE OF LEFT SHIFT IN IALIGN (JTC).
; 29DEC82: FIX BUG IN FORCING CHOP MODE. (JTC)
; 30DEC82: UNFIX 28DEC82 FIX -- UNNECESSARY (JTC).
; 14JAN85: MDS (JTC)
;
;-----------------------------------------------------------
;-----------------------------------------------------------
; CONVERSIONS TO EXTENDED ARE TRIVIAL, REQUIRING COERCION
; ONLY FOR FINITE, NONZERO VALUES
;-----------------------------------------------------------
CVT2E:
TST.W D3 ; IS IT 0 OR INF?
BEQ COERCE ; COERCE IF NOT
RTS
;-----------------------------------------------------------
; ROUND TO INTEGER REQUIRES RIGHT ALIGNMENT FOR TINIES,
; NOTHING FOR LARGE, 0, OR INF VALUES
;-----------------------------------------------------------
RINT:
TST.W D3 ; 0 OR INF?
BEQ.S @1
RTS ; SKIP IF 0 OR INF
@1:
BSR.S IPALIGN ; ALIGN BIN PT AT RIGHT
MOVEA.W (A0),A2 ; SAVE MODES, ARTIFICIALLY
BRA.S COMINT
;-----------------------------------------------------------
; TRUNC TO INTEGER REQUIRES RIGHT ALIGNMENT FOR TINIES,
; NOTHING FOR LARGE, 0, OR INF VALUES
;-----------------------------------------------------------
TINT:
TST.W D3 ; 0 OR INF?
BEQ.S @1
RTS ; SKIP IF 0 OR INF
@1:
;-----------------------------------------------------------
; NOW FAKE CHOP MODE BITS, BUT BE CAREFUL NOT TO LOSE
; ERROR FLAGS OR OLD MODE.
; BUG: CHOP CHANGED FROM 01 TO 11 AT LAST MINUTE IN DESIGN,
; BUT CHANGE WAS MISSED HERE.
;-----------------------------------------------------------
BSR.S IPALIGN ; ALIGN BIN PT AT RIGHT
MOVEA.W (A0),A2 ; SAVE MODES ETC.
BSET #RNDHI,(A0) ; CHOP = 11
BSET #RNDLO,(A0)
COMINT:
BSR COERCE ; COERCE, MAYBE 0
MOVE.W A2,(A0) ; RECALL MODES
;-----------------------------------------------------------
; AFTER COERCE MAY HAVE 0, UNNORM, OR NORMALIZED.
;-----------------------------------------------------------
TST.L D4 ; IF NORMALIZED, ALL SET
BMI.S @9
BNE.S @5
TST.L D5
BNE.S @5
SUBA.L A4,A4 ; SET TO 0
BRA.S @9
@5:
SUBQ.L #1,A4
ADD.L D5,D5
ADDX.L D4,D4
BPL.S @5
@9:
RTS
;-----------------------------------------------------------
; IPALIGN SETS UP BINARY POINT NO FURTHER RIGHT THAN 24,
; 53, 64 BITS AS SPECIFIED BY THE COERCION INFO.
;-----------------------------------------------------------
IPALIGN:
TST.L D6 ; IS IT SINGLE? (#SPREC)
BMI.S @1
BTST #DPREC+16,D6 ; IS IT DOUBLE
BEQ.S IALIGN ; USUAL EXTD CASE
MOVEQ #52,D0
BRA FINALIGN
@1:
MOVEQ #23,D0
BRA FINALIGN
IALIGN:
MOVEQ #63,D0
FINALIGN:
ADDI.W #$3FFF,D0
MOVE.W D0,D1 ; SAVE POSSIBLE NEW EXP
SUB.L A4,D0 ; INTEXP - EXP
BGT.S @7
RTS ; RETURN LE IF TOO BIG
@7:
MOVEA.W D1,A4 ; PLACE NEW EXP
BSR RTSHIFT
MOVE #0000,CCR ; FUDGE CCR = GT
RTS
;-----------------------------------------------------------
; CONVERSIONS FROM EXTENDED ARE MORE COMPLICATED, IF THE
; RESULT IS INTXX OR COMP64, BECAUSE OF THE OVERFLOW CASES.
;-----------------------------------------------------------
CVTE2:
BTST #DSTINT+16,D6 ; 1 -> INTEGER
BEQ.S CVT2E ; AS ABOVE FOR FLOATS
;-----------------------------------------------------------
; FIRST BYPASS O, INF CASES.
;-----------------------------------------------------------
CMPI.W #2,D3 ; 2 -> ZERO, DONE
BNE.S @2
RTS
@2:
CMPI.W #4,D3 ; 4 -> INF -> OFLOW
BNE.S @4
MOVEQ #-1,D4 ; ENSURE OVERFLOW FOUND
BRA.S IOFLOW
;-----------------------------------------------------------
; USE IALIGN TO PUT BIN PT TO RIGHT OF D5, RETURNING LE IF
; INTEGER OVERFLOW (NO SPECIAL HANDLING REQUIRED SINCE THE
; VALUE IS ASSURED TO BE NORMALIZED, FORCING OVERFLOW).
;-----------------------------------------------------------
@4:
BSR.S IALIGN
BLE.S IOFLOW ; MUST HAVE LEADING ONE
;-----------------------------------------------------------
; SET UP CALL TO ROUND AS THOUGH RESULT IS EXT. SINCE LEAD
; BIT IS 0, ROUNDING CANNOT CARRY OUT AND MODIFY EXP.
;-----------------------------------------------------------
CLR.L D1 ; PUT EXT INC INFO
MOVEQ #1,D2
BTST #0,D5 ; GET NOT LSB TO Z FOR ROUND
BSR ROUND
;-----------------------------------------------------------
; NOW CHECK THE HORRENDOUS CASES FOR INTEGER OVERFLOW,
; FOR EACH OF THE THREE FORMATS.
; FORMAT CODES: 4-INT16 5-INT32 6-COMP64
; LET INTXX CASES SHARE CODE.
;-----------------------------------------------------------
IOFLOW:
MOVEQ #1,D1 ; $80000000 --> D1
ROR.L #1,D1
BTST #DSTLO+16,D6 ; CHECK FOR INT32
BNE.S @21
BTST #DSTMD+16,D6 ; CHECK FOR COMP64
BNE.S @41
SWAP D1 ; $00008000 --> D1
@21:
TST.L D4 ; ANY HI BITS?
BNE.S @25
CMP.L D1,D5 ; BIGGEST MAGNITUDE
BHI.S @25
BCS.S @23 ; NO OFLOW
TST.B D6 ; IS IT NEGATIVE
BPL.S @25 ; NO, OFLOW
@23:
TST.B D6 ; NEGATIVE INTEGER?
BPL.S @24
NEG.L D5 ; NEGATE ALL 64 BITS
NEGX.L D4
@24:
RTS
@25:
MOVE.L D1,D5
@27:
BSET #ERRI+8,D6
BCLR #errx+8,d6 ; Clear inexact if invalid.
RTS
@41:
TST.L D4 ; JUST CHECK LEAD BIT
BPL.S @23
CLR.L D5
MOVE.L D1,D4 ; D1 IS $80000000
BRA.S @27
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPSQRT
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 03JUL82: WRITTEN BY JEROME COONEN
; 12AUG82: TIDIED UP (JTC)
; 12DEC82: PROJ MODE OUT (JTC)
; 14JAN85: MDS (JTC)
;
; THIS SQUARE ROOT ALGORITHM IS OPTIMIZED FOR SIZE.
; A SOMEWHAT FASTER ALGORITHM (THAT TAKES ADVANTAGE OF
; TRAILING 0'S AT THE BEGINNING AND END OF THE ALGORITHM)
; REQUIRES MORE THAN TWICE THE SPACE.
;-----------------------------------------------------------
SQRTTOP:
CMPI.W #2,D3 ; IS THE OPERAND 0?
BNE.S @1
RTS ; ROOT(+-0) = +-0
@1:
MOVEQ #nanSQRT,D0 ; CODE BYTE, JUST IN CASE
TST.B D6 ; NEGATIVE, POSSIBLY INF?
BMI INVALIDOP ; WHETHER NUM OR INF
CMPI.W #4,D3 ; IS THE OPERAND +INF?
BNE.S @10
RTS ; ROOT(AFF +INF) = +INF
@10:
;-----------------------------------------------------------
; THIS ALGORITHM IS THE EXACT ANALOG OF EVERYMAN'S GRAMMAR
; SCHOOL METHOD. EXCEPT THAT IN BINARY IT'S EASIER.
; IN DECIMAL EACH STEP BEGINS WITH THE CRYPTIC OPERATION:
; "DOUBLE THE CURRENT ROOT, ADD A -BLANK- TO BE FILLED
; WITH THE LARGEST NEXT-ROOT-DIGIT POSSIBLE."
; IN BINARY THIS TRANSLATES TO: "APPEND TO THE CURRENT
; ROOT THE BITS 01 AND ATTEMPT A SUBTRACT; IF IT GOES,
; THE NEXT ROOT BIT IS 1, ELSE IT'S 0 SO ADD THE DEFICIT
; BACK." THE ONLY NUISANCE IS THAT THE OPERATION IS WIDE:
; THE APPENDED 01 MEANS THAT ESSENTIALLY 66 BITS ARE LOOKED
; AT EACH TIME.
;
; THE BASIC REGISTER MASK IS:
; ROOT: D0.B D4 D5
; RAD: D1.B D2 D3 D6 D7
; SAVE: D6->A1 D7->A2
; LOOP: COUNTERS IN A3, ... SWAPPED IN WHEN USED
;
; FIRST STEP IS TO HALVE THE EXPONENT AND ADJUST THE BIAS.
; SINCE BIAS IS 3FFF, SHIFT OUT OF RIGHT SIDE IS 1 PRECISELY
; WHEN THE TRUE EXP IS EVEN.
; CASES, AFTER RIGHT SHIFT:
; 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
;
; NOTE THAT 16-BIT OPERATIONS SUFFICE, THOUGH THE EXP IS
; KEPT TO 32 BITS. THE LAST "MOVEA.W" EXTENDS BACH TO 32.
;-----------------------------------------------------------
MOVE.W A4,D0 ; CONVENIENT FOR SHIFTING
ASR.W #1,D0
MOVE SR,D1 ; SAVE FLAGS FOR LATER
BCC.S @12
ADDQ.W #1,D0
@12:
ADDI.W #$1FFF,D0 ; REBIAS
MOVEA.W D0,A4 ; REPLACE SHIFTED EXP
;-----------------------------------------------------------
; INITIALIZE REGISTERS FOR ROOTING. USE A1,A2 AS TEMPS.
;-----------------------------------------------------------
MOVEA.L D6,A1 ; CLEAR RADICAND AREA
MOVEA.L D7,A2
MOVE.L D5,D7 ; INIT RADICAND
MOVE.L D4,D6
CLR.L D3
MOVE.L D3,D2
;-----------------------------------------------------------
; NOW SHIFT RADICAND TO ALIGN BINARY POINT BETWEEN D3 AND
; D6. REQUIRES 1 SHIFT FOR EVEN EXP, 2 SHIFTS FOR ODD,
; FOR WHICH WE SAVED FLAGS ABOVE IN D1.
;-----------------------------------------------------------
ADD.L D7,D7 ; ALWAYS SHIFT ONCE
ADDX.L D6,D6
ADDX.W D3,D3
MOVE D1,CCR ; C=0 -> ODD -> EXTRA
BCS.S @14
ADD.L D7,D7
ADDX.L D6,D6
ADDX.W D3,D3
@14:
;-----------------------------------------------------------
; INITIALIZE ROOT: BECAUSE NUMBERS ARE NORMALIZED, KNOW
; FIRST ROOT BIT IS 1, SO CAN BYPASS FIRST STEP BY SUBTRACT
; FROM "INTEGER" RADICAND PART IN D3 AND BY FORCING 1 BIT
; IN LOW-ORDER ROOT. TRICK ABOUT ROOT IS THAT BEFORE EACH
; STEP ROOT HAS FORM: <CURRENT ROOT>01
; AND AFTER: <NEW ROOT>1
; SO THE INIT VALUE: 0000000000000011
;-----------------------------------------------------------
MOVE.L D2,D0 ; SET ROOT TO 000...0011
MOVE.L D2,D4
MOVEQ #3,D5
SUBQ.W #1,D3 ; FIRST STEP REDUCTION
;-----------------------------------------------------------
; NOW THE MAIN LOOP: SHIFT THE RADICAND LEFT 2 BITS;
; SHIFT THE ROOT: <ROOT>1 -> <ROOT>01 AND SUBTRACT.
; NEED STICKY BITS AND SCAN OF FINAL RADICAND TO GET FULL
; PRECISION. BECAUSE OF REGISTER OVERFLOW, KEEP COUNTER
; IN A3.
;-----------------------------------------------------------
MOVEQ #65,D1
MOVEA.W D1,A3
CLR.L D1
@20:
ADD.L D7,D7 ; RADICAND LEFT BY 2
ADDX.L D6,D6
ADDX.L D3,D3
ADDX.L D2,D2
ADDX.W D1,D1
ADD.L D7,D7
ADDX.L D6,D6
ADDX.L D3,D3
ADDX.L D2,D2
ADDX.W D1,D1
ADD.L D5,D5 ; ROOT LEFT BY 1 AND FIX
ADDX.L D4,D4
ADDX.W D0,D0
SUBQ.W #1,D5 ; XXX10 -> XXX01
;-----------------------------------------------------------
; TRY RADICAND - ROOT
;-----------------------------------------------------------
SUB.L D5,D3
SUBX.L D4,D2
SUBX.W D0,D1
BCC.S @22 ; NO CARRY -> ROOT = 1
ADD.L D5,D3
ADDX.L D4,D2
ADDX.W D0,D1
BRA.S @24
@22:
ADDQ.W #2,D5 ; SET ROOT BIT TO 1
@24:
EXG D0,A3
SUBQ.W #1,D0
EXG D0,A3
BNE.S @20
;-----------------------------------------------------------
; AFTER LOOP HAVE 66 BITS PLUS APPENDED 1 IN D0,4,5.
; ALAS, CAN'T USE GENERAL RIGHT SHIFTER BECAUSE OF D0 STUFF.
; Q: CAN WE PROVE THAT OR-ING TOGETHER LAST RADICAND ISN'T
; NEEDED?
; FACT: SINCE DID 65 STEPS OF LEFT SHIFT, D6,7 ARE NOW 0.
;-----------------------------------------------------------
MOVE.L A1,D6 ; RESTORE OPWORD ETC.
MOVE.L A2,D7
OR.L D2,D1
OR.L D3,D1
BNE.S @30
SUBQ.W #1,D5 ; KILL THIS IF NO STICKIES
@30:
MOVEQ #3,D1 ; RIGHT SHIFT COUNT
@32:
LSR.W #1,D0
ROXR.L #1,D4
ROXR.L #1,D5
ROXR.W #1,D7 ; ROUND BITS (NO SHIFT OUT)
SUBQ.W #1,D1
BNE.S @32
BRA COERCE
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPSLOG
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 28DEC82: BUILT FROM SQRT BY JEROME COONEN
; 29APR83: CLASS ADDED (JTC)
; 09JUN83: PRESERVE A5,A6 (JTC)
; 14JAN85: MDS (JTC)
;
;-----------------------------------------------------------
LOGBTOP:
CLR.B D6 ; SIGN IS IRRELEVANT
CMPI.W #2,D3 ; IS THE OPERAND +-0?
BNE.S @1
;-----------------------------------------------------------
; LOGB(+-0) --> DIV BY ZERO --> ERROR BIT, STUFF INF, RET.
; BSET #ERRZ+8,D6
; BSET #7,D6 ; SIGN OF MINUS INF
;-----------------------------------------------------------
ORI.W #$0880,D6 ; POOR MAN'S BSET'S
MOVEA.W #$7FFF,A4 ; BIG EXP
CLR.L D4 ; ZERO DIGS
MOVE.L D4,D5
RTS
@1:
CMPI.W #4,D3 ; IS THE OPERAND +-INF?
BNE.S @10
;-----------------------------------------------------------
; LOGB(+-INF) --> +INF --> RET.
;-----------------------------------------------------------
RTS
;-----------------------------------------------------------
; LOGB(FINITE, NONZERO) --> EXPONENT, NORMALIZED AS A
; FLOATING-POINT NUMBER. NEVER EXCEPTIONAL, BUT PASS
; THROUGH COERCE TO NORMALIZE AND TEST FOR ZERO.
;-----------------------------------------------------------
@10:
CLR.L D5 ; CLEAR THE SIGNIFICANT BITS
SUBA.W #$3FFF,A4 ; UNBIAS EXPONENT
MOVE.L A4,D4 ; MOVE AS INTEGER
BPL.S @12
ORI.B #$80,D6 ; SET SIGN
NEG.L D4 ; MAGNITUDE OF VALUE
@12:
MOVEA.W #$401E,A4 ; EXPONENT = 31, BIASED
BRA ZNORMCOERCE
;-----------------------------------------------------------
; SCALB BEHAVES MUCH LIKE LOGB, EXCEPT THAT THE INTEGER
; ARGUMENT MUST BE PULL FROM ITS SOURCE LOCATION, IT IS
; MORE CONVENIENT NOT TO UNPACK THE INPUT INTEGER TO
; FLOATING-POINT FORM. COUNT ON INTEGER'S ADDRESS IN
; LKADR2(A6).
; EASY CASES -- SCALB(N, ZERO/INF/NAN) --> ZERO/INF/NAN.
;-----------------------------------------------------------
SCALBTOP:
TST.W D3 ; IS THE OPERAND +-0, +-INF?
BEQ.S @1
RTS
;-----------------------------------------------------------
; JUST ADD THE INTEGER ADJUSTMENT INTO THE EXPONENT IN A4,
; AND CHECK FOR OVER/UNDERFLOW.
;-----------------------------------------------------------
@1:
MOVEA.L LKADR2(A6),A3 ; SRC ADDRESS
ADDA.W (A3),A4
BRA COERCE
;-----------------------------------------------------------
; CLASS PLACES INTEGER CODE AT DST ADDRESS. THE CODE TIES
; IN USEFULLY WITH THE PASCAL ENUMERATED TYPES IN SANE.
; IT IS THE SANE VALUE PLUS ONE, WITH THE SIGN OF THE INPUT
; OPERAND. IN SANE, THE SIGN IS PLACED IN A SEPARATE INT.
; THE VALUES ARE THUS:
; SNAN 1
; QNAN 2
; INF 3
; ZERO 4
; NORMAL 5
; DENORM 6
;-----------------------------------------------------------
CLASSTOP:
MOVEQ #5,D0 ; ASSUME NORMAL NUMBER
TST.L D3 ; CHECK FOR DENORM
BMI.S @99
BEQ.S CLASSFIN
SUBQ.W #2,D0 ; ASSUME INF
CMPI.W #4,D3 ; INF CODE
BEQ.S CLASSFIN
@99:
ADDQ.W #1,D0
CLASSFIN:
TST.B D6 ; NONZERO -> NEGATIVE
BEQ.S @100
NEG.W D0
@100:
MOVEA.L LKADR1(A6),A3
MOVE.W D0,(A3)
RTS
;-----------------------------------------------------------
;-----------------------------------------------------------
; old FPODDS
;-----------------------------------------------------------
;-----------------------------------------------------------
;-----------------------------------------------------------
; 05JUL82: WRITTEN BY JEROME COONEN
; 27APR83: NEGATE, ABS, COPYSIGN ADDED. (JTC)
; 02MAY83: NEXTAFTER ADDED. (JTC)
; 04MAY83: SETXCP ADDED. (JTC)
; 09JUN83: A5,A6 PRESERVED.
; 09JUL83: ENTRY/EXIT, TESTXCP ADDED. (JTC)
; 14JAN85: MDS (JTC)
;
; FOR CONVENIENCE, MOVE DST->A1, SRC->A2 TO HAVE POINTERS.
;
; JUMP TO MISCELLANEOUS ROUTINE BASED ON INDEX IN OPCODE IN
; D6. DEPEND ON REGISTER MASK: ODDBALLS WITH STATE POINTER
; IN A0 AND ONE OPERAND ADDRESS IN A1.
; AT END, MUST JUMP TO FINISHUP SEQUENCES POPX, AS
; APPROPRIATE.
;-----------------------------------------------------------
ODDBALL:
MOVEM.L LKADR1(A6),A1-A2 ; GET DST, SRC ADRS
IF PCOK THEN
MOVE.W ODDTAB(PC,D7),D7
JMP ODDBALL(PC,D7)
ELSE
MOVE.W ODDTAB(D7),D7
JMP ODDBALL(D7)
ENDIF
;-----------------------------------------------------------
; JUMP FROM INDEX-1, AFTER CHECK FOR LEGITIMACY.
;-----------------------------------------------------------
ODDTAB:
DC.W PUTW-ODDBALL ; PUT STATE WORD
DC.W GETW-ODDBALL ; GET STATE WORD
DC.W PUTV-ODDBALL ; PUT HALT VECTOR
DC.W GETV-ODDBALL ; GET HALT VECTOR
DC.W D2B-ODDBALL ; DEC TO BIN
DC.W B2D-ODDBALL ; BIN TO DEC
DC.W NEGZ-ODDBALL ; NEGATE -- ANY FORMAT
DC.W ABSZ-ODDBALL ; ABS -- ANY FORMAT
DC.W CPSZ-ODDBALL ; COPYSIGN -- ANY FORMAT
DC.W NEXTZ-ODDBALL ; NEXTAFTER -- ANY FORMAT
DC.W SETXCP-ODDBALL ; SET EXCEPTION, TRAP IF...
DC.W ENTRYP-ODDBALL ; ENTRY PROTOCOL
DC.W EXITP-ODDBALL ; EXIT PROTOCOL
DC.W TESTXCP-ODDBALL ; TEXT EXCEPTION
;-----------------------------------------------------------
; THE STATE ROUTINES ARE TRIVIAL, AND ALL "RETURN" TO POP1.
;-----------------------------------------------------------
PUTW:
MOVE.W (A1),(A0)
BRA.S GO1
ENTRYP:
MOVE.W (A0),(A1)
CLR.W (A0)
BRA.S GO1
GETW:
MOVE.W (A0),(A1)
BRA.S GO1
PUTV:
MOVE.L (A1),2(A0)
BRA.S GO1
GETV:
MOVE.L 2(A0),(A1)
BRA.S GO1
NEGZ:
BCHG #7,(A1)
BRA.S GO1
ABSZ:
BCLR #7,(A1)
GO1:
BRA POP1
;-----------------------------------------------------------
; TEST AN EXCEPTION WHOSE INDEX IS (A1). SET BYTE (A1) TO
; 1 (TRUE) IF THE EXCEPTION IS SET, SET IT TO 0 (FALSE) IF
; N0T SET.
;-----------------------------------------------------------
TESTXCP:
MOVE.W (A1),D0 ; FETCH INPUT INDEX
BTST D0,(A0) ; EXCEPTION BITS IN HI BYTE
SNE D0
NEG.B D0
MOVE.B D0,(A1) ; RESULT CODE
BRA.S GO1
;-----------------------------------------------------------
; NOTE THAT COPYSIGN COPIES THE SIGN OF THE "DST" ARGUMENT
; ONTO THAT OF THE "SRC" ARGUMENT.
;-----------------------------------------------------------
CPSZ:
BTST #7,(A1)
BEQ.S @1
BSET #7,(A2)
BRA.S @2
@1:
BCLR #7,(A2)
@2:
BRA POP2
;-----------------------------------------------------------
; NEXTAFTER FUNCTION: BEHAVES LIKE NONARITHMETIC OPS, BUT
; MAY SET ERROR FLAGS, SO EXITS THROUGH CHKERR RATHER THAN
; POP2. CALLS REFP68K FOR COMPARE, MULTIPLY (NAN PRECEDENCE),
; CLASS, AND CONVERT.
; NOTE THAT NEXTAFTER CHANGES ITS *****SOURCE***** ARGUMENT
; IN THE DIRECTION OF THE DESTINATION ARGUMENT.
;-----------------------------------------------------------
NEXTZ:
;-----------------------------------------------------------
; ON ENTRY, D6.W IS OPCODE, A1 IS DST, A2 IS SRC, A0 STATE.
; USE OTHER REGISTERS FREELY, BUT MUST ALIGN OPWORD IN D6.HI
; WITH PROPER MASK FOR EXIT THROUGH CHKERR. D6.L0 WILL HOLD
; ERROR FLAGS. MASK OF OPERAND FORMAT BITS INTO D5 FOR USE
; AS MASK FOR CALLING CONVERSION AND INC/DEC ROUTINES.
; STACK FRAME = (A4) = DST-EXT; SRC-EXT; INT
;-----------------------------------------------------------
SUBA.W #22,SP ; NEED 2 EXTENDEDS AND 1 INTEGER
MOVEA.L SP,A4 ; FRAME POINTER THROUGHOUT WHOLE FCN
MOVE.W D6,D5 ; COPY OPCODE
ANDI.W #OPFOMASK,D5 ; ISOLATE FORMAT BITS
ADDQ.W #1,D6 ; SET #TWOADRS BIT CHEAPLY
SWAP D6 ; ALIGN IN HI WORD, LIKE ARITH OPS
CLR.W D6 ; ZERO FLAG AND SIGN BITS
;-----------------------------------------------------------
; CONVERT SRC TO EXTENDED
;-----------------------------------------------------------
MOVE.L A2,-(SP) ; SRC OPERAND ADDRESS
PEA 10(A4) ; STACK FRAME ADDRESS
MOVEQ #OP2EXT,D0 ; CONVERT TO EXT OPCODE
OR.W D5,D0 ; ...WITH FORMAT
MOVE.W D0,-(SP)
BSR REFP68K
;-----------------------------------------------------------
; COMPARE SRC WITH ZERO. IF IT'S EQUAL, ADJUSTMENTS WILL
; BE MADE IN DECREMENT ROUTINES BELOW.
;-----------------------------------------------------------
CLR.L (A4)
CLR.L 4(A4)
CLR.W 8(A4)
PEA (A4)
PEA 10(A4)
MOVE.W #OPCMP,-(SP)
BSR REFP68K
SNE D4 ; D4.BYTE IS 1'S IF SRC IS ZERO
;-----------------------------------------------------------
; CONVERT DST TO EXTENDED
;-----------------------------------------------------------
MOVE.L A1,-(SP)
PEA (A4)
MOVE.W D0,-(SP)
BSR REFP68K
;-----------------------------------------------------------
; COMPARE THE TWO EXTENDED OPERANDS
;-----------------------------------------------------------
PEA (A4) ; DST OPERAND
PEA 10(A4) ; SRC OPERAND
MOVE.W #OPCMP,-(SP)
BSR REFP68K
;-----------------------------------------------------------
; 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 10(A4) ; SRC OPERAND
MOVE.W #OPMUL,-(SP)
BSR REFP68K
;-----------------------------------------------------------
; NOW CONVERT THE PRECEDENT NAN BACK TO INPUT FORMAT.
;-----------------------------------------------------------
PEA 10(A4) ; SRC OPERAND IS OUTPUT
MOVE.L A2,-(SP) ; SRC ADDRESS
MOVEQ #OPEXT2,D0 ; CVT FROM EXT OPCODE
OR.W D5,D0 ; OVERLAY THE FORMAT
MOVE.W D0,-(SP)
BSR REFP68K
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.S 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.S NXDEC
;-----------------------------------------------------------
; GET HERE WHEN SRC > DST. DEC IF SRC IS +, INC IF -
;-----------------------------------------------------------
NXGREAT:
BTST #7,(A2)
BEQ.S 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) ; FALL THROUGH TO NXERR
;-----------------------------------------------------------
; 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:
MOVE.L A2,-(SP)
PEA 20(A4) ; ADDRESS OF INTEGER
MOVEQ #OPCLASS,D0
OR.W D5,D0
MOVE.W D0,-(SP)
BSR REFP68K
;-----------------------------------------------------------
; 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 20(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
BRA CHKERR
;-----------------------------------------------------------
; DECREMENT, WATCHING FOR ZERO VALUE. BRANCH TREE IS LIKE
; THAT OF INC ABOVE.
;-----------------------------------------------------------
NXDEC:
BTST #SRCMD,D5 ; CHECK $1000 BIT FOR SINGLE
BEQ.S @21
TST.B D4 ; D4.B IS NON0 IF OPERAND IS
BNE.S @201
BCHG #7,(A2)
ADDQ.L #1,(A2)
BRA.S NXERR
@201:
SUBQ.L #1,(A2)
BRA.S NXERR
;-----------------------------------------------------------
; DOUBLE CASE
;-----------------------------------------------------------
@21:
BTST #SRCLO,D5 ; CHECK $0800 BIT FOR DOUBLE
BEQ.S @25
TST.B D4 ; D4.B IS NON0 IF OP IS
BNE.S @211
BCHG #7,(A2)
ADDQ.W #1,6(A2)
BRA.S NXERR
@211:
SUBQ.L #1,4(A2)
BCC.S @213
SUBQ.L #1,(A2)
@213:
BRA.S NXERR
;-----------------------------------------------------------
; EXTENDED CASE
;-----------------------------------------------------------
@25:
TST.B D4
BNE.S @251
BCHG #7,(A2)
ADDQ.W #1,8(A2)
BRA.S 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 ; ???? WAS BRA.S
;-----------------------------------------------------------
; SET EXCEPTION AND HALT IF ENABLED. SIMPLY SET THE
; SUITABLE BIT IN THE BYTE MASK $00001F00 IN D6 AND EXIT
; THROUGH FPCONTROL, AS THOUGH ARITHMETIC WERE PERFORMED.
;-----------------------------------------------------------
SETXCP:
SWAP D6 ; ALIGN IN HI WORD, LIKE ARITH OPS
CLR.W D6 ; ZERO FLAG AND SIGN BITS
MOVE.W (A1),D0 ; FETCH INPUT WORD INDEX
ADDQ.W #8,D0 ; ALIGN TO SECOND BYTE
BSET D0,D6
BRA.S EPEXIT ; EXIT THROUGH FPCONTROL
;-----------------------------------------------------------
; RESTORE OLD ENVIRONMENT, AND CHECK CURRENT ERRS FOR HALT
;-----------------------------------------------------------
EXITP:
SWAP D6 ; ALIGN OPWORD, LIKE ARITH
MOVE.W #$1F00,D6 ; SET UP FLAG MASK #ERRO
; #ERRU #ERRX #ERRI #ERRZ
AND.W (A0),D6 ; SAVE CURRENT ERRORS
MOVE.W (A1),(A0) ; RESTORE OLD STATE
EPEXIT:
BRA CHKERR ; EXIT VIA FPCONTROL
Reference in New Issue Copy Permalink