diff --git a/asm/forth-dictionary.s b/asm/forth-dictionary.s index 073e56c..9e460f4 100644 --- a/asm/forth-dictionary.s +++ b/asm/forth-dictionary.s @@ -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 diff --git a/asm/mathlib.s b/asm/mathlib.s index 0c06f2c..ca49e3f 100644 --- a/asm/mathlib.s +++ b/asm/mathlib.s @@ -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