Merge branch 'loops/sx-vm-extensions' into architecture

# Conflicts:
#	lib/erlang/runtime.sx
This commit is contained in:
2026-06-20 07:37:43 +00:00
18 changed files with 453 additions and 25 deletions

View File

@@ -263,7 +263,7 @@ let make_integration_env () =
(* Type predicates — needed by adapter-sx.sx *) (* Type predicates — needed by adapter-sx.sx *)
bind "callable?" (fun args -> bind "callable?" (fun args ->
match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false); match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true | _ -> Bool false);
bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false); bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false); bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false); bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);

View File

@@ -477,7 +477,7 @@ let setup_env () =
bind "number?" (fun args -> match args with bind "number?" (fun args -> match args with
| [Number _] -> Bool true | _ -> Bool false); | [Number _] -> Bool true | _ -> Bool false);
bind "callable?" (fun args -> match args with bind "callable?" (fun args -> match args with
| [NativeFn _ | Lambda _ | Component _ | Island _] -> Bool true | _ -> Bool false); | [NativeFn _ | Lambda _ | Component _ | Island _ | VmClosure _] -> Bool true | _ -> Bool false);
bind "empty?" (fun args -> match args with bind "empty?" (fun args -> match args with
| [List []] | [ListRef { contents = [] }] -> Bool true | [List []] | [ListRef { contents = [] }] -> Bool true
| [Nil] -> Bool true | _ -> Bool false); | [Nil] -> Bool true | _ -> Bool false);

View File

@@ -595,7 +595,7 @@ let make_test_env () =
(* regex-find-all now provided by sx_primitives.ml *) (* regex-find-all now provided by sx_primitives.ml *)
bind "callable?" (fun args -> bind "callable?" (fun args ->
match args with match args with
| [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true
| _ -> Bool false); | _ -> Bool false);
bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string")); bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string"));
bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string")); bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string"));

View File

