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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user