commit d58e86959f8f535523f43e86174c3db43f297b44
parent 916cf97b8f41509b44ffed37e1ca56534882f07a
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Thu, 30 Apr 2026 17:43:15 -0700
scheme1: tidy
Diffstat:
| M | scheme1/scheme1.P1pp | | | 1789 | ++++++++++++++++++++++++++++++++++++------------------------------------------- |
1 file changed, 807 insertions(+), 982 deletions(-)
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -79,17 +79,58 @@
%lb(rd, rd, 0)
%endm
+# Increment cursor and store it back. `addr_reg` is the address of
+# readbuf_pos as returned by %lda_global (the second output register).
+%macro readbuf_advance(pos_reg, addr_reg)
+ %addi(pos_reg, pos_reg, 1)
+ %st(pos_reg, addr_reg, 0)
+%endm
+
+# Load readbuf_len into len_reg and branch to target if cursor is at EOF.
+%macro readbuf_at_eof(pos_reg, len_reg, target)
+ %ld_global(len_reg, &readbuf_len)
+ %beq(pos_reg, len_reg, target)
+%endm
+
+# Branch character equal/not-equal: if (c == expect) / (c != expect) goto target.
+# expect passed as -(char_code). scratch is clobbered.
+%macro bceq(c, neg_cv, target, scratch)
+ %addi(scratch, c, neg_cv)
+ %beqz(scratch, target)
+%endm
+
+%macro bcne(c, neg_cv, target, scratch)
+ %addi(scratch, c, neg_cv)
+ %bnez(scratch, target)
+%endm
+
+# Branch immediate equal/not-equal: if (reg == value) / (reg != value) goto target.
+# scratch is clobbered.
+%macro bieq(reg, value, target, scratch)
+ %li(scratch, value)
+ %beq(reg, scratch, target)
+%endm
+
+%macro bine(reg, value, target, scratch)
+ %li(scratch, value)
+ %bne(reg, scratch, target)
+%endm
+
# Branch to `target` if `ch_reg` holds an ASCII whitespace byte (space,
# tab, LF, CR). `scratch` is clobbered.
%macro is_ws_branch(scratch, ch_reg, target)
- %addi(scratch, ch_reg, -32)
- %beqz(scratch, target)
- %addi(scratch, ch_reg, -9)
- %beqz(scratch, target)
- %addi(scratch, ch_reg, -10)
- %beqz(scratch, target)
- %addi(scratch, ch_reg, -13)
- %beqz(scratch, target)
+ %bceq(ch_reg, -32, target, scratch) ; SP
+ %bceq(ch_reg, -9, target, scratch) ; HT
+ %bceq(ch_reg, -10, target, scratch) ; LF
+ %bceq(ch_reg, -13, target, scratch) ; CR
+%endm
+
+# Branch to `target` if lo_neg <= c < lo_neg+count (unsigned). Both
+# scratch and count_scratch are clobbered.
+%macro brange(c, lo_neg, count, scratch, count_scratch, target)
+ %addi(scratch, c, lo_neg)
+ %li(count_scratch, count)
+ %bltu(scratch, count_scratch, target)
%endm
# Compute &symtab_buf + idx_reg * SYMENT.SIZE into rd. `scratch` is
@@ -142,21 +183,19 @@
%beq(val, scratch, target)
%endm
-# Advance a list cursor parked at sp[slot] to its cdr. t0 is the implicit
-# scratch register; callers must ensure it's free.
-%macro advance_walk(slot)
- %ld(t0, sp, slot)
+# Advance a named list-cursor local to its cdr. t0 is the implicit scratch
+# register; callers must ensure it's free.
+%macro advance_walk(name)
+ %ldl(t0, name)
%cdr(t0, t0)
- %st(t0, sp, slot)
+ %stl(t0, name)
%endm
-# Bind a global from registers a0 (value) and t0 (tagged sym). Untags t0,
-# rearranges into the (idx, val) ABI, and calls sym_set_global. Used at
-# the tail of every define-style binder.
-%macro bind_global_from_t0()
- %untag_sym(t0, t0)
- %mov(a1, a0)
- %mov(a0, t0)
+# Set a global binding. sym is a tagged symbol, val is the new value.
+# Untags sym into the idx ABI position and calls sym_set_global.
+%macro set_global(sym, val)
+ %mov(a1, val)
+ %untag_sym(a0, sym)
%call(&sym_set_global)
%endm
@@ -220,15 +259,7 @@
%call(&heap_init)
%call(&intern_special_forms)
%call(®ister_primitives)
-
- # Bind `eof` as a direct global -> IMM.EOF value. (Predicate is `eof?`,
- # registered via prim_table.) Cheaper and shorter than a 0-arg thunk.
- %la(a0, &name_eof)
- %li(a1, 3)
- %call(&intern)
- %untag_sym(a0, a0)
- %li(a1, %imm_val(%IMM.EOF))
- %call(&sym_set_global)
+ %call(®ister_globals)
# load_source(argv[1])
%ld_global(a0, &saved_argv)
@@ -277,22 +308,19 @@
%beq(t0, t1, &::done)
%readbuf_byte(a0, t0)
%is_ws_branch(a1, a0, &::step)
- %addi(a1, a0, -59) ; ';'
- %beqz(a1, &::comment)
+ %bceq(a0, -59, &::comment, a1) ; ';'
%b(&::done)
::comment
# Consume up to and including the next LF, or to EOF.
%addi(t0, t0, 1)
%beq(t0, t1, &::done)
%readbuf_byte(a0, t0)
- %addi(a1, a0, -10)
- %bnez(a1, &::comment)
- %addi(t0, t0, 1)
- %b(&::loop)
+ %bcne(a0, -10, &::comment, a1) ; LF
::step
%addi(t0, t0, 1)
%b(&::loop)
::done
+
%st(t0, t2, 0)
%li(a0, 1)
%beq(t0, t1, &::ret)
@@ -309,26 +337,19 @@
%ld_global(t0, &readbuf_pos)
%readbuf_byte(a0, t0)
- %addi(a1, a0, -40)
- %beqz(a1, &::lparen)
- %addi(a1, a0, -41)
- %beqz(a1, &::rparen)
- %addi(a1, a0, -35)
- %beqz(a1, &::hash)
- %addi(a1, a0, -39) ; '\''
- %beqz(a1, &::quote)
- %addi(a1, a0, -44) ; ','
- %beqz(a1, &::comma)
- %addi(a1, a0, -34) ; '"'
- %beqz(a1, &::string)
+ %bceq(a0, -40, &::lparen, a1)
+ %bceq(a0, -41, &::rparen, a1)
+ %bceq(a0, -35, &::hash, a1)
+ %bceq(a0, -39, &::quote, a1)
+ %bceq(a0, -44, &::comma, a1)
+ %bceq(a0, -34, &::string, a1)
%tail(&parse_atom)
::lparen
# Consume '(' and read items until ')'.
%lda_global(t1, t0, &readbuf_pos)
- %addi(t1, t1, 1)
- %st(t1, t0, 0)
+ %readbuf_advance(t1, t0)
%tail(&parse_list)
::rparen
@@ -338,31 +359,22 @@
# Consume opening '"' and tail to parse_string. parse_string scans
# through the matching '"' (consuming it) and returns a tagged bv.
%lda_global(t1, t0, &readbuf_pos)
- %addi(t1, t1, 1)
- %st(t1, t0, 0)
+ %readbuf_advance(t1, t0)
%tail(&parse_string)
::hash
# Consume '#' plus its type byte; dispatch on the type byte.
%lda_global(t0, t2, &readbuf_pos)
%addi(t0, t0, 1)
- %ld_global(t1, &readbuf_len)
- %beq(t0, t1, &::eof)
+ %readbuf_at_eof(t0, t1, &::eof)
%readbuf_byte(a0, t0)
- %addi(t0, t0, 1)
- %st(t0, t2, 0)
- %addi(a1, a0, -116) ; 't'
- %beqz(a1, &::true_lit)
- %addi(a1, a0, -102) ; 'f'
- %beqz(a1, &::false_lit)
- %addi(a1, a0, -120) ; 'x'
- %beqz(a1, &::hex_lit)
- %addi(a1, a0, -88) ; 'X'
- %beqz(a1, &::hex_lit)
- %addi(a1, a0, -92) ; '\\'
- %beqz(a1, &::char_lit)
- %addi(a1, a0, -117) ; 'u'
- %beqz(a1, &::u8_lit)
+ %readbuf_advance(t0, t2)
+ %bceq(a0, -116, &::true_lit, a1) ; 't'
+ %bceq(a0, -102, &::false_lit, a1) ; 'f'
+ %bceq(a0, -120, &::hex_lit, a1) ; 'x'
+ %bceq(a0, -88, &::hex_lit, a1) ; 'X'
+ %bceq(a0, -92, &::char_lit, a1) ; '\\'
+ %bceq(a0, -117, &::u8_lit, a1) ; 'u'
%die(msg_bad_hash)
::true_lit
@@ -381,10 +393,8 @@
%beq(t0, t1, &::hex_end)
%readbuf_byte(a0, t0)
%is_ws_branch(a1, a0, &::hex_end)
- %addi(a1, a0, -40)
- %beqz(a1, &::hex_end)
- %addi(a1, a0, -41)
- %beqz(a1, &::hex_end)
+ %bceq(a0, -40, &::hex_end, a1)
+ %bceq(a0, -41, &::hex_end, a1)
%addi(t0, t0, 1)
%b(&::hex_scan)
::hex_end
@@ -412,8 +422,7 @@
# Consume the leading '\''; recurse into parse_one for the datum;
# then build (quote <datum>).
%lda_global(t0, t2, &readbuf_pos)
- %addi(t0, t0, 1)
- %st(t0, t2, 0)
+ %readbuf_advance(t0, t2)
%call(&parse_one)
%li(a1, %imm_val(%IMM.NIL))
%call(&cons)
@@ -429,8 +438,7 @@
# `(unquote x)` reaches eval as an application of the unbound
# `unquote` and dies through the standard unbound-variable path.
%lda_global(t0, t2, &readbuf_pos)
- %addi(t0, t0, 1)
- %st(t0, t2, 0)
+ %readbuf_advance(t0, t2)
%call(&parse_one)
%li(a1, %imm_val(%IMM.NIL))
%call(&cons)
@@ -448,18 +456,14 @@
# Cursor is past '#u'. Demand '8' then '('; consume both and tail to
# parse_u8_body, which reads the element list and packs it into a bv.
%lda_global(t0, t2, &readbuf_pos)
- %ld_global(t1, &readbuf_len)
- %beq(t0, t1, &::u8_bad)
+ %readbuf_at_eof(t0, t1, &::u8_bad)
%readbuf_byte(a0, t0)
- %addi(a1, a0, -56) ; '8'
- %bnez(a1, &::u8_bad)
+ %bcne(a0, -56, &::u8_bad, a1) ; '8'
%addi(t0, t0, 1)
%beq(t0, t1, &::u8_bad)
%readbuf_byte(a0, t0)
- %addi(a1, a0, -40) ; '('
- %bnez(a1, &::u8_bad)
- %addi(t0, t0, 1)
- %st(t0, t2, 0)
+ %bcne(a0, -40, &::u8_bad, a1) ; '('
+ %readbuf_advance(t0, t2)
%tail(&parse_u8_body)
::u8_bad
@@ -487,21 +491,17 @@
%ld_global(t1, &readbuf_len)
%readbuf_byte(a0, t0)
- %addi(a1, a0, -41)
- %beqz(a1, &::close)
+ %bceq(a0, -41, &::close, a1)
# Dotted-pair separator: '.' followed by ws/paren/EOF (otherwise the
# '.' is part of an identifier and parse_atom handles it).
- %addi(a1, a0, -46)
- %bnez(a1, &::not_dot)
+ %bcne(a0, -46, &::not_dot, a1) ; '.'
%addi(a2, t0, 1)
%beq(a2, t1, &::do_dot)
%readbuf_byte(a3, a2)
%is_ws_branch(a1, a3, &::do_dot)
- %addi(a1, a3, -40)
- %beqz(a1, &::do_dot)
- %addi(a1, a3, -41)
- %beqz(a1, &::do_dot)
+ %bceq(a3, -40, &::do_dot, a1)
+ %bceq(a3, -41, &::do_dot, a1)
::not_dot
# Not ')': parse one item, append.
@@ -511,8 +511,7 @@
# If head is NIL, both head and tail = new cons; else set-cdr! tail = new.
%ldl(t0, head)
- %li(t1, %imm_val(%IMM.NIL))
- %bne(t0, t1, &::link)
+ %bine(t0, %imm_val(%IMM.NIL), &::link, t1)
%stl(a0, head)
%stl(a0, tail)
%b(&::loop)
@@ -528,8 +527,7 @@
# Consume the '.', read one datum, splice it in as the cdr of the
# tail cons. Then expect a closing ')' (with optional ws).
%lda_global(t0, t1, &readbuf_pos)
- %addi(t0, t0, 1)
- %st(t0, t1, 0)
+ %readbuf_advance(t0, t1)
%call(&parse_one)
%ldl(t0, tail)
%set_cdr(a0, t0)
@@ -537,18 +535,15 @@
%bnez(a0, &::eof)
%lda_global(t0, t1, &readbuf_pos)
%readbuf_byte(a0, t0)
- %addi(a1, a0, -41)
- %bnez(a1, &::eof)
- %addi(t0, t0, 1)
- %st(t0, t1, 0)
+ %bcne(a0, -41, &::eof, a1) ; ')'
+ %readbuf_advance(t0, t1)
%ldl(a0, head)
%eret
::close
# Consume ')' and return head.
%lda_global(t1, t0, &readbuf_pos)
- %addi(t1, t1, 1)
- %st(t1, t0, 0)
+ %readbuf_advance(t1, t0)
%ldl(a0, head)
%eret
@@ -578,7 +573,7 @@
::loop
%if_nil(t1, a0, &::done)
%car(t1, a0)
- %sari(t1, t1, 3) ; untag fixnum -> raw byte
+ %untag_fix(t1, t1)
%sb(t1, t0, 0)
%addi(t0, t0, 1)
%cdr(a0, a0)
@@ -593,52 +588,32 @@
# Clobbers t0, t1, a1.
:is_ident_byte
%scope is_ident_byte
- %addi(t0, a0, -48) ; '0'
- %li(t1, 10)
- %bltu(t0, t1, &::ok) ; '0'..'9'
- %li(t1, 26)
- %addi(t0, a0, -65) ; 'A'
- %bltu(t0, t1, &::ok) ; 'A'..'Z'
- %addi(t0, a0, -97) ; 'a'
- %bltu(t0, t1, &::ok) ; 'a'..'z'
- %addi(t0, a0, -33) ; '!'
- %beqz(t0, &::ok)
- %addi(t0, a0, -36) ; '$'
- %beqz(t0, &::ok)
- %addi(t0, a0, -37) ; '%'
- %beqz(t0, &::ok)
- %addi(t0, a0, -38) ; '&'
- %beqz(t0, &::ok)
- %addi(t0, a0, -42) ; '*'
- %beqz(t0, &::ok)
- %addi(t0, a0, -43) ; '+'
- %beqz(t0, &::ok)
- %addi(t0, a0, -45) ; '-'
- %beqz(t0, &::ok)
- %addi(t0, a0, -46) ; '.'
- %beqz(t0, &::ok)
- %addi(t0, a0, -47) ; '/'
- %beqz(t0, &::ok)
- %addi(t0, a0, -58) ; ':'
- %beqz(t0, &::ok)
- %addi(t0, a0, -60) ; '<'
- %beqz(t0, &::ok)
- %addi(t0, a0, -61) ; '='
- %beqz(t0, &::ok)
- %addi(t0, a0, -62) ; '>'
- %beqz(t0, &::ok)
- %addi(t0, a0, -63) ; '?'
- %beqz(t0, &::ok)
- %addi(t0, a0, -64) ; '@'
- %beqz(t0, &::ok)
- %addi(t0, a0, -94) ; '^'
- %beqz(t0, &::ok)
- %addi(t0, a0, -95) ; '_'
- %beqz(t0, &::ok)
- %addi(t0, a0, -126) ; '~'
- %beqz(t0, &::ok)
+ %brange(a0, -48, 10, t0, t1, &::ok) ; '0'..'9'
+ %brange(a0, -65, 26, t0, t1, &::ok) ; 'A'..'Z'
+ %brange(a0, -97, 26, t0, t1, &::ok) ; 'a'..'z'
+
+ %bceq(a0, -33, &::ok, t0) ; '!'
+ %bceq(a0, -36, &::ok, t0) ; '$'
+ %bceq(a0, -37, &::ok, t0) ; '%'
+ %bceq(a0, -38, &::ok, t0) ; '&'
+ %bceq(a0, -42, &::ok, t0) ; '*'
+ %bceq(a0, -43, &::ok, t0) ; '+'
+ %bceq(a0, -45, &::ok, t0) ; '-'
+ %bceq(a0, -46, &::ok, t0) ; '.'
+ %bceq(a0, -47, &::ok, t0) ; '/'
+ %bceq(a0, -58, &::ok, t0) ; ':'
+ %bceq(a0, -60, &::ok, t0) ; '<'
+ %bceq(a0, -61, &::ok, t0) ; '='
+ %bceq(a0, -62, &::ok, t0) ; '>'
+ %bceq(a0, -63, &::ok, t0) ; '?'
+ %bceq(a0, -64, &::ok, t0) ; '@'
+ %bceq(a0, -94, &::ok, t0) ; '^'
+ %bceq(a0, -95, &::ok, t0) ; '_'
+ %bceq(a0, -126, &::ok, t0) ; '~'
+
%li(a1, 0)
%ret
+
::ok
%li(a1, 1)
%ret
@@ -665,11 +640,8 @@
%readbuf_byte(a0, t1)
%is_ws_branch(a1, a0, &::end)
- # paren?
- %addi(a1, a0, -40)
- %beqz(a1, &::end)
- %addi(a1, a0, -41)
- %beqz(a1, &::end)
+ %bceq(a0, -40, &::end, a1) ; '('
+ %bceq(a0, -41, &::end, a1) ; ')'
%addi(t1, t1, 1)
%b(&::scan)
@@ -690,10 +662,8 @@
%bltu(a1, a2, &::is_int)
# '-' or '+' followed by digit -> int. A lone '+' or '-' falls
# through to is_sym (those tokens stay valid identifiers).
- %addi(a1, t1, -45)
- %beqz(a1, &::sign)
- %addi(a1, t1, -43)
- %beqz(a1, &::sign)
+ %bceq(t1, -45, &::sign, a1) ; '-'
+ %bceq(t1, -43, &::sign, a1) ; '+'
%b(&::is_sym)
::sign
%ldl(t2, end)
@@ -733,13 +703,22 @@
%tail(&intern)
::is_int
- %ldl(t0, start) ; start_off
- %ldl(t1, end) ; end_off
+ %ldl(t0, start)
+ %ldl(t1, end)
%ld_global(a0, &readbuf_buf_ptr)
- %add(a0, a0, t0) ; ptr = base + start_off
- %sub(a1, t1, t0) ; len = end_off - start_off
- %call(&parse_dec) ; -> (a0=value, a1=ok)
- %beqz(a1, &::int_bad)
+ %add(a0, a0, t0)
+ %sub(a1, t1, t0) ; len = end - start
+ # P1pp's parse_dec handles '-' but not '+'; strip '+' here.
+ %lb(t2, a0, 0)
+ %bcne(t2, -43, &::no_plus, t2) ; '+'
+ %addi(a0, a0, 1)
+ %addi(a1, a1, -1)
+ ::no_plus
+ %stl(a1, cursor) ; save adjusted len (cursor slot is free on int path)
+ %call(&parse_dec) ; P1pp: -> (raw_val=a0, consumed=a1)
+ %ldl(t0, cursor)
+ %bne(a1, t0, &::int_bad) ; partial parse -> bad
+ %mkfix(a0, a0)
%eret
::int_bad
%die(msg_bad_number)
@@ -767,10 +746,8 @@
::scan
%beq(t1, t2, &::eof)
%readbuf_byte(a3, t1)
- %addi(a1, a3, -34) ; '"'
- %beqz(a1, &::scan_done)
- %addi(a1, a3, -92) ; '\\'
- %beqz(a1, &::scan_esc)
+ %bceq(a3, -34, &::scan_done, a1) ; '"'
+ %bceq(a3, -92, &::scan_esc, a1) ; '\\'
%addi(t1, t1, 1)
%addi(a0, a0, 1)
%b(&::scan)
@@ -782,8 +759,7 @@
%addi(t1, t1, 1)
%beq(t1, t2, &::eof)
%readbuf_byte(a3, t1)
- %addi(a1, a3, -120) ; 'x'
- %beqz(a1, &::scan_hex)
+ %bceq(a3, -120, &::scan_hex, a1) ; 'x'
%addi(t1, t1, 1)
%addi(a0, a0, 1)
%b(&::scan)
@@ -796,8 +772,7 @@
::scan_hex_loop
%beq(t1, t2, &::eof)
%readbuf_byte(a3, t1)
- %addi(a1, a3, -59) ; ';'
- %beqz(a1, &::scan_hex_done)
+ %bceq(a3, -59, &::scan_hex_done, a1) ; ';'
%addi(t1, t1, 1)
%b(&::scan_hex_loop)
::scan_hex_done
@@ -811,15 +786,14 @@
%stl(a0, bv)
# Pass 2: decode into the freshly allocated data buffer.
- %ldl(t1, start) ; start
- %ldl(t2, end) ; end
+ %ldl(t1, start)
+ %ldl(t2, end)
%heap_ld(a3, a0, %BV.data)
::fill
%beq(t1, t2, &::fill_done)
%readbuf_byte(a1, t1)
- %addi(a2, a1, -92) ; '\\'
- %beqz(a2, &::fill_esc)
+ %bceq(a1, -92, &::fill_esc, a2) ; '\\'
%sb(a1, a3, 0)
%addi(a3, a3, 1)
%addi(t1, t1, 1)
@@ -828,18 +802,12 @@
::fill_esc
%addi(t1, t1, 1) ; consume backslash
%readbuf_byte(a1, t1)
- %addi(a2, a1, -110) ; 'n'
- %beqz(a2, &::esc_n)
- %addi(a2, a1, -116) ; 't'
- %beqz(a2, &::esc_t)
- %addi(a2, a1, -114) ; 'r'
- %beqz(a2, &::esc_r)
- %addi(a2, a1, -92) ; '\\'
- %beqz(a2, &::write_byte)
- %addi(a2, a1, -34) ; '"'
- %beqz(a2, &::write_byte)
- %addi(a2, a1, -120) ; 'x'
- %beqz(a2, &::esc_hex)
+ %bceq(a1, -110, &::esc_n, a2) ; 'n'
+ %bceq(a1, -116, &::esc_t, a2) ; 't'
+ %bceq(a1, -114, &::esc_r, a2) ; 'r'
+ %bceq(a1, -92, &::write_byte, a2) ; '\\'
+ %bceq(a1, -34, &::write_byte, a2) ; '"'
+ %bceq(a1, -120, &::esc_hex, a2) ; 'x'
%die(msg_bad_escape)
::esc_n
@@ -876,8 +844,7 @@
%ldl(t2, end)
%beq(t1, t2, &::hex_bad)
%readbuf_byte(t0, t1)
- %addi(t0, t0, -59) ; ';'
- %bnez(t0, &::hex_bad)
+ %bcne(t0, -59, &::hex_bad, t0) ; ';'
%addi(t1, t1, 1) ; consume ';'
%ldl(a3, spill)
%sb(a0, a3, 0)
@@ -897,6 +864,20 @@
%die(msg_unterm_string)
})
+# Emit one named-char arm inside parse_char's multi-byte dispatch. t2
+# must hold the slice pointer; ::bad must be in scope. name_label is a
+# full label reference (e.g. &name_ch_tab).
+%macro match_named_char(name_label, len, value)
+ %mov(a0, t2)
+ %la(a1, name_label)
+ %li(a2, len)
+ %call(&memcmp)
+ %bnez(a0, &::bad)
+ %li(a0, value)
+ %mkfix(a0, a0)
+ %eret
+%endm
+
# parse_char() -> tagged fixnum (the u8 char value) in a0. Cursor sits
# past '#\\' (consumed by parse_one's hash dispatch). Always consumes
# at least one byte; then continues until ws/paren/EOF. Single-byte
@@ -922,10 +903,8 @@
%beq(t1, t2, &::scan_done)
%readbuf_byte(a0, t1)
%is_ws_branch(a1, a0, &::scan_done)
- %addi(a1, a0, -40) ; '('
- %beqz(a1, &::scan_done)
- %addi(a1, a0, -41) ; ')'
- %beqz(a1, &::scan_done)
+ %bceq(a0, -40, &::scan_done, a1) ; '('
+ %bceq(a0, -41, &::scan_done, a1) ; ')'
%addi(t1, t1, 1)
%b(&::scan)
@@ -937,8 +916,7 @@
%ldl(t1, end)
%sub(a2, t1, t0) ; length
- %li(a3, 1)
- %beq(a2, a3, &::single)
+ %bieq(a2, 1, &::single, a3)
%ld_global(t2, &readbuf_buf_ptr)
%add(t2, t2, t0) ; t2 = slice ptr
@@ -949,16 +927,11 @@
%beqz(a1, &::hex_form)
# Named form: dispatch on length.
- %li(a3, 3)
- %beq(a2, a3, &::try_tab)
- %li(a3, 4)
- %beq(a2, a3, &::try_null)
- %li(a3, 5)
- %beq(a2, a3, &::try_space)
- %li(a3, 6)
- %beq(a2, a3, &::try_return)
- %li(a3, 7)
- %beq(a2, a3, &::try_newline)
+ %bieq(a2, 3, &::try_tab, a3)
+ %bieq(a2, 4, &::try_null, a3)
+ %bieq(a2, 5, &::try_space, a3)
+ %bieq(a2, 6, &::try_return, a3)
+ %bieq(a2, 7, &::try_newline, a3)
%b(&::bad)
::single
@@ -976,54 +949,19 @@
%eret
::try_tab
- %mov(a0, t2)
- %la(a1, &name_ch_tab)
- %li(a2, 3)
- %call(&memcmp)
- %bnez(a0, &::bad)
- %li(a0, 9)
- %mkfix(a0, a0)
- %eret
+ %match_named_char(&name_ch_tab, 3, 9)
::try_null
- %mov(a0, t2)
- %la(a1, &name_ch_null)
- %li(a2, 4)
- %call(&memcmp)
- %bnez(a0, &::bad)
- %li(a0, 0)
- %mkfix(a0, a0)
- %eret
+ %match_named_char(&name_ch_null, 4, 0)
::try_space
- %mov(a0, t2)
- %la(a1, &name_ch_space)
- %li(a2, 5)
- %call(&memcmp)
- %bnez(a0, &::bad)
- %li(a0, 32)
- %mkfix(a0, a0)
- %eret
+ %match_named_char(&name_ch_space, 5, 32)
::try_return
- %mov(a0, t2)
- %la(a1, &name_ch_return)
- %li(a2, 6)
- %call(&memcmp)
- %bnez(a0, &::bad)
- %li(a0, 13)
- %mkfix(a0, a0)
- %eret
+ %match_named_char(&name_ch_return, 6, 13)
::try_newline
- %mov(a0, t2)
- %la(a1, &name_ch_newline)
- %li(a2, 7)
- %call(&memcmp)
- %bnez(a0, &::bad)
- %li(a0, 10)
- %mkfix(a0, a0)
- %eret
+ %match_named_char(&name_ch_newline, 7, 10)
::bad
%die(msg_bad_char)
@@ -1032,84 +970,10 @@
%die(msg_bad_char)
})
-# parse_dec(data_ptr=a0, len=a1) -> (tagged fixnum=a0, ok=a1). Leaf.
-# Accepts an optional leading '+' or '-' followed by one or more decimal
-# digits. ok=1 on a fully-consumed valid input; ok=0 on empty input, a
-# lone sign, or any non-digit byte. On failure a0 still holds the
-# best-effort accumulator (sign-applied, retagged) so reader-style
-# callers that don't check ok get the same garbage they got before this
-# routine validated. UB on integer overflow. Uses only t0..t2.
-#
-# Register map:
-# t0 = current ptr a0 = byte / digit / final value
-# t1 = remaining length a1 = ok flag (output)
-# t2 = constant 10 a2 = sign flag (1 = negative)
-# a3 = accumulator (raw value)
-:parse_dec
-%scope parse_dec
- %mov(t0, a0)
- %mov(t1, a1)
- %li(a2, 0)
- %li(a3, 0)
- %beqz(t1, &::fail)
-
- %lb(a0, t0, 0)
- %addi(t2, a0, -45) ; '-'
- %beqz(t2, &::neg)
- %addi(t2, a0, -43) ; '+'
- %bnez(t2, &::loop_init)
- %b(&::skip_sign)
- ::neg
- %li(a2, 1)
- ::skip_sign
- %addi(t0, t0, 1)
- %addi(t1, t1, -1)
- %beqz(t1, &::fail)
-
- ::loop_init
- %li(t2, 10)
-
- ::loop
- %beqz(t1, &::done)
- %lb(a0, t0, 0)
- %addi(a0, a0, -48)
- %bltz(a0, &::fail)
- %bltu(a0, t2, &::digit_ok)
- %b(&::fail)
- ::digit_ok
- %mul(a3, a3, t2)
- %add(a3, a3, a0)
- %addi(t0, t0, 1)
- %addi(t1, t1, -1)
- %b(&::loop)
-
- ::done
- %beqz(a2, &::tag)
- %li(t2, 0)
- %sub(a3, t2, a3)
- ::tag
- %mkfix(a0, a3)
- %li(a1, 1)
- %ret
-
- ::fail
- %beqz(a2, &::fail_tag)
- %li(t2, 0)
- %sub(a3, t2, a3)
- ::fail_tag
- %mkfix(a0, a3)
- %li(a1, 0)
- %ret
-%endscope
# =========================================================================
# eval / apply
# =========================================================================
-#
-# eval is the only place that touches tag bits at runtime; the table
-# below is a flat compare cascade for now (5 tags). When special-form
-# dispatch is wired up the SYM/PAIR paths split further per LISP-C.md
-# §Eval.
# eval(expr=a0, env=a1) -> value (a0)
#
@@ -1123,10 +987,8 @@
%stl(a1, env)
%tagof(t0, a0)
- %li(t1, %TAG.PAIR)
- %beq(t0, t1, &::pair)
- %li(t1, %TAG.SYM)
- %beq(t0, t1, &::sym)
+ %bieq(t0, %TAG.SYM, &::sym, t1)
+ %bieq(t0, %TAG.PAIR, &::pair, t1)
# FIXNUM, HEAP, IMM all self-evaluate.
%eret
@@ -1149,14 +1011,15 @@
::env_miss
%untag_sym(a0, a0)
%call(&sym_global)
- %li(t0, %imm_val(%IMM.UNBOUND))
- %beq(a0, t0, &::unbound)
+ %bieq(a0, %imm_val(%IMM.UNBOUND), &::unbound, t0)
%eret
::unbound
%die(msg_unbound)
+
::pair
+
# Special-form dispatch: pointer-compare head against the cached
# special-form symbol values. SYM is a distinct tag, so a head that
# isn't a symbol cannot collide with any sym_* slot.
@@ -1181,31 +1044,25 @@
%dispatch_form(&sym_pmatch, &::do_pmatch)
%dispatch_form(&sym_do, &::do_do)
- # head = eval(car(expr), env)
+ # Apply car to cdr
+ # fn = eval(car(expr), env)
%ldl(a0, expr)
%car(a0, a0)
%ldl(a1, env)
%call(&eval)
%stl(a0, fn)
-
# args = eval_args(cdr(expr), env)
%ldl(a0, expr)
%cdr(a0, a0)
%ldl(a1, env)
%call(&eval_args)
-
# apply(fn, args) -- tail call
%mov(a1, a0)
%ldl(a0, fn)
%tail(&apply)
::do_quote
- # (quote datum) -> car(cdr(expr))
- %ldl(a0, expr)
- %cdr(a0, a0)
- %car(a0, a0)
- %eret
-
+ %tail_to_handler(&eval_quote)
::do_if
%tail_to_handler(&eval_if)
::do_lambda
@@ -1261,34 +1118,34 @@
%stl(t0, tail)
::loop
- %ldl(t0, args)
- %if_nil(t1, t0, &::done)
+ %ldl(t0, args)
+ %if_nil(t1, t0, &::done)
- # val = eval(car(args), env)
- %car(a0, t0)
- %ldl(a1, env)
- %call(&eval)
-
- # cell = cons(val, NIL); append to head/tail.
- %li(a1, %imm_val(%IMM.NIL))
- %call(&cons)
+ # val = eval(car(args), env)
+ %car(a0, t0)
+ %ldl(a1, env)
+ %call(&eval)
- %ldl(t0, head)
- %if_nil(t1, t0, &::first)
- %ldl(t0, tail)
- %set_cdr(a0, t0)
- %stl(a0, tail)
- %b(&::advance)
+ # cell = cons(val, NIL); append to head/tail.
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
- ::first
- %stl(a0, head)
- %stl(a0, tail)
+ %ldl(t0, head)
+ %if_nil(t1, t0, &::first)
+ %ldl(t0, tail)
+ %set_cdr(a0, t0)
+ %stl(a0, tail)
+ %b(&::advance)
- ::advance
- %advance_walk(0)
- %b(&::loop)
+ ::first
+ %stl(a0, head)
+ %stl(a0, tail)
+ ::advance
+ %advance_walk(args)
+ %b(&::loop)
::done
+
%ldl(a0, head)
})
@@ -1301,22 +1158,12 @@
%fn2(apply, {args body}, {
%stl(a1, args)
- # Only HEAP-tagged values can be applicable.
- %tagof(t0, a0)
- %li(t1, %TAG.HEAP)
- %bne(t0, t1, &::not_proc)
-
%hdr_type(t0, a0)
- %li(t1, %HDR.PRIM)
- %beq(t0, t1, &::prim)
- %li(t1, %HDR.CLOSURE)
- %beq(t0, t1, &::closure)
-
- ::not_proc
- %die(msg_not_proc)
+ %bieq(t0, %HDR.PRIM, &::prim, t1)
+ %bieq(t0, %HDR.CLOSURE, &::closure, t1)
::prim
- # Primitive calling convention (interface, not coincidence):
+ # Primitive calling convention:
# a0 = args list (proper list of evaluated args)
# a1 = the PRIM object itself (HEAP-tagged)
# Parameterized PRIMs (e.g. the per-field record accessors built
@@ -1333,13 +1180,13 @@
::closure
# Closure layout (HEAP-tagged): [hdr][params][body][env]
- # field offsets from tagged ptr: params=5, body=13, env=21.
- %heap_ld(t1, a0, %CLOSURE.body) ; must survive bind_params
- %stl(t1, body)
- %heap_ld(t2, a0, %CLOSURE.env)
%heap_ld(t0, a0, %CLOSURE.params)
+ %heap_ld(t1, a0, %CLOSURE.body)
+ %heap_ld(t2, a0, %CLOSURE.env)
+ %stl(t1, body) ; persist body past bind_params
- %mov(a0, t0) ; bind_params(params, args, env)
+ # bind_params(params, args, env)
+ %mov(a0, t0)
%ldl(a1, args)
%mov(a2, t2)
%call(&bind_params)
@@ -1348,7 +1195,6 @@
%mov(a1, a0)
%ldl(a0, body)
%tail(&eval_body)
-
})
# =========================================================================
@@ -1388,6 +1234,11 @@
%intern_form(&name_dollar, 1, &sym_dollar)
})
+# eval_quote(rest=a0, env=a1) -> value (a0). rest is (datum); return datum.
+%fn(eval_quote, 0, {
+ %car(a0, a0)
+})
+
# eval_if(rest=a0, env=a1) -> value (a0). `rest` is (test then) or
# (test then else). Single-arm form returns UNSPEC when test is #f.
# No arity check beyond that -- spec policy: malformed special forms
@@ -1404,8 +1255,7 @@
%car(a0, a0)
%call(&eval)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::else_branch)
+ %bieq(a0, %imm_val(%IMM.FALSE), &::else_branch, t0)
# then-branch: tail-eval(cadr(rest), env)
%ldl(a0, rest)
@@ -1442,7 +1292,7 @@
%stl(a0, rest)
%stl(a1, env)
- %li(a0, 32)
+ %li(a0, %CLOSURE.SIZE)
%li(a1, %HDR.CLOSURE)
%call(&alloc_hdr)
%stl(a0, closure)
@@ -1484,8 +1334,7 @@
# If car(rest) is a pair, this is the lambda-sugar form.
%car(t0, a0)
%tagof(t1, t0)
- %li(t2, %TAG.PAIR)
- %beq(t1, t2, &::sugar)
+ %bieq(t1, %TAG.PAIR, &::sugar, t2)
# Plain define: value = eval(car(cdr(rest)), env)
%ldl(t0, rest)
@@ -1496,7 +1345,7 @@
%ldl(t0, rest)
%car(t0, t0)
- %bind_global_from_t0()
+ %set_global(t0, a0)
%li(a0, %imm_val(%IMM.UNSPEC))
%eret
@@ -1514,7 +1363,7 @@
%ldl(t0, rest)
%car(t0, t0)
%car(t0, t0) ; name
- %bind_global_from_t0()
+ %set_global(t0, a0)
%li(a0, %imm_val(%IMM.UNSPEC))
})
@@ -1546,29 +1395,29 @@
%ldl(t1, rest)
%car(t1, t1) ; target sym
- ::lp
- %ldl(t2, env)
- %if_nil(t0, t2, &::ms)
- %car(t0, t2)
- %car(t0, t0) ; cell sym
- %beq(t0, t1, &::ht)
- %cdr(t2, t2)
- %stl(t2, env)
- %b(&::lp)
-
- ::ht
+ ::loop
+ %ldl(t2, env)
+ %if_nil(t0, t2, &::miss)
+ %car(t0, t2)
+ %car(t0, t0) ; cell sym
+ %beq(t0, t1, &::hit)
+ %cdr(t2, t2)
+ %stl(t2, env)
+ %b(&::loop)
+
+ ::hit
%car(t0, t2) ; re-fetch binding cell
%ldl(a0, saved)
%set_cdr(a0, t0) ; mutate cell's cdr
%li(a0, %imm_val(%IMM.UNSPEC))
%eret
- ::ms
+ ::miss
# Miss: rebind global.
%ldl(a0, saved)
%ldl(t0, rest)
%car(t0, t0)
- %bind_global_from_t0()
+ %set_global(t0, a0)
%li(a0, %imm_val(%IMM.UNSPEC))
})
@@ -1589,19 +1438,19 @@
::loop
%ldl(t0, clauses)
- %if_nil(t1, t0, &::nm)
+ %if_nil(t1, t0, &::no_match)
%car(t1, t0) ; clause
%car(t2, t1) ; test_expr
%ld_global(a0, &sym_else)
- %beq(t2, a0, &::dm)
+ %beq(t2, a0, &::else_clause)
%mov(a0, t2)
%ldl(a1, env)
%call(&eval)
%li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::nx)
+ %beq(a0, t0, &::next)
# Truthy. Spill test value and inspect cdr(clause): empty -> UNSPEC,
# car == => -> arrow path, else regular body.
@@ -1609,16 +1458,16 @@
%ldl(t0, clauses)
%car(t0, t0)
%cdr(t0, t0)
- %if_nil(t1, t0, &::nm)
+ %if_nil(t1, t0, &::no_match)
%car(t1, t0)
%ld_global(t2, &sym_arrow)
- %beq(t1, t2, &::ar)
+ %beq(t1, t2, &::arrow)
%mov(a0, t0) ; regular body
%ldl(a1, env)
%tail(&eval_body)
- ::ar
+ ::arrow
%cdr(t0, t0)
%car(a0, t0) ; proc-expr
%ldl(a1, env)
@@ -1631,18 +1480,18 @@
%ldl(a0, proc)
%tail(&apply)
- ::dm
+ ::else_clause
%ldl(t0, clauses)
%car(t0, t0)
%cdr(a0, t0)
%ldl(a1, env)
%tail(&eval_body)
- ::nx
- %advance_walk(0)
+ ::next
+ %advance_walk(clauses)
%b(&::loop)
- ::nm
+ ::no_match
%li(a0, %imm_val(%IMM.UNSPEC))
})
@@ -1665,8 +1514,7 @@
# Named let?
%car(t0, a0)
%tagof(t1, t0)
- %li(t2, %TAG.SYM)
- %beq(t1, t2, &::named)
+ %bieq(t1, %TAG.SYM, &::named, t2)
%ldl(t0, rest)
%car(t0, t0) ; bindings
@@ -1700,7 +1548,7 @@
%call(&cons)
%stl(a0, new_env)
- %advance_walk(16)
+ %advance_walk(walk)
%b(&::loop)
::done
@@ -1735,33 +1583,33 @@
%stl(t0, new_env)
::loop
- %ldl(t0, walk)
- %if_nil(t1, t0, &::done)
-
- %car(t1, t0)
- %cdr(t2, t1)
- %car(t2, t2)
+ %ldl(t0, walk)
+ %if_nil(t1, t0, &::done)
- # val = eval(init, new_env)
- %mov(a0, t2)
- %ldl(a1, new_env)
- %call(&eval)
+ %car(t1, t0)
+ %cdr(t2, t1)
+ %car(t2, t2)
- %ldl(t0, walk)
- %car(t1, t0)
- %car(t2, t1)
- %mov(a1, a0)
- %mov(a0, t2)
- %call(&cons)
+ # val = eval(init, new_env)
+ %mov(a0, t2)
+ %ldl(a1, new_env)
+ %call(&eval)
- %ldl(a1, new_env)
- %call(&cons)
- %stl(a0, new_env)
+ %ldl(t0, walk)
+ %car(t1, t0)
+ %car(t2, t1)
+ %mov(a1, a0)
+ %mov(a0, t2)
+ %call(&cons)
- %advance_walk(16)
- %b(&::loop)
+ %ldl(a1, new_env)
+ %call(&cons)
+ %stl(a0, new_env)
+ %advance_walk(walk)
+ %b(&::loop)
::done
+
%ldl(a0, rest)
%cdr(a0, a0)
%ldl(a1, new_env)
@@ -1790,35 +1638,35 @@
%stl(t0, new_env) ; new_env = env
::loop
- %ldl(t0, walk)
- %if_nil(t1, t0, &::done)
-
- %car(t1, t0) ; clause = (formals init)
- %cdr(t2, t1)
- %car(t2, t2) ; init
+ %ldl(t0, walk)
+ %if_nil(t1, t0, &::done)
- # val = eval(init, env_orig)
- %mov(a0, t2)
- %ldl(a1, env)
- %call(&eval)
+ %car(t1, t0) ; clause = (formals init)
+ %cdr(t2, t1)
+ %car(t2, t2) ; init
- # vals = mv_to_list(val)
- %call(&mv_to_list)
+ # val = eval(init, env_orig)
+ %mov(a0, t2)
+ %ldl(a1, env)
+ %call(&eval)
- # new_env = bind_params(formals, vals, new_env)
- %ldl(t0, walk)
- %car(t1, t0)
- %car(t1, t1) ; formals
- %mov(a1, a0)
- %mov(a0, t1)
- %ldl(a2, new_env)
- %call(&bind_params)
- %stl(a0, new_env)
+ # vals = mv_to_list(val)
+ %call(&mv_to_list)
- %advance_walk(16)
- %b(&::loop)
+ # new_env = bind_params(formals, vals, new_env)
+ %ldl(t0, walk)
+ %car(t1, t0)
+ %car(t1, t1) ; formals
+ %mov(a1, a0)
+ %mov(a0, t1)
+ %ldl(a2, new_env)
+ %call(&bind_params)
+ %stl(a0, new_env)
+ %advance_walk(walk)
+ %b(&::loop)
::done
+
%ldl(a0, rest)
%cdr(a0, a0) ; body
%ldl(a1, new_env)
@@ -1845,33 +1693,33 @@
%stl(t0, new_env)
::loop
- %ldl(t0, walk)
- %if_nil(t1, t0, &::done)
-
- %car(t1, t0)
- %cdr(t2, t1)
- %car(t2, t2) ; init
+ %ldl(t0, walk)
+ %if_nil(t1, t0, &::done)
- # val = eval(init, new_env)
- %mov(a0, t2)
- %ldl(a1, new_env)
- %call(&eval)
+ %car(t1, t0)
+ %cdr(t2, t1)
+ %car(t2, t2) ; init
- %call(&mv_to_list)
+ # val = eval(init, new_env)
+ %mov(a0, t2)
+ %ldl(a1, new_env)
+ %call(&eval)
- %ldl(t0, walk)
- %car(t1, t0)
- %car(t1, t1) ; formals
- %mov(a1, a0)
- %mov(a0, t1)
- %ldl(a2, new_env)
- %call(&bind_params)
- %stl(a0, new_env)
+ %call(&mv_to_list)
- %advance_walk(16)
- %b(&::loop)
+ %ldl(t0, walk)
+ %car(t1, t0)
+ %car(t1, t1) ; formals
+ %mov(a1, a0)
+ %mov(a0, t1)
+ %ldl(a2, new_env)
+ %call(&bind_params)
+ %stl(a0, new_env)
+ %advance_walk(walk)
+ %b(&::loop)
::done
+
%ldl(a0, rest)
%cdr(a0, a0)
%ldl(a1, new_env)
@@ -1891,30 +1739,30 @@
%if_nil(t1, a0, &::done_imm)
::loop
- %stl(a0, rest)
- %stl(a1, env)
+ %stl(a0, rest)
+ %stl(a1, env)
- # If cdr(rest) is NIL, the head is the last form -> tail-eval.
- %cdr(t0, a0)
- %if_nil(t1, t0, &::last)
+ # If cdr(rest) is NIL, the head is the last form -> tail-eval.
+ %cdr(t0, a0)
+ %if_nil(t1, t0, &::last)
- # Non-last: eval, short-circuit on #f, otherwise advance.
- %car(a0, a0)
- %call(&eval)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::done)
- %ldl(a0, rest)
- %cdr(a0, a0)
- %ldl(a1, env)
- %b(&::loop)
-
- ::last
- %ldl(a0, rest)
- %car(a0, a0)
- %ldl(a1, env)
- %tail(&eval)
+ # Non-last: eval, short-circuit on #f, otherwise advance.
+ %car(a0, a0)
+ %call(&eval)
+ %li(t0, %imm_val(%IMM.FALSE))
+ %beq(a0, t0, &::done)
+ %ldl(a0, rest)
+ %cdr(a0, a0)
+ %ldl(a1, env)
+ %b(&::loop)
+ ::last
+ %ldl(a0, rest)
+ %car(a0, a0)
+ %ldl(a1, env)
+ %tail(&eval)
::done
+
%eret
::done_imm
@@ -1934,28 +1782,27 @@
%if_nil(t1, a0, &::done_imm)
::loop
- %stl(a0, rest)
- %stl(a1, env)
-
- %cdr(t0, a0)
- %if_nil(t1, t0, &::last)
+ %stl(a0, rest)
+ %stl(a1, env)
- %car(a0, a0)
- %call(&eval)
- %li(t0, %imm_val(%IMM.FALSE))
- %bne(a0, t0, &::done)
- %ldl(a0, rest)
- %cdr(a0, a0)
- %ldl(a1, env)
- %b(&::loop)
+ %cdr(t0, a0)
+ %if_nil(t1, t0, &::last)
- ::last
- %ldl(a0, rest)
- %car(a0, a0)
- %ldl(a1, env)
- %tail(&eval)
+ %car(a0, a0)
+ %call(&eval)
+ %bine(a0, %imm_val(%IMM.FALSE), &::done, t0)
+ %ldl(a0, rest)
+ %cdr(a0, a0)
+ %ldl(a1, env)
+ %b(&::loop)
+ ::last
+ %ldl(a0, rest)
+ %car(a0, a0)
+ %ldl(a1, env)
+ %tail(&eval)
::done
+
%eret
::done_imm
@@ -1977,8 +1824,7 @@
%car(a0, a0) ; test
%call(&eval)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::skip)
+ %bieq(a0, %imm_val(%IMM.FALSE), &::skip, t0)
%ldl(a0, rest)
%cdr(a0, a0) ; body
@@ -2017,46 +1863,46 @@
%stl(a0, subject)
::loop
- %ldl(t0, clauses)
- %if_nil(t1, t0, &::no_match)
-
- %car(t1, t0) ; clause
- %car(t2, t1) ; head: datum-list or `else`
-
- %ld_global(a3, &sym_else)
- %beq(t2, a3, &::do_else)
-
- # Walk the datum list, eq?-compare each against subject.
- %stl(t2, datums)
- %ldl(a0, subject)
- ::scan
- %ldl(t0, datums)
- %if_nil(t1, t0, &::next_clause)
- %car(t1, t0) ; datum
- %beq(t1, a0, &::do_body)
- %cdr(t0, t0)
- %stl(t0, datums)
- %b(&::scan)
-
- ::do_body
- %ldl(t0, clauses)
- %car(t0, t0)
- %cdr(a0, t0) ; body
- %ldl(a1, env)
- %tail(&eval_body)
-
- ::do_else
- %ldl(t0, clauses)
- %car(t0, t0)
- %cdr(a0, t0) ; body
- %ldl(a1, env)
- %tail(&eval_body)
+ %ldl(t0, clauses)
+ %if_nil(t1, t0, &::no_match)
+
+ %car(t1, t0) ; clause
+ %car(t2, t1) ; head: datum-list or `else`
+
+ %ld_global(a3, &sym_else)
+ %beq(t2, a3, &::do_else)
+
+ # Walk the datum list, eq?-compare each against subject.
+ %stl(t2, datums)
+ %ldl(a0, subject)
+ ::scan
+ %ldl(t0, datums)
+ %if_nil(t1, t0, &::next_clause)
+ %car(t1, t0) ; datum
+ %beq(t1, a0, &::do_body)
+ %cdr(t0, t0)
+ %stl(t0, datums)
+ %b(&::scan)
- ::next_clause
- %ldl(t0, clauses)
- %cdr(t0, t0)
- %stl(t0, clauses)
- %b(&::loop)
+ ::do_body
+ %ldl(t0, clauses)
+ %car(t0, t0)
+ %cdr(a0, t0) ; body
+ %ldl(a1, env)
+ %tail(&eval_body)
+
+ ::do_else
+ %ldl(t0, clauses)
+ %car(t0, t0)
+ %cdr(a0, t0) ; body
+ %ldl(a1, env)
+ %tail(&eval_body)
+
+ ::next_clause
+ %ldl(t0, clauses)
+ %cdr(t0, t0)
+ %stl(t0, clauses)
+ %b(&::loop)
::no_match
%li(a0, %imm_val(%IMM.UNSPEC))
@@ -2094,88 +1940,85 @@
%stl(a0, subject)
::loop
- %ldl(t0, clauses)
- %if_nil(t1, t0, &::no_match)
-
- %car(t1, t0) ; clause
- %car(t2, t1) ; pat
-
- %ld_global(a3, &sym_else)
- %beq(t2, a3, &::do_else)
-
- # pmatch_match(pat, subject, env_outer) -> (a0=env_ext, a1=ok)
- %mov(a0, t2)
- %ldl(a1, subject)
- %ldl(a2, env_outer)
- %call(&pmatch_match)
- %beqz(a1, &::next)
-
- %stl(a0, env_ext) ; env_ext
-
- # tail = cdr(clause)
- %ldl(t0, clauses)
- %car(t0, t0)
- %cdr(t0, t0) ; tail = (body...) or ((guard ...) body...)
-
- # Guard form? tail is a pair, car(tail) is a pair, head of car(tail)
- # eq? sym_guard.
- %tagof(t1, t0)
- %li(t2, %TAG.PAIR)
- %bne(t1, t2, &::body_simple)
- %car(t1, t0) ; first form of tail
- %tagof(t2, t1)
- %li(a0, %TAG.PAIR)
- %bne(t2, a0, &::body_simple)
- %car(a0, t1) ; head of first form
- %ld_global(a1, &sym_guard)
- %bne(a0, a1, &::body_simple)
-
- # Guard clause. guards = cdr(car(tail)); body = cdr(tail).
- %cdr(a0, t1)
- %stl(a0, guard)
- %cdr(t0, t0)
- %stl(t0, body)
-
- ::g_loop
- %ldl(t0, guard)
- %if_nil(t1, t0, &::body_run)
-
- %car(a0, t0) ; guard expr
- %ldl(a1, env_ext) ; env_ext
- %call(&eval)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::next)
-
- %ldl(t0, guard)
- %cdr(t0, t0)
- %stl(t0, guard)
- %b(&::g_loop)
-
- ::body_run
- %ldl(a0, body)
- %ldl(a1, env_ext)
- %tail(&eval_body)
-
- ::body_simple
- # tail itself is the body (no guard wrapper). Tail-call eval_body
- # with the extended env; tail position of the matched clause's body
- # is preserved.
- %mov(a0, t0)
- %ldl(a1, env_ext)
- %tail(&eval_body)
-
- ::do_else
- %ldl(t0, clauses)
- %car(t0, t0)
- %cdr(a0, t0) ; body
- %ldl(a1, env_outer) ; env_outer (no bindings introduced)
- %tail(&eval_body)
-
- ::next
- %ldl(t0, clauses)
- %cdr(t0, t0)
- %stl(t0, clauses)
- %b(&::loop)
+ %ldl(t0, clauses)
+ %if_nil(t1, t0, &::no_match)
+
+ %car(t1, t0) ; clause
+ %car(t2, t1) ; pat
+
+ %ld_global(a3, &sym_else)
+ %beq(t2, a3, &::do_else)
+
+ # pmatch_match(pat, subject, env_outer) -> (a0=env_ext, a1=ok)
+ %mov(a0, t2)
+ %ldl(a1, subject)
+ %ldl(a2, env_outer)
+ %call(&pmatch_match)
+ %beqz(a1, &::next)
+
+ %stl(a0, env_ext) ; env_ext
+
+ # tail = cdr(clause)
+ %ldl(t0, clauses)
+ %car(t0, t0)
+ %cdr(t0, t0) ; tail = (body...) or ((guard ...) body...)
+
+ # Guard form? tail is a pair, car(tail) is a pair, head of car(tail)
+ # eq? sym_guard.
+ %tagof(t1, t0)
+ %bine(t1, %TAG.PAIR, &::body_simple, t2)
+ %car(t1, t0) ; first form of tail
+ %tagof(t2, t1)
+ %bine(t2, %TAG.PAIR, &::body_simple, a0)
+ %car(a0, t1) ; head of first form
+ %ld_global(a1, &sym_guard)
+ %bne(a0, a1, &::body_simple)
+
+ # Guard clause. guards = cdr(car(tail)); body = cdr(tail).
+ %cdr(a0, t1)
+ %stl(a0, guard)
+ %cdr(t0, t0)
+ %stl(t0, body)
+
+ ::g_loop
+ %ldl(t0, guard)
+ %if_nil(t1, t0, &::body_run)
+
+ %car(a0, t0) ; guard expr
+ %ldl(a1, env_ext) ; env_ext
+ %call(&eval)
+ %bieq(a0, %imm_val(%IMM.FALSE), &::next, t0)
+
+ %ldl(t0, guard)
+ %cdr(t0, t0)
+ %stl(t0, guard)
+ %b(&::g_loop)
+
+ ::body_run
+ %ldl(a0, body)
+ %ldl(a1, env_ext)
+ %tail(&eval_body)
+
+ ::body_simple
+ # tail itself is the body (no guard wrapper). Tail-call eval_body
+ # with the extended env; tail position of the matched clause's body
+ # is preserved.
+ %mov(a0, t0)
+ %ldl(a1, env_ext)
+ %tail(&eval_body)
+
+ ::do_else
+ %ldl(t0, clauses)
+ %car(t0, t0)
+ %cdr(a0, t0) ; body
+ %ldl(a1, env_outer) ; env_outer (no bindings introduced)
+ %tail(&eval_body)
+
+ ::next
+ %ldl(t0, clauses)
+ %cdr(t0, t0)
+ %stl(t0, clauses)
+ %b(&::loop)
::no_match
%die(msg_pmatch_no_match)
@@ -2227,71 +2070,71 @@
%stl(t0, vals_tail)
::init_loop
- %ldl(t0, walk)
- %if_nil(t1, t0, &::init_done)
-
- # spec = car(walk); init-expr = car(cdr(spec)).
- %car(t1, t0)
- %cdr(a0, t1)
- %car(a0, a0) ; init expression
-
- # val = eval(init, env)
- %ldl(a1, env)
- %call(&eval)
-
- # binding pair = cons(var, val); var = car(car(walk)).
- %ldl(t0, walk)
- %car(t1, t0)
- %car(t2, t1) ; var
- %mov(a1, a0)
- %mov(a0, t2)
- %call(&cons) ; a0 = binding pair
-
- # new_env = cons(pair, new_env). cons clobbers t0/t1/t2 so we don't
- # spill pair into a t-reg; recover it as car(new_env) afterwards.
- %ldl(a1, new_env)
- %call(&cons)
- %stl(a0, new_env)
-
- # pcell = cons(pair, NIL). pair = car(new_env), and a0 still holds
- # the new_env list pointer from the cons above.
- %car(a0, a0)
- %li(a1, %imm_val(%IMM.NIL))
- %call(&cons)
-
- %ldl(t0, pairs_head)
- %if_nil(t1, t0, &::pairs_first)
- %ldl(t0, pairs_tail)
- %set_cdr(a0, t0)
- %stl(a0, pairs_tail)
- %b(&::vals_alloc)
-
- ::pairs_first
- %stl(a0, pairs_head)
- %stl(a0, pairs_tail)
-
- ::vals_alloc
- # vcell = cons(NIL, NIL). Append onto vals list.
- %li(a0, %imm_val(%IMM.NIL))
- %li(a1, %imm_val(%IMM.NIL))
- %call(&cons)
-
- %ldl(t0, vals_head)
- %if_nil(t1, t0, &::vals_first)
- %ldl(t0, vals_tail)
- %set_cdr(a0, t0)
- %stl(a0, vals_tail)
- %b(&::init_advance)
+ %ldl(t0, walk)
+ %if_nil(t1, t0, &::init_done)
- ::vals_first
- %stl(a0, vals_head)
- %stl(a0, vals_tail)
+ # spec = car(walk); init-expr = car(cdr(spec)).
+ %car(t1, t0)
+ %cdr(a0, t1)
+ %car(a0, a0) ; init expression
- ::init_advance
- %advance_walk(24)
- %b(&::init_loop)
+ # val = eval(init, env)
+ %ldl(a1, env)
+ %call(&eval)
+ # binding pair = cons(var, val); var = car(car(walk)).
+ %ldl(t0, walk)
+ %car(t1, t0)
+ %car(t2, t1) ; var
+ %mov(a1, a0)
+ %mov(a0, t2)
+ %call(&cons) ; a0 = binding pair
+
+ # new_env = cons(pair, new_env). cons clobbers t0/t1/t2 so we don't
+ # spill pair into a t-reg; recover it as car(new_env) afterwards.
+ %ldl(a1, new_env)
+ %call(&cons)
+ %stl(a0, new_env)
+
+ # pcell = cons(pair, NIL). pair = car(new_env), and a0 still holds
+ # the new_env list pointer from the cons above.
+ %car(a0, a0)
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
+
+ %ldl(t0, pairs_head)
+ %if_nil(t1, t0, &::pairs_first)
+ %ldl(t0, pairs_tail)
+ %set_cdr(a0, t0)
+ %stl(a0, pairs_tail)
+ %b(&::vals_alloc)
+
+ ::pairs_first
+ %stl(a0, pairs_head)
+ %stl(a0, pairs_tail)
+
+ ::vals_alloc
+ # vcell = cons(NIL, NIL). Append onto vals list.
+ %li(a0, %imm_val(%IMM.NIL))
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
+
+ %ldl(t0, vals_head)
+ %if_nil(t1, t0, &::vals_first)
+ %ldl(t0, vals_tail)
+ %set_cdr(a0, t0)
+ %stl(a0, vals_tail)
+ %b(&::init_advance)
+
+ ::vals_first
+ %stl(a0, vals_head)
+ %stl(a0, vals_tail)
+
+ ::init_advance
+ %advance_walk(walk)
+ %b(&::init_loop)
::init_done
+
# body = cddr(rest).
%ldl(t0, rest)
%cdr(t0, t0)
@@ -2307,8 +2150,7 @@
%ldl(a1, new_env)
%call(&eval)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::commands)
+ %bieq(a0, %imm_val(%IMM.FALSE), &::commands, t0)
# Truthy: results = cdr(car(cdr(rest))).
%ldl(t0, rest)
@@ -2334,7 +2176,7 @@
%car(a0, t0)
%ldl(a1, new_env)
%call(&eval)
- %advance_walk(24)
+ %advance_walk(walk)
%b(&::cmd_loop)
::step_phase
@@ -2373,9 +2215,9 @@
%ldl(t0, val_walk)
%set_car(a0, t0)
- %advance_walk(24)
- %advance_walk(72)
- %advance_walk(80)
+ %advance_walk(walk)
+ %advance_walk(pair_walk)
+ %advance_walk(val_walk)
%b(&::step_loop)
::update_phase
@@ -2392,8 +2234,8 @@
%ldl(t0, val_walk)
%car(t2, t0) ; new val
%set_cdr(t2, t1)
- %advance_walk(72)
- %advance_walk(80)
+ %advance_walk(pair_walk)
+ %advance_walk(val_walk)
%b(&::update_loop)
})
@@ -2442,20 +2284,15 @@
%beq(a0, a1, &::ok)
# HDR.BV equality.
- %li(t1, %TAG.HEAP)
- %bne(t0, t1, &::no)
+ %bine(t0, %TAG.HEAP, &::no, t1)
%hdr_type(t1, a0)
- %li(t2, %HDR.BV)
- %bne(t1, t2, &::no)
+ %bine(t1, %HDR.BV, &::no, t2)
%tagof(t1, a1)
- %li(t2, %TAG.HEAP)
- %bne(t1, t2, &::no)
+ %bine(t1, %TAG.HEAP, &::no, t2)
%hdr_type(t1, a1)
- %li(t2, %HDR.BV)
- %bne(t1, t2, &::no)
+ %bine(t1, %HDR.BV, &::no, t2)
%call(&bv_equal_check)
- %li(t0, %imm_val(%IMM.TRUE))
- %beq(a0, t0, &::ok)
+ %bieq(a0, %imm_val(%IMM.TRUE), &::ok, t0)
%b(&::no)
::pair_pat
@@ -2467,8 +2304,7 @@
# Structural pair. subj must be a pair too.
%tagof(t0, a1)
- %li(t1, %TAG.PAIR)
- %bne(t0, t1, &::no)
+ %bine(t0, %TAG.PAIR, &::no, t1)
# Recurse on the cars; on success, recurse on the cdrs as a tail call.
%ldl(t0, pat)
@@ -2492,15 +2328,12 @@
%ldl(t0, pat)
%cdr(t1, t0) ; cdr(pat)
%tagof(t0, t1)
- %li(t2, %TAG.PAIR)
- %bne(t0, t2, &::bad)
+ %bine(t0, %TAG.PAIR, &::bad, t2)
%cdr(t0, t1) ; cdr(cdr(pat))
- %li(t2, %imm_val(%IMM.NIL))
- %bne(t0, t2, &::bad)
+ %bine(t0, %imm_val(%IMM.NIL), &::bad, t2)
%car(t0, t1) ; pident (kept in t0)
%tagof(t2, t0)
- %li(a3, %TAG.SYM)
- %bne(t2, a3, &::bad)
+ %bine(t2, %TAG.SYM, &::bad, a3)
# Wildcard? Compare against sym_underscore; if so, no binding.
%ld_global(t1, &sym_underscore)
@@ -2525,12 +2358,10 @@
%ldl(t0, pat)
%cdr(t1, t0) ; (pred-sym . clauses)
%tagof(t0, t1)
- %li(t2, %TAG.PAIR)
- %bne(t0, t2, &::no)
+ %bine(t0, %TAG.PAIR, &::no, t2)
%car(t0, t1) ; t0 = pred-sym
%tagof(t2, t0)
- %li(a3, %TAG.SYM)
- %bne(t2, a3, &::no)
+ %bine(t2, %TAG.SYM, &::no, a3)
%cdr(t2, t1) ; t2 = clauses
%stl(t2, flw)
@@ -2542,11 +2373,9 @@
# Verify HEAP / HDR.PRIM, entry == &prim_predicate_entry; extract TD
# from PRIM.data; sanity-check TD is HEAP / HDR.TD.
%tagof(t0, a0)
- %li(t1, %TAG.HEAP)
- %bne(t0, t1, &::no)
+ %bine(t0, %TAG.HEAP, &::no, t1)
%hdr_type(t0, a0)
- %li(t1, %HDR.PRIM)
- %bne(t0, t1, &::no)
+ %bine(t0, %HDR.PRIM, &::no, t1)
%heap_ld(t1, a0, %PRIM.entry_w)
%la(t2, &prim_predicate_entry)
%bne(t1, t2, &::no)
@@ -2577,13 +2406,11 @@
%if_nil(t1, t0, &::ok)
%car(t1, t0) ; t1 = clause
%tagof(t0, t1)
- %li(t2, %TAG.PAIR)
- %bne(t0, t2, &::no)
+ %bine(t0, %TAG.PAIR, &::no, t2)
%car(t2, t1) ; t2 = fname
%cdr(t1, t1) ; t1 = (pat_i)
%tagof(t0, t1)
- %li(a3, %TAG.PAIR)
- %bne(t0, a3, &::no)
+ %bine(t0, %TAG.PAIR, &::no, a3)
%car(a3, t1) ; a3 = pat_i
%stl(a3, pat) ; reuse `pat` local for pat_i across recursion
@@ -2696,7 +2523,7 @@
%stl(a0, tail)
::p1_advance
- %advance_walk(32)
+ %advance_walk(walk)
%b(&::p1_loop)
::p1_done
@@ -2738,7 +2565,7 @@
%stl(a0, tail)
::p2_advance
- %advance_walk(32)
+ %advance_walk(walk)
%b(&::p2_loop)
::p2_done
@@ -2775,31 +2602,31 @@
%stl(a2, env)
::loop
- %ldl(t0, params)
- %tagof(t1, t0)
- %li(t2, %TAG.PAIR)
- %beq(t1, t2, &::pair)
- %li(t2, %TAG.SYM)
- %beq(t1, t2, &::rest_bind)
- %b(&::done)
-
- ::pair
- # binding = cons(car(params), car(args))
- %ldl(t0, params)
- %car(a0, t0)
- %ldl(t0, args)
- %car(a1, t0)
- %call(&cons)
-
- # env = cons(binding, env)
- %ldl(a1, env)
- %call(&cons)
- %stl(a0, env)
+ %ldl(t0, params)
+ %tagof(t1, t0)
+ %li(t2, %TAG.PAIR)
+ %beq(t1, t2, &::pair)
+ %li(t2, %TAG.SYM)
+ %beq(t1, t2, &::rest_bind)
+ %b(&::done)
- # advance params and args
- %advance_walk(0)
- %advance_walk(8)
- %b(&::loop)
+ ::pair
+ # binding = cons(car(params), car(args))
+ %ldl(t0, params)
+ %car(a0, t0)
+ %ldl(t0, args)
+ %car(a1, t0)
+ %call(&cons)
+
+ # env = cons(binding, env)
+ %ldl(a1, env)
+ %call(&cons)
+ %stl(a0, env)
+
+ # advance params and args
+ %advance_walk(params)
+ %advance_walk(args)
+ %b(&::loop)
::rest_bind
# binding = cons(params_sym, args_list); env = cons(binding, env)
@@ -3070,11 +2897,9 @@
# count (remaining slot count)
%fn2(mv_to_list, {ptr count}, {
%tagof(t0, a0)
- %li(t1, %TAG.HEAP)
- %bne(t0, t1, &::single)
+ %bine(t0, %TAG.HEAP, &::single, t1)
%hdr_type(t0, a0)
- %li(t1, %HDR.MV)
- %bne(t0, t1, &::single)
+ %bine(t0, %HDR.MV, &::single, t1)
# MV-pack: count = (hdr >> 8); header sits at raw+0 = tagged-3.
%ld(t0, a0, -3)
@@ -3280,6 +3105,17 @@
::done
})
+%fn(register_globals, 0, {
+ # Bind `eof` as a direct global -> IMM.EOF value. (Predicate is `eof?`,
+ # registered via prim_table.) Cheaper and shorter than a 0-arg thunk.
+ %la(a0, &name_eof)
+ %li(a1, 3)
+ %call(&intern)
+ %untag_sym(a0, a0)
+ %li(a1, %imm_val(%IMM.EOF))
+ %call(&sym_set_global)
+})
+
# Each primitive is a leaf reached via apply's %tailr: args list is in a0,
# and the result goes back in a0. Most use no frame at all; the few that
# need recursion (apply) carry a small one via %fn.
@@ -3445,8 +3281,7 @@
%car(a0, t2) ; (car pair)
%ldl(a1, key)
%call(&equal_recurse)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::next)
+ %bieq(a0, %imm_val(%IMM.FALSE), &::next, t0)
%ldl(a0, pair)
%eret
@@ -3509,13 +3344,13 @@
%li(t0, 0)
%mov(t1, a0)
::sum_loop
- %if_nil(t2, t1, &::sum_done)
- %car(t2, t1)
- %heap_ld(a0, t2, %BV.hdr)
- %shri(a0, a0, 8)
- %add(t0, t0, a0)
- %cdr(t1, t1)
- %b(&::sum_loop)
+ %if_nil(t2, t1, &::sum_done)
+ %car(t2, t1)
+ %heap_ld(a0, t2, %BV.hdr)
+ %shri(a0, a0, 8)
+ %add(t0, t0, a0)
+ %cdr(t1, t1)
+ %b(&::sum_loop)
::sum_done
%stl(t0, total)
@@ -3527,28 +3362,28 @@
%stl(t0, write)
::copy_loop
- %ldl(t0, args)
- %if_nil(t1, t0, &::copy_done)
- %car(t1, t0) ; src bv
- %heap_ld(t2, t1, %BV.hdr)
- %shri(t2, t2, 8) ; src length
-
- %ldl(a0, result)
- %heap_ld(a0, a0, %BV.data) ; result.data
- %ldl(a3, write)
- %add(a0, a0, a3) ; dst = result.data + offset
- %heap_ld(a1, t1, %BV.data) ; src.data
- %mov(a2, t2) ; count
-
- %add(a3, a3, t2)
- %stl(a3, write)
- %cdr(t0, t0)
- %stl(t0, args)
-
- %call(&memcpy)
- %b(&::copy_loop)
-
+ %ldl(t0, args)
+ %if_nil(t1, t0, &::copy_done)
+ %car(t1, t0) ; src bv
+ %heap_ld(t2, t1, %BV.hdr)
+ %shri(t2, t2, 8) ; src length
+
+ %ldl(a0, result)
+ %heap_ld(a0, a0, %BV.data) ; result.data
+ %ldl(a3, write)
+ %add(a0, a0, a3) ; dst = result.data + offset
+ %heap_ld(a1, t1, %BV.data) ; src.data
+ %mov(a2, t2) ; count
+
+ %add(a3, a3, t2)
+ %stl(a3, write)
+ %cdr(t0, t0)
+ %stl(t0, args)
+
+ %call(&memcpy)
+ %b(&::copy_loop)
::copy_done
+
%ldl(a0, result)
})
@@ -3608,8 +3443,7 @@
%call(&str_alloc)
%ldl(a1, value)
%ldl(t0, radix)
- %li(t1, 16)
- %beq(t0, t1, &::hex)
+ %bieq(t0, 16, &::hex, t1)
%tail(&str_putint)
::hex
%tail(&str_puthex)
@@ -3626,11 +3460,9 @@
%car(t2, a0)
%tagof(t0, t2)
- %li(t1, %TAG.HEAP)
- %bne(t0, t1, &::fail)
+ %bine(t0, %TAG.HEAP, &::fail, t1)
%hdr_type(t0, t2)
- %li(t1, %HDR.BV)
- %bne(t0, t1, &::fail)
+ %bine(t0, %HDR.BV, &::fail, t1)
%heap_ld(t0, t2, %BV.data)
%heap_ld(t1, t2, %BV.hdr)
@@ -3644,15 +3476,24 @@
%if_nil(t1, t0, &::dec)
%car(t1, t0)
%sari(t1, t1, 3)
- %li(t2, 16)
- %beq(t1, t2, &::hex)
+ %bieq(t1, 16, &::hex, t2)
::dec
%ldl(a0, ptr)
%ldl(a1, len)
- %call(&parse_dec) ; -> (a0=value, a1=ok)
- %bnez(a1, &::end)
- %b(&::fail)
+ %beqz(a1, &::fail)
+ %lb(t0, a0, 0)
+ %bcne(t0, -43, &::dec_no_plus, t0) ; '+'
+ %addi(a0, a0, 1)
+ %addi(a1, a1, -1)
+ %beqz(a1, &::fail)
+ ::dec_no_plus
+ %stl(a1, len) ; save adjusted len
+ %call(&parse_dec) ; P1pp: -> (raw_val=a0, consumed=a1)
+ %ldl(t0, len)
+ %bne(a1, t0, &::fail) ; partial parse -> fail
+ %mkfix(a0, a0)
+ %b(&::end)
::hex
# Strip optional leading '+' / '-'.
@@ -3690,7 +3531,7 @@
%li(t1, 0)
%sub(a0, t1, a0)
::hex_pos
- %shli(a0, a0, 3) ; mkfix
+ %mkfix(a0, a0)
%b(&::end)
::fail
@@ -3797,11 +3638,11 @@
%scope prim_plus
%li(t0, 0) ; tagged 0; tag bits stay 0 across %add
::loop
- %if_nil(t1, a0, &::done)
- %car(t1, a0)
- %add(t0, t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %add(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::done
%mov(a0, t0)
%ret
@@ -3815,11 +3656,11 @@
%cdr(a0, a0)
%if_nil(t1, a0, &::neg)
::loop
- %if_nil(t1, a0, &::done)
- %car(t1, a0)
- %sub(t0, t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %sub(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::neg
%li(t1, 0) ; unary: 0 - seed
%sub(t0, t1, t0)
@@ -3834,12 +3675,12 @@
%scope prim_mult
%li(t0, 8) ; tagged 1 = mkfix(1)
::loop
- %if_nil(t1, a0, &::done)
- %car(t1, a0)
- %untag_fix(t1, t1)
- %mul(t0, t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %untag_fix(t1, t1)
+ %mul(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::done
%mov(a0, t0)
%ret
@@ -3853,12 +3694,12 @@
%car(t0, a0) ; prev = first
%cdr(a0, a0)
::loop
- %if_nil(t1, a0, &::true)
- %car(t1, a0) ; curr
- %bne(t0, t1, &::false)
- %mov(t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::true)
+ %car(t1, a0) ; curr
+ %bne(t0, t1, &::false)
+ %mov(t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::true
%li(a0, %imm_val(%IMM.TRUE))
%ret
@@ -3872,15 +3713,15 @@
%car(t0, a0)
%cdr(a0, a0)
::loop
- %if_nil(t1, a0, &::true)
- %car(t1, a0)
- %blt(t0, t1, &::ok) ; prev < curr -> continue
- %li(a0, %imm_val(%IMM.FALSE))
- %ret
- ::ok
- %mov(t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::true)
+ %car(t1, a0)
+ %blt(t0, t1, &::ok) ; prev < curr -> continue
+ %li(a0, %imm_val(%IMM.FALSE))
+ %ret
+ ::ok
+ %mov(t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::true
%li(a0, %imm_val(%IMM.TRUE))
%ret
@@ -3891,15 +3732,15 @@
%car(t0, a0)
%cdr(a0, a0)
::loop
- %if_nil(t1, a0, &::true)
- %car(t1, a0)
- %blt(t1, t0, &::ok) ; curr < prev <=> prev > curr -> continue
- %li(a0, %imm_val(%IMM.FALSE))
- %ret
- ::ok
- %mov(t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::true)
+ %car(t1, a0)
+ %blt(t1, t0, &::ok) ; curr < prev <=> prev > curr -> continue
+ %li(a0, %imm_val(%IMM.FALSE))
+ %ret
+ ::ok
+ %mov(t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::true
%li(a0, %imm_val(%IMM.TRUE))
%ret
@@ -3928,11 +3769,11 @@
%scope prim_bit_and
%li(t0, -8) ; tagged -1; AND-identity preserves the tag
::loop
- %if_nil(t1, a0, &::done)
- %car(t1, a0)
- %and(t0, t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %and(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::done
%mov(a0, t0)
%ret
@@ -3942,11 +3783,11 @@
%scope prim_bit_or
%li(t0, 0)
::loop
- %if_nil(t1, a0, &::done)
- %car(t1, a0)
- %or(t0, t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %or(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::done
%mov(a0, t0)
%ret
@@ -3956,11 +3797,11 @@
%scope prim_bit_xor
%li(t0, 0)
::loop
- %if_nil(t1, a0, &::done)
- %car(t1, a0)
- %xor(t0, t0, t1)
- %cdr(a0, a0)
- %b(&::loop)
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %xor(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
::done
%mov(a0, t0)
%ret
@@ -4171,13 +4012,13 @@
%li(a1, 0)
::fill_loop
- %beq(a1, t0, &::fill_done)
- %sb(t1, t2, 0)
- %addi(t2, t2, 1)
- %addi(a1, a1, 1)
- %b(&::fill_loop)
-
+ %beq(a1, t0, &::fill_done)
+ %sb(t1, t2, 0)
+ %addi(t2, t2, 1)
+ %addi(a1, a1, 1)
+ %b(&::fill_loop)
::fill_done
+
%ldl(a0, wrapper)
%eret
@@ -4363,12 +4204,12 @@
%sub(a3, a3, a2) ; count
::loop
- %beqz(a3, &::done)
- %lb(t1, a1, 0)
- %sb(t1, t0, 0)
- %addi(t0, t0, 1)
- %addi(a1, a1, 1)
- %addi(a3, a3, -1)
+ %beqz(a3, &::done)
+ %lb(t1, a1, 0)
+ %sb(t1, t0, 0)
+ %addi(t0, t0, 1)
+ %addi(a1, a1, 1)
+ %addi(a3, a3, -1)
%b(&::loop)
::done
@@ -4396,13 +4237,13 @@
%heap_ld(a3, a1, %BV.data)
::loop
- %beqz(t0, &::true)
- %lb(t1, a2, 0)
- %lb(t2, a3, 0)
- %bne(t1, t2, &::false)
- %addi(a2, a2, 1)
- %addi(a3, a3, 1)
- %addi(t0, t0, -1)
+ %beqz(t0, &::true)
+ %lb(t1, a2, 0)
+ %lb(t2, a3, 0)
+ %bne(t1, t2, &::false)
+ %addi(a2, a2, 1)
+ %addi(a3, a3, 1)
+ %addi(t0, t0, -1)
%b(&::loop)
::true
@@ -4458,10 +4299,8 @@
%tagof(t1, a1)
%bne(t0, t1, &::false)
- %li(t1, %TAG.PAIR)
- %beq(t0, t1, &::pair)
- %li(t1, %TAG.HEAP)
- %beq(t0, t1, &::heap)
+ %bieq(t0, %TAG.PAIR, &::pair, t1)
+ %bieq(t0, %TAG.HEAP, &::heap, t1)
%b(&::false)
::pair
@@ -4470,8 +4309,7 @@
%car(a0, t0)
%car(a1, t1)
%call(&equal_recurse)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::done)
+ %bieq(a0, %imm_val(%IMM.FALSE), &::done, t0)
%ldl(t0, a)
%ldl(t1, b)
%cdr(a0, t0)
@@ -4547,8 +4385,7 @@
%add(t1, t1, t2)
%ld(a1, t1, 0) ; b's field i
%call(&equal_recurse)
- %li(t0, %imm_val(%IMM.FALSE))
- %beq(a0, t0, &::done)
+ %bieq(a0, %imm_val(%IMM.FALSE), &::done, t0)
%ldl(t0, i)
%addi(t0, t0, 1)
@@ -4614,29 +4451,29 @@
%stl(t0, tail)
::loop
- %ldl(t0, walk)
- %cdr(t1, t0)
- %if_nil(t2, t1, &::last)
+ %ldl(t0, walk)
+ %cdr(t1, t0)
+ %if_nil(t2, t1, &::last)
- # cell = cons(car(walk), NIL); append to head/tail.
- %car(a0, t0)
- %li(a1, %imm_val(%IMM.NIL))
- %call(&cons)
+ # cell = cons(car(walk), NIL); append to head/tail.
+ %car(a0, t0)
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
- %ldl(t0, head)
- %if_nil(t1, t0, &::first)
- %ldl(t0, tail)
- %set_cdr(a0, t0)
- %stl(a0, tail)
- %b(&::advance)
+ %ldl(t0, head)
+ %if_nil(t1, t0, &::first)
+ %ldl(t0, tail)
+ %set_cdr(a0, t0)
+ %stl(a0, tail)
+ %b(&::advance)
- ::first
- %stl(a0, head)
- %stl(a0, tail)
+ ::first
+ %stl(a0, head)
+ %stl(a0, tail)
- ::advance
- %advance_walk(0)
- %b(&::loop)
+ ::advance
+ %advance_walk(walk)
+ %b(&::loop)
::last
# car(walk) is the trailing list. If head is NIL there were no leading
@@ -4710,14 +4547,14 @@
%addi(t1, a0, 13)
::fill_loop
- %if_nil(t2, t0, &::fill_done)
- %car(t2, t0)
- %st(t2, t1, 0)
- %addi(t1, t1, 8)
- %cdr(t0, t0)
- %b(&::fill_loop)
-
+ %if_nil(t2, t0, &::fill_done)
+ %car(t2, t0)
+ %st(t2, t1, 0)
+ %addi(t1, t1, 8)
+ %cdr(t0, t0)
+ %b(&::fill_loop)
::fill_done
+
%ldl(a0, record)
})
@@ -4728,11 +4565,9 @@
%heap_ld(t1, a1, %PRIM.data)
%tagof(t2, t0)
%li(a0, %imm_val(%IMM.FALSE))
- %li(a2, %TAG.HEAP)
- %bne(t2, a2, &::end)
+ %bine(t2, %TAG.HEAP, &::end, a2)
%hdr_type(t2, t0)
- %li(a2, %HDR.REC)
- %bne(t2, a2, &::end)
+ %bine(t2, %HDR.REC, &::end, a2)
%heap_ld(t2, t0, %REC.td)
%bne(t2, t1, &::end)
%li(a0, %imm_val(%IMM.TRUE))
@@ -4831,8 +4666,7 @@
# Splice into list: if head is NIL, head = tail = cell.
# Else set-cdr!(tail, cell); tail = cell.
%ldl(t1, fl_head)
- %li(t2, %imm_val(%IMM.NIL))
- %bne(t1, t2, &::fl_append)
+ %bine(t1, %imm_val(%IMM.NIL), &::fl_append, t2)
%stl(a0, fl_head)
%stl(a0, fl_tail)
%b(&::fl_next)
@@ -4859,7 +4693,7 @@
%cdr(t0, t0)
%car(t0, t0)
%car(t0, t0)
- %bind_global_from_t0()
+ %set_global(t0, a0)
# pred-prim = make_param_prim(prim_predicate_entry, td); bind pred.
%la(a0, &prim_predicate_entry)
@@ -4869,7 +4703,7 @@
%cdr(t0, t0)
%cdr(t0, t0)
%car(t0, t0)
- %bind_global_from_t0()
+ %set_global(t0, a0)
# Iterate clauses: bind accessor + optional mutator per clause.
%li(t0, 0)
@@ -4881,7 +4715,7 @@
# accessor-prim with data = tagged idx; bind cadr(clause).
%ldl(a1, idx)
- %shli(a1, a1, 3)
+ %mkfix(a1, a1)
%la(a0, &prim_accessor_entry)
%call(&make_param_prim)
@@ -4889,7 +4723,7 @@
%car(t0, t0)
%cdr(t0, t0)
%car(t0, t0)
- %bind_global_from_t0()
+ %set_global(t0, a0)
# Mutator? If cddr(clause) is a pair, bind it.
%ldl(t0, walk)
@@ -4899,7 +4733,7 @@
%if_nil(t1, t0, &::no_mutator)
%ldl(a1, idx)
- %shli(a1, a1, 3)
+ %mkfix(a1, a1)
%la(a0, &prim_mutator_entry)
%call(&make_param_prim)
@@ -4908,10 +4742,10 @@
%cdr(t0, t0)
%cdr(t0, t0)
%car(t0, t0)
- %bind_global_from_t0()
+ %set_global(t0, a0)
::no_mutator
- %advance_walk(24)
+ %advance_walk(walk)
%ldl(t0, idx)
%addi(t0, t0, 1)
%stl(t0, idx)
@@ -5175,14 +5009,10 @@
%stl(a2, mode)
%tagof(t0, a0)
- %li(t1, %TAG.PAIR)
- %beq(t0, t1, &::pair)
- %li(t1, %TAG.SYM)
- %beq(t0, t1, &::sym)
- %li(t1, %TAG.HEAP)
- %beq(t0, t1, &::heap)
- %li(t1, %TAG.IMM)
- %beq(t0, t1, &::imm)
+ %bieq(t0, %TAG.PAIR, &::pair, t1)
+ %bieq(t0, %TAG.SYM, &::sym, t1)
+ %bieq(t0, %TAG.HEAP, &::heap, t1)
+ %bieq(t0, %TAG.IMM, &::imm, t1)
# Fall-through: FIXNUM (the only remaining tag).
%ldl(a0, bv)
@@ -5207,16 +5037,11 @@
::heap
%hdr_type(t0, a0)
- %li(t1, %HDR.BV)
- %beq(t0, t1, &::heap_bv)
- %li(t1, %HDR.CLOSURE)
- %beq(t0, t1, &::heap_closure)
- %li(t1, %HDR.PRIM)
- %beq(t0, t1, &::heap_prim)
- %li(t1, %HDR.TD)
- %beq(t0, t1, &::heap_td)
- %li(t1, %HDR.REC)
- %beq(t0, t1, &::heap_rec)
+ %bieq(t0, %HDR.BV, &::heap_bv, t1)
+ %bieq(t0, %HDR.CLOSURE, &::heap_closure, t1)
+ %bieq(t0, %HDR.PRIM, &::heap_prim, t1)
+ %bieq(t0, %HDR.TD, &::heap_td, t1)
+ %bieq(t0, %HDR.REC, &::heap_rec, t1)
%b(&::heap_unknown)
::heap_bv
@@ -5668,7 +5493,7 @@
%fn2(wrap_syscall_result, {raw pad}, {
%stl(a0, raw)
%bltz(a0, &::err)
- %shli(a1, a0, 3)
+ %mkfix(a1, a0)
%li(a0, %imm_val(%IMM.TRUE))
%tail(&cons)
@@ -5676,7 +5501,7 @@
%ldl(t0, raw)
%li(t1, 0)
%sub(t0, t1, t0)
- %shli(a1, t0, 3)
+ %mkfix(a1, t0)
%li(a0, %imm_val(%IMM.FALSE))
%tail(&cons)
})
@@ -6262,6 +6087,44 @@
%tail(&apply)
})
+# =========================================================================
+# Startup -- heap_init
+# =========================================================================
+
+# heap_init() -> none. Initializes the main heap (heap_next /
+# heap_end), the scratch heap (scratch_next / scratch_end), and points
+# current_heap_*_ptr at the main slots so cons / alloc_hdr /
+# alloc_bytes default to allocating in main. Both _next slots are
+# rounded up to 8-byte alignment so every PAIR/HEAP tag bit is exact;
+# &ELF_end's alignment depends on the data section above it. cons /
+# alloc_hdr / alloc_bytes test (*current_next + bytes <= *current_end)
+# on every allocation and abort via runtime_error on overflow. Leaf.
+:heap_init
+ %ld_global(t0, &heap_buf_ptr)
+ %alignup(t0, t0, 8, t1)
+ %st_global(t0, &heap_next, t1)
+
+ %ld_global(t0, &heap_buf_ptr)
+ %li(t1, %HEAP_CAP_BYTES)
+ %add(t0, t0, t1)
+ %st_global(t0, &heap_end, t1)
+
+ %ld_global(t0, &scratch_buf_ptr)
+ %alignup(t0, t0, 8, t1)
+ %st_global(t0, &scratch_next, t1)
+
+ %ld_global(t0, &scratch_buf_ptr)
+ %li(t1, %SCRATCH_CAP_BYTES)
+ %add(t0, t0, t1)
+ %st_global(t0, &scratch_end, t1)
+
+ %la(t0, &heap_next)
+ %st_global(t0, ¤t_heap_next_ptr, t1)
+ %la(t0, &heap_end)
+ %st_global(t0, ¤t_heap_end_ptr, t1)
+
+ %ret
+
# Sentinel: marks the boundary between executable text and rodata.
# Read by scripts/disasm-elf.sh (via scripts/m1-symbols.py) to bound
# disassembly so trailing strings don't decode as bogus instructions.
@@ -6517,44 +6380,6 @@
:name_ch_newline "newline" ;; 7+1+0=8
# =========================================================================
-# Startup -- heap_init
-# =========================================================================
-
-# heap_init() -> none. Initializes the main heap (heap_next /
-# heap_end), the scratch heap (scratch_next / scratch_end), and points
-# current_heap_*_ptr at the main slots so cons / alloc_hdr /
-# alloc_bytes default to allocating in main. Both _next slots are
-# rounded up to 8-byte alignment so every PAIR/HEAP tag bit is exact;
-# &ELF_end's alignment depends on the data section above it. cons /
-# alloc_hdr / alloc_bytes test (*current_next + bytes <= *current_end)
-# on every allocation and abort via runtime_error on overflow. Leaf.
-:heap_init
- %ld_global(t0, &heap_buf_ptr)
- %alignup(t0, t0, 8, t1)
- %st_global(t0, &heap_next, t1)
-
- %ld_global(t0, &heap_buf_ptr)
- %li(t1, %HEAP_CAP_BYTES)
- %add(t0, t0, t1)
- %st_global(t0, &heap_end, t1)
-
- %ld_global(t0, &scratch_buf_ptr)
- %alignup(t0, t0, 8, t1)
- %st_global(t0, &scratch_next, t1)
-
- %ld_global(t0, &scratch_buf_ptr)
- %li(t1, %SCRATCH_CAP_BYTES)
- %add(t0, t0, t1)
- %st_global(t0, &scratch_end, t1)
-
- %la(t0, &heap_next)
- %st_global(t0, ¤t_heap_next_ptr, t1)
- %la(t0, &heap_end)
- %st_global(t0, ¤t_heap_end_ptr, t1)
-
- %ret
-
-# =========================================================================
# BSS arena table
# =========================================================================
#
