commit 2b483904003bbec46c3ce450406f96edefe40fe7
parent 46778b08a87e3a4fdf6b51d9cebd88ba3774ec06
Author: Christian Ermann <christianermann@gmail.com>
Date: Fri, 15 Nov 2024 01:08:23 -0800
Switch from indirect threaded code to subroutine threaded code
Diffstat:
| M | forth.s | | | 578 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------- |
1 file changed, 418 insertions(+), 160 deletions(-)
diff --git a/forth.s b/forth.s
@@ -30,10 +30,7 @@
.equ flag_immediate, 0x40
.macro next
- load_cell w, 0(ip)
- load_cell x, 0(w)
- addi ip, ip, cell
- jr x
+ ret
.endm
.macro push_addr addr
@@ -94,9 +91,14 @@ name_\label:
.byte \flags
.balign cell
+ .globl code_\label
+code_\label:
+ .int \label
+
+ .section ".text"
+ .balign cell
.globl \label
\label:
- .int \code
.endm
.macro defmeta name, label
@@ -112,19 +114,19 @@ meta_\label:
.macro defcode name, label, hash, flags=0
defmeta "\name", \label
defhead "\name", \label, \hash, code_\label, flags=\flags
- .section ".text"
- .globl code_\label
-code_\label:
.endm
.macro defword name, label, hash, flags=0
defmeta "\name", \label
defhead "\name", \label, \hash, docol, flags=\flags
+ docol
.endm
.macro defvar name, label, hash, flags=0, initial=0
defmeta "\name", \label
defhead "\name", \label, \hash, dovar, flags=\flags
+ push_ret ra
+ jal dovar
.globl _\label
_\label:
.endm
@@ -132,25 +134,31 @@ _\label:
.macro defconst name, label, hash, flags=0, value=0
defmeta "\name", \label
defhead "\name", \label, \hash, docon, flags=\flags
+ push_ret ra
+ jal docon
.globl _\label
_\label:
.endm
-docol:
- push_ret ip
- addi ip, w, cell
- next
+.macro docol
+ push_ret ra
+.endm
+
+.macro exit
+ pop_ret ra
+ ret
+.endm
dovar:
- addi w, w, cell
- push w
- next
+ push ra
+ pop_ret ra
+ ret
docon:
- addi w, w, cell
- load_cell w, 0(w)
+ load_cell w, 0(ra)
push w
- next
+ pop_ret ra
+ ret
dodoes:
push_ret ip # save old ip
@@ -159,8 +167,7 @@ dodoes:
mv ip, ra # set new ip
next
-defcode "exit", exit, 0xCDED1A85
- pop_ret ip
+defcode "break", break, 0xC9648178
next
# -----------------------------------------------------------------------------
@@ -208,7 +215,9 @@ defvar "source-id", source_id, 0x965ED1E2
defcode "type", type, 0x5127F14D
pop a1 # length
pop a0 # address
+ push_ret ra
jal uart_put_string
+ pop_ret ra
next
defcode "emit", emit, 0x2D88474A
@@ -224,7 +233,9 @@ defcode "key", key, 0x6815C86C
defcode "accept", accept, 0x08247E29
pop w # max len
pop x # address
+ push_ret ra
jal accept_impl
+ pop_ret ra
push w # recv'd len
next
@@ -251,24 +262,49 @@ accept_impl:
ret
defword "refill", refill, 0x238BAA91
- .int source_id, fetch, q_branch, _refill_tib
+ jal source_id
+ jal fetch
+ jal q_branch
+ .int _refill_tib
_refill_fib:
- .int fib, read_line, q_branch, _refill_failed
- .int fib, drop, swap, branch, _refill_success
+ jal fib
+ jal read_line
+ jal q_branch
+ .int _refill_failed
+ jal fib
+ jal drop
+ jal swap
+ jal branch
+ .int _refill_success
_refill_tib:
- .int tib, accept, dup, q_branch, _refill_failed
- .int tib, drop, swap
+ jal tib
+ jal accept
+ jal dup
+ jal q_branch
+ .int _refill_failed
+ jal tib
+ jal drop
+ jal swap
_refill_success:
- .int tick_source, two_store
- .int lit, 0, source_offset, store
- .int lit, -1
- .int exit
+ jal tick_source
+ jal two_store
+ jal lit
+ .int 0
+ jal source_offset
+ jal store
+ jal lit
+ .int -1
+ exit
_refill_failed:
- .int drop, lit, 0
- .int exit
+ jal drop
+ jal lit
+ .int 0
+ exit
defword "source", source, 0x1BCF29D8
- .int tick_source, two_fetch, exit
+ jal tick_source
+ jal two_fetch
+ exit
defcode "tib", tib, 0xC90B0194
# ( -- addr len )
@@ -291,46 +327,90 @@ defcode "fib", fib, 0xBCE49236
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
+ jal dup
+ jal q_branch
+ .int _skip_while_done
+ jal over
+ jal char_fetch
+ jal delimiter
+ jal fetch
+ jal equal
+ jal q_branch
+ .int _skip_while_done
+ jal lit
+ .int 1
+ jal apply_offset
+ jal branch
+ .int _skip_while_loop
_skip_while_done:
- .int exit
+ 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
+ jal dup
+ jal q_branch
+ .int _skip_until_done
+ jal over
+ jal char_fetch
+ jal delimiter
+ jal fetch
+ jal not_equal
+ jal q_branch
+ .int _skip_until_done
+ jal lit
+ .int 1
+ jal apply_offset
+ jal branch
+ .int _skip_until_loop
_skip_until_done:
- .int exit
+ exit
defword "apply-offset", apply_offset, 0x605143A5
# ( addr1 len1 offset -- addr2 len2 )
- .int tuck, minus, to_ret, plus, from_ret, exit
+ jal tuck
+ jal minus
+ jal to_ret
+ jal plus
+ jal from_ret
+ exit
defword "parse-offset", parse_offset, 0x9E5C3F80
# ( addr1 len1 -- offset )
- .int lit, 1, min, plus
- .int source, drop, minus
- .int exit
+ jal lit
+ .int 1
+ jal min
+ jal plus
+ jal source
+ jal drop
+ jal minus
+ 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
+ jal delimiter
+ jal store
+ jal source
+ jal source_offset
+ jal fetch
+ jal apply_offset
+ jal skip_while
+ jal over
+ jal to_ret
+ jal skip_until
+ jal two_dup
+ jal parse_offset
+ jal source_offset
+ jal store
+ jal drop
+ jal from_ret
+ jal tuck
+ jal minus
+ exit
defword "parse-word", parse_word, 0xB218226F
- .int bl, parse, exit
+ jal bl
+ jal parse
+ exit
defcode ">number", to_number, 0x2F770E4C
pop x # word len
@@ -394,20 +474,36 @@ defcode "word>hash", word_to_hash, 0x50E0A245
next
defword "find", find, 0xBDF0855A
- .int hash
- .int latest, fetch
+ jal hash
+ jal latest
+ jal fetch
_find_loop:
- .int dup, zero_equal, q_branch, _find_check_hidden
- .int swap, drop, exit
+ jal dup
+ jal zero_equal
+ jal q_branch
+ .int _find_check_hidden
+ jal swap
+ jal drop
+ exit
_find_check_hidden:
- .int dup, hidden_q, zero_equal, q_branch, _find_next_word
+ jal dup
+ jal hidden_q
+ jal zero_equal
+ jal q_branch
+ .int _find_next_word
_find_check_hash:
- .int two_dup
- .int word_to_hash, equal, q_branch, _find_next_word
- .int swap, drop, exit
+ jal two_dup
+ jal word_to_hash
+ jal equal
+ jal q_branch
+ .int _find_next_word
+ jal swap
+ jal drop
+ exit
_find_next_word:
- .int fetch
- .int branch, _find_loop
+ jal fetch
+ jal branch
+ .int _find_loop
defcode ">cfa", to_cfa, 0x8CAC3233
pop w
@@ -423,74 +519,121 @@ defcode "execute", execute, 0xA01E3D98
defword "interpret", interpret, 0x1F98C57A
_interpret_start:
- .int parse_word, q_dup, q_branch, _interpret_parse_area_empty
- .int two_dup
- .int find, q_dup, q_branch, _interpret_word_not_found
- .int nip, nip, to_cfa
- .int compiling_q, q_branch, _interpret_execute_word
- .int dup
- .int immediate_q, zero_equal, q_branch, _interpret_execute_word
+ jal parse_word
+ load_cell w, 0(psp) # dup, ?branch
+ beqz w, _interpret_parse_area_empty
+ jal two_dup
+ jal find
+ load_cell w, 0(psp) # dup, ?branch
+ beqz w, _interpret_word_not_found
+ addi psp, psp, 2 * cell # nip, nip
+ store_cell w, 0(psp)
+ jal to_cfa
+ la w, _state # compiling? ?branch
+ load_cell w, 0(w)
+ beqz w, _interpret_execute_word
+ load_cell w, 0(psp) # dup immediate? 0= branch?
+ addi w, w, flag_offset - code_offset
+ lb w, 0(w)
+ andi w, w, flag_immediate
+ bnez w, _interpret_execute_word
_interpret_compile_word:
- .int comma, branch, _interpret_start
+ jal fetch
+ jal jal_to
+ jal comma
+ j _interpret_start
_interpret_execute_word:
- .int execute, branch, _interpret_start
+ jal execute
+ jal branch
+ .int _interpret_start
_interpret_word_not_found:
- .int to_number, zero_equal, q_branch, _interpret_retry
- .int compiling_q, q_branch, _interpret_start
+ addi psp, psp, cell
+ jal to_number
+ pop w
+ bnez w, _interpret_retry
+ jal compiling_q
+ jal q_branch
+ .int _interpret_start
_interpret_compile_number:
- .int lit, lit, comma, comma, branch, _interpret_start
+ jal lit
+ .int lit
+ jal comma
+ jal comma
+ jal branch
+ .int _interpret_start
_interpret_retry:
- .int drop, branch, _interpret_start
+ jal drop
+ jal branch
+ .int _interpret_start
_interpret_parse_area_empty:
- .int drop, exit
+ addi psp, psp, 2 * cell
+ exit
defword "evaluate", evaluate, 0xACE4360A
- .int lit, 1, source_id, store
+ jal lit
+ .int 1
+ jal source_id
+ jal store
_evaluate_loop:
- .int refill, q_branch, _evaluate_done
- .int interpret
- .int branch, _evaluate_loop
+ jal refill
+ jal q_branch
+ .int _evaluate_done
+ jal interpret
+ jal branch
+ .int _evaluate_loop
_evaluate_done:
- .int lit, 0, source_id, store
- .int exit
+ jal lit
+ .int 0
+ jal source_id
+ jal store
+ exit
defcode "branch", branch, 0xB6873945
- load_cell w, 0(ip)
- mv ip, w
+ load_cell w, 0(ra)
+ mv ra, w
next
defcode "?branch", q_branch, 0x6AF3C1DE
pop w
bnez w, _branch_done
- load_cell w, 0(ip)
- mv ip, w
+ load_cell w, 0(ra)
+ mv ra, w
next
_branch_done:
- addi ip, ip, cell
+ addi ra, ra, cell
next
defcode "prompt", prompt, 0xDFE6493B
la w, _prompt
la x, _prompt_len
+ push_ret ra
call uart_put_string
+ pop_ret ra
next
defcode "okay", okay, 0xBA9EEB49
la w, _okay
la x, _okay_len
+ push_ret ra
call uart_put_string
+ pop_ret ra
next
defword "quit", quit, 0x47878736
-_quit_top:
- .int rp_top, rp_store
- .int prompt
- .int refill, drop # TODO: What should happen when 'refill' fails?
- .int interpret, okay
- .int branch, _quit_top
+ jal rp_top
+ jal rp_store
+ jal prompt
+ jal refill
+ jal drop # TODO: What should happen when 'refill' fails?
+ jal interpret
+ jal okay
+ jal branch
+ .int quit
defword "abort", abort, 0xA52BCAF9
- .int sp_top, sp_store, quit
+ jal sp_top
+ jal sp_store
+ jal quit
# -----------------------------------------------------------------------------
# memory access
@@ -570,16 +713,17 @@ defcode "cell+", cell_plus, 0xB14A8CBA
# -----------------------------------------------------------------------------
defword "here", here, 0x213B65CB
- .int dp, fetch
- .int exit
+ jal dp
+ jal fetch
+ exit
defcode "lit", lit, 0x404CD5B6
- load_cell w, 0(ip)
- addi ip, ip, cell
+ load_cell w, 0(ra)
+ addi ra, ra, cell
push w
next
-defcode "lit-string", lit_string, 0xC7BE567C
+defcode "lit-string", lit_string, 0xC7BE567C # TODO: ip -> ra
load_cell x, 0(ip) # len
addi ip, ip, cell
mv w, ip # addr
@@ -592,25 +736,41 @@ defcode "lit-string", lit_string, 0xC7BE567C
next
defword "allot", allot, 0xADB1A69F
- .int dp, add_store
- .int exit
+ jal dp
+ jal add_store
+ exit
-defword ",", comma, 0x290C95CB
- .int here, store # store value
- .int lit, cell, allot # increment 'here'
- .int exit
+defcode ",", comma, 0x290C95CB
+ pop w
+ la y, _dp
+ load_cell x, 0(y)
+ store_cell w, 0(x)
+ addi x, x, cell
+ store_cell x, 0(y)
+ next
-defword "c,", char_comma, 0xA32A0A5A
- .int here, char_store # store value
- .int lit, 1, allot # increment 'here'
- .int exit
+defcode "c,", char_comma, 0xA32A0A5A
+ pop w
+ la y, _dp
+ load_cell x, 0(y)
+ sb w, 0(x)
+ addi x, x, 1
+ store_cell x, 0(y)
+ next
defword "align", align, 0x602C63DE
- .int dp, dup, fetch
- .int lit, 3, plus
- .int lit, -4, and_
- .int swap, store
- .int exit
+ jal dp
+ jal dup
+ jal fetch
+ jal lit
+ .int 3
+ jal plus
+ jal lit
+ .int -4
+ jal and_
+ jal swap
+ jal store
+ exit
# -----------------------------------------------------------------------------
# stack manipulation
@@ -837,31 +997,120 @@ _less_than:
next
defword "min", min, 0xC98F4557
- .int two_dup, less_than, q_branch, _min_b
+ jal two_dup
+ jal less_than
+ jal q_branch
+ .int _min_b
_min_a:
- .int drop, exit
+ jal drop
+ exit
_min_b:
- .int nip, exit
+ jal nip
+ exit
# -----------------------------------------------------------------------------
# compiler
# -----------------------------------------------------------------------------
+defcode "jal-immed", jal_immed, 0xA914EF13
+ # encode a value as an immediate for a 'jal' instruction
+ pop x
+ li y, 0x000FF000 # imm[19:12]
+ and w, x, y
+ li y, 0x00100000 # imm[20]
+ and y, x, y
+ slli y, y, 11
+ add w, w, y
+ li y, 0x00000800 # imm[11]
+ and y, x, y
+ slli y, y, 9
+ add w, w, y
+ andi y, x, 0x000007FE # imm[10:1]
+ slli y, y, 20
+ add w, w, y
+ push w
+ next
+
+defword "jal-to", jal_to, 0xC38EF054
+ # generate a 'jal ra, addr' instruction
+ pop w
+ la x, _dp
+ load_cell x, 0(x)
+ sub w, w, x
+ push w
+ jal jal_immed
+ pop w
+ addi w, w, 0x000000EF # jal ra, imm
+ push w
+ exit
+
+defword "jal-dovar", jal_dovar, 0x668658A5
+ # generate a 'jal ra, dovar' instruction
+ la w, dovar
+ push w
+ jal jal_to
+ exit
+
+defword "dovar,", dovar_comma, 0x1F514E5B
+ jal jal_dovar
+ jal comma
+ exit
+
+defword "docol,", docol_comma, 0xFAE1EE9E
+ li w, 0xFE192E23 # sw ra, -4(s2)
+ push w
+ jal comma
+ li w, 0xFFC90913 # addi s2, s2, -4
+ push w
+ jal comma
+ exit
+
+defword "exit,", exit_comma, 0xD540F80B
+ li w, 0x00092083 # lw ra, 0(s2)
+ push w
+ jal comma
+ li w, 0x00490913 # addi s2, s2, 4
+ push w
+ jal comma
+ li w, 0x00008067 # ret
+ push w
+ jal comma
+ exit
+
defword "create", create, 0x26BB595D
- .int parse_word
- .int latest, fetch, comma # link
- .int hash, comma # hash
- .int lit, 0, comma # meta
- .int lit, 0, char_comma # flags
- .int align
- .int here, lit, -code_offset, plus, latest, store # update 'latest'
- .int lit, dovar, comma
- .int exit
+ jal parse_word
+ jal latest # link
+ jal fetch
+ jal comma
+ jal hash # hash
+ jal comma
+ push_imm 0 # meta
+ jal comma
+ push_imm 0 # flags
+ jal char_comma
+ jal align
+ # update latest
+ la x, _dp
+ load_cell x, 0(x)
+ addi x, x, -code_offset
+ la y, _latest
+ store_cell x, 0(y)
+ # code field
+ la x, _dp
+ load_cell y, 0(x)
+ addi y, y, cell
+ store_cell y, -cell(y)
+ store_cell y, 0(x)
+ # append 'dovar'
+ jal dovar_comma
+ exit
defcode "hash", hash, 0xEDBF0FE3
pop x # string length
pop w # string address
+ push_ret ra
jal hash_impl
+ pop_ret ra
push w # string hash
next
@@ -907,18 +1156,24 @@ defcode "hidden?", hidden_q, 0x6F436C72
next
defword ":", colon, 0x3F0CB86D
- .int create # create header
- .int lit, -cell, allot
- .int lit, docol, comma # append 'docol'
- .int latest, fetch, hidden # hide word
- .int r_bracket # enter 'compile' mode
- .int exit
+ jal create # create header
+ jal lit
+ .int -cell
+ jal allot
+ jal docol_comma # append 'docol'
+ jal latest
+ jal fetch
+ jal hidden # hide word
+ jal r_bracket # enter 'compile' mode
+ exit
defword ";", semicolon, 0x3E0CB6DA, flags=flag_immediate
- .int lit, exit, comma # append 'exit'
- .int latest, fetch, hidden # show word
- .int l_bracket # enter 'immediate' mode
- .int exit
+ jal exit_comma
+ jal latest
+ jal fetch
+ jal hidden
+ jal l_bracket
+ exit
defcode "compiling?", compiling_q, 0x94652AE2
la w, _state
@@ -935,34 +1190,36 @@ defcode "immediate?", immediate_q, 0x89F23E9F
push w
next
+# TODO: everything after this needs updated to work with subroutine threading
+
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
_postpone_execute:
# stores "<xt>" into the current definition
- .int comma, exit
+ #.int comma, exit
_postpone_compile:
# stores "lit <xt> ," into the current definition
- .int lit, lit, comma, comma, lit, comma, comma, exit
+ #.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
- .int exit
+ exit
defword "variable", variable, 0x19385305
.int create # create header
.int lit, 0, comma # initialize to zero
- .int exit
+ exit
defword "constant", constant, 0x0691EA25
.int create # create header
.int lit, -cell, allot
- .int lit, docon, comma # append 'docon'
+ #.int lit, docon, comma # append 'docon'
.int comma # initialize to value on stack
- .int exit
+ exit
defcode "jal-dodoes", jal_dodoes, 0x4F82E787
pop w
@@ -988,12 +1245,12 @@ defcode "jal-dodoes", jal_dodoes, 0x4F82E787
defword ";does", does, 0xF5BCD777, flags=flag_immediate
.int lit, does_internal, comma
.int here, jal_dodoes, comma
- .int exit
+ exit
defword "(;does)", does_internal, 0xED4B7678
.int from_ret
.int latest, fetch, lit, code_offset, plus, store
- .int exit
+ exit
defcode "read-char", read_char, 0xF07E2044
jal _read_char_impl
@@ -1024,22 +1281,22 @@ _read_char_eof:
defword "buffer-open", buffer_open, 0x79AAD9CA
# ( addr len -- addr end-addr cur-addr )
.int over, plus, over
- .int exit
+ exit
defword "buffer-close", buffer_close, 0x42B7429E
# ( open-buffer -- len )
.int nip, swap, minus
- .int exit
+ exit
defword "buffer-emit", buffer_emit, 0xEA240555
# ( open-buffer char -- open-buffer )
.int over, store, lit, 1, plus
- .int exit
+ exit
defword "buffer-full?", buffer_full_q, 0x070A2E6C
# ( open-buffer -- flag )
.int two_dup, greater_than # TODO: >=
- .int exit
+ exit
defword "read-line", read_line, 0xAF1308A2
.int buffer_open
@@ -1051,20 +1308,21 @@ _read_line_loop:
.int buffer_full_q, q_branch, _read_line_buffer_full
.int branch, _read_line_loop
_read_line_newline:
- .int drop, buffer_close, lit, -1, exit
+ #.int drop, buffer_close, lit, -1, exit
_read_line_eof:
.int drop, buffer_close, dup, q_branch, _read_line_eof_fail
- .int lit, -1, exit
+ #.int lit, -1, exit
_read_line_eof_fail:
- .int lit, 0, exit
+ #.int lit, 0, exit
_read_line_buffer_full:
- .int buffer_close, lit, 0, exit
+ #.int buffer_close, lit, 0, exit
-.section ".rodata"
+.section ".text"
program:
- .int type
- .int quit
+ jal type
+ jal quit
+.section ".rodata"
version_string:
.ascii "soup forth rv32\n"
version_string_len = (. - version_string)
@@ -1103,5 +1361,5 @@ start:
push_addr version_string
push_imm version_string_len
- next
+ jal program
