diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index cdae24d6..45658060 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -1279,7 +1279,7 @@ let run_foundation_tests () = assert_true "sx_truthy \"\"" (Bool (sx_truthy (String ""))); assert_eq "not truthy nil" (Bool false) (Bool (sx_truthy Nil)); assert_eq "not truthy false" (Bool false) (Bool (sx_truthy (Bool false))); - let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None } in + let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None; l_call_count = 0 } in assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l))); ignore (Sx_types.set_lambda_name (Lambda l) "my-fn"); assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l)) diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 0c4fcb3b..bb2700e3 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -3138,4 +3138,25 @@ let () = end done; String (Buffer.contents buf) - | _ -> raise (Eval_error "clock-format: (seconds [format])")) + | _ -> raise (Eval_error "clock-format: (seconds [format])")); + + (* JIT cache control & observability — backed by refs in sx_types.ml to + avoid creating a sx_primitives → sx_vm dependency cycle. sx_vm reads + these refs to decide when to JIT. *) + register "jit-stats" (fun _args -> + let d = Hashtbl.create 8 in + Hashtbl.replace d "threshold" (Number (float_of_int !Sx_types.jit_threshold)); + Hashtbl.replace d "compiled" (Number (float_of_int !Sx_types.jit_compiled_count)); + Hashtbl.replace d "compile-failed" (Number (float_of_int !Sx_types.jit_skipped_count)); + Hashtbl.replace d "below-threshold" (Number (float_of_int !Sx_types.jit_threshold_skipped_count)); + Dict d); + register "jit-set-threshold!" (fun args -> + match args with + | [Number n] -> Sx_types.jit_threshold := int_of_float n; Nil + | [Integer n] -> Sx_types.jit_threshold := n; Nil + | _ -> raise (Eval_error "jit-set-threshold!: (n) where n is integer")); + register "jit-reset-counters!" (fun _args -> + Sx_types.jit_compiled_count := 0; + Sx_types.jit_skipped_count := 0; + Sx_types.jit_threshold_skipped_count := 0; + Nil) diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index 490ce093..c7c00a33 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -128,6 +128,7 @@ and lambda = { l_closure : env; mutable l_name : string option; mutable l_compiled : vm_closure option; (** Lazy JIT cache *) + mutable l_call_count : int; (** Tiered-compilation counter — JIT after threshold calls *) } and component = { @@ -439,7 +440,20 @@ let make_lambda params body closure = | List items -> List.map value_to_string items | _ -> value_to_string_list params in - Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None } + Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None; l_call_count = 0 } + +(** {1 JIT cache control} + + Tiered compilation: only JIT a lambda after it's been called [jit_threshold] + times. This filters out one-shot lambdas (test harness, dynamic eval, REPLs) + so they never enter the JIT cache. Counters are exposed to SX as [(jit-stats)]. + + These live here (in sx_types) rather than sx_vm so [sx_primitives] can read + them without creating a sx_primitives → sx_vm dependency cycle. *) +let jit_threshold = ref 4 +let jit_compiled_count = ref 0 +let jit_skipped_count = ref 0 +let jit_threshold_skipped_count = ref 0 let make_component name params has_children body closure affinity = let n = value_to_string name in diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index bf29e066..9d8ddbb1 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -57,6 +57,9 @@ let () = Sx_types._convert_vm_suspension := (fun exn -> let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref = ref (fun _ _ -> None) +(* JIT threshold and counters live in Sx_types so primitives can read them + without creating a sx_primitives → sx_vm dependency cycle. *) + (** Sentinel closure indicating JIT compilation was attempted and failed. Prevents retrying compilation on every call. *) let jit_failed_sentinel = { @@ -353,13 +356,21 @@ and vm_call vm f args = | None -> if l.l_name <> None then begin - l.l_compiled <- Some jit_failed_sentinel; - match !jit_compile_ref l vm.globals with - | Some cl -> - l.l_compiled <- Some cl; - push_closure_frame vm cl args - | None -> + l.l_call_count <- l.l_call_count + 1; + if l.l_call_count >= !Sx_types.jit_threshold then begin + l.l_compiled <- Some jit_failed_sentinel; + match !jit_compile_ref l vm.globals with + | Some cl -> + incr Sx_types.jit_compiled_count; + l.l_compiled <- Some cl; + push_closure_frame vm cl args + | None -> + incr Sx_types.jit_skipped_count; + push vm (cek_call_or_suspend vm f (List args)) + end else begin + incr Sx_types.jit_threshold_skipped_count; push vm (cek_call_or_suspend vm f (List args)) + end end else push vm (cek_call_or_suspend vm f (List args)))