rewrite format module in assembly

Makefile

@@ -19,7 +19,7 @@ PETCAT = petcat # text conversion utility, included in VICE package
 SRC_DIR = forth
 SRC_NAMES = base debug v asm gfx gfxdemo rnd sin ls turtle fractals \
     sprite doloop sys labels mml mmldemo sid spritedemo \
-    format require compat timer float viceutil turnkey \
+    require compat timer float viceutil turnkey \
     wordlist io open dos see accept
 SRCS = $(addprefix $(SRC_DIR)/,$(addsuffix .fs,$(SRC_NAMES)))
 

asm/core.asm

@@ -370,8 +370,9 @@ FILL_Y
     jmp	-
 
     +BACKLINK "base", 4
-    +VALUE	BASE
 BASE
+    +VALUE	_BASE
+_BASE
     !word 16
 
     +BACKLINK "2*", 2
@@ -380,6 +381,7 @@ BASE
     rts
 
     +BACKLINK "rot", 3 ; ( a b c -- b c a )
+ROT
     ldy MSB+2, x
     lda MSB+1, x
     sta MSB+2, x
@@ -395,6 +397,7 @@ BASE
     rts
 
     +BACKLINK "+!", 2 ; ( num addr -- )
+PLUS_STORE
     lda LSB,x
     sta W
     lda MSB,x

asm/durexforth.asm

@@ -156,6 +156,7 @@ MINUS_ONE
 !src "io.asm"
 !src "lowercase.asm"
 !src "disk.asm"
+!src "format.asm"
 
 BOOT_STRING
 !src "../build/version.asm"

asm/format.asm

@@ -0,0 +1,104 @@
+; <# #> HOLD SIGN # #S U. . SPACE
+
+.hold_start = $3fc
+
+; : <# $3fc holdp ! ;
++BACKLINK "<#", 2
+LESS_NUMBER_SIGN
+    lda #<.hold_start
+    sta .holdp
+    rts
+
+; : #> 2drop holdp @ $3fc over - ;
++BACKLINK "#>", 2
+NUMBER_SIGN_GREATER
+    lda .holdp
+    sta LSB+1,x
+    lda #>.hold_start
+    sta MSB+1,x
+    lda #<.hold_start
+    sec
+    sbc .holdp
+    sta LSB,x
+    lda #0
+    sta MSB,x
+    rts
+
+; : hold -1 holdp +! holdp @ c! ;
++BACKLINK "hold", 4
+HOLD
+    dec .holdp
+    inx
+    lda LSB-1,x
+.holdp = * + 1
+    sta .hold_start
+    rts
+
+; : sign 0< if '-' hold then ;
++BACKLINK "sign", 4
+SIGN
+    inx
+    lda MSB-1,x
+    and #$80
+    bne +
+    rts
++   jsr LITC
+    !byte '-'
+    jmp HOLD
+
+; : # base @ ud/mod rot
+; dup $a < if 7 - then $37 + hold ;
++BACKLINK "#", 1
+NUMBER_SIGN
+    jsr BASE
+    jsr FETCH
+    jsr UD_MOD
+    jsr ROT
+    lda LSB,x
+    cmp #10
+    bcs +
+    sbc #6
++   clc
+    adc #$37
+    sta LSB,x
+    jmp HOLD
+
+; : #s # begin 2dup or while # repeat ;
++BACKLINK "#s", 2
+NUMBER_SIGN_S
+    jsr NUMBER_SIGN
+    lda LSB,x
+    ora MSB,x
+    ora LSB+1,x
+    ora MSB+1,x
+    bne NUMBER_SIGN_S
+    rts
+
+; : u. 0 <# #s #> type space ;
++BACKLINK "u.", 2
+    jsr ZERO
+    jsr LESS_NUMBER_SIGN
+    jsr NUMBER_SIGN_S
+    jsr NUMBER_SIGN_GREATER
+    jsr TYPE
+    jmp SPACE
+
+; : . dup abs 0 <# #s rot sign #>
+; type space ;
++BACKLINK ".", 1
+DOT
+    jsr DUP
+    jsr ABS
+    jsr ZERO
+    jsr LESS_NUMBER_SIGN
+    jsr NUMBER_SIGN_S
+    jsr ROT
+    jsr SIGN
+    jsr NUMBER_SIGN_GREATER
+    jsr TYPE
+    jmp SPACE
+
++BACKLINK "space", 5
+SPACE
+    lda #' '
+    jmp PUTCHR

asm/interpreter.asm

@@ -584,7 +584,7 @@ SLASH_STRING ; ( addr u n -- addr u )
     jmp SWAP
 
 apply_base
-    sta BASE
+    sta _BASE
     dec .chars_to_process
     inc W3
     bne +
@@ -603,7 +603,7 @@ READ_NUMBER
     lda LSB+1,x
     sta W3
 
-    lda BASE
+    lda _BASE
     sta OLD_BASE
 
     ldy #0
@@ -642,8 +642,8 @@ READ_NUMBER
     jmp .prepare_next_char
 
 .next_digit
-    ; number *= BASE
-    lda BASE
+    ; number *= _BASE
+    lda _BASE
     sta LSB,x
     jsr U_M_STAR
     lda LSB,x
@@ -669,7 +669,7 @@ READ_NUMBER
     cmp #10
     bcc .parse_failed
 
-+   cmp BASE
++   cmp _BASE
     bcs .parse_failed
 
     adc LSB+1,x
@@ -684,7 +684,7 @@ READ_NUMBER
 .parse_done
 OLD_BASE = * + 1
     lda #0
-    sta BASE
+    sta _BASE
 
     lda LSB+1,x
     sta LSB+3,x

asm/math.asm

@@ -255,6 +255,7 @@ DIVISOR_SIGN = * + 1
 
     ; (ud1 u2 -- urem udquot)
     +BACKLINK "ud/mod", 6
+UD_MOD
     lda LSB,x
     sta LSB - 1,x
     sta W3

forth/base.fs

@@ -90,7 +90,6 @@ code split swap lda,# ldy,#
 ( to free up space, pad could be
   e.g. HERE+34 instead )
 $35b constant pad
-: space bl emit ;
 : spaces ( n -- )
 begin ?dup while space 1- repeat ;
 
@@ -142,8 +141,6 @@ here latest >xt 1+ (to)
 : */ */mod nip ;
 ( ...from FIG UK )
 
-.( format..) parse-name format included
-
 : .s depth begin ?dup while
 dup pick . 1- repeat ;
 
@@ -172,7 +169,7 @@ marker ---modules---
 
 \ hides private words
 hide 1mi hide 2mi hide 23mi hide 3mi
-hide holdp hide latestxt
+hide latestxt
 hide dodoes hide (abort")
 
 .( labels..) include labels