mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-06-14 02:29:29 +00:00
4325cdcc78
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
2055 lines
48 KiB
Plaintext
2055 lines
48 KiB
Plaintext
;
|
|
; 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} <klh 11apr90>
|
|
cmp.w d3,d1 ; d1 - d3 <klh 11apr90>
|
|
ble.s @1 ; d1 <= d3 <klh 11apr90>
|
|
move.w d3,d4 ; d4 := max {d1, d3} <klh 11apr90>
|
|
@1:
|
|
tst.w d2 ; <klh 11apr90>
|
|
beq.s RtDvWS ; only one word in A1 & A3 <klh 11apr90>
|
|
lea 2(a1),a2 ; <klh 11apr90>
|
|
lea 2(a3),a4 ; <klh 11apr90>
|
|
moveq #0,d2 ; <klh 11apr90>
|
|
@2:
|
|
addq.w #1,d2 ; <klh 11apr90>
|
|
cmp.w d2,d1 ; d1 - d2 <klh 11apr90>
|
|
bge.s @3 ; d1 >= d2, don't clear (a2) <klh 11apr90>
|
|
clr.w (a2) ; <klh 11apr90>
|
|
@3:
|
|
cmp.w d2,d3 ; d3 - d2 <klh 11apr90>
|
|
bge.s @4 ; d3 >= d2, don't clear (a4) <klh 11apr90>
|
|
clr.w (a4) ; <klh 11apr90>
|
|
@4:
|
|
cmpm.w (a4)+,(a2)+ ; <klh 11apr90>
|
|
bne.s RtDvWS ; <klh 11apr90>
|
|
cmp.w d2,d4 ; d4 - d2 <klh 11apr90>
|
|
bgt.s @2 ; d4 > d2, keep looking <klh 11apr90>
|
|
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 <klh 11apr90>
|
|
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 <klh 11apr90>
|
|
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
|
|
|
|
|
|
|