coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

JIT: restore re-entrancy guards, compile quasiquote inline, closure env merging

Browse Source 
Fix infinite recursion in VM JIT: restore sentinel pre-mark in vm_call
and pre-compile loop so recursive compiler functions don't trigger
unbounded compilation cascades. Runtime VM errors fall back to CEK;
compile errors surface visibly (not silently swallowed).

New: compile-quasiquote emits inline code instead of delegating to
qq-expand-runtime. Closure-captured variables merged into VM globals
so compiled closures resolve outer bindings via GLOBAL_GET.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-23 12:22:54 +00:00
parent 1cc3e761a2
commit 2a5ef0ea09
3 changed files with 118 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
hosts/ocaml/bin/sx_server.ml
View File

@@ -814,24 +814,14 @@ let register_jit_hook env =
| Lambda l ->
(match l.l_compiled with
| Some cl when not (Sx_vm.is_jit_failed cl) ->
(* Cached bytecode — execute on VM, fall back to CEK on error.
Don't invalidate cache — bytecode is correct, error is runtime. *)
(* Cached bytecode — run on VM, fall back to CEK on runtime error *)
(try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
with _ -> None)
| Some _ -> None (* failed sentinel *)
| Some _ -> None (* compile failed — CEK handles *)
| None ->
(* Don't try to compile while already compiling (prevents
infinite recursion: compile calls lambdas internally) *)
if !_jit_compiling then None
else begin
let fn_name = match l.l_name with Some n -> n | None -> "?" in
begin
(* Mark as tried BEFORE compiling — prevents other calls to
the same lambda from starting redundant compilations while
this one is running. If compilation succeeds, overwrite. *)
l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
Printf.eprintf "[jit-hook] compiling %s (body size ~%d)...\n%!"
fn_name (String.length (inspect l.l_body));
_jit_compiling := true;
let t0 = Unix.gettimeofday () in
let compiled = Sx_vm.jit_compile_lambda l env.bindings in
@@ -842,16 +832,11 @@ let register_jit_hook env =
match compiled with
| Some cl ->
l.l_compiled <- Some cl;
Printf.eprintf "[jit-hook] executing %s on VM...\n%!" fn_name;
(try
let r = Sx_vm.call_closure cl args cl.vm_env_ref in
Printf.eprintf "[jit-hook] %s execution OK\n%!" fn_name;
Some r
with e ->
Printf.eprintf "[jit-hook] %s VM FAIL: %s\n%!" fn_name (Printexc.to_string e);
l.l_compiled <- Some Sx_vm.jit_failed_sentinel; None)
(* Run on VM, fall back to CEK on runtime error *)
(try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
with _ -> None)
| None -> None
end end)
end)
| _ -> None)
@@ -992,7 +977,8 @@ let rec dispatch env cmd =
| Some cl ->
l.l_compiled <- Some cl;
incr count
| None -> ())
| None ->
Printf.eprintf "[jit] pre-compile FAIL: %s\n%!" name)
| _ -> ()
) compiler_fns;
let dt = Unix.gettimeofday () -. t0 in
@@ -1072,14 +1058,11 @@ let rec dispatch env cmd =
let t0 = Unix.gettimeofday () in
let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
ignore (env_bind env "expand-components?" expand_fn);
Printf.eprintf "[sx-page-full] starting aser eval...\n%!";
let body_result =
let call = List [Symbol "aser";
List [Symbol "quote"; expr];
Env env] in
let r = Sx_ref.eval_expr call (Env env) in
Printf.eprintf "[sx-page-full] aser eval returned\n%!";
r
Sx_ref.eval_expr call (Env env)
in
let t1 = Unix.gettimeofday () in
io_batch_mode := false;