From 80af5b4bb82f3c3e987cc30262f9a0ed5b72ce26 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 19 Jul 2022 11:31:35 +0200
Subject: [PATCH 1/8] Wasm: wrop host function in a descriptor

---
 src/lib_scoru_wasm/host_funcs.ml     |  8 +++++++-
 src/lib_webassembly/bin/main.ml      |  5 +++--
 src/lib_webassembly/exec/eval.ml     |  4 ++--
 src/lib_webassembly/host/env.ml      |  8 +++++---
 src/lib_webassembly/host/spectest.ml |  6 ++++--
 src/lib_webassembly/runtime/func.ml  | 16 +++++++++++++---
 src/lib_webassembly/runtime/func.mli | 11 ++++++++++-
 7 files changed, 44 insertions(+), 14 deletions(-)

diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml
index 09a2fe2b3f32..1901f2556610 100644
--- a/src/lib_scoru_wasm/host_funcs.ml
+++ b/src/lib_scoru_wasm/host_funcs.ml
@@ -99,7 +99,13 @@ let read_input =
         Lwt.return [Values.(Num (I32 (I32.of_int_s x)))]
     | _ -> raise Bad_input
   in
-  Func.HostFunc (fun_type, f)
+  Func.HostFunc
+    {
+      func_type = fun_type;
+      module_name = "tezos";
+      func_name = "read_input";
+      implem = f;
+    }
 
 module Internal_for_tests = struct
   let aux_write_input_in_memory = aux_write_input_in_memory
diff --git a/src/lib_webassembly/bin/main.ml b/src/lib_webassembly/bin/main.ml
index 0c1e36ddaadd..27601c92cef9 100644
--- a/src/lib_webassembly/bin/main.ml
+++ b/src/lib_webassembly/bin/main.ml
@@ -6,9 +6,10 @@ let configure () =
   let open Lwt.Syntax in
   let* () =
     Import.register (Utf8.decode "spectest") (fun name type_ ->
-        Spectest.lookup name type_)
+        Spectest.lookup "spectest" name type_)
   in
-  Import.register (Utf8.decode "env") (fun name type_ -> Env.lookup name type_)
+  Import.register (Utf8.decode "env") (fun name type_ ->
+      Env.lookup "env" name type_)
 
 let banner () = print_endline (name ^ " " ^ version ^ " reference interpreter")
 
diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml
index 96ffa9119fe7..ef8bfa393484 100644
--- a/src/lib_webassembly/exec/eval.ml
+++ b/src/lib_webassembly/exec/eval.ml
@@ -138,7 +138,7 @@ let func_ref inst x i at =
 
 let func_type_of = function
   | Func.AstFunc (t, inst, f) -> t
-  | Func.HostFunc (t, _) -> t
+  | Func.HostFunc {func_type = t; _} -> t
 
 let block_type inst bt =
   let empty () = Lazy_vector.LwtInt32Vector.create 0l in
