commit 8411ede10e4eafe904ea36d7aac44be7b927a325
parent f60a666570b19da819acf341d4a6c70ebd094df1
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 13:38:29 -0700
scheme1: display, write, format, error primitives
Diffstat:
11 files changed, 699 insertions(+), 21 deletions(-)
diff --git a/docs/scheme-shell-todo.md b/docs/scheme-shell-todo.md
@@ -51,10 +51,6 @@ gap that must be addressed before calling scheme1 shippable.
Per LISP.md and LISP-C.md, but not implemented:
-- [ ] **Reader gaps**:
- - `"…"` string / bytevector literals with `\n \t \r \\ \"` escapes
- - `#\char` literals (printable ASCII, named forms, `#\xNN`)
- - Source-location side table (line:col → pair) used by `error`
- [ ] **Special forms missing**: `set!`, `pmatch`, `cond`'s
`=>` arrow form. `pmatch` is called out by LISP-C.md as a built-in
special form needed by the self-hosted compiler.
@@ -69,7 +65,6 @@ Per LISP.md and LISP-C.md, but not implemented:
`for-each` as primitives (we provide them via the prelude only)
- Bytevector: `bytevector-append`, `bytevector=?`, `string->symbol`,
`symbol->string`
- - I/O / control: `error`, `display`, `write`, `format`
- [ ] **`+ - * = <` are 2-arg only.** R7RS allows any arity.
- [ ] **`apply` is variadic on the trailing list** but otherwise
unverified for arity edge cases.
@@ -91,8 +86,6 @@ Per LISP.md and LISP-C.md, but not implemented:
`vector-ref` / `vector-set!` / `vector-length`), and `equal?` (needs
`string?` / `vector?` plus their ref/length) wait on the
corresponding primitives.
-- [ ] **`error` primitive** — exits with no formatted message; no
- "at file:line:col:" prefix.
## Hacks and fragile invariants
@@ -223,16 +216,6 @@ before the suite can be considered authoritative.
- [ ] **No quoted-pair test (`'(1 . 2)`)** — only quoted lists are
tested. The reader handles dotted pairs but no test pins this.
-- [ ] **No `#xHEX` with negative literal `#x-1a` test** — though
- `parse_one`'s hex branch supports leading `-`, it's untested.
-
-- [ ] **No `#X` (uppercase) test.** The reader accepts both `#x` and
- `#X`; only the lowercase form is tested.
-
-- [ ] **`tests/scheme1/06-comment.scm`** — verifies `;` comments inside
- a single form. Doesn't verify a full-line comment between top-level
- forms.
-
- [ ] **`tests/scheme1/16-cond.scm`** — verifies short-circuit in the
positive direction (later truthy clauses don't fire). Doesn't
verify that a `(cond)` with no matching clause and no `else` returns
@@ -245,14 +228,10 @@ In rough priority order:
1. Track down and fix the prelude `spawn`-via-`run` bug; remove the
workaround in test 45.
-3. Implement `error`, `display`, `write`, `format` so the abort paths
- produce something readable. Plumb them through `runtime_error` so
- the prefix stays consistent with the existing error messages.
4. Fill in the spec-required primitives (`equal?`, `eqv?`, `set-car!`,
`set-cdr!`, the comparison family, the bytevector family, the
number/string converters).
5. `set!`, `pmatch`.
-6. Reader: `"…"` strings, `#\char`, source locations.
7. Port shell.scm's port record + I/O wrappers.
8. Replace the 1024-slot linear-scan symtab with an open-addressing
hash per LISP-C.md.
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -2800,6 +2800,586 @@
})
# =========================================================================
+# Writer -- display, write, format, error
+# =========================================================================
+#
+# All four entry points walk values through a single recursive writer
+# that appends bytes into an output bytevector. display / write call the
+# writer once, then sys_write the resulting bytes to stdout. error
+# prepends `scheme1: error: `, joins irritants with spaces, and tails
+# into runtime_error so the prefix stays consistent with every other
+# abort path. format walks a template bv, emitting raw bytes verbatim
+# and dispatching ~a (display), ~s (write), ~d (decimal), ~% (newline),
+# and ~~ (literal '~') against successive args.
+#
+# Mode flag for write_to_bv: 0 = display (bytevectors emit raw), 1 =
+# write (bytevectors emit "..." with a leading and trailing double quote;
+# escapes are not handled because string literals are not yet supported).
+#
+# bv_putn / bv_putc / bv_putint append to the output bv and return the
+# (same wrapper, possibly-grown) bv. bv_grow patches data_ptr/capacity
+# in place, so the wrapper pointer never changes -- callers can keep a
+# stable handle in a single frame slot.
+
+# bv_putn(bv=a0, src=a1, n=a2) -> bv (a0). Append n bytes from src to bv,
+# growing the data buffer when capacity falls short. The byte at index
+# `length` after append is left zero (preserved by the cap > length
+# invariant from bv_capacity_for + the BSS-zero heap), so syscalls that
+# read the data_ptr as a C string still see a NUL terminator.
+%fn(bv_putn, 32, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+ %st(a2, sp, 16)
+
+ %ld(t0, a0, -3)
+ %shri(t0, t0, 8) ; old_len
+ %st(t0, sp, 24)
+
+ # bv_grow ensures cap >= old_len + n + 1, so cap > new_len.
+ %add(a1, t0, a2)
+ %addi(a1, a1, 1)
+ %call(&bv_grow)
+
+ %ld(t0, sp, 0)
+ %ld(a0, t0, 5)
+ %ld(t1, sp, 24)
+ %add(a0, a0, t1) ; dst = data + old_len
+ %ld(a1, sp, 8)
+ %ld(a2, sp, 16)
+ %call(&memcpy)
+
+ # hdr = (old_len + n) << 8 | HDR.BV. HDR.BV is 0.
+ %ld(t0, sp, 24)
+ %ld(t1, sp, 16)
+ %add(t0, t0, t1)
+ %shli(t0, t0, 8)
+ %ld(t1, sp, 0)
+ %st(t0, t1, -3)
+
+ %ld(a0, sp, 0)
+})
+
+# bv_putc(bv=a0, byte=a1) -> bv (a0). Append a single byte (low 8 bits
+# of a1). Same growth + length-update protocol as bv_putn.
+%fn(bv_putc, 16, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+
+ %ld(t0, a0, -3)
+ %shri(t0, t0, 8) ; old_len
+ %addi(a1, t0, 2) ; min_cap = old_len + 2
+ %call(&bv_grow)
+
+ %ld(t0, sp, 0)
+ %ld(t1, t0, -3)
+ %shri(t1, t1, 8) ; old_len (re-read after grow)
+ %ld(t2, t0, 5)
+ %add(t2, t2, t1)
+ %ld(a0, sp, 8)
+ %sb(a0, t2, 0)
+
+ %addi(t1, t1, 1)
+ %shli(t1, t1, 8)
+ %st(t1, t0, -3)
+
+ %ld(a0, sp, 0)
+})
+
+# bv_putint(bv=a0, value=a1) -> bv (a0). Append decimal repr of (raw,
+# untagged) value. Uses :writer_num_buf as a 24-byte scratch buffer
+# (fmt_dec writes at most 20 bytes for a 64-bit signed integer).
+%fn(bv_putint, 16, {
+ %st(a0, sp, 0)
+
+ %la(a0, &writer_num_buf)
+ %call(&fmt_dec) ; n_bytes (a0)
+
+ %mov(a2, a0)
+ %la(a1, &writer_num_buf)
+ %ld(a0, sp, 0)
+ %tail(&bv_putn)
+})
+
+# sym_name(idx=a0) -> (ptr=a0, len=a1). Leaf. idx is the untagged sym
+# slot index; both fields come straight out of the symtab entry.
+:sym_name
+ %la(t0, &symtab_buf_ptr)
+ %ld(t0, t0, 0)
+ %shli(t1, a0, 5)
+ %add(t0, t0, t1)
+ %ld(a1, t0, 8)
+ %ld(a0, t0, 0)
+ %ret
+
+# write_to_bv(val=a0, bv=a1, mode=a2) -> bv (a0). Recursively appends
+# val's printed representation to bv. mode = 0 emits bytevectors as raw
+# bytes (display); mode = 1 emits them as `"..."` (write). Pairs are
+# delegated to write_pair_to_bv so the recursion through PAIR has its
+# own frame.
+%fn(write_to_bv, 32, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+ %st(a2, sp, 16)
+
+ %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)
+
+ # Fall-through: FIXNUM (the only remaining tag).
+ %ld(a0, sp, 8)
+ %ld(a1, sp, 0)
+ %sari(a1, a1, 3)
+ %tail(&bv_putint)
+
+ ::sym
+ %ld(a0, sp, 0)
+ %sari(a0, a0, 3)
+ %call(&sym_name)
+ %mov(a2, a1)
+ %mov(a1, a0)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::pair
+ %ld(a0, sp, 0)
+ %ld(a1, sp, 8)
+ %ld(a2, sp, 16)
+ %tail(&write_pair_to_bv)
+
+ ::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)
+ %b(&::heap_unknown)
+
+ ::heap_bv
+ %ld(t0, sp, 16)
+ %beqz(t0, &::heap_bv_raw)
+ # write mode: emit `"`, then the raw bytes, then `"`.
+ %ld(a0, sp, 8)
+ %li(a1, 34)
+ %call(&bv_putc)
+ %ld(t0, sp, 0)
+ %ld(a1, t0, 5)
+ %ld(a2, t0, -3)
+ %shri(a2, a2, 8)
+ %call(&bv_putn)
+ %li(a1, 34)
+ %tail(&bv_putc)
+
+ ::heap_bv_raw
+ %ld(t0, sp, 0)
+ %ld(a1, t0, 5)
+ %ld(a2, t0, -3)
+ %shri(a2, a2, 8)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::heap_closure
+ %la(a1, &str_closure)
+ %li(a2, 10)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::heap_prim
+ %la(a1, &str_prim)
+ %li(a2, 7)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::heap_td
+ %la(a1, &str_td)
+ %li(a2, 11)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::heap_rec
+ %la(a1, &str_rec)
+ %li(a2, 9)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::heap_unknown
+ %la(a1, &str_unknown)
+ %li(a2, 10)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::imm
+ %ld(a0, sp, 0)
+ %sari(a0, a0, 3)
+ %beqz(a0, &::imm_false)
+ %addi(t0, a0, -1)
+ %beqz(t0, &::imm_true)
+ %addi(t0, a0, -2)
+ %beqz(t0, &::imm_nil)
+ %addi(t0, a0, -3)
+ %beqz(t0, &::imm_unspec)
+ %addi(t0, a0, -4)
+ %beqz(t0, &::imm_unbound)
+ # EOF (idx == 5) is the only remaining IMM.
+ %la(a1, &str_eof)
+ %li(a2, 5)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::imm_false
+ %la(a1, &str_false)
+ %li(a2, 2)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::imm_true
+ %la(a1, &str_true)
+ %li(a2, 2)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::imm_nil
+ %la(a1, &str_nil)
+ %li(a2, 2)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::imm_unspec
+ %la(a1, &str_unspec)
+ %li(a2, 8)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+
+ ::imm_unbound
+ %la(a1, &str_unbound)
+ %li(a2, 9)
+ %ld(a0, sp, 8)
+ %tail(&bv_putn)
+})
+
+# write_pair_to_bv(pair=a0, bv=a1, mode=a2) -> bv (a0). Emits `(elt elt
+# ...)` form, with `( . )` for non-list cdrs (dotted pair). The walker
+# advances `pair` along the spine; cdr's tag determines whether we emit
+# a separator and continue, emit ` . val)` for a dotted tail, or just
+# emit `)` for a proper-list NIL.
+#
+# Frame: 32 bytes
+# +0 pair walk
+# +8 bv (stable wrapper; reused across recursive calls)
+# +16 mode
+%fn(write_pair_to_bv, 32, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+ %st(a2, sp, 16)
+
+ %ld(a0, sp, 8)
+ %li(a1, 40)
+ %call(&bv_putc)
+
+ ::loop
+ %ld(t0, sp, 0)
+ %car(a0, t0)
+ %ld(a1, sp, 8)
+ %ld(a2, sp, 16)
+ %call(&write_to_bv)
+
+ %ld(t0, sp, 0)
+ %cdr(t0, t0)
+ %st(t0, sp, 0)
+
+ %if_nil(t1, t0, &::done)
+ %tagof(t1, t0)
+ %li(t2, %TAG.PAIR)
+ %beq(t1, t2, &::cont)
+
+ # Dotted tail: emit ` . ` then write_to_bv(cdr).
+ %ld(a0, sp, 8)
+ %li(a1, 32)
+ %call(&bv_putc)
+ %ld(a0, sp, 8)
+ %li(a1, 46)
+ %call(&bv_putc)
+ %ld(a0, sp, 8)
+ %li(a1, 32)
+ %call(&bv_putc)
+ %ld(a0, sp, 0)
+ %ld(a1, sp, 8)
+ %ld(a2, sp, 16)
+ %call(&write_to_bv)
+ %b(&::done)
+
+ ::cont
+ %ld(a0, sp, 8)
+ %li(a1, 32)
+ %call(&bv_putc)
+ %b(&::loop)
+
+ ::done
+ %ld(a0, sp, 8)
+ %li(a1, 41)
+ %tail(&bv_putc)
+})
+
+# value_to_bv(val=a0, mode=a1) -> bv (a0). Allocate an empty bv and
+# delegate to write_to_bv; helper for display / write. The 16-byte
+# starting capacity is the floor from bv_capacity_for; bv_putn /
+# bv_putc grow as needed.
+%fn(value_to_bv, 16, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+ %li(a0, 0)
+ %call(&bv_alloc)
+ %mov(a1, a0)
+ %ld(a0, sp, 0)
+ %ld(a2, sp, 8)
+ %tail(&write_to_bv)
+})
+
+# (display val) and (write val): build the printed representation in a
+# fresh bv, sys_write the raw bytes to fd 1, return UNSPEC. Partial
+# writes are not retried -- libp1pp's wrapper streams its own buffer
+# but the kernel may chunk a giant single write; in practice
+# scheme1 outputs are short and we accept the simple path.
+%fn(prim_display_entry, 0, {
+ %car(a0, a0)
+ %li(a1, 0)
+ %call(&value_to_bv)
+ %ld(a1, a0, 5)
+ %ld(a2, a0, -3)
+ %shri(a2, a2, 8)
+ %li(a0, 1)
+ %call(&sys_write)
+ %li(a0, %imm_val(%IMM.UNSPEC))
+})
+
+%fn(prim_write_entry, 0, {
+ %car(a0, a0)
+ %li(a1, 1)
+ %call(&value_to_bv)
+ %ld(a1, a0, 5)
+ %ld(a2, a0, -3)
+ %shri(a2, a2, 8)
+ %li(a0, 1)
+ %call(&sys_write)
+ %li(a0, %imm_val(%IMM.UNSPEC))
+})
+
+# (error msg-bv irritant ...). Builds `scheme1: error: <msg> <irr> ...`
+# in a bv (irritants joined by single spaces, all rendered with display
+# semantics) and tails into runtime_error. The bv has cap > length so
+# the byte at `length` is the BSS-zero NUL terminator, making the bv's
+# data_ptr a valid C string for panic's eprint_cstr.
+#
+# Frame: 16 bytes
+# +0 walk (initially args; advances over irritants)
+# +8 bv
+%fn(prim_error_entry, 16, {
+ %st(a0, sp, 0)
+
+ %li(a0, 0)
+ %call(&bv_alloc)
+ %st(a0, sp, 8)
+
+ %la(a1, &str_error_prefix)
+ %li(a2, 16)
+ %ld(a0, sp, 8)
+ %call(&bv_putn)
+
+ # First arg (the message) goes through write_to_bv with display mode.
+ %ld(t0, sp, 0)
+ %car(a0, t0)
+ %ld(a1, sp, 8)
+ %li(a2, 0)
+ %call(&write_to_bv)
+
+ %ld(t0, sp, 0)
+ %cdr(t0, t0)
+ %st(t0, sp, 0)
+
+ ::loop
+ %ld(t0, sp, 0)
+ %if_nil(t1, t0, &::done)
+
+ %ld(a0, sp, 8)
+ %li(a1, 32)
+ %call(&bv_putc)
+
+ %ld(t0, sp, 0)
+ %car(a0, t0)
+ %ld(a1, sp, 8)
+ %li(a2, 0)
+ %call(&write_to_bv)
+
+ %ld(t0, sp, 0)
+ %cdr(t0, t0)
+ %st(t0, sp, 0)
+ %b(&::loop)
+
+ ::done
+ %ld(t0, sp, 8)
+ %ld(a0, t0, 5)
+ %tail(&runtime_error)
+})
+
+# (format template-bv arg ...). Walks the template bv byte by byte;
+# `~X` consumes the next byte as a directive: a (display), s (write),
+# d (decimal fixnum), % (newline), ~ (literal tilde). Unknown specs
+# pass through verbatim. Returns the assembled bv; the caller decides
+# how to consume it (e.g. (display (format ...))).
+#
+# Frame: 32 bytes
+# +0 out bv
+# +8 template bv
+# +16 args walk
+# +24 idx (current byte offset into template)
+%fn(prim_format_entry, 32, {
+ %st(a0, sp, 16) ; spill incoming args while we set up
+
+ %li(a0, 0)
+ %call(&bv_alloc)
+ %st(a0, sp, 0)
+
+ %ld(t0, sp, 16)
+ %car(t1, t0)
+ %st(t1, sp, 8)
+ %cdr(t0, t0)
+ %st(t0, sp, 16)
+
+ %li(t0, 0)
+ %st(t0, sp, 24)
+
+ ::loop
+ %ld(t1, sp, 8)
+ %ld(t2, t1, -3)
+ %shri(t2, t2, 8) ; template length
+ %ld(t0, sp, 24)
+ %beq(t0, t2, &::done)
+
+ %ld(a3, t1, 5)
+ %add(a3, a3, t0)
+ %lb(a3, a3, 0) ; byte = template.data[idx]
+
+ %addi(t1, a3, -126) ; '~'
+ %beqz(t1, &::tilde)
+
+ # Plain byte: emit and advance.
+ %ld(a0, sp, 0)
+ %mov(a1, a3)
+ %call(&bv_putc)
+ %ld(t0, sp, 24)
+ %addi(t0, t0, 1)
+ %st(t0, sp, 24)
+ %b(&::loop)
+
+ ::tilde
+ %ld(t0, sp, 24)
+ %addi(t0, t0, 1)
+ %ld(t1, sp, 8)
+ %ld(t2, t1, -3)
+ %shri(t2, t2, 8)
+ %beq(t0, t2, &::tilde_lit)
+
+ %ld(t1, t1, 5)
+ %add(t1, t1, t0)
+ %lb(a3, t1, 0) ; spec
+
+ %addi(t0, t0, 1) ; advance past spec
+ %st(t0, sp, 24)
+
+ %addi(t1, a3, -97) ; 'a'
+ %beqz(t1, &::spec_a)
+ %addi(t1, a3, -115) ; 's'
+ %beqz(t1, &::spec_s)
+ %addi(t1, a3, -100) ; 'd'
+ %beqz(t1, &::spec_d)
+ %addi(t1, a3, -37) ; '%'
+ %beqz(t1, &::spec_pct)
+ %addi(t1, a3, -126) ; '~'
+ %beqz(t1, &::spec_tilde)
+
+ # Unknown directive: emit `~` then the spec byte verbatim. Re-read
+ # the spec byte from the template since bv_putc may clobber a3.
+ %ld(a0, sp, 0)
+ %li(a1, 126)
+ %call(&bv_putc)
+ %ld(t0, sp, 8)
+ %ld(t1, t0, 5)
+ %ld(t0, sp, 24)
+ %addi(t0, t0, -1)
+ %add(t1, t1, t0)
+ %lb(a1, t1, 0)
+ %ld(a0, sp, 0)
+ %call(&bv_putc)
+ %b(&::loop)
+
+ ::tilde_lit
+ # `~` at end of template: emit literal `~` and finish next iter.
+ %ld(a0, sp, 0)
+ %li(a1, 126)
+ %call(&bv_putc)
+ %ld(t0, sp, 24)
+ %addi(t0, t0, 1)
+ %st(t0, sp, 24)
+ %b(&::loop)
+
+ ::spec_a
+ %ld(t0, sp, 16)
+ %car(a0, t0)
+ %cdr(t0, t0)
+ %st(t0, sp, 16)
+ %ld(a1, sp, 0)
+ %li(a2, 0)
+ %call(&write_to_bv)
+ %b(&::loop)
+
+ ::spec_s
+ %ld(t0, sp, 16)
+ %car(a0, t0)
+ %cdr(t0, t0)
+ %st(t0, sp, 16)
+ %ld(a1, sp, 0)
+ %li(a2, 1)
+ %call(&write_to_bv)
+ %b(&::loop)
+
+ ::spec_d
+ %ld(t0, sp, 16)
+ %car(t1, t0)
+ %cdr(t0, t0)
+ %st(t0, sp, 16)
+ %sari(a1, t1, 3)
+ %ld(a0, sp, 0)
+ %call(&bv_putint)
+ %b(&::loop)
+
+ ::spec_pct
+ %ld(a0, sp, 0)
+ %li(a1, 10)
+ %call(&bv_putc)
+ %b(&::loop)
+
+ ::spec_tilde
+ %ld(a0, sp, 0)
+ %li(a1, 126)
+ %call(&bv_putc)
+ %b(&::loop)
+
+ ::done
+ %ld(a0, sp, 0)
+})
+
+# =========================================================================
# Syscall primitives
# =========================================================================
#
@@ -3142,6 +3722,26 @@
:name_eof_object "eof-object"
:name_eof_objectq "eof-object?"
+:name_display "display"
+:name_write "write"
+:name_error "error"
+:name_format "format"
+
+# Writer string constants. Lengths are hard-coded at the bv_putn call
+# sites (write_to_bv branches). No NUL needed -- bv_putn takes (ptr, n).
+:str_false "#f"
+:str_true "#t"
+:str_nil "()"
+:str_unspec "#!unspec"
+:str_unbound "#!unbound"
+:str_eof "#!eof"
+:str_closure "#<closure>"
+:str_prim "#<prim>"
+:str_td "#<rec-type>"
+:str_rec "#<record>"
+:str_unknown "#<unknown>"
+:str_error_prefix "scheme1: error: "
+
# Primitive registration table. Each entry: 8-byte name_ptr (4-byte label
# ref + 4 pad), 8-byte name_len, 8-byte entry_label (4 ref + 4 pad).
:prim_table
@@ -3186,6 +3786,10 @@
&name_sys_argv %(0) $(8) &prim_sys_argv_entry %(0)
&name_eof_object %(0) $(10) &prim_eof_object_entry %(0)
&name_eof_objectq %(0) $(11) &prim_eof_objectq_entry %(0)
+&name_display %(0) $(7) &prim_display_entry %(0)
+&name_write %(0) $(5) &prim_write_entry %(0)
+&name_error %(0) $(5) &prim_error_entry %(0)
+&name_format %(0) $(6) &prim_format_entry %(0)
:prim_table_end
:msg_usage "scheme1: usage: scheme1 SOURCE.scm" '0a' '00'
@@ -3251,6 +3855,11 @@
:saved_argc $(0)
:saved_argv $(0)
+# Scratch buffer for bv_putint -> fmt_dec. fmt_dec writes at most 20
+# bytes for a 64-bit signed integer; 24 bytes (three words) is comfortable
+# room and keeps following slots word-aligned.
+:writer_num_buf $(0) $(0) $(0)
+
# Pointer slots for the past-:ELF_end arenas.
:readbuf_buf_ptr $(0)
:heap_buf_ptr $(0)
diff --git a/tests/scheme1/48-display-write.expected b/tests/scheme1/48-display-write.expected
@@ -0,0 +1,14 @@
+42
+-7
+foo
+()
+#t
+#f
+(1 2 3)
+(1 . 2)
+(a (b c) d)
+hi
+42
+foo
+(1 2 3)
+"hi"
diff --git a/tests/scheme1/48-display-write.expected-exit b/tests/scheme1/48-display-write.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/48-display-write.scm b/tests/scheme1/48-display-write.scm
@@ -0,0 +1,29 @@
+; Verify display and write across the value spaces.
+;
+; display emits human-readable output: bytevectors as raw bytes, no
+; quotes; symbols as their name; pairs in list syntax; immediates in
+; their reader form. write is identical except bytevectors are quoted
+; "..." (treated as strings).
+(define (newline) (display (make-bytevector 1 10)))
+
+(define hi (make-bytevector 2 0))
+(bytevector-u8-set! hi 0 104)
+(bytevector-u8-set! hi 1 105)
+
+(display 42) (newline)
+(display -7) (newline)
+(display 'foo) (newline)
+(display '()) (newline)
+(display #t) (newline)
+(display #f) (newline)
+(display '(1 2 3)) (newline)
+(display '(1 . 2)) (newline)
+(display '(a (b c) d)) (newline)
+(display hi) (newline)
+
+(write 42) (newline)
+(write 'foo) (newline)
+(write '(1 2 3)) (newline)
+(write hi) (newline)
+
+(sys-exit 0)
diff --git a/tests/scheme1/49-format.expected b/tests/scheme1/49-format.expected
@@ -0,0 +1,4 @@
+n=42
+list=(1 2 3)
+tilde=~
+3 times 4 = 12
diff --git a/tests/scheme1/49-format.expected-exit b/tests/scheme1/49-format.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/49-format.scm b/tests/scheme1/49-format.scm
@@ -0,0 +1,25 @@
+; format(template-bv arg ...) -> bv. Substitutes ~a (display), ~s
+; (write), ~d (decimal), ~~ (literal '~'), ~% (newline).
+;
+; Templates are bytevectors; we build them from byte lists since the
+; reader doesn't have string literals yet.
+(define (bv-from bs)
+ (let ((bv (make-bytevector (length bs) 0)))
+ (let loop ((i 0) (xs bs))
+ (if (null? xs) bv
+ (begin (bytevector-u8-set! bv i (car xs))
+ (loop (+ i 1) (cdr xs)))))))
+
+; "n=~a~%" -> "n=42\n"
+(display (format (bv-from '(110 61 126 97 126 37)) 42))
+
+; "list=~s~%" -> "list=(1 2 3)\n"
+(display (format (bv-from '(108 105 115 116 61 126 115 126 37)) '(1 2 3)))
+
+; "tilde=~~~%" -> "tilde=~\n"
+(display (format (bv-from '(116 105 108 100 101 61 126 126 126 37))))
+
+; "~d times ~d = ~d~%" -> "3 times 4 = 12\n"
+(display (format (bv-from '(126 100 32 116 105 109 101 115 32 126 100 32 61 32 126 100 126 37)) 3 4 12))
+
+(sys-exit 0)
diff --git a/tests/scheme1/50-error.expected b/tests/scheme1/50-error.expected
@@ -0,0 +1 @@
+scheme1: error: boom 42 foo
diff --git a/tests/scheme1/50-error.expected-exit b/tests/scheme1/50-error.expected-exit
@@ -0,0 +1 @@
+1
diff --git a/tests/scheme1/50-error.scm b/tests/scheme1/50-error.scm
@@ -0,0 +1,14 @@
+; (error msg-bv irritant ...) writes "scheme1: error: <msg> <irritants...>"
+; followed by a newline to fd 2 and exits 1. Plumbed through the same
+; runtime_error path as every other abort so the prefix stays uniform.
+(define (bv-from bs)
+ (let ((bv (make-bytevector (length bs) 0)))
+ (let loop ((i 0) (xs bs))
+ (if (null? xs) bv
+ (begin (bytevector-u8-set! bv i (car xs))
+ (loop (+ i 1) (cdr xs)))))))
+
+; "boom"
+(error (bv-from '(98 111 111 109)) 42 'foo)
+; not reached
+(sys-exit 0)
