diff --git a/src/lib_scoru_wasm/gather_floppies.ml b/src/lib_scoru_wasm/gather_floppies.ml index 81b649e03329315c12cd9bcc1e9b6291b0c6a6b5..de9e41146d4bf67149167d85a7968ec8563d453b 100644 --- a/src/lib_scoru_wasm/gather_floppies.ml +++ b/src/lib_scoru_wasm/gather_floppies.ml @@ -114,7 +114,7 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : type tree = Wasm.tree open Tezos_webassembly_interpreter - module Merklizer = Tree_encoding_decoding.Make (T) + module EncDec = Tree_encoding_decoding.Make (T) (** The tick state of the [Gathering_floppies] instrumentation. *) type state = { @@ -131,11 +131,11 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : PVM. *) } - let boot_sector_merklizer : string Merklizer.t = - Merklizer.(value ["boot-sector"] Data_encoding.string) + let boot_sector_merklizer : string EncDec.t = + EncDec.(value ["boot-sector"] Data_encoding.string) - let state_merklizer : state Merklizer.t = - let open Merklizer in + let state_merklizer : state EncDec.t = + let open EncDec in conv (fun (internal_status, last_input_info, internal_tick, kernel) -> {internal_status; last_input_info; internal_tick; kernel}) @@ -173,7 +173,7 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : It only tries to fetch the current tick (with the same key as the one used in [state_merklizer]. *) let broken_merklizer = - Merklizer.value ["gather-floppies"; "internal-tick"] Data_encoding.n + EncDec.value ["gather-floppies"; "internal-tick"] Data_encoding.n (** [read_state tree] fetches the current state of the PVM from [tree]. *) @@ -182,18 +182,18 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : Lwt.catch (fun () -> (* First, we try to interpret [tree] as a [state]. *) - let+ state = Merklizer.decode state_merklizer tree in + let+ state = EncDec.decode state_merklizer tree in Running state) (fun _exn -> Lwt.catch (fun () -> (* If it fails, it means the PVM may be stuck. *) - let+ current_tick = Merklizer.decode broken_merklizer tree in + let+ current_tick = EncDec.decode broken_merklizer tree in Broken {current_tick}) (fun _exn -> (* In case both previous attempts have failed, it means this is probably the very first tick of the PVM. *) - let+ boot_sector = Merklizer.decode boot_sector_merklizer tree in + let+ boot_sector = EncDec.decode boot_sector_merklizer tree in Halted boot_sector)) (* PROCESS MESSAGES *) @@ -320,14 +320,14 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : let* state = read_state tree in match state with | Broken {current_tick} -> - Merklizer.encode broken_merklizer (Z.succ current_tick) tree + EncDec.encode broken_merklizer (Z.succ current_tick) tree | Halted origination_message -> ( match origination_kernel_loading_step origination_message with - | Some state -> Merklizer.encode state_merklizer state tree + | Some state -> EncDec.encode state_merklizer state tree | None -> (* We could not interpret [origination_message], meaning the PVM is stuck. *) - Merklizer.encode broken_merklizer Z.one tree) + EncDec.encode broken_merklizer Z.one tree) | Running state -> ( let state = increment_ticks state in match state.internal_status with @@ -353,7 +353,7 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : match state.internal_status with | Gathering_floppies _ -> let* state = process_input_step input message state in - Merklizer.encode state_merklizer state tree + EncDec.encode state_merklizer state tree | Not_gathering_floppies -> Wasm.set_input_step input message tree) let get_output = Wasm.get_output @@ -408,9 +408,11 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : module Internal_for_tests = struct let initial_tree_from_boot_sector ~empty_tree boot_sector = match origination_kernel_loading_step boot_sector with - | Some state -> Merklizer.encode state_merklizer state empty_tree + | Some state -> EncDec.encode state_merklizer state empty_tree | None -> raise (Invalid_argument "initial_tree_from_boot_sector: wrong boot sector") end + + let initialize = Wasm.initialize end diff --git a/src/lib_scoru_wasm/test/ast_generators.ml b/src/lib_scoru_wasm/test/ast_generators.ml index 2678bf5ae9d02b19ff55302e293072976dde9381..334bf3107f69a56ffe41cd4b3fb3d6f229d48ed5 100644 --- a/src/lib_scoru_wasm/test/ast_generators.ml +++ b/src/lib_scoru_wasm/test/ast_generators.ml @@ -285,7 +285,7 @@ let block_label_gen = let+ n = int32 in Ast.Block_label n -let func_gen = +let func'_gen = let* ftype = var_gen in let* locals = vector_gen value_type_gen in let* body = block_label_gen in @@ -294,7 +294,7 @@ let func_gen = let func_gen current_module = let ast_func () = let* func_type = func_type_gen in - let* func = func_gen in + let* func = func'_gen in return @@ Func.AstFunc (func_type, current_module (), func) in oneof @@ -314,12 +314,15 @@ let ref_gen = map (fun n -> Values.ExternRef n) int32; ] -let table_gen = - let* len = frequency [(10, int_range 1 10); (1, int_range 100 200)] in +let table_type_gen len = let* max = opt @@ map Int32.of_int @@ int_range 1 len in let limit = {Types.min = 0l; max} in let* ref_type = ref_type_gen in - let ty = Types.TableType (limit, ref_type) in + return @@ Types.TableType (limit, ref_type) + +let table_gen = + let* len = frequency [(10, int_range 1 10); (1, int_range 100 200)] in + let* ty = table_type_gen len in let* seeds = small_list (int_range 0 10_000) in let table_entries = Table.Vector.Vector.create diff --git a/src/lib_scoru_wasm/test/test_initialization.ml b/src/lib_scoru_wasm/test/test_initialization.ml new file mode 100644 index 0000000000000000000000000000000000000000..2fc019a2f5bf8a96a813fb0af75cdb14a32e7161 --- /dev/null +++ b/src/lib_scoru_wasm/test/test_initialization.ml @@ -0,0 +1,212 @@ +open Tezos_webassembly_interpreter +open Instance +open Tezos_scoru_wasm +module Context = Tezos_context_memory.Context_binary +open QCheck2.Gen +open Tztest + +let det_import_gen list_of_imports = + let open Ast_generators in + let memory_type = Types.(MemoryType {min = 1l; max = Some 3l}) in + let importsl = + List.map + (fun module_name -> + let item_name = Utf8.decode "memory" in + let idesc = no_region @@ Ast.MemoryImport memory_type in + no_region @@ Ast.{module_name; item_name; idesc}) + list_of_imports + in + Lazy_vector.LwtInt32Vector.of_list importsl + +module Vector = Lazy_vector.LwtInt32Vector + +let module_generator_det list_of_imports = + let allocations = + let blocks = Vector.create 0l in + let datas = Vector.create 0l in + Ast.{blocks; datas} + in + + (* let b = Vector.num_elements allocations.blocks in *) + let imports = det_import_gen list_of_imports in + + return + Ast. + { + types = Vector.create 0l; + globals = Vector.create 0l; + tables = Vector.create 0l; + memories = Vector.create 0l; + funcs = Vector.create 0l; + start = None; + elems = Vector.create 0l; + datas = Vector.create 0l; + imports; + exports = Vector.create 0l; + allocations; + } + +module Tree = struct + type t = Context.t + + type tree = Context.tree + + type key = Context.key + + type value = Context.value + + include Context.Tree +end + +module Wasm = Wasm_pvm.Make (Tree) +module EncDec = Tree_encoding_decoding.Make (Tree) +module Wasm_encoding = Wasm_encoding.Make (EncDec) + +let current_tick_encoding = + EncDec.value ["wasm"; "current_tick"] Data_encoding.z + +let status_encoding = EncDec.value ["input"; "consuming"] Data_encoding.bool + +let floppy_encoding = + EncDec.value + ["gather-floppies"; "status"] + Gather_floppies.internal_status_encoding + +let initialise_tree () = + let open Lwt_syntax in + let* tree = + let open Lwt_syntax in + let* index = Context.init "/tmp" in + let empty_store = Context.empty index in + return (Context.Tree.empty empty_store) + in + + let* tree = EncDec.encode current_tick_encoding Z.zero tree in + let* tree = + EncDec.encode floppy_encoding Gather_floppies.Not_gathering_floppies tree + in + let* tree = EncDec.encode status_encoding true tree in + Lwt.return tree + +let x0 = + QCheck2.Gen.generate1 + ~rand:(Random.State.make_self_init ()) + (module_generator_det [Utf8.decode "m1"; Utf8.decode "m2"]) + +let x1 = + QCheck2.Gen.generate1 + ~rand:(Random.State.make_self_init ()) + (module_generator_det [Utf8.decode "m3"]) + +let x2 = + QCheck2.Gen.generate1 + ~rand:(Random.State.make_self_init ()) + (module_generator_det []) + +let x3 = + QCheck2.Gen.generate1 + ~rand:(Random.State.make_self_init ()) + (module_generator_det []) + +let name_list name = Lwt_main.run @@ Ast.Vector.to_list @@ Utf8.decode name + +let maps = + Ast_generators. + [ + (name_list "m0", no_region x0); + (name_list "m1", no_region x1); + (name_list "m2", no_region x2); + (name_list "m3", no_region x3); + ] + +let map = + List.fold_left (fun m (a, b) -> NameMap.(set a b m)) (NameMap.create ()) maps + +let memory_gen = + let ty = Types.(MemoryType {min = 1l; max = Some 3l}) in + let bs = "hello" in + let chunks = Chunked_byte_vector.Lwt.of_string bs in + return @@ Memory.of_chunks ty chunks + +let memory = QCheck2.Gen.generate1 memory_gen + +let lookup name = + let open Lwt.Syntax in + let+ name = Utf8.encode name in + match name with "memory" -> ExternMemory memory | _ -> assert false + +let print = Format.asprintf "%a" Ast_printer.pp_module + +let check_modules module_name tree = + let open Lwt_result_syntax in + let host_function_registry = + Tezos_webassembly_interpreter.Host_funcs.empty () + in + let*! decoded = + EncDec.( + decode (Wasm_encoding.module_instance_encoding ~module_name ()) tree) + in + let*! module_ = NameMap.get (name_list module_name) map in + let*! initialised = + let m = Ast_generators.no_region module_.it in + let*! imports = Import.link m in + Eval.init host_function_registry m imports + in + assert (print decoded = print initialised) ; + return_unit + +let test () = + let open Lwt_result_syntax in + let*! _ = + List.fold_left + (fun _ x -> Import.register ~module_name:(Utf8.decode x) lookup) + Lwt.return_unit + ["m0"; "m1"; "m2"; "m3"] + in + + let*! tree = initialise_tree () in + let host_function_registry = + Tezos_webassembly_interpreter.Host_funcs.empty () + in + + let*! tree = + Wasm.initialize ~host_function_registry map tree (Utf8.decode "m0") + in + let*! _ = check_modules "m0" tree in + let*! _ = check_modules "m1" tree in + let*! _ = check_modules "m2" tree in + let*! _ = check_modules "m3" tree in + + return_unit + +(* let decode_encode enc x = + let open Lwt_syntax in + let* t = + let open Lwt_syntax in + let* index = Context.init "/tmp" in + let empty_store = Context.empty index in + return @@ Context.Tree.empty empty_store + in + let* t1 = EncDec.encode enc x t in + EncDec.decode enc t1 + + let assert_string_equal s1 s2 = + let open Lwt_result_syntax in + if String.equal s1 s2 then return_unit else failwith "Not equal" + + (** Test serialize/deserialize empty_mem. *) + let test_mem () = + let open Lwt_result_syntax in + let print = Format.asprintf "%a" Ast_printer.pp_memory in + let mem1 = + let ty = Types.(MemoryType {min = 1l; max = Some 3l}) in + Memory.alloc ty + in + let mem1_str = print mem1 in + let*! mem2 = decode_encode Wasm_encoding.memory_encoding mem1 in + let mem2_str = print mem2 in + + assert_string_equal mem1_str mem2_str *) + +let tests = + [tztest "initialisation" `Quick test (* tztest "memory" `Quick test_mem *)] diff --git a/src/lib_scoru_wasm/test/test_scoru_wasm.ml b/src/lib_scoru_wasm/test/test_scoru_wasm.ml index 506c77631f21175ec200b557d50e9e8f419d5d08..764c54ca12db815df43d83024326c5900cd808e5 100644 --- a/src/lib_scoru_wasm/test/test_scoru_wasm.ml +++ b/src/lib_scoru_wasm/test/test_scoru_wasm.ml @@ -38,5 +38,6 @@ let () = ("Encodings", Test_encoding.tests); ("AST Generators", Test_ast_generators.tests); ("WASM Encodings", Test_wasm_encoding.tests); + ("Initialize", Test_initialization.tests); ] |> Lwt_main.run diff --git a/src/lib_scoru_wasm/test/test_wasm_encoding.ml b/src/lib_scoru_wasm/test/test_wasm_encoding.ml index f844d50631d2e269c9826a70127822affe216591..bd14be64b442463f02c6b5f25172ed9b0ee5fde3 100644 --- a/src/lib_scoru_wasm/test/test_wasm_encoding.ml +++ b/src/lib_scoru_wasm/test/test_wasm_encoding.ml @@ -93,11 +93,11 @@ let test_module_roundtrip () = (* We need to print here in order to force lazy bindings to be evaluated. *) let module1_str = print module1 in let*! module2 = - encode_decode Wasm_encoding.module_instance_encoding module1 + encode_decode (Wasm_encoding.module_instance_encoding ()) module1 in let module2_str = print module2 in let*! module3 = - encode_decode Wasm_encoding.module_instance_encoding module2 + encode_decode (Wasm_encoding.module_instance_encoding ()) module2 in let module3_str = print module3 in (* Check that modules match. *) @@ -114,18 +114,18 @@ let test_module_tree () = let _ = print module1 in let*! tree1 = Merklizer.encode - Wasm_encoding.module_instance_encoding + (Wasm_encoding.module_instance_encoding ()) module1 empty_tree in let*! module2 = - Merklizer.decode Wasm_encoding.module_instance_encoding tree1 + Merklizer.decode (Wasm_encoding.module_instance_encoding ()) tree1 in (* We need to print here in order to force lazy bindings to be evaluated. *) let _ = print module2 in let*! tree2 = Merklizer.encode - Wasm_encoding.module_instance_encoding + (Wasm_encoding.module_instance_encoding ()) module2 empty_tree in diff --git a/src/lib_scoru_wasm/wasm_encoding.ml b/src/lib_scoru_wasm/wasm_encoding.ml index 7a6e6adbcd312e818db00361a1c75107da57b8aa..0c617a675d98360f0dcb79d869435a28ee0a95f3 100644 --- a/src/lib_scoru_wasm/wasm_encoding.ml +++ b/src/lib_scoru_wasm/wasm_encoding.ml @@ -651,7 +651,9 @@ module Make (Tree_encoding_decoding : Tree_encoding_decoding.S) = struct (fun {blocks; datas} -> (blocks, datas)) (tup2 ~flatten:false block_table_encoding datas_table_encoding) - let module_instance_encoding = + (** adhoc modification of the module_encoding to allow for several modules. + This is needed in the initialization function in `wasm_pvm`*) + let module_instance_encoding ?(module_name = "main_module") () = let open Lwt_syntax in let gen_encoding current_module = let current_module = Lazy.map (fun x -> ref x) current_module in @@ -711,5 +713,5 @@ module Make (Tree_encoding_decoding : Tree_encoding_decoding.S) = struct data_instance_encoding allocations_encoding) in - scope ["module"] @@ with_self_reference gen_encoding + scope ["module"; module_name] @@ with_self_reference gen_encoding end diff --git a/src/lib_scoru_wasm/wasm_encoding.mli b/src/lib_scoru_wasm/wasm_encoding.mli index 708be6a8f1c7819bc5ff2bd505fcacd42bac4559..35941e51b5384aaf4ba3da9ceaa793b6369d7253 100644 --- a/src/lib_scoru_wasm/wasm_encoding.mli +++ b/src/lib_scoru_wasm/wasm_encoding.mli @@ -89,5 +89,6 @@ module Make (M : Tree_encoding_decoding.S) : sig val allocations_encoding : Ast.allocations t - val module_instance_encoding : Instance.module_inst t + val module_instance_encoding : + ?module_name:string -> unit -> Instance.module_inst t end diff --git a/src/lib_scoru_wasm/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml index ffddb241c36fcda16c7f99c3a7f2537fc26e3ed7..a4ee52da070a5fc90260398f122474099023fc3e 100644 --- a/src/lib_scoru_wasm/wasm_pvm.ml +++ b/src/lib_scoru_wasm/wasm_pvm.ml @@ -29,6 +29,7 @@ must be exposed to the protocol via the environment shall be added here. *) +open Tezos_webassembly_interpreter module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct include @@ -115,5 +116,60 @@ module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct in let* tree = EncDec.encode status_encoding false tree in EncDec.encode (inp_encoding level id) message tree + + let _module_instance_of_tree modules = + EncDec.decode (Wasm_encoding.module_instance_encoding ()) modules + + let _module_instances_of_tree = + EncDec.decode (Wasm_encoding.module_instance_encoding ()) + + let transitive_closure (module_map : Ast.module_ Instance.NameMap.t) + module_name = + let open Lwt_syntax in + let rec aux module_map added_list remaining_list = + match remaining_list with + | [] -> Lwt.return added_list + | h :: tl -> + let* head = Ast.Vector.to_list h in + let* mod_ = Instance.NameMap.get head module_map in + let Ast.{imports; _} = mod_.Source.it in + let* imports = Ast.Vector.to_list imports in + let keys = + List.map + Ast.( + fun x -> + let {module_name; _} = x.Source.it in + module_name) + imports + in + let new_added_list = (h, mod_) :: added_list in + let new_remaining = List.rev_append keys tl in + aux module_map new_added_list new_remaining + in + aux module_map [] [module_name] + + let initialize ?(host_function_registry = Host_funcs.empty ()) + module_map tree main_module_name = + let open Lwt_syntax in + let* modules = transitive_closure module_map main_module_name in + let s = + List.fold_left + (fun tree (mod_name, m) -> + let* imports = Import.link m in + let* mod_inst = Eval.init host_function_registry m imports in + let* tree = tree in + let* module_name = Utf8.encode mod_name in + + let* t = + EncDec.encode + (Wasm_encoding.module_instance_encoding ~module_name ()) + mod_inst + tree + in + Lwt.return t) + (Lwt.return tree) + modules + in + s end) end diff --git a/src/lib_scoru_wasm/wasm_pvm_sig.ml b/src/lib_scoru_wasm/wasm_pvm_sig.ml index 43cf63465df26b2538716aaeb39acab8e512f3cb..470293ac7512da7410c3d8b6b55e751c33c89561 100644 --- a/src/lib_scoru_wasm/wasm_pvm_sig.ml +++ b/src/lib_scoru_wasm/wasm_pvm_sig.ml @@ -22,6 +22,7 @@ (* DEALINGS IN THE SOFTWARE. *) (* *) (*****************************************************************************) +open Tezos_webassembly_interpreter (** Represents the location of an input message. *) type input_info = { @@ -56,6 +57,8 @@ type info = { module type S = sig type tree + module EncDec : Tree_encoding_decoding.S with type tree = tree + (** [compute_step] forwards the VM by one compute tick. If the VM is expecting input, it gets stuck. If the VM is already stuck, this function may raise an exception. *) @@ -77,6 +80,13 @@ module type S = sig (** [get_info] provides a typed view of the current machine state. Should not raise. *) val get_info : tree -> info Lwt.t + + val initialize : + ?host_function_registry:Host_funcs.registry -> + Ast.module_ Instance.NameMap.t -> + tree -> + Ast.name -> + tree Lwt.t end (* Encodings *)