commit e96b14c147c6749d0be977ace11d395bfdf4c50f
parent 8499cfc19bb5b2dab4715ca6493089429db35b31
Author: Christian Ermann <christianermann@gmail.com>
Date: Thu, 7 Nov 2024 14:46:24 -0800
Factor 'parse-string' into smaller words
Diffstat:
| M | forth.f | | | 56 | ++++++++++++++++++++++++++++++++++++++++++++------------ |
| M | forth.s | | | 40 | +++++++++++++++++++--------------------- |
2 files changed, 63 insertions(+), 33 deletions(-)
diff --git a/forth.f b/forth.f
@@ -25,23 +25,55 @@
: 'r' [ parse-char r ] literal ;
: 'z' [ parse-char z ] literal ;
-: parse-string
- here
+: parse-until
+ delimiter !
+ source source-offset @ apply-offset
+ over >r
+ skip-until
+ 2dup parse-offset source-offset !
+ drop r> tuck - ;
+
+: cmove
+ ( addr1 addr2 u -- )
+ swap >r
begin
- parse-key dup dup '"' <> and
+ dup
while
+ over c@
+ r> tuck c! 1 + >r
+ 1 apply-offset
+ repeat
+ 2drop r> drop ;
+
+: translate-escape-code
+ ( char -- char )
+ dup 'n' = if drop 10 else
+ dup 'r' = if drop 13 else
+ dup 'z' = if drop 0 else
+ dup '"' = if else
+ dup '\' = if else
+ then then then then then ;
+
+: translate-escape-string
+ ( addr len -- len-diff )
+ over >r
+ begin
+ dup
+ while
+ over c@
dup '\' = if
- drop parse-key
- dup 'n' = if drop 10 else
- dup 'r' = if drop 13 else
- dup 'z' = if drop 0 else
- dup '"' = if else
- dup '\' = if else
- then then then then then
+ drop 1 apply-offset over c@
+ translate-escape-code
then
- over c! 1 +
+ r> tuck c! 1 + >r
+ 1 apply-offset
repeat
- drop here - here swap ;
+ drop r> - ;
+
+: parse-string
+ '"' parse-until
+ here swap 2dup 2>r cmove 2r>
+ 2dup translate-escape-string - ;
: "
compiling? if
diff --git a/forth.s b/forth.s
@@ -326,26 +326,6 @@ defword "parse", parse, 0x423B42EC
defword "parse-word", parse_word, 0xB218226F
.int bl, parse, exit
-defcode "parse-key", parse_key, 0xB78FDA4A
- la w, _tick_source
- load_cell x, 0(w)
- load_cell w, cell(w)
- la y, _source_offset
- load_cell y, 0(y)
- add w, w, y
- sub x, x, y
- beqz x, 2f
-1:
- lb t0, 0(w)
- addi y, y, 1
- la t1, _source_offset
- store_cell y, 0(t1)
- push t0
- next
-2:
- mv t0, zero
- j 1b
-
defcode "parse-char", parse_char, 0xDF4F729B
la w, _tick_source
load_cell x, 0(w)
@@ -690,6 +670,20 @@ defcode "r>", from_ret, 0x135408B1
push w
next
+defcode "2>r" two_to_ret, 0x69F5D439
+ pop w
+ pop x
+ push_ret x
+ push_ret w
+ next
+
+defcode "2r>", two_from_ret, 0xB54DEDC1
+ pop_ret w
+ pop_ret x
+ push x
+ push w
+ next
+
defcode "dup", dup, 0xD330F226
load_cell w, 0(psp)
push w
@@ -710,7 +704,7 @@ defcode "swap", swap, 0x64ED874E
next
defcode "drop", drop, 0xA9A58D8C
- pop zero
+ addi psp, psp, cell
next
defcode "over", over, 0x31F6520F
@@ -738,6 +732,10 @@ defcode "2dup", two_dup, 0x5E46F4D6
push w
next
+defcode "2drop", two_drop, 0xECFD129C
+ addi psp, psp, 2 * cell
+ next
+
# -----------------------------------------------------------------------------
# math and logic
# -----------------------------------------------------------------------------
