Skip to content
This repository was archived by the owner on Aug 12, 2026. It is now read-only.

Commit 5919285

Browse files
chaploudchaploud
committed
The echo slice: a string crosses the boundary both ways and comes back equal
cljwit.component is S4's guest side, first slice, 0030 implemented as pinned: memory + a bump-arena cabi_realloc (grow-last fast path, non-last copy, memory.grow when a payload outruns the page), reset at each export entry, and the echo trampoline with the worked signature — (param i32 i32) (result i32), the callee returning the pointer to its 4-aligned (ptr, code-units) pair. The order constraint the arena depends on is stated where it binds: lift everything out of linear memory into the GC heap before the first lowering allocation, because the entry reset parks the bump pointer under the caller's bytes. The round trip runs in the gate against cljwit.host's finished string lanes: ascii, multi-byte utf8 (the encoding decision's first executable check), the empty string, a 600 KB payload that forces memory.grow, and two calls in a row across the entry reset. Body is identity on the GC value — marshalling only, as 0030 says out loud. Claude-Session: https://claude.ai/code/session_01XF5Hfq4Ca2N2XYEzWQQuHt
1 parent 0ede3fd commit 5919285

2 files changed

Lines changed: 180 additions & 0 deletions

File tree

‎src/cljwit/component.clj‎

