6502/of816
1
0
Fork 0
mirror of https://github.com/mgcaret/of816.git synced 2025-04-05 08:37:10 +00:00
Code Issues Projects Releases Wiki Activity

fix #5

Browse Source
This commit is contained in:
mgcaret 2020-03-22 17:11:32 -07:00
parent e789327c87
commit cbf755a4aa
2 changed files with 45 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
asm/forth-dictionary.s
View File

@ -3376,7 +3376,7 @@ eword
; H: ( d n1 -- n2 n3 ) Floored divide d by n1, giving quotient n3 and remainder n2.
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
lda STACKBASE+0,x
ora STACKBASE+2,x
@ -3384,6 +3384,34 @@ dword FMDIVMOD,"FM/MOD"
jsr _fmdivmod
bcs _overflow
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
ENTER
.dword DUP

29
asm/mathlib.s
View File

@ -251,10 +251,10 @@ l2: dec XR ; next bit
; ( d n -- ud u )
.proc _dnabs
lda STACKBASE+2,x ; take absolute value of n1
bpl :+
bpl :+ ; if needed
jsr _negate
: lda STACKBASE+6,x ; take absolute value of d
bpl :+
bpl :+ ; if needed
dtneg: inx
inx
inx
@ -298,26 +298,29 @@ overflow: pla ; carry is set, pla does not affect it
.endproc
_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
stz WR
lda STACKBASE+2,x
lda STACKBASE+2,x ; high word of n1
pha ; save divisor sign
bpl :+
dec WR
jsr _dnabs
: lda STACKBASE+6,x
jsr _negate ; negate both if n1 was negative
jsr _dtucknegate
: lda STACKBASE+6,x ; highest word of d1
bpl :+
lda STACKBASE+0,x
lda STACKBASE+0,x ; it's negative, add n1 to high cell of d1
clc
adc STACKBASE+4,x
sta STACKBASE+4,x
lda STACKBASE+2,x
adc STACKBASE+6,x
sta STACKBASE+6,x
: jsr _umdivmod
bcs :+
bit WR
bpl :+
jsr _tucknegate ; clears carry
: jsr _umdivmod ; UM/MOD
pla ; get divisor sign back (carry unaffected)
bcs :+ ; error
bpl :+ ; if n1 was positive
jsr _tucknegate ; if it was, negate the result (clears carry)
: rts
.endproc