diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index d8598fb2..258dedde 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -799,7 +799,7 @@ let _jit_compiling = ref false (* re-entrancy guard *) let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16 let register_jit_hook env = - Sx_ref.jit_call_hook := Some (fun f args -> + Sx_runtime._jit_try_call_fn := Some (fun f args -> match f with | Lambda l -> (match l.l_compiled with diff --git a/hosts/ocaml/bootstrap.py b/hosts/ocaml/bootstrap.py index eae4c71a..423681f1 100644 --- a/hosts/ocaml/bootstrap.py +++ b/hosts/ocaml/bootstrap.py @@ -54,9 +54,6 @@ let _strict_ref = ref (Bool false) let _prim_param_types_ref = ref Nil let _last_error_kont_ref = ref Nil -(* JIT call hook — platform-level optimization, registered by sx_server.ml *) -let jit_call_hook : (value -> value list -> value option) option ref = ref None - """ @@ -209,50 +206,6 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str: # the transpiler directly — it emits !_ref for reads, _ref := for writes. import re - # Inject make_raise_guard_frame if missing (transpiler merge bug drops it) - if "and make_raise_guard_frame" not in output: - RAISE_GUARD_FRAME = """ -(* make-raise-guard-frame — injected by bootstrap.py *) -and make_raise_guard_frame env saved_kont = - (CekFrame { cf_type = "raise-guard"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = saved_kont; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil }) -""" - output = output.replace( - "(* make-signal-return-frame *)\nand make_signal_return_frame", - RAISE_GUARD_FRAME + "\n(* make-signal-return-frame *)\nand make_signal_return_frame", - ) - - # === Platform-level patches (not spec concerns) === - - # Instrument recursive cek_run to capture kont on error (for comp-trace). - cek_run_old = ( - 'and cek_run state =\n' - ' (if sx_truthy ((cek_terminal_p (state))) then (cek_value (state)) else (cek_run ((cek_step (state)))))' - ) - cek_run_new = ( - 'and cek_run state =\n' - ' (if sx_truthy ((cek_terminal_p (state))) then (cek_value (state)) else\n' - ' try cek_run ((cek_step (state)))\n' - ' with Eval_error msg ->\n' - ' (if !_last_error_kont_ref = Nil then _last_error_kont_ref := cek_kont state);\n' - ' raise (Eval_error msg))' - ) - if cek_run_old in output: - output = output.replace(cek_run_old, cek_run_new, 1) - - # Inject JIT dispatch into continue_with_call's lambda branch. - # Replace final make_cek_state in the lambda branch with JIT check. - jit_old = "(make_cek_state ((lambda_body (f))) (local) (kont))))))" - jit_new = ( - "(match !jit_call_hook, f with " - "| Some hook, Lambda l when l.l_name <> None -> " - "let args_list = match args with List a | ListRef { contents = a } -> a | _ -> [] in " - "(match hook f args_list with " - "Some result -> make_cek_value result local kont " - "| None -> make_cek_state (lambda_body f) local kont) " - "| _ -> make_cek_state ((lambda_body (f))) (local) (kont))))))" - ) - output = output.replace(jit_old, jit_new, 1) - return output diff --git a/hosts/ocaml/lib/sx_runtime.ml b/hosts/ocaml/lib/sx_runtime.ml index 327d7111..d0239b84 100644 --- a/hosts/ocaml/lib/sx_runtime.ml +++ b/hosts/ocaml/lib/sx_runtime.ml @@ -474,3 +474,16 @@ let debug_log _ _ = Nil (* mutable_list — mutable list for bytecode compiler pool entries *) let mutable_list () = ListRef (ref []) +(* JIT try-call — ref set by sx_server.ml after compiler loads. + Returns Nil (no JIT) or the result value. Spec calls this. *) +let _jit_try_call_fn : (value -> value list -> value option) option ref = ref None +let jit_try_call f args = + match !_jit_try_call_fn with + | None -> Nil + | Some hook -> + match f with + | Lambda l when l.l_name <> None -> + let arg_list = match args with List a | ListRef { contents = a } -> a | _ -> [] in + (match hook f arg_list with Some result -> result | None -> Nil) + | _ -> Nil + diff --git a/hosts/ocaml/transpiler.sx b/hosts/ocaml/transpiler.sx index 31b6516a..ca37d803 100644 --- a/hosts/ocaml/transpiler.sx +++ b/hosts/ocaml/transpiler.sx @@ -252,7 +252,8 @@ "component-set-file!" "parse-comp-params" "parse-macro-params" - "parse-keyword-args")) + "parse-keyword-args" + "jit-try-call")) (define ml-is-known-name? diff --git a/spec/evaluator.sx b/spec/evaluator.sx index 66d2caf9..7b0dd55f 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -127,6 +127,8 @@ (define make-raise-eval-frame (fn (env continuable?) {:scheme continuable? :env env :type "raise-eval"})) +(define make-raise-guard-frame (fn (env saved-kont) {:env env :type "raise-guard" :remaining saved-kont})) + (define find-matching-handler (fn @@ -2640,8 +2642,10 @@ (handler-fn (kont-find-handler rest-k condition))) (if (nil? handler-fn) - (host-error - (str "Unhandled exception: " (inspect condition))) + (do + (set! *last-error-kont* rest-k) + (host-error + (str "Unhandled exception: " (inspect condition)))) (continue-with-call handler-fn (list condition) @@ -2654,8 +2658,10 @@ rest-k) (kont-push (make-raise-guard-frame fenv rest-k) rest-k)))))) ("raise-guard" - (host-error - "exception handler returned from non-continuable raise")) + (do + (set! *last-error-kont* rest-k) + (host-error + "exception handler returned from non-continuable raise"))) ("multi-map" (let ((f (get frame "f")) @@ -2685,7 +2691,10 @@ (get frame "env") (list k) rest-k))) - (_ (error (str "Unknown frame type: " ft))))))))) + (_ + (do + (set! *last-error-kont* rest-k) + (error (str "Unknown frame type: " ft)))))))))) (define continue-with-call @@ -2733,7 +2742,12 @@ (for-each (fn (p) (env-bind! local p nil)) (slice params (len args)))) - (make-cek-state (lambda-body f) local kont)) + (let + ((jit-result (jit-try-call f args))) + (if + (nil? jit-result) + (make-cek-state (lambda-body f) local kont) + (make-cek-value jit-result local kont)))) (or (component? f) (island? f)) (let ((parsed (parse-keyword-args raw-args env))