@@ -1097,7 +1097,11 @@ let setup_introspection env =
bind "component?" (fun args -> bind "component?" (fun args ->
match args with [Component _] | [Island _] -> Bool true | _ -> Bool false); match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
bind "callable?" (fun args -> bind "callable?" (fun args ->
match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false); (* VmClosure must count as callable: a JIT-compiled higher-order function
returns its inner closure as a VmClosure, and downstream code (e.g.
scheme-apply's `(callable? proc)` guard) must recognize it — it is
invocable via the normal call path. *)
match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true | _ -> Bool false);
bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false); bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
bind "continuation?" (fun args -> bind "continuation?" (fun args ->
match args with [Continuation _] -> Bool true | [_] -> Bool false | _ -> Bool false); match args with [Continuation _] -> Bool true | [_] -> Bool false | _ -> Bool false);
@@ -1468,6 +1472,22 @@ let sx_render_to_html expr env =
let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16 let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16
(* Bisection aid: env-var-driven JIT filter. Lets us narrow which named
lambda the VM miscompiles without rebuilding.
SX_JIT_DENY=name1,name2 — never JIT these (substring match on exact name).
SX_JIT_ONLY=name1,name2 — JIT ONLY these (exact name); skip all others. *)
let _jit_deny_set =
match Sys.getenv_opt "SX_JIT_DENY" with
| None | Some "" -> []
| Some s -> String.split_on_char ',' s |> List.map String.trim
let _jit_only_set =
match Sys.getenv_opt "SX_JIT_ONLY" with
| None | Some "" -> []
| Some s -> String.split_on_char ',' s |> List.map String.trim
let _jit_name_allowed name =
(not (List.mem name _jit_deny_set))
&& (match _jit_only_set with [] -> true | only -> List.mem name only)
let rec make_vm_suspend_marker request saved_vm = let rec make_vm_suspend_marker request saved_vm =
let d = Hashtbl.create 3 in let d = Hashtbl.create 3 in
Hashtbl.replace d "__vm_suspended" (Bool true); Hashtbl.replace d "__vm_suspended" (Bool true);
@@ -1486,6 +1506,8 @@ let rec make_vm_suspend_marker request saved_vm =
let register_jit_hook env = let register_jit_hook env =
Sx_runtime._jit_try_call_fn := Some (fun f args -> Sx_runtime._jit_try_call_fn := Some (fun f args ->
match f with match f with
| Lambda l when (match l.l_name with Some n -> not (_jit_name_allowed n) | None -> false) ->
None (* bisection filter excluded this name *)
| Lambda l -> | Lambda l ->
(match l.l_compiled with (match l.l_compiled with
| Some cl when not (Sx_vm.is_jit_failed cl) -> | Some cl when not (Sx_vm.is_jit_failed cl) ->
@@ -4854,6 +4876,38 @@ let () =
else begin else begin
(* Normal persistent server mode *) (* Normal persistent server mode *)
let env = make_server_env () in let env = make_server_env () in
(* JIT in the epoch serving mode is OPT-IN via SX_SERVING_JIT=1.
Default OFF: this mode is the shared command channel used by every
loop's conformance runner, and enabling JIT globally regresses
continuation-based guest interpreters (Scheme/Erlang/Prolog/CL: their
eval/dispatch cores capture call/cc continuations the stack VM can't
escape, and deep AST recursion can miscompile into a non-terminating
loop). Guests that are safe declare their interpret-only namespace with
`(jit-exclude! "<ns>-*")`; until every guest is validated, the safe
default is no JIT here. Opt in (SX_SERVING_JIT=1) for validated
workloads — e.g. the content/Smalltalk page server. *)
(match Sys.getenv_opt "SX_SERVING_JIT" with
| Some ("1" | "true" | "yes" | "on") ->
(* Load the SX bytecode compiler (lib/compiler.sx) as `compile` — the
native Sx_compiler.compile is an incomplete stub (arity-0 bytecode,
params as GLOBAL_GET). http/cli/site modes already load it. *)
(_import_env := Some env;
let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
try Sys.getenv "SX_ROOT" with Not_found ->
if Sys.file_exists "/app/spec" then "/app" else Sys.getcwd () in
let lib_base = try Sys.getenv "SX_LIB_DIR" with Not_found ->
project_dir ^ "/lib" in
let compiler_path = lib_base ^ "/compiler.sx" in
let compiler_path =
if Sys.file_exists compiler_path then compiler_path
else if Sys.file_exists "lib/compiler.sx" then "lib/compiler.sx"
else compiler_path in
try load_library_file compiler_path; rebind_host_extensions env
with exn ->
Printf.eprintf "[sx-server] WARNING: failed to load compiler.sx for JIT (%s) — JIT disabled\n%!"
(Printexc.to_string exn));
register_jit_hook env
| _ -> ());
send "(ready)"; send "(ready)";
(* Main command loop *) (* Main command loop *)
try try

View File

@@ -4168,6 +4168,28 @@ let () =
) Sx_types.jit_cache_queue; ) Sx_types.jit_cache_queue;
Queue.clear Sx_types.jit_cache_queue; Queue.clear Sx_types.jit_cache_queue;
Nil); Nil);
register "jit-exclude!" (fun args ->
(* Mark function names as interpret-only (never JIT-compiled). A guest
interpreter calls this for its continuation-using dispatch core.
Accepts string/symbol names; a trailing "*" makes it a namespace prefix
(e.g. "er-*" excludes every function whose name starts with "er-")
the robust way to declare a whole guest interpreter core. *)
List.iter (fun a ->
match a with
| String n | Symbol n ->
let len = String.length n in
if len > 0 && n.[len - 1] = '*' then begin
let prefix = String.sub n 0 (len - 1) in
if not (List.mem prefix !Sx_types.jit_excluded_prefixes) then
Sx_types.jit_excluded_prefixes := prefix :: !Sx_types.jit_excluded_prefixes
end else
Hashtbl.replace Sx_types.jit_excluded n ()
| _ -> ()) args;
Nil);
register "jit-excluded?" (fun args ->
match args with
| [String n] | [Symbol n] -> Bool (Sx_types.jit_name_excluded n)
| _ -> Bool false);
register "jit-reset-counters!" (fun _args -> register "jit-reset-counters!" (fun _args ->
Sx_types.jit_compiled_count := 0; Sx_types.jit_compiled_count := 0;
Sx_types.jit_skipped_count := 0; Sx_types.jit_skipped_count := 0;

View File

@@ -17,11 +17,19 @@ let rec _fast_eq a b =
| Number x, Number y -> x = y | Number x, Number y -> x = y
| Integer x, Number y -> float_of_int x = y | Integer x, Number y -> float_of_int x = y
| Number x, Integer y -> x = float_of_int y | Number x, Integer y -> x = float_of_int y
(* Exact rationals — must match the "=" primitive (safe_eq). Cross-multiply
for rational/rational; coerce for rational/int and rational/float. *)
| Rational (an, ad), Rational (bn, bd) -> an * bd = bn * ad
| Rational (n, d), Integer y -> n = y * d
| Integer x, Rational (n, d) -> x * d = n
| Rational (n, d), Number y -> float_of_int n /. float_of_int d = y
| Number x, Rational (n, d) -> x = float_of_int n /. float_of_int d
| Bool x, Bool y -> x = y | Bool x, Bool y -> x = y
| Nil, Nil -> true | Nil, Nil -> true
| Symbol x, Symbol y -> x = y | Symbol x, Symbol y -> x = y
| Keyword x, Keyword y -> x = y | Keyword x, Keyword y -> x = y
| List la, List lb -> | (List la | ListRef { contents = la }),
(List lb | ListRef { contents = lb }) ->
(try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false) (try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false)
| _ -> false | _ -> false

View File

@@ -470,6 +470,38 @@ let jit_compiled_count = ref 0
let jit_skipped_count = ref 0 let jit_skipped_count = ref 0
let jit_threshold_skipped_count = ref 0 let jit_threshold_skipped_count = ref 0
(** Runtime, data-driven JIT exclusion set. Names added here are never
JIT-compiled — they run on the CEK interpreter instead.
This is how a guest interpreter declares its *interpret-only* functions:
those that capture or invoke first-class continuations (e.g. Smalltalk's
[call/cc]-based non-local return [^expr], or block escape). The stack VM
cannot transfer control through a CEK continuation, so a JIT-compiled
frame on the OCaml/VM stack between a [call/cc] and its [(k v)] invocation
would either fail at runtime or (worse) re-run with duplicated side
effects. Marking the dispatch core interpret-only keeps those functions on
the CEK while pure helpers still JIT.
Populated from SX via the [jit-exclude!] primitive (see sx_primitives).
Consulted in [Sx_vm.jit_compile_lambda], so it covers BOTH JIT entry
points: the CEK call hook and the in-VM tiered-compilation path. *)
let jit_excluded : (string, unit) Hashtbl.t = Hashtbl.create 64
(** Namespace-prefix exclusions. A guest interpreter declares its whole
function namespace interpret-only with one entry (e.g. ["er-"], ["scm-"]),
which is far more robust than enumerating every function — a name-list
misses functions in extra files (the erlang VM dispatcher, etc.) and
silently regresses. Set via [jit-exclude!] with a trailing ["*"]
(e.g. [(jit-exclude! "er-*")]). Checked via [jit_name_excluded]. *)
let jit_excluded_prefixes : string list ref = ref []
(** True if [name] is excluded from JIT — by exact name or by namespace prefix. *)
let jit_name_excluded name =
Hashtbl.mem jit_excluded name
|| List.exists (fun p ->
String.length name >= String.length p
&& String.sub name 0 (String.length p) = p) !jit_excluded_prefixes
(** {2 JIT cache LRU eviction — Phase 2} (** {2 JIT cache LRU eviction — Phase 2}
Once a lambda crosses the threshold, its [l_compiled] slot is filled. Once a lambda crosses the threshold, its [l_compiled] slot is filled.

View File

@@ -808,14 +808,31 @@ and run vm =
let b = pop vm and a = pop vm in let b = pop vm and a = pop vm in
push vm (match a, b with push vm (match a, b with
| Integer x, Integer y when y <> 0 && x mod y = 0 -> Integer (x / y) | Integer x, Integer y when y <> 0 && x mod y = 0 -> Integer (x / y)
| Integer x, Integer y -> Number (float_of_int x /. float_of_int y) (* Non-divisible Integer/Integer must delegate to the "/" primitive:
it returns an exact Rational (e.g. 1/2), matching CEK semantics.
Inlining float division here (0.5) diverges from the interpreter
and breaks numeric equality against rational results. *)
| Number x, Number y -> Number (x /. y) | Number x, Number y -> Number (x /. y)
| Integer x, Number y -> Number (float_of_int x /. y) | Integer x, Number y -> Number (float_of_int x /. y)
| Number x, Integer y -> Number (x /. float_of_int y) | Number x, Integer y -> Number (x /. float_of_int y)
| _ -> (Hashtbl.find Sx_primitives.primitives "/") [a; b]) | _ -> (Hashtbl.find Sx_primitives.primitives "/") [a; b])
| 164 (* OP_EQ *) -> | 164 (* OP_EQ *) ->
let b = pop vm and a = pop vm in let b = pop vm and a = pop vm in
push vm (Bool (Sx_runtime._fast_eq a b)) (* Trivial scalar cases inline; everything else (Rational, Dict,
Record, Vector, ListRef, nested lists) delegates to the "="
primitive so VM equality matches CEK exactly. _fast_eq is a
stripped-down subset and must not be the source of truth here. *)
push vm (match a, b with
| Integer x, Integer y -> Bool (x = y)
| Number x, Number y -> Bool (x = y)
| Integer x, Number y -> Bool (float_of_int x = y)
| Number x, Integer y -> Bool (x = float_of_int y)
| String x, String y -> Bool (x = y)
| Bool x, Bool y -> Bool (x = y)
| Symbol x, Symbol y -> Bool (x = y)
| Keyword x, Keyword y -> Bool (x = y)
| Nil, Nil -> Bool true
| _ -> (Hashtbl.find Sx_primitives.primitives "=") [a; b])
| 165 (* OP_LT *) -> | 165 (* OP_LT *) ->
let b = pop vm and a = pop vm in let b = pop vm and a = pop vm in
push vm (match a, b with push vm (match a, b with
@@ -1072,7 +1089,7 @@ let _jit_is_broken_name n =
Operand-size logic mirrors [opcode_operand_size] (which is defined Operand-size logic mirrors [opcode_operand_size] (which is defined
later, in the disassembly section); inlined here so this helper can later, in the disassembly section); inlined here so this helper can
sit before [jit_compile_lambda] in the file. *) sit before [jit_compile_lambda] in the file. *)
let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) = let bytecode_find_opcode (pred : int -> bool) (bc : int array) (consts : value array) =
let core_operand_size = function let core_operand_size = function
| 1 | 20 | 21 | 64 | 65 | 128 -> 2 (* u16 *) | 1 | 20 | 21 | 64 | 65 | 128 -> 2 (* u16 *)
| 16 | 17 | 18 | 19 | 48 | 49 | 144 -> 1 (* u8 *) | 16 | 17 | 18 | 19 | 48 | 49 | 144 -> 1 (* u8 *)
@@ -1085,7 +1102,7 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
let found = ref false in let found = ref false in
while not !found && !ip < len do while not !found && !ip < len do
let op = bc.(!ip) in let op = bc.(!ip) in
if op >= 200 then found := true if pred op then found := true
else begin else begin
ip := !ip + 1; ip := !ip + 1;
let extra = match op with let extra = match op with
@@ -1112,6 +1129,33 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
done; done;
!found !found
let bytecode_uses_extension_opcodes bc consts =
bytecode_find_opcode (fun op -> op >= 200) bc consts
(** True if [code] — or any closure nested in its constant pool — installs an
exception handler (OP_PUSH_HANDLER = 35), i.e. contains a `guard` /
`handler-bind` / dream-catch form. The VM's PUSH_HANDLER only intercepts a
VM-level RAISE (opcode 37); it does NOT catch the OCaml [Eval_error] that
the `error` primitive throws from inside a CALL/CALL_PRIM in a callee
frame. So a JIT-compiled guard silently fails to catch thrown errors (they
escape across the JIT frame).
The scan is RECURSIVE: a curried higher-order function (e.g. Dream's
`dream-catch-with = (fn (on-error) (fn (next) (fn (req) (guard ...))))`)
has no PUSH_HANDLER in its own body — the guard lives in a nested
`OP_CLOSURE` whose code sits in the constant pool. JIT-compiling the outer
function would mint that inner guard as a VmClosure with the broken VM
handler. Descending into nested closure codes catches this, so the whole
closure family runs on the CEK (whose guard catches correctly). Covers
dream-catch-with, host wrap-errors, and every guard user centrally. *)
let rec code_uses_handler code =
bytecode_find_opcode (fun op -> op = 35) code.vc_bytecode code.vc_constants
|| Array.exists (fun c ->
match c with
| Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
(try code_uses_handler (code_from_value c) with _ -> false)
| _ -> false) code.vc_constants
let jit_compile_lambda (l : lambda) globals = let jit_compile_lambda (l : lambda) globals =
let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in
if !_jit_compiling then ( if !_jit_compiling then (
@@ -1127,6 +1171,13 @@ let jit_compile_lambda (l : lambda) globals =
None None
) else if _jit_is_broken_name fn_name then ( ) else if _jit_is_broken_name fn_name then (
None None
) else if Sx_types.jit_name_excluded fn_name then (
(* Guest-declared interpret-only function (continuation-using dispatch
core, or a whole namespace via prefix). Run on the CEK; the stack VM
can't escape through a CEK continuation and may miscompile deep AST
recursion into a non-terminating loop. See Sx_types.jit_excluded /
jit_excluded_prefixes. *)
None
) else ) else
try try
_jit_compiling := true; _jit_compiling := true;
@@ -1183,6 +1234,13 @@ let jit_compile_lambda (l : lambda) globals =
Printf.eprintf "[jit] SKIP %s: bytecode uses extension opcodes (interpret-only in v1)\n%!" Printf.eprintf "[jit] SKIP %s: bytecode uses extension opcodes (interpret-only in v1)\n%!"
fn_name; fn_name;
None None
end else if code_uses_handler code then begin
(* guard / handler-bind (possibly in a nested closure): VM
PUSH_HANDLER doesn't catch the `error` primitive's OCaml
exception across frames — run on the CEK. *)
Printf.eprintf "[jit] SKIP %s: installs an exception handler (guard) — interpret-only\n%!"
fn_name;
None
end else end else
Some { vm_code = code; vm_upvalues = [||]; Some { vm_code = code; vm_upvalues = [||];
vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure } vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }

View File

@@ -757,4 +757,10 @@
"format-arguments" args)))) "format-arguments" args))))
(cl-restart-case (cl-restart-case
(fn () (cl-signal-obj obj cl-handler-stack)) (fn () (cl-signal-obj obj cl-handler-stack))
(list "continue" (list) (fn () nil)))))) (list "continue" (list) (fn () nil))))))
;; ── JIT interpret-only boundary ───────────────────────────────────────────
;; The Common-Lisp evaluator implements block/return-from, catch/throw, and
;; the condition system via non-local control (host continuations); under JIT
;; a compiled frame can't transfer control through a CEK continuation. Exclude
;; the cl-/clos- namespaces from JIT. See Sx_types.jit_excluded_prefixes.
(jit-exclude! "cl-*" "clos-*")

