mirror of https://github.com/mgcaret/of816.git
fix #5
This commit is contained in:
parent
e789327c87
commit
cbf755a4aa
|
@ -3376,7 +3376,7 @@ eword
|
||||||
|
|
||||||
; H: ( d n1 -- n2 n3 ) Floored divide d by n1, giving quotient n3 and remainder n2.
|
; H: ( d n1 -- n2 n3 ) Floored divide d by n1, giving quotient n3 and remainder n2.
|
||||||
dword FMDIVMOD,"FM/MOD"
|
dword FMDIVMOD,"FM/MOD"
|
||||||
.if 0 ; primitive, using math lib FM/MOD code based on SM/REM
|
.if 1 ; primitive, using math lib FM/MOD code
|
||||||
jsr _3parm
|
jsr _3parm
|
||||||
lda STACKBASE+0,x
|
lda STACKBASE+0,x
|
||||||
ora STACKBASE+2,x
|
ora STACKBASE+2,x
|
||||||
|
@ -3384,6 +3384,34 @@ dword FMDIVMOD,"FM/MOD"
|
||||||
jsr _fmdivmod
|
jsr _fmdivmod
|
||||||
bcs _overflow
|
bcs _overflow
|
||||||
NEXT
|
NEXT
|
||||||
|
.elseif 1 ; secondary, using UM/MOD
|
||||||
|
ENTER
|
||||||
|
.dword DUP
|
||||||
|
.dword PtoR
|
||||||
|
.dword DUP
|
||||||
|
.dword ZEROLT
|
||||||
|
.dword _IF
|
||||||
|
.dword :+
|
||||||
|
.dword NEGATE
|
||||||
|
.dword PtoR
|
||||||
|
.dword DNEGATE
|
||||||
|
.dword RtoP
|
||||||
|
: .dword PtoR
|
||||||
|
.dword DUP
|
||||||
|
.dword ZEROLT
|
||||||
|
.dword RCOPY
|
||||||
|
.dword LAND
|
||||||
|
.dword PLUS
|
||||||
|
.dword RtoP
|
||||||
|
.dword UMDIVMOD
|
||||||
|
.dword RtoP
|
||||||
|
.dword ZEROLT
|
||||||
|
.dword _IF
|
||||||
|
.dword :+
|
||||||
|
.dword SWAP
|
||||||
|
.dword NEGATE
|
||||||
|
.dword SWAP
|
||||||
|
: EXIT
|
||||||
.else ; secondary, using SM/REM
|
.else ; secondary, using SM/REM
|
||||||
ENTER
|
ENTER
|
||||||
.dword DUP
|
.dword DUP
|
||||||
|
|
|
@ -251,10 +251,10 @@ l2: dec XR ; next bit
|
||||||
; ( d n -- ud u )
|
; ( d n -- ud u )
|
||||||
.proc _dnabs
|
.proc _dnabs
|
||||||
lda STACKBASE+2,x ; take absolute value of n1
|
lda STACKBASE+2,x ; take absolute value of n1
|
||||||
bpl :+
|
bpl :+ ; if needed
|
||||||
jsr _negate
|
jsr _negate
|
||||||
: lda STACKBASE+6,x ; take absolute value of d
|
: lda STACKBASE+6,x ; take absolute value of d
|
||||||
bpl :+
|
bpl :+ ; if needed
|
||||||
dtneg: inx
|
dtneg: inx
|
||||||
inx
|
inx
|
||||||
inx
|
inx
|
||||||
|
@ -298,26 +298,29 @@ overflow: pla ; carry is set, pla does not affect it
|
||||||
.endproc
|
.endproc
|
||||||
_tucknegate = _smdivrem::tneg
|
_tucknegate = _smdivrem::tneg
|
||||||
|
|
||||||
|
; ( d1 n1 -- n2 n3 )
|
||||||
|
; Divide dividend d1 by divisor n1, giving the floored quotient n3 and the remainder n2.
|
||||||
|
; Input and output stack arguments are signed.
|
||||||
.proc _fmdivmod
|
.proc _fmdivmod
|
||||||
stz WR
|
lda STACKBASE+2,x ; high word of n1
|
||||||
lda STACKBASE+2,x
|
pha ; save divisor sign
|
||||||
bpl :+
|
bpl :+
|
||||||
dec WR
|
jsr _negate ; negate both if n1 was negative
|
||||||
jsr _dnabs
|
jsr _dtucknegate
|
||||||
: lda STACKBASE+6,x
|
: lda STACKBASE+6,x ; highest word of d1
|
||||||
bpl :+
|
bpl :+
|
||||||
lda STACKBASE+0,x
|
lda STACKBASE+0,x ; it's negative, add n1 to high cell of d1
|
||||||
clc
|
clc
|
||||||
adc STACKBASE+4,x
|
adc STACKBASE+4,x
|
||||||
sta STACKBASE+4,x
|
sta STACKBASE+4,x
|
||||||
lda STACKBASE+2,x
|
lda STACKBASE+2,x
|
||||||
adc STACKBASE+6,x
|
adc STACKBASE+6,x
|
||||||
sta STACKBASE+6,x
|
sta STACKBASE+6,x
|
||||||
: jsr _umdivmod
|
: jsr _umdivmod ; UM/MOD
|
||||||
bcs :+
|
pla ; get divisor sign back (carry unaffected)
|
||||||
bit WR
|
bcs :+ ; error
|
||||||
bpl :+
|
bpl :+ ; if n1 was positive
|
||||||
jsr _tucknegate ; clears carry
|
jsr _tucknegate ; if it was, negate the result (clears carry)
|
||||||
: rts
|
: rts
|
||||||
.endproc
|
.endproc
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue