From 421a595c03bc7b593164341a6d0a8701dd8fe909 Mon Sep 17 00:00:00 2001 From: Corneliu Hoffman Date: Mon, 25 Jul 2022 18:23:48 +0100 Subject: [PATCH 1/4] SCORU/WASM: start --- src/lib_scoru_wasm/gather_floppies.ml | 30 ++++++++------- src/lib_scoru_wasm/wasm_pvm.ml | 54 +++++++++++++++++++++++++++ src/lib_scoru_wasm/wasm_pvm_sig.ml | 10 +++++ 3 files changed, 80 insertions(+), 14 deletions(-) diff --git a/src/lib_scoru_wasm/gather_floppies.ml b/src/lib_scoru_wasm/gather_floppies.ml index 81b649e03329..f4e117531531 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 ?host_function_registry:_ _ tree _ = Lwt.return tree end diff --git a/src/lib_scoru_wasm/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml index ffddb241c36f..88672a304550 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,58 @@ 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 = 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 + Vector.to_list module_name) + imports + in + let new_added_list = 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 [] [Lwt.return 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 m -> + let* imports = Import.link m in + let* mod_inst = Eval.init host_function_registry m imports in + let* tree = tree in + let* t = + EncDec.encode + Wasm_encoding.module_instance_encoding + 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 43cf63465df2..7e0b194fc2af 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_list -> + tree Lwt.t end (* Encodings *) -- GitLab From f267a909f14a3e6fb78cc176f556d07182ca310d Mon Sep 17 00:00:00 2001 From: Corneliu Hoffman Date: Wed, 27 Jul 2022 13:22:38 +0100 Subject: [PATCH 2/4] WASM/PVM modified to have sevaral modules --- src/lib_scoru_wasm/test/test_wasm_encoding.ml | 10 +++++----- src/lib_scoru_wasm/wasm_encoding.ml | 6 ++++-- src/lib_scoru_wasm/wasm_encoding.mli | 3 ++- src/lib_scoru_wasm/wasm_pvm.ml | 14 +++++++++----- 4 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/lib_scoru_wasm/test/test_wasm_encoding.ml b/src/lib_scoru_wasm/test/test_wasm_encoding.ml index f844d50631d2..bd14be64b442 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 7a6e6adbcd31..0c617a675d98 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 708be6a8f1c7..35941e51b538 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 88672a304550..9621db5a0a58 100644 --- a/src/lib_scoru_wasm/wasm_pvm.ml +++ b/src/lib_scoru_wasm/wasm_pvm.ml @@ -118,10 +118,10 @@ module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct EncDec.encode (inp_encoding level id) message tree let _module_instance_of_tree modules = - EncDec.decode Wasm_encoding.module_instance_encoding modules + EncDec.decode (Wasm_encoding.module_instance_encoding ()) modules let _module_instances_of_tree = - EncDec.decode Wasm_encoding.module_instance_encoding + EncDec.decode (Wasm_encoding.module_instance_encoding ()) let transitive_closure (module_map : Ast.module_ Instance.NameMap.t) module_name = @@ -142,7 +142,7 @@ module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct Vector.to_list module_name) imports in - let new_added_list = mod_ :: added_list in + let new_added_list = (head, mod_) :: added_list in let new_remaining = List.rev_append keys tl in aux module_map new_added_list new_remaining in @@ -154,13 +154,17 @@ module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct let* modules = transitive_closure module_map main_module_name in let s = List.fold_left - (fun tree m -> + (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* t = EncDec.encode - Wasm_encoding.module_instance_encoding + (Wasm_encoding.module_instance_encoding + ?module_name: + (Some + (String.concat "" (List.map string_of_int mod_name))) + ()) mod_inst tree in -- GitLab From 4009201ddde96863d8e3838c392d732208463a83 Mon Sep 17 00:00:00 2001 From: Corneliu Hoffman Date: Thu, 28 Jul 2022 07:56:04 +0100 Subject: [PATCH 3/4] WASM/PVM as_generators for testing --- src/lib_scoru_wasm/test/ast_generators.ml | 13 +- .../test/test_initialization.ml | 180 ++++++++++++++++++ 2 files changed, 188 insertions(+), 5 deletions(-) create mode 100644 src/lib_scoru_wasm/test/test_initialization.ml diff --git a/src/lib_scoru_wasm/test/ast_generators.ml b/src/lib_scoru_wasm/test/ast_generators.ml index 2678bf5ae9d0..334bf3107f69 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 000000000000..192d5822baf2 --- /dev/null +++ b/src/lib_scoru_wasm/test/test_initialization.ml @@ -0,0 +1,180 @@ +(* open Tztest *) +open Tezos_webassembly_interpreter + +(* open Tezos_scoru_wasm *) +open QCheck2.Gen + +let gen_names : Ast.name_list t = list int + +let types_gen = Ast_generators.(map no_region func_type_gen) + +let global_type_gen = + let* value = Ast_generators.value_type_gen in + let* mt = oneofl [Types.Immutable; Types.Mutable] in + let ty = Types.GlobalType (value, mt) in + return ty + +let const_gen = Ast_generators.(map no_region block_label_gen) + +let glob_gen = + let* gtype = global_type_gen in + let* ginit = const_gen in + return @@ Ast_generators.no_region Ast.{gtype; ginit} + +let table'_gen = + let* len = frequency [(10, int_range 1 10); (1, int_range 100 200)] in + let* ttype = Ast_generators.table_type_gen len in + return @@ Ast_generators.no_region Ast.{ttype} + +let mem_gen = + let open Ast_generators in + let* mtype = memory_type_gen in + let memory' = Ast.{mtype} in + return @@ no_region memory' + +let start_gen = + let open Ast_generators in + let* sfunc = var_gen in + let start' = Ast.{sfunc} in + oneof [return None; return @@ Some (no_region start')] + +let segm_mode_gen = + let open Ast_generators in + let index = no_region 0l in + let* offset = const_gen in + map no_region @@ oneofl Ast.[Passive; Active {index; offset}] + +let elm_seg_gen = + let open Ast_generators in + let* etype = ref_type_gen in + let* einit = vector_gen const_gen in + let* emode = segm_mode_gen in + return @@ Ast_generators.no_region Ast.{etype; einit; emode} + +let data_segm_gen = + let* bs = string in + let dinit = Chunked_byte_vector.Lwt.of_string bs in + let* dmode = segm_mode_gen in + return @@ Ast_generators.no_region Ast.{dinit; dmode} + +let import_desc_gen = + let open Ast_generators in + let* var = var_gen in + let* len = frequency [(10, int_range 1 10); (1, int_range 100 200)] in + let* table_type = table_type_gen len in + let* memory_type = memory_type_gen in + let* global_type = global_type_gen in + map no_region + @@ oneofl + Ast. + [ + FuncImport var; + TableImport table_type; + MemoryImport memory_type; + GlobalImport global_type; + ] + +let name_gen = Ast_generators.vector_gen int + +let import_gen = + let open Ast_generators in + let* module_name = name_gen in + let* item_name = name_gen in + let* idesc = import_desc_gen in + return @@ no_region @@ Ast.{module_name; item_name; idesc} + +let det_import_gen list_of_imports = + let open Ast_generators in + let rand = Random.State.make_self_init () in + let importsl = + List.map + (fun module_name -> + let item_name = generate1 ~rand name_gen in + let idesc = generate1 ~rand import_desc_gen in + no_region @@ Ast.{module_name; item_name; idesc}) + list_of_imports + in + Lazy_vector.LwtInt32Vector.of_list importsl + +let export_desc_gen = + let open Ast_generators in + let* var = var_gen in + + map no_region + @@ oneofl + Ast.[FuncExport var; TableExport var; MemoryExport var; GlobalExport var] + +let export_gen = + let* name = name_gen in + let* edesc = export_desc_gen in + return @@ Ast_generators.no_region Ast.{name; edesc} + +let block_table_gen = + let open Ast_generators in + let instr_g = + let* instr = instr_gen in + return @@ Ast_generators.no_region instr.it + in + vector_gen @@ vector_gen instr_g + +let module_generator = + let open Ast_generators in + let* types = vector_gen types_gen in + let* globals = vector_gen glob_gen in + let* tables = vector_gen table'_gen in + let* memories = vector_gen mem_gen in + let* funcs = vector_gen func'_gen in + let* start = start_gen in + let* elems = vector_gen elm_seg_gen in + let* datas = vector_gen data_segm_gen in + let* imports = vector_gen import_gen in + let* exports = vector_gen export_gen in + let* blocks = block_table_gen in + + return + Ast. + { + types; + globals; + tables; + memories; + funcs; + start; + elems; + datas; + imports; + exports; + blocks; + } + +module Vector = Lazy_vector.LwtInt32Vector + +let module_generator_det list_of_imports = + let open Ast_generators in + let* _types = vector_gen types_gen in + let* _globals = vector_gen glob_gen in + let* _tables = vector_gen table'_gen in + let* _memories = vector_gen mem_gen in + let* _funcs = vector_gen func'_gen in + let* _start = start_gen in + let* _elems = vector_gen elm_seg_gen in + let* datas = vector_gen data_segm_gen in + let imports = det_import_gen list_of_imports in + let* _exports = vector_gen export_gen in + let* _blocks = block_table_gen 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; + imports; + exports = Vector.create 0l; + blocks = Vector.create 0l; + } -- GitLab From 5bd489fad95440f8a273f488b7122cf04db739c2 Mon Sep 17 00:00:00 2001 From: Corneliu Hoffman Date: Sat, 30 Jul 2022 11:35:18 +0100 Subject: [PATCH 4/4] WASM/PVM test --- src/lib_scoru_wasm/gather_floppies.ml | 2 +- .../test/test_initialization.ml | 330 ++++++++++-------- src/lib_scoru_wasm/test/test_scoru_wasm.ml | 1 + src/lib_scoru_wasm/wasm_pvm.ml | 16 +- src/lib_scoru_wasm/wasm_pvm_sig.ml | 2 +- 5 files changed, 191 insertions(+), 160 deletions(-) diff --git a/src/lib_scoru_wasm/gather_floppies.ml b/src/lib_scoru_wasm/gather_floppies.ml index f4e117531531..de9e41146d4b 100644 --- a/src/lib_scoru_wasm/gather_floppies.ml +++ b/src/lib_scoru_wasm/gather_floppies.ml @@ -414,5 +414,5 @@ module Make (T : Tree.S) (Wasm : Wasm_pvm_sig.S with type tree = T.tree) : (Invalid_argument "initial_tree_from_boot_sector: wrong boot sector") end - let initialize ?host_function_registry:_ _ tree _ = Lwt.return tree + let initialize = Wasm.initialize end diff --git a/src/lib_scoru_wasm/test/test_initialization.ml b/src/lib_scoru_wasm/test/test_initialization.ml index 192d5822baf2..2fc019a2f5bf 100644 --- a/src/lib_scoru_wasm/test/test_initialization.ml +++ b/src/lib_scoru_wasm/test/test_initialization.ml @@ -1,167 +1,34 @@ -(* open Tztest *) open Tezos_webassembly_interpreter - -(* open Tezos_scoru_wasm *) +open Instance +open Tezos_scoru_wasm +module Context = Tezos_context_memory.Context_binary open QCheck2.Gen - -let gen_names : Ast.name_list t = list int - -let types_gen = Ast_generators.(map no_region func_type_gen) - -let global_type_gen = - let* value = Ast_generators.value_type_gen in - let* mt = oneofl [Types.Immutable; Types.Mutable] in - let ty = Types.GlobalType (value, mt) in - return ty - -let const_gen = Ast_generators.(map no_region block_label_gen) - -let glob_gen = - let* gtype = global_type_gen in - let* ginit = const_gen in - return @@ Ast_generators.no_region Ast.{gtype; ginit} - -let table'_gen = - let* len = frequency [(10, int_range 1 10); (1, int_range 100 200)] in - let* ttype = Ast_generators.table_type_gen len in - return @@ Ast_generators.no_region Ast.{ttype} - -let mem_gen = - let open Ast_generators in - let* mtype = memory_type_gen in - let memory' = Ast.{mtype} in - return @@ no_region memory' - -let start_gen = - let open Ast_generators in - let* sfunc = var_gen in - let start' = Ast.{sfunc} in - oneof [return None; return @@ Some (no_region start')] - -let segm_mode_gen = - let open Ast_generators in - let index = no_region 0l in - let* offset = const_gen in - map no_region @@ oneofl Ast.[Passive; Active {index; offset}] - -let elm_seg_gen = - let open Ast_generators in - let* etype = ref_type_gen in - let* einit = vector_gen const_gen in - let* emode = segm_mode_gen in - return @@ Ast_generators.no_region Ast.{etype; einit; emode} - -let data_segm_gen = - let* bs = string in - let dinit = Chunked_byte_vector.Lwt.of_string bs in - let* dmode = segm_mode_gen in - return @@ Ast_generators.no_region Ast.{dinit; dmode} - -let import_desc_gen = - let open Ast_generators in - let* var = var_gen in - let* len = frequency [(10, int_range 1 10); (1, int_range 100 200)] in - let* table_type = table_type_gen len in - let* memory_type = memory_type_gen in - let* global_type = global_type_gen in - map no_region - @@ oneofl - Ast. - [ - FuncImport var; - TableImport table_type; - MemoryImport memory_type; - GlobalImport global_type; - ] - -let name_gen = Ast_generators.vector_gen int - -let import_gen = - let open Ast_generators in - let* module_name = name_gen in - let* item_name = name_gen in - let* idesc = import_desc_gen in - return @@ no_region @@ Ast.{module_name; item_name; idesc} +open Tztest let det_import_gen list_of_imports = let open Ast_generators in - let rand = Random.State.make_self_init () in + let memory_type = Types.(MemoryType {min = 1l; max = Some 3l}) in let importsl = List.map (fun module_name -> - let item_name = generate1 ~rand name_gen in - let idesc = generate1 ~rand import_desc_gen in + 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 -let export_desc_gen = - let open Ast_generators in - let* var = var_gen in - - map no_region - @@ oneofl - Ast.[FuncExport var; TableExport var; MemoryExport var; GlobalExport var] - -let export_gen = - let* name = name_gen in - let* edesc = export_desc_gen in - return @@ Ast_generators.no_region Ast.{name; edesc} - -let block_table_gen = - let open Ast_generators in - let instr_g = - let* instr = instr_gen in - return @@ Ast_generators.no_region instr.it - in - vector_gen @@ vector_gen instr_g - -let module_generator = - let open Ast_generators in - let* types = vector_gen types_gen in - let* globals = vector_gen glob_gen in - let* tables = vector_gen table'_gen in - let* memories = vector_gen mem_gen in - let* funcs = vector_gen func'_gen in - let* start = start_gen in - let* elems = vector_gen elm_seg_gen in - let* datas = vector_gen data_segm_gen in - let* imports = vector_gen import_gen in - let* exports = vector_gen export_gen in - let* blocks = block_table_gen in - - return - Ast. - { - types; - globals; - tables; - memories; - funcs; - start; - elems; - datas; - imports; - exports; - blocks; - } - module Vector = Lazy_vector.LwtInt32Vector let module_generator_det list_of_imports = - let open Ast_generators in - let* _types = vector_gen types_gen in - let* _globals = vector_gen glob_gen in - let* _tables = vector_gen table'_gen in - let* _memories = vector_gen mem_gen in - let* _funcs = vector_gen func'_gen in - let* _start = start_gen in - let* _elems = vector_gen elm_seg_gen in - let* datas = vector_gen data_segm_gen in + 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 - let* _exports = vector_gen export_gen in - let* _blocks = block_table_gen in return Ast. @@ -173,8 +40,173 @@ let module_generator_det list_of_imports = funcs = Vector.create 0l; start = None; elems = Vector.create 0l; - datas; + datas = Vector.create 0l; imports; exports = Vector.create 0l; - blocks = 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 506c77631f21..764c54ca12db 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/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml index 9621db5a0a58..a4ee52da070a 100644 --- a/src/lib_scoru_wasm/wasm_pvm.ml +++ b/src/lib_scoru_wasm/wasm_pvm.ml @@ -130,7 +130,7 @@ module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct match remaining_list with | [] -> Lwt.return added_list | h :: tl -> - let* head = h in + 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 @@ -139,14 +139,14 @@ module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct Ast.( fun x -> let {module_name; _} = x.Source.it in - Vector.to_list module_name) + module_name) imports in - let new_added_list = (head, mod_) :: added_list 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 [] [Lwt.return module_name] + aux module_map [] [module_name] let initialize ?(host_function_registry = Host_funcs.empty ()) module_map tree main_module_name = @@ -158,13 +158,11 @@ module Make (T : Tree.S) : Gather_floppies.S with type tree = T.tree = struct 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: - (Some - (String.concat "" (List.map string_of_int mod_name))) - ()) + (Wasm_encoding.module_instance_encoding ~module_name ()) mod_inst tree in diff --git a/src/lib_scoru_wasm/wasm_pvm_sig.ml b/src/lib_scoru_wasm/wasm_pvm_sig.ml index 7e0b194fc2af..470293ac7512 100644 --- a/src/lib_scoru_wasm/wasm_pvm_sig.ml +++ b/src/lib_scoru_wasm/wasm_pvm_sig.ml @@ -85,7 +85,7 @@ module type S = sig ?host_function_registry:Host_funcs.registry -> Ast.module_ Instance.NameMap.t -> tree -> - Ast.name_list -> + Ast.name -> tree Lwt.t end -- GitLab