View File

@@ -783,11 +783,7 @@
(rest-clauses (rest-clauses
(if (> (len flat-args) 2) (slice flat-args 2) (list)))) (if (> (len flat-args) 2) (slice flat-args 2) (list))))
(if (if
(or (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
(and
(= (type-of test) "keyword")
(= (keyword-name test) "else"))
(= test true))
(compile-expr em body scope tail?) (compile-expr em body scope tail?)
(do (do
(compile-expr em test scope false) (compile-expr em test scope false)
@@ -828,11 +824,7 @@
(rest-clauses (rest-clauses
(if (> (len clauses) 2) (slice clauses 2) (list)))) (if (> (len clauses) 2) (slice clauses 2) (list))))
(if (if
(or (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
(and
(= (type-of test) "keyword")
(= (keyword-name test) "else"))
(= test true))
(do (emit-op em 5) (compile-expr em body scope tail?)) (do (emit-op em 5) (compile-expr em body scope tail?))
(do (do
(emit-op em 6) (emit-op em 6)
@@ -1172,11 +1164,7 @@
(test (first clause)) (test (first clause))
(body (rest clause))) (body (rest clause)))
(if (if
(or (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
(and
(= (type-of test) "keyword")
(= (keyword-name test) "else"))
(= test true))
(compile-begin em body scope tail?) (compile-begin em body scope tail?)
(do (do
(compile-expr em test scope false) (compile-expr em test scope false)

View File

@@ -1624,4 +1624,6 @@
(er-mk-atom "ok"))) (er-mk-atom "ok")))
;; Register everything at load time. ;; Register everything at load time.
(jit-exclude! "er-*" "erlang-*")
(er-register-builtin-bifs!) (er-register-builtin-bifs!)

View File

@@ -148,3 +148,9 @@
(fn (acc i) (str acc (char-at buf i))) (fn (acc i) (str acc (char-at buf i)))
"" ""
(range off (string-length buf))))))) (range off (string-length buf)))))))
;; ── JIT interpret-only boundary ───────────────────────────────────────────
;; The Haskell evaluator (hk-eval and the lazy-thunk forcer) recurses deeply
;; over the AST/graph; under JIT the recursive eval can miscompile into a
;; non-terminating loop. Exclude the hk- namespace from JIT.
(jit-exclude! "hk-*")

