mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-09-06 18:54:30 +00:00
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: <09> 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
|
|||
|
|
|||
|
|
|||
|
|