vm-ext: gate serving-JIT behind SX_SERVING_JIT + fix continuation-guest regressions
Enabling the epoch serving-mode JIT globally regressed continuation-based guest
interpreters (the epoch mode is the shared command channel every loop's
conformance runner uses). Two-part fix:
1. SAFE DEFAULT GATE. register_jit_hook in the persistent server branch is now
opt-in via SX_SERVING_JIT=1 (default OFF). Default behaviour is unchanged
(no JIT in epoch serving) → zero regression for sibling loops. The
content/Smalltalk page server opts in.
2. GENERAL FIXES + per-guest interpret-only declarations:
- callable? (sx_server/run_tests/integration_tests/mcp_tree) now accepts
VmClosure. A JIT-compiled higher-order function returns its inner closure
as a VmClosure; callable? previously rejected it, so scheme-apply's
(callable? proc) guard failed with "not a procedure: <vm:anon>".
- jit-exclude! gains a trailing-"*" namespace-prefix form
(Sx_types.jit_excluded_prefixes), the robust way to mark a whole guest
interpreter interpret-only (a name-list misses functions in extra files —
it left erlang's vm/dispatcher JIT'd and 13 tests short).
- Per-guest exclusions in each guest's runtime.sx:
scheme "scheme-*" "scm-*" erlang "er-*" "erlang-*"
prolog "pl-*" common-lisp "cl-*" "clos-*"
js "js-*" haskell "hk-*"
Verified under opt-in JIT (== CEK, no hang): smalltalk 847/847, scheme/flow
166/166, erlang 530/530, prolog 590/590, apl 152/152, js 147/148. Residual
(documented, protected by the default gate): common-lisp 6 fails in advanced
suites (parser-recovery/debugger/CLOS/MOP). lua (0/16) and tcl (3/4) fail
identically on CEK — pre-existing, not JIT. run_tests --jit/no-jit unchanged.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -263,7 +263,7 @@ let make_integration_env () =
|
||||
|
||||
(* Type predicates — needed by adapter-sx.sx *)
|
||||
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 "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
|
||||
bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);
|
||||
|
||||
@@ -477,7 +477,7 @@ let setup_env () =
|
||||
bind "number?" (fun args -> match args with
|
||||
| [Number _] -> Bool true | _ -> Bool false);
|
||||
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
|
||||
| [List []] | [ListRef { contents = [] }] -> Bool true
|
||||
| [Nil] -> Bool true | _ -> Bool false);
|
||||
|
||||
@@ -595,7 +595,7 @@ let make_test_env () =
|
||||
(* regex-find-all now provided by sx_primitives.ml *)
|
||||
bind "callable?" (fun args ->
|
||||
match args with
|
||||
| [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
|
||||
| [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true
|
||||
| _ -> Bool false);
|
||||
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"));
|
||||
|
||||
@@ -789,7 +789,11 @@ let setup_introspection env =
|
||||
bind "component?" (fun args ->
|
||||
match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
|
||||
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 "continuation?" (fun args ->
|
||||
match args with [Continuation _] -> Bool true | [_] -> Bool false | _ -> Bool false);
|
||||
@@ -4556,29 +4560,38 @@ let () =
|
||||
else begin
|
||||
(* Normal persistent server mode *)
|
||||
let env = make_server_env () in
|
||||
(* JIT needs the SX bytecode compiler (lib/compiler.sx) as its `compile`
|
||||
binding — the native Sx_compiler.compile is an incomplete stub that
|
||||
miscompiles parameters (emits arity-0 bytecode with params as
|
||||
GLOBAL_GET). http/cli/site modes already load compiler.sx; the
|
||||
persistent (epoch) serving mode must too before enabling the hook,
|
||||
or every JIT-compiled function fails at runtime with "VM undefined:
|
||||
<param>" and falls back to CEK (with double-executed side effects). *)
|
||||
(_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;
|
||||
(* 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)";
|
||||
(* Main command loop *)
|
||||
try
|
||||
|
||||
@@ -4154,17 +4154,26 @@ let () =
|
||||
Queue.clear Sx_types.jit_cache_queue;
|
||||
Nil);
|
||||
register "jit-exclude!" (fun args ->
|
||||
(* Mark one or more function names as interpret-only (never JIT-compiled).
|
||||
A guest interpreter calls this for its continuation-using dispatch core.
|
||||
Accepts any number of string/symbol names. *)
|
||||
(* 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 -> Hashtbl.replace Sx_types.jit_excluded n ()
|
||||
| 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 (Hashtbl.mem Sx_types.jit_excluded n)
|
||||
| [String n] | [Symbol n] -> Bool (Sx_types.jit_name_excluded n)
|
||||
| _ -> Bool false);
|
||||
register "jit-reset-counters!" (fun _args ->
|
||||
Sx_types.jit_compiled_count := 0;
|
||||
|
||||
@@ -487,6 +487,21 @@ let jit_threshold_skipped_count = ref 0
|
||||
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}
|
||||
|
||||
Once a lambda crosses the threshold, its [l_compiled] slot is filled.
|
||||
|
||||
@@ -1144,10 +1144,12 @@ let jit_compile_lambda (l : lambda) globals =
|
||||
None
|
||||
) else if _jit_is_broken_name fn_name then (
|
||||
None
|
||||
) else if Hashtbl.mem Sx_types.jit_excluded fn_name then (
|
||||
) else if Sx_types.jit_name_excluded fn_name then (
|
||||
(* Guest-declared interpret-only function (continuation-using dispatch
|
||||
core). Run on the CEK; the stack VM can't escape through a CEK
|
||||
continuation. See Sx_types.jit_excluded. *)
|
||||
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
|
||||
try
|
||||
|
||||
Reference in New Issue
Block a user