erlang: Phase 10b slice — real OP_BIF_LENGTH handler, end-to-end VM proof

This commit is contained in:
2026-05-15 08:43:45 +00:00
parent 33725de03b
commit 5c7ad01bd1
2 changed files with 78 additions and 6 deletions

View File

@@ -1631,14 +1631,51 @@ let run_foundation_tests () =
Printf.printf " FAIL: unknown erlang opcode: got %s\n"
(Sx_types.inspect other));
(* Dispatching an erlang opcode raises the not-wired Eval_error
(bytecode emission is a later phase; SX stub dispatcher is the
working path). 230 = erlang.OP_BIF_LENGTH. *)
(* Phase 10b vertical slice: erlang.OP_BIF_LENGTH (230) is a REAL
handler. Build [CONST 0; OP_BIF_LENGTH; RETURN] with an Erlang
list [1,2,3] in the constant pool; expect Integer 3. Proves the
full path: bytecode -> Sx_vm extension fallthrough -> erlang_ext
handler -> correct stack result. *)
(let mk_dict kvs =
let h = Hashtbl.create 4 in
List.iter (fun (k, v) -> Hashtbl.replace h k v) kvs;
Sx_types.Dict h in
let er_nil = mk_dict [("tag", Sx_types.String "nil")] in
let er_cons hd tl =
mk_dict [("tag", Sx_types.String "cons");
("head", hd); ("tail", tl)] in
let lst = er_cons (Sx_types.Integer 1)
(er_cons (Sx_types.Integer 2)
(er_cons (Sx_types.Integer 3) er_nil)) in
let code = ({
vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
vc_bytecode = [| 1; 0; 0; 230; 50 |];
vc_constants = [| lst |];
vc_bytecode_list = None; vc_constants_list = None;
} : Sx_types.vm_code) in
let globals = Hashtbl.create 1 in
try
match Sx_vm.execute_module code globals with
| Integer 3 ->
incr pass_count;
Printf.printf " PASS: erlang.OP_BIF_LENGTH [1,2,3] -> 3 (real handler, end-to-end)\n"
| other ->
incr fail_count;
Printf.printf " FAIL: OP_BIF_LENGTH result: got %s\n"
(Sx_types.inspect other)
with exn ->
incr fail_count;
Printf.printf " FAIL: OP_BIF_LENGTH raised: %s\n"
(Printexc.to_string exn));
(* A still-stubbed opcode (231 = erlang.OP_BIF_HD) raises the
not-wired Eval_error — confirms the honest-failure path remains
for opcodes whose real handlers haven't landed. *)
(let globals = Hashtbl.create 1 in
try
ignore (Sx_vm.execute_module (make_bc_seq [| 230; 50 |]) globals);
ignore (Sx_vm.execute_module (make_bc_seq [| 231; 50 |]) globals);
incr fail_count;
Printf.printf " FAIL: erlang.OP_BIF_LENGTH dispatch should have raised\n"
Printf.printf " FAIL: erlang.OP_BIF_HD dispatch should have raised\n"
with
| Sx_types.Eval_error msg
when (let needle = "not yet wired" in