View File

@@ -6994,3 +6994,9 @@
(set! js-global-this js-global) (set! js-global-this js-global)
(dict-set! js-global "globalThis" js-global) (dict-set! js-global "globalThis" js-global)
;; ── JIT interpret-only boundary ───────────────────────────────────────────
;; The JS evaluator (transpile.sx) uses call/cc for control flow (exceptions,
;; early return); a JIT-compiled frame can't escape through a CEK continuation.
;; Exclude the js- namespace from JIT. See Sx_types.jit_excluded_prefixes.
(jit-exclude! "js-*")

View File

@@ -2792,3 +2792,10 @@
{:cut false} {:cut false}
(fn () (begin (dict-set! box :n (+ (dict-get box :n) 1)) false))) (fn () (begin (dict-set! box :n (+ (dict-get box :n) 1)) false)))
(dict-get box :n)))) (dict-get box :n))))
;; ── JIT interpret-only boundary ───────────────────────────────────────────
;; The Prolog resolution engine (pl-solve! and friends) recurses deeply over
;; goals/clauses with backtracking; under JIT it miscompiles into a
;; non-terminating loop (the suite never completes). Exclude the whole pl-
;; namespace from JIT. See Sx_types.jit_excluded_prefixes.
(jit-exclude! "pl-*")

