; ; 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: 01 ; AND AFTER: 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: 1 -> 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