Add 6 VM/bytecode debugging and build tools
OCaml server commands: - vm-trace: step-by-step bytecode execution trace (opcode, stack, depth) - bytecode-inspect: disassemble compiled function (opcodes, constants, arity) - deps-check: strict symbol resolution (resolved vs unresolved symbols) - prim-check: verify CALL_PRIM opcodes match real primitives Scripts: - hosts/ocaml/browser/test_boot.sh: WASM boot test in Node.js - scripts/sx-build-all.sh: full pipeline (OCaml + JS + tests) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1078,6 +1078,122 @@ let rec dispatch env cmd =
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
(* ---- Debugging / introspection commands ---- *)
|
||||
|
||||
| List [Symbol "vm-trace"; String src] ->
|
||||
(* Compile and trace-execute an SX expression, returning step-by-step
|
||||
trace entries with opcode names, stack snapshots, and frame depth. *)
|
||||
(try
|
||||
let result = Sx_vm.trace_run src env.bindings in
|
||||
send_ok_value result
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "bytecode-inspect"; String name] ->
|
||||
(* Disassemble a named function's compiled bytecode.
|
||||
Returns a dict with arity, num_locals, constants, bytecode instructions. *)
|
||||
(try
|
||||
let v = try Hashtbl.find env.bindings name
|
||||
with Not_found -> raise (Eval_error ("bytecode-inspect: not found: " ^ name)) in
|
||||
let code = match v with
|
||||
| Lambda l ->
|
||||
(match l.l_compiled with
|
||||
| Some cl when not (Sx_vm.is_jit_failed cl) -> cl.vm_code
|
||||
| _ -> raise (Eval_error ("bytecode-inspect: " ^ name ^ " has no compiled bytecode")))
|
||||
| VmClosure cl -> cl.vm_code
|
||||
| NativeFn _ -> raise (Eval_error ("bytecode-inspect: " ^ name ^ " is a native function"))
|
||||
| _ -> raise (Eval_error ("bytecode-inspect: " ^ name ^ " is not a function"))
|
||||
in
|
||||
send_ok_value (Sx_vm.disassemble code)
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "deps-check"; String src] ->
|
||||
(* Walk parsed AST to find all symbol references and check resolution. *)
|
||||
(try
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let special_forms = [
|
||||
"if"; "when"; "cond"; "case"; "let"; "let*"; "lambda"; "fn";
|
||||
"define"; "defcomp"; "defisland"; "defmacro";
|
||||
"quote"; "quasiquote"; "begin"; "do"; "set!"; "->"; "and"; "or"
|
||||
] in
|
||||
let seen = Hashtbl.create 64 in
|
||||
let rec walk = function
|
||||
| Symbol s ->
|
||||
if not (Hashtbl.mem seen s) then Hashtbl.replace seen s true
|
||||
| List items | ListRef { contents = items } ->
|
||||
List.iter walk items
|
||||
| Dict d -> Hashtbl.iter (fun _ v -> walk v) d
|
||||
| _ -> ()
|
||||
in
|
||||
List.iter walk exprs;
|
||||
let resolved = ref [] in
|
||||
let unresolved = ref [] in
|
||||
Hashtbl.iter (fun name _ ->
|
||||
if List.mem name special_forms
|
||||
|| Hashtbl.mem env.bindings name
|
||||
|| Hashtbl.mem Sx_primitives.primitives name
|
||||
|| name = "true" || name = "false" || name = "nil"
|
||||
then resolved := String name :: !resolved
|
||||
else unresolved := String name :: !unresolved
|
||||
) seen;
|
||||
let result = Hashtbl.create 2 in
|
||||
Hashtbl.replace result "resolved" (List !resolved);
|
||||
Hashtbl.replace result "unresolved" (List !unresolved);
|
||||
send_ok_value (Dict result)
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "prim-check"; String name] ->
|
||||
(* Scan a compiled function's bytecode for CALL_PRIM opcodes
|
||||
and verify each referenced primitive exists. *)
|
||||
(try
|
||||
let v = try Hashtbl.find env.bindings name
|
||||
with Not_found -> raise (Eval_error ("prim-check: not found: " ^ name)) in
|
||||
let code = match v with
|
||||
| Lambda l ->
|
||||
(match l.l_compiled with
|
||||
| Some cl when not (Sx_vm.is_jit_failed cl) -> cl.vm_code
|
||||
| _ -> raise (Eval_error ("prim-check: " ^ name ^ " has no compiled bytecode")))
|
||||
| VmClosure cl -> cl.vm_code
|
||||
| _ -> raise (Eval_error ("prim-check: " ^ name ^ " is not a compiled function"))
|
||||
in
|
||||
let bc = code.vc_bytecode in
|
||||
let consts = code.vc_constants in
|
||||
let len = Array.length bc in
|
||||
let valid = ref [] in
|
||||
let invalid = ref [] in
|
||||
let ip = ref 0 in
|
||||
while !ip < len do
|
||||
let op = bc.(!ip) in
|
||||
ip := !ip + 1;
|
||||
if op = 52 (* OP_CALL_PRIM *) && !ip + 2 < len then begin
|
||||
let lo = bc.(!ip) in let hi = bc.(!ip + 1) in
|
||||
let idx = lo lor (hi lsl 8) in
|
||||
let _argc = bc.(!ip + 2) in
|
||||
ip := !ip + 3;
|
||||
let prim_name = if idx < Array.length consts
|
||||
then (match consts.(idx) with String s -> s | _ -> "?") else "?" in
|
||||
if Hashtbl.mem Sx_primitives.primitives prim_name
|
||||
then valid := String prim_name :: !valid
|
||||
else invalid := String prim_name :: !invalid
|
||||
end else begin
|
||||
(* Skip operand bytes for other opcodes *)
|
||||
let skip = Sx_vm.opcode_operand_size op in
|
||||
ip := !ip + skip
|
||||
end
|
||||
done;
|
||||
let result = Hashtbl.create 2 in
|
||||
Hashtbl.replace result "valid" (List !valid);
|
||||
Hashtbl.replace result "invalid" (List !invalid);
|
||||
send_ok_value (Dict result)
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "reset"] ->
|
||||
(* Clear all bindings and rebuild env.
|
||||
We can't reassign env, so clear and re-populate. *)
|
||||
|
||||
30
hosts/ocaml/browser/test_boot.sh
Executable file
30
hosts/ocaml/browser/test_boot.sh
Executable file
@@ -0,0 +1,30 @@
|
||||
#!/bin/bash
|
||||
# Test WASM boot in Node.js — verifies the compiled sx_browser.bc.js loads
|
||||
# without errors by providing minimal DOM/browser API stubs.
|
||||
set -euo pipefail
|
||||
|
||||
cd "$(dirname "$0")/../../.."
|
||||
|
||||
node -e "
|
||||
global.window = global;
|
||||
global.document = { createElement: () => ({style:{},setAttribute:()=>{},appendChild:()=>{},children:[]}), createDocumentFragment: () => ({appendChild:()=>{},children:[],childNodes:[]}), head:{appendChild:()=>{}}, body:{appendChild:()=>{}}, querySelector:()=>null, querySelectorAll:()=>[], createTextNode:(s)=>({textContent:s}), addEventListener:()=>{}, createComment:(s)=>({textContent:s||''}) };
|
||||
global.localStorage = {getItem:()=>null,setItem:()=>{},removeItem:()=>{}};
|
||||
global.CustomEvent = class { constructor(n,o){this.type=n;this.detail=(o||{}).detail||{}} };
|
||||
global.MutationObserver = class { observe(){} disconnect(){} };
|
||||
global.requestIdleCallback = (fn) => setTimeout(fn,0);
|
||||
global.matchMedia = () => ({matches:false});
|
||||
global.navigator = {serviceWorker:{register:()=>Promise.resolve()}};
|
||||
global.location = {href:'',pathname:'/',hostname:'localhost'};
|
||||
global.history = {pushState:()=>{},replaceState:()=>{}};
|
||||
global.fetch = () => Promise.resolve({ok:true,text:()=>Promise.resolve('')});
|
||||
global.setTimeout = setTimeout;
|
||||
global.clearTimeout = clearTimeout;
|
||||
try {
|
||||
require('./shared/static/wasm/sx_browser.bc.js');
|
||||
console.log('WASM boot: OK');
|
||||
} catch(e) {
|
||||
console.error('WASM boot: FAILED');
|
||||
console.error(e.message);
|
||||
process.exit(1);
|
||||
}
|
||||
"
|
||||
@@ -611,3 +611,301 @@ let jit_compile_lambda (l : lambda) globals =
|
||||
(* Wire up forward references *)
|
||||
let () = jit_compile_ref := jit_compile_lambda
|
||||
let () = _vm_call_closure_ref := (fun cl args -> call_closure cl args cl.vm_env_ref)
|
||||
|
||||
|
||||
(** {1 Debugging / introspection} *)
|
||||
|
||||
(** Map opcode integer to human-readable name. *)
|
||||
let opcode_name = function
|
||||
| 1 -> "CONST" | 2 -> "NIL" | 3 -> "TRUE" | 4 -> "FALSE"
|
||||
| 5 -> "POP" | 6 -> "DUP"
|
||||
| 16 -> "LOCAL_GET" | 17 -> "LOCAL_SET"
|
||||
| 18 -> "UPVALUE_GET" | 19 -> "UPVALUE_SET"
|
||||
| 20 -> "GLOBAL_GET" | 21 -> "GLOBAL_SET"
|
||||
| 32 -> "JUMP" | 33 -> "JUMP_IF_FALSE" | 34 -> "JUMP_IF_TRUE"
|
||||
| 48 -> "CALL" | 49 -> "TAIL_CALL" | 50 -> "RETURN"
|
||||
| 51 -> "CLOSURE" | 52 -> "CALL_PRIM"
|
||||
| 64 -> "LIST" | 65 -> "DICT"
|
||||
| 128 -> "DEFINE"
|
||||
| 144 -> "STR_CONCAT"
|
||||
| 160 -> "ADD" | 161 -> "SUB" | 162 -> "MUL" | 163 -> "DIV"
|
||||
| 164 -> "EQ" | 165 -> "LT" | 166 -> "GT" | 167 -> "NOT"
|
||||
| 168 -> "LEN" | 169 -> "FIRST" | 170 -> "REST" | 171 -> "NTH"
|
||||
| 172 -> "CONS" | 173 -> "NEG" | 174 -> "INC" | 175 -> "DEC"
|
||||
| n -> Printf.sprintf "UNKNOWN_%d" n
|
||||
|
||||
(** Number of extra operand bytes consumed by each opcode.
|
||||
Returns (format, total_bytes) where format describes the operand types. *)
|
||||
let opcode_operand_size = function
|
||||
| 1 (* CONST *) | 20 (* GLOBAL_GET *) | 21 (* GLOBAL_SET *)
|
||||
| 64 (* LIST *) | 65 (* DICT *) | 128 (* DEFINE *) -> 2 (* u16 *)
|
||||
| 16 (* LOCAL_GET *) | 17 (* LOCAL_SET *)
|
||||
| 18 (* UPVALUE_GET *) | 19 (* UPVALUE_SET *)
|
||||
| 48 (* CALL *) | 49 (* TAIL_CALL *)
|
||||
| 144 (* STR_CONCAT *) -> 1 (* u8 *)
|
||||
| 32 (* JUMP *) | 33 (* JUMP_IF_FALSE *) | 34 (* JUMP_IF_TRUE *) -> 2 (* i16 *)
|
||||
| 51 (* CLOSURE *) -> 2 (* u16 for constant index; upvalue descriptors follow dynamically *)
|
||||
| 52 (* CALL_PRIM *) -> 3 (* u16 + u8 *)
|
||||
| _ -> 0 (* no operand *)
|
||||
|
||||
(** Trace a single execution — compile + run, collecting trace entries.
|
||||
Each entry is a dict with :opcode, :stack, :depth. *)
|
||||
let trace_run src globals =
|
||||
(* Compile *)
|
||||
let compile_fn = try Hashtbl.find globals "compile"
|
||||
with Not_found -> raise (Eval_error "trace: compiler not loaded") in
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with [e] -> e | _ -> List (Symbol "do" :: exprs) in
|
||||
let quoted = List [Symbol "quote"; expr] in
|
||||
let code_val = Sx_ref.eval_expr (List [compile_fn; quoted]) (Env (make_env ())) in
|
||||
let code = code_from_value code_val in
|
||||
let cl = { vm_code = code; vm_upvalues = [||]; vm_name = Some "trace";
|
||||
vm_env_ref = globals; vm_closure_env = None } in
|
||||
let vm = create globals in
|
||||
let frame0 = { closure = cl; ip = 0; base = 0; local_cells = Hashtbl.create 4 } in
|
||||
for _ = 0 to code.vc_locals - 1 do push vm Nil done;
|
||||
vm.frames <- [frame0];
|
||||
(* Run with tracing *)
|
||||
let trace = ref [] in
|
||||
let max_steps = 10000 in
|
||||
let steps = ref 0 in
|
||||
(try
|
||||
while vm.frames <> [] && !steps < max_steps do
|
||||
match vm.frames with
|
||||
| [] -> ()
|
||||
| frame :: _ ->
|
||||
let bc = frame.closure.vm_code.vc_bytecode in
|
||||
if frame.ip >= Array.length bc then
|
||||
vm.frames <- []
|
||||
else begin
|
||||
let op = bc.(frame.ip) in
|
||||
(* Snapshot stack top 5 *)
|
||||
let stack_snap = List.init (min 5 vm.sp) (fun i ->
|
||||
let v = vm.stack.(vm.sp - 1 - i) in
|
||||
String (Sx_types.inspect v)) in
|
||||
let entry = Hashtbl.create 4 in
|
||||
Hashtbl.replace entry "opcode" (String (opcode_name op));
|
||||
Hashtbl.replace entry "stack" (List stack_snap);
|
||||
Hashtbl.replace entry "depth" (Number (float_of_int (List.length vm.frames)));
|
||||
trace := Dict entry :: !trace;
|
||||
incr steps;
|
||||
(* Execute one step — use the main run loop for 1 step.
|
||||
We do this by saving the state and running the original dispatch. *)
|
||||
let saved_ip = frame.ip in
|
||||
frame.ip <- frame.ip + 1;
|
||||
let rest_frames = List.tl vm.frames in
|
||||
(try match op with
|
||||
| 1 -> let idx = read_u16 frame in push vm frame.closure.vm_code.vc_constants.(idx)
|
||||
| 2 -> push vm Nil
|
||||
| 3 -> push vm (Bool true)
|
||||
| 4 -> push vm (Bool false)
|
||||
| 5 -> ignore (pop vm)
|
||||
| 6 -> push vm (peek vm)
|
||||
| 16 -> let slot = read_u8 frame in
|
||||
let v = match Hashtbl.find_opt frame.local_cells slot with
|
||||
| Some cell -> cell.uv_value
|
||||
| None -> vm.stack.(frame.base + slot) in
|
||||
push vm v
|
||||
| 17 -> let slot = read_u8 frame in let v = peek vm in
|
||||
(match Hashtbl.find_opt frame.local_cells slot with
|
||||
| Some cell -> cell.uv_value <- v
|
||||
| None -> vm.stack.(frame.base + slot) <- v)
|
||||
| 18 -> let idx = read_u8 frame in
|
||||
push vm frame.closure.vm_upvalues.(idx).uv_value
|
||||
| 19 -> let idx = read_u8 frame in
|
||||
frame.closure.vm_upvalues.(idx).uv_value <- peek vm
|
||||
| 20 -> let idx = read_u16 frame in
|
||||
let name = match frame.closure.vm_code.vc_constants.(idx) with String s -> s | _ -> "" in
|
||||
let v = try Hashtbl.find vm.globals name with Not_found ->
|
||||
try Sx_primitives.get_primitive name with _ ->
|
||||
raise (Eval_error ("VM undefined: " ^ name)) in
|
||||
push vm v
|
||||
| 21 -> let idx = read_u16 frame in
|
||||
let name = match frame.closure.vm_code.vc_constants.(idx) with String s -> s | _ -> "" in
|
||||
Hashtbl.replace vm.globals name (peek vm)
|
||||
| 32 -> let offset = read_i16 frame in frame.ip <- frame.ip + offset
|
||||
| 33 -> let offset = read_i16 frame in let v = pop vm in
|
||||
if not (sx_truthy v) then frame.ip <- frame.ip + offset
|
||||
| 34 -> let offset = read_i16 frame in let v = pop vm in
|
||||
if sx_truthy v then frame.ip <- frame.ip + offset
|
||||
| 48 -> let argc = read_u8 frame in
|
||||
let args = Array.init argc (fun _ -> pop vm) in
|
||||
let f = pop vm in
|
||||
vm_call vm f (List.rev (Array.to_list args))
|
||||
| 49 -> let argc = read_u8 frame in
|
||||
let args = Array.init argc (fun _ -> pop vm) in
|
||||
let f = pop vm in
|
||||
vm.frames <- rest_frames; vm.sp <- frame.base;
|
||||
vm_call vm f (List.rev (Array.to_list args))
|
||||
| 50 -> let result = pop vm in
|
||||
vm.frames <- rest_frames; vm.sp <- frame.base; push vm result
|
||||
| 51 -> (* CLOSURE — skip for trace, just advance past upvalue descriptors *)
|
||||
let idx = read_u16 frame in
|
||||
let code_val2 = frame.closure.vm_code.vc_constants.(idx) in
|
||||
let uv_count = match code_val2 with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| _ -> 0 in
|
||||
let upvalues = Array.init uv_count (fun _ ->
|
||||
let is_local = read_u8 frame in
|
||||
let index = read_u8 frame in
|
||||
if is_local = 1 then begin
|
||||
let cell = match Hashtbl.find_opt frame.local_cells index with
|
||||
| Some existing -> existing
|
||||
| None ->
|
||||
let c = { uv_value = vm.stack.(frame.base + index) } in
|
||||
Hashtbl.replace frame.local_cells index c; c in
|
||||
cell
|
||||
end else frame.closure.vm_upvalues.(index)
|
||||
) in
|
||||
let inner_code = code_from_value code_val2 in
|
||||
let c = { vm_code = inner_code; vm_upvalues = upvalues; vm_name = None;
|
||||
vm_env_ref = vm.globals; vm_closure_env = None } in
|
||||
push vm (VmClosure c)
|
||||
| 52 -> let idx = read_u16 frame in let argc = read_u8 frame in
|
||||
let name = match frame.closure.vm_code.vc_constants.(idx) with String s -> s | _ -> "" in
|
||||
let args = List.init argc (fun _ -> pop vm) |> List.rev in
|
||||
let fn_val = try Sx_primitives.get_primitive name with _ ->
|
||||
try Hashtbl.find vm.globals name with Not_found ->
|
||||
raise (Eval_error ("VM: unknown primitive " ^ name)) in
|
||||
(match fn_val with NativeFn (_, fn) -> push vm (fn args) | _ -> push vm Nil)
|
||||
| 64 -> let count = read_u16 frame in
|
||||
let items = List.init count (fun _ -> pop vm) |> List.rev in
|
||||
push vm (List items)
|
||||
| 65 -> let count = read_u16 frame in
|
||||
let d = Hashtbl.create count in
|
||||
for _ = 1 to count do let v = pop vm in let k = pop vm in
|
||||
let key = match k with String s -> s | Keyword s -> s | _ -> Sx_runtime.value_to_str k in
|
||||
Hashtbl.replace d key v done;
|
||||
push vm (Dict d)
|
||||
| 128 -> let idx = read_u16 frame in
|
||||
let name = match frame.closure.vm_code.vc_constants.(idx) with String s -> s | _ -> "" in
|
||||
Hashtbl.replace vm.globals name (peek vm)
|
||||
| 144 -> let count = read_u8 frame in
|
||||
let parts = List.init count (fun _ -> pop vm) |> List.rev in
|
||||
push vm (String (String.concat "" (List.map Sx_runtime.value_to_str parts)))
|
||||
| 160 -> let b = pop vm and a = pop vm in
|
||||
push vm (match a, b with Number x, Number y -> Number (x +. y) | _ -> Nil)
|
||||
| 161 -> let b = pop vm and a = pop vm in
|
||||
push vm (match a, b with Number x, Number y -> Number (x -. y) | _ -> Nil)
|
||||
| 162 -> let b = pop vm and a = pop vm in
|
||||
push vm (match a, b with Number x, Number y -> Number (x *. y) | _ -> Nil)
|
||||
| 163 -> let b = pop vm and a = pop vm in
|
||||
push vm (match a, b with Number x, Number y -> Number (x /. y) | _ -> Nil)
|
||||
| 164 -> let b = pop vm and a = pop vm in push vm (Bool (a = b))
|
||||
| 165 -> let b = pop vm and a = pop vm in
|
||||
push vm (match a, b with Number x, Number y -> Bool (x < y) | _ -> Bool false)
|
||||
| 166 -> let b = pop vm and a = pop vm in
|
||||
push vm (match a, b with Number x, Number y -> Bool (x > y) | _ -> Bool false)
|
||||
| 167 -> let v = pop vm in push vm (Bool (not (sx_truthy v)))
|
||||
| 168 -> let v = pop vm in
|
||||
push vm (match v with
|
||||
| List l | ListRef { contents = l } -> Number (float_of_int (List.length l))
|
||||
| String s -> Number (float_of_int (String.length s))
|
||||
| _ -> Number 0.0)
|
||||
| 169 -> let v = pop vm in
|
||||
push vm (match v with List (x :: _) | ListRef { contents = x :: _ } -> x | _ -> Nil)
|
||||
| 170 -> let v = pop vm in
|
||||
push vm (match v with
|
||||
| List (_ :: xs) | ListRef { contents = _ :: xs } -> List xs | _ -> List [])
|
||||
| 171 -> let n = pop vm and coll = pop vm in
|
||||
push vm (match coll, n with
|
||||
| (List l | ListRef { contents = l }), Number f ->
|
||||
(try List.nth l (int_of_float f) with _ -> Nil) | _ -> Nil)
|
||||
| 172 -> let coll = pop vm and x = pop vm in
|
||||
push vm (match coll with List l -> List (x :: l) | _ -> List [x])
|
||||
| 173 -> let v = pop vm in
|
||||
push vm (match v with Number x -> Number (-.x) | _ -> Nil)
|
||||
| 174 -> let v = pop vm in
|
||||
push vm (match v with Number x -> Number (x +. 1.0) | _ -> Nil)
|
||||
| 175 -> let v = pop vm in
|
||||
push vm (match v with Number x -> Number (x -. 1.0) | _ -> Nil)
|
||||
| _ -> ()
|
||||
with e ->
|
||||
let _ = e in
|
||||
ignore saved_ip;
|
||||
(* On error during trace, just stop *)
|
||||
vm.frames <- [])
|
||||
end
|
||||
done
|
||||
with _ -> ());
|
||||
List (List.rev !trace)
|
||||
|
||||
(** Disassemble a vm_code into a list of instruction dicts. *)
|
||||
let disassemble (code : vm_code) =
|
||||
let bc = code.vc_bytecode in
|
||||
let len = Array.length bc in
|
||||
let consts = code.vc_constants in
|
||||
let instrs = ref [] in
|
||||
let ip = ref 0 in
|
||||
while !ip < len do
|
||||
let offset = !ip in
|
||||
let op = bc.(!ip) in
|
||||
ip := !ip + 1;
|
||||
let name = opcode_name op in
|
||||
let operands = ref [] in
|
||||
(match op with
|
||||
| 1 (* CONST *) | 20 (* GLOBAL_GET *) | 21 (* GLOBAL_SET *)
|
||||
| 128 (* DEFINE *) ->
|
||||
if !ip + 1 < len then begin
|
||||
let lo = bc.(!ip) in let hi = bc.(!ip + 1) in
|
||||
let idx = lo lor (hi lsl 8) in
|
||||
ip := !ip + 2;
|
||||
let const_str = if idx < Array.length consts
|
||||
then Sx_types.inspect consts.(idx) else "?" in
|
||||
operands := [Number (float_of_int idx); String const_str]
|
||||
end
|
||||
| 64 (* LIST *) | 65 (* DICT *) | 51 (* CLOSURE *) ->
|
||||
if !ip + 1 < len then begin
|
||||
let lo = bc.(!ip) in let hi = bc.(!ip + 1) in
|
||||
let idx = lo lor (hi lsl 8) in
|
||||
ip := !ip + 2;
|
||||
operands := [Number (float_of_int idx)];
|
||||
(* For CLOSURE, skip upvalue descriptors *)
|
||||
if op = 51 && idx < Array.length consts then begin
|
||||
let uv_count = match consts.(idx) with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| _ -> 0 in
|
||||
ip := !ip + uv_count * 2
|
||||
end
|
||||
end
|
||||
| 16 (* LOCAL_GET *) | 17 (* LOCAL_SET *)
|
||||
| 18 (* UPVALUE_GET *) | 19 (* UPVALUE_SET *)
|
||||
| 48 (* CALL *) | 49 (* TAIL_CALL *)
|
||||
| 144 (* STR_CONCAT *) ->
|
||||
if !ip < len then begin
|
||||
let v = bc.(!ip) in ip := !ip + 1;
|
||||
operands := [Number (float_of_int v)]
|
||||
end
|
||||
| 32 (* JUMP *) | 33 (* JUMP_IF_FALSE *) | 34 (* JUMP_IF_TRUE *) ->
|
||||
if !ip + 1 < len then begin
|
||||
let lo = bc.(!ip) in let hi = bc.(!ip + 1) in
|
||||
let raw = lo lor (hi lsl 8) in
|
||||
let signed = if raw >= 32768 then raw - 65536 else raw in
|
||||
ip := !ip + 2;
|
||||
operands := [Number (float_of_int signed)]
|
||||
end
|
||||
| 52 (* CALL_PRIM *) ->
|
||||
if !ip + 2 < len then begin
|
||||
let lo = bc.(!ip) in let hi = bc.(!ip + 1) in
|
||||
let idx = lo lor (hi lsl 8) in
|
||||
let argc = bc.(!ip + 2) in
|
||||
ip := !ip + 3;
|
||||
let prim_name = if idx < Array.length consts
|
||||
then (match consts.(idx) with String s -> s | _ -> "?") else "?" in
|
||||
operands := [Number (float_of_int idx); String prim_name; Number (float_of_int argc)]
|
||||
end
|
||||
| _ -> ());
|
||||
let entry = Hashtbl.create 4 in
|
||||
Hashtbl.replace entry "offset" (Number (float_of_int offset));
|
||||
Hashtbl.replace entry "opcode" (String name);
|
||||
Hashtbl.replace entry "operands" (List !operands);
|
||||
instrs := Dict entry :: !instrs
|
||||
done;
|
||||
let result = Hashtbl.create 4 in
|
||||
Hashtbl.replace result "arity" (Number (float_of_int code.vc_arity));
|
||||
Hashtbl.replace result "num_locals" (Number (float_of_int code.vc_locals));
|
||||
Hashtbl.replace result "constants" (List (Array.to_list (Array.map (fun v -> String (Sx_types.inspect v)) consts)));
|
||||
Hashtbl.replace result "bytecode" (List (List.rev !instrs));
|
||||
Dict result
|
||||
|
||||
15
scripts/sx-build-all.sh
Executable file
15
scripts/sx-build-all.sh
Executable file
@@ -0,0 +1,15 @@
|
||||
#!/bin/bash
|
||||
# Full SX build pipeline — OCaml + JS browser + JS test + JS tests.
|
||||
set -euo pipefail
|
||||
|
||||
cd "$(dirname "$0")/.."
|
||||
|
||||
echo "=== OCaml build ==="
|
||||
(cd hosts/ocaml && eval $(opam env 2>/dev/null) && dune build) || { echo "FAIL: OCaml build"; exit 1; }
|
||||
echo "=== JS browser build ==="
|
||||
python3 hosts/javascript/cli.py --output shared/static/scripts/sx-browser.js || { echo "FAIL: JS build"; exit 1; }
|
||||
echo "=== JS test build ==="
|
||||
python3 hosts/javascript/cli.py --extensions continuations --spec-modules types --output shared/static/scripts/sx-full-test.js || { echo "FAIL: test build"; exit 1; }
|
||||
echo "=== JS tests ==="
|
||||
node hosts/javascript/run_tests.js --full 2>&1 | tail -3 || { echo "FAIL: JS tests"; exit 1; }
|
||||
echo "=== All OK ==="
|
||||
Reference in New Issue
Block a user