@@ -800,7 +800,7 @@ and step_resolved (c : config) frame vs e es : config Lwt.t =
               ]
             in
             (vs', [Frame (n2, frame', ([], instr')) @@ e.at])
-        | Func.HostFunc (t, f) ->
+        | Func.HostFunc {func_type = t; implem = f; _} ->
             let inst = ref frame.inst in
             Lwt.catch
               (fun () ->
diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml
index b40477536796..fab074df5b2c 100644
--- a/src/lib_webassembly/host/env.ml
+++ b/src/lib_webassembly/host/env.ml
@@ -33,10 +33,12 @@ let abort _input _mod_inst vs =
 
 let exit _input (_mod_inst : module_inst ref) vs = exit (int (single vs))
 
-let lookup name t =
+let lookup module_name name t =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   match (name, t) with
-  | "abort", ExternFuncType t -> ExternFunc (Func.alloc_host t abort)
-  | "exit", ExternFuncType t -> ExternFunc (Func.alloc_host t exit)
+  | "abort", ExternFuncType t ->
+      ExternFunc (Func.alloc_host ~module_name ~func_name:name t abort)
+  | "exit", ExternFuncType t ->
+      ExternFunc (Func.alloc_host ~module_name ~func_name:name t exit)
   | _ -> raise Not_found
diff --git a/src/lib_webassembly/host/spectest.ml b/src/lib_webassembly/host/spectest.ml
index dd325d27f836..a8089c6445a0 100644
--- a/src/lib_webassembly/host/spectest.ml
+++ b/src/lib_webassembly/host/spectest.ml
@@ -26,7 +26,8 @@ let table =
 
 let memory = Memory.alloc (MemoryType {min = 1l; max = Some 2l})
 
-let func f t = Func.alloc_host t (f t)
+let func module_name func_name f t =
+  Func.alloc_host ~module_name ~func_name t (f t)
 
 let print_value v =
   Printf.printf
@@ -42,7 +43,7 @@ let print (FuncType (_, out)) _m _v vs =
     (Lazy_vector.LwtInt32Vector.loaded_bindings out)
   |> Lwt.return
 
-let lookup name t =
+let lookup module_name name t =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   let empty () = Lazy_vector.LwtInt32Vector.create 0l in
@@ -50,6 +51,7 @@ let lookup name t =
   let two i j =
     Lazy_vector.LwtInt32Vector.(create 2l |> set 0l i |> set 1l j)
   in
+  let func = func module_name name in
   match (name, t) with
   | "print", _ -> ExternFunc (func print (FuncType (empty (), empty ())))
   | "print_i32", _ ->
diff --git a/src/lib_webassembly/runtime/func.ml b/src/lib_webassembly/runtime/func.ml
index 1ca262c8f16c..97e43780b120 100644
--- a/src/lib_webassembly/runtime/func.ml
+++ b/src/lib_webassembly/runtime/func.ml
@@ -1,14 +1,24 @@
 open Types
 open Values
 
+type ('input, 'inst) host_func_desc = {
+  module_name : string;
+  func_name : string;
+  func_type : func_type;
+  implem : 'input -> 'inst -> value list -> value list Lwt.t;
+}
+
 type ('input, 'inst) t = ('input, 'inst) func
 
 and ('input, 'inst) func =
   | AstFunc of func_type * 'inst * Ast.func
-  | HostFunc of func_type * ('input -> 'inst -> value list -> value list Lwt.t)
+  | HostFunc of ('input, 'inst) host_func_desc
 
 let alloc ft inst f = AstFunc (ft, inst, f)
 
-let alloc_host ft f = HostFunc (ft, f)
+let alloc_host ~module_name ~func_name ft f =
+  HostFunc {module_name; func_name; func_type = ft; implem = f}
 
-let type_of = function AstFunc (ft, _, _) -> ft | HostFunc (ft, _) -> ft
+let type_of = function
+  | AstFunc (ft, _, _) -> ft
+  | HostFunc {func_type = ft; _} -> ft
diff --git a/src/lib_webassembly/runtime/func.mli b/src/lib_webassembly/runtime/func.mli
index 3aa013d7f4f4..dff5383f7891 100644
--- a/src/lib_webassembly/runtime/func.mli
+++ b/src/lib_webassembly/runtime/func.mli
@@ -1,15 +1,24 @@
 open Types
 open Values
 
+type ('input, 'inst) host_func_desc = {
+  module_name : string;
+  func_name : string;
+  func_type : func_type;
+  implem : 'input -> 'inst -> value list -> value list Lwt.t;
+}
+
 type ('input, 'inst) t = ('input, 'inst) func
 
 and ('input, 'inst) func =
   | AstFunc of func_type * 'inst * Ast.func
-  | HostFunc of func_type * ('input -> 'inst -> value list -> value list Lwt.t)
+  | HostFunc of ('input, 'inst) host_func_desc
 
 val alloc : func_type -> 'inst -> Ast.func -> ('input, 'inst) func
 
 val alloc_host :
+  module_name:string ->
+  func_name:string ->
   func_type ->
   ('input -> 'inst -> value list -> value list Lwt.t) ->
   ('input, 'inst) func
-- 
GitLab


From 675c0c0074739702878c757eed6a5b1c944a964d Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 19 Jul 2022 13:36:25 +0200
Subject: [PATCH 2/8] Wasm: actually plug host funcs in the PVM

---
 src/lib_scoru_wasm/host_funcs.ml      | 13 ++++++++++---
 src/lib_scoru_wasm/host_funcs.mli     | 14 +++++++++++---
 src/lib_scoru_wasm/wasm_decodings.ml  | 18 ++++++++++++++++--
 src/lib_scoru_wasm/wasm_pvm.ml        |  5 ++++-
 src/lib_webassembly/script/import.ml  | 11 +++++++++--
 src/lib_webassembly/script/import.mli |  6 ++++++
 6 files changed, 56 insertions(+), 11 deletions(-)

diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml
index 1901f2556610..a7de037ce0dc 100644
--- a/src/lib_scoru_wasm/host_funcs.ml
+++ b/src/lib_scoru_wasm/host_funcs.ml
@@ -26,9 +26,6 @@
 open Tezos_webassembly_interpreter
 open Instance
 
-let lookup name =
-  Stdlib.failwith (Printf.sprintf "Unknown host function %s" name)
-
 exception Bad_input
 
 let aux_write_input_in_memory ~input_buffer ~module_inst ~rtype_offset
@@ -107,6 +104,16 @@ let read_input =
       implem = f;
     }
 
+let lookup _module_name name _t =
+  let open Lwt.Syntax in
+  let+ name = Utf8.encode name in
+  match name with
+  | "read_input" -> ExternFunc read_input (* TODO: typecheck *)
+  | _ -> raise Not_found
+
+let configure () =
+  Import.register (Utf8.decode "tezos") (fun name t -> lookup "tezos" name t)
+
 module Internal_for_tests = struct
   let aux_write_input_in_memory = aux_write_input_in_memory
 end
diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli
index 48bdd7ef07e0..436f71fc916a 100644
--- a/src/lib_scoru_wasm/host_funcs.mli
+++ b/src/lib_scoru_wasm/host_funcs.mli
@@ -23,9 +23,17 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(** [lookup name] retrieves or instantiates a host function by the given
-    [name]. *)
-val lookup : string -> ('input, 'inst) Tezos_webassembly_interpreter.Func.t
+(** [lookup module_name name] retrieves or instantiates a host
+    function by the given [name] in the given [module_name].
+    Currently dispatches [Tezos.read_input] to {!read_input}. *)
+val lookup :
+  string ->
+  Tezos_webassembly_interpreter.Ast.name ->
+  Tezos_webassembly_interpreter.Types.func_type ->
+  Tezos_webassembly_interpreter.Instance.extern Lwt.t
+
+(** Plugs {!lookup} into the WASN interpreter module system. *)
+val configure : unit -> unit Lwt.t
 
 exception Bad_input
 
diff --git a/src/lib_scoru_wasm/wasm_decodings.ml b/src/lib_scoru_wasm/wasm_decodings.ml
index c8852b8c3c58..9486369e30e3 100644
--- a/src/lib_scoru_wasm/wasm_decodings.ml
+++ b/src/lib_scoru_wasm/wasm_decodings.ml
@@ -427,8 +427,22 @@ module Make (T : Tree.S) = struct
         (Data_encoding.string_enum [("host", true); ("native", false)])
     in
     if is_host_func then
-      let+ name = value ["name"] Data_encoding.string in
-      Host_funcs.lookup name
+      let* module_name =
+        lazy_vector_decoding "module_name" (value [] Data_encoding.int31)
+      in
+      let* name =
+        lazy_vector_decoding "func_name" (value [] Data_encoding.int31)
+      in
+      let* t = scope ["func_type"] (func_type_decoding ()) in
+      of_lwt
+        (Lwt.bind
+           (Tezos_webassembly_interpreter.Import.lookup
+              module_name
+              name
+              (ExternFuncType t))
+           (function
+            | ExternFunc extern -> Lwt.return extern
+            | _ -> assert false))
     else
       let* type_ = func_type_decoding () in
       let* ftype = value ["ftype"] Interpreter_encodings.Ast.var_encoding in
diff --git a/src/lib_scoru_wasm/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml
index f0ef2ead0084..7caffb3d4cf3 100644
--- a/src/lib_scoru_wasm/wasm_pvm.ml
+++ b/src/lib_scoru_wasm/wasm_pvm.ml
@@ -39,7 +39,10 @@ module Make (T : Tree.S) : Wasm_pvm_sig.S with type tree = T.tree = struct
 
         module Decodings = Wasm_decodings.Make (T)
 
-        let compute_step = Lwt.return
+        let compute_step s =
+          let open Lwt.Syntax in
+          let* () = Host_funcs.configure () in
+          Lwt.return s
 
         (* TODO: https://gitlab.com/tezos/tezos/-/issues/3092
            Implement handling of input logic.
diff --git a/src/lib_webassembly/script/import.ml b/src/lib_webassembly/script/import.ml
index 213a47d41b14..8954b73ad625 100644
--- a/src/lib_webassembly/script/import.ml
+++ b/src/lib_webassembly/script/import.ml
@@ -25,7 +25,7 @@ let register name lookup =
   registry := Registry.add name lookup !registry ;
   Lwt.return_unit
 
-let lookup (m : module_) (im : import) : Instance.extern Lwt.t =
+let link_one (m : module_) (im : import) : Instance.extern Lwt.t =
   let open Lwt.Syntax in
   let {module_name; item_name; idesc} = im.it in
   let* module_name_l = from_ast_name module_name in
@@ -44,4 +44,11 @@ let lookup (m : module_) (im : import) : Instance.extern Lwt.t =
 let link m =
   let open Lwt.Syntax in
   let* imports = Lazy_vector.LwtInt32Vector.to_list m.it.imports in
-  TzStdLib.List.map_s (lookup m) imports
+  TzStdLib.List.map_s (link_one m) imports
+
+let lookup (module_name : Ast.name) (item_name : Ast.name)
+    (t : Types.extern_type) : Instance.extern Lwt.t =
+  let open Lwt.Syntax in
+  let* module_name_l = from_ast_name module_name in
+  let* item_name_l = from_ast_name item_name in
+  Registry.find module_name_l !registry item_name_l t
diff --git a/src/lib_webassembly/script/import.mli b/src/lib_webassembly/script/import.mli
index 221491fa696a..f2384966d61e 100644
--- a/src/lib_webassembly/script/import.mli
+++ b/src/lib_webassembly/script/import.mli
@@ -8,3 +8,9 @@ val register :
   Types.extern_type ->
   Instance.extern Lwt.t (* raises Not_found *)) ->
   unit Lwt.t
+
+val lookup :
+  Ast.name ->
+  Ast.name ->
+  Types.extern_type ->
+  Instance.extern Lwt.t (* raises Not_found *)
-- 
GitLab


From 435f57eaa7c6a360dc04f9a488b52224b020d337 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 19 Jul 2022 14:38:48 +0200
Subject: [PATCH 3/8] Wasm: extract host function implementations to their own
 global table

---
 src/lib_scoru_wasm/host_funcs.ml           | 59 ++++++++++------------
 src/lib_scoru_wasm/host_funcs.mli          |  8 +--
 src/lib_scoru_wasm/test/test_input.ml      |  7 ++-
 src/lib_scoru_wasm/wasm_decodings.ml       | 20 ++------
 src/lib_webassembly/exec/eval.ml           |  3 +-
 src/lib_webassembly/host/env.ml            |  6 ++-
 src/lib_webassembly/host/spectest.ml       |  3 +-
 src/lib_webassembly/runtime/func.ml        | 14 +++--
 src/lib_webassembly/runtime/func.mli       | 21 +++-----
 src/lib_webassembly/runtime/host_funcs.ml  | 19 +++++++
 src/lib_webassembly/runtime/host_funcs.mli |  9 ++++
 src/lib_webassembly/runtime/instance.ml    |  2 +-
 src/lib_webassembly/script/import.ml       | 11 +---
 src/lib_webassembly/script/import.mli      |  6 ---
 14 files changed, 94 insertions(+), 94 deletions(-)
 create mode 100644 src/lib_webassembly/runtime/host_funcs.ml
 create mode 100644 src/lib_webassembly/runtime/host_funcs.mli

diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml
index a7de037ce0dc..d902b10cc2cc 100644
--- a/src/lib_scoru_wasm/host_funcs.ml
+++ b/src/lib_scoru_wasm/host_funcs.ml
@@ -59,8 +59,7 @@ let aux_write_input_in_memory ~input_buffer ~module_inst ~rtype_offset
     in
     Lwt.return input_size
 
-let read_input =
-  let open Lwt.Syntax in
+let read_input_desc =
   let input_types =
     Types.
       [
@@ -74,44 +73,40 @@ let read_input =
   in
   let output_types = Types.[NumType I32Type] |> Vector.of_list in
   let fun_type = Types.FuncType (input_types, output_types) in
-  let f input_buffer module_inst inputs =
-    match inputs with
-    | [
-     Values.(Num (I32 rtype_offset));
-     Values.(Num (I32 level_offset));
-     Values.(Num (I32 id_offset));
-     Values.(Num (I32 dst));
-     Values.(Num (I32 max_bytes));
-    ] ->
-        let* x =
-          aux_write_input_in_memory
-            ~input_buffer
-            ~module_inst
-            ~rtype_offset
-            ~level_offset
-            ~id_offset
-            ~dst
-            ~max_bytes
-        in
-        Lwt.return [Values.(Num (I32 (I32.of_int_s x)))]
-    | _ -> raise Bad_input
-  in
-  Func.HostFunc
-    {
-      func_type = fun_type;
-      module_name = "tezos";
-      func_name = "read_input";
-      implem = f;
-    }
+  {Func.func_type = fun_type; module_name = "tezos"; func_name = "read_input"}
+
+let read_input input_buffer module_inst inputs =
+  let open Lwt.Syntax in
+  match inputs with
+  | [
+   Values.(Num (I32 rtype_offset));
+   Values.(Num (I32 level_offset));
+   Values.(Num (I32 id_offset));
+   Values.(Num (I32 dst));
+   Values.(Num (I32 max_bytes));
+  ] ->
+      let* x =
+        aux_write_input_in_memory
+          ~input_buffer
+          ~module_inst
+          ~rtype_offset
+          ~level_offset
+          ~id_offset
+          ~dst
+          ~max_bytes
+      in
+      Lwt.return [Values.(Num (I32 (I32.of_int_s x)))]
+  | _ -> raise Bad_input
 
 let lookup _module_name name _t =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   match name with
-  | "read_input" -> ExternFunc read_input (* TODO: typecheck *)
+  | "read_input" -> ExternFunc (HostFunc read_input_desc)
   | _ -> raise Not_found
 
 let configure () =
+  Host_funcs.register ~module_name:"tezos" ~func_name:"read_input" read_input ;
   Import.register (Utf8.decode "tezos") (fun name t -> lookup "tezos" name t)
 
 module Internal_for_tests = struct
diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli
index 436f71fc916a..c0cff14eef65 100644
--- a/src/lib_scoru_wasm/host_funcs.mli
+++ b/src/lib_scoru_wasm/host_funcs.mli
@@ -46,10 +46,10 @@ exception Bad_input
     is no larger than the input is not too large. Finally, it returns
     returns a singleton value list containing the size of the
     input_buffer payload. *)
-val read_input :
-  ( Tezos_webassembly_interpreter.Input_buffer.t,
-    Tezos_webassembly_interpreter.Instance.module_inst ref )
-  Tezos_webassembly_interpreter.Func.func
+val read_input : Tezos_webassembly_interpreter.Host_funcs.host_func
+
+(** Host function descriptor for {!read_input} *)
+val read_input_desc : Tezos_webassembly_interpreter.Func.host_func_desc
 
 module Internal_for_tests : sig
   (** [aux_write_memory ~input_buffer ~module_inst ~rtype_offset
diff --git a/src/lib_scoru_wasm/test/test_input.ml b/src/lib_scoru_wasm/test/test_input.ml
index 3dd99ca36b3c..047ef02daeeb 100644
--- a/src/lib_scoru_wasm/test/test_input.ml
+++ b/src/lib_scoru_wasm/test/test_input.ml
@@ -153,8 +153,13 @@ let test_host_fun () =
         Num (I32 0l); Num (I32 4l); Num (I32 10l); Num (I32 50l); Num (I32 3600l);
       ]
   in
+  let* () = Host_funcs.configure () in
   let* module_inst, result =
-    Eval.invoke ~module_inst ~input Host_funcs.read_input values
+    Eval.invoke
+      ~module_inst
+      ~input
+      (Func.HostFunc Host_funcs.read_input_desc)
+      values
   in
   let* memory =
     Tezos_webassembly_interpreter.Lazy_vector.LwtInt32Vector.get
diff --git a/src/lib_scoru_wasm/wasm_decodings.ml b/src/lib_scoru_wasm/wasm_decodings.ml
index 9486369e30e3..9b5c7c4e8676 100644
--- a/src/lib_scoru_wasm/wasm_decodings.ml
+++ b/src/lib_scoru_wasm/wasm_decodings.ml
@@ -427,22 +427,10 @@ module Make (T : Tree.S) = struct
         (Data_encoding.string_enum [("host", true); ("native", false)])
     in
     if is_host_func then
-      let* module_name =
-        lazy_vector_decoding "module_name" (value [] Data_encoding.int31)
-      in
-      let* name =
-        lazy_vector_decoding "func_name" (value [] Data_encoding.int31)
-      in
-      let* t = scope ["func_type"] (func_type_decoding ()) in
-      of_lwt
-        (Lwt.bind
-           (Tezos_webassembly_interpreter.Import.lookup
-              module_name
-              name
-              (ExternFuncType t))
-           (function
-            | ExternFunc extern -> Lwt.return extern
-            | _ -> assert false))
+      let* module_name = value ["module_name"] Data_encoding.string in
+      let* func_name = value ["func_name"] Data_encoding.string in
+      let+ func_type = scope ["func_type"] (func_type_decoding ()) in
+      Func.HostFunc {module_name; func_name; func_type}
     else
       let* type_ = func_type_decoding () in
       let* ftype = value ["ftype"] Interpreter_encodings.Ast.var_encoding in
diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml
index ef8bfa393484..e80c039a133c 100644
--- a/src/lib_webassembly/exec/eval.ml
+++ b/src/lib_webassembly/exec/eval.ml
@@ -800,10 +800,11 @@ and step_resolved (c : config) frame vs e es : config Lwt.t =
               ]
             in
             (vs', [Frame (n2, frame', ([], instr')) @@ e.at])
-        | Func.HostFunc {func_type = t; implem = f; _} ->
+        | Func.HostFunc {module_name; func_name; func_type = _} ->
             let inst = ref frame.inst in
             Lwt.catch
               (fun () ->
+                let f = Host_funcs.lookup ~module_name ~func_name in
                 let+ res = f c.input inst (List.rev args) in
                 (List.rev res @ vs', []))
               (function
diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml
index fab074df5b2c..4d4f7aae5679 100644
--- a/src/lib_webassembly/host/env.ml
+++ b/src/lib_webassembly/host/env.ml
@@ -38,7 +38,9 @@ let lookup module_name name t =
   let+ name = Utf8.encode name in
   match (name, t) with
   | "abort", ExternFuncType t ->
-      ExternFunc (Func.alloc_host ~module_name ~func_name:name t abort)
+      Host_funcs.register ~module_name ~func_name:"abort" abort ;
+      ExternFunc (Func.alloc_host ~module_name ~func_name:name t)
   | "exit", ExternFuncType t ->
-      ExternFunc (Func.alloc_host ~module_name ~func_name:name t exit)
+      Host_funcs.register ~module_name ~func_name:"exit" exit ;
+      ExternFunc (Func.alloc_host ~module_name ~func_name:name t)
   | _ -> raise Not_found
diff --git a/src/lib_webassembly/host/spectest.ml b/src/lib_webassembly/host/spectest.ml
index a8089c6445a0..c62cb5d7a423 100644
--- a/src/lib_webassembly/host/spectest.ml
+++ b/src/lib_webassembly/host/spectest.ml
@@ -27,7 +27,8 @@ let table =
 let memory = Memory.alloc (MemoryType {min = 1l; max = Some 2l})
 
 let func module_name func_name f t =
-  Func.alloc_host ~module_name ~func_name t (f t)
+  Host_funcs.register ~module_name ~func_name (f t) ;
+  Func.alloc_host ~module_name ~func_name t
 
 let print_value v =
   Printf.printf
diff --git a/src/lib_webassembly/runtime/func.ml b/src/lib_webassembly/runtime/func.ml
index 97e43780b120..f43b37909615 100644
--- a/src/lib_webassembly/runtime/func.ml
+++ b/src/lib_webassembly/runtime/func.ml
@@ -1,23 +1,21 @@
 open Types
-open Values
 
-type ('input, 'inst) host_func_desc = {
+type host_func_desc = {
   module_name : string;
   func_name : string;
   func_type : func_type;
-  implem : 'input -> 'inst -> value list -> value list Lwt.t;
 }
 
-type ('input, 'inst) t = ('input, 'inst) func
+type 'inst t = 'inst func
 
-and ('input, 'inst) func =
+and 'inst func =
   | AstFunc of func_type * 'inst * Ast.func
-  | HostFunc of ('input, 'inst) host_func_desc
+  | HostFunc of host_func_desc
 
 let alloc ft inst f = AstFunc (ft, inst, f)
 
-let alloc_host ~module_name ~func_name ft f =
-  HostFunc {module_name; func_name; func_type = ft; implem = f}
+let alloc_host ~module_name ~func_name ft =
+  HostFunc {module_name; func_name; func_type = ft}
 
 let type_of = function
   | AstFunc (ft, _, _) -> ft
diff --git a/src/lib_webassembly/runtime/func.mli b/src/lib_webassembly/runtime/func.mli
index dff5383f7891..05f90af0fbd4 100644
--- a/src/lib_webassembly/runtime/func.mli
+++ b/src/lib_webassembly/runtime/func.mli
@@ -1,26 +1,21 @@
 open Types
-open Values
 
-type ('input, 'inst) host_func_desc = {
+type host_func_desc = {
   module_name : string;
   func_name : string;
   func_type : func_type;
-  implem : 'input -> 'inst -> value list -> value list Lwt.t;
+      (*  implem : 'input -> 'inst -> value list -> value list Lwt.t;*)
 }
 
-type ('input, 'inst) t = ('input, 'inst) func
+type 'inst t = 'inst func
 
-and ('input, 'inst) func =
+and 'inst func =
   | AstFunc of func_type * 'inst * Ast.func
-  | HostFunc of ('input, 'inst) host_func_desc
+  | HostFunc of host_func_desc
 
-val alloc : func_type -> 'inst -> Ast.func -> ('input, 'inst) func
+val alloc : func_type -> 'inst -> Ast.func -> 'inst func
 
 val alloc_host :
-  module_name:string ->
-  func_name:string ->
-  func_type ->
-  ('input -> 'inst -> value list -> value list Lwt.t) ->
-  ('input, 'inst) func
+  module_name:string -> func_name:string -> func_type -> 'inst func
 
-val type_of : ('input, 'inst) func -> func_type
+val type_of : 'inst func -> func_type
diff --git a/src/lib_webassembly/runtime/host_funcs.ml b/src/lib_webassembly/runtime/host_funcs.ml
new file mode 100644
index 000000000000..b1c7b1471867
--- /dev/null
+++ b/src/lib_webassembly/runtime/host_funcs.ml
@@ -0,0 +1,19 @@
+type host_func =
+  Input_buffer.t ->
+  Instance.module_inst ref ->
+  Values.value list ->
+  Values.value list Lwt.t
+
+module Registry = Map.Make (struct
+  type t = string * string
+
+  let compare = compare
+end)
+
+let registry : host_func Registry.t ref = ref Registry.empty
+
+let register ~module_name ~func_name implem =
+  registry := Registry.add (module_name, func_name) implem !registry
+
+let lookup ~module_name ~func_name =
+  Registry.find (module_name, func_name) !registry
diff --git a/src/lib_webassembly/runtime/host_funcs.mli b/src/lib_webassembly/runtime/host_funcs.mli
new file mode 100644
index 000000000000..08d5a9714632
--- /dev/null
+++ b/src/lib_webassembly/runtime/host_funcs.mli
@@ -0,0 +1,9 @@
+type host_func =
+  Input_buffer.t ->
+  Instance.module_inst ref ->
+  Values.value list ->
+  Values.value list Lwt.t
+
+val register : module_name:string -> func_name:string -> host_func -> unit
+
+val lookup : module_name:string -> func_name:string -> host_func
diff --git a/src/lib_webassembly/runtime/instance.ml b/src/lib_webassembly/runtime/instance.ml
index f0d6ca2b551c..56e0a66045df 100644
--- a/src/lib_webassembly/runtime/instance.ml
+++ b/src/lib_webassembly/runtime/instance.ml
@@ -24,7 +24,7 @@ type module_inst = {
   blocks : Ast.block_table;
 }
 
-and func_inst = (input_inst, module_inst ref) Func.t
+and func_inst = module_inst ref Func.t
 
 and table_inst = Table.t
 
diff --git a/src/lib_webassembly/script/import.ml b/src/lib_webassembly/script/import.ml
index 8954b73ad625..213a47d41b14 100644
--- a/src/lib_webassembly/script/import.ml
+++ b/src/lib_webassembly/script/import.ml
@@ -25,7 +25,7 @@ let register name lookup =
   registry := Registry.add name lookup !registry ;
   Lwt.return_unit
 
-let link_one (m : module_) (im : import) : Instance.extern Lwt.t =
+let lookup (m : module_) (im : import) : Instance.extern Lwt.t =
   let open Lwt.Syntax in
   let {module_name; item_name; idesc} = im.it in
   let* module_name_l = from_ast_name module_name in
@@ -44,11 +44,4 @@ let link_one (m : module_) (im : import) : Instance.extern Lwt.t =
 let link m =
   let open Lwt.Syntax in
   let* imports = Lazy_vector.LwtInt32Vector.to_list m.it.imports in
-  TzStdLib.List.map_s (link_one m) imports
-
-let lookup (module_name : Ast.name) (item_name : Ast.name)
-    (t : Types.extern_type) : Instance.extern Lwt.t =
-  let open Lwt.Syntax in
-  let* module_name_l = from_ast_name module_name in
-  let* item_name_l = from_ast_name item_name in
-  Registry.find module_name_l !registry item_name_l t
+  TzStdLib.List.map_s (lookup m) imports
diff --git a/src/lib_webassembly/script/import.mli b/src/lib_webassembly/script/import.mli
index f2384966d61e..221491fa696a 100644
--- a/src/lib_webassembly/script/import.mli
+++ b/src/lib_webassembly/script/import.mli
@@ -8,9 +8,3 @@ val register :
   Types.extern_type ->
   Instance.extern Lwt.t (* raises Not_found *)) ->
   unit Lwt.t
-
-val lookup :
-  Ast.name ->
-  Ast.name ->
-  Types.extern_type ->
-  Instance.extern Lwt.t (* raises Not_found *)
-- 
GitLab


From cd331841d9e690b2c5165607b16dce1683cb88c8 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 19 Jul 2022 15:53:46 +0200
Subject: [PATCH 4/8] Wasm: separate host function table symbols from their
 import names

---
 src/lib_scoru_wasm/host_funcs.ml           | 12 ++++++++----
 src/lib_scoru_wasm/host_funcs.mli          |  4 ++--
 src/lib_scoru_wasm/test/test_input.ml      |  3 ++-
 src/lib_scoru_wasm/wasm_decodings.ml       |  5 ++---
 src/lib_webassembly/exec/eval.ml           |  6 +++---
 src/lib_webassembly/host/env.ml            | 10 ++++++----
 src/lib_webassembly/host/spectest.ml       |  5 +++--
 src/lib_webassembly/runtime/func.ml        | 15 +++------------
 src/lib_webassembly/runtime/func.mli       | 12 ++----------
 src/lib_webassembly/runtime/host_funcs.ml  | 13 ++++---------
 src/lib_webassembly/runtime/host_funcs.mli | 10 ++++++++--
 11 files changed, 43 insertions(+), 52 deletions(-)

diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml
index d902b10cc2cc..93bc7f152c3b 100644
--- a/src/lib_scoru_wasm/host_funcs.ml
+++ b/src/lib_scoru_wasm/host_funcs.ml
@@ -59,7 +59,7 @@ let aux_write_input_in_memory ~input_buffer ~module_inst ~rtype_offset
     in
     Lwt.return input_size
 
-let read_input_desc =
+let read_input_type =
   let input_types =
     Types.
       [
@@ -73,7 +73,11 @@ let read_input_desc =
   in
   let output_types = Types.[NumType I32Type] |> Vector.of_list in
   let fun_type = Types.FuncType (input_types, output_types) in
-  {Func.func_type = fun_type; module_name = "tezos"; func_name = "read_input"}
+  fun_type
+
+let read_input_name = "tezos_read_input"
+
+let read_input_desc = (read_input_type, read_input_name)
 
 let read_input input_buffer module_inst inputs =
   let open Lwt.Syntax in
@@ -102,11 +106,11 @@ let lookup _module_name name _t =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   match name with
-  | "read_input" -> ExternFunc (HostFunc read_input_desc)
+  | "read_input" -> ExternFunc (HostFunc (read_input_type, read_input_name))
   | _ -> raise Not_found
 
 let configure () =
-  Host_funcs.register ~module_name:"tezos" ~func_name:"read_input" read_input ;
+  Host_funcs.register ~global_name:read_input_name read_input ;
   Import.register (Utf8.decode "tezos") (fun name t -> lookup "tezos" name t)
 
 module Internal_for_tests = struct
diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli
index c0cff14eef65..ab4bc14b0434 100644
--- a/src/lib_scoru_wasm/host_funcs.mli
+++ b/src/lib_scoru_wasm/host_funcs.mli
@@ -48,8 +48,8 @@ exception Bad_input
     input_buffer payload. *)
 val read_input : Tezos_webassembly_interpreter.Host_funcs.host_func
 
-(** Host function descriptor for {!read_input} *)
-val read_input_desc : Tezos_webassembly_interpreter.Func.host_func_desc
+(** Host function type and global name for {!read_input} *)
+val read_input_desc : Tezos_webassembly_interpreter.Types.func_type * string
 
 module Internal_for_tests : sig
   (** [aux_write_memory ~input_buffer ~module_inst ~rtype_offset
diff --git a/src/lib_scoru_wasm/test/test_input.ml b/src/lib_scoru_wasm/test/test_input.ml
index 047ef02daeeb..3a9c70c9f930 100644
--- a/src/lib_scoru_wasm/test/test_input.ml
+++ b/src/lib_scoru_wasm/test/test_input.ml
@@ -155,10 +155,11 @@ let test_host_fun () =
   in
   let* () = Host_funcs.configure () in
   let* module_inst, result =
+    let read_input_type, read_input_name = Host_funcs.read_input_desc in
     Eval.invoke
       ~module_inst
       ~input
-      (Func.HostFunc Host_funcs.read_input_desc)
+      (Func.HostFunc (read_input_type, read_input_name))
       values
   in
   let* memory =
diff --git a/src/lib_scoru_wasm/wasm_decodings.ml b/src/lib_scoru_wasm/wasm_decodings.ml
index 9b5c7c4e8676..286a73f1f0bb 100644
--- a/src/lib_scoru_wasm/wasm_decodings.ml
+++ b/src/lib_scoru_wasm/wasm_decodings.ml
@@ -427,10 +427,9 @@ module Make (T : Tree.S) = struct
         (Data_encoding.string_enum [("host", true); ("native", false)])
     in
     if is_host_func then
-      let* module_name = value ["module_name"] Data_encoding.string in
-      let* func_name = value ["func_name"] Data_encoding.string in
+      let* global_name = value ["global_name"] Data_encoding.string in
       let+ func_type = scope ["func_type"] (func_type_decoding ()) in
-      Func.HostFunc {module_name; func_name; func_type}
+      Func.HostFunc (func_type, global_name)
     else
       let* type_ = func_type_decoding () in
       let* ftype = value ["ftype"] Interpreter_encodings.Ast.var_encoding in
diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml
index e80c039a133c..4c1742b32acd 100644
--- a/src/lib_webassembly/exec/eval.ml
+++ b/src/lib_webassembly/exec/eval.ml
@@ -138,7 +138,7 @@ let func_ref inst x i at =
 
 let func_type_of = function
   | Func.AstFunc (t, inst, f) -> t
-  | Func.HostFunc {func_type = t; _} -> t
+  | Func.HostFunc (t, _) -> t
 
 let block_type inst bt =
   let empty () = Lazy_vector.LwtInt32Vector.create 0l in
@@ -800,11 +800,11 @@ and step_resolved (c : config) frame vs e es : config Lwt.t =
               ]
             in
             (vs', [Frame (n2, frame', ([], instr')) @@ e.at])
-        | Func.HostFunc {module_name; func_name; func_type = _} ->
+        | Func.HostFunc (_, global_name) ->
             let inst = ref frame.inst in
             Lwt.catch
               (fun () ->
-                let f = Host_funcs.lookup ~module_name ~func_name in
+                let f = Host_funcs.lookup ~global_name in
                 let+ res = f c.input inst (List.rev args) in
                 (List.rev res @ vs', []))
               (function
diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml
index 4d4f7aae5679..559daefc55cd 100644
--- a/src/lib_webassembly/host/env.ml
+++ b/src/lib_webassembly/host/env.ml
@@ -38,9 +38,11 @@ let lookup module_name name t =
   let+ name = Utf8.encode name in
   match (name, t) with
   | "abort", ExternFuncType t ->
-      Host_funcs.register ~module_name ~func_name:"abort" abort ;
-      ExternFunc (Func.alloc_host ~module_name ~func_name:name t)
+      let global_name = "env_abort" in
+      Host_funcs.register ~global_name abort ;
+      ExternFunc (Func.alloc_host ~global_name t)
   | "exit", ExternFuncType t ->
-      Host_funcs.register ~module_name ~func_name:"exit" exit ;
-      ExternFunc (Func.alloc_host ~module_name ~func_name:name t)
+      let global_name = "env_exit" in
+      Host_funcs.register ~global_name exit ;
+      ExternFunc (Func.alloc_host ~global_name t)
   | _ -> raise Not_found
diff --git a/src/lib_webassembly/host/spectest.ml b/src/lib_webassembly/host/spectest.ml
index c62cb5d7a423..91d23674ec7f 100644
--- a/src/lib_webassembly/host/spectest.ml
+++ b/src/lib_webassembly/host/spectest.ml
@@ -27,8 +27,9 @@ let table =
 let memory = Memory.alloc (MemoryType {min = 1l; max = Some 2l})
 
 let func module_name func_name f t =
-  Host_funcs.register ~module_name ~func_name (f t) ;
-  Func.alloc_host ~module_name ~func_name t
+  let global_name = module_name ^ "_" ^ func_name in
+  Host_funcs.register ~global_name (f t) ;
+  Func.alloc_host ~global_name t
 
 let print_value v =
   Printf.printf
diff --git a/src/lib_webassembly/runtime/func.ml b/src/lib_webassembly/runtime/func.ml
index f43b37909615..775926d9fe8d 100644
--- a/src/lib_webassembly/runtime/func.ml
+++ b/src/lib_webassembly/runtime/func.ml
@@ -1,22 +1,13 @@
 open Types
 
-type host_func_desc = {
-  module_name : string;
-  func_name : string;
-  func_type : func_type;
-}
-
 type 'inst t = 'inst func
 
 and 'inst func =
   | AstFunc of func_type * 'inst * Ast.func
-  | HostFunc of host_func_desc
+  | HostFunc of func_type * string
 
 let alloc ft inst f = AstFunc (ft, inst, f)
 
-let alloc_host ~module_name ~func_name ft =
-  HostFunc {module_name; func_name; func_type = ft}
+let alloc_host ~global_name ft = HostFunc (ft, global_name)
 
-let type_of = function
-  | AstFunc (ft, _, _) -> ft
-  | HostFunc {func_type = ft; _} -> ft
+let type_of = function AstFunc (ft, _, _) -> ft | HostFunc (ft, _) -> ft
diff --git a/src/lib_webassembly/runtime/func.mli b/src/lib_webassembly/runtime/func.mli
index 05f90af0fbd4..17eaf691cd5d 100644
--- a/src/lib_webassembly/runtime/func.mli
+++ b/src/lib_webassembly/runtime/func.mli
@@ -1,21 +1,13 @@
 open Types
 
-type host_func_desc = {
-  module_name : string;
-  func_name : string;
-  func_type : func_type;
-      (*  implem : 'input -> 'inst -> value list -> value list Lwt.t;*)
-}
-
 type 'inst t = 'inst func
 
 and 'inst func =
   | AstFunc of func_type * 'inst * Ast.func
-  | HostFunc of host_func_desc
+  | HostFunc of func_type * string
 
 val alloc : func_type -> 'inst -> Ast.func -> 'inst func
 
-val alloc_host :
-  module_name:string -> func_name:string -> func_type -> 'inst func
+val alloc_host : global_name:string -> func_type -> 'inst func
 
 val type_of : 'inst func -> func_type
diff --git a/src/lib_webassembly/runtime/host_funcs.ml b/src/lib_webassembly/runtime/host_funcs.ml
index b1c7b1471867..2ab4af015427 100644
--- a/src/lib_webassembly/runtime/host_funcs.ml
+++ b/src/lib_webassembly/runtime/host_funcs.ml
@@ -4,16 +4,11 @@ type host_func =
   Values.value list ->
   Values.value list Lwt.t
 
-module Registry = Map.Make (struct
-  type t = string * string
-
-  let compare = compare
-end)
+module Registry = Map.Make (String)
 
 let registry : host_func Registry.t ref = ref Registry.empty
 
-let register ~module_name ~func_name implem =
-  registry := Registry.add (module_name, func_name) implem !registry
+let register ~global_name implem =
+  registry := Registry.add global_name implem !registry
 
-let lookup ~module_name ~func_name =
-  Registry.find (module_name, func_name) !registry
+let lookup ~global_name = Registry.find global_name !registry
diff --git a/src/lib_webassembly/runtime/host_funcs.mli b/src/lib_webassembly/runtime/host_funcs.mli
index 08d5a9714632..9680669ce0c5 100644
--- a/src/lib_webassembly/runtime/host_funcs.mli
+++ b/src/lib_webassembly/runtime/host_funcs.mli
@@ -1,9 +1,15 @@
+(** The type of a Host function implementation *)
 type host_func =
   Input_buffer.t ->
   Instance.module_inst ref ->
   Values.value list ->
   Values.value list Lwt.t
 
-val register : module_name:string -> func_name:string -> host_func -> unit
+(** [register ~func_name implem] registers the implementation of a
+    named host function in the global symbol table. Will erase a
+    previous implementation for the given name. *)
+val register : global_name:string -> host_func -> unit
 
-val lookup : module_name:string -> func_name:string -> host_func
+(** [lookup ~func_name] looks for the implementation of a named host
+    function in the global symbol table. May raise [Not_found].*)
+val lookup : global_name:string -> host_func
-- 
GitLab


From 7934cabea002a12e9dca803cd5f8a87e1675e495 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 19 Jul 2022 22:00:44 +0200
Subject: [PATCH 5/8] Wasm: drop some useless parameter in module registry

---
 src/lib_scoru_wasm/host_funcs.ml      |  6 ++++--
 src/lib_scoru_wasm/host_funcs.mli     |  1 -
 src/lib_webassembly/bin/main.ml       |  6 ++----
 src/lib_webassembly/bin/script/run.ml |  2 +-
 src/lib_webassembly/host/env.ml       | 19 +++++++++++------
 src/lib_webassembly/host/spectest.ml  | 30 +++++++++++++--------------
 src/lib_webassembly/script/import.ml  |  3 +--
 src/lib_webassembly/script/import.mli |  4 +---
 8 files changed, 37 insertions(+), 34 deletions(-)

diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml
index 93bc7f152c3b..ee7c762260ba 100644
--- a/src/lib_scoru_wasm/host_funcs.ml
+++ b/src/lib_scoru_wasm/host_funcs.ml
@@ -102,7 +102,7 @@ let read_input input_buffer module_inst inputs =
       Lwt.return [Values.(Num (I32 (I32.of_int_s x)))]
   | _ -> raise Bad_input
 
-let lookup _module_name name _t =
+let lookup _module_name name =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   match name with
@@ -110,8 +110,10 @@ let lookup _module_name name _t =
   | _ -> raise Not_found
 
 let configure () =
+  (* register the host function implementation *)
   Host_funcs.register ~global_name:read_input_name read_input ;
-  Import.register (Utf8.decode "tezos") (fun name t -> lookup "tezos" name t)
+  (* register the [tezos] module containing the PVM host functions in the linker *)
+  Import.register (Utf8.decode "tezos") (lookup "tezos")
 
 module Internal_for_tests = struct
   let aux_write_input_in_memory = aux_write_input_in_memory
diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli
index ab4bc14b0434..48ca4430c3be 100644
--- a/src/lib_scoru_wasm/host_funcs.mli
+++ b/src/lib_scoru_wasm/host_funcs.mli
@@ -29,7 +29,6 @@
 val lookup :
   string ->
   Tezos_webassembly_interpreter.Ast.name ->
-  Tezos_webassembly_interpreter.Types.func_type ->
   Tezos_webassembly_interpreter.Instance.extern Lwt.t
 
 (** Plugs {!lookup} into the WASN interpreter module system. *)
diff --git a/src/lib_webassembly/bin/main.ml b/src/lib_webassembly/bin/main.ml
index 27601c92cef9..980d255e1d88 100644
--- a/src/lib_webassembly/bin/main.ml
+++ b/src/lib_webassembly/bin/main.ml
@@ -5,11 +5,9 @@ let version = "2.0"
 let configure () =
   let open Lwt.Syntax in
   let* () =
-    Import.register (Utf8.decode "spectest") (fun name type_ ->
-        Spectest.lookup "spectest" name type_)
+    Import.register (Utf8.decode "spectest") (Spectest.lookup "spectest")
   in
-  Import.register (Utf8.decode "env") (fun name type_ ->
-      Env.lookup "env" name type_)
+  Import.register (Utf8.decode "env") (Env.lookup "env")
 
 let banner () = print_endline (name ^ " " ^ version ^ " reference interpreter")
 
diff --git a/src/lib_webassembly/bin/script/run.ml b/src/lib_webassembly/bin/script/run.ml
index a5fc7ef8c4e3..139448aa6fdd 100644
--- a/src/lib_webassembly/bin/script/run.ml
+++ b/src/lib_webassembly/bin/script/run.ml
@@ -351,7 +351,7 @@ let lookup_module = lookup "module" modules
 
 let lookup_instance = lookup "module" instances
 
-let lookup_registry module_name item_name _t =
+let lookup_registry module_name item_name =
   let* item_name = Lazy_vector.LwtInt32Vector.to_list item_name in
   let+ value = Instance.export (Map.find module_name !registry) item_name in
   match value with Some ext -> ext | None -> raise Not_found
diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml
index 559daefc55cd..31eb8583afec 100644
--- a/src/lib_webassembly/host/env.ml
+++ b/src/lib_webassembly/host/env.ml
@@ -33,16 +33,23 @@ let abort _input _mod_inst vs =
 
 let exit _input (_mod_inst : module_inst ref) vs = exit (int (single vs))
 
-let lookup module_name name t =
+let lookup module_name name =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
-  match (name, t) with
-  | "abort", ExternFuncType t ->
+  match name with
+  | "abort" ->
       let global_name = "env_abort" in
       Host_funcs.register ~global_name abort ;
-      ExternFunc (Func.alloc_host ~global_name t)
-  | "exit", ExternFuncType t ->
+      ExternFunc
+        (Func.alloc_host
+           ~global_name
+           (FuncType (Vector.of_list [], Vector.of_list [])))
+  | "exit" ->
       let global_name = "env_exit" in
       Host_funcs.register ~global_name exit ;
-      ExternFunc (Func.alloc_host ~global_name t)
+      ExternFunc
+        (Func.alloc_host
+           ~global_name
+           (FuncType
+              (Vector.of_list [Types.(NumType I32Type)], Vector.of_list [])))
   | _ -> raise Not_found
diff --git a/src/lib_webassembly/host/spectest.ml b/src/lib_webassembly/host/spectest.ml
index 91d23674ec7f..1241858da0b2 100644
--- a/src/lib_webassembly/host/spectest.ml
+++ b/src/lib_webassembly/host/spectest.ml
@@ -45,7 +45,7 @@ let print (FuncType (_, out)) _m _v vs =
     (Lazy_vector.LwtInt32Vector.loaded_bindings out)
   |> Lwt.return
 
-let lookup module_name name t =
+let lookup module_name name =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   let empty () = Lazy_vector.LwtInt32Vector.create 0l in
@@ -54,34 +54,34 @@ let lookup module_name name t =
     Lazy_vector.LwtInt32Vector.(create 2l |> set 0l i |> set 1l j)
   in
   let func = func module_name name in
-  match (name, t) with
-  | "print", _ -> ExternFunc (func print (FuncType (empty (), empty ())))
-  | "print_i32", _ ->
+  match name with
+  | "print" -> ExternFunc (func print (FuncType (empty (), empty ())))
+  | "print_i32" ->
       ExternFunc (func print (FuncType (singleton (NumType I32Type), empty ())))
-  | "print_i64", _ ->
+  | "print_i64" ->
       ExternFunc (func print (FuncType (singleton (NumType I64Type), empty ())))
-  | "print_f32", _ ->
+  | "print_f32" ->
       ExternFunc (func print (FuncType (singleton (NumType F32Type), empty ())))
-  | "print_f64", _ ->
+  | "print_f64" ->
       ExternFunc (func print (FuncType (singleton (NumType F64Type), empty ())))
-  | "print_i32_f32", _ ->
+  | "print_i32_f32" ->
       ExternFunc
         (func
            print
            (FuncType (two (NumType I32Type) (NumType F32Type), empty ())))
-  | "print_f64_f64", _ ->
+  | "print_f64_f64" ->
       ExternFunc
         (func
            print
            (FuncType (two (NumType F64Type) (NumType F64Type), empty ())))
-  | "global_i32", _ ->
+  | "global_i32" ->
       ExternGlobal (global (GlobalType (NumType I32Type, Immutable)))
-  | "global_i64", _ ->
+  | "global_i64" ->
       ExternGlobal (global (GlobalType (NumType I64Type, Immutable)))
-  | "global_f32", _ ->
+  | "global_f32" ->
       ExternGlobal (global (GlobalType (NumType F32Type, Immutable)))
-  | "global_f64", _ ->
+  | "global_f64" ->
       ExternGlobal (global (GlobalType (NumType F64Type, Immutable)))
-  | "table", _ -> ExternTable table
-  | "memory", _ -> ExternMemory memory
+  | "table" -> ExternTable table
+  | "memory" -> ExternMemory memory
   | _ -> raise Not_found
diff --git a/src/lib_webassembly/script/import.ml b/src/lib_webassembly/script/import.ml
index 213a47d41b14..f2e1b8a920cd 100644
--- a/src/lib_webassembly/script/import.ml
+++ b/src/lib_webassembly/script/import.ml
@@ -30,9 +30,8 @@ let lookup (m : module_) (im : import) : Instance.extern Lwt.t =
   let {module_name; item_name; idesc} = im.it in
   let* module_name_l = from_ast_name module_name in
   let* item_name_l = from_ast_name item_name in
-  let* t = import_type m im in
   Lwt.catch
-    (fun () -> Registry.find module_name_l !registry item_name_l t)
+    (fun () -> Registry.find module_name_l !registry item_name_l)
     (function
       | Not_found ->
           Unknown.error
diff --git a/src/lib_webassembly/script/import.mli b/src/lib_webassembly/script/import.mli
index 221491fa696a..75a5e4188be9 100644
--- a/src/lib_webassembly/script/import.mli
+++ b/src/lib_webassembly/script/import.mli
@@ -4,7 +4,5 @@ val link : Ast.module_ -> Instance.extern list Lwt.t (* raises Unknown *)
 
 val register :
   Ast.name ->
-  (Ast.name ->
-  Types.extern_type ->
-  Instance.extern Lwt.t (* raises Not_found *)) ->
+  (Ast.name -> Instance.extern Lwt.t (* raises Not_found *)) ->
   unit Lwt.t
-- 
GitLab


From d7eb24efc16cc09b230c543e2be0aad817629b9e Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 19 Jul 2022 23:48:20 +0200
Subject: [PATCH 6/8] Wasm: make the host function registry local to the
 interpreter config

---
 src/lib_scoru_wasm/host_funcs.ml           |  9 ++--
 src/lib_scoru_wasm/host_funcs.mli          | 14 +++---
 src/lib_scoru_wasm/test/test_input.ml      |  5 +-
 src/lib_scoru_wasm/wasm_pvm.ml             | 12 ++++-
 src/lib_webassembly/bin/main.ml            | 10 ++--
 src/lib_webassembly/bin/script/run.ml      | 12 +++--
 src/lib_webassembly/bin/script/run.mli     |  2 +
 src/lib_webassembly/exec/eval.ml           | 26 +++++++---
 src/lib_webassembly/exec/eval.mli          |  6 ++-
 src/lib_webassembly/host/env.ml            |  8 +--
 src/lib_webassembly/host/spectest.ml       | 58 ++++++++++++++--------
 src/lib_webassembly/runtime/host_funcs.ml  |  8 +--
 src/lib_webassembly/runtime/host_funcs.mli | 10 +++-
 13 files changed, 119 insertions(+), 61 deletions(-)

diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml
index ee7c762260ba..e3c273bab2b5 100644
--- a/src/lib_scoru_wasm/host_funcs.ml
+++ b/src/lib_scoru_wasm/host_funcs.ml
@@ -102,18 +102,15 @@ let read_input input_buffer module_inst inputs =
       Lwt.return [Values.(Num (I32 (I32.of_int_s x)))]
   | _ -> raise Bad_input
 
-let lookup _module_name name =
+let lookup name =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   match name with
   | "read_input" -> ExternFunc (HostFunc (read_input_type, read_input_name))
   | _ -> raise Not_found
 
-let configure () =
-  (* register the host function implementation *)
-  Host_funcs.register ~global_name:read_input_name read_input ;
-  (* register the [tezos] module containing the PVM host functions in the linker *)
-  Import.register (Utf8.decode "tezos") (lookup "tezos")
+let register_host_funcs registry =
+  Host_funcs.register ~global_name:read_input_name read_input registry
 
 module Internal_for_tests = struct
   let aux_write_input_in_memory = aux_write_input_in_memory
diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli
index 48ca4430c3be..70226120bdaf 100644
--- a/src/lib_scoru_wasm/host_funcs.mli
+++ b/src/lib_scoru_wasm/host_funcs.mli
@@ -23,16 +23,18 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(** [lookup module_name name] retrieves or instantiates a host
-    function by the given [name] in the given [module_name].
-    Currently dispatches [Tezos.read_input] to {!read_input}. *)
+(** [lookup name] retrieves or instantiates a host function by the given [name].
+    Currently dispatches [read_input] to {!read_input} using host function global
+    names as registered by {!register_host_funcs}.
+    Used to plug host function wrappers in the WASN interpreter linker. *)
 val lookup :
-  string ->
   Tezos_webassembly_interpreter.Ast.name ->
   Tezos_webassembly_interpreter.Instance.extern Lwt.t
 
-(** Plugs {!lookup} into the WASN interpreter module system. *)
-val configure : unit -> unit Lwt.t
+(** [register_host_funcs] registers all the PVMs host functions into a WASM
+    interpreter's registry, using the names expected by {!lookup}. *)
+val register_host_funcs :
+  Tezos_webassembly_interpreter.Host_funcs.registry -> unit
 
 exception Bad_input
 
diff --git a/src/lib_scoru_wasm/test/test_input.ml b/src/lib_scoru_wasm/test/test_input.ml
index 3a9c70c9f930..21acc9e1106b 100644
--- a/src/lib_scoru_wasm/test/test_input.ml
+++ b/src/lib_scoru_wasm/test/test_input.ml
@@ -153,10 +153,13 @@ let test_host_fun () =
         Num (I32 0l); Num (I32 4l); Num (I32 10l); Num (I32 50l); Num (I32 3600l);
       ]
   in
-  let* () = Host_funcs.configure () in
+  let host_funcs_registry = Tezos_webassembly_interpreter.Host_funcs.empty () in
+  Host_funcs.register_host_funcs host_funcs_registry ;
+
   let* module_inst, result =
     let read_input_type, read_input_name = Host_funcs.read_input_desc in
     Eval.invoke
+      host_funcs_registry
       ~module_inst
       ~input
       (Func.HostFunc (read_input_type, read_input_name))
diff --git a/src/lib_scoru_wasm/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml
index 7caffb3d4cf3..a077a4106add 100644
--- a/src/lib_scoru_wasm/wasm_pvm.ml
+++ b/src/lib_scoru_wasm/wasm_pvm.ml
@@ -41,7 +41,17 @@ module Make (T : Tree.S) : Wasm_pvm_sig.S with type tree = T.tree = struct
 
         let compute_step s =
           let open Lwt.Syntax in
-          let* () = Host_funcs.configure () in
+          (* register the PVM host funcs wrappers in a module ["tezos"] into the WASM linker *)
+          let* () =
+            Tezos_webassembly_interpreter.(
+              Import.register (Utf8.decode "tezos"))
+              Host_funcs.lookup
+          in
+          (* build the registry of host functions (to be passed to the interpreter via its config *)
+          let host_funcs_registry =
+            Tezos_webassembly_interpreter.Host_funcs.empty ()
+          in
+          Host_funcs.register_host_funcs host_funcs_registry ;
           Lwt.return s
 
         (* TODO: https://gitlab.com/tezos/tezos/-/issues/3092
diff --git a/src/lib_webassembly/bin/main.ml b/src/lib_webassembly/bin/main.ml
index 980d255e1d88..34409ad2ccfa 100644
--- a/src/lib_webassembly/bin/main.ml
+++ b/src/lib_webassembly/bin/main.ml
@@ -4,10 +4,10 @@ let version = "2.0"
 
 let configure () =
   let open Lwt.Syntax in
-  let* () =
-    Import.register (Utf8.decode "spectest") (Spectest.lookup "spectest")
-  in
-  Import.register (Utf8.decode "env") (Env.lookup "env")
+  let* () = Import.register (Utf8.decode "spectest") Spectest.lookup in
+  let+ () = Import.register (Utf8.decode "env") Env.lookup in
+  Spectest.register_host_funcs Run.host_funcs_registry ;
+  Env.register_host_funcs Run.host_funcs_registry
 
 let banner () = print_endline (name ^ " " ^ version ^ " reference interpreter")
 
@@ -47,7 +47,7 @@ let run () =
   let open Lwt.Syntax in
   Lwt.catch
     (fun () ->
-      let* () = configure () in
+      let* registry = configure () in
       Arg.parse
         argspec
         (fun file -> add_arg ("(input " ^ quote file ^ ")"))
diff --git a/src/lib_webassembly/bin/script/run.ml b/src/lib_webassembly/bin/script/run.ml
index 139448aa6fdd..9652a6e67244 100644
--- a/src/lib_webassembly/bin/script/run.ml
+++ b/src/lib_webassembly/bin/script/run.ml
@@ -320,6 +320,8 @@ let print_results rs =
 
 (* Configuration *)
 
+let host_funcs_registry = Host_funcs.empty ()
+
 module Map = Map.Make (String)
 
 let quote : script ref = ref []
@@ -390,7 +392,9 @@ let run_action act : Values.value list Lwt.t =
                 Script.error v.at "wrong type of argument")
             vs
             ins_l ;
-          let+ _, result = Eval.invoke f (List.map (fun v -> v.it) vs) in
+          let+ _, result =
+            Eval.invoke host_funcs_registry f (List.map (fun v -> v.it) vs)
+          in
           result
       | Some _ -> Assert.error act.at "export is not a function"
       | None -> Assert.error act.at "undefined export")
@@ -509,7 +513,7 @@ let run_assertion ass : unit Lwt.t =
       Lwt.try_bind
         (fun () ->
           let* imports = Import.link m in
-          Eval.init m imports)
+          Eval.init host_funcs_registry m imports)
         (fun _ -> Assert.error ass.at "expected linking error")
         (function
           | Import.Unknown (_, msg) | Eval.Link (_, msg) ->
@@ -524,7 +528,7 @@ let run_assertion ass : unit Lwt.t =
       Lwt.try_bind
         (fun () ->
           let* imports = Import.link m in
-          Eval.init m imports)
+          Eval.init host_funcs_registry m imports)
         (fun _ -> Assert.error ass.at "expected instantiation error")
         (function
           | Eval.Trap (_, msg) -> assert_message ass.at "instantiation" msg re
@@ -572,7 +576,7 @@ let rec run_command cmd : unit Lwt.t =
       if not !Flags.dry then
         let* () = trace_lwt "Initializing..." in
         let* imports = Import.link m in
-        let+ inst = Eval.init m imports in
+        let+ inst = Eval.init host_funcs_registry m imports in
         bind instances x_opt inst
       else Lwt.return_unit
   | Register (name, x_opt) ->
diff --git a/src/lib_webassembly/bin/script/run.mli b/src/lib_webassembly/bin/script/run.mli
index 92fef80ba21f..fe92323f1016 100644
--- a/src/lib_webassembly/bin/script/run.mli
+++ b/src/lib_webassembly/bin/script/run.mli
@@ -11,3 +11,5 @@ val run_string : string -> bool Lwt.t
 val run_file : string -> bool Lwt.t
 
 val run_stdin : unit -> unit Lwt.t
+
+val host_funcs_registry : Host_funcs.registry
diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml
index 4c1742b32acd..825f8f2a41e0 100644
--- a/src/lib_webassembly/exec/eval.ml
+++ b/src/lib_webassembly/exec/eval.ml
@@ -76,13 +76,14 @@ type config = {
   frame : frame;
   input : input_inst;
   code : code;
+  host_funcs : Host_funcs.registry;
   budget : int; (* to model stack overflow *)
 }
 
 let frame inst locals = {inst; locals}
 
-let config ?(input = Input_buffer.alloc ()) inst vs es =
-  {frame = frame inst []; input; code = (vs, es); budget = 300}
+let config ?(input = Input_buffer.alloc ()) host_funcs inst vs es =
+  {frame = frame inst []; input; code = (vs, es); budget = 300; host_funcs}
 
 let plain e = Plain e.it @@ e.at
 
@@ -772,6 +773,7 @@ and step_resolved (c : config) frame vs e es : config Lwt.t =
               code = code';
               budget = c.budget - 1;
               input = c.input;
+              host_funcs = c.host_funcs;
             }
         in
         (vs, [Frame (n, c'.frame, c'.code) @@ e.at])
@@ -804,7 +806,7 @@ and step_resolved (c : config) frame vs e es : config Lwt.t =
             let inst = ref frame.inst in
             Lwt.catch
               (fun () ->
-                let f = Host_funcs.lookup ~global_name in
+                let f = Host_funcs.lookup ~global_name c.host_funcs in
                 let+ res = f c.input inst (List.rev args) in
                 (List.rev res @ vs', []))
               (function
@@ -823,7 +825,8 @@ let rec eval (c : config) : value stack Lwt.t =
 (* Functions & Constants *)
 
 let invoke ?(module_inst = empty_module_inst) ?(input = Input_buffer.alloc ())
-    (func : func_inst) (vs : value list) : (module_inst * value list) Lwt.t =
+    host_funcs (func : func_inst) (vs : value list) :
+    (module_inst * value list) Lwt.t =
   let at = match func with Func.AstFunc (_, _, f) -> f.at | _ -> no_region in
   let (FuncType (ins, out)) = Func.type_of func in
   let* ins_l = Lazy_vector.LwtInt32Vector.to_list ins in
@@ -840,7 +843,12 @@ let invoke ?(module_inst = empty_module_inst) ?(input = Input_buffer.alloc ())
     | Func.HostFunc _ -> Instance.Vector.create 0l
   in
   let c =
-    config ~input {module_inst with blocks} (List.rev vs) [Invoke func @@ at]
+    config
+      ~input
+      host_funcs
+      {module_inst with blocks}
+      (List.rev vs)
+      [Invoke func @@ at]
   in
   Lwt.catch
     (fun () ->
@@ -851,7 +859,9 @@ let invoke ?(module_inst = empty_module_inst) ?(input = Input_buffer.alloc ())
       | exn -> Lwt.fail exn)
 
 let eval_const (inst : module_inst) (const : const) : value Lwt.t =
-  let c = config inst [] [From_block (const.it, 0l) @@ const.at] in
+  let c =
+    config (Host_funcs.empty ()) inst [] [From_block (const.it, 0l) @@ const.at]
+  in
   let+ vs = eval c in
   match vs with
   | [v] -> v
@@ -989,7 +999,7 @@ let run_data inst i data =
 
 let run_start start = List.map plain [Call start.it.sfunc @@ start.at]
 
-let init (m : module_) (exts : extern list) : module_inst Lwt.t =
+let init host_funcs (m : module_) (exts : extern list) : module_inst Lwt.t =
   let open Lwt.Syntax in
   let {
     imports;
@@ -1111,6 +1121,6 @@ let init (m : module_) (exts : extern list) : module_inst Lwt.t =
   let es_data = List.concat (Lib.List32.mapi (run_data inst) datas) in
   let es_start = Lib.Option.get (Lib.Option.map run_start start) [] in
   let+ (_ : Values.value stack) =
-    eval (config inst [] (es_elem @ es_data @ es_start))
+    eval (config host_funcs inst [] (es_elem @ es_data @ es_start))
   in
   inst
diff --git a/src/lib_webassembly/exec/eval.mli b/src/lib_webassembly/exec/eval.mli
index 5ef8ec7c897f..cb39ff061951 100644
--- a/src/lib_webassembly/exec/eval.mli
+++ b/src/lib_webassembly/exec/eval.mli
@@ -10,11 +10,15 @@ exception Crash of Source.region * string
 exception Exhaustion of Source.region * string
 
 val init :
-  Ast.module_ -> extern list -> module_inst Lwt.t (* raises Link, Trap *)
+  Host_funcs.registry ->
+  Ast.module_ ->
+  extern list ->
+  module_inst Lwt.t (* raises Link, Trap *)
 
 val invoke :
   ?module_inst:module_inst ->
   ?input:Input_buffer.t ->
+  Host_funcs.registry ->
   func_inst ->
   value list ->
   (module_inst * value list) Lwt.t (* raises Trap *)
diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml
index 31eb8583afec..eb0e6708da55 100644
--- a/src/lib_webassembly/host/env.ml
+++ b/src/lib_webassembly/host/env.ml
@@ -33,20 +33,22 @@ let abort _input _mod_inst vs =
 
 let exit _input (_mod_inst : module_inst ref) vs = exit (int (single vs))
 
-let lookup module_name name =
+let register_host_funcs registry =
+  Host_funcs.register ~global_name:"abort" abort registry ;
+  Host_funcs.register ~global_name:"abort" exit registry
+
+let lookup name =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   match name with
   | "abort" ->
       let global_name = "env_abort" in
-      Host_funcs.register ~global_name abort ;
       ExternFunc
         (Func.alloc_host
            ~global_name
            (FuncType (Vector.of_list [], Vector.of_list [])))
   | "exit" ->
       let global_name = "env_exit" in
-      Host_funcs.register ~global_name exit ;
       ExternFunc
         (Func.alloc_host
            ~global_name
diff --git a/src/lib_webassembly/host/spectest.ml b/src/lib_webassembly/host/spectest.ml
index 1241858da0b2..725276dcc48a 100644
--- a/src/lib_webassembly/host/spectest.ml
+++ b/src/lib_webassembly/host/spectest.ml
@@ -26,26 +26,27 @@ let table =
 
 let memory = Memory.alloc (MemoryType {min = 1l; max = Some 2l})
 
-let func module_name func_name f t =
-  let global_name = module_name ^ "_" ^ func_name in
-  Host_funcs.register ~global_name (f t) ;
-  Func.alloc_host ~global_name t
-
 let print_value v =
   Printf.printf
     "%s : %s\n"
     (Values.string_of_value v)
     (Types.string_of_value_type (Values.type_of_value v))
 
-let print (FuncType (_, out)) _m _v vs =
+let print _i _m vs =
   List.iter print_value vs ;
   flush_all () ;
-  List.map
-    (fun (_, t) -> default_value t)
-    (Lazy_vector.LwtInt32Vector.loaded_bindings out)
-  |> Lwt.return
+  Lwt.return_nil
+
+let register_host_funcs registry =
+  Host_funcs.register ~global_name:"spectest_print" print registry ;
+  Host_funcs.register ~global_name:"spectest_print_i32" print registry ;
+  Host_funcs.register ~global_name:"spectest_print_i64" print registry ;
+  Host_funcs.register ~global_name:"spectest_print_f32" print registry ;
+  Host_funcs.register ~global_name:"spectest_print_f64" print registry ;
+  Host_funcs.register ~global_name:"spectest_print_i32_f32" print registry ;
+  Host_funcs.register ~global_name:"spectest_print_f64_f64" print registry
 
-let lookup module_name name =
+let lookup name =
   let open Lwt.Syntax in
   let+ name = Utf8.encode name in
   let empty () = Lazy_vector.LwtInt32Vector.create 0l in
@@ -53,26 +54,41 @@ let lookup module_name name =
   let two i j =
     Lazy_vector.LwtInt32Vector.(create 2l |> set 0l i |> set 1l j)
   in
-  let func = func module_name name in
   match name with
-  | "print" -> ExternFunc (func print (FuncType (empty (), empty ())))
+  | "print" ->
+      ExternFunc
+        (Func.alloc_host
+           ~global_name:"spectest_print"
+           (FuncType (empty (), empty ())))
   | "print_i32" ->
-      ExternFunc (func print (FuncType (singleton (NumType I32Type), empty ())))
+      ExternFunc
+        (Func.alloc_host
+           ~global_name:"spectest_print_i32"
+           (FuncType (singleton (NumType I32Type), empty ())))
   | "print_i64" ->
-      ExternFunc (func print (FuncType (singleton (NumType I64Type), empty ())))
+      ExternFunc
+        (Func.alloc_host
+           ~global_name:"spectest_print_i64"
+           (FuncType (singleton (NumType I64Type), empty ())))
   | "print_f32" ->
-      ExternFunc (func print (FuncType (singleton (NumType F32Type), empty ())))
+      ExternFunc
+        (Func.alloc_host
+           ~global_name:"spectest_print_f32"
+           (FuncType (singleton (NumType F32Type), empty ())))
   | "print_f64" ->
-      ExternFunc (func print (FuncType (singleton (NumType F64Type), empty ())))
+      ExternFunc
+        (Func.alloc_host
+           ~global_name:"spectest_print_f64"
+           (FuncType (singleton (NumType F64Type), empty ())))
   | "print_i32_f32" ->
       ExternFunc
-        (func
-           print
+        (Func.alloc_host
+           ~global_name:"spectest_print_i32_f32"
            (FuncType (two (NumType I32Type) (NumType F32Type), empty ())))
   | "print_f64_f64" ->
       ExternFunc
-        (func
-           print
+        (Func.alloc_host
+           ~global_name:"spectest_print_f64_f64"
            (FuncType (two (NumType F64Type) (NumType F64Type), empty ())))
   | "global_i32" ->
       ExternGlobal (global (GlobalType (NumType I32Type, Immutable)))
diff --git a/src/lib_webassembly/runtime/host_funcs.ml b/src/lib_webassembly/runtime/host_funcs.ml
index 2ab4af015427..21015d98f92e 100644
--- a/src/lib_webassembly/runtime/host_funcs.ml
+++ b/src/lib_webassembly/runtime/host_funcs.ml
@@ -6,9 +6,11 @@ type host_func =
 
 module Registry = Map.Make (String)
 
-let registry : host_func Registry.t ref = ref Registry.empty
+type registry = host_func Registry.t ref
 
-let register ~global_name implem =
+let empty () = ref Registry.empty
+
+let register ~global_name implem registry =
   registry := Registry.add global_name implem !registry
 
-let lookup ~global_name = Registry.find global_name !registry
+let lookup ~global_name registry = Registry.find global_name !registry
diff --git a/src/lib_webassembly/runtime/host_funcs.mli b/src/lib_webassembly/runtime/host_funcs.mli
index 9680669ce0c5..eaebf1a21de6 100644
--- a/src/lib_webassembly/runtime/host_funcs.mli
+++ b/src/lib_webassembly/runtime/host_funcs.mli
@@ -5,11 +5,17 @@ type host_func =
   Values.value list ->
   Values.value list Lwt.t
 
+(** A (mutable) host function registry *)
+type registry
+
+(** [empty ()] creates a new empty registry *)
+val empty : unit -> registry
+
 (** [register ~func_name implem] registers the implementation of a
     named host function in the global symbol table. Will erase a
     previous implementation for the given name. *)
-val register : global_name:string -> host_func -> unit
+val register : global_name:string -> host_func -> registry -> unit
 
 (** [lookup ~func_name] looks for the implementation of a named host
     function in the global symbol table. May raise [Not_found].*)
-val lookup : global_name:string -> host_func
+val lookup : global_name:string -> registry -> host_func
-- 
GitLab


From 1f7adf9cac512074ca1decf73db321e6a2719ff6 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Wed, 20 Jul 2022 17:00:44 +0200
Subject: [PATCH 7/8] Wasm: minor refactor of host function type

---
 src/lib_scoru_wasm/host_funcs.ml           | 53 +++++++++++-----------
 src/lib_scoru_wasm/host_funcs.mli          | 30 ++++++------
 src/lib_scoru_wasm/test/test_input.ml      |  3 +-
 src/lib_webassembly/exec/eval.ml           |  4 +-
 src/lib_webassembly/host/env.ml            | 16 ++++---
 src/lib_webassembly/host/spectest.ml       | 10 ++--
 src/lib_webassembly/runtime/host_funcs.ml  | 10 ++--
 src/lib_webassembly/runtime/host_funcs.mli | 10 ++--
 8 files changed, 74 insertions(+), 62 deletions(-)

diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml
index e3c273bab2b5..9320566785d9 100644
--- a/src/lib_scoru_wasm/host_funcs.ml
+++ b/src/lib_scoru_wasm/host_funcs.ml
@@ -72,35 +72,34 @@ let read_input_type =
     |> Vector.of_list
   in
   let output_types = Types.[NumType I32Type] |> Vector.of_list in
-  let fun_type = Types.FuncType (input_types, output_types) in
-  fun_type
+  Types.FuncType (input_types, output_types)
 
 let read_input_name = "tezos_read_input"
 
-let read_input_desc = (read_input_type, read_input_name)
-
-let read_input input_buffer module_inst inputs =
-  let open Lwt.Syntax in
-  match inputs with
-  | [
-   Values.(Num (I32 rtype_offset));
-   Values.(Num (I32 level_offset));
-   Values.(Num (I32 id_offset));
-   Values.(Num (I32 dst));
-   Values.(Num (I32 max_bytes));
-  ] ->
-      let* x =
-        aux_write_input_in_memory
-          ~input_buffer
-          ~module_inst
-          ~rtype_offset
-          ~level_offset
-          ~id_offset
-          ~dst
-          ~max_bytes
-      in
-      Lwt.return [Values.(Num (I32 (I32.of_int_s x)))]
-  | _ -> raise Bad_input
+let read_input =
+  Host_funcs.Host_func
+    (fun input_buffer module_inst inputs ->
+      let open Lwt.Syntax in
+      match inputs with
+      | [
+       Values.(Num (I32 rtype_offset));
+       Values.(Num (I32 level_offset));
+       Values.(Num (I32 id_offset));
+       Values.(Num (I32 dst));
+       Values.(Num (I32 max_bytes));
+      ] ->
+          let* x =
+            aux_write_input_in_memory
+              ~input_buffer
+              ~module_inst
+              ~rtype_offset
+              ~level_offset
+              ~id_offset
+              ~dst
+              ~max_bytes
+          in
+          Lwt.return [Values.(Num (I32 (I32.of_int_s x)))]
+      | _ -> raise Bad_input)
 
 let lookup name =
   let open Lwt.Syntax in
@@ -114,4 +113,6 @@ let register_host_funcs registry =
 
 module Internal_for_tests = struct
   let aux_write_input_in_memory = aux_write_input_in_memory
+
+  let read_input = Func.HostFunc (read_input_type, read_input_name)
 end
diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli
index 70226120bdaf..fb4ac90aa3f6 100644
--- a/src/lib_scoru_wasm/host_funcs.mli
+++ b/src/lib_scoru_wasm/host_funcs.mli
@@ -32,26 +32,24 @@ val lookup :
   Tezos_webassembly_interpreter.Instance.extern Lwt.t
 
 (** [register_host_funcs] registers all the PVMs host functions into a WASM
-    interpreter's registry, using the names expected by {!lookup}. *)
+    interpreter's registry, using the names expected by {!lookup}.
+
+    Currently, the registered functions are:
+    - [read_input]:
+      It has to be invoked with a list
+      of 5 values representing rtype_offset, level_offset, id_offset,
+      dst and max_bytes, otherwise it raises the [Bad_input] exception.
+
+      When invoked, it write the content of an input message into the
+      memory of a [module_inst]. It also checks that the input payload
+      is no larger than the input is not too large. Finally, it returns
+      returns a singleton value list containing the size of the
+      input_buffer payload. *)
 val register_host_funcs :
   Tezos_webassembly_interpreter.Host_funcs.registry -> unit
 
 exception Bad_input
 
-(** [read_input] is a host function. It has to be invoked with a list
-    of 5 values representing rtype_offset, level_offset, id_offset,
-    dst and max_bytes, otherwise it raises the [Bad_input] exception.
-
-    When invoked, it write the content of an input message into the
-    memory of a [module_inst]. It also checks that the input payload
-    is no larger than the input is not too large. Finally, it returns
-    returns a singleton value list containing the size of the
-    input_buffer payload. *)
-val read_input : Tezos_webassembly_interpreter.Host_funcs.host_func
-
-(** Host function type and global name for {!read_input} *)
-val read_input_desc : Tezos_webassembly_interpreter.Types.func_type * string
-
 module Internal_for_tests : sig
   (** [aux_write_memory ~input_buffer ~module_inst ~rtype_offset
        ~level_offset ~id_offset ~dst ~max_bytes] reads `input_buffer`
@@ -69,4 +67,6 @@ module Internal_for_tests : sig
     dst:int32 ->
     max_bytes:int32 ->
     int Lwt.t
+
+  val read_input : Tezos_webassembly_interpreter.Instance.func_inst
 end
diff --git a/src/lib_scoru_wasm/test/test_input.ml b/src/lib_scoru_wasm/test/test_input.ml
index 21acc9e1106b..b13f1a5da16f 100644
--- a/src/lib_scoru_wasm/test/test_input.ml
+++ b/src/lib_scoru_wasm/test/test_input.ml
@@ -157,12 +157,11 @@ let test_host_fun () =
   Host_funcs.register_host_funcs host_funcs_registry ;
 
   let* module_inst, result =
-    let read_input_type, read_input_name = Host_funcs.read_input_desc in
     Eval.invoke
       host_funcs_registry
       ~module_inst
       ~input
-      (Func.HostFunc (read_input_type, read_input_name))
+      Host_funcs.Internal_for_tests.read_input
       values
   in
   let* memory =
diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml
index 825f8f2a41e0..f19f6d54fd59 100644
--- a/src/lib_webassembly/exec/eval.ml
+++ b/src/lib_webassembly/exec/eval.ml
@@ -806,7 +806,9 @@ and step_resolved (c : config) frame vs e es : config Lwt.t =
             let inst = ref frame.inst in
             Lwt.catch
               (fun () ->
-                let f = Host_funcs.lookup ~global_name c.host_funcs in
+                let (Host_funcs.Host_func f) =
+                  Host_funcs.lookup ~global_name c.host_funcs
+                in
                 let+ res = f c.input inst (List.rev args) in
                 (List.rev res @ vs', []))
               (function
diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml
index eb0e6708da55..e6200de05876 100644
--- a/src/lib_webassembly/host/env.ml
+++ b/src/lib_webassembly/host/env.ml
@@ -26,12 +26,16 @@ let int = function
   | Num (I32 i) -> Int32.to_int i
   | v -> type_error v (NumType I32Type)
 
-let abort _input _mod_inst vs =
-  empty vs ;
-  print_endline "Abort!" ;
-  exit (-1)
-
-let exit _input (_mod_inst : module_inst ref) vs = exit (int (single vs))
+let abort =
+  Host_funcs.Host_func
+    (fun _input _mod_inst vs ->
+      empty vs ;
+      print_endline "Abort!" ;
+      exit (-1))
+
+let exit =
+  Host_funcs.Host_func
+    (fun _input (_mod_inst : module_inst ref) vs -> exit (int (single vs)))
 
 let register_host_funcs registry =
   Host_funcs.register ~global_name:"abort" abort registry ;
diff --git a/src/lib_webassembly/host/spectest.ml b/src/lib_webassembly/host/spectest.ml
index 725276dcc48a..556b18b87489 100644
--- a/src/lib_webassembly/host/spectest.ml
+++ b/src/lib_webassembly/host/spectest.ml
@@ -32,10 +32,12 @@ let print_value v =
     (Values.string_of_value v)
     (Types.string_of_value_type (Values.type_of_value v))
 
-let print _i _m vs =
-  List.iter print_value vs ;
-  flush_all () ;
-  Lwt.return_nil
+let print =
+  Host_funcs.Host_func
+    (fun _i _m vs ->
+      List.iter print_value vs ;
+      flush_all () ;
+      Lwt.return_nil)
 
 let register_host_funcs registry =
   Host_funcs.register ~global_name:"spectest_print" print registry ;
diff --git a/src/lib_webassembly/runtime/host_funcs.ml b/src/lib_webassembly/runtime/host_funcs.ml
index 21015d98f92e..e0e016cc21d8 100644
--- a/src/lib_webassembly/runtime/host_funcs.ml
+++ b/src/lib_webassembly/runtime/host_funcs.ml
@@ -1,8 +1,10 @@
 type host_func =
-  Input_buffer.t ->
-  Instance.module_inst ref ->
-  Values.value list ->
-  Values.value list Lwt.t
+  | Host_func of
+      (Input_buffer.t ->
+      Instance.module_inst ref ->
+      Values.value list ->
+      Values.value list Lwt.t)
+[@@ocaml.unboxed]
 
 module Registry = Map.Make (String)
 
diff --git a/src/lib_webassembly/runtime/host_funcs.mli b/src/lib_webassembly/runtime/host_funcs.mli
index eaebf1a21de6..34e1cb30badb 100644
--- a/src/lib_webassembly/runtime/host_funcs.mli
+++ b/src/lib_webassembly/runtime/host_funcs.mli
@@ -1,9 +1,11 @@
 (** The type of a Host function implementation *)
 type host_func =
-  Input_buffer.t ->
-  Instance.module_inst ref ->
-  Values.value list ->
-  Values.value list Lwt.t
+  | Host_func of
+      (Input_buffer.t ->
+      Instance.module_inst ref ->
+      Values.value list ->
+      Values.value list Lwt.t)
+[@@ocaml.unboxed]
 
 (** A (mutable) host function registry *)
 type registry
-- 
GitLab


From b2e0938adabc0f932c72edd8e9c5734463d20b56 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Wed, 20 Jul 2022 17:03:40 +0200
Subject: [PATCH 8/8] Wasm: minor refactor of Import.register

---
 src/lib_scoru_wasm/wasm_pvm.ml        | 2 +-
 src/lib_webassembly/bin/main.ml       | 6 ++++--
 src/lib_webassembly/bin/script/run.ml | 2 +-
 src/lib_webassembly/script/import.ml  | 4 ++--
 src/lib_webassembly/script/import.mli | 2 +-
 5 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/lib_scoru_wasm/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml
index a077a4106add..846d19792d87 100644
--- a/src/lib_scoru_wasm/wasm_pvm.ml
+++ b/src/lib_scoru_wasm/wasm_pvm.ml
@@ -44,7 +44,7 @@ module Make (T : Tree.S) : Wasm_pvm_sig.S with type tree = T.tree = struct
           (* register the PVM host funcs wrappers in a module ["tezos"] into the WASM linker *)
           let* () =
             Tezos_webassembly_interpreter.(
-              Import.register (Utf8.decode "tezos"))
+              Import.register ~module_name:(Utf8.decode "tezos"))
               Host_funcs.lookup
           in
           (* build the registry of host functions (to be passed to the interpreter via its config *)
diff --git a/src/lib_webassembly/bin/main.ml b/src/lib_webassembly/bin/main.ml
index 34409ad2ccfa..889c43eda17a 100644
--- a/src/lib_webassembly/bin/main.ml
+++ b/src/lib_webassembly/bin/main.ml
@@ -4,8 +4,10 @@ let version = "2.0"
 
 let configure () =
   let open Lwt.Syntax in
-  let* () = Import.register (Utf8.decode "spectest") Spectest.lookup in
-  let+ () = Import.register (Utf8.decode "env") Env.lookup in
+  let* () =
+    Import.register ~module_name:(Utf8.decode "spectest") Spectest.lookup
+  in
+  let+ () = Import.register ~module_name:(Utf8.decode "env") Env.lookup in
   Spectest.register_host_funcs Run.host_funcs_registry ;
   Env.register_host_funcs Run.host_funcs_registry
 
diff --git a/src/lib_webassembly/bin/script/run.ml b/src/lib_webassembly/bin/script/run.ml
index 9652a6e67244..165266bb9d2e 100644
--- a/src/lib_webassembly/bin/script/run.ml
+++ b/src/lib_webassembly/bin/script/run.ml
@@ -586,7 +586,7 @@ let rec run_command cmd : unit Lwt.t =
         let inst = lookup_instance x_opt cmd.at in
         let* utf8_name = Utf8.encode name in
         registry := Map.add utf8_name inst !registry ;
-        Import.register name (lookup_registry utf8_name))
+        Import.register ~module_name:name (lookup_registry utf8_name))
       else Lwt.return_unit
   | Action act ->
       quote := cmd :: !quote ;
diff --git a/src/lib_webassembly/script/import.ml b/src/lib_webassembly/script/import.ml
index f2e1b8a920cd..82b472401505 100644
--- a/src/lib_webassembly/script/import.ml
+++ b/src/lib_webassembly/script/import.ml
@@ -18,10 +18,10 @@ let registry = ref Registry.empty
 
 let from_ast_name name = Lazy_vector.LwtInt32Vector.to_list name
 
-let register name lookup =
+let register ~module_name lookup =
   let open Lwt.Syntax in
   let lookup name = lookup (Lazy_vector.LwtInt32Vector.of_list name) in
-  let* name = from_ast_name name in
+  let* name = from_ast_name module_name in
   registry := Registry.add name lookup !registry ;
   Lwt.return_unit
 
diff --git a/src/lib_webassembly/script/import.mli b/src/lib_webassembly/script/import.mli
index 75a5e4188be9..11fbe73235aa 100644
--- a/src/lib_webassembly/script/import.mli
+++ b/src/lib_webassembly/script/import.mli
@@ -3,6 +3,6 @@ exception Unknown of Source.region * string
 val link : Ast.module_ -> Instance.extern list Lwt.t (* raises Unknown *)
 
 val register :
-  Ast.name ->
+  module_name:Ast.name ->
   (Ast.name -> Instance.extern Lwt.t (* raises Not_found *)) ->
   unit Lwt.t
-- 
GitLab