|
|
|
|
@@ -1138,7 +1138,11 @@ let setup_introspection env =
|
|
|
|
|
bind "component?" (fun args ->
|
|
|
|
|
match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
|
|
|
|
|
bind "callable?" (fun args ->
|
|
|
|
|
match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
|
|
|
|
|
(* VmClosure must count as callable: a JIT-compiled higher-order function
|
|
|
|
|
returns its inner closure as a VmClosure, and downstream code (e.g.
|
|
|
|
|
scheme-apply's `(callable? proc)` guard) must recognize it — it is
|
|
|
|
|
invocable via the normal call path. *)
|
|
|
|
|
match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true | _ -> Bool false);
|
|
|
|
|
bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
|
|
|
|
|
bind "continuation?" (fun args ->
|
|
|
|
|
match args with [Continuation _] -> Bool true | [_] -> Bool false | _ -> Bool false);
|
|
|
|
|
@@ -1523,6 +1527,22 @@ let sx_render_to_html expr env =
|
|
|
|
|
|
|
|
|
|
let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16
|
|
|
|
|
|
|
|
|
|
(* Bisection aid: env-var-driven JIT filter. Lets us narrow which named
|
|
|
|
|
lambda the VM miscompiles without rebuilding.
|
|
|
|
|
SX_JIT_DENY=name1,name2 — never JIT these (substring match on exact name).
|
|
|
|
|
SX_JIT_ONLY=name1,name2 — JIT ONLY these (exact name); skip all others. *)
|
|
|
|
|
let _jit_deny_set =
|
|
|
|
|
match Sys.getenv_opt "SX_JIT_DENY" with
|
|
|
|
|
| None | Some "" -> []
|
|
|
|
|
| Some s -> String.split_on_char ',' s |> List.map String.trim
|
|
|
|
|
let _jit_only_set =
|
|
|
|
|
match Sys.getenv_opt "SX_JIT_ONLY" with
|
|
|
|
|
| None | Some "" -> []
|
|
|
|
|
| Some s -> String.split_on_char ',' s |> List.map String.trim
|
|
|
|
|
let _jit_name_allowed name =
|
|
|
|
|
(not (List.mem name _jit_deny_set))
|
|
|
|
|
&& (match _jit_only_set with [] -> true | only -> List.mem name only)
|
|
|
|
|
|
|
|
|
|
let rec make_vm_suspend_marker request saved_vm =
|
|
|
|
|
let d = Hashtbl.create 3 in
|
|
|
|
|
Hashtbl.replace d "__vm_suspended" (Bool true);
|
|
|
|
|
@@ -1541,6 +1561,8 @@ let rec make_vm_suspend_marker request saved_vm =
|
|
|
|
|
let register_jit_hook env =
|
|
|
|
|
Sx_runtime._jit_try_call_fn := Some (fun f args ->
|
|
|
|
|
match f with
|
|
|
|
|
| Lambda l when (match l.l_name with Some n -> not (_jit_name_allowed n) | None -> false) ->
|
|
|
|
|
None (* bisection filter excluded this name *)
|
|
|
|
|
| Lambda l ->
|
|
|
|
|
(match l.l_compiled with
|
|
|
|
|
| Some cl when not (Sx_vm.is_jit_failed cl) ->
|
|
|
|
|
@@ -4917,6 +4939,38 @@ let () =
|
|
|
|
|
match args with
|
|
|
|
|
| expr :: _ -> String (sx_render_to_html expr env)
|
|
|
|
|
| _ -> raise (Eval_error "render-page: (expr)"))));
|
|
|
|
|
(* JIT in the epoch serving mode is OPT-IN via SX_SERVING_JIT=1.
|
|
|
|
|
Default OFF: this mode is the shared command channel used by every
|
|
|
|
|
loop's conformance runner, and enabling JIT globally regresses
|
|
|
|
|
continuation-based guest interpreters (Scheme/Erlang/Prolog/CL: their
|
|
|
|
|
eval/dispatch cores capture call/cc continuations the stack VM can't
|
|
|
|
|
escape, and deep AST recursion can miscompile into a non-terminating
|
|
|
|
|
loop). Guests that are safe declare their interpret-only namespace with
|
|
|
|
|
`(jit-exclude! "<ns>-*")`; until every guest is validated, the safe
|
|
|
|
|
default is no JIT here. Opt in (SX_SERVING_JIT=1) for validated
|
|
|
|
|
workloads — e.g. the content/Smalltalk page server. *)
|
|
|
|
|
(match Sys.getenv_opt "SX_SERVING_JIT" with
|
|
|
|
|
| Some ("1" | "true" | "yes" | "on") ->
|
|
|
|
|
(* Load the SX bytecode compiler (lib/compiler.sx) as `compile` — the
|
|
|
|
|
native Sx_compiler.compile is an incomplete stub (arity-0 bytecode,
|
|
|
|
|
params as GLOBAL_GET). http/cli/site modes already load it. *)
|
|
|
|
|
(_import_env := Some env;
|
|
|
|
|
let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
|
|
|
|
|
try Sys.getenv "SX_ROOT" with Not_found ->
|
|
|
|
|
if Sys.file_exists "/app/spec" then "/app" else Sys.getcwd () in
|
|
|
|
|
let lib_base = try Sys.getenv "SX_LIB_DIR" with Not_found ->
|
|
|
|
|
project_dir ^ "/lib" in
|
|
|
|
|
let compiler_path = lib_base ^ "/compiler.sx" in
|
|
|
|
|
let compiler_path =
|
|
|
|
|
if Sys.file_exists compiler_path then compiler_path
|
|
|
|
|
else if Sys.file_exists "lib/compiler.sx" then "lib/compiler.sx"
|
|
|
|
|
else compiler_path in
|
|
|
|
|
try load_library_file compiler_path; rebind_host_extensions env
|
|
|
|
|
with exn ->
|
|
|
|
|
Printf.eprintf "[sx-server] WARNING: failed to load compiler.sx for JIT (%s) — JIT disabled\n%!"
|
|
|
|
|
(Printexc.to_string exn));
|
|
|
|
|
register_jit_hook env
|
|
|
|
|
| _ -> ());
|
|
|
|
|
send "(ready)";
|
|
|
|
|
(* Main command loop *)
|
|
|
|
|
try
|
|
|
|
|
|