commit 354384eae6863bd903d5ea4ed4511c54e11636b4
parent 925240dd23966009f0b742a6199d87f1661e79fa
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 03:03:52 -0700
Refactor scheme1.P1pp: use tag idioms, lexer helpers, %die, %alignup
The tag-idiom macros (%car, %cdr, %tagof, %hdr_type, %mkfix,
%untag_fix, %untag_sym) were defined but unused -- every call site
inlined the underlying instruction. Now the file routes every tag
operation through them so the layout is documented in one place.
Adds scheme1-local helpers and uses them at the obvious sites:
%readbuf_byte -- load one byte at readbuf_buf[off] (skip_ws,
parse_one, parse_list, parse_atom scan loop)
%is_ws_branch -- 4-way ASCII whitespace check (same callers)
%symtab_entry -- base + idx*SYMENT.SIZE (intern, sym_global,
sym_set_global)
%die(msg, code) -- print_cstr + sys_exit, replacing seven copies
of the same la/call/li/call/spin block
Adds a generic %alignup(rd, rs, align, scratch) to libp1pp; uses it
in p1_main's heap_next setup and alloc_hdr. Drops the dead ::spin
labels after %die-style sys_exit calls (sys_exit doesn't return).
parse_one's frame is 0 since the body never touches sp slots.
Bumps M1PP_MACRO_BODY_CAP from 0x18000 to 0x30000: the new helper
macros plus the larger amd64 backend pushed the body-token pool
past the old cap.
Notes:
- parse_atom's first-byte dispatch keeps the inline la/ld/add/lb
sequence; routing it through %readbuf_byte caused the apply
dispatch to read a non-PRIM value on aarch64 in a way I haven't
fully diagnosed.
- amd64 and riscv64 still fail tests/scheme1/00-exit with "not a
procedure" -- pre-existing on the baseline, unchanged here.
Diffstat:
3 files changed, 104 insertions(+), 119 deletions(-)
diff --git a/M1pp/M1pp.P1 b/M1pp/M1pp.P1
@@ -38,7 +38,7 @@ DEFINE M1PP_MACRO_RECORD_SIZE 2801000000000000
DEFINE M1PP_MACRO_BODY_START_OFF 1801000000000000
DEFINE M1PP_MACRO_BODY_END_OFF 2001000000000000
DEFINE M1PP_MACROS_CAP 0050020000000000
-DEFINE M1PP_MACRO_BODY_CAP 0080010000000000
+DEFINE M1PP_MACRO_BODY_CAP 0000030000000000
DEFINE O_WRONLY_CREAT_TRUNC 4102000000000000
DEFINE MODE_0644 A401000000000000
DEFINE AT_FDCWD 9CFFFFFFFFFFFFFF
diff --git a/P1/P1pp.P1pp b/P1/P1pp.P1pp
@@ -11,6 +11,23 @@
# See docs/LIBP1PP.md for the public contract.
# =========================================================================
+# Compile-time helpers
+# =========================================================================
+
+# %alignup -- Round `rs` up to a multiple of `align` (a power of two) and
+# place the result in `rd`. `scratch` is clobbered. `align` must be a
+# constant integer expression. Two instructions plus an %li for the mask:
+#
+# rd = rs + (align - 1)
+# scratch = -align (i.e. ~(align-1) for power-of-two align)
+# rd = rd & scratch
+%macro alignup(rd, rs, align, scratch)
+%addi(rd, rs, (- align 1))
+%li(scratch, (- 0 align))
+%and(rd, rd, scratch)
+%endm
+
+# =========================================================================
# Control-flow macros
# =========================================================================
#
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -44,25 +44,19 @@
%endm
# Layout helpers. %struct stride is 8 bytes per field.
-%struct PAIR { car cdr } # .SIZE = 16
+%struct PAIR { car cdr } # .SIZE = 16
%struct SYMENT { name_ptr name_len global_val pad } # .SIZE = 32
-%struct PRIM { hdr entry_w } # .SIZE = 16
-
-# BSS sizing. Offsets are bytes from :ELF_end.
-DEFINE OFF_readbuf 0000000000000000
-DEFINE OFF_heap 0000010000000000
-DEFINE OFF_symtab 0000020000000000
-DEFINE READBUF_CAP 0000010000000000
-DEFINE HEAP_CAP 0000010000000000
-DEFINE SYMTAB_CAP_BYTES 0000010000000000
-
-# Number of symtab slots. Used as a runtime guard in intern. Must match
-# SYMTAB_CAP_BYTES / SYMENT.SIZE.
+%struct PRIM { hdr entry_w } # .SIZE = 16
+
+# BSS arena offsets from :ELF_end. Each arena is 64 KiB; the three are
+# packed back-to-back below ELF_end + 192 KiB. p1_main's startup loop
+# materializes &ELF_end + OFF_X into the matching pointer slot. The
+# offsets are emitted directly in bss_init_tbl via $().
+
%macro SYMTAB_CAP_SLOTS()
1024
%endm
-# Same as M1PP_INPUT_CAP, exposed for %li in load_source.
%macro READBUF_CAP_BYTES()
65536
%endm
@@ -100,6 +94,50 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%endm
# =========================================================================
+# Scheme1-local helpers
+# =========================================================================
+
+# Load the byte at readbuf_buf[off_reg] into rd. Clobbers rd. `rd` must
+# be the destination register; the macro reuses it as a scratch pointer
+# during the la / ld / add chain before the final lb writes the byte.
+%macro readbuf_byte(rd, off_reg)
+%la(rd, &readbuf_buf_ptr)
+%ld(rd, rd, 0)
+%add(rd, rd, off_reg)
+%lb(rd, rd, 0)
+%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)
+%endm
+
+# Compute &symtab_buf + idx_reg * SYMENT.SIZE into rd. `scratch` is
+# clobbered.
+%macro symtab_entry(rd, idx_reg, scratch)
+%la(rd, &symtab_buf_ptr)
+%ld(rd, rd, 0)
+%shli(scratch, idx_reg, 5)
+%add(rd, rd, scratch)
+%endm
+
+# Print msg_label, exit with `code`. Never returns.
+%macro die(msg, code)
+%la(a0, & ## msg)
+%call(&print_cstr)
+%li(a0, code)
+%call(&sys_exit)
+%endm
+
+# =========================================================================
# p1_main -- runtime spine
# =========================================================================
#
@@ -133,9 +171,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
# every pair pointer's low 3 bits are exactly the PAIR tag.
%la(t0, &heap_buf_ptr)
%ld(t0, t0, 0)
- %addi(t0, t0, 7)
- %li(t1, -8)
- %and(t0, t0, t1)
+ %alignup(t0, t0, 8, t1)
%la(t1, &heap_next)
%st(t0, t1, 0)
@@ -168,9 +204,6 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
# =========================================================================
# Source loading -- argv[1] -> readbuf, length stored in readbuf_len
# =========================================================================
-#
-# Frame: 8 bytes
-# +0 no slots; libp1pp's read_file does open+read+close in one call.
%fn(load_source, 0, {
%la(t0, &readbuf_buf_ptr)
@@ -185,12 +218,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%eret
::fail
- %la(a0, &msg_load_fail)
- %call(&print_cstr)
- %li(a0, 3)
- %call(&sys_exit)
- ::spin
- %b(&::spin)
+ %die(msg_load_fail, 3)
})
# =========================================================================
@@ -216,9 +244,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
# alloc_hdr(bytes=a0, hdr_word=a1) -> tagged heap obj (a0)
# Rounds bytes up to a multiple of 8 and writes hdr_word at offset 0.
:alloc_hdr
- %addi(a0, a0, 7)
- %li(t0, -8)
- %and(a0, a0, t0)
+ %alignup(a0, a0, 8, t0)
%la(t2, &heap_next)
%ld(t0, t2, 0)
%add(t1, t0, a0)
@@ -253,11 +279,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%b(&::append)
::probe
- # entry_ptr = symtab_buf + idx * SYMENT.SIZE
- %la(t1, &symtab_buf_ptr)
- %ld(t1, t1, 0)
- %shli(t2, t0, 5)
- %add(t1, t1, t2)
+ %symtab_entry(t1, t0, t2)
%st(t1, sp, 24)
# entry.name_len == name_len ?
@@ -283,16 +305,10 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%ld(t0, sp, 16)
%li(t1, %SYMTAB_CAP_SLOTS)
%bltu(t0, t1, &::append_ok)
- %la(a0, &msg_symtab_full)
- %call(&print_cstr)
- %li(a0, 5)
- %call(&sys_exit)
+ %die(msg_symtab_full, 5)
::append_ok
- %la(t1, &symtab_buf_ptr)
- %ld(t1, t1, 0)
- %shli(t2, t0, 5)
- %add(t1, t1, t2)
+ %symtab_entry(t1, t0, t2)
%ld(a0, sp, 0)
%st(a0, t1, 0)
%ld(a0, sp, 8)
@@ -351,18 +367,8 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%ld(t1, t1, 0)
::loop
%beq(t0, t1, &::done)
- %la(a0, &readbuf_buf_ptr)
- %ld(a0, a0, 0)
- %add(a0, a0, t0)
- %lb(a0, a0, 0)
- %addi(a1, a0, -32)
- %beqz(a1, &::step)
- %addi(a1, a0, -9)
- %beqz(a1, &::step)
- %addi(a1, a0, -10)
- %beqz(a1, &::step)
- %addi(a1, a0, -13)
- %beqz(a1, &::step)
+ %readbuf_byte(a0, t0)
+ %is_ws_branch(a1, a0, &::step)
%b(&::done)
::step
%addi(t0, t0, 1)
@@ -373,7 +379,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%endscope
# parse_one() -> tagged value in a0
-%fn(parse_one, 16, {
+%fn(parse_one, 0, {
%call(&skip_ws)
%la(t0, &readbuf_pos)
@@ -382,10 +388,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%ld(t1, t1, 0)
%beq(t0, t1, &::eof)
- %la(a0, &readbuf_buf_ptr)
- %ld(a0, a0, 0)
- %add(a0, a0, t0)
- %lb(a0, a0, 0)
+ %readbuf_byte(a0, t0)
%addi(a1, a0, -40)
%beqz(a1, &::lparen)
@@ -405,18 +408,10 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%eret
::rparen
- %la(a0, &msg_unexp_rparen)
- %call(&print_cstr)
- %li(a0, 6)
- %call(&sys_exit)
+ %die(msg_unexp_rparen, 6)
::eof
- %la(a0, &msg_unexp_eof)
- %call(&print_cstr)
- %li(a0, 6)
- %call(&sys_exit)
- ::spin
- %b(&::spin)
+ %die(msg_unexp_eof, 6)
})
# parse_list() -> tagged list value in a0. Cursor sits past '(' on entry;
@@ -438,10 +433,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%ld(t1, t1, 0)
%beq(t0, t1, &::eof)
- %la(a0, &readbuf_buf_ptr)
- %ld(a0, a0, 0)
- %add(a0, a0, t0)
- %lb(a0, a0, 0)
+ %readbuf_byte(a0, t0)
%addi(a1, a0, -41)
%beqz(a1, &::close)
@@ -475,12 +467,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%eret
::eof
- %la(a0, &msg_unterm_list)
- %call(&print_cstr)
- %li(a0, 6)
- %call(&sys_exit)
- ::spin
- %b(&::spin)
+ %die(msg_unterm_list, 6)
})
# parse_atom() -> tagged value (fixnum or symbol) in a0.
@@ -499,20 +486,9 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
::scan
%beq(t1, t2, &::end)
- %la(a0, &readbuf_buf_ptr)
- %ld(a0, a0, 0)
- %add(a0, a0, t1)
- %lb(a0, a0, 0)
+ %readbuf_byte(a0, t1)
- # whitespace?
- %addi(a1, a0, -32)
- %beqz(a1, &::end)
- %addi(a1, a0, -9)
- %beqz(a1, &::end)
- %addi(a1, a0, -10)
- %beqz(a1, &::end)
- %addi(a1, a0, -13)
- %beqz(a1, &::end)
+ %is_ws_branch(a1, a0, &::end)
# paren?
%addi(a1, a0, -40)
%beqz(a1, &::end)
@@ -545,8 +521,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%ld(t2, sp, 8)
%addi(t0, t0, 1)
%beq(t0, t2, &::is_sym)
- %addi(a0, a0, 1)
- %lb(a0, a0, 0)
+ %readbuf_byte(a0, t0)
%addi(a1, a0, -48)
%bltu(a1, a2, &::is_int)
# fall through to is_sym
@@ -600,7 +575,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%li(t2, 0)
%sub(a0, t2, a0)
::tag
- %shli(a0, a0, 3)
+ %mkfix(a0, a0)
%ret
%endscope
@@ -623,7 +598,7 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%st(a0, sp, 0)
%st(a1, sp, 8)
- %andi(t0, a0, 7)
+ %tagof(t0, a0)
%li(t1, %TAG.PAIR)
%beq(t0, t1, &::pair)
%li(t1, %TAG.SYM)
@@ -632,29 +607,26 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%eret
::sym
- %sari(a0, a0, 3)
+ %untag_sym(a0, a0)
%call(&sym_global)
%li(t0, %imm_val(%IMM.UNBOUND))
%beq(a0, t0, &::unbound)
%eret
::unbound
- %la(a0, &msg_unbound)
- %call(&print_cstr)
- %li(a0, 7)
- %call(&sys_exit)
+ %die(msg_unbound, 7)
::pair
# head = eval(car(expr), env)
%ld(a0, sp, 0)
- %ld(a0, a0, -1)
+ %car(a0, a0)
%ld(a1, sp, 8)
%call(&eval)
%st(a0, sp, 16)
# args = eval_args(cdr(expr), env)
%ld(a0, sp, 0)
- %ld(a0, a0, 7)
+ %cdr(a0, a0)
%ld(a1, sp, 8)
%call(&eval_args)
@@ -675,13 +647,13 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%st(a1, sp, 8)
# val = eval(car(args), env)
- %ld(a0, a0, -1)
+ %car(a0, a0)
%call(&eval)
%st(a0, sp, 16)
# rest = eval_args(cdr(args), env)
%ld(a0, sp, 0)
- %ld(a0, a0, 7)
+ %cdr(a0, a0)
%ld(a1, sp, 8)
%call(&eval_args)
@@ -704,19 +676,16 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
# Only HEAP-tagged values can be applicable. PRIM is the only header
# type wired up here.
- %andi(t0, a0, 7)
+ %tagof(t0, a0)
%li(t1, %TAG.HEAP)
%bne(t0, t1, &::not_proc)
- %lb(t0, a0, -3)
+ %hdr_type(t0, a0)
%li(t1, %HDR.PRIM)
%beq(t0, t1, &::prim)
::not_proc
- %la(a0, &msg_not_proc)
- %call(&print_cstr)
- %li(a0, 8)
- %call(&sys_exit)
+ %die(msg_not_proc, 8)
::prim
%ld(t0, a0, 5) ; t0 = entry word (offset = -3 + 8)
@@ -737,11 +706,10 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
%la(a0, &name_sys_exit)
%li(a1, 8)
%call(&intern)
- %sari(a0, a0, 3) ; idx
+ %untag_sym(a0, a0) ; idx
%la(a1, &prim_sys_exit)
%addi(a1, a1, 3) ; tag HEAP
%call(&sym_set_global)
- # No stack frame needed -- pure register code with one nested call.
})
# prim_sys_exit_entry(args=a0). Args is a one-element list whose car is
@@ -749,8 +717,8 @@ DEFINE SYMTAB_CAP_BYTES 0000010000000000
# sys_exit (a %b, not a %call -- this is a leaf with no frame, and
# sys_exit doesn't return anyway).
:prim_sys_exit_entry
- %ld(a0, a0, -1) ; car = fixnum
- %sari(a0, a0, 3)
+ %car(a0, a0) ; car = fixnum
+ %untag_fix(a0, a0)
%b(&sys_exit)
# =========================================================================
@@ -782,9 +750,9 @@ $(%HDR.PRIM) &prim_sys_exit_entry %(0)
# Each entry: 8-byte slot pointer (4-byte label ref + 4 bytes pad) +
# 8-byte offset constant. p1_main walks this once at startup.
:bss_init_tbl
-&readbuf_buf_ptr %(0) OFF_readbuf
-&heap_buf_ptr %(0) OFF_heap
-&symtab_buf_ptr %(0) OFF_symtab
+&readbuf_buf_ptr %(0) $(0)
+&heap_buf_ptr %(0) $(0x10000)
+&symtab_buf_ptr %(0) $(0x20000)
:bss_init_tbl_end
# =========================================================================
