commit 21588fcba332d565b2140bff48cfd019d6badc6f
parent b0dcec26045df46a260b24c74680d3c0c0fcbee7
Author: Christian Ermann <christianermann@gmail.com>
Date: Wed, 20 Nov 2024 20:37:34 -0800
Fix 'postpone', 'variable', 'constant', and 'lit-string' for subroutine threading
Diffstat:
2 files changed, 76 insertions(+), 42 deletions(-)
diff --git a/src/bootstrap.fs b/src/bootstrap.fs
@@ -1,3 +1,4 @@
+: exit exit, ; immediate
: test type ;
@@ -11,7 +12,7 @@
: again postpone branch , ; immediate
: repeat postpone again postpone then ; immediate
-: test-if if type then exit ;
+: test-if if type then ;
: literal postpone lit , ; immediate
diff --git a/src/forth.s b/src/forth.s
@@ -223,7 +223,9 @@ defcode "type", type, 0x5127F14D
next
defcode "emit", emit, 0x2D88474A
+ push_ret ra
jal uart_put_char
+ pop_ret ra
pop w
next
@@ -524,7 +526,6 @@ _interpret_start:
_interpret_word_found:
addi psp, psp, 2 * cell # nip, nip
addi w, w, code_offset
- load_cell w, 0(w)
# compiling?
la x, _state
load_cell x, 0(x)
@@ -535,11 +536,12 @@ _interpret_word_found:
andi x, x, flag_immediate
bnez x, _interpret_execute_word
_interpret_compile_word:
+ load_cell w, 0(w)
jal jal_to
jal comma
j _interpret_start
_interpret_execute_word:
- mv x, w
+ load_cell x, 0(w)
pop w
jalr x
j _interpret_start
@@ -553,14 +555,15 @@ _interpret_word_not_found:
load_cell x, 0(x)
beqz x, _interpret_start
_interpret_compile_number:
- jal lit
- .int lit
+ push w
+ la w, lit
+ jal jal_to
jal comma
jal comma
j _interpret_start
_interpret_retry:
addi psp, psp, cell
- load_cell w, 0(psp)
+ pop w
j _interpret_start
_interpret_parse_area_empty:
addi psp, psp, cell
@@ -719,15 +722,14 @@ defcode "lit", lit, 0x404CD5B6
next
defcode "lit-string", lit_string, 0xC7BE567C # TODO: ip -> ra, w=tos
- load_cell x, 0(ip) # len
- addi ip, ip, cell
- mv w, ip # addr
- add ip, ip, x
- # re-align ip
- addi ip, ip, cell - 1
- andi ip, ip, -cell
push w
- push x
+ load_cell w, 0(ra) # len
+ addi ra, ra, cell
+ push ra # addr
+ # align
+ add ra, ra, w
+ addi ra, ra, cell - 1
+ andi ra, ra, -cell
next
defword "allot", allot, 0xADB1A69F
@@ -773,8 +775,9 @@ defword "align", align, 0x602C63DE
defcode "sp@", sp_fetch, 0xFC419F82
# ( -- addr )
+ mv x, psp
push w
- mv w, psp
+ mv w, x
next
defcode "sp!", sp_store, 0x1D41D375
@@ -1001,15 +1004,19 @@ defword "jal-to", jal_to, 0xC38EF054
addi w, w, 0x000000EF # jal ra, imm
exit
-defword "jal-dovar", jal_dovar, 0x668658A5
- # generate a 'jal ra, dovar' instruction
+defword "dovar,", dovar_comma, 0x1F514E5B
+ # 'jal ra, dovar'
push w
la w, dovar
jal jal_to
+ jal comma
exit
-defword "dovar,", dovar_comma, 0x1F514E5B
- jal jal_dovar
+defword "docon,", docon_comma, 0x76DCA1A4
+ # 'jal ra, docon'
+ push w
+ la w, docon
+ jal jal_to
jal comma
exit
@@ -1058,7 +1065,8 @@ defword "create", create, 0x26BB595D
addi y, y, cell
store_cell y, -cell(y)
store_cell y, 0(x)
- # append 'dovar'
+ # append 'docol, dovar'
+ jal docol_comma
jal dovar_comma
exit
@@ -1112,8 +1120,7 @@ defcode "hidden?", hidden_q, 0x6F436C72
defword ":", colon, 0x3F0CB86D
jal create # create header
push_imm -cell
- jal allot
- jal docol_comma # append 'docol'
+ jal allot # erase 'dovar'
jal latest
jal fetch
jal hidden # hide word
@@ -1129,10 +1136,10 @@ defword ";", semicolon, 0x3E0CB6DA, flags=flag_immediate
exit
defcode "compiling?", compiling_q, 0x94652AE2
+ push w
la w, _state
load_cell w, 0(w)
andi w, w, state_compile
- push w
next
defcode "immediate?", immediate_q, 0x89F23E9F
@@ -1143,38 +1150,64 @@ defcode "immediate?", immediate_q, 0x89F23E9F
push w
next
-# TODO: everything after this needs updated to work with subroutine threading
-# and with w=tos
-
defword "postpone", postpone, 0x933F531F, flags=flag_immediate
- .int parse_word, find # TODO: was word actually found?
- .int to_cfa, dup
- .int immediate_q, q_branch, _postpone_compile
+ jal parse_word
+ jal find
+ addi x, w, flag_offset
+ lb x, 0(x)
+ andi x, x, flag_immediate
+ addi w, w, code_offset
+ load_cell w, 0(w)
+ beqz x, _postpone_compile
_postpone_execute:
# stores "<xt>" into the current definition
- #.int comma, exit
+ jal jal_to
+ jal comma
+ exit
_postpone_compile:
# stores "lit <xt> ," into the current definition
- #.int lit, lit, comma, comma, lit, comma, comma, exit
-
-defword "immediate", immediate, 0xF232267A
- .int latest, fetch, lit, flag_offset, plus, dup
- .int fetch, lit, flag_immediate, or_
- .int swap, store
+ push w
+ la w, lit
+ jal jal_to
+ jal comma
+ jal comma
+ push w
+ la w, jal_to
+ jal jal_to
+ jal comma
+ push w
+ la w, comma
+ jal jal_to
+ jal comma
exit
+defcode "immediate", immediate, 0xF232267A
+ la x, _latest
+ load_cell x, 0(x)
+ addi x, x, flag_offset
+ lb y, 0(x)
+ ori y, y, flag_immediate
+ sb y, 0(x)
+ next
+
defword "variable", variable, 0x19385305
- .int create # create header
- .int lit, 0, comma # initialize to zero
+ jal create
+ push w
+ mv w, zero
+ jal comma
exit
defword "constant", constant, 0x0691EA25
- .int create # create header
- .int lit, -cell, allot
- #.int lit, docon, comma # append 'docon'
- .int comma # initialize to value on stack
+ jal create
+ push_imm -cell
+ jal allot
+ jal docon_comma # append 'docon'
+ jal comma
exit
+# TODO: ';does' and related words still need updated to work with subroutine
+# threading and with w=tos
+
defcode "jal-dodoes", jal_dodoes, 0x4F82E787
pop w
la x, dodoes