View File

@@ -647,3 +647,11 @@
(raise (get outcome :value))) (raise (get outcome :value)))
(:else outcome)))))))))) (:else outcome))))))))))
env))) env)))
;; ── JIT interpret-only boundary ───────────────────────────────────────────
;; The Scheme evaluator uses call/cc, dynamic-wind, guard/raise and applies
;; user procedures (which may be continuations or JIT-returned closures); a
;; JIT-compiled frame cannot transfer control through a CEK continuation.
;; Exclude the whole scheme-/scm- namespace from JIT (robust vs a name list,
;; which misses functions in extra files). See Sx_types.jit_excluded_prefixes.
(jit-exclude! "scheme-*" "scm-*")

View File

@@ -1475,3 +1475,22 @@
(get ast :temps))) (get ast :temps)))
(smalltalk-eval-ast ast frame))))))) (smalltalk-eval-ast ast frame)))))))
(begin (dict-set! cell :active false) result))))) (begin (dict-set! cell :active false) result)))))
;; ── JIT interpret-only boundary ──────────────────────────────────────────
;; The Smalltalk evaluator implements non-local return (^expr), block escape,
;; and exception unwinding via first-class continuations (call/cc). A stack
;; bytecode VM cannot transfer control through a CEK continuation, so any of
;; these dispatch-core functions, if JIT-compiled, would be an un-escapable
;; VM frame on the stack between a `call/cc` capture and its `(k v)` invocation
;; — failing at runtime and (before this guard) re-running with duplicated
;; side effects. Declaring them interpret-only keeps them on the CEK while the
;; pure leaf helpers (parsing, ident/ivar lookup, formatting, predicates,
;; arithmetic) still JIT. See Sx_types.jit_excluded / `jit-exclude!`.
(jit-exclude!
"smalltalk-eval" "smalltalk-eval-program" "smalltalk-load"
"smalltalk-eval-ast" "st-eval-seq" "st-eval-send" "st-eval-send-dispatch"
"st-eval-cascade" "st-try-intrinsify" "st-send" "st-invoke" "st-dnu"
"st-super-send" "st-primitive-send" "st-num-send" "st-bool-send"
"st-string-send" "st-array-send" "st-nil-send" "st-class-side-send"
"st-block-apply" "st-block-dispatch" "st-block-while" "st-block-ensure"
"st-block-if-curtailed" "st-block-on-do" "st-block-value-selector?")

