; ; File: FP020BD.a ; ; Contains: xxx put contents here xxx ; ; Written by: xxx put writers here xxx ; ; Copyright: © 1990 by Apple Computer, Inc., all rights reserved. ; ; This file is used in these builds: Mac32 ; ; Change History (most recent first): ; ; <5> 9/15/90 BG Removed <4>. 040s are behaving more reliably now. ; <4> 7/4/90 BG Added EclipseNOPs for flakey 040s. ; <3> 5/9/90 JJ Bug fix to fringe case of binary-to-decimal conversion. ; <2> 4/14/90 JJ Made changes to support new binary-to-decimal, 96-bit precision, ; and improved Pack 5. ; <1> 3/2/90 JJ First checked in. ; ; To Do: ; ;----------------------------------------------------------- ; File: FPBD.a ;----------------------------------------------------------- ;----------------------------------------------------------- ;----------------------------------------------------------- ; Binary-to-decimal and decimal-to-binary conversions ; ; Copyright Apple Computer, Inc., 1983,1984,1985,1989,1990 ; All rights reserved ; ; 09 Mar 90 Correctly rounded conversion algorithms written ; by Kenton Hansen completed ; 20 Mar 90 Conversion routines installed into MC68020 SANE ; by Jon Okada ; 21 Mar 90 KLH Corrected zero NaN anomaly, & Dec2Int setting of ; inexact, overlow and invalid simultaneously ; 30 Mar 90 KLH Put tighter limits on decform.digits ; 02 Apr 90 KLH Corrected case of df.digits = -32000 while style = fixed ; 11 Apr 90 KLH Corrected bcc.s -> bhi.s on 'divide will succeed' statements ; 12 Apr 90 JPO Replaced FSETXCP macro with faster, smaller code ; ;----------------------------------------------------------- ;----------------------------------------------------------- ;----------------------------------------------------------- ; MACROs for quickly accessing other PACK4 routines ;----------------------------------------------------------- MACRO BDFP68K BSR FP020 ENDM MACRO BDMULI MOVE.W #$2004,-(SP) BSR FP020 ENDM ;----------------------------------------------------------- ;----------------------------------------------------------- ;; PROCEDURE Num2Dec(VAR f: decform;x: Extended;VAR d: decimal); ;; { d <-- x according to format f } ;; _____________________________________| ;; | | ;; | address of df (decform) | ;; |_____________________________________| ;; | | ;; | address of x (extended) | ;; |_____________________________________| ;; | | ;; | address decimal record | ;; |_____________________________________| ;; | | ;; | return address | ;; |_____________________________________| ;----------------------------------------------------------- ;----------------------------------------------------------- BDOPW EQU 4*15 ; opword location in A6-relative stack frame dcAdN2D EQU 4*15+2 ; address decimal record address BDPOP3 EQU 14 ; # of operand bytes to pop prior to return exAdN2D EQU dcAdN2D+4 ; extended address dfAdN2D EQU exAdN2D+4 ; address decform record address MaxDigs EQU 19 EnvSave EQU -2 ; address of Environment Env2 EQU -4 ; overlaps with MISCRec MISCRec EQU -12 ; MISC record (for Halt Handler) XTemp EQU -16 ; Intermediate location for Extended ;----------------------------------------------------------- ; Main entry point for binary to decimal conversions. Restore ; stack and registers to pristine condition, then save state ; again in new fashion. Finally, get binary source format ; into D7. ;----------------------------------------------------------- B2D: movem.l (SP)+,A0-A4/D0-D7 ; restore registers unlk A6 ; undo link movem.l A0-A4/D0-D7,-(SP) ; save state again link a6,#-16 ; reserve 16 bytes local stack frame move.w BDOPW(A6),D7 ; D7.W <- opword and.w #$3820,D7 ; isolate SRC format in D7.W move.w (FPSTATE).W,D3 ; get caller's environment move.w D3,EnvSave(A6) ; save it and.w #$6000,D3 ; install environment that is default move.w D3,(FPSTATE).W ; except for caller's rounding direction move.l exAdN2D(a6),a3 ; save original source address in A3 lea XTemp(a6),a0 ; A0 <- addr of temp extended move.l a0,exAdN2D(a6) ; move current dst to 'exAdN2D(a6)' move.l a3,-(sp) ; push &SRC move.l a0,-(sp) ; push &temp MOVE.W d7,-(SP) ; move format to stack add.W #FOZ2X,(SP) ; create opword on stack BDFP68K ; convert to extended TST.B D7 ; 96-bit extended in XTemp? BEQ.S @1 ; no MOVE.L XTemp+4(A6),XTemp+2(A6) ; yes; convert to 80-bit format MOVE.L XTemp+8(A6),XTemp+6(A6) ; in place @1: movea.l dfAdN2D(a6),A1 ; get decform into D2 move.l (A1),D2 movea.l dcAdN2D(a6),A1 ; get address of decimal record move.w (a0)+,d0 ; get sign and exponent from stack frame clr.w (a1) BCLR #15,D0 ; strip sign from exponent beq.s @4 MOVE.b #1,(a1) ; set decimal sign @4: move.L (a0)+,d4 ; get high 32 bits of extended from memory move.L (a0),d5 ; get low 32 bits of extended from memory ;----------------------------------------------------------- ; ENUM TYPE: SET DEFAULT ; STRING LENGTH TO 1, USEFUL JUST BELOW AND LATER WHEN ; SCALED FIXED-PT RESULT OVERFLOWS TO '?'. ;----------------------------------------------------------- MOVE.B #1,4(A1) ; LENGTH TO 1 ;----------------------------------------------------------- ; NOW PICK OUT NAN, INF, ZERO CASES... ;----------------------------------------------------------- cmp.w #$7fff,d0 ; d0 - $7fff bne.s @10 ; zero denorm or normal move.l d4,d0 ANDI.L #$7FFFFFFF,D0 ; test fractional part of significand bne.s @28 ; NaN found tst.l d5 bne.s @28 ; NaN found MOVEQ #'I',D0 ; Infinity found @16: MOVE.B D0,5(A1) ; SAVE 1-CHAR FIELD BRA BDFIN ; GO TO END OF CONVERSION ;----------------------------------------------------------- ; CHECK FOR 0, INF, OR (GASP) AN HONEST NUMBER. ;----------------------------------------------------------- @10: TST.L D4 ; IF-SPECIAL-NUMBER bne.S BD1 ; --> FINITE, NONZERO TST.L D5 ; IF-SPECIAL-NUMBER bne.S BD1 ; --> FINITE, NONZERO MOVEQ #'0',D0 ; ASSUME IT'S ZERO bra.s @16 @28: bset #30,d4 ; test for signaling NaN while quieting bne.s @29 ; quiet NaN found bset #ERRI,(FPSTATE).W ; signaling NaN raises INVALID exception ;----------------------------------------------------------- ; PUT NXXXX... FOR 16 HEXITS OF A NAN, REGARDLESS OF FORMAT ; SINCE TRAILING ZEROS WILL BE STRIPPED LATER. NOTE THAT ; NAN STRUCT IS 22 BYTES LONG: 2 WORDS FOR SIGN AND EXP, ; AND 18 BYTES FOR LENGTH, N, AND 16 HEXITS. ;----------------------------------------------------------- @29: ADDQ.L #4,A1 ; POINT TO RESULT STRING MOVE.B #17,(A1)+ ; LENGTH = N PLUS 2 SETS OF 8 MOVE.B #'N',(A1)+ ; FIRST CHAR BSR.S @31 ; FIRST 8 HEXITS FROM D4 MOVE.L D5,D4 ; MOVE LOW 8 HEXITS BSR.S @31 ; AND CONVERT SUBA.W #22,A1 ; POINT TO HEAD OF STRUCT BRA BDFIN ;----------------------------------------------------------- ; ROUTINE TO DISPLAY D4 IN 0-9, A-F. ;----------------------------------------------------------- @31: MOVEQ #8,D0 ; LOOP COUNT @33: ROL.L #4,D4 ; PRINT FROM HI TO LO MOVEQ #$0F,D1 ; NIBBLE MASK AND.B D4,D1 ; STRIP NIBBLE OR.B #'0',D1 ; '0' IS $30 CMPI.B #'9',D1 ; HEX LETTER? BLE.S @35 ADDQ.B #7,D1 ; TRANSLATE TO A-F @35: MOVE.B D1,(A1)+ ; STUFF CHARACTER SUBQ.W #1,D0 BNE.S @33 RTS ;----------------------------------------------------------- ; NEED NORMALIZED FORM OF NUMBER (EVEN WHEN VALUE IS ; EXTENDED DENORMALIZED) IN ORDER TO COMPUTE ; FLOOR( LOG10 ( | X | ) ). ; AS EXPLAINED IN THE B-D PAPER, WE CAN APPROXIMATE ; LOG2 ( | X | ) BY EXP.FRAC . ; SO WE PUT THIS INFORMATION TOGETHER BEFORE STORING THE ; SIGNED EXTENDED VALUE AT THE TOP OF THE STACK FRAME (A3). ; FOR CONVENIENCE, THIS INFORMATION IS KEPT EVEN IN THE ; CASE OF FIXED CONVERSIONS, IN WHICH IT IS IRRELEVENT. ;----------------------------------------------------------- BD1: tst.l d4 bmi.s @2 ; x normal @1: subq.w #1,d0 ; normalize x add.l d5,d5 addx.l d4,d4 bpl.s @1 ; x denormal @2: MOVE.L D4,D1 ; INTEGER-BIT.FRAC MOVE.W D0,D1 ; EXP IN LOW WORD SUBI.W #$3FFF,D1 ; UNBIAS EXP SWAP D1 ; ALIGN EXP AND INT.FRAC ADD.W D1,D1 ; FINALLY HAVE EXP.FRAC MOVE.L #$4D104D42,D0 ; FLOOR( LOG10 (2) ) TST.L D1 ; EXP NEGATIVE? BPL.S @7 ADDQ.W #1,D0 ; BUMP LOG TO ASSURE FLOOR ;----------------------------------------------------------- ; COMPUTE LOG10(2) * LOG2(X) INTO D4.W. THIS IS A 32*32 ; SIGNED MULTIPLY SO CANNOT USE CORE ROUTINE OF THE MULT ; OPERATION. SINCE ONLY THE LEADING 16 BITS ARE OF ; INTEREST, IT IS NOT NECESSARY TO CARRY OUT THE LOW ORDER ; 16*16 PARTIAL PRODUCT. THE SCHEME IS: ; ; A B = D0 = FLOOR( LOG10 (2) ) > 0 ; * X Y = D1 = FLOOR( LOG2 |X| ) ; ------- ; A--Y ; B--X ; + A--X ; ------------ ; ???????? = D4.W, KEEPING ONLY 16 BITS ;----------------------------------------------------------- @7: MOVE.L D0,D4 SWAP D4 ; D4.W = A MULU D1,D4 ; D4.L = A--Y CLR.W D4 SWAP D4 ; D4.W = A--Y.HI SWAP D1 ; D1.W = X MOVE.W D1,D5 MULS D0,D5 ; D5.L = B--X SWAP D5 EXT.L D5 ; D5.W = B--X.HI WITH SIGN ADD.L D5,D4 ; CANNOT CARRY OR BORROW SWAP D0 ; D0.W = A MULS D1,D0 ; D0.L = A--X ADD.L D0,D4 SWAP D4 ; D4.W = FLOOR(LOG10(X)) ;----------------------------------------------------------- ; ADD 1 TO D4.W YIELDING THE NUMBER OF DIGITS LEFT OF THE ; DECIMAL POINT WHEN X IS WRITTEN OUT, A HANDY VALUE. ;----------------------------------------------------------- ;if (f.style = FloatDecimal) and (f.digits < 1) then f.digits := 1; move.w d2,d1 ; contains decform.digits bmi.s @8 ; negative cmpi.w #$2000,d1 ; peg positive at 8K blt.s @9 move.w #$2000,d1 bra.s @9 @8: cmpi.w #$e000,d1 ; peg negative at -8K bgt.s @9 move.w #$e000,d1 @9: swap d2 ; contains decform.style lsr.w #8,d2 ; word --> byte tst.b d2 ; nonzero --> fixed bne.s loop tst.w d1 bgt.s loop ; f.digts >= 0 moveq #1,d1 ; f.digits := 1 loop: addq.w #1,d4 ; logx := logx + 1 move.w d1,d5 ; len := f.digits tst.b d2 ; nonzero --> fixed beq.s @1 add.w d4,d5 ; len := len + (logx + 1) @1: cmpi.w #MaxDigs,d5 ; len - MaxDigs ble.s @2 move.w #MaxDigs,d5 ; len := MaxDigs @2: move.w d5,2(a1) ; d.exp := len sub.w d4,2(a1) ; d.exp := d.exp - (logx + 1) tst.w d5 bgt.s @3 moveq #1,d5 ; len := 1 @3: move.l exAdN2D(a6),-(sp) move.l a1,-(sp) jsr BIGX2S cmp.b 4(a1),d5 ; len - length (d.sig) bcs.s loop neg.w 2(a1) ; d.exp := -d.exp BDFIN: move.w (FPSTATE).W,d0 ; current environment word andi.w #$1f00,d0 ; current exceptions or.w d0,EnvSave(A6) ; set current exceptions in saved environment move.w EnvSave(A6),(FPSTATE).W ; restore updated saved environment lsr.w #8,d0 ; align pending exceptions into halt position and.w EnvSave(a6),d0 ; exceptions causing halts beq.s NoHalts move.l 4(a6),MISCRec+4(a6) ; original d0 saved on stack swap d0 ; prepare pending CCR/halts clr.w d0 ; (faking CCR = 0) move.l d0,MISCRec(a6) ; pending halt exceptions pea MISCRec(a6) ; push mischaltinfo record addr move.l dfAdN2D(a6),-(sp) ; push src1 (decform) addr move.l a3,-(sp) ; push src addr move.l dcAdN2D(a6),-(sp) ; push dst (decimal) addr move.w BDOPW(A6),-(sp) ; push opword movea.l (FPHV).W,A0 ; get haltvector and jsr to user jsr (A0) ; halt handler NoHalts: unlk a6 movem.l (sp)+,A0-A4/D0-D7 ; restore registers move.l (sp),BDPOP3(sp) ; move rts address to proper location lea BDPOP3(sp),sp ; clean up stack move #0,CCR ; zero CCR rts ; return ;----------------------------------------------------------- ;----------------------------------------------------------- ;; PROCEDURE Dec2Num(d: decimal, VAR x: Extended); ;; _____________________________________ ;; | | ;; | d address decimal record | ;; |_____________________________________| ;; | | ;; | address of x (extended) | ;; |_____________________________________| ;; | | ;; | return address | ;; |_____________________________________| ;----------------------------------------------------------- ;----------------------------------------------------------- dbopw EQU 4*15 ; opword location relative to A6 exAddr EQU 4*15+2 ; extended address BDPOP2 EQU 10 ; # of operand bytes to pop prior to return dcAddr EQU exAddr+4 ; address decimal record MxDgs EQU 19 ; 'brain dead' limit for decimal point on decimal record ; input. Scheme is backwards compatible for previous ; routines ;----------------------------------------------------------- ; Main entry point for decimal to binary conversions. Restore ; stack and registers to pristine condition, then save state ; again in new fashion. Finally, get binary source format ; into D7. ;----------------------------------------------------------- D2B: movem.l (SP)+,A0-A4/D0-D7 ; restore registers unlk A6 ; undo link movem.l A0-A4/D0-D7,-(SP) ; save state again link a6,#-16 ; reserve 16 bytes local stack frame move.w DBOPW(A6),D7 ; D7.W <- opword and.w #$3800,D7 ; isolate DST format in D7.W beq.s QDEC2X ; extended (80- or 96-bit) format cmp.w #$1000,D7 blt.s QDEC2D ; double beq.s QDEC2S ; single MOVE.W #$6000,d0 ; comp or integer: mask for rounding direction only bra.s NoRound QDEC2S: ; single precision DST MOVE.W #$6040,d0 ; mask for rounding precision and direction bra.s NoRound QDEC2D: ; double precision DST MOVE.W #$6060,d0 ; mask for rounding precision and direction NoRound: move.w (FPSTATE).W,D3 ; D3 <- caller's environment move.w D3,EnvSave(A6) ; save it and.w d0,d3 or.w #$0080,d3 ; special bit to tell rounding routine ; to set sticky bit but don't round since ; FOX2Z will do the proper rounding, i.e., ; this gimmick avoids double rounding. bra.s SetIt ; set new environment QDEC2X: ; extended precision DST MOVE.W #$6060,d0 ; mask for rounding precision and direction move.w (FPSTATE).W,D3 ; D3 <- caller's environment move.w D3,EnvSave(A6) ; save it and.w d0,d3 SetIt: move.w D3,(FPSTATE).W ; set new environment (caller's rounding ; direction/precision with no halts enabled) drpad: move.l exAddr(a6),a3 ; save original destination address in A3 cmpi.w #FFEXT,d7 beq.s @1 lea XTemp(a6),a0 move.l a0,exAddr(a6) ; move XTemp(a6) to 'exAdN2D(a6)' @1: move.l dcAddr(a6),A2 ; get address of decimal record LEA 4(A2),A4 ; PTR TO STRING ;----------------------------------------------------------- ; CLEAR OUT DIGIT ACCUMULATOR AND INITIALIZE COUNTERS. ;----------------------------------------------------------- CLR.L D4 ; DIGIT BUFFER MOVE.L D4,D5 MOVE.B (A4)+,D6 ; DIGIT STRING LENGTH COUNT BEQ.S DBZSTO ; ZERO LENGTH --> 0.0 ;----------------------------------------------------------- ; GET FIRST CHARACTER BUT DON'T AUTOINCREMENT. ;----------------------------------------------------------- MOVE.B (A4),D0 ; FIRST CHAR ;----------------------------------------------------------- ; CHECK FOR 'I' -- INFINITY. ;----------------------------------------------------------- CMPI.B #$49,D0 ; IS IT 'I'? BEQ.S DBNFIN ;----------------------------------------------------------- ; CHECK FOR 'N', IF SO GET HEXITS FOR SIGNIFICAND. IF THERE ; ARE FEWER THAN THREE, FORCE LEAD ZEROS. ;----------------------------------------------------------- CMPI.B #'N',D0 ; ALLOW ONLY CAPITAL N BNE.S DBZER MOVE.B -1(A4),D2 ; CHARACTER COUNT ADDQ.L #1,A4 ; POINT TO FIRST HEXIT SUBQ.B #1,D2 ; DON'T COUNT 'N' MOVEQ #8,D0 ; ASSUME 8 DIGITS CMPI.B #4,D2 ; OK IF AT LEAST 4 BGE.S @31 SUBQ.B #4,D0 ; FOUR 0'S AND WHAT'S THERE ADD.B D2,D0 @31: BSR.S @35 MOVE.L D5,D4 CLR.L D5 MOVEQ #8,D0 BSR.S @35 BRA.S @39 ;----------------------------------------------------------- ; ROUTINE TO GET D0 DIGITS TO D5, UP TO COUNT IN D2 ;----------------------------------------------------------- @35: ROL.L #4,D5 ; ALIGN BITS SO FAR SUBQ.B #1,D2 ; DEC STRING COUNT BMI.S @37 MOVE.B (A4)+,D1 CMPI.B #'9',D1 BLE.S @36 ADDI.B #9,D1 ; TRUE NIBBLE VALUE @36: ANDI.B #$0F,D1 ; NIBBLE MASK OR.B D1,D5 @37: SUBQ.W #1,D0 BNE.S @35 RTS ;----------------------------------------------------------- ; CLEAR IRRELEVANT LEAD BIT AND TEST FOR ANYTHING NONZERO. ;----------------------------------------------------------- @39: bset #QNANBIT,D4 ; make it a quiet NaN move.l D4,D0 swap D0 andi.b #$FF,D0 ; test for zero NaN code bne.s DBNFIN ; nonzero code; done ori.w #NANZERO,D0 ; insert special NaN code swap D0 move.l D0,D4 ;----------------------------------------------------------- ; SET EXPONENT FOR INF/NaN IN D0 ;----------------------------------------------------------- DBNFIN: MOVE.W #$7FFF,D0 ; STORE HUGE EXP BRA.S DBSSTO ;----------------------------------------------------------- ; GET HERE IF ALL DIGITS ZERO: FORCE SIGNED 0 AND STORE ;----------------------------------------------------------- DBZER: CMPI.B #$30,D0 ; IS IT '0'? BNE.S SIGDIGS DBZSTO: CLR.L D0 DBSSTO: ;----------------------------------------------------------- ; DECIMAL.SGN ENUM TYPE TEST USES HI BYTE ONLY ;----------------------------------------------------------- TST.B (A2) ; CHECK OPERAND SIGN BEQ.S @1 BSET #15,D0 @1: move.l exAddr(a6),A0 MOVE.W D0,(A0)+ MOVE.L D4,(A0)+ MOVE.L D5,(A0) bra.s NoDigs BrnDd: ;save exponent, adjust exponent, call bigd2x, restore exponent move.w 2(a2),-(sp) ; save original decimal.exp moveq #0,d0 move.b d6,d0 subi.w #MxDgs,d0 sub.w d0,2(a2) ; adjust decimal.exp for brain dead 19 digit max move.l exAddr(a6),-(sp) move.l dcAddr(a6),-(sp) jsr BIGD2X move.w (sp)+,2(a2) ; restore original decimal.exp bra.s NoDigs ; normal finish SIGDIGS: cmpi.b #MxDgs,d6 bhi.s BrnDd move.l exAddr(a6),-(sp) move.l dcAddr(a6),-(sp) jsr BIGD2X NoDigs: cmpi.w #FFEXT,d7 ; if non-extended DST, convert bgt.s @1 BTST #FPX96,dbopw+1(A6) ; if 80-bit extended DST, result BEQ.S @3 ; is already delivered MOVE.L 6(A3),8(A3) ; if 96-bit extended DST, convert MOVE.L 2(A3),4(A3) ; in place BRA.S @3 @1: pea XTemp(a6) ; non-extended DST requires conversion move.l a3,-(sp) ; put address of dest onto stack MOVE.W d7,-(SP) ; move op to stack add.W #FOX2Z,(SP) ; move op to stack BDFP68K ; convert to DST format move.w (FPSTATE).W,D0 ; Get current environment btst #8,D0 ; INVALID exception? beq.s @2 ; no andi.w #$E1FF,D0 ; yes. clr spurious exceptions bra.s @4 @2: cmpi.w #FFSGL,D7 ; integer or comp DST? ble.s @4 ; no. single or double bclr #ERRU+8,D0 ; yes. clr underflow bra.s @4 @3: move.w (FPSTATE).W,D0 ; extended DST: D0 <- environment @4: andi.w #$1f00,D0 ; current exceptions or.w D0,EnvSave(A6) ; set current exceptions in saved environment move.w EnvSave(A6),(FPSTATE).W ; restore updated saved environment lsr.w #8,d0 ; align pending exceptions into halt position and.w EnvSave(a6),D0 ; exceptions causing halts beq.s NoHlts move.l 4(a6),MISCRec+4(a6) ; original d0 saved on stack swap d0 ; prepare pending CCR/halts clr.w d0 ; (faking CCR = 0) move.l d0,MISCRec(a6) ; save in mischaltinfo record pea MISCRec(a6) ; push mischaltinfo record addr move.l dcAddr+4(A6),-(sp) ; push (nonexistent) SRC2 addr move.l dcAddr(a6),-(sp) ; push SRC (decimal record) addr move.l a3,-(sp) ; push DST addr move.w dbopw(A6),-(sp) ; push opword movea.l (FPHV).W,A0 ; get haltvector and jsr to jsr (a0) ; user halt handler NoHlts: unlk a6 movem.l (sp)+,A0-A4/D0-D7 ; restore registers move.l (sp),BDPOP2(sp) ; move rts address to proper location lea BDPOP2(sp),sp ; clean up stack move #0,CCR ; clr CCR rts ; return BIGD2X: bgSz equ 784 ; 780.1=(256*21)*(Ln(5)/Ln(2)/16) lclSz equ 4*bgSz+160 ParamSize EQU 8 ; size of all the passed parameters MinSpace EQU 3316 ; minimum stack space in bytes rtnAd EQU 4*13 ; rtnAd(a6) contains the return address s EQU rtnAd+4 ; s(a6) contains the address of string or decimal record x EQU s+4 ; x(a6) contains the address of x AAdr equ -4 ; contains the address of aReg BAdr equ AAdr-4 ; contains the address of bReg CAdr equ BAdr-4 ; contains the address of cReg DAdr equ CAdr-4 ; contains the address of dReg EAdr equ DAdr-4 ; contains the address of Environment xreg equ EAdr-4 ; xReg(A6) address of xReg areg equ xreg-16 ; aReg(A6) address of aReg MoveM.L A1-A4/D0-D7,-(SP) link a6,#-160 movea.L s(a6),a0 addq #2,a0 move.w (a0),D0 ; hi part of D0 never used!! blt SigDiv bsr SizeExt bsr a2b bsr StoD move.L DAdr(A6),CAdr(A6) bsr cXb2a movea.L a1,a3 move.w #$4f,d6 ; 63 + 16 move.w d1,d2 movea.l a3,a2 @1: subi.w #16,d6 ; find first non zero word move.w (a2)+,d0 bne.s @3 ; found first non zero word dbra d2,@1 @2: addq.w #1,d6 ; find first bit lsl.w #1,d0 @3: bpl.s @2 ; location of first bit not found moveq #-1,d5 ; d5 < 0 => decimal to binary bsr Roundit ; Roundit likes address of register in a3 move.w d1,d7 asl.w #4,d7 ; times 16 = number of bits movea.L s(a6),a0 addq #2,a0 add.w (a0),d7 addi.w #$400e,d7 ; add extended bias bsr.s StuffIt tst.l d4 bmi.s @5 @4: subq.w #1,d7 ; decrement exponent asl.l #1,d6 roxl.l #1,d5 roxl.l #1,d4 bpl.s @4 @5: move.l x(a6),a0 cmp.w #$7fff,d7 ; d7 - $7fff bcc.s OverFlo asl.w #1,d7 PICont: asl.w (a0) ; put sign bit in 'X' roxr.w #1,d7 ; put sign into exponent word move.w d7,(a0)+ ; put sign and exponent into memory move.L d4,(a0)+ ; put high 32 bits of extended into memory move.L d5,(a0) ; put low 32 bits of extended into memory bra DoneB2X OverFlo: or.w #ERRWXO,(FPSTATE).W ; signal INEXACT and OVERFLOW MOVE.W (FPSTATE).W,D2 ; D2 <- environment ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BTST #14,D2 ; bit for +/-infinity rounding directions BNE.S DnOrTZ ; DOWNWARD or TOWARDZERO BTST #13,D2 BEQ.S RtrnInf ; TONEAREST MOVE.L x(A6),A4 ; UPWARD MOVE.W (A4),D2 ; contains sign and biased exponent BPL.S RtrnInf ; + & UPWARD, bumpit BRA.S RtrnMax ; - & UPWARD, don't bumpit DnOrTZ: BTST #13,D2 ; DOWNWARD or TOWARDZERO BNE.S RtrnMax ; TOWARD-ZERO MOVEA.L x(A6),A4 ; x(A6) contains the address of x MOVE.W (A4),D2 ; contains sign and biased exponent BMI.S RtrnInf ; - & DOWNWARD, bumpit ; + & DOWNWARD, don't bumpit RtrnMax: move.w #$fffc,d7 ; return Max moveq #-1,d4 moveq #-1,d5 bra.s PICont RtrnInf: move.w #$fffe,d7 ; return infinity moveq #0,d4 moveq #0,d5 bra.s PICont StuffIt: moveq #0,d4 ; clear significand moveq #0,d5 ; clear significand moveq #0,d6 ; clear significand tst.w d1 bgt.s @4 move.w (a3)+,d4 ; 1 significant word swap d4 rts @4: move.l (a3)+,d4 ; 2 or more significant words subq.w #2,d1 ; d1 - 2 bgt.s @5 blt NormIt move.w (a3)+,d5 ; 3 significant words swap d5 rts @5: move.l (a3)+,d5 ; 4 or more significant words subq.w #2,d1 ; d1 - 2 (d1 - 4) bgt.s @6 blt NormIt move.w (a3)+,d6 ; 5 significant words swap d6 rts @6: move.l (a3)+,d6 ; 6 or more significant words rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DivWS: move.w d1,d4 ; d4 := max {d1, d3} cmp.w d3,d1 ; d1 - d3 ble.s @1 ; d1 <= d3 move.w d3,d4 ; d4 := max {d1, d3} @1: tst.w d2 ; beq.s RtDvWS ; only one word in A1 & A3 lea 2(a1),a2 ; lea 2(a3),a4 ; moveq #0,d2 ; @2: addq.w #1,d2 ; cmp.w d2,d1 ; d1 - d2 bge.s @3 ; d1 >= d2, don't clear (a2) clr.w (a2) ; @3: cmp.w d2,d3 ; d3 - d2 bge.s @4 ; d3 >= d2, don't clear (a4) clr.w (a4) ; @4: cmpm.w (a4)+,(a2)+ ; bne.s RtDvWS ; cmp.w d2,d4 ; d4 - d2 bgt.s @2 ; d4 > d2, keep looking bra.s RtDvWS ; note: condition code will be Z, values identical ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SigDiv: bsr SizeExtN bsr StoD ; D3.w = # words - 1 in (A3) bsr Nrmlz10 ; D7.w = # bits to the right of (A1) word movea.l a4,a3 ; a4 set by StoD moveq #4,d6 ; D6.W + 1 = # of DIVU steps required CMP.W (A3),D0 ; DO - (A3) BEQ.S DivWS ; need further investigation RtDvWs: BHI.S @1 ; Divide will succeed, no padding necessary <11apr90> ADDQ.w #1,D3 ; append a zero word to A3 CLR.W -(A3) moveq #5,d6 ; D6.W + 1 = # of DIVU steps required @1: move.w d3,d2 asl.w #4,d2 ; times 16 sub.w d7,d2 addi.w #$3FFE,d2 ; add extended bias move.w d2,-(SP) ; (d3*16 - d7) + $3FFE -> stack bsr BgnDiv ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; MakeX transforms contents of software register in a3 (d1.w = length) ; into and extended value in D0.W (sign & exponent) & ; D4/D5 (64-bit significand). ; first the register is rounded and checked for overflow and underflow ; ; find leading significant bit ; moveq #0,d6 move.w (a3),d0 bra.s @3 @2: addq.w #1,d6 ; find first bit lsl.w #1,d0 @3: bpl.s @2 ; location of first bit not found move.w (SP)+,d7 move.l d7,a1 ; Roundit DOESN'T USE a1 sub.w d6,d7 ; if negative, necessary '0' bits appended to left bmi.s Dnrml addi.w #63,d6 moveq #-1,d5 ; d5 < 0 => decimal to binary bsr Roundit ; Roundit likes address of register in a3 move.l a1,d7 bsr StuffIt NormIt: tst.l d4 bmi.s @2 @1: subq.w #1,d7 ; decrement exponent asl.l #1,d6 roxl.l #1,d5 roxl.l #1,d4 bpl.s @1 @2: move.l x(a6),a0 asl.w #1,d7 asl.w (a0) ; put sign bit in 'X' roxr.w #1,d7 ; put sign into exponent word move.w d7,(a0)+ ; put sign and exponent into memory move.L d4,(a0)+ ; put high 32 bits of extended into memory move.L d5,(a0) ; put low 32 bits of extended into memory bra DoneB2X NeedWrd: tst.w d0 bge.s @1 clr.w -(a3) addq #1,d1 addi.w #16,d6 subi.w #16,d7 addi.w #16,d0 @1: rts Dnrml: move.l a1,d0 cmpi.w #-66,d0 ; iscale(a6) - (-66) bpl.s @0 ; not an extreme denormalized case move.w #-66,d7 move.w d7,d0 sub.w d6,d7 @0: add.w d7,d6 bsr.s NeedWrd bsr.s NeedWrd bsr.s NeedWrd bsr.s NeedWrd bsr.s NeedWrd addi.w #63,d6 move.w d0,-(SP) moveq #-1,d5 ; d5 < 0 => decimal to binary movea.l a3,a1 ; save a3 bsr Roundit ; Roundit likes address of register in a3 movea.l a1,a3 ; restore a3 move.w (SP)+,d7 bsr StuffIt tst.l d4 bmi.s @2 @1: tst.w d7 ble.s @2 ; min exponent, no further normalization subq.w #1,d7 ; decrement exponent asl.l #1,d6 roxl.l #1,d5 roxl.l #1,d4 bpl.s @1 @2: move.l x(a6),a0 asl.w #1,d7 asl.w (a0) ; put sign bit in 'X' roxr.w #1,d7 ; put sign into exponent word move.w d7,(a0)+ ; put sign and exponent into memory move.L d4,(a0)+ ; put high 32 bits of extended into memory move.L d5,(a0) ; put low 32 bits of extended into memory ; Note: any power of ten that turns a pascal string into a denormalized ; number will not do it exactly. Therefore it is not necessary to check ; for inexact. All denormalized results cause underflow in Decimal to Binary tst.L d4 bmi.s noUF ; not denormalized OR.W #ERRWXU,(FPSTATE).W ; subnormal: signal INEXACT and UNDERFLOW noUF: bra DoneB2X ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; StoD: moveq #0,d3 ; initialize length move.L DAdr(A6),A3 subq.l #2,a3 ; starting address of integer clr.w (A3)+ ; clear initial word for integer MOVE.L s(A6),A0 ; s(A6) contains the address of decimal record MOVE.L x(A6),A4 ; address of x for directed roundings ;----------------------------------------------------------- ; DECIMAL.SGN ENUM TYPE TEST USES HI BYTE ONLY ;----------------------------------------------------------- TST.B (A0) ; CHECK OPERAND SIGN BEQ.S @10 BSET.B #7,(a4) ; store decimal.sig in x for directed roundings bra.s @11 @10: BCLR.B #7,(a4) ; store decimal.sig in x for directed roundings @11: addq.L #4,A0 ; address of decimal.sig moveq #0,d0 move.b (a0)+,d0 ; length of string bra.s @3 ; ; Loop through string, successively multiplying by 10 and adding ; in the low nibble of the character. ; @1: MOVEQ #$0F,D7 AND.B (A0)+,D7 ; GET LOW NIBBLE movea.l a3,a4 move.w d3,d4 @2: move.w -(a4),d6 ; get word for multiply mulu #10,d6 add.l d6,d7 ; add previous overflow or decimal digit move.w d7,(a4) ; move word back into memory register clr.w d7 ; clear non overflow part swap d7 ; put overflow part in low word dbra d4,@2 ; condition codes not affected beq.s @3 move.w d7,-(a4) ; add new word to memory register addq.w #1,d3 @3: dbra d0,@1 rts ;----------------------------------------------------------- ;----------------------------------------------------------- ; Binary to String routines modified from JTC's BINDEC.a ; procedure BigX2S (var x: extended; iscale: integer; var s: string); ; ;; ;; ;; _________________________________________________________________ ;; ;; after 'Link' instruction the stack should look like: ;; ;; _____________________________________ ;; | | ;; | address of x (extended)| ;; |_____________________________________| ;; | | ;; | s address decimal record | ;; |_____________________________________| ;; | | ;; | return address | ;; |_____________________________________| ;; | | ;; | address (20 bytes) | ;; |_____________________________________| ;; | | ;; | xreg (12 bytes) | ;; |_____________________________________| ;; | | ;; | areg (1456 bytes) | ;; |_____________________________________| ;; | | ;; | breg (728 bytes) | ;; |_____________________________________| ;; | | ;; | creg (728 bytes) | ;; |_____________________________________| ;; | | ;; | dreg (108 bytes) | ;; |_____________________________________| ;; ;;_________________________________________________________________ ;; ;----------------------------------------------------------- ;----------------------------------------------------------- BIGX2S: MoveM.L A1-A4/D0-D7,-(SP) link a6,#-160 movea.L s(a6),a0 addq #2,a0 move.w (a0),D0 ;hi part of D0 never used!! ble.s DivCase bsr SizeExt bsr XbyA bra.s MStr DivCase: bsr SizeExtN bsr GetX bsr DivX moveq #0,d5 ; d5 >= 0 => binary to decimal bsr Roundit MStr: bsr.s MakeStr Done: UNLK A6 ; destroy the link MoveM.L (SP)+,A1-A4/D0-D7 ; restore registers & return address MOVEA.L (SP)+,A0 ; pull off the return address LEA ParamSize(SP),SP ; strip all of the caller's parameters JMP (A0) ; return to the caller DoneB2X: ; special backend to check for rounding precision move.w (FPSTATE).W,D4 ; D4 <- environment and.w #$0060,d4 ; check for rounding precision beq.s Done pea Tbl1 ; address of integer value 1 MOVE.L x(a6),-(SP) ; push address of extended BDMULI ; forces rounding precision control bra.s Done MakeStr: movea.L CAdr(A6),A1 ; initialize bcd string address CLR.L (A1) ; initialize string MOVEQ #0,D3 ; initialize bcd string length TST.W D6 MOVE.L A1,A2 BMI.s RtnZero ADDQ.W #1,D1 BinLoop: MOVEQ #15,D5 CMP.W D5,D6 ; D6 - D5 BGE.S @2 MOVE.W D6,D5 @2: SUBQ.W #1,D1 ; decrement number of words remaining BLT.S bcdAddr MOVE.W (A3)+,D2 bcdAddr: MOVE.L A1,A2 ; reset bcd string address ADD.W D2,D2 ; generate X if appropriate MOVE.L D3,D7 LEA 4(A2),A2 @5: MOVE.L -(A2),D0 ; put long word of string into D0 ABCD D0,D0 ROR.L #8,D0 ABCD D0,D0 ROR.L #8,D0 ABCD D0,D0 ROR.L #8,D0 ABCD D0,D0 ROR.L #8,D0 MOVE.L D0,(A2) ; put it back DBRA D7,@5 ; end of long word string loop MOVEQ #0,D0 ABCD D0,D0 BEQ.S @6 ; no X condition found ADDQ.L #1,D3 ; add new long word to string MOVE.L D0,-(A2) @6: DBRA D5,bcdAddr SUBI.W #16,D6 ; number of binary digits - 1 remaining BGE.S BinLoop MOVE.L s(A6),A0 ; s(A6) contains the address of decimal record addq #4,a0 ; address of string LEA 1(A0),A1 ; pointer to string of characters ; ; The hard part is delivering the ascii digits, stripping leading ; zeros. Use D6 as a marker: if minus then skipping leading zeros; if ; plus print any digit. ; @7: BSR.S BD1OUT BSR.S BD1OUT BSR.S BD1OUT BSR.S BD1OUT DBRA D3,@7 ; end of long word string loop ; ; Finally, stuff the string length, restore the registers, and exit. ; A0 points to the length byte, A1 points to the next character after ; the string; so (A1 - A0 - 1) is the true length. ; MOVE.W A1,D0 SUB.W A0,D0 SUBQ.B #1,D0 BEQ.S RtnZero MOVE.B D0,(A0) RTS RtnZero: MOVE.L s(A6),A0 ; s(A6) contains the address of decimal record addq #4,a0 MOVE.W #$0130,(A0) ; Return the following string, '0' RTS ; ; Utility routine to print two digits from nibbles in D1, skipping ; leading zeros, according to sign of D6. Recall that ascii digits ; have the hex form $3x. ; BD1OUT: MOVEQ #0,D1 MOVE.B (A2)+,D1 ROR.W #4,D1 ; ALIGN D1: $0000L00H BSR.S BD1DIGOUT ROL.W #4,D1 ; ALIGN D1: $0000000L ; FALL THROUGH AND RETURN ; ; Place a character from D1.B into the string (A1). ; Skip a leading 0 if D6.W is negative. ; BD1DIGOUT: TST.W D6 BPL.S BDDOIT TST.B D1 ; 0 NIBBLE? BEQ.S BDSKIPIT MOVEQ #0,D6 ; MARK NONZERO FOUND BDDOIT: ORI.B #$30,D1 ; MAKE ASCII DIGIT MOVE.B D1,(A1)+ SUB.B D1,D1 ; CLEAR FOR NEXT ROTATE BDSKIPIT: RTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; XbyA: movea.L s(a6),a0 addq #2,a0 move.w (a0),D6 ; d.exp MOVE.L x(A6),A0 ; x(A6) contains the address of x MOVE.W (A0)+,D7 ; contains sign and biased exponent BCLR.L #15,D7 ; test and clear sign bit SUBI.W #$403f,D7 ; subtract extended (bias + 64) ADD.W D6,D7 ; location of binary point to the right MOVE.W (A0)+,D3 ; contains 1st word of significand MOVE.W (A0)+,D4 ; contains 2nd word of significand MOVE.W (A0)+,D5 ; contains 3rd word of significand MOVE.W (A0)+,D6 ; contains 4th word of significand movea.L AAdr(A6),A3 adda.L #16,A3 movea.L AAdr(A6),A1 subq.L #2,A1 movea.L CAdr(A6),A4 subq.L #2,A4 ; use this as a scratch location to assist ADDX MOVE.W (A1),D0 MOVE.W D0,D2 MULU D6,D2 MOVE.L D2,(A3) ; A3 MOVE.W D0,D2 MULU D4,D2 MOVE.L D2,-(A3) ; A3-4 CLR.w -(A3) ; A3-6 clears high word LEA 4(A3),A3 ; A3-2 MOVE.W D0,D2 MULU D5,D2 ADD.L D2,(A3) ; A3-2 MULU D3,D0 MOVE.L D0,(A4)+ ; Silly but necessary ADDX.L -(A4),-(A3) ; A3-6 MOVE.L D1,A2 ; save length & use D1 as loop counter SUBQ.W #1,D1 BMI.s @2 @1: LEA 4(A3),A3 ; A3-2 MOVE.W -(A1),D0 MOVE.W D0,D2 MULU D6,D2 ADD.L D2,(A3) ; A3-2 MOVE.W D0,D2 MULU D4,D2 MOVE.L D2,(A4)+ ; Silly but necessary ADDX.L -(A4),-(A3) ; A3-6 bcc.s @98 MOVE.w #1,-(A3) ; A3-8 clears high word BRA.S @99 @98: MOVE.w #0,-(A3) ; A3-8 clears high word @99: LEA 4(A3),A3 ; A3-4 MOVE.W D0,D2 MULU D5,D2 ADD.L D2,(A3) ; A3-4 MULU D3,D0 MOVE.L D0,(A4)+ ; Silly but necessary ADDX.L -(A4),-(A3) ; A3-8 DBRA D1,@1 @2: MOVE.L A2,D1 ; restore length of loop ADDQ.w #4,D1 ; number of words MOVE.W D1,D6 ADDQ.w #1,D6 ASL.W #4,D6 ; # bits = 16 * # words ADD.W D7,D6 ; # number of integer bits moveq #0,d5 ; d5 >= 0 => binary to decimal Roundit: TST.W D6 bge.s @2 ; at least one digit to the left of binary point ; ; Make sure at least one digit is to the left of the binary point ; cmpi.w #-66,d6 ; d6 + 66 bpl.s @1 move.w #-66,d6 @1: clr.w -(a3) ; add zero word addQ.w #1,D1 ; adjust length (number of words) addI.W #16,D6 ; number - 1 of bits left of the binary point blt.s @1 ; no digits to the left of binary point @2: BSR RndStk TST.W D5 BEQ.s @8 ; no round or sticky => no rounding ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Determines if least significant bit is set ; sets lsb of D5 if lsb of significand is set ; D3 = bit location in word (A2) of lsb MOVE.W D6,D2 LSR.W #4,D2 ; divide by 16, (round bit word location) LSL.W #1,D2 ; multiply by 2, to obtain byte offset LEA 0(A3,D2.W),A2 MOVE.W (A2),D4 ; put word into D reg for BTST MOVE.W D6,D3 ; # of bits in significand ANDI.W #15,D3 ; location of round bit within word MOVE.W #$8000,D0 ; initialize mask ROR.W D3,D0 ; align mask to round bit AND.W D0,D4 BEQ.S @3 ; least significant bit clear ADDQ.W #1,D5 @3: bset #ERRX,(FPSTATE).W ; signal INEXACT move.w (FPSTATE).W,D2 ; D2 <- environment move.w d2,d4 and.w #$00e0,d4 ; check for rounding precision or type coercion '0080' beq.s @91 or.W D0,(A2) ; or in sticky bit bra.s @8 @91: BTST #14,D2 ; bit for +/-infinity rounding directions BNE.S @10 ; DOWNWARD or TOWARDZERO BTST #13,D2 BNE.S @11 ; UPWARD CMP.W #5,D5 ; D5 - 5 BLT.S @8 ; no rounding ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Increment the significand (BumpIt) @4: ADD.W D0,(A2) ; test for least significant bit BCC.S @8 @5: cmpa.L A2,A3 beq.s @6 ; register overflowed ADDQ.W #1,-(A2) BCS.S @5 bra.s @8 ; MAKE SURE THIS GETS EXCERCISED ALL FOUR WAYS (bin <--> dec & mul | div) @6: move.w #1,-(a3) ; add overflow word addQ.w #1,D1 ; adjust length (number of words) addI.W #16,D6 ; number - 1 of bits left of the binary point lea 16(a1),a1 ; for DivD case @8: TST.W (A3) BNE.S @9 LEA 2(A3),A3 ; location of first word - 1 SUBQ #1,D1 ; number of words SUBI.W #16,D6 ; number - 1 of bits left of the binary point @9: RTS @10: BTST #13,D2 ; DOWNWARD or TOWARDZERO BNE.S @8 ; TOWARD-ZERO MOVE.L x(A6),A4 ; x(A6) contains the address of x MOVE.W (A4),D2 ; contains sign and biased exponent BMI.S @4 ; - & DOWNWARD, bumpit BRA.S @8 ; + & DOWNWARD, don't bumpit @11: MOVE.L x(A6),A4 ; UPWARD MOVE.W (A4),D2 ; contains sign and biased exponent BPL.S @4 ; + & UPWARD, bumpit BRA.S @8 ; - & UPWARD, don't bumpit ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Determines if round or sticky bits exist ; D5 = 0 => no round & no sticky ; D5 = 2 => no round & sticky ; D5 = 4 => round & no sticky ; D5 = 6 => round & sticky RndStk: clr.w d5 ; initialize D5 MOVE.W D6,D3 ; # of bits in significand ADDQ.W #1,D3 ; round bit location w.r.t. left of significand MOVE.L D3,D4 LSR.W #4,D4 ; divide by 16, (round bit word location) CMP.W D1,D4 ; D4 - D1 BLE.S @1 RTS ; no round or sticky bits, no rounding @1: ANDI.W #15,D3 ; location of round bit within word MOVE.W #$8000,D0 ; initialize mask ROR.W D3,D0 ; align mask to round bit MOVE.W D4,D2 LSL.W #1,D2 ; multiply by 2, to obtain byte offset LEA 0(A3,D2.W),A2 AND.W (A2),D0 ; test for round bit BEQ.S @2 ; no round bit found MOVEQ #4,D5 @2: MOVE.W #$7FFF,D0 ; initialize mask LSR.W D3,D0 ; align mask to sticky bits AND.W (A2)+,D0 ; test for sticky bits BEQ.S @5 ; sticky bits not found yet @3: ADDQ.W #2,D5 RTS @4: TST.W (A2)+ BNE.S @3 ; sticky bit found @5: ADDQ.W #1,D4 CMP.W D1,D4 ; D4 - D1 BLE.S @4 ; keep looking for sticky bits RTS ; no sticky bits found GetX: MOVE.L x(A6),A0 ; x(A6) contains the address of x MOVE.W (A0)+,D6 ; contains sign and biased exponent BCLR.L #15,D6 ; test and clear sign bit SUBI.W #$400C,D6 ; adjusted location of binary point movea.L DAdr(A6),A3 suba.w #52,A3 MOVE.L (A0)+,(A3) ; get significand of extended MOVE.L (A0)+,4(A3) ; get significand of extended MOVEQ #3,D3 ; initial length of D3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Extended input located at (A3), length of D3 + 1 words, ; binary point D6 bits to the right of word (A3) ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; We must first normalize the power of ten. ; Then align extended value such that the last 16 bit divide will ; yield the round bit in the least significant bit. ; Then do the divide. Nrmlz10: MOVE.W D1,D7 ASL.W #4,D7 ; times 16 movea.L s(a6),a0 addq #2,a0 SUB.W (A0),D7 ; location of binary point to the right ; of first word (address (A1)) MOVE.W D1,D5 ; get word displacement ASL.W #1,D5 ; set byte displacement, save for FinDiv MOVE.W (A1),D0 ; get most significant word of divisor BMI.S @3 ; power of ten normalized @1: SUBQ.W #1,D7 ; adjust binary point MOVE.W D1,D4 ; set counter LEA 2(A1,D5.W),A0 MOVE.W #0,CCR ; clear 'X' @2: ROXL.W -(A0) ; normalize power of ten DBRA D4,@2 BPL.S @1 ; power of ten still not normalized MOVE.W (A1),D0 ; get most significant word of divisor @3: RTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Power of ten located at (A1), length of D1 + 1 words, ; binary point D7 bits to the right of word (A1) ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DivX: SUB.W D7,D6 ; # bits to generate BLE noDiv MOVE.W D6,D4 ASR.W #4,D6 ; D6.W + 1 = # of DIVU steps required ANDI.W #15,D4 ; # of shifts necessary to align final answer BEQ.S BeginD ADDQ.w #1,D3 ; append a zero word to A3 CLR.W -(A3) SUBQ #1,D4 ; adjust counter for DBRA below @4: ASL.W 8(A3) ROXL.W 6(A3) ROXL.W 4(A3) ROXL.W 2(A3) ROXL.W (A3) DBRA D4,@4 BRA.S BgnDiv BeginD: CMP.W (A3),D0 ; DO - (A3) BHI.S @1 ; Divide will succeed, no padding necessary ADDQ.w #1,D3 ; append a zero word to A3 CLR.W -(A3) BRA.S BgnDiv @1: SUBQ #1,D6 ; D6.W + 1 = # of DIVU steps required BgnDiv: BSR.s PadIt MOVEA.L A3,A0 DivLoop: MOVE.L (A0),D2 ; Address of quotient DIVU D0,D2 BVS divOver SWAP D2 MOVE.L D2,(A0) ; put result and rem back into (A3) SWAP D2 ; used in FinDiv LEA 2(A0),A0 CMPI.W #2,D5 ; byte offset of last word of divisor BLT.S CtnDv BEQ.S OneDiv MOVE.W D5,D7 ; number of bytes - 2 BCLR.L #1,D7 BSR.s MandS MOVEQ #0,D4 MOVE.W -(A4),D1 SUBX.W D4,D1 MOVE.W D1,(A4) ; 'C' Cleared, 'X' not affected. NEGX.W D7 ; test 'X' bit, 'X' - D7 TST.W D7 BNE.S OneDiv ; no 'X' bit BSR.s DecrIt OneDiv: MOVE.W D5,D7 BTST.L #1,D7 BNE.S @1 SUBQ.W #2,D7 @1: BSR.S MandS NEGX.W D7 ; test 'X' bit, 'X' - D7 TST.W D7 BNE.S CtnDv ; no 'X' bit BSR.s DecrIt CtnDv: DBRA D6,DivLoop DvFin: SUBA.L A3,A0 MOVE.W A0,D6 MOVE.W D3,D1 ASL.W #3,D6 ; multiply by 8 SUBQ #3,D6 ; # number of integer bits rts noDiv: MOVEA.L A3,A0 CLR.W -(A3) BRA.S DvFin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; PadIt ; D1 length of divisor ; D3 length of dividend ; D6 necessary length of DIVU required (similar to length i.e, 0 => 1 ; ; Extended input located at (A3), length of D3 + 1 words, ; binary point D5 bits to the right of word (A3) ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PadIt: MOVE.W D1,D7 ADD.W D6,D7 ADDQ.W #1,D7 ; number of words necessary for dividend SUB.W D3,D7 ; (D1 + D6 + 1) - D3 BLE.S @2 ; quotient has sufficent length move.w d3,d2 asl.w #1,d2 ; times 2 LEA 2(A3,D2.W),A2 ; address of first block to be cleared ADD.W D7,D3 ; adjust length ASR.W #1,D7 ; divide by 2 @1: CLR.L (A2)+ DBRA D7,@1 @2: RTS MandS: LEA 2(A1,D7.W),A2 LEA 2(A0,D7.W),A4 SUBQ.W #2,D7 ASR.W #2,D7 ; use as a counter for DBRA MOVE.W #0,CCR ; clear 'X' @1: MOVE.L -(A2),D4 MULU D2,D4 MOVE.L -(A4),D1 SUBX.L D4,D1 MOVE.L D1,(A4) ; 'C' Cleared, 'X' not affected. DBRA D7,@1 RTS DecrIt: SUBQ.W #1,-2(A0) MOVE.L D5,D1 ; #of bytes - 2 in divisor LEA 2(A1,D1.W),A2 LEA 2(A0,D1.W),A4 ASR.W #1,D1 ; use as a counter for DBRA MOVE.W #0,CCR ; clear 'X' @1: ADDX.W -(A2),-(A4) DBRA D1,@1 BCC.S DecrIt RTS divOver: CLR.W (A0)+ MOVE.W D5,D7 ; #of bytes - 2 in divisor beq.s DecrIt LEA 2(A1,D7.W),A2 LEA 0(A0,D7.W),A4 ASR.W #1,D7 ; use as a counter for DBRA subq.w #1,D7 MOVE.W #0,CCR ; clear 'X' @1: SUBX.W -(A2),-(A4) DBRA D7,@1 BSR.S DecrIt BRA CtnDv SizeExtN: neg.w D0 cmpi.w #5208,D0 ; D0 - 5208 bcs.s allct ; D0 < 5208 MOVE.W #5207,D0 ; initialize mask move.w d0,d1 neg.w d1 move.w d1,(a0) ; reset s(a6) bra.s allct SizeExt: cmpi.w #5008,D0 ; D0 - 5008 bcs.s allct ; D0 < 5008 MOVE.W #5007,D0 ; initialize mask move.w d0,(a0) ; reset s(a6) allct: moveq #0,d4 ; zero d4 (for longword comparison below) move.w d0,d4 add.w #527,d4 ; minimum value for d4 and.b #$f8,d4 ; force multiple of 8 cmpi.w #4*bgSz,d4 ; d5 - #4*bgSz, check for max value bcs.s @1 move.w #4*bgSz,d4 @1: move.w d4,d5 asr.w #2,d5 ; divide by 4 [*** result must be even ***] move.l d0,d1 ; save d0 _StackSpace ; results will be in A0 and D0 CMP.L d4,D0 ; do we have enough StackSpace? BPL.S @2 MOVEQ #28,D0 ; Stack overflow error. The stack has expanded into the heap _SysError @2: move.l d1,d0 ; restore d0 move.l (sp)+,a1 ; save return address suba.w d4,sp ; allocate more space on the stack move.l a1,-(sp) ; restore return address lea areg(A6),A1 move.L A1,AAdr(A6) suba.w d4,a1 ; -4*d5 move.L A1,DAdr(A6) adda.w d5,a1 ; -3*d5 move.L A1,CAdr(A6) adda.w d5,a1 ; -2*d5 move.L A1,BAdr(A6) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Algorithm for generating powers of ten. D0 intially contains ; the requested power of ten. On completion areg (see description ; below) will contain the actual integer power of 5. ; Ten2AReg: movea.L AAdr(A6),A1 MOVEQ #0,D2 ; make sure hi part of D2 is clear MOVE.W D0,D2 DIVU #21,D2 MOVE.W D2,D0 SWAP D2 ; get remainder into D2.LO CMPI.W #7,D2 ; D2 - 7 BLT.S Frst7 CMPI.W #14,D2 ; D2 - 14 BGE.S Third7 MOVEQ #1,D1 ; set length word LEA Tbl2,A2 SUBQ.W #7,D2 ASL.W #2,D2 ; times 4, byte offset MOVE.L 0(A2,D2.W),-(A1) BRA.S GotTen2 Third7: MOVEQ #2,D1 ; set length word LEA Tbl3,A2 SUBI.W #14,D2 MULU #6,D2 ; times 6, byte offset MOVE.L 2(A2,D2.W),-(A1) BRA.S GotTen Frst7: MOVEQ #0,D1 ; set length word LEA Tbl1,A2 ASL.W #1,D2 ; times 2, byte offset GotTen: MOVE.W 0(A2,D2.W),-(A1) GotTen2: TST.W D0 BNE.S MakeTen RTS MakeTen: BSR.s a2c MOVEQ #3,D2 ; initialize length of 10^21 movea.L BAdr(A6),A2 subq.L #4,A2 MOVE.L #$4D6E2EF5,(A2) MOVE.L #$0001B1AE,-(A2) bra.s BigLoop DoItAgn: bsr.s a2c notOdd: bsr.s bXb2b BigLoop: asr.w #1,d0 bcc.s notOdd bsr.s cXb2a tst.w d0 bgt.s DoItAgn rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; a, b & c reside in locations areg2(A6), breg2(A6), creg2(A6), ; respectively. They are stored in a string of words counting backwards ; from their starting location. The higher order words are appended ; to the lower address. D1, D2 & D3 contain their respective word ; lengths - 1. ; cXb2a: move.w d2,d1 add.w d3,d1 addq.w #1,d1 ; maximum length for areg move.w d3,d7 ; use as counter addq.w #1,d7 ; initial length for areg lsr.w #1,d7 ; divide by 2, (clear 2 words at a time) movea.L AAdr(A6),A1 @2: clr.l -(a1) ; zero out areg(a6) dbra d7,@2 movea.L AAdr(A6),A4 subq.L #2,A4 movea.L BAdr(A6),A2 subq.L #2,A2 move.w d2,d5 ; set outer counter bra.s @4 @3: clr.w -(a1) subq.L #2,a2 subq.L #2,a4 @4: move.L a4,a1 movea.L CAdr(A6),A3 move.w d3,d6 ; set inner loop counter for C @5: move.w -(a3),d7 mulu (a2),d7 suba.w #2,a1 ; adjust address of a1 add.l d7,(a1) bcc.s @7 ; check for carry propagation move.l a1,a0 @6: addq.l #1,-(a0) ; propagate carry bcs.s @6 @7: dbra d6,@5 dbra d5,@3 tst.w (a1) bne.s @10 lea 2(a1),a1 ; adjust address of a1 subq.w #1,d1 ; adjust length @10: rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; a2c: move.w d1,d3 ; areg -> creg movea.L AAdr(A6),A1 movea.L CAdr(A6),A3 lsr.w #1,d1 ; divide by 2 @1: move.l -(a1),-(a3) dbra d1,@1 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; bXb2b: move.w d2,d1 move.w d1,d7 ; use as counter asl.w #1,d1 ; double it addq.w #1,d1 ; new length movea.L AAdr(A6),A1 @2: clr.l -(a1) ; zero out areg(a6) dbra d7,@2 move.w d2,d5 ; set counter for cross products of square subq.w #1,d5 bmi.s doSqrs ; no cross products movea.L AAdr(A6),A4 ; save address subq.L #4,A4 movea.L BAdr(A6),A2 subq.L #2,A2 bra.s @4 @3: suba.w #2,a2 suba.w #4,a4 @4: move.l a4,a1 move.l a2,a3 move.w d5,d6 ; set inner loop counter for C @5: move.w -(a3),d7 mulu (a2),d7 suba.w #2,a1 ; adjust address of a1 add.l d7,(a1) bcc.s @7 move.l a1,a0 ; COULD PUSH & RESTORE FROM STACK!!! @6: addq.l #1,-(a1) bcs.s @6 move.l a0,a1 ; restore @7: dbra d6,@5 @8: dbra d5,@3 dblIt: movea.L AAdr(A6),A1 move.w #0,CCR ; clear 'X' move.w d1,d7 ; use as counter @1: roxl.w -(a1) dbra d7,@1 doSqrs: movea.L AAdr(A6),A1 movea.L BAdr(A6),A2 @5: move.w -(a2),d7 mulu d7,d7 add.l d7,-(a1) bcc.s @7 move.l a1,a0 ; COULD PUSH & RESTORE FROM STACK!!! @6: addq.l #1,-(a1) bcs.s @6 move.l a0,a1 ; restore @7: dbra d2,@5 tst.w (a1) bne.s @10 lea 2(a1),a1 ; adjust address of a1 subq.w #1,d1 ; adjust length @10: tst.w d0 bne.s a2b rts a2b: move.w d1,d2 ; areg -> breg movea.L AAdr(A6),A1 movea.L BAdr(A6),A2 lsr.w #1,d1 ; divide by 2 @1: move.l -(a1),-(a2) dbra d1,@1 rts Tbl1: DC.W $0001 ; 5^0 DC.W $0005 ; 5^1 DC.W $0019 ; 5^2 DC.W $007D ; 5^3 DC.W $0271 ; 5^4 DC.W $0C35 ; 5^5 DC.W $3D09 ; 5^6 Tbl2: DC.W $0001 DC.W $312D ; 5^7 DC.W $0005 DC.W $F5E1 ; 5^8 DC.W $001D DC.W $CD65 ; 5^9 DC.W $0095 DC.W $02F9 ; 5^10 DC.W $02E9 DC.W $0EDD ; 5^11 DC.W $0E8D DC.W $4A51 ; 5^12 DC.W $48C2 DC.W $7395 ; 5^13 Tbl3: DC.W $0001 DC.W $6BCC DC.W $41E9 ; 5^14 DC.W $0007 DC.W $1AFD DC.W $498D ; 5^15 DC.W $0023 DC.W $86F2 DC.W $6FC1 ; 5^16 DC.W $00B1 DC.W $A2BC DC.W $2EC5 ; 5^17 DC.W $0378 DC.W $2DAC DC.W $E9D9 ; 5^18 DC.W $1158 DC.W $E460 DC.W $913D ; 5^19 DC.W $56BC DC.W $75E2 DC.W $D631 ; 5^20