Lines changed: 122 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,122 @@
1+
(ns cljwit.component
2+
"S4's guest-side marshalling, first slice (`doc/design/0030`): the
3+
linear-memory scaffolding a component needs — `memory`,
4+
`cabi_realloc` as a bump arena with a grow-last-block fast path,
5+
reset at each export entry — and the echo trampoline whose core
6+
signature the note pins: a lifted `func(string) -> string` is
7+
`(param i32 i32) (result i32)`, and the callee *returns* the
8+
pointer to its (ptr, code-units) pair.
9+
10+
Order constraint the arena depends on: a trampoline lifts every
11+
argument out of linear memory into the GC heap *before* its first
12+
lowering allocation — the entry reset moves the bump pointer under
13+
the caller's argument bytes, which stay intact only until the next
14+
allocation. Lifting allocates nothing linear, so lift-all-then-
15+
lower-all keeps it sound."
16+
(:require [clojure.string :as str]))
17+
18+
(set! *warn-on-reflection* true)
19+
20+
(def ^:private arena
21+
;; Offsets 0..15 stay unused so 0 keeps meaning null. The grow-last
22+
;; fast path is what the Canonical ABI's optimistic utf8 transcode
23+
;; calls for (0030 §3); realloc of a non-last block copies.
24+
" (memory (export \"memory\") 1)
25+
(global $next (mut i32) (i32.const 16))
26+
(global $last (mut i32) (i32.const 0))
27+
(func $ensure (param $end i32)
28+
(block $ok
29+
(loop $grow
30+
(br_if $ok (i32.le_u (local.get $end)
31+
(i32.mul (memory.size) (i32.const 65536))))
32+
(if (i32.eq (memory.grow (i32.const 1)) (i32.const -1))
33+
(then (unreachable)))
34+
(br $grow))))
35+
(func $cabi_realloc (export \"cabi_realloc\")
36+
(param $old i32) (param $old-size i32) (param $align i32) (param $new-size i32)
37+
(result i32)
38+
(local $p i32) (local $i i32)
39+
;; grow-last fast path: the newest block resizes in place.
40+
(if (i32.and (i32.ne (local.get $old) (i32.const 0))
41+
(i32.eq (local.get $old) (global.get $last)))
42+
(then
43+
(call $ensure (i32.add (local.get $old) (local.get $new-size)))
44+
(global.set $next (i32.add (local.get $old) (local.get $new-size)))
45+
(return (local.get $old))))
46+
(local.set $p (i32.and (i32.add (global.get $next)
47+
(i32.sub (local.get $align) (i32.const 1)))
48+
(i32.xor (i32.sub (local.get $align) (i32.const 1))
49+
(i32.const -1))))
50+
(call $ensure (i32.add (local.get $p) (local.get $new-size)))
51+
(global.set $next (i32.add (local.get $p) (local.get $new-size)))
52+
(global.set $last (local.get $p))
53+
;; A non-last realloc preserves the old contents, per realloc.
54+
(if (i32.ne (local.get $old) (i32.const 0))
55+
(then
56+
(local.set $i (i32.const 0))
57+
(block $done
58+
(loop $copy
59+
(br_if $done (i32.ge_u (local.get $i)
60+
(select (local.get $old-size) (local.get $new-size)
61+
(i32.lt_u (local.get $old-size) (local.get $new-size)))))
62+
(i32.store8 (i32.add (local.get $p) (local.get $i))
63+
(i32.load8_u (i32.add (local.get $old) (local.get $i))))
64+
(local.set $i (i32.add (local.get $i) (i32.const 1)))
65+
(br $copy)))))
66+
(local.get $p))
67+
(func $arena-reset
68+
(global.set $next (i32.const 16))
69+
(global.set $last (i32.const 0)))
70+
")
71+
72+
(def echo-wat
73+
"The echo component's core module: utf8 string in, the same bytes
74+
out — marshalling only, the body is identity on the GC value
75+
(`0030` §5)."
76+
(str "(module\n"
77+
" (type $Bytes (array (mut i8)))\n"
78+
arena
79+
" (func (export \"echo\") (param $ptr i32) (param $len i32) (result i32)\n"
80+
" (local $arr (ref $Bytes)) (local $i i32) (local $dst i32) (local $ret i32)\n"
81+
" (call $arena-reset)\n"
82+
" ;; lift: caller bytes -> GC array, before any lowering allocation\n"
83+
" (local.set $arr (array.new_default $Bytes (local.get $len)))\n"
84+
" (local.set $i (i32.const 0))\n"
85+
" (block $done1\n"
86+
" (loop $l1\n"
87+
" (br_if $done1 (i32.ge_u (local.get $i) (local.get $len)))\n"
88+
" (array.set $Bytes (local.get $arr) (local.get $i)\n"
89+
" (i32.load8_u (i32.add (local.get $ptr) (local.get $i))))\n"
90+
" (local.set $i (i32.add (local.get $i) (i32.const 1)))\n"
91+
" (br $l1)))\n"
92+
" ;; body: identity\n"
93+
" ;; lower: GC array -> fresh arena block\n"
94+
" (local.set $dst (call $cabi_realloc (i32.const 0) (i32.const 0)\n"
95+
" (i32.const 1) (array.len (local.get $arr))))\n"
96+
" (local.set $i (i32.const 0))\n"
97+
" (block $done2\n"
98+
" (loop $l2\n"
99+
" (br_if $done2 (i32.ge_u (local.get $i) (array.len (local.get $arr))))\n"
100+
" (i32.store8 (i32.add (local.get $dst) (local.get $i))\n"
101+
" (array.get_u $Bytes (local.get $arr) (local.get $i)))\n"
102+
" (local.set $i (i32.add (local.get $i) (i32.const 1)))\n"
103+
" (br $l2)))\n"
104+
" ;; the callee RETURNS the retptr to its 4-aligned (ptr, code-units)\n"
105+
" ;; pair -- 0030 §4's worked signature; a return-area param here is\n"
106+
" ;; zwasm's recorded bug.\n"
107+
" (local.set $ret (call $cabi_realloc (i32.const 0) (i32.const 0)\n"
108+
" (i32.const 4) (i32.const 8)))\n"
109+
" (i32.store (local.get $ret) (local.get $dst))\n"
110+
" (i32.store (i32.add (local.get $ret) (i32.const 4)) (array.len (local.get $arr)))\n"
111+
" (local.get $ret)))\n"))
112+
113+
(defn wit
114+
"The echo world, utf8 declared by the lift (0030 §1 — utf8 is also
115+
the embed default)."
116+
[]
117+
(str/join "\n"
118+
["package cljwit:s4;"
119+
""
120+
"world echo-world {"
121+
" export echo: func(s: string) -> string;"
122+
"}"]))

‎test/cljwit/component_echo_test.clj‎

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
(ns cljwit.component-echo-test
2+
"S4's first slice, round-tripped (0030 §5): the guest-side echo
3+
component — memory, bump-arena cabi_realloc, the pinned trampoline
4+
shape — built by wasm-tools and called through cljwit.host, whose
5+
host-side string lanes already pass. Skips like the other FFM tests
6+
when libwasmtime is not resolvable."
7+
(:require [clojure.java.io :as io]
8+
[clojure.java.process :as process]
9+
[clojure.test :refer [deftest is]]
10+
[cljwit.component :as component]
11+
[cljwit.host :as host]))
12+
13+
(set! *warn-on-reflection* true)
14+
15+
(def ^:private lib? (some? (System/getenv "CLJWIT_WASMTIME_LIB")))
16+
17+
(defn- sh! [& args]
18+
(let [p (apply process/start {:out :pipe :err :pipe} args)
19+
err (future (slurp (process/stderr p)))
20+
exit @(process/exit-ref p)]
21+
(when-not (zero? exit)
22+
(throw (ex-info (str "failed: " (pr-str args)) {:err @err})))))
23+
24+
(defn- build-echo-component ^java.io.File []
25+
(let [dir (doto (io/file "target/component-echo") (.mkdirs))
26+
wat (io/file dir "echo.wat")
27+
wit (io/file dir "echo.wit")
28+
core (io/file dir "echo.core.wasm")
29+
emb (io/file dir "echo.embed.wasm")
30+
comp (io/file dir "echo.component.wasm")]
31+
(spit wat component/echo-wat)
32+
(spit wit (component/wit))
33+
(sh! "wasm-tools" "parse" (str wat) "-o" (str core))
34+
(sh! "wasm-tools" "component" "embed" (str wit) (str core) "-o" (str emb))
35+
(sh! "wasm-tools" "component" "new" (str emb) "-o" (str comp))
36+
comp))
37+
38+
(deftest echo-round-trip
39+
(if-not lib?
40+
(println "CLJWIT_WASMTIME_LIB unset — skipping the component echo test")
41+
(let [comp (build-echo-component)]
42+
(with-open [e (host/engine)
43+
a (host/compile e comp)
44+
i (host/instantiate a)]
45+
(let [echo (i "echo")]
46+
(is (= {:params [["s" :string]] :result :string} (host/signature i "echo")))
47+
(is (= "hello, boundary" (echo "hello, boundary")))
48+
;; Multi-byte utf8 crosses intact — the encoding decision's
49+
;; first executable check (0030 §1).
50+
(is (= "こんにちは、component境界" (echo "こんにちは、component境界")))
51+
(is (= "" (echo "")))
52+
;; Long enough to force memory.grow past the initial page.
53+
(let [big (apply str (repeat 100000 "abcДЖ日"))]
54+
(is (= big (echo big))))
55+
;; Two calls in a row: the second entry's reset must not
56+
;; corrupt the first's already-lifted result (0030 §3).
57+
(let [r1 (echo "first") r2 (echo "second")]
58+
(is (= ["first" "second"] [r1 r2]))))))))

0 commit comments

Comments
 (0)