View File

@@ -360,3 +360,10 @@
{:type "number" :value 2})) {:type "number" :value 2}))
(list st-test-pass st-test-fail) (list st-test-pass st-test-fail)
;; The SUnit suite-runner `pharo-test-class` (defined in tests/pharo.sx and
;; tests/ansi.sx) drives the interpret-only Smalltalk evaluator through
;; smalltalk-eval-program in a loop and accumulates results via st-test
;; (a side-effecting accumulator). Under JIT it can fail mid-loop and re-run
;; via CEK, double-counting already-emitted rows. Keep it interpret-only.
(jit-exclude! "pharo-test-class")

View File

@@ -0,0 +1,205 @@
# JIT bytecode correctness — enable the JIT in serving mode
> Kickoff handed over from the **host-on-sx** loop (2026-06-19). This is the
> highest-leverage perf win on the platform.
## Why this matters
Every SX-on-SX subsystem runs **interpreted on the tree-walking CEK**: the
Smalltalk runtime (→ content-on-sx rendering), and the guest languages
(Datalog, Prolog, APL, Scheme, Haskell, Erlang, Maude). The lazy JIT
(`register_jit_hook` → bytecode VM) would speed all of them up ~1060×. It is
currently **only installed in `--http` page-server mode**, not the epoch /
`http-listen` serving mode — because it **miscompiles** these workloads.
Concrete impact: the host serves a blog post (`content/html`, interpreted
Smalltalk) in **~2 seconds per request**. With a correct JIT it should be tens
of ms. Same slowdown applies to every guest-language-backed service.
## Concrete repro (from the host loop)
In `hosts/ocaml/bin/sx_server.ml`, the persistent server mode (`make_server_env`,
~line 4871) does **not** call `register_jit_hook env` — only the `--http` mode
(~line 4034) does. To reproduce the miscompile:
1. Add `register_jit_hook env;` right after `let env = make_server_env () in` in
the persistent server-mode branch (~4871).
2. Rebuild: `eval $(opam env --switch=5.2.0); dune build bin/sx_server.exe`.
3. Run a Smalltalk/content-heavy suite, e.g. the host-on-sx conformance
(`bash /root/rose-ash-loops/host/lib/host/conformance.sh`, or any
content-on-sx suite). **With the hook ON, tests FAIL** — host-on-sx dropped to
`router 3/6, feed 4/11, relations 9/16, blog 4/11`. With the hook OFF: all green.
So the JIT produces **wrong results** (the known "compiled compiler helpers loop
on complex nested ASTs" — see memory `project_jit_bytecode_bug`).
## Goal
Make the JIT compile the Smalltalk-on-SX evaluator + guest-language evaluators
**correctly**, so `register_jit_hook` can be enabled in serving mode with
conformance **fully green**. Then enable it there.
## Suggested approach
- Minimal repro to bisect: render a `lib/content` doc via `content/html` with JIT
ON vs OFF, diff the output, find the first divergence.
- Localize with the VM debugging tools (see CLAUDE.md): `(vm-trace ...)`,
`(bytecode-inspect ...)`, `(prim-check ...)`, `(deps-check ...)`.
- Likely suspects: nested closures / TCO, dict construction, `st-send` dispatch
patterns, recursion through the Smalltalk method interpreter.
## Pointers
- `register_jit_hook``sx_server.ml` ~1493; JIT VM-suspend/resolve path ~14971514.
- `hosts/ocaml/lib/sx_vm.ml` — the bytecode VM + compiler.
- `plans/jit-cache-architecture.md`, `plans/jit-perf-regression.md`, `restore-jit-perf.sh`.
- Memory: `project_jit_bytecode_bug.md` (plan ref `plans/reflective-rolling-treehouse.md`).
- The shared `sx_server.exe` binary is used by ALL loops — coordinate before
changing VM semantics that could affect sibling conformance runs.
---
## Resolution (2026-06-19, loop loops/sx-vm-extensions)
JIT is now enabled in the persistent (epoch) serving mode (`register_jit_hook`
in `sx_server.ml`'s server-mode branch). Smalltalk conformance is **847/847 —
identical to the no-JIT baseline** (no failures, no double-counted rows).
Datalog conformance (a non-continuation guest) is **356/356** under JIT.
Five distinct root causes were found and fixed (not one "miscompile"):
1. **Serving mode never loaded `lib/compiler.sx`.** The JIT then used the
native `Sx_compiler.compile` stub, which emits arity-0 bytecode with every
parameter compiled as `GLOBAL_GET` → "VM undefined: <param>" on the first
call of essentially every function. `http`/`cli`/`site` modes already load
`compiler.sx`; the epoch serving branch now does too (before the hook).
*Fix: `sx_server.ml` server-mode branch loads `lib/compiler.sx`.*
2. **`compile-cond`/`compile-case-clauses`/`compile-guard-clauses` only treated
the keyword `:else` and `true` as the catch-all** — not the bare symbol
`else` that the CEK's `is-else-clause?` accepts. They emitted
`GLOBAL_GET "else"` → runtime "VM undefined: else".
*Fix: `lib/compiler.sx` — add the symbol-`else` case to all three.*
3. **`OP_DIV` produced a float for non-divisible Integer/Integer** (`1/2` → 0.5)
instead of the exact `Rational` the `/` primitive returns → diverged from CEK
and broke equality vs rational results.
*Fix: `sx_vm.ml` — delegate non-divisible int/int to the `/` primitive.*
4. **`OP_EQ` / `_fast_eq` lacked `Rational`/`ListRef` cases** that the real `=`
primitive's `safe_eq` has → `(= 1/2 1/2)` was false under JIT.
*Fix: `OP_EQ` delegates non-trivial types to the `=` primitive;
`_fast_eq` (also used by `prim_call "="`) gained rational + ListRef cases.*
5. **Continuation-based control flow can't run in the stack VM.** Smalltalk's
non-local return (`^expr`), block escape, and exception unwinding use
`call/cc`; a JIT-compiled frame between a `call/cc` capture and its `(k v)`
invocation cannot transfer control and (via the hook's re-run-on-failure)
double-executes side effects.
*Fix: a general, data-driven exclusion set — `Sx_types.jit_excluded`,
populated from SX via the new `jit-exclude!` primitive, consulted in
`jit_compile_lambda` so it covers BOTH JIT entry points (CEK hook + in-VM
tiered path). `lib/smalltalk/eval.sx` self-declares its continuation-using
dispatch core interpret-only; pure helpers (parsing, lookup, formatting,
arithmetic) still JIT.* One SUnit suite-runner test helper
(`pharo-test-class`) miscompiles under JIT on a specific iteration and is
excluded in the test prelude (`tests/tokenize.sx`).
### Known residual / follow-up
- The hook still **re-runs a failed VM execution via CEK** (always yields the
correct result, but can duplicate side effects if a JIT'd function fails
mid-run after a side effect). `run_tests`'s hook instead propagates non-IO /
non-"VM undefined" exceptions. Adopting that propagate-don't-rerun semantics
in the serving hook would remove the double-execution class entirely, but it
surfaces genuine mid-run miscompiles as errors — so it must land together
with fixing/excluding any function that miscompiles mid-run (e.g.
`pharo-test-class`). Deferred to avoid changing shared VM/CEK semantics under
this loop.
- Other continuation-heavy guests (Scheme, Erlang use `call/cc`) will need
their own `jit-exclude!` declarations for their dispatch cores; the mechanism
is in place. Non-continuation guests (Datalog/Prolog/Haskell/APL) JIT as-is.
- A debug aid was added to the serving hook: `SX_JIT_DENY=name,...` /
`SX_JIT_ONLY=name,...` env vars to bisect which named lambda the VM
mishandles (hook-path only).
---
## Guest-loop regression sweep + safe-default gate (2026-06-19, follow-up)
Host-loop verification found that enabling serving-mode JIT **globally**
regresses continuation-based guest interpreters (the epoch serving mode is the
shared command channel for every loop's conformance runner). Failure modes:
- **VmClosure not callable** — a JIT'd higher-order function returns its inner
closure as a `VmClosure`; the native `callable?` predicate didn't list
`VmClosure`, so `scheme-apply`'s `(callable? proc)` guard rejected it
("scheme-eval: not a procedure: <vm:anon>"). FIXED generally: `callable?`
(all 4 bindings) now accepts `VmClosure`.
- **Continuation escape** — Scheme `call/cc`, Erlang receive, CL conditions,
JS exceptions: a JIT'd frame can't transfer control through a CEK
continuation.
- **Non-terminating miscompile (HANG)** — Erlang/Prolog/Haskell recursive
evaluators miscompiled into an infinite loop (worse than an error: can't
fall back).
### Mechanism
- `jit-exclude!` now accepts a trailing `*` wildcard → namespace-prefix
exclusion (`Sx_types.jit_excluded_prefixes`, checked in
`jit_compile_lambda` for both JIT entry points). One declaration per guest,
robust vs name-lists (which missed e.g. the erlang `vm/dispatcher`).
### Per-guest exclusions added (in each guest's runtime, loaded with it)
| Guest | Declaration | Status under opt-in JIT |
|-------|-------------|--------------------------|
| smalltalk | name-list (dispatch core) + `pharo-test-class` | 847/847 == CEK |
| scheme | `(jit-exclude! "scheme-*" "scm-*")` | flow 166/166 == CEK |
| erlang | `(jit-exclude! "er-*" "erlang-*")` | 530/530 == CEK, no hang |
| prolog | `(jit-exclude! "pl-*")` | 590/590 == CEK |
| common-lisp | `(jit-exclude! "cl-*" "clos-*")` | residual: 6 fail (advanced suites) |
| js | `(jit-exclude! "js-*")` | (verifying) |
| haskell | `(jit-exclude! "hk-*")` | (verifying) |
Not JIT-related (fail identically on CEK and JIT, pre-existing): lua 0/16,
tcl 3/4. apl/datalog/forth/ocaml: clean under JIT as-is (no continuations).
### Safe-default gate
Serving-mode JIT is now **opt-in via `SX_SERVING_JIT=1` (default OFF)** in
`sx_server.ml`. Default behavior is unchanged (no JIT in epoch serving) ⇒
**zero regression** for every sibling loop's conformance. The content/Smalltalk
page server opts in. This bounds risk: guests are validated and excluded
incrementally; until then the default protects them. Common-Lisp's advanced
suites still need investigation before CL is opt-in-clean.
---
## guard / handler-bind under JIT — central recursive PUSH_HANDLER scan (2026-06-20)
Combined-binary integration (my JIT + host render-page) surfaced a third
JIT-unsafe class beyond guest dispatch cores: **`guard`-based error handling**.
The VM's `OP_PUSH_HANDLER` (compiled `guard`) only intercepts a VM-level
`RAISE` (opcode 37) — it does NOT catch the OCaml `Eval_error` the `error`
primitive throws from a CALL/CALL_PRIM in a callee frame. So a JIT-compiled
`guard` silently fails to catch; the thrown error escapes across the JIT frame.
- SOLID break: `host/wrap-errors -> dream-catch-with` (curried:
`(fn (on-error) (fn (next) (fn (req) (guard ...))))`) — middleware suite
7/9 under JIT (9/9 CEK), "kaboom" escaped as Unhandled exception, NOT
fallback-saved (the guard is in an outer frame, the throw in an inner one).
- LATENT (turned out harmless): `host/blog--render-node`'s `guard` — it JIT-
failed then the hook RE-RAN it on CEK where the guard caught (pure render, no
duplicated effects). This is the double-execution residual firing live.
Fix: `code_uses_handler` scans a JIT candidate's bytecode **recursively**
(including nested closure code in the constant pool) for `OP_PUSH_HANDLER`;
`jit_compile_lambda` skips JIT for any match. The recursion is essential —
curried `dream-catch-with` has no PUSH_HANDLER in its own body; the guard is in
a nested `OP_CLOSURE`. Verified: direct + curried cross-frame guards catch
under JIT; host "kaboom" escapes 2 -> 0.
### Remaining (documented, gated): the double-execution residual
The serving hook still re-runs a failed VM execution via CEK (correct result,
duplicated side effects if the function is impure and fails mid-run). The guard
fix removes the common trigger (guard functions no longer JIT). The clean
general fix is propagate-don't-rerun (run_tests' hook semantics) but that
surfaces genuine mid-run miscompiles as errors and must land with fixing/
excluding those — deferred (shared CEK/VM change). The default-OFF gate makes
all of this opt-in, so nothing regresses by default.