The following is Garth Wilson's corrected UM/MOD code for Forth,
compared to the buggy fig-Forth, per
http://6502.org/source/integers/ummodfix/ummodfix.htm
HEADER "UM/MOD", NOT_IMMEDIATE ; ( ud u -- rem quot )
CODE ; (Make Forth CFA point to PFA for a code definition.)
SEC
LDA 2,X ; Subtract hi cell of dividend by
SBC 0,X ; divisor to see if there's an overflow condition.
LDA 3,X
SBC 1,X
BCS oflo$ ; Branch if /0 or overflow.
LDA #11H ; Loop 17x.
STA N ; Use N for loop counter.
loop: ROL 4,X ; Rotate dividend lo cell left one bit.
ROL 5,X
DEC N ; Decrement loop counter.
BEQ end$ ; If we're done, then branch to end.
ROL 2,X ; Otherwise rotate dividend hi cell left one bit.
ROL 3,X
STZ N+1
ROL N+1 ; Rotate the bit carried out of above into N+1.
SEC
LDA 2,X ; Subtract dividend hi cell minus divisor.
SBC 0,X
STA N+2 ; Put result temporarily in N+2 (lo byte)
LDA 3,X
SBC 1,X
TAY ; and Y (hi byte).
LDA N+1 ; Remember now to bring in the bit carried out above.
SBC #0
BCC loop
LDA N+2 ; If that didn't cause a borrow,
STA 2,X ; make the result from above to
STY 3,X ; be the new dividend hi cell
BRA loop ; and then brach up. (NMOS 6502 can use BCS here.)
oflo$: LDA #FFH ; If overflow or /0 condition found,
STA 2,X ; just put FFFF in both the remainder
STA 3,X
STA 4,X ; and the quotient.
STA 5,X
end$: INX ; When you're done, show one less cell on data stack,
INX ; (INX INX is exactly what the Forth word DROP does)
JMP SWAP ; and swap the two top cells to put quotient on top.
; (Actually you'll jump to the beginning of SWAP's
; executable code. Assembler label "SWAP" is at SWAP's
; PFA, not the CFA that ' SWAP would give you in Forth.
;-------------------