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

Merge hs-f into architecture: JIT Phase 2/3 + native unwrap sweep + dict-eq fix

Browse Source 
JIT Phase 2 (LRU eviction) + Phase 3 (manual reset), lib/jit.sx convenience layer,
21 host-* natives ABI-compatible with WASM kernel handles, dict-eq fix (structural
eq for plain dicts + Integer/Number in equal?), io-wait-event interceptor fix,
HS test runner unwrap shim for post-JIT-P1 value handles.

Conflicts resolved:
- tests/hs-run-filtered.js: combined arch's fake-timer block (for socket RPC tests)
  with hs-f's auto-unwrap shim
- shared/static/wasm/sx_browser.bc.js: took hs-f's regenerated bundle
This commit is contained in:
giles
2026-05-14 20:10:42 +00:00
parent ca8e6f4da3 95c2d0b64a
commit f62df8d64e
10 changed files with 5246 additions and 5596 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hosts/ocaml/bin/run_tests.ml
View File

@@ -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; l_call_count = 0 } 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; l_uid = Sx_types.next_lambda_uid () } 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))

6
hosts/ocaml/browser/sx_browser.ml
View File

@@ -676,7 +676,11 @@ let () =
let rec deep_equal a b =
match a, b with
| Nil, Nil -> true | Bool a, Bool b -> a = b
| Number a, Number b -> a = b | String a, String b -> a = b
| Integer a, Integer b -> a = b
| Number a, Number b -> a = b
| Integer a, Number b -> float_of_int a = b
| Number a, Integer b -> a = float_of_int b
| String a, String b -> a = b
| Symbol a, Symbol b -> a = b | Keyword a, Keyword b -> a = b
| (List a | ListRef { contents = a }), (List b | ListRef { contents = b }) ->
List.length a = List.length b && List.for_all2 deep_equal a b

32
hosts/ocaml/lib/sx_primitives.ml
View File

@@ -759,11 +759,22 @@ let () =
(List lb | ListRef { contents = lb }) ->
List.length la = List.length lb &&
List.for_all2 safe_eq la lb
(* Dict: check __host_handle for DOM node identity *)
(* Dict: __host_handle identity for DOM-wrapped dicts; otherwise
structural equality over keys + values. *)
| Dict a, Dict b ->
(match Hashtbl.find_opt a "__host_handle", Hashtbl.find_opt b "__host_handle" with
| Some (Number ha), Some (Number hb) -> ha = hb
| _ -> false)
| Some _, _ | _, Some _ -> false
| None, None ->
Hashtbl.length a = Hashtbl.length b &&
(let eq = ref true in
Hashtbl.iter (fun k v ->
if !eq then
match Hashtbl.find_opt b k with
| Some v' -> if not (safe_eq v v') then eq := false
| None -> eq := false
) a;
!eq))
(* Records: same type + structurally equal fields *)
| Record a, Record b ->
a.r_type.rt_uid = b.r_type.rt_uid &&
@@ -4117,17 +4128,34 @@ let () =
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 "budget" (Number (float_of_int !Sx_types.jit_budget));
Hashtbl.replace d "cache-size" (Number (float_of_int (Sx_types.jit_cache_size ())));
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));
Hashtbl.replace d "evicted" (Number (float_of_int !Sx_types.jit_evicted_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-set-budget!" (fun args ->
match args with
| [Number n] -> Sx_types.jit_budget := int_of_float n; Nil
| [Integer n] -> Sx_types.jit_budget := n; Nil
| _ -> raise (Eval_error "jit-set-budget!: (n) where n is integer"));
register "jit-reset-cache!" (fun _args ->
(* Phase 3 manual cache reset — clear all compiled VmClosures.
Hot paths will re-JIT on next call (after re-hitting threshold). *)
Queue.iter (fun (_, v) ->
match v with Lambda l -> l.l_compiled <- None | _ -> ()
) Sx_types.jit_cache_queue;
Queue.clear Sx_types.jit_cache_queue;
Nil);
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;
Sx_types.jit_evicted_count := 0;
Nil)

38
hosts/ocaml/lib/sx_types.ml
View File

@@ -139,6 +139,7 @@ and lambda = {
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 *)
l_uid : int; (** Unique identity for LRU cache tracking *)
}
and component = {
@@ -445,12 +446,16 @@ let unwrap_env_val = function
| Env e -> e
| _ -> raise (Eval_error "make_lambda: expected env for closure")
(* Lambda UID — minted on construction, used as LRU cache key (Phase 2). *)
let lambda_uid_counter = ref 0
let next_lambda_uid () = incr lambda_uid_counter; !lambda_uid_counter
let make_lambda params body closure =
let ps = match params with
| 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; l_call_count = 0 }
Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None; l_call_count = 0; l_uid = next_lambda_uid () }
(** {1 JIT cache control}
@@ -465,6 +470,37 @@ let jit_compiled_count = ref 0
let jit_skipped_count = ref 0
let jit_threshold_skipped_count = ref 0
(** {2 JIT cache LRU eviction — Phase 2}
Once a lambda crosses the threshold, its [l_compiled] slot is filled.
To bound memory under unbounded compilation pressure, track all live
compiled lambdas in FIFO order, and evict from the head when the count
exceeds [jit_budget].
[lambda_uid_counter] mints unique identities on lambda creation; the
LRU queue holds these IDs paired with a back-reference to the lambda
so we can clear its [l_compiled] slot on eviction.
Budget of 0 = no cache (disable JIT entirely).
Budget of [max_int] = unbounded (legacy behaviour). Default 5000 is
a generous ceiling for any realistic page; the test harness compiles
~3000 distinct one-shot lambdas in a full run but tiered compilation
(Phase 1) means most never enter the cache, so steady-state count
stays small.
[lambda_uid_counter] and [next_lambda_uid] are defined above
[make_lambda] (which uses them on construction). *)
let jit_budget = ref 5000
let jit_evicted_count = ref 0
(** Live compiled lambdas in FIFO order — front is oldest, back is newest.
Each entry is (uid, lambda); on eviction we clear lambda.l_compiled and
drop from the queue. Using a mutable Queue rather than a hand-rolled
linked list because eviction is amortised O(1) at the head and inserts
are O(1) at the tail. *)
let jit_cache_queue : (int * value) Queue.t = Queue.create ()
let jit_cache_size () = Queue.length jit_cache_queue
let make_component name params has_children body closure affinity =
let n = value_to_string name in
let ps = value_to_string_list params in

10
hosts/ocaml/lib/sx_vm.ml
View File

@@ -368,12 +368,20 @@ and vm_call vm f args =
if l.l_name <> None
then begin
l.l_call_count <- l.l_call_count + 1;
if l.l_call_count >= !Sx_types.jit_threshold then begin
if l.l_call_count >= !Sx_types.jit_threshold && !Sx_types.jit_budget > 0 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;
(* Phase 2 LRU: track this compiled lambda; if cache exceeds budget,
evict the oldest by clearing its l_compiled slot. *)
Queue.add (l.l_uid, Lambda l) Sx_types.jit_cache_queue;
while Queue.length Sx_types.jit_cache_queue > !Sx_types.jit_budget do
(match Queue.pop Sx_types.jit_cache_queue with
| (_, Lambda ev_l) -> ev_l.l_compiled <- None; incr Sx_types.jit_evicted_count
| _ -> ())
done;
push_closure_frame vm cl args
| None ->
incr Sx_types.jit_skipped_count;