: #       ( +d1 -- +d2)
     base @ ud/mod rot dup 9 > 7 and + Ascii 0 + hold ;

; - - - - - - - - - - - - - - - - - - - - - - - - - - -
; #  ( ud1 -- ud2 )
; Extract least significant digit of ud1, convert to
;   ASCII and save that digit in HOLD area.
; ud2 is the quotient of ud1 / BASE
; Undefined behavior for a BASE outside [2..20]
;
sharp:
        lda  #0         ;partial remainder
        ldy  #32        ;loop counter
sharp2:
        asl  stackl,x   ;Dividend in TOS:NOS (h:l)
        rol  stackh,x   ;  is gradually replaced
        rol  TOS        ;  with the quotient
        rol  TOS+1      ;a is gradually replaced
        rol             ;  with the remainder
        cmp  BASE       ;partial remainder < BASE?
        bcc  sharp3     ;  no: update the partial
        sbc  BASE       ;    remainder and partial
        inc  stackl,x   ;    quotient
sharp3:
        dey
        bne  sharp2     ;loop 32 times
        cmp  #10
        sed
        adc  #'0'       ;adjust remainder to ASCII
        cld
        jsr  pushya
        jmp  hold       ;HOLD ;

; DTC 65m32 Forth
; a = TOS, x = PSP, y = IP, s = RSP, u = UP

        NOT_IMM '2PICK'
_2pick:  ; ( x1 x2 x3 -- x1 x2 x3 x1 )
        sta  ,-x
        lda  2,x
        jmp  (,y+)      ; NEXT

        NOT_IMM '-ROT'
_mrot:  ; ( x1 x2 x3 -- x3 x1 x2 )
        exa  1,x
        jmp  _swap

        NOT_IMM 'PICK'
_pick:  ; ( xu ... x2 x1 x0 u -- xu ... x2 x1 x0 xu )
        add  #,x
        jmp  _fetch

; - - - - - - - - - - - - - - - - - - - - - - - - - - -
; UD/MOD  ( ud1 u1 -- u2 ud2 )
; Dividend ud1 and Quotient ud2 are 32-bits unsigned
; Divisor u1 and Remainder u2 are 16-bits unsigned
; Invalid inputs and/or outputs are silently ignored
;
udslashmod:
        ldy  #32        ; init loop counter
        lda  #0         ; init partial remainder
        sta  N          ;   in N:A (h:l)
udsm2:
        asl  stackl+1,x ; dividend in NOS:3OS (h:l)
        rol  stackh+1,x ;   is gradually replaced
        rol  stackl,x   ;   with the quotient
        rol  stackh,x
        rol             ; N:A is gradually replaced
        rol  N          ;   with the remainder
        pha
        cmp  TOS        ; TOS holds the divisor
        lda  N          ; partial remainder >= TOS?
        sbc  TOS+1
        bcc  udsm3
        sta  N          ;   yes: update the partial
        pla             ;     remainder and set the
        sbc  TOS        ;     low bit in the partial
        pha             ;     quotient
        inc  stackl+1,x
udsm3:
        pla
        dey
        bne  udsm2      ; loop 32 times
        ldy  N
        jsr  put
        jsr  rot
        jmp  rot

; UD/MOD  ( ud1 u1 -- u2 ud2 )
; Dividend ud1 and Quotient ud2 are 32-bits unsigned
; Divisor u1 and Remainder u2 are 16-bits unsigned
; Invalid inputs and/or outputs are silently ignored
;
udslashmod:
        ldy  #32        ; init loop counter
        lda  #0         ; init partial remainder
        sta  N          ;   in N:A (h:l)
udsm2:
        asl  stackl+1,x ; dividend in NOS:3OS (h:l)
        rol  stackh+1,x ;   is gradually replaced
        rol  stackl,x   ;   with the quotient
        rol  stackh,x
        rol             ; N:A is gradually replaced
        rol  N          ;   with the remainder
        pha
        cmp  TOS        ; TOS holds the divisor
        lda  N          ; partial remainder >= TOS?
        sbc  TOS+1
        bcc  udsm3
        sta  N          ;   yes: update the partial
        pla             ;     remainder and set the
        sbc  TOS        ;     low bit in the partial
        inc  stackl+1,x ;     quotient
        .db  $24        ;   BIT zp naked opcode
udsm3:
        pla
        dey
        bne  udsm2      ; loop 32 times
        ldy  N
        jsr  put
        jsr  rot
        jmp  rot

        jsr  put
        jsr  rot
        jmp  rot

        sta  TOS
        sty  TOS+1
        jmp  dashrot

UD/MOD   ( ud1 u2 – u3 ud4 )
udslashmod
        ldy #2
        jsr locals        ; dividend to n0..n3
        ;clc
        ;ldy #0           ; locals does this for us
        stx storex
        ldx #33
        tya
        beq udslashmodb   ; bra to initialization code
udslashmoda
        rol n+4           ; [5] I don't know what this 2-bytes is called
        rol n+5           ; [5] trial minuend or something like that
        sec               ; [2]
        lda n+4           ; [3]
        sbc tos           ; [3]
        tay               ; [2]
        lda n+5           ; [3]
        sbc tos+1         ; [3]
        bcc udslashmodc   ; save or abandon the trial subtraction
udslashmodb
        sty n+4           ; [2+3+3] or [3]?
        sta n+5           ; treating this as [~6] clocks on average
udslashmodc
        rol n+0           ; [5]
        rol n+1           ; [5]
        rol n+2           ; [5]
        rol n+3           ; [5]
        dex               ; [2]
        bne udslashmoda   ; [3]
                ; [54] or [59] clocks for 33x main loop = [1839]

        ldx storex

; this is the end [22-bytes]
        ldy n+5
        sty tos+1
        lda n+4
        sta tos           ; put remainder on stack
        ldy n+1
        lda n+0
        jsr push6502      ; push quotient(lo) on stack
        ldy n+3
        lda n+2
        jmp pushya        ; push quotient(hi) on stack

; alternate ending [8-bytes]
        brk
        .byt ld | N2
        .byt st | TOS
        .byt ld | N0
        .byt push
        .byt ld | N1
        .byt push
        .byt nxt