vm-ext: fix common-lisp condition-system JIT residual (call/cc-caller exclusion)
The 6 common-lisp opt-in-JIT failures were all condition-system continuation escape: cl-restart-case/cl-handler-case/cl-handler-bind wrap their body in call/cc (restarts + non-local handler exit). When an SX function that drives the condition system (the parse-recover / interactive-debugger fixtures, e.g. parse-numbers, make-policy-debugger) is JIT-compiled, the call/cc form runs in a NESTED cek-run where invoking the captured continuation runs-to-completion-and-returns instead of escaping — so a restart fails to abort and the body falls through. Observed as result accumulation (got (1 3 0 3) vs (1 3)) and no-abort (restart returns the 999 sentinel). These callers are arbitrary user/fixture code, not a fixed namespace, so they can't be prefix-excluded. New data-driven mechanism: - jit-exclude-callers-of! registers call/cc-establishing form names in Sx_types.jit_excluded_caller_names. - jit_compile_lambda skips any function whose constant pool (recursively, incl. nested closures) references a registered name — code_refs_escaping_caller. Guarded by Hashtbl.length > 0 so it's a no-op for every guest that doesn't register (zero effect outside CL). - lib/common-lisp/runtime.sx registers the establish side (cl-restart-case, cl-handler-case, cl-handler-bind) and the invoke side (cl-invoke-restart, cl-invoke-debugger, cl-signal, cl-error-with-debugger). Result: CL conformance under SX_SERVING_JIT=1 = 487/0, EXACTLY matching the CEK baseline (was 484/6 with a +3 double-execution over-count). parse-recover 3/4 -> 6/0, interactive-debugger 7/2 -> 7/0. Note: the geometry/mop-trace suites report 0/0 on BOTH CEK and JIT — they error "Undefined symbol: refl-class-chain-depth-with" (the CLOS suites don't preload lib/guest/reflective/class-chain.sx). Pre-existing conformance-harness gap, not a JIT issue; left as-is. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -4175,6 +4175,16 @@ let () =
|
||||
match args with
|
||||
| [String n] | [Symbol n] -> Bool (Sx_types.jit_name_excluded n)
|
||||
| _ -> Bool false);
|
||||
register "jit-exclude-callers-of!" (fun args ->
|
||||
(* Register call/cc-establishing forms (e.g. cl-restart-case). Any function
|
||||
whose bytecode references one of these is itself interpret-only — JIT
|
||||
would force the form into a nested cek-run where its continuation can't
|
||||
escape. A guest declares its condition-system / escaping forms here. *)
|
||||
List.iter (fun a ->
|
||||
match a with
|
||||
| String n | Symbol n -> Hashtbl.replace Sx_types.jit_excluded_caller_names n ()
|
||||
| _ -> ()) args;
|
||||
Nil);
|
||||
register "jit-reset-counters!" (fun _args ->
|
||||
Sx_types.jit_compiled_count := 0;
|
||||
Sx_types.jit_skipped_count := 0;
|
||||
|
||||
@@ -502,6 +502,20 @@ let jit_name_excluded name =
|
||||
String.length name >= String.length p
|
||||
&& String.sub name 0 (String.length p) = p) !jit_excluded_prefixes
|
||||
|
||||
(** Names of functions that ESTABLISH an escaping continuation via call/cc
|
||||
(e.g. Common-Lisp's [cl-restart-case] / [cl-handler-case] — the condition
|
||||
system). Any SX function that *calls* one of these is itself unsafe to JIT:
|
||||
JIT-compiling the caller forces the call/cc-wrapping form to run in a nested
|
||||
cek-run, where invoking the captured continuation runs-to-completion-and-
|
||||
returns instead of escaping — so a restart/non-local exit silently fails
|
||||
and the body falls through (observed as result accumulation / no-abort).
|
||||
|
||||
These callers are NOT a fixed namespace (they are arbitrary user/test code),
|
||||
so they cannot be prefix-excluded. Instead a guest declares its escaping
|
||||
forms here (via [jit-exclude-callers-of!]) and [jit_compile_lambda] skips
|
||||
any function whose constant pool references one of them. *)
|
||||
let jit_excluded_caller_names : (string, unit) Hashtbl.t = Hashtbl.create 16
|
||||
|
||||
(** {2 JIT cache LRU eviction — Phase 2}
|
||||
|
||||
Once a lambda crosses the threshold, its [l_compiled] slot is filled.
|
||||
|
||||
@@ -1156,6 +1156,22 @@ let rec code_uses_handler code =
|
||||
(try code_uses_handler (code_from_value c) with _ -> false)
|
||||
| _ -> false) code.vc_constants
|
||||
|
||||
(** True if [code] — or any nested closure code — references (in its constant
|
||||
pool, as a GLOBAL_GET/CALL name) a function registered in
|
||||
[Sx_types.jit_excluded_caller_names] (a call/cc-establishing form like
|
||||
Common-Lisp's cl-restart-case/cl-handler-case). Such a caller must run on
|
||||
the CEK so the continuation captured inside the called form can escape.
|
||||
The constant-pool string IS the referenced symbol name, so membership is a
|
||||
direct lookup; recurse into nested closure codes. Skipped entirely (no
|
||||
Hashtbl walk) when no escaping forms are registered. *)
|
||||
let rec code_refs_escaping_caller code =
|
||||
Array.exists (fun c ->
|
||||
match c with
|
||||
| String s -> Hashtbl.mem Sx_types.jit_excluded_caller_names s
|
||||
| Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
|
||||
(try code_refs_escaping_caller (code_from_value c) with _ -> false)
|
||||
| _ -> false) code.vc_constants
|
||||
|
||||
let jit_compile_lambda (l : lambda) globals =
|
||||
let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in
|
||||
if !_jit_compiling then (
|
||||
@@ -1241,6 +1257,13 @@ let jit_compile_lambda (l : lambda) globals =
|
||||
Printf.eprintf "[jit] SKIP %s: installs an exception handler (guard) — interpret-only\n%!"
|
||||
fn_name;
|
||||
None
|
||||
end else if Hashtbl.length Sx_types.jit_excluded_caller_names > 0
|
||||
&& code_refs_escaping_caller code then begin
|
||||
(* Calls a call/cc-establishing form (e.g. cl-restart-case): must
|
||||
run on the CEK so the captured continuation can escape. *)
|
||||
Printf.eprintf "[jit] SKIP %s: calls a call/cc-establishing form — interpret-only\n%!"
|
||||
fn_name;
|
||||
None
|
||||
end else
|
||||
Some { vm_code = code; vm_upvalues = [||];
|
||||
vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }
|
||||
|
||||
Reference in New Issue
Block a user