Macintosh-SW/supermario
1
0
Fork 0
mirror of https://github.com/elliotnunn/supermario.git synced 2024-11-26 01:49:19 +00:00
Code Issues Projects Releases Wiki Activity
9dd3c4bef8
supermario/base/SuperMarioProj.1994-02-09/Toolbox/SANE/FPOps.a
Elliot Nunn 2e16381318 Bring in sources, and document
2019-06-29 23:17:50 +08:00

1820 lines
52 KiB
Plaintext
Raw Blame History

;
; File: FPOps.a
;
; Contains: Floating Point Stuff
;
; Written by: Jerome T. Coonen
;
; Copyright: © 1982-1990 by Apple Computer, Inc., all rights reserved.
;
; This file is used in these builds: Mac32
;
; Change History (most recent first):
;
; <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…
;-----------------------------------------------------------
;-----------------------------------------------------------
; 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 View Git Blame Copy Permalink