commit 1a02bdf307a1ce920ae5ad98832152db23b9bc8a
parent b5cd66c29256d3ab4ed670ecb321ac93a67d6902
Author: Christian Ermann <christianermann@gmail.com>
Date: Wed, 4 Dec 2024 21:47:13 -0800
Add '"' as a string prefix
Diffstat:
| M | src/forth.s | | | 193 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------ |
1 file changed, 180 insertions(+), 13 deletions(-)
diff --git a/src/forth.s b/src/forth.s
@@ -226,8 +226,13 @@ defvar ":", prefix_define, 0x3F0CB86D
.int _prefix_execute
.int string_to_define
-defvar "latest-prefix", latest_prefix, 0x86C823C5
+defvar "\"", prefix_string, 0x270C92A5
+ .int 0x22
.int _prefix_define
+ .int token_to_string_comma
+
+defvar "latest-prefix", latest_prefix, 0x86C823C5
+ .int _prefix_string
# -----------------------------------------------------------------------------
# constants and variables
@@ -362,37 +367,65 @@ defword "source", source, 0x1BCF29D8
jal two_fetch
exit
-defcode "skip-while", skip_while, 0xBBFD4B86
+skip_escape:
+ addi x, x, 1
+ addi w, w, -1
+ blez w, _skip_escape_undo
+ lb y, 0(x)
+ addi y, y, -32
+ blez y, _skip_escape_undo
+_skip_escape:
+ addi x, x, 1
+ addi w, w, -1
+ lb y, 0(x)
+ ret
+_skip_escape_undo:
+ li y, 92
+ addi x, x, -1
+ addi w, w, 1
+ ret
+
+defword "skip-while", skip_while, 0xBBFD4B86
# ( addr1 len1 -- addr2 len2 )
lw x, 0*cell(psp)
blez w, _skip_while_done
- la y, _delimiter
- lb y, 0(y)
+ la t0, _delimiter
+ lb t0, 0(t0)
+ li t1, 92
_skip_while_loop:
- lb t0, 0(x)
- bne t0, y, _skip_while_done
+ lb y, 0(x)
+ bne y, t1, _skip_while_continue
+ jal skip_escape
+ blez w, _skip_while_done
+_skip_while_continue:
+ bne y, t0, _skip_while_done
addi x, x, 1
addi w, w, -1
bgtz w, _skip_while_loop
_skip_while_done:
sw x, 0*cell(psp)
- next
+ exit
-defcode "skip-until", skip_until, 0x661D5D67
+defword "skip-until", skip_until, 0x661D5D67
# (addr1 len1 -- addr2 len2 )
lw x, 0*cell(psp)
blez w, _skip_until_done
- la y, _delimiter
- lb y, 0(y)
+ la t0, _delimiter
+ lb t0, 0(t0)
+ li t1, 92
_skip_until_loop:
- lb t0, 0(x)
- beq t0, y, _skip_until_done
+ lb y, 0(x)
+ bne y, t1, _skip_until_continue
+ jal skip_escape
+ blez w, _skip_until_done
+_skip_until_continue:
+ beq y, t0, _skip_until_done
addi x, x, 1
addi w, w, -1
bgtz w, _skip_until_loop
_skip_until_done:
sw x, 0*cell(psp)
- next
+ exit
defword "parse", parse, 0x423B42EC
# ( delimiter -- addr len )
@@ -420,6 +453,39 @@ defword "parse", parse, 0x423B42EC
la x, _tick_source
lw x, 1*cell(x)
sub y, w, x
+ addi y, y, 1
+ la x, _source_offset
+ sw y, 0(x)
+ # set outputs
+ pop_ret x
+ sw x, 0*cell(psp)
+ sub w, w, x
+ exit
+
+defword "parse-until", parse_until, 0x6266DA65
+ # ( delimiter -- addr len )
+ # set delimiter
+ la x, _delimiter
+ sw w, 0(x)
+ # load source
+ la x, _tick_source
+ lw w, 0*cell(x)
+ lw x, 1*cell(x)
+ # apply offset
+ la y, _source_offset
+ lw y, 0*cell(y)
+ add x, x, y
+ sub w, w, y
+ push_ret x
+ # find end of token
+ push x
+ jal skip_until
+ # compute offset
+ lw w, 0*cell(psp)
+ la x, _tick_source
+ lw x, 1*cell(x)
+ sub y, w, x
+ addi y, y, 1
la x, _source_offset
sw y, 0(x)
# set outputs
@@ -433,6 +499,82 @@ defword "parse-word", parse_word, 0xB218226F
jal parse
exit
+defword "token>string", token_to_string, 0x7EB3F3A5
+ # ( addr len -- addr len )
+ addi psp, psp, 1*cell
+ # rewind to beginning of string
+ la x, _source_offset
+ lw y, 0(x)
+ sub y, y, w
+ addi y, y, -1
+ sw y, 0(x)
+ # parse string
+ li w, 0x22
+ jal parse_until
+ jal translate_escape
+ exit
+
+defword "token>string,", token_to_string_comma, 0xFE4860AB
+ jal token_to_string
+ # lit-string
+ push w
+ la w, lit_string
+ jal jal_to
+ jal compile_comma
+ # len [chars]
+ push w
+ jal compile_comma
+ la x, _code_pointer
+ lw x, 0(x)
+ push x
+ push_ret w
+ jal char_move
+ # set code pointer to after string
+ pop_ret x
+ la y, _code_pointer
+ lw t0, 0*cell(y)
+ add t0, t0, x
+ sw t0, 0*cell(y)
+ jal align_code
+ push_imm -1
+ exit
+
+defcode "translate-escape", translate_escape, 0x913F36AB
+ # ( addr len -- addr len )
+ blez w, _translate_escape_done
+ lw x, 0*cell(psp) # src
+ mv y, x # dst
+_translate_escape_loop:
+ lb t0, 0(x)
+ addi x, x, 1
+ addi y, y, 1
+ addi w, w, -1
+ blez w, _translate_escape_done
+ addi t0, t0, -92
+ beqz t0, _translate_escape
+ j _translate_escape_loop
+_translate_escape:
+ lb t0, 0(x)
+ mv t1, t0
+ addi x, x, 1
+ addi w, w, -1
+_translate_escape_lf:
+ addi t0, t0, -110
+ bnez t0, _translate_escape_cr
+ li t1, 0x0A
+ j _translate_escape_store
+_translate_escape_cr:
+ addi t0, t0, -4
+ bnez t0, _translate_escape_store
+ li t1, 0x0D
+_translate_escape_store:
+ sb t1, -1(y)
+ bgtz w, _translate_escape_loop
+_translate_escape_done:
+ lw x, 0*cell(psp)
+ sub w, y, x
+ next
+
defcode ">number", to_number, 0x2F770E4C
mv x, w
pop w
@@ -946,6 +1088,23 @@ defcode "char+", char_plus, 0x25A90E02
addi w, w, 1
next
+defcode "cmove", char_move, 0x199E414F
+ # ( src-addr dst-addr n -- )
+ lw x, 0*cell(psp)
+ lw y, 1*cell(psp)
+ beqz w, _cmove_done
+_cmove_loop:
+ lb t0, 0(y)
+ sb t0, 0(x)
+ addi x, x, 1
+ addi y, y, 1
+ addi w, w, -1
+ bnez w, _cmove_loop
+_cmove_done:
+ lw w, 2*cell(psp)
+ addi psp, psp, 3*cell
+ next
+
# -----------------------------------------------------------------------------
# dictionary management
# -----------------------------------------------------------------------------
@@ -1019,6 +1178,14 @@ defword "align", align, 0x602C63DE
jal store
exit
+defcode "align-code", align_code, 0xBC9CE4E0
+ la x, _code_pointer
+ lw y, 0(x)
+ addi y, y, cell-1
+ andi y, y, -cell
+ sw y, 0(x)
+ next
+
# -----------------------------------------------------------------------------
# stack manipulation
# -----------------------------------------------------------------------------
