commit 8499cfc19bb5b2dab4715ca6493089429db35b31
parent 3abcc45b2f613315ccec87132d66568fc11abd9d
Author: Christian Ermann <christianermann@gmail.com>
Date: Thu, 7 Nov 2024 11:42:06 -0800
Add 'parse' and redefine 'parse-word' as a high-level word
Diffstat:
| M | forth.s | | | 126 | +++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------- |
1 file changed, 82 insertions(+), 44 deletions(-)
diff --git a/forth.s b/forth.s
@@ -167,6 +167,9 @@ defconst "sp0", sp_top, 0x0C41B8B2
defconst "rp0", rp_top, 0x8AD91EDD
.int __stacktop_ret
+defconst "bl", bl, 0x412BAEAB
+ .int 0x20
+
defvar "state", state, 0x783132F6
.int state_immediate
@@ -179,9 +182,12 @@ defvar "latest", latest, 0x41704246
defvar "base", base, 0x3DDC94D8
.int 10
+defvar "delimiter", delimiter, 0x6C15B5FA
+ .int 0x20 # space
+
defvar "'source", tick_source, 0xEB4FEC0B
- .int 0 # address
.int 0 # length
+ .int 0 # address
defvar "source-offset", source_offset, 0x7F8C1674
.int 0
@@ -242,10 +248,10 @@ defword "refill", refill, 0x238BAA91
.int source_id, fetch, q_branch, _refill_tib
_refill_fib:
.int fib, read_line, q_branch, _refill_failed
- .int fib, drop, branch, _refill_success
+ .int fib, drop, swap, branch, _refill_success
_refill_tib:
.int tib, accept, dup, q_branch, _refill_failed
- .int tib, drop
+ .int tib, drop, swap
_refill_success:
.int tick_source, two_store
.int lit, 0, source_offset, store
@@ -276,10 +282,54 @@ defcode "fib", fib, 0xBCE49236
push w
next
+defword "skip-while", skip_while, 0xBBFD4B86
+ # ( addr1 len1 -- addr2 len2 )
+_skip_while_loop:
+ .int dup, q_branch, _skip_while_done
+ .int over, char_fetch, delimiter, fetch
+ .int equal, q_branch, _skip_while_done
+ .int lit, 1, apply_offset
+ .int branch, _skip_while_loop
+_skip_while_done:
+ .int exit
+
+defword "skip-until", skip_until, 0x661A5D67
+ # ( addr1 len1 -- addr2 len2 )
+_skip_until_loop:
+ .int dup, q_branch, _skip_until_done
+ .int over, char_fetch, delimiter, fetch
+ .int not_equal, q_branch, _skip_until_done
+ .int lit, 1, apply_offset
+ .int branch, _skip_until_loop
+_skip_until_done:
+ .int exit
+
+defword "apply-offset", apply_offset, 0x605143A5
+ # ( addr1 len1 offset -- addr2 len2 )
+ .int tuck, minus, to_ret, plus, from_ret, exit
+
+defword "parse-offset", parse_offset, 0x9E5C3F80
+ # ( addr1 len1 -- offset )
+ .int lit, 1, min, plus
+ .int source, drop, minus
+ .int exit
+
+defword "parse", parse, 0x423B42EC
+ .int delimiter, store
+ .int source, source_offset, fetch, apply_offset
+ .int skip_while, over, to_ret
+ .int skip_until
+ .int two_dup, parse_offset, source_offset, store
+ .int drop, from_ret, tuck, minus
+ .int exit
+
+defword "parse-word", parse_word, 0xB218226F
+ .int bl, parse, exit
+
defcode "parse-key", parse_key, 0xB78FDA4A
la w, _tick_source
- load_cell x, cell(w)
- load_cell w, 0(w)
+ load_cell x, 0(w)
+ load_cell w, cell(w)
la y, _source_offset
load_cell y, 0(y)
add w, w, y
@@ -298,8 +348,8 @@ defcode "parse-key", parse_key, 0xB78FDA4A
defcode "parse-char", parse_char, 0xDF4F729B
la w, _tick_source
- load_cell x, cell(w)
- load_cell w, 0(w)
+ load_cell x, 0(w)
+ load_cell w, cell(w)
la y, _source_offset
load_cell y, 0(y)
add w, w, y
@@ -324,43 +374,6 @@ defcode "parse-char", parse_char, 0xDF4F729B
mv t0, zero
j 2b
-defcode "parse-word", parse_word, 0xB218226F
- la w, _tick_source
- load_cell x, cell(w)
- load_cell w, 0(w) # buff addr
- # apply input offset
- la y, _source_offset
- load_cell y, 0(y)
- add w, w, y
- sub x, x, y
-
- li s3, 0x20 # space
- mv s4, w
-1: # find start of word
- beqz x, 3f # out of chars? -> stop!
- lb t0, 0(w) # next char!
- addi w, w, 1 # inc. addr
- addi y, y, 1 # inc. offset
- addi x, x, -1 # dec. len
- beq t0, s3, 1b # space? -> skip!
-
- addi s4, w, -1 # addr of word
-2: # find end of word
- beqz x, 3f
- lb t0, 0(w) # next char!
- addi y, y, 1 # inc. offset
- beq t0, s3, 3f # space? -> stop!
- addi w, w, 1 # inc. addr
- addi x, x, -1 # dec. len
- j 2b
-3: # done
- la t0, _source_offset
- store_cell y, 0(t0)
- sub x, w, s4
- push s4 # word addr
- push x # word len
- next
-
defcode ">number", to_number, 0x2F770E4C
pop x # word len
pop w # word addr
@@ -667,6 +680,16 @@ defcode "rp!", rp_store, 0x99D9367A
mv rsp, w
next
+defcode ">r", to_ret, 0x47FCB8A9
+ pop w
+ push_ret w
+ next
+
+defcode "r>", from_ret, 0x135408B1
+ pop_ret w
+ push w
+ next
+
defcode "dup", dup, 0xD330F226
load_cell w, 0(psp)
push w
@@ -700,6 +723,14 @@ defcode "nip", nip, 0x21A41868
store_cell w, 0(psp)
next
+defcode "tuck", tuck, 0x8E26FCE8
+ pop w
+ pop x
+ push w
+ push x
+ push w
+ next
+
defcode "2dup", two_dup, 0x5E46F4D6
load_cell w, 0(psp)
load_cell x, cell(psp)
@@ -806,6 +837,13 @@ _less_than:
push_imm -1
next
+defword "min", min, 0xC98F4557
+ .int two_dup, less_than, q_branch, _min_b
+_min_a:
+ .int drop, exit
+_min_b:
+ .int nip, exit
+
# -----------------------------------------------------------------------------
# compiler
# -----------------------------------------------------------------------------
