From 5c7ad01bd1e7b19005494782d500a037fbdc63c5 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 15 May 2026 08:43:45 +0000 Subject: [PATCH] =?UTF-8?q?erlang:=20Phase=2010b=20slice=20=E2=80=94=20rea?= =?UTF-8?q?l=20OP=5FBIF=5FLENGTH=20handler,=20end-to-end=20VM=20proof?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- hosts/ocaml/bin/run_tests.ml | 47 +++++++++++++++++++++--- hosts/ocaml/lib/extensions/erlang_ext.ml | 37 ++++++++++++++++++- 2 files changed, 78 insertions(+), 6 deletions(-) diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 4c3cc5c6..6b7a5460 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -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 diff --git a/hosts/ocaml/lib/extensions/erlang_ext.ml b/hosts/ocaml/lib/extensions/erlang_ext.ml index e620ab6f..0ac74fd7 100644 --- a/hosts/ocaml/lib/extensions/erlang_ext.ml +++ b/hosts/ocaml/lib/extensions/erlang_ext.ml @@ -64,6 +64,41 @@ module M : Sx_vm_extension.EXTENSION = struct (id, nm, (fun (_vm : Sx_vm.vm) (_frame : Sx_vm.frame) -> bump (); not_wired nm)) in + (* Phase 10b vertical slice: one REAL register-machine handler. + erlang.OP_BIF_LENGTH (230) — pops an Erlang list off the VM + stack and pushes its length. Proves the full path works: + extension-opcode-id -> bytecode -> Sx_vm dispatch fallthrough + -> this handler -> correct stack result. The remaining 17 + opcodes still raise not_wired until their handlers + compiler + emission land. Erlang lists are tagged dicts: + nil = {"tag" -> String "nil"} + cons = {"tag" -> String "cons"; "head" -> v; "tail" -> v} *) + let er_tag d = + match Hashtbl.find_opt d "tag" with + | Some (String s) -> s | _ -> "" + in + let op_bif_length = + (230, "erlang.OP_BIF_LENGTH", + (fun (vm : Sx_vm.vm) (_frame : Sx_vm.frame) -> + bump (); + let v = Sx_vm.pop vm in + let rec walk acc node = + match node with + | Dict d -> + (match er_tag d with + | "nil" -> acc + | "cons" -> + (match Hashtbl.find_opt d "tail" with + | Some t -> walk (acc + 1) t + | None -> raise (Eval_error + "erlang.OP_BIF_LENGTH: cons cell without :tail")) + | _ -> raise (Eval_error + "erlang.OP_BIF_LENGTH: not a proper list")) + | _ -> raise (Eval_error + "erlang.OP_BIF_LENGTH: not a proper list") + in + Sx_vm.push vm (Integer (walk 0 v)))) + in [ op 222 "erlang.OP_PATTERN_TUPLE"; op 223 "erlang.OP_PATTERN_LIST"; @@ -73,7 +108,7 @@ module M : Sx_vm_extension.EXTENSION = struct op 227 "erlang.OP_RECEIVE_SCAN"; op 228 "erlang.OP_SPAWN"; op 229 "erlang.OP_SEND"; - op 230 "erlang.OP_BIF_LENGTH"; + op_bif_length; op 231 "erlang.OP_BIF_HD"; op 232 "erlang.OP_BIF_TL"; op 233 "erlang.OP_BIF_ELEMENT";