exports.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2022 TriliTech <contact@trili.tech> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
(* For documentation please refer to the [Tezos_wasmer] module. *)
open Api
open Vectors
module Resolver = Map.Make (struct
type t = string * Types.Externkind.t
let compare (l1, l2) (r1, r2) =
match (String.compare l1 r1, Unsigned.UInt8.compare l2 r2) with
| 0, r -> r
| r, _ -> r
end)
type t = {resolved : Types.Extern.t Ctypes.ptr Resolver.t; clean : unit -> unit}
let from_instance inst =
let exports_vec = Module.exports inst.Instance.module_ in
let exports = Export_type_vector.to_list exports_vec in
let externs_vec = Extern_vector.empty () in
Functions.Instance.exports inst.instance (Ctypes.addr externs_vec) ;
let externs = Extern_vector.to_list externs_vec in
let resolved =
List.fold_right2
(fun export extern tail ->
let name = Export_type.name export in
let kind = Export_type.type_ export |> Functions.Externtype.kind in
Resolver.add (name, kind) extern tail)
exports
externs
Resolver.empty
in
(* The exports vector is consumed in read-only or copying fashion, therefore
there are no references to it at this point. We can clean it up. *)
Functions.Exporttype_vec.delete (Ctypes.addr exports_vec) ;
let clean () =
(* This function shall be called when the user no longer needs to interact
with the instance exports. Only then may we free the extern objects. *)
Functions.Extern_vec.delete (Ctypes.addr externs_vec)
in
{resolved; clean}
let delete exports = exports.clean ()
exception Export_not_found of {name : string; kind : Unsigned.uint8}
let () =
Printexc.register_printer (function
| Export_not_found {name; kind} ->
Some
(Format.asprintf
"Export %S (%i) not found"
name
(Unsigned.UInt8.to_int kind))
| _ -> None)
let fn exports name typ =
let kind = Types.Externkind.func in
let extern = Resolver.find_opt (name, kind) exports.resolved in
let extern =
match extern with
| None -> raise (Export_not_found {name; kind})
| Some extern -> extern
in
let func = Functions.Extern.as_func extern in
let f = Function.call func typ in
() ;
(* ^ This causes the current function to cap its arity. E.g. in case it gets
aggressively inlined we make sure that the resulting extern function is
entirely separate. *)
f
let mem_of_extern extern =
let mem = Functions.Extern.as_memory extern in
let mem_type = Functions.Memory.type_ mem in
let limits = Functions.Memory_type.limits mem_type in
let min, max =
let open Ctypes in
(!@(limits |-> Types.Limits.min), !@(limits |-> Types.Limits.max))
in
let max =
if Unsigned.UInt32.equal max Types.Limits.max_default then None
else Some max
in
let raw =
Ctypes.CArray.from_ptr
(Functions.Memory.data mem)
(Functions.Memory.data_size mem |> Unsigned.Size_t.to_int)
in
(* The memory type is no longer used after this, so we must delete it. *)
Functions.Memory_type.delete mem_type ;
Memory.{raw; min; max}
let mem exports name =
let kind = Types.Externkind.memory in
let extern = Resolver.find (name, kind) exports.resolved in
mem_of_extern extern
let mem0 exports =
let _, extern =
Resolver.bindings exports.resolved
|> List.find (fun ((_, kind), extern) -> kind = Types.Externkind.memory)
in
mem_of_extern extern