Merge loops/erlang into architecture: Phases 7-10 (hot reload, FFI BIFs, BIF registry, VM opcode extension + erlang_ext); fixes cyclic-env identity hang
# Conflicts: # hosts/ocaml/bin/run_tests.ml # plans/sx-vm-opcode-extension.md
This commit is contained in:
@@ -1599,6 +1599,213 @@ let run_foundation_tests () =
|
||||
Printf.printf " FAIL: invocation_count: %s\n"
|
||||
(match other with Some n -> string_of_int n | None -> "None"));
|
||||
|
||||
Printf.printf "\nSuite: extensions/erlang_ext (Phase 9h)\n";
|
||||
(* Register the Erlang opcode namespace. Disjoint id range (200-217)
|
||||
from test_ext (220/221) so they coexist. *)
|
||||
Erlang_ext.register ();
|
||||
|
||||
(match prim [String "erlang.OP_PATTERN_TUPLE"] with
|
||||
| Integer 222 ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: extension-opcode-id erlang.OP_PATTERN_TUPLE = 222\n"
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: erlang.OP_PATTERN_TUPLE: got %s\n"
|
||||
(Sx_types.inspect other));
|
||||
|
||||
(match prim [String "erlang.OP_BIF_IS_TUPLE"] with
|
||||
| Integer 239 ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: extension-opcode-id erlang.OP_BIF_IS_TUPLE = 239\n"
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: erlang.OP_BIF_IS_TUPLE: got %s\n"
|
||||
(Sx_types.inspect other));
|
||||
|
||||
(match prim [String "erlang.OP_NONEXISTENT"] with
|
||||
| Nil ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: unknown erlang opcode -> nil\n"
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: unknown erlang opcode: got %s\n"
|
||||
(Sx_types.inspect other));
|
||||
|
||||
(* 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));
|
||||
|
||||
(* More real handlers (Phase 10b batch): build a list/tuple constant
|
||||
and exercise HD/TL/TUPLE_SIZE/IS_* end-to-end through the VM. *)
|
||||
(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 er_tuple es = mk_dict [("tag", Sx_types.String "tuple");
|
||||
("elements", Sx_types.List es)] in
|
||||
let er_atom nm = mk_dict [("tag", Sx_types.String "atom");
|
||||
("name", Sx_types.String nm)] in
|
||||
let lst3 = er_cons (Sx_types.Integer 7)
|
||||
(er_cons (Sx_types.Integer 8)
|
||||
(er_cons (Sx_types.Integer 9) er_nil)) in
|
||||
let tup3 = er_tuple [Sx_types.Integer 1; Sx_types.Integer 2;
|
||||
Sx_types.Integer 3] in
|
||||
let run consts bc =
|
||||
let code = ({
|
||||
vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
|
||||
vc_bytecode = bc; vc_constants = consts;
|
||||
vc_bytecode_list = None; vc_constants_list = None;
|
||||
} : Sx_types.vm_code) in
|
||||
Sx_vm.execute_module code (Hashtbl.create 1) in
|
||||
let nm = function
|
||||
| Sx_types.Dict d ->
|
||||
(match Hashtbl.find_opt d "name" with
|
||||
| Some (Sx_types.String s) -> s | _ -> "?")
|
||||
| _ -> "?" in
|
||||
let check label want got =
|
||||
if got = want then begin
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: %s\n" label
|
||||
end else begin
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: %s: got %s\n" label (Sx_types.inspect got)
|
||||
end in
|
||||
(* HD [7,8,9] -> 7 *)
|
||||
check "OP_BIF_HD [7,8,9] -> 7" (Sx_types.Integer 7)
|
||||
(run [| lst3 |] [| 1;0;0; 231; 50 |]);
|
||||
(* TL [7,8,9] -> [8,9], check its HD = 8 *)
|
||||
check "OP_BIF_TL then HD -> 8" (Sx_types.Integer 8)
|
||||
(run [| lst3 |] [| 1;0;0; 232; 231; 50 |]);
|
||||
(* TUPLE_SIZE {1,2,3} -> 3 *)
|
||||
check "OP_BIF_TUPLE_SIZE {1,2,3} -> 3" (Sx_types.Integer 3)
|
||||
(run [| tup3 |] [| 1;0;0; 234; 50 |]);
|
||||
(* IS_INTEGER 42 -> true ; IS_INTEGER [..] -> false *)
|
||||
(match run [| Sx_types.Integer 42 |] [| 1;0;0; 236; 50 |] with
|
||||
| v when nm v = "true" ->
|
||||
incr pass_count; Printf.printf " PASS: OP_BIF_IS_INTEGER 42 -> true\n"
|
||||
| v -> incr fail_count;
|
||||
Printf.printf " FAIL: IS_INTEGER 42: got %s\n" (Sx_types.inspect v));
|
||||
(match run [| lst3 |] [| 1;0;0; 236; 50 |] with
|
||||
| v when nm v = "false" ->
|
||||
incr pass_count; Printf.printf " PASS: OP_BIF_IS_INTEGER list -> false\n"
|
||||
| v -> incr fail_count;
|
||||
Printf.printf " FAIL: IS_INTEGER list: got %s\n" (Sx_types.inspect v));
|
||||
(* IS_ATOM atom -> true ; IS_LIST nil -> true ; IS_TUPLE tuple -> true *)
|
||||
(match run [| er_atom "ok" |] [| 1;0;0; 237; 50 |] with
|
||||
| v when nm v = "true" ->
|
||||
incr pass_count; Printf.printf " PASS: OP_BIF_IS_ATOM ok -> true\n"
|
||||
| v -> incr fail_count;
|
||||
Printf.printf " FAIL: IS_ATOM: got %s\n" (Sx_types.inspect v));
|
||||
(match run [| er_nil |] [| 1;0;0; 238; 50 |] with
|
||||
| v when nm v = "true" ->
|
||||
incr pass_count; Printf.printf " PASS: OP_BIF_IS_LIST nil -> true\n"
|
||||
| v -> incr fail_count;
|
||||
Printf.printf " FAIL: IS_LIST nil: got %s\n" (Sx_types.inspect v));
|
||||
(match run [| tup3 |] [| 1;0;0; 239; 50 |] with
|
||||
| v when nm v = "true" ->
|
||||
incr pass_count; Printf.printf " PASS: OP_BIF_IS_TUPLE {..} -> true\n"
|
||||
| v -> incr fail_count;
|
||||
Printf.printf " FAIL: IS_TUPLE: got %s\n" (Sx_types.inspect v));
|
||||
(match run [| tup3 |] [| 1;0;0; 238; 50 |] with
|
||||
| v when nm v = "false" ->
|
||||
incr pass_count; Printf.printf " PASS: OP_BIF_IS_LIST tuple -> false\n"
|
||||
| v -> incr fail_count;
|
||||
Printf.printf " FAIL: IS_LIST tuple: got %s\n" (Sx_types.inspect v));
|
||||
(* ELEMENT: element(2, {1,2,3}) -> 2. Calling convention: push
|
||||
Index then Tuple; opcode pops Tuple (TOS) then Index. *)
|
||||
check "OP_BIF_ELEMENT element(2,{1,2,3}) -> 2" (Sx_types.Integer 2)
|
||||
(run [| Sx_types.Integer 2; tup3 |] [| 1;0;0; 1;1;0; 233; 50 |]);
|
||||
check "OP_BIF_ELEMENT element(1,{1,2,3}) -> 1" (Sx_types.Integer 1)
|
||||
(run [| Sx_types.Integer 1; tup3 |] [| 1;0;0; 1;1;0; 233; 50 |]);
|
||||
(* ELEMENT out of range raises *)
|
||||
(let raised =
|
||||
(try ignore (run [| Sx_types.Integer 9; tup3 |]
|
||||
[| 1;0;0; 1;1;0; 233; 50 |]); false
|
||||
with Sx_types.Eval_error _ -> true) in
|
||||
if raised then begin
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: OP_BIF_ELEMENT out-of-range raises\n"
|
||||
end else begin
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: OP_BIF_ELEMENT out-of-range should raise\n"
|
||||
end);
|
||||
(* LISTS_REVERSE [7,8,9] -> [9,8,7]; verify HD = 9 then HD of TL = 8 *)
|
||||
check "OP_BIF_LISTS_REVERSE then HD -> 9" (Sx_types.Integer 9)
|
||||
(run [| lst3 |] [| 1;0;0; 235; 231; 50 |]);
|
||||
check "OP_BIF_LISTS_REVERSE then TL,HD -> 8" (Sx_types.Integer 8)
|
||||
(run [| lst3 |] [| 1;0;0; 235; 232; 231; 50 |]);
|
||||
(* reverse preserves length *)
|
||||
check "OP_BIF_LISTS_REVERSE then LENGTH -> 3" (Sx_types.Integer 3)
|
||||
(run [| lst3 |] [| 1;0;0; 235; 230; 50 |]));
|
||||
|
||||
(* A still-stubbed opcode (222 = erlang.OP_PATTERN_TUPLE) 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 [| 222; 50 |]) globals);
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: erlang.OP_PATTERN_TUPLE dispatch should have raised\n"
|
||||
with
|
||||
| Sx_types.Eval_error msg
|
||||
when (let needle = "not yet wired" in
|
||||
let nl = String.length needle and ml = String.length msg in
|
||||
let rec scan i =
|
||||
if i + nl > ml then false
|
||||
else if String.sub msg i nl = needle then true
|
||||
else scan (i + 1)
|
||||
in scan 0) ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: erlang opcode dispatch raises not-wired error\n"
|
||||
| exn ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: unexpected exn: %s\n" (Printexc.to_string exn));
|
||||
|
||||
(match Erlang_ext.dispatch_count () with
|
||||
| Some n when n >= 1 ->
|
||||
incr pass_count;
|
||||
Printf.printf " PASS: erlang_ext state recorded %d dispatch(es)\n" n
|
||||
| other ->
|
||||
incr fail_count;
|
||||
Printf.printf " FAIL: dispatch_count: %s\n"
|
||||
(match other with Some n -> string_of_int n | None -> "None"));
|
||||
|
||||
Printf.printf "\nSuite: jit extension-opcode awareness\n";
|
||||
let scan = Sx_vm.bytecode_uses_extension_opcodes in
|
||||
let no_consts = [||] in
|
||||
|
||||
Reference in New Issue
Block a user