commit 38cc7345ce6b626acc2be223267ff7c997130c4f
parent 8847c6b5c1e8e0e9034895c5d0098079afd3be49
Author: Christian Ermann <christianermann@gmail.com>
Date: Wed, 6 Nov 2024 14:48:49 -0800
Refactor 'defcode' and 'defword' macros
Diffstat:
| M | forth.s | | | 250 | +++++++++++++++++++++++++++++++++++++++++-------------------------------------- |
1 file changed, 129 insertions(+), 121 deletions(-)
diff --git a/forth.s b/forth.s
@@ -1,3 +1,5 @@
+.option norelax
+
.extern uart_put_char
.extern uart_get_char
.extern uart_put_string
@@ -64,53 +66,61 @@
addi rsp, rsp, cell
.endm
-.macro defcode name, name_length, flags, hash, label, last
+
+.macro this_link
+ .globl link_\+
+link_\+:
+.endm
+
+.macro prev_link
+ .int link_\+
+.endm
+
+.macro link
+ this_link
+ prev_link
+.endm
+
+this_link
+.int 0
+
+.macro defhead name, label, hash, code, flags=0
.section ".rodata"
.balign cell
.globl name_\label
name_\label:
- .int name_\last # 1. Link to the previously defined word.
+ link
.int \hash
.int meta_\label
- .byte \flags # 3. Set the flags.
+ .byte \flags
- .balign cell # 6. Add any padding we may need.
+ .balign cell
.globl \label
\label:
- .int code_\label # 7. Set the codeword.
+ .int \code
+.endm
- .section ".data.meta"
+.macro defmeta name, label
+ .section ".rodata.meta"
.global meta_\label
meta_\label:
- .byte \name_length
+ .byte length_\@
+1:
.ascii "\name"
+ .equ length_\@, . - 1b
+.endm
+.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: # 8. This is where our assembly code will go.
+code_\label:
.endm
-.macro defword name, name_length, flags, hash, label, last
- .section ".rodata"
- .balign cell
- .globl name_\label
-name_\label:
- .int name_\last
- .int \hash
- .int meta_\label
- .byte \flags
-
- .section ".data.meta"
- .global meta_\label
-meta_\label:
- .byte \name_length
- .ascii "\name"
-
- .section ".rodata"
- .balign cell
- .globl \label
-\label:
- .int docol
+.macro defword name, label, hash, flags=0
+ defmeta "\name", \label
+ defhead "\name", \label, \hash, docol, flags=\flags
.endm
docol:
@@ -129,29 +139,27 @@ docon:
push w
next
-.equ name_null, 0
-
-defcode "exit", 4, 0, 0xCDED1A85, exit, null
+defcode "exit", exit, 0xCDED1A85
pop_ret ip
next
-defcode "type", 4, 0, 0x5127F14D, type, exit
+defcode "type", type, 0x5127F14D
pop a1 # length
pop a0 # address
jal uart_put_string
next
-defcode "emit", 4, 0, 0x2D88474A, emit, type
+defcode "emit", emit, 0x2D88474A
pop a0
jal uart_put_char
next
-defcode "key", 3, 0, 0x6815C86C, key, emit
+defcode "key", key, 0x6815C86C
jal uart_get_char
push a0
next
-defcode "accept", 6, 0, 0x08247E29, accept, key
+defcode "accept", accept, 0x08247E29
pop w # max len
pop x # address
jal accept_impl
@@ -180,7 +188,7 @@ accept_impl:
pop_ret ra
ret
-defword "refill", 6, 0, 0x238BAA91, refill, accept
+defword "refill", refill, 0x238BAA91
.int source_id, fetch, q_branch, _refill_tib
_refill_fib:
.int fib, read_line, q_branch, _refill_failed
@@ -198,7 +206,7 @@ _refill_failed:
.int drop, lit, 0
.int exit
-defcode "source", 6, 0, 0x1BCF29D8, source, refill
+defcode "source", source, 0x1BCF29D8
la w, _source
load_cell w, 0(w)
la x, _source_len
@@ -207,27 +215,27 @@ defcode "source", 6, 0, 0x1BCF29D8, source, refill
push x
next
-defcode "source-addr", 11, 0, 0x997F9EE8, source_addr, source
+defcode "source-addr", source_addr, 0x997F9EE8
la w, _source
push w
next
-defcode "source-len", 10, 0, 0x1B513E8E, source_len, source_addr
+defcode "source-len", source_len, 0x1B513E8E
la w, _source_len
push w
next
-defcode "source-offset", 13, 0, 0x7F8C1674, source_offset, source_len
+defcode "source-offset", source_offset, 0x7F8C1674
la w, _input_offset
push w
next
-defcode "source-id", 9, 0, 0x965ED1E2, source_id, source_offset
+defcode "source-id", source_id, 0x965ED1E2
la w, _source_id
push w
next
-defcode "tib", 3, 0, 0xC90B0194, tib, source_id
+defcode "tib", tib, 0xC90B0194
# ( -- addr len )
la w, _tib
push w
@@ -236,7 +244,7 @@ defcode "tib", 3, 0, 0xC90B0194, tib, source_id
push w
next
-defcode "fib", 3, 0, 0xBCE49236, fib, tib
+defcode "fib", fib, 0xBCE49236
# ( -- addr len )
la w, _fib
push w
@@ -245,7 +253,7 @@ defcode "fib", 3, 0, 0xBCE49236, fib, tib
push w
next
-defcode "parse-key" 9, 0, 0xB78FDA4A, parse_key, fib
+defcode "parse-key", parse_key, 0xB78FDA4A
la w, _source
load_cell w, 0(w)
la x, _source_len
@@ -266,7 +274,7 @@ defcode "parse-key" 9, 0, 0xB78FDA4A, parse_key, fib
mv t0, zero
j 1b
-defcode "parse-char", 10, 0, 0xDF4F729B, parse_char, parse_key
+defcode "parse-char", parse_char, 0xDF4F729B
la w, _source
load_cell w, 0(w)
la x, _source_len
@@ -295,7 +303,7 @@ defcode "parse-char", 10, 0, 0xDF4F729B, parse_char, parse_key
mv t0, zero
j 2b
-defcode "parse-word", 10, 0, 0xB218226F, parse_word, parse_char
+defcode "parse-word", parse_word, 0xB218226F
la w, _source
load_cell w, 0(w) # buff addr
la x, _source_len
@@ -333,7 +341,7 @@ defcode "parse-word", 10, 0, 0xB218226F, parse_word, parse_char
push x # word len
next
-defcode ">number", 7, 0, 0x2F770E4C, to_number, parse_word
+defcode ">number", to_number, 0x2F770E4C
pop x # word len
pop w # word addr
mv y, zero # initial value
@@ -388,13 +396,13 @@ _to_number_done:
push x
next
-defcode "word>hash", 9, 0, 0x50E0A245, word_to_hash, to_number
+defcode "word>hash", word_to_hash, 0x50E0A245
pop w # word address
load_cell w, hash_offset(w)
push w # word hash
next
-defword "find", 4, 0, 0xBDF0855A, find, word_to_hash
+defword "find", find, 0xBDF0855A
.int hash
.int latest, fetch
_find_loop:
@@ -408,19 +416,19 @@ _find_next_word:
.int fetch
.int branch, _find_loop
-defcode ">cfa", 4, 0, 0x8CAC3233, to_cfa, find
+defcode ">cfa", to_cfa, 0x8CAC3233
pop w
addi w, w, code_offset
push w
next
-defcode "execute", 7, 0, 0xA01E3D98, execute, to_cfa
+defcode "execute", execute, 0xA01E3D98
pop w
load_cell x, 0(w)
jr x
# 'next' should be called by the executed word
-defword "interpret", 9, 0, 0x1F98C57A, interpret, execute
+defword "interpret", interpret, 0x1F98C57A
_interpret_start:
.int parse_word, q_dup, q_branch, _interpret_parse_area_empty
.int two_dup
@@ -443,7 +451,7 @@ _interpret_retry:
_interpret_parse_area_empty:
.int drop, exit
-defword "evaluate", 8, 0, 0xACE4360A, evaluate, interpret
+defword "evaluate", evaluate, 0xACE4360A
.int lit, 1, source_id, store
_evaluate_loop:
.int refill, q_branch, _evaluate_done
@@ -453,12 +461,12 @@ _evaluate_done:
.int lit, 0, source_id, store
.int exit
-defcode "branch", 6, 0, 0xB6873945, branch, evaluate
+defcode "branch", branch, 0xB6873945
load_cell w, 0(ip)
mv ip, w
next
-defcode "?branch", 7, 0, 0x6AF3C1DE, q_branch, branch
+defcode "?branch", q_branch, 0x6AF3C1DE
pop w
bnez w, _branch_done
load_cell w, 0(ip)
@@ -468,19 +476,19 @@ _branch_done:
addi ip, ip, cell
next
-defcode "prompt", 6, 0, 0xDFE6493B, prompt, q_branch
+defcode "prompt", prompt, 0xDFE6493B
la w, _prompt
la x, _prompt_len
call uart_put_string
next
-defcode "okay", 6, 0, 0xBA9EEB49, okay, prompt
+defcode "okay", okay, 0xBA9EEB49
la w, _okay
la x, _okay_len
call uart_put_string
next
-defword "quit", 4, 0, 0x47878736, quit, okay
+defword "quit", quit, 0x47878736
_quit_top:
.int rp_top, rp_store
.int prompt
@@ -488,38 +496,38 @@ _quit_top:
.int interpret, okay
.int branch, _quit_top
-defword "abort", 5, 0, 0xA52BCAF9, abort, quit
+defword "abort", abort, 0xA52BCAF9
.int sp_top, sp_store, quit
# -----------------------------------------------------------------------------
# memory access
# -----------------------------------------------------------------------------
-defcode "!", 1, 0, 0x240C8DEC, store, abort
+defcode "!", store, 0x240C8DEC
pop w # address
pop x # value
store_cell x, 0(w)
next
-defcode "@", 1, 0, 0xC50BF85F, fetch, store
+defcode "@", fetch, 0xC50BF85F
pop w # address
load_cell x, 0(w)
push x
next
-defcode "c!", 2, 0, 0x9829F909, char_store, fetch
+defcode "c!", char_store, 0x9829F909
pop w
pop x
sb x, 0(w)
next
-defcode "c@", 2, 0, 0x37296056, char_fetch, char_store
+defcode "c@", char_fetch, 0x37296056
pop w
lb x, 0(w)
push x
next
-defcode "+!", 2, 0, 0x08DC01D1, add_store, char_fetch
+defcode "+!", add_store, 0x08DC01D1
pop w # address
pop x # value to add
load_cell t0, 0(w)
@@ -527,7 +535,7 @@ defcode "+!", 2, 0, 0x08DC01D1, add_store, char_fetch
store_cell t0, 0(w)
next
-defcode "-!", 2, 0, 0x24CD235B, sub_store, add_store
+defcode "-!", sub_store, 0x24CD235B
pop w # address
pop x # value to add
load_cell t0, 0(w)
@@ -535,14 +543,14 @@ defcode "-!", 2, 0, 0x24CD235B, sub_store, add_store
store_cell t0, 0(w)
next
-defcode "cells", 5, 0, 0xD94ACBB2, cells, sub_store
+defcode "cells", cells, 0xD94ACBB2
pop w
li x, cell
mul w, w, x
push w
next
-defcode "cell+", 5, 0, 0xB14A8CBA, cell_plus, cells
+defcode "cell+", cell_plus, 0xB14A8CBA
pop w
addi w, w, cell
push w
@@ -552,29 +560,29 @@ defcode "cell+", 5, 0, 0xB14A8CBA, cell_plus, cells
# dictionary management
# -----------------------------------------------------------------------------
-defcode "dp", 2, 0, 0x491CB0B9, dp, cell_plus
+defcode "dp", dp, 0x491CB0B9
la w, _here
push w
next
-defcode "here", 4, 0, 0x213B65CB, here, dp
+defcode "here", here, 0x213B65CB
la w, _here
load_cell x, 0(w)
push x
next
-defcode "latest", 6, 0, 0x41704246, latest, here
+defcode "latest", latest, 0x41704246
la w, _latest
push w
next
-defcode "lit", 3, 0, 0x404CD5B6, lit, latest
+defcode "lit", lit, 0x404CD5B6
load_cell w, 0(ip)
addi ip, ip, cell
push w
next
-defcode "lit-string", 10, 0, 0xC7BE567C, lit_string, lit
+defcode "lit-string", lit_string, 0xC7BE567C
load_cell x, 0(ip) # len
addi ip, ip, cell
mv w, ip # addr
@@ -586,21 +594,21 @@ defcode "lit-string", 10, 0, 0xC7BE567C, lit_string, lit
push x
next
-defword "allot", 5, 0, 0xADB1A69F, allot, lit_string
+defword "allot", allot, 0xADB1A69F
.int dp, add_store
.int exit
-defword ",", 1, 0, 0x290C95CB, comma, allot
+defword ",", comma, 0x290C95CB
.int here, store # store value
.int lit, cell, allot # increment 'here'
.int exit
-defword "c,", 2, 0, 0xA32A0A5A, char_comma, comma
+defword "c,", char_comma, 0xA32A0A5A
.int here, char_store # store value
.int lit, 1, allot # increment 'here'
.int exit
-defcode "align", 5, 0, 0x602C63DE, align, char_comma
+defcode "align", align, 0x602C63DE
la w, _here
load_cell x, 0(w)
addi x, x, 3
@@ -612,76 +620,76 @@ defcode "align", 5, 0, 0x602C63DE, align, char_comma
# stack manipulation
# -----------------------------------------------------------------------------
-defcode "sp0", 3, 0, 0x0C41B8B2, sp_top, align
+defcode "sp0", sp_top, 0x0C41B8B2
# ( -- addr )
la w, __stacktop
push w
next
-defcode "sp@", 3, 0, 0xFC419F82, sp_fetch, sp_top
+defcode "sp@", sp_fetch, 0xFC419F82
# ( -- addr )
mv w, psp
push w
next
-defcode "sp!", 3, 0, 0x1D41D375, sp_store, sp_fetch
+defcode "sp!", sp_store, 0x1D41D375
# ( addr -- )
pop w
mv psp, w
next
-defcode "rp0", 3, 0, 0x8AD91EDD, rp_top, sp_store
+defcode "rp0", rp_top, 0x8AD91EDD
# ( -- addr )
la w, __stacktop_ret
push w
next
-defcode "rp@", 3, 0, 0x7AD905AD, rp_fetch, rp_top
+defcode "rp@", rp_fetch, 0x7AD905AD
# ( -- addr )
mv w, rsp
push w
next
-defcode "rp!", 3, 0, 0x99D9367A, rp_store, rp_fetch
+defcode "rp!", rp_store, 0x99D9367A
# ( addr -- )
pop w
mv rsp, w
next
-defcode "dup", 3, 0, 0xD330F226, dup, rp_store
+defcode "dup", dup, 0xD330F226
load_cell w, 0(psp)
push w
next
-defcode "?dup", 4, 0, 0xFD2928D3, q_dup, dup
+defcode "?dup", q_dup, 0xFD2928D3
load_cell w, 0(psp)
beqz w, _q_dup_done
push w
_q_dup_done:
next
-defcode "swap", 4, 0, 0x64ED874E, swap, q_dup
+defcode "swap", swap, 0x64ED874E
pop w
pop x
push w
push x
next
-defcode "drop", 4, 0, 0xA9A58D8C, drop, swap
+defcode "drop", drop, 0xA9A58D8C
pop zero
next
-defcode "over", 4, 0, 0x31F6520F, over, drop
+defcode "over", over, 0x31F6520F
load_cell w, cell(psp)
push w
next
-defcode "nip", 3, 0, 0x21A41868, nip, over
+defcode "nip", nip, 0x21A41868
pop w
store_cell w, 0(psp)
next
-defcode "2dup", 3, 0, 0x5E46F4D6, two_dup, nip
+defcode "2dup", two_dup, 0x5E46F4D6
load_cell w, 0(psp)
load_cell x, cell(psp)
push x
@@ -692,42 +700,42 @@ defcode "2dup", 3, 0, 0x5E46F4D6, two_dup, nip
# math and logic
# -----------------------------------------------------------------------------
-defcode "+", 1, 0, 0x2E0C9DAA, plus, two_dup
+defcode "+", plus, 0x2E0C9DAA
pop w
pop x
add w, w, x
push w
next
-defcode "-", 1, 0, 0x280C9438, minus, plus
+defcode "-", minus, 0x280C9438
pop x
pop w
sub w, w, x
push w
next
-defcode "*", 1, 0, 0x2F0C9F3D, times, minus
+defcode "*", times, 0x2F0C9F3D
pop w
pop x
mul w, w, x
push w
next
-defcode "or", 2, 0, 0x5D342984, or_, minus
+defcode "or", or_, 0x5D342984
pop w
pop x
or w, w, x
push w
next
-defcode "and", 3, 0, 0x0F29C2A6, and_, or_
+defcode "and", and_, 0x0F29C2A6
pop w
pop x
and w, w, x
push w
next
-defcode "aligned", 7, 0, 0xC73174DF, aligned, and_
+defcode "aligned", aligned, 0xC73174DF
pop w
addi w, w, 3
andi w, w, 0xFFFFFFFC
@@ -738,7 +746,7 @@ defcode "aligned", 7, 0, 0xC73174DF, aligned, and_
# comparison
# -----------------------------------------------------------------------------
-defcode "0=", 2, 0, 0x14ED5DD6, zero_equal, aligned
+defcode "0=", zero_equal, 0x14ED5DD6
pop w
mv x, zero
bnez w, _zero_done
@@ -747,7 +755,7 @@ _zero_done:
push x
next
-defcode "=", 1, 0, 0x380CAD68, equal, zero_equal
+defcode "=", equal, 0x380CAD68
pop w
pop x
beq w, x, _equal
@@ -757,7 +765,7 @@ _equal:
push_imm -1
next
-defcode "<>", 2, 0, 0x93F7201F, not_equal, equal
+defcode "<>", not_equal, 0x93F7201F
pop w
pop x
bne w, x, _not_equal
@@ -767,7 +775,7 @@ _not_equal:
push_imm -1
next
-defcode ">", 1, 0, 0x3B0CB221, greater_than, not_equal
+defcode ">", greater_than, 0x3B0CB221
pop w
pop x
bgt x, w, _greater_than
@@ -777,7 +785,7 @@ _greater_than:
push_imm -1
next
-defcode "<", 1, 0, 0x390CAEFB, less_than, greater_than
+defcode "<", less_than, 0x390CAEFB
pop w
pop x
blt x, w, _less_than
@@ -791,7 +799,7 @@ _less_than:
# compiler
# -----------------------------------------------------------------------------
-defword "create", 6, 0, 0x26BB595D, create, less_than
+defword "create", create, 0x26BB595D
.int parse_word
.int latest, fetch, comma # link
.int hash, comma # hash
@@ -802,7 +810,7 @@ defword "create", 6, 0, 0x26BB595D, create, less_than
.int lit, dovar, comma
.int exit
-defcode "hash", 4, 0, 0xEDBF0FE3, hash, create
+defcode "hash", hash, 0xEDBF0FE3
pop x # string length
pop w # string address
jal hash_impl
@@ -822,19 +830,19 @@ _hash_char:
mv w, t0
ret
-defcode "[", 1, flag_immediate, 0xDE0C1FBA, l_bracket, hash
+defcode "[", l_bracket, 0xDE0C1FBA, flags=flag_immediate
la w, _state
li x, state_immediate
store_cell x, 0(w)
next
-defcode "]", 1, 0, 0xD80C1648, r_bracket, l_bracket
+defcode "]", r_bracket, 0xD80C1648
la w, _state
li x, state_compile
store_cell x, 0(w)
next
-defcode "hidden", 6, 0, 0xF618F139, hidden, r_bracket
+defcode "hidden", hidden, 0xF618F139
pop w
addi w, w, flag_offset
lb x, 0(w)
@@ -842,7 +850,7 @@ defcode "hidden", 6, 0, 0xF618F139, hidden, r_bracket
sb x, 0(w)
next
-defword ":", 1, 0, 0x3F0CB86D, colon, hidden
+defword ":", colon, 0x3F0CB86D
.int create # create header
.int lit, -cell, allot
.int lit, docol, comma # append 'docol'
@@ -850,20 +858,20 @@ defword ":", 1, 0, 0x3F0CB86D, colon, hidden
.int r_bracket # enter 'compile' mode
.int exit
-defword ";", 1, flag_immediate, 0x3E0CB6DA, semicolon, colon
+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
-defcode "compiling?", 10, 0, 0x94652AE2, compiling_q, semicolon
+defcode "compiling?", compiling_q, 0x94652AE2
la w, _state
load_cell w, 0(w)
andi w, w, state_compile
push w
next
-defcode "immediate?", 10, 0, 0x89F23E9F, immediate_q, compiling_q
+defcode "immediate?", immediate_q, 0x89F23E9F
pop w
addi w, w, flag_offset - code_offset
lb w, 0(w)
@@ -871,7 +879,7 @@ defcode "immediate?", 10, 0, 0x89F23E9F, immediate_q, compiling_q
push w
next
-defword "postpone", 8, flag_immediate, 0x933F531F, postpone, immediate_q
+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
@@ -882,25 +890,25 @@ _postpone_compile:
# stores "lit <xt> ," into the current definition
.int lit, lit, comma, comma, lit, comma, comma, exit
-defword "immediate", 9, 0, 0xF232267A, immediate, postpone
+defword "immediate", immediate, 0xF232267A
.int latest, fetch, lit, flag_offset, plus, dup
.int fetch, lit, flag_immediate, or_
.int swap, store
.int exit
-defword "variable", 8, 0, 0x19385305, variable, immediate
+defword "variable", variable, 0x19385305
.int create # create header
.int lit, 0, comma # initialize to zero
.int exit
-defword "constant", 8, 0, 0x0691EA25, constant, variable
+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
.int exit
-defcode "read-char", 10, 0, 0xF07E2044, read_char, variable
+defcode "read-char", read_char, 0xF07E2044
jal _read_char_impl
push w
next
@@ -926,27 +934,27 @@ _read_char_eof:
mv w, zero
ret
-defword "buffer-open", 11, 0, 0x79AAD9CA, buffer_open, read_char
+defword "buffer-open", buffer_open, 0x79AAD9CA
# ( addr len -- addr end-addr cur-addr )
.int over, plus, over
.int exit
-defword "buffer-close", 12, 0, 0x42B7429E, buffer_close, buffer_open
+defword "buffer-close", buffer_close, 0x42B7429E
# ( open-buffer -- len )
.int nip, swap, minus
.int exit
-defword "buffer-emit", 11, 0, 0xEA240555, buffer_emit, buffer_close
+defword "buffer-emit", buffer_emit, 0xEA240555
# ( open-buffer char -- open-buffer )
.int over, store, lit, 1, plus
.int exit
-defword "buffer-full?", 12, 0, 0x070A2E6C, buffer_full_q, buffer_emit
+defword "buffer-full?", buffer_full_q, 0x070A2E6C
# ( open-buffer -- flag )
.int two_dup, greater_than # TODO: >=
.int exit
-defword "read-line", 10, 0, 0xAF1308A2, read_line, buffer_full_q
+defword "read-line", read_line, 0xAF1308A2
.int buffer_open
_read_line_loop:
.int read_char
@@ -984,7 +992,7 @@ _okay:
word_buffer: .space 255
.balign cell
-_latest: .int name_constant
+_latest: prev_link
_here: .int __here_start
_meta: .int __meta_start
