diff --git a/.gitlab/ci/opam-ci.yml b/.gitlab/ci/opam-ci.yml index f1618d8b6ff550cabc034873f45c43d66e4d28b2..7c0f5a32d280875d9ac5e1292005db6464449a8f 100644 --- a/.gitlab/ci/opam-ci.yml +++ b/.gitlab/ci/opam-ci.yml @@ -1571,6 +1571,13 @@ opam:tezos-version: variables: package: tezos-version +opam:tezos-wasmer: + extends: + - .opam_template + - .rules_template__trigger_opam_batch_7 + variables: + package: tezos-wasmer + opam:tezos-webassembly-interpreter: extends: - .opam_template diff --git a/.gitlab/ci/templates.yml b/.gitlab/ci/templates.yml index 3a11a350f2745ec13aa85a0ef6df923b95f5c481..0bec9d5d5f2175f6bffb39916dbf739a33826105 100644 --- a/.gitlab/ci/templates.yml +++ b/.gitlab/ci/templates.yml @@ -2,7 +2,7 @@ variables: # /!\ CI_REGISTRY is overriden to use a private Docker registry mirror in AWS ECR # in GitLab namespaces `nomadic-labs` and `tezos` ## This value MUST be the same as `opam_repository_tag` in `scripts/version.sh` - build_deps_image_version: 767d4c60d54970501f663666e39e0356328180fa + build_deps_image_version: e5c4c9e8bf716902dbeb699a73053c6d6202e4b9 build_deps_image_name: "${CI_REGISTRY}/tezos/opam-repository" GIT_STRATEGY: fetch GIT_DEPTH: "1" diff --git a/dune-project b/dune-project index 3461eed0d438c265897cd924bf3a658603aeeeb6..9b4d42dce0f8a439b807ac1017e308d633d95db1 100644 --- a/dune-project +++ b/dune-project @@ -210,6 +210,7 @@ (package (name tezos-tx-rollup-alpha)) (package (name tezos-validation)) (package (name tezos-version)) +(package (name tezos-wasmer)) (package (name tezos-webassembly-interpreter)) (package (name tezos-webassembly-interpreter-extra)) (package (name tezos-workers)) diff --git a/manifest/main.ml b/manifest/main.ml index 5de01f2fdc4664e7ae0828018d035164972a8e34..fad7cb4ea0b7e3384468d19eb554ff014e67f812 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -122,6 +122,13 @@ let conf_rust = opam_only "conf-rust" V.True let ctypes = external_lib ~js_compatible:true "ctypes" V.(at_least "0.18.0") +let ctypes_foreign = + external_lib + ~js_compatible:true + ~opam:"ctypes-foreign" + "ctypes.foreign" + V.(at_least "0.18.0") + let ctypes_stubs = external_sublib ctypes "ctypes.stubs" let ctypes_stubs_js = external_lib ~js_compatible:true "ctypes_stubs_js" V.True @@ -330,7 +337,7 @@ let tar = external_lib "tar" V.True let tar_unix = external_lib "tar-unix" V.(exactly "2.0.0") let tezos_rust_lib = - opam_only ~can_vendor:false "tezos-rust-libs" V.(exactly "1.1") + opam_only ~can_vendor:false "tezos-rust-libs" V.(exactly "1.2") let tls = external_lib "tls" V.(at_least "0.10") @@ -1570,6 +1577,27 @@ let _octez_p2p_tests = ]; ]) +let _octez_wasmer = + public_lib + "tezos-wasmer" + ~path:"src/lib_wasmer" + ~synopsis:"Wasmer bindings for SCORU WASM" + ~deps:[ctypes; ctypes_foreign; lwt; lwt_unix; tezos_rust_lib] + ~preprocess:[pps ppx_deriving_show] + ~flags:(Flags.standard ~disable_warnings:[9; 27] ()) + ~ctypes: + Ctypes. + { + external_library_name = "wasmer"; + include_header = "wasmer.h"; + extra_search_dir = "%{env:OPAM_SWITCH_PREFIX=}/lib/tezos-rust-libs"; + type_description = {instance = "Types"; functor_ = "Api_types_desc"}; + function_description = + {instance = "Functions"; functor_ = "Api_funcs_desc"}; + generated_types = "Api_types"; + generated_entry_point = "Api"; + } + let octez_scoru_wasm = public_lib "tezos-scoru-wasm" diff --git a/opam/tezos-sapling.opam b/opam/tezos-sapling.opam index 0d612ad3e073bee59de66336213bbad5c18a4c19..221191ce1841ac4a2d3593a236bd7e180284df04 100644 --- a/opam/tezos-sapling.opam +++ b/opam/tezos-sapling.opam @@ -18,7 +18,7 @@ depends: [ "tezos-stdlib" "tezos-crypto" "tezos-error-monad" - "tezos-rust-libs" { = "1.1" } + "tezos-rust-libs" { = "1.2" } "tezos-lwt-result-stdlib" "tezos-base" {with-test} "tezos-stdlib-unix" {with-test} diff --git a/opam/tezos-wasmer.opam b/opam/tezos-wasmer.opam new file mode 100644 index 0000000000000000000000000000000000000000..28c475aefa1356c3b7e377fe94f4aef26617d714 --- /dev/null +++ b/opam/tezos-wasmer.opam @@ -0,0 +1,26 @@ +# This file was automatically generated, do not edit. +# Edit file manifest/main.ml instead. +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: ["Tezos devteam"] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "dune" { >= "3.0" } + "ppx_deriving" + "ctypes" { >= "0.18.0" } + "ctypes-foreign" { >= "0.18.0" } + "lwt" { >= "5.6.0" } + "tezos-rust-libs" { = "1.2" } +] +x-opam-monorepo-opam-provided: [ + "tezos-rust-libs" +] +build: [ + ["rm" "-r" "vendors"] + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Wasmer bindings for SCORU WASM" diff --git a/scripts/version.sh b/scripts/version.sh index 950cfe9221a01a51a95f4d0a05518bc277aee6a5..a00a2838df52bf5864994a5cfe603b54fcd3ba24 100755 --- a/scripts/version.sh +++ b/scripts/version.sh @@ -25,7 +25,7 @@ export full_opam_repository_tag=87ee6c685f0d3e809d1c09a26038eb3b07cfebed ## opam_repository is an additional, tezos-specific opam repository. ## This value MUST be the same as `build_deps_image_version` in `.gitlab/ci/templates.ym export opam_repository_url=https://gitlab.com/tezos/opam-repository -export opam_repository_tag=767d4c60d54970501f663666e39e0356328180fa +export opam_repository_tag=e5c4c9e8bf716902dbeb699a73053c6d6202e4b9 export opam_repository_git=$opam_repository_url.git export opam_repository=$opam_repository_git\#$opam_repository_tag diff --git a/shell.nix b/shell.nix index 2207a7c2743e3c15d4c32edfa1122035902da4e5..cc0d51c899d97a92b5308e1ac8497bcaeab52f6a 100644 --- a/shell.nix +++ b/shell.nix @@ -112,19 +112,11 @@ let # Tweak the dependencies. (final: prev: { - conf-rust = prev.conf-rust.overrideAttrs (old: { + conf-rust-2021 = prev.conf-rust.overrideAttrs (old: { propagatedNativeBuildInputs = (old.propagatedNativeBuildInputs or [ ]) ++ - # Need Rust compiler - already fixed in upstream opam-repository - [ pkgs.rustc ]; - }); - - tezos-rust-libs = prev.tezos-rust-libs.overrideAttrs (old: { - propagatedNativeBuildInputs = - (old.propagatedNativeBuildInputs or [ ]) - ++ - # Missing libiconv dependency + # Upstream conf-rust* packages don't request libiconv [ pkgs.libiconv ]; }); }) diff --git a/src/lib_wasmer/api_funcs_desc.ml b/src/lib_wasmer/api_funcs_desc.ml new file mode 100644 index 0000000000000000000000000000000000000000..0a18fbde54109f5c5f065a9b30ca3f331fc6c1e0 --- /dev/null +++ b/src/lib_wasmer/api_funcs_desc.ml @@ -0,0 +1,365 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Ctypes +module Types = Api_types + +(** This functor is used by Ctypes to generate function bindings for the + Wasmer C API. *) +module Functions (S : FOREIGN) = struct + open S + + (** This functor corresponds to the [WASM_DECLARE_VEC] macro in [wasm.h]. *) + module Declare_vec (Vector : sig + include Types.Named_type + + type item + + val item : item typ + end) = + struct + let new_empty = + foreign + ("wasm_" ^ Vector.name ^ "_new_empty") + (ptr Vector.t @-> returning void) + + let new_ = + foreign + ("wasm_" ^ Vector.name ^ "_new") + (ptr Vector.t @-> size_t @-> ptr Vector.item @-> returning void) + + let new_uninitialized = + foreign + ("wasm_" ^ Vector.name ^ "_new_uninitialized") + (ptr Vector.t @-> size_t @-> returning void) + + let delete = + foreign + ("wasm_" ^ Vector.name ^ "_delete") + (ptr Vector.t @-> returning void) + end + + (** Generate a pointer type from another type. *) + module Ptr (Item : sig + val name : string + + type t + + val t : t typ + end) = + struct + include Item + + type t = Item.t Ctypes.ptr + + let t = ptr Item.t + end + + (** Functions with the [wasmer_] prefix *) + module Wasmer = struct + module Compiler = struct + let is_available = + foreign + "wasmer_is_compiler_available" + (Types.Wasmer.Compiler.t @-> returning bool) + end + end + + (** Functions with the [wasm_config_] prefix *) + module Config = struct + let new_ = + foreign "wasm_config_new" (void @-> returning (ptr Types.Config.t)) + + let set_compiler = + foreign + "wasm_config_set_compiler" + (ptr Types.Config.t @-> Types.Wasmer.Compiler.t @-> returning void) + + let delete = + foreign "wasm_config_delete" (ptr Types.Config.t @-> returning void) + end + + (** Functions with the [wasm_engine_] prefix *) + module Engine = struct + let new_with_config = + foreign + "wasm_engine_new_with_config" + (ptr Types.Config.t @-> returning (ptr Types.Engine.t)) + + let delete = + foreign "wasm_engine_delete" (ptr Types.Engine.t @-> returning void) + end + + (** Functions with the [wasm_store_] prefix *) + module Store = struct + let new_ = + foreign + "wasm_store_new" + (ptr Types.Engine.t @-> returning (ptr Types.Store.t)) + + let delete = + foreign "wasm_store_delete" (ptr Types.Store.t @-> returning void) + end + + (** Functions with the [wasm_module_] prefix *) + module Module = struct + let new_ = + foreign + "wasm_module_new" + (ptr Types.Store.t @-> ptr Types.Byte_vec.t + @-> returning (ptr Types.Module.t)) + + let delete = + foreign "wasm_module_delete" (ptr Types.Module.t @-> returning void) + + let imports = + foreign + "wasm_module_imports" + (ptr Types.Module.t @-> ptr Types.Importtype.Vec.t @-> returning void) + + let exports = + foreign + "wasm_module_exports" + (ptr Types.Module.t @-> ptr Types.Exporttype.Vec.t @-> returning void) + end + + (** Functions with the [wasm_byte_vec_] prefix *) + module Byte_vec = struct + (* NOTE: This module does not use [Declare_vec] to allow us to use the + better [Ctypes.string] type which takes care of string marshalling. *) + + let new_ = + foreign + "wasm_byte_vec_new" + (ptr Types.Byte_vec.t @-> Ctypes.size_t @-> Ctypes.string + @-> returning void) + + let new_empty = + foreign "wasm_byte_vec_new_empty" (ptr Types.Byte_vec.t @-> returning void) + + let delete = + foreign "wasm_byte_vec_delete" (ptr Types.Byte_vec.t @-> returning void) + end + + (** Functions with the [wasm_val_vec_] prefix *) + module Val_vec = Declare_vec (Types.Val_vec) + + (** Functions with the [wasm_valtype_] prefix *) + module Valtype = struct + let new_ = + foreign + "wasm_valtype_new" + (Types.Valkind.t @-> returning (ptr Types.Valtype.t)) + + let kind = + foreign + "wasm_valtype_kind" + (ptr Types.Valtype.t @-> returning Types.Valkind.t) + end + + (** Functions with the [wasm_valtype_vec_] prefix *) + module Valtype_vec = Declare_vec (Types.Valtype.Vec) + + (** Functions with the [wasm_extern_] prefix *) + module Extern = struct + let as_func = + foreign + "wasm_extern_as_func" + (ptr Types.Extern.t @-> returning (ptr Types.Func.t)) + + let as_memory = + foreign + "wasm_extern_as_memory" + (ptr Types.Extern.t @-> returning (ptr Types.Memory.t)) + end + + (** Functions with the [wasm_extern_vec_] prefix *) + module Extern_vec = Declare_vec (Types.Extern.Vec) + + (** Functions with the [wasm_functype_] prefix *) + module Functype = struct + let new_ = + foreign + "wasm_functype_new" + (ptr Types.Valtype.Vec.t @-> ptr Types.Valtype.Vec.t + @-> returning (ptr Types.Functype.t)) + + let params = + foreign + "wasm_functype_params" + (ptr Types.Functype.t @-> returning (ptr Types.Valtype.Vec.t)) + + let results = + foreign + "wasm_functype_results" + (ptr Types.Functype.t @-> returning (ptr Types.Valtype.Vec.t)) + end + + (** Functions with the [wasm_func_] prefix *) + module Func = struct + let new_ = + foreign + "wasm_func_new" + (ptr Types.Store.t @-> ptr Types.Functype.t @-> Types.Func_callback.t + @-> returning (ptr Types.Func.t)) + + let as_extern = + foreign + "wasm_func_as_extern" + (ptr Types.Func.t @-> returning (ptr Types.Extern.t)) + + let call = + foreign + "wasm_func_call" + (ptr Types.Func.t @-> ptr Types.Val_vec.t @-> ptr Types.Val_vec.t + @-> returning (ptr Types.Trap.t)) + + let param_arity = + foreign "wasm_func_param_arity" (ptr Types.Func.t @-> returning size_t) + + let result_arity = + foreign "wasm_func_result_arity" (ptr Types.Func.t @-> returning size_t) + + let type_ = + foreign + "wasm_func_type" + (ptr Types.Func.t @-> returning (ptr Types.Functype.t)) + end + + (** Functions with the [wasm_memory_] prefix *) + module Memory = struct + let data = + foreign "wasm_memory_data" (ptr Types.Memory.t @-> returning (ptr uint8_t)) + + let data_size = + foreign "wasm_memory_data_size" (ptr Types.Memory.t @-> returning size_t) + + let type_ = + foreign + "wasm_memory_type" + (ptr Types.Memory.t @-> returning (ptr Types.Memorytype.t)) + end + + (** Functions with the [wasm_memory_type_] prefix *) + module Memory_type = struct + let limits = + foreign + "wasm_memorytype_limits" + (ptr Types.Memorytype.t @-> returning (ptr Types.Limits.t)) + + let delete = + foreign + "wasm_memorytype_delete" + (ptr Types.Memorytype.t @-> returning void) + end + + (** Functions with the [wasm_instance_] prefix *) + module Instance = struct + let new_ = + foreign + "wasm_instance_new" + (ptr Types.Store.t @-> ptr Types.Module.t @-> ptr Types.Extern.Vec.t + @-> ptr (ptr Types.Trap.t) + @-> returning (ptr Types.Instance.t)) + + let delete = + foreign "wasm_instance_delete" (ptr Types.Instance.t @-> returning void) + + let exports = + foreign + "wasm_instance_exports" + (ptr Types.Instance.t @-> ptr Types.Extern.Vec.t @-> returning void) + end + + (** Functions with the [wasm_name_] prefix *) + module Name = Byte_vec + + (** Functions with the [wasm_message_] prefix *) + module Message = Name + + (** Functions with the [wasm_trap_] prefix *) + module Trap = struct + let new_ = + foreign + "wasm_trap_new" + (ptr Types.Store.t @-> ptr Types.Message.t + @-> returning (ptr Types.Trap.t)) + + let message = + foreign + "wasm_trap_message" + (ptr Types.Trap.t @-> ptr Types.Message.t @-> returning void) + end + + (** Functions with the [wasm_externtype_] prefix *) + module Externtype = struct + let kind = + foreign + "wasm_externtype_kind" + (ptr Types.Externtype.t @-> returning Types.Externkind.t) + end + + (** Functions with the [wasm_importtype_] prefix *) + module Importtype = struct + let module_ = + foreign + "wasm_importtype_module" + (ptr Types.Importtype.t @-> returning (ptr Types.Name.t)) + + let name = + foreign + "wasm_importtype_name" + (ptr Types.Importtype.t @-> returning (ptr Types.Name.t)) + + let type_ = + foreign + "wasm_importtype_type" + (ptr Types.Importtype.t @-> returning (ptr Types.Externtype.t)) + end + + (** Functions with the [wasm_importtype_vec_] prefix *) + module Importtype_vec = Declare_vec (Types.Importtype.Vec) + + (** Functions with the [wasm_exporttype_] prefix *) + module Exporttype = struct + let name = + foreign + "wasm_exporttype_name" + (ptr Types.Exporttype.t @-> returning (ptr Types.Name.t)) + + let type_ = + foreign + "wasm_exporttype_type" + (ptr Types.Exporttype.t @-> returning (ptr Types.Externtype.t)) + end + + (** Functions with the [wasm_exporttype_vec_] prefix *) + module Exporttype_vec = Declare_vec (Types.Exporttype.Vec) + + let wat2wasm = + foreign + "wat2wasm" + (ptr Types.Byte_vec.t @-> ptr Types.Byte_vec.t @-> returning void) +end diff --git a/src/lib_wasmer/api_types_desc.ml b/src/lib_wasmer/api_types_desc.ml new file mode 100644 index 0000000000000000000000000000000000000000..8a58c1d6558730598f040dd80c3af67acd8a9882 --- /dev/null +++ b/src/lib_wasmer/api_types_desc.ml @@ -0,0 +1,383 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** This functor is used by Ctypes to generate Wasmer C API type bindings. *) +module Types (S : Ctypes.TYPE) = struct + open S + + module type Named = sig + val name : string + end + + module type Named_struct = sig + include Named + + type s + + type t = s Ctypes.structure + + val t : t typ + end + + (** This functor corresponds to the [WASM_DECLARE_OWN] macro in [wasm.h]. *) + module Declare_own (Desc : Named) : Named_struct = struct + include Desc + + type s + + type t = s Ctypes.structure + + let t : t typ = + let name = "wasm_" ^ Desc.name ^ "_t" in + typedef (structure name) name + end + + module type Named_type = sig + include Named + + type t + + val t : t typ + end + + module type Vec = sig + type s + + include Named_type with type t = s Ctypes.structure + + type item + + val item : item typ + + val size : (Unsigned.size_t, t) field + + val data : (item Ctypes.ptr, t) field + end + + (** This functor corresponds to the [WASM_DECLARE_VEC] macro in [wasm.h]. *) + module Declare_vec (Item : Named_type) : Vec with type item = Item.t = struct + let name = Item.name ^ "_vec" + + type s + + type t = s Ctypes.structure + + let t : t typ = + let name = "wasm_" ^ name ^ "_t" in + typedef (structure name) name + + type item = Item.t + + let item = Item.t + + let size = field t "size" size_t + + let data = field t "data" (ptr Item.t) + + let () = seal t + end + + (** Generate a pointer type from another type. *) + module Ptr (Item : Named_type) : Named_type with type t = Item.t Ctypes.ptr = + struct + include Item + + type t = Item.t Ctypes.ptr + + let t = ptr Item.t + end + + module Declare_type (Desc : Named) : sig + include Named_struct + + module Vec : Vec with type item = t Ctypes.ptr + end = struct + module Self = Declare_own (Desc) + module Vec = Declare_vec (Ptr (Self)) + include Self + end + + module Wasmer = struct + (** [wasmer_compiler_t] *) + module Compiler = struct + type s + + type t = CRANELIFT | LLVM | SINGLEPASS + + let t : t typ = + enum + "wasmer_compiler_t" + [ + (CRANELIFT, constant "CRANELIFT" int64_t); + (LLVM, constant "LLVM" int64_t); + (SINGLEPASS, constant "SINGLEPASS" int64_t); + ] + end + end + + (** [wasm_config_t] *) + module Config = Declare_own (struct + let name = "config" + end) + + (** [wasm_engine_t] *) + module Engine = Declare_own (struct + let name = "engine" + end) + + (** [wasm_store_t] *) + module Store = Declare_own (struct + let name = "store" + end) + + (** [wasm_module_t] *) + module Module = Declare_own (struct + let name = "module" + end) + + (** [wasm_byte_t] *) + module Byte = struct + type t = Unsigned.uint8 + + let t = uint8_t + + let name = "byte" + end + + (** [wasm_byte_vec_t] *) + module Byte_vec = Declare_vec (Byte) + + (** [wasm_name_t] *) + module Name = Byte_vec + + (** [wasm_message_t] *) + module Message = Name + + module Ref_repr = struct + type s + + type t = s Ctypes.structure + + let t : t Ctypes.typ = Ctypes.structure "wasm_ref_t" + end + + (** [wasm_ref_t] *) + module Ref = struct + let name = "ref" + + type t = Ref_repr.s Ctypes.structure + + let t : t typ = S.lift_typ Ref_repr.t + end + + (** [wasm_valkind_t] *) + module Valkind = struct + type t = Unsigned.uint8 + + let i32 = constant "WASM_I32" uint8_t + + let i64 = constant "WASM_I64" uint8_t + + let f32 = constant "WASM_F32" uint8_t + + let f64 = constant "WASM_F64" uint8_t + + let anyref = constant "WASM_ANYREF" uint8_t + + let funcref = constant "WASM_FUNCREF" uint8_t + + let t : t typ = uint8_t + end + + (* The actual [Val.t] is an abstract representation of values. + Unfortunately, it can't be properly represented using Ctypes' stubs + functionality because it contains an anonymous union field. + + However, the default Ctypes functionality works fine here. The down side is + that this is not sufficiently type checked, hence we must be careful with + declarations below. + + Ultimately the [Val.t] is still the type to be used. The types described + by this module are lifted within the [Val] module. + *) + module Val_repr = struct + open Ctypes + + module Of = struct + type s + + type t = s union + + let t : t typ = union "" + + let i32 = field t "i32" int32_t + + let i64 = field t "i64" int64_t + + let f32 = field t "f32" float + + let f64 = field t "f64" double + + let ref = field t "ref" (ptr Ref_repr.t) + + let () = seal t + end + + type s + + type t = s structure + + let t : t typ = structure "wasm_val_t" + + let kind = field t "kind" uint8_t + + let of_ = field t "of" Of.t + + let () = seal t + end + + (** [wasm_val_t] *) + module Val = struct + let name = "val" + + type t = Val_repr.s Ctypes.structure + + let t : t typ = S.lift_typ Val_repr.t + end + + (** [wasm_val_vec_t] *) + module Val_vec = Declare_vec (Val) + + (** [wasm_trap_t] *) + module Trap = Declare_own (struct + let name = "trap" + end) + + (** [wasm_valtype_t] *) + module Valtype = Declare_type (struct + let name = "valtype" + end) + + module Func_callback = struct + let t = + Foreign.funptr + ~runtime_lock:true + (* [runtime_lock=true] is required to unblock execution in other + threads. Without it, we would deadlock. The description of [funptr] + is a little confusing: it seems to suggest that it must be + [runtime_lock=false] to work - but that seems false in experiments. + *) + (ptr Val_vec.t @-> ptr Val_vec.t @-> returning (ptr Trap.t)) + end + + (** [wasm_func_t] *) + module Func = Declare_own (struct + let name = "func" + end) + + (** [wasm_memory_t] *) + module Memory = Declare_own (struct + let name = "memory" + end) + + (** [wasm_extern_t] *) + module Extern = Declare_type (struct + let name = "extern" + end) + + (** [wasm_instance_t] *) + module Instance = Declare_own (struct + let name = "instance" + end) + + (** [wasm_functype_t] *) + module Functype = Declare_own (struct + let name = "functype" + end) + + (** [wasm_globaltype_t] *) + module Globaltype = Declare_own (struct + let name = "globaltype" + end) + + (** [wasm_tabletype_t] *) + module Tabletype = Declare_own (struct + let name = "tabletype" + end) + + (** [wasm_memorytype_t] *) + module Memorytype = Declare_own (struct + let name = "memorytype" + end) + + (** [wasm_limits_t] *) + module Limits = struct + open Ctypes + + type s + + type t = s structure + + let t : t typ = structure "wasm_limits_t" + + let min = field t "min" uint32_t + + let max = field t "max" uint32_t + + let () = seal t + + let max_default = constant "wasm_limits_max_default" S.uint32_t + end + + (** [wasm_externkind_t] *) + module Externkind = struct + type t = Unsigned.uint8 + + let func = constant "WASM_EXTERN_FUNC" uint8_t + + let global = constant "WASM_EXTERN_GLOBAL" uint8_t + + let table = constant "WASM_EXTERN_TABLE" uint8_t + + let memory = constant "WASM_EXTERN_MEMORY" uint8_t + + let t : t typ = uint8_t + end + + (** [wasm_externtype_t] *) + module Externtype = Declare_own (struct + let name = "externtype" + end) + + (** [wasm_exporttype_t] *) + module Exporttype = Declare_type (struct + let name = "exporttype" + end) + + (** [wasm_importtype_t] *) + module Importtype = Declare_type (struct + let name = "importtype" + end) +end diff --git a/src/lib_wasmer/config.ml b/src/lib_wasmer/config.ml new file mode 100644 index 0000000000000000000000000000000000000000..8661285ca719e5382c9db8cb6108b8bbe0ff2106 --- /dev/null +++ b/src/lib_wasmer/config.ml @@ -0,0 +1,49 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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 Utils +open Api + +exception Failed_to_create + +type compiler = Types.Wasmer.Compiler.t = CRANELIFT | LLVM | SINGLEPASS + +let is_compiler_available = Functions.Wasmer.Compiler.is_available + +exception Compiler_unavailable of compiler + +type t = {compiler : compiler} + +let default = {compiler = SINGLEPASS} + +let to_owned desc = + let conf = Functions.Config.new_ () in + check_null_ptr Failed_to_create conf ; + let has_compiler = is_compiler_available desc.compiler in + if not has_compiler then raise (Compiler_unavailable desc.compiler) ; + Functions.Config.set_compiler conf desc.compiler ; + conf diff --git a/src/lib_wasmer/dune b/src/lib_wasmer/dune new file mode 100644 index 0000000000000000000000000000000000000000..690f58863a22d0d35faf79133d3ab102cbb60f14 --- /dev/null +++ b/src/lib_wasmer/dune @@ -0,0 +1,36 @@ +; This file was automatically generated, do not edit. +; Edit file manifest/main.ml instead. + +(library + (name tezos_wasmer) + (public_name tezos-wasmer) + (instrumentation (backend bisect_ppx)) + (libraries + ctypes + ctypes.foreign + lwt + lwt.unix) + (preprocess (pps ppx_deriving.show)) + (flags + (:standard) + -w -9-27) + (ctypes + (external_library_name wasmer) + (build_flags_resolver + (vendored + (c_flags + :standard + -Wno-discarded-qualifiers + -I%{env:OPAM_SWITCH_PREFIX=}/lib/tezos-rust-libs) + (c_library_flags + :standard + -lwasmer + -L%{env:OPAM_SWITCH_PREFIX=}/lib/tezos-rust-libs))) + (headers (include wasmer.h)) + (type_description (instance Types) (functor Api_types_desc)) + (function_description + (concurrency unlocked) + (instance Functions) + (functor Api_funcs_desc)) + (generated_types Api_types) + (generated_entry_point Api))) diff --git a/src/lib_wasmer/engine.ml b/src/lib_wasmer/engine.ml new file mode 100644 index 0000000000000000000000000000000000000000..c06d3aac977f05896b188b59570b02509f51a76f --- /dev/null +++ b/src/lib_wasmer/engine.ml @@ -0,0 +1,45 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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 Utils +open Api + +exception Failed_to_create + +type t = + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of [Types.Engine.t] is respected. + *) + Types.Engine.t Ctypes.ptr + +let create config = + let config = Config.to_owned config in + let engine = Functions.Engine.new_with_config config in + check_null_ptr Failed_to_create engine ; + engine + +let delete = Functions.Engine.delete diff --git a/src/lib_wasmer/export_type.ml b/src/lib_wasmer/export_type.ml new file mode 100644 index 0000000000000000000000000000000000000000..733a0568b10f8243c34b296a8dae0340a9b0b1b6 --- /dev/null +++ b/src/lib_wasmer/export_type.ml @@ -0,0 +1,39 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api +open Vectors + +type t = + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of [Types.Exporttype.t] is respected. + *) + Types.Exporttype.t Ctypes.ptr + +let name modul = + let name = Functions.Exporttype.name modul in + Name.to_string Ctypes.(!@name) + +let type_ = Functions.Exporttype.type_ diff --git a/src/lib_wasmer/exports.ml b/src/lib_wasmer/exports.ml new file mode 100644 index 0000000000000000000000000000000000000000..261b2764da44edd63dd592dfda6a32e714cd3ebd --- /dev/null +++ b/src/lib_wasmer/exports.ml @@ -0,0 +1,102 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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 = + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of each [Types.Extern.t] is respected. + *) + Types.Extern.t Ctypes.ptr Resolver.t + +let from_instance inst = + let exports = + Module.exports inst.Instance.module_ |> Export_type_vector.to_list + in + let externs = Extern_vector.empty () in + Functions.Instance.exports inst.instance (Ctypes.addr externs) ; + let externs = Extern_vector.to_list externs in + 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 + +let fn exports name typ = + let kind = Types.Externkind.func in + let extern = Resolver.find (name, kind) exports 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 + Memory.{raw; min; max} + +let mem exports name = + let kind = Types.Externkind.memory in + let extern = Resolver.find (name, kind) exports in + mem_of_extern extern + +let mem0 exports = + let _, extern = + Resolver.bindings exports + |> List.find (fun ((_, kind), extern) -> kind = Types.Externkind.memory) + in + mem_of_extern extern diff --git a/src/lib_wasmer/extern.ml b/src/lib_wasmer/extern.ml new file mode 100644 index 0000000000000000000000000000000000000000..c983016bf55f7f9b9861e84e7655c1dcef4f80ff --- /dev/null +++ b/src/lib_wasmer/extern.ml @@ -0,0 +1,35 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api + +type t = Function : 'a Function_type.t * 'a -> t + +let to_extern wasmer ext = + match ext with + | Function (typ, f) -> + Function.create wasmer typ f |> Functions.Func.as_extern + +let to_externkind = function Function _ -> Types.Externkind.func diff --git a/src/lib_wasmer/function.ml b/src/lib_wasmer/function.ml new file mode 100644 index 0000000000000000000000000000000000000000..8bcc8ffa33a2625243d19db79e235a1271ebe3b7 --- /dev/null +++ b/src/lib_wasmer/function.ml @@ -0,0 +1,148 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api +open Vectors + +type owned = + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of [Types.Func.t] is respected. + *) + Types.Func.t Ctypes.ptr + +let call_with_inputs params f inputs = + let rec go : type f r. (f, r) Function_type.params -> f -> int -> r = + fun params f index -> + match params with + | Function_type.End_param -> f + | Trigger_param params -> (go [@tailcall]) params (f ()) index + | Cons_param (typ, params) -> + let value = + Value_vector.get Ctypes.(!@inputs) index |> Value.unpack typ + in + (go [@tailcall]) params (f value) (succ index) + in + go params f 0 + +let pack_outputs results r outputs = + Value_vector.init_uninitialized outputs (Function_type.num_results results) ; + let rec go : type r. r Function_type.results -> r -> int -> unit = + fun results value index -> + match results with + | Function_type.No_result -> () + | Function_type.One_result typ -> + let value = Value.pack typ value in + Value_vector.set Ctypes.(!@outputs) index value + | Function_type.Cons_result (typ, results) -> + let x, xs = value in + let value = Value.pack typ x in + Value_vector.set Ctypes.(!@outputs) index value ; + (go [@tailcall]) results xs (succ index) + in + go results r 0 + +let create : type f. Store.t -> f Function_type.t -> f -> owned = + fun store typ f -> + let func_type = Function_type.to_owned typ in + let (Function_type.Function (params, results)) = typ in + let run inputs outputs = + let result = + Lwt_preemptive.run_in_main (fun () -> call_with_inputs params f inputs) + in + pack_outputs results result outputs + in + let try_run inputs outputs = + try + let () = run inputs outputs in + Trap.none + with exn -> Trap.from_string store (Printexc.to_string exn) + in + Functions.Func.new_ store func_type try_run + +let call_raw func inputs = + let open Lwt.Syntax in + let outputs = Value_vector.uninitialized (Functions.Func.result_arity func) in + let+ trap = + Lwt_preemptive.detach + (fun (inputs, outputs) -> + Functions.Func.call func (Ctypes.addr inputs) (Ctypes.addr outputs)) + (inputs, outputs) + in + Trap.check trap ; + outputs + +let pack_inputs (type x r) (params : (x, r Lwt.t) Function_type.params) func + (unpack : Value_vector.t -> r) = + let open Lwt.Syntax in + let inputs = Value_vector.uninitialized (Function_type.num_params params) in + let rec go_params : type f. (f, r Lwt.t) Function_type.params -> int -> f = + fun params index -> + match params with + | Function_type.End_param -> + let+ outputs = call_raw func inputs in + unpack outputs + | Trigger_param params -> fun () -> (go_params [@tailcall]) params index + | Cons_param (typ, params) -> + fun x -> + Value_vector.set inputs index (Value.pack typ x) ; + (go_params [@tailcall]) params (succ index) + in + go_params params 0 + +exception + Not_enough_outputs of {expected : Unsigned.size_t; got : Unsigned.size_t} + +let () = + Printexc.register_printer (function + | Not_enough_outputs {got; expected} -> + Some + (Printf.sprintf + "Function did return less values (%s) than expected (%s)" + (Unsigned.Size_t.to_string got) + (Unsigned.Size_t.to_string got)) + | _ -> None) + +let unpack_outputs results outputs = + let got = Value_vector.length outputs in + let expected = Function_type.num_results results in + if (* Fewer outputs than expected. *) + Unsigned.Size_t.compare got expected < 0 + then raise (Not_enough_outputs {got; expected}) ; + let rec go : type r x. r Function_type.results -> int -> (r -> x) -> x = + fun params index k -> + match params with + | Function_type.No_result -> k () + | Function_type.One_result typ -> + Value_vector.get outputs index |> Value.unpack typ |> k + | Function_type.Cons_result (typ, results) -> + let x = Value_vector.get outputs index |> Value.unpack typ in + (go [@tailcall]) results (succ index) (fun xs -> k (x, xs)) + in + go results 0 Fun.id + +let call func typ = + Function_type.check_types typ (Functions.Func.type_ func) ; + let (Function_type.Function (params, results)) = typ in + pack_inputs params func (unpack_outputs results) diff --git a/src/lib_wasmer/function_type.ml b/src/lib_wasmer/function_type.ml new file mode 100644 index 0000000000000000000000000000000000000000..bd19742b922496eafb0f22872a94affc69fca680 --- /dev/null +++ b/src/lib_wasmer/function_type.ml @@ -0,0 +1,184 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api +open Vectors + +type (_, _) params = + | End_param : ('r, 'r) params + | Trigger_param : ('a, 'r) params -> (unit -> 'a, 'r) params + | Cons_param : 'a Value_type.t * ('b, 'r) params -> ('a -> 'b, 'r) params + +let num_params params = + let rec go : type f r. (f, r) params -> Unsigned.size_t -> Unsigned.size_t = + fun params num -> + match params with + | End_param -> num + | Trigger_param params -> (go [@tailcail]) params num + | Cons_param (_, params) -> + (go [@tailcail]) params (Unsigned.Size_t.succ num) + in + go params Unsigned.Size_t.zero + +let param_types params = + let inputs = Value_type_vector.uninitialized (num_params params) in + let set_type index typ = + Value_type_vector.set inputs index (Value_type.to_valtype typ) + in + let rec go : type f r. (f, r) params -> int -> unit = + fun params index -> + match params with + | End_param -> () + | Trigger_param params -> (go [@tailcail]) params index + | Cons_param (typ, params) -> + set_type index typ ; + (go [@tailcail]) params (succ index) + in + go params 0 ; + inputs + +type _ results = + | No_result : unit results + | One_result : 'a Value_type.t -> 'a results + | Cons_result : 'a Value_type.t * 'b results -> ('a * 'b) results + +let num_results results = + let rec go : type r. r results -> Unsigned.size_t -> Unsigned.size_t = + fun results num -> + match results with + | No_result -> num + | One_result _ -> Unsigned.Size_t.succ num + | Cons_result (_, results) -> + (go [@tailcail]) results (Unsigned.Size_t.succ num) + in + go results Unsigned.Size_t.zero + +let result_types results = + let outputs = Value_type_vector.uninitialized (num_results results) in + let set_type index typ = + Value_type_vector.set outputs index (Value_type.to_valtype typ) + in + let rec go : type r. r results -> int -> unit = + fun results index -> + match results with + | No_result -> () + | One_result typ -> set_type index typ + | Cons_result (typ, results) -> + set_type index typ ; + (go [@tailcail]) results (succ index) + in + go results 0 ; + outputs + +type 'f t = Function : ('f, 'r Lwt.t) params * 'r results -> 'f t + +let to_owned (Function (params, results)) = + let inputs = param_types params in + let outputs = result_types results in + (* Note, this consumes the elements in [inputs] and [outputs] but not the + structures themselves. Ctypes will free the structures once they go out + of scope. *) + Functions.Functype.new_ (Ctypes.addr inputs) (Ctypes.addr outputs) + +exception + Wrong_number_of_params of {expected : Unsigned.size_t; got : Unsigned.size_t} + +let () = + Printexc.register_printer (function + | Wrong_number_of_params {expected; got} -> + Some + (Printf.sprintf + "Wrong number of parameters: expected %s, got %s" + (Unsigned.Size_t.to_string expected) + (Unsigned.Size_t.to_string got)) + | _ -> None) + +let check_param_types params param_types = + let expected = num_params params in + let got = Value_type_vector.length param_types in + if + (* Fewer or more params than expected. *) + not (Unsigned.Size_t.equal expected got) + then raise (Wrong_number_of_params {got; expected}) ; + let rec go : type f r. (f, r) params -> int -> unit = + fun params index -> + match params with + | End_param -> () + | Trigger_param params -> (go [@tailcail]) params index + | Cons_param (expected, params) -> + Value_type_vector.get param_types index |> Value_type.check expected ; + (go [@tailcail]) params (succ index) + in + go params 0 + +exception + Not_enough_results of {expected : Unsigned.size_t; got : Unsigned.size_t} + +let () = + Printexc.register_printer (function + | Not_enough_results {expected; got} -> + Some + (Printf.sprintf + "Not enough results: expected %s, got %s" + (Unsigned.Size_t.to_string expected) + (Unsigned.Size_t.to_string got)) + | _ -> None) + +let check_result_types results result_types = + let expected = num_results results in + let got = Value_type_vector.length result_types in + if (* Fewer resuls than expected. *) + Unsigned.Size_t.compare got expected < 0 + then raise (Not_enough_results {got; expected}) ; + let rec go : type r. r results -> int -> unit = + fun results index -> + match results with + | No_result -> () + | One_result expected -> + Value_type_vector.get result_types index |> Value_type.check expected + | Cons_result (expected, results) -> + Value_type_vector.get result_types index |> Value_type.check expected ; + (go [@tailcail]) results (succ index) + in + go results 0 + +exception Function_type_mismatch of {reason : exn} + +let () = + Printexc.register_printer (function + | Function_type_mismatch {reason} -> + Some + (Printf.sprintf + "Function type does not match: %s" + (Printexc.to_string reason)) + | _ -> None) + +let check_types (Function (params, results)) func_type = + try + let param_types = Functions.Functype.params func_type in + check_param_types params Ctypes.(!@param_types) ; + let result_types = Functions.Functype.results func_type in + check_result_types results Ctypes.(!@result_types) + with exn -> raise (Function_type_mismatch {reason = exn}) diff --git a/src/lib_wasmer/import_type.ml b/src/lib_wasmer/import_type.ml new file mode 100644 index 0000000000000000000000000000000000000000..c1e9642e1397bdcc33f9406c8e1a9803614e90ab --- /dev/null +++ b/src/lib_wasmer/import_type.ml @@ -0,0 +1,37 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api +open Vectors + +let module_ modul = + let name = Functions.Importtype.module_ modul in + Name.to_string Ctypes.(!@name) + +let name modul = + let name = Functions.Importtype.name modul in + Name.to_string Ctypes.(!@name) + +let type_ = Functions.Importtype.type_ diff --git a/src/lib_wasmer/instance.ml b/src/lib_wasmer/instance.ml new file mode 100644 index 0000000000000000000000000000000000000000..020c8ed1ec758ceeec815d6085bafc3a4a87b6ef --- /dev/null +++ b/src/lib_wasmer/instance.ml @@ -0,0 +1,99 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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 +open Utils + +module Resolver = Map.Make (struct + type t = string * string * Types.Externkind.t + + let compare (l1, l2, l3) (r1, r2, r3) = + match + (String.compare l1 r1, String.compare l2 r2, Unsigned.UInt8.compare l3 r3) + with + | 0, 0, r -> r + | 0, r, _ -> r + | r, _, _ -> r +end) + +exception Null + +(* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of [Types.Instance.t] is respected. +*) +type t = {module_ : Module.t; instance : Types.Instance.t Ctypes.ptr} + +exception + Unsatisfied_import of { + module_ : string; + name : string; + kind : Types.Externkind.t; + } + +let resolve_imports store modul resolver = + let lookup import = + let module_ = Import_type.module_ import in + let name = Import_type.name import in + let kind = Import_type.type_ import |> Functions.Externtype.kind in + let match_ = Resolver.find_opt (module_, name, kind) resolver in + match match_ with + | None -> raise (Unsatisfied_import {module_; name; kind}) + | Some m -> Extern.to_extern store m + in + + Module.imports modul |> Import_type_vector.to_array |> Array.map lookup + |> Extern_vector.from_array + +let create store module_ externs = + let open Lwt.Syntax in + let externs_vec = + externs + |> List.map (fun (module_, name, extern) -> + ((module_, name, Extern.to_externkind extern), extern)) + |> List.to_seq |> Resolver.of_seq + |> resolve_imports store module_ + in + + let trap = Ctypes.allocate_n (Ctypes.ptr Types.Trap.t) ~count:1 in + Ctypes.(trap <-@ Trap.none) ; + + let+ instance = + Lwt_preemptive.detach + (fun (store, module_, externs_vec, trap) -> + Functions.Instance.new_ store module_ (Ctypes.addr externs_vec) trap) + (store, module_, externs_vec, trap) + in + + let trap = Ctypes.(!@trap) in + Trap.check trap ; + + check_null_ptr Null instance ; + + {module_; instance} + +let delete inst = Functions.Instance.delete inst.instance diff --git a/src/lib_wasmer/memory.ml b/src/lib_wasmer/memory.ml new file mode 100644 index 0000000000000000000000000000000000000000..8fa0210f9dbe96867fb03a79350d444878c7e609 --- /dev/null +++ b/src/lib_wasmer/memory.ml @@ -0,0 +1,38 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +module Array = Ctypes.CArray + +type t = { + raw : Unsigned.uint8 Array.t; + min : Unsigned.uint32; + max : Unsigned.uint32 option; +} + +let get mem = Array.get mem.raw + +let set mem = Array.set mem.raw + +let length mem = Array.length mem.raw diff --git a/src/lib_wasmer/module.ml b/src/lib_wasmer/module.ml new file mode 100644 index 0000000000000000000000000000000000000000..eafc820f796f50bd98af6b61821776f4fe6949fd --- /dev/null +++ b/src/lib_wasmer/module.ml @@ -0,0 +1,69 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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 Utils +open Vectors +open Api + +exception Failed_to_create + +type t = + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of [Types.Module.t] is respected. + *) + Types.Module.t Ctypes.ptr + +let wat2wasm code = + let source = Byte_vector.from_string code in + let dest = Byte_vector.empty () in + Functions.wat2wasm (Ctypes.addr source) (Ctypes.addr dest) ; + dest + +type format = Text | Binary + +let create store format code = + let wasm = + match format with + | Binary -> Byte_vector.from_string code + | Text -> wat2wasm code + in + let modul = Functions.Module.new_ store (Ctypes.addr wasm) in + Byte_vector.delete wasm ; + check_null_ptr Failed_to_create modul ; + modul + +let imports modul = + let outputs = Import_type_vector.empty () in + Functions.Module.imports modul (Ctypes.addr outputs) ; + outputs + +let exports modul = + let outputs = Export_type_vector.empty () in + Functions.Module.exports modul (Ctypes.addr outputs) ; + outputs + +let delete = Functions.Module.delete diff --git a/src/lib_wasmer/ref.ml b/src/lib_wasmer/ref.ml new file mode 100644 index 0000000000000000000000000000000000000000..7de37f9ef113ccb7b369f49a309b006baccc1337 --- /dev/null +++ b/src/lib_wasmer/ref.ml @@ -0,0 +1,33 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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 + +(* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of [Types.Ref.t] is respected. +*) +type t = Ref of Types.Ref.t Ctypes.ptr diff --git a/src/lib_wasmer/store.ml b/src/lib_wasmer/store.ml new file mode 100644 index 0000000000000000000000000000000000000000..ed7f456eb2ec680ec395772923c0a85562188a67 --- /dev/null +++ b/src/lib_wasmer/store.ml @@ -0,0 +1,44 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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 Utils + +exception Failed_to_create + +type t = + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4026 + Ensure that ownership and lifetime of [Types.Store.t] is respected. + *) + Types.Store.t Ctypes.ptr + +let create engine = + let store = Functions.Store.new_ engine in + check_null_ptr Failed_to_create store ; + store + +let delete = Functions.Store.delete diff --git a/src/lib_wasmer/tezos_wasmer.ml b/src/lib_wasmer/tezos_wasmer.ml new file mode 100644 index 0000000000000000000000000000000000000000..1d280de07dce43cd7e7f8d7d7c902b38f48ccbf8 --- /dev/null +++ b/src/lib_wasmer/tezos_wasmer.ml @@ -0,0 +1,73 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +module Config = Config +module Engine = Engine +module Store = Store +module Module = Module +module Ref = Ref +module Memory = Memory +module Exports = Exports +module Instance = Instance + +type 'a typ = 'a Value_type.t + +let i32 = Value_type.I32 + +let i64 = Value_type.I64 + +let f32 = Value_type.F32 + +let f64 = Value_type.F64 + +let anyref = Value_type.AnyRef + +let funcref = Value_type.FuncRef + +type 'a fn = 'a Function_type.t + +let ( @-> ) param (Function_type.Function (params, results)) = + Function_type.(Function (Cons_param (param, params), results)) + +type 'a ret = 'a Function_type.results + +let ret1 x = Function_type.One_result x + +let returning1 typ = Function_type.(Function (End_param, ret1 typ)) + +let ( @** ) lhs rhs = Function_type.Cons_result (lhs, ret1 rhs) + +let ( @* ) lhs results = Function_type.Cons_result (lhs, results) + +let returning r = Function_type.(Function (End_param, r)) + +let producer results = + Function_type.(Function (Trigger_param End_param, results)) + +let nothing = Function_type.No_result + +type extern = Extern.t + +let fn typ f = Extern.Function (typ, f) diff --git a/src/lib_wasmer/tezos_wasmer.mli b/src/lib_wasmer/tezos_wasmer.mli new file mode 100644 index 0000000000000000000000000000000000000000..d1399e767aa17610449e473eb4a71d2156ecd6e5 --- /dev/null +++ b/src/lib_wasmer/tezos_wasmer.mli @@ -0,0 +1,192 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +module Config : sig + (** Compiler backend *) + type compiler = CRANELIFT | LLVM | SINGLEPASS + + (** [is_compiler_available compiler] checks if the given [compiler] is + available in the linked Wasmer environment. *) + val is_compiler_available : compiler -> bool + + (** Wasmer engine configuration *) + type t = {compiler : compiler} + + (** Sensible default configuration for Wasmer *) + val default : t +end + +module Engine : sig + (** WebAssembly engine *) + type t + + (** [create config] instantiate a WebAssembly engine. *) + val create : Config.t -> t +end + +module Store : sig + (** WebAssembly runtime store *) + type t + + (** [create engine] instantiate a WebAssembly runtime store. *) + val create : Engine.t -> t +end + +module Ref : sig + (** Generic reference *) + type t +end + +(** WebAssembly type *) +type _ typ + +(** 32-bit integer *) +val i32 : int32 typ + +(** 64-bit integer *) +val i64 : int64 typ + +(** 32-bit floating point number *) +val f32 : float typ + +(** 64-bit floating point number *) +val f64 : float typ + +(** Generic reference *) +val anyref : Ref.t typ + +(** Function reference *) +val funcref : Ref.t typ + +(** Function type *) +type _ fn + +(** [x @-> f] composes a function type such that [x] is in the contravariant + position and [f] in the covariant position. *) +val ( @-> ) : 'a typ -> 'b fn -> ('a -> 'b) fn + +(** [returning1 ret] describes a function that receives no arguments and returns + a single value of type [ret]. *) +val returning1 : 'a typ -> 'a Lwt.t fn + +(** Return type *) +type 'a ret + +(** [nothing] returns nothing. *) +val nothing : unit ret + +(** [ret1 typ] constructs a return type for one value of type [typ]. *) +val ret1 : 'a typ -> 'a ret + +(** [a @** b] composes two types as a tuple return type such that two values of + respectively type [a] and [b] are returned. *) +val ( @** ) : 'a typ -> 'b typ -> ('a * 'b) ret + +(** [x @* xs] composes things similarly to [@**] with the addition that the + second parameter may already be a composite type. *) +val ( @* ) : 'a typ -> 'b ret -> ('a * 'b) ret + +(** [returning ret] constructs a function type which receives no parameters from + the WebAssembly side, but returns values as described by [ret]. *) +val returning : 'a ret -> 'a Lwt.t fn + +(** [producer ret] works similar to [returning] but adds an extra unit argument + so that the effects of the implementing function trigger at call time. *) +val producer : 'a ret -> (unit -> 'a Lwt.t) fn + +(** Something that can be given to a WebAssembly module via an import *) +type extern + +(** Construct an extern function. *) +val fn : 'a fn -> 'a -> extern + +module Module : sig + (** WebAssembly module *) + type t + + (** Textual or binary representation of WebAssembly *) + type format = Text | Binary + + (** [create store format code] parses a module in the given [format]. *) + val create : Store.t -> format -> string -> t + + (** [delete module_] destroys a WebAssembly module. Make sure that [module_] + is not used after [delete] is called on it. *) + val delete : t -> unit +end + +module Memory : sig + module Array : module type of Ctypes.CArray + + (** WebAssembly memory *) + type t = { + raw : Unsigned.uint8 Array.t; (** C array backing the memory *) + min : Unsigned.uint32; (** Minimum memory size in pages (64 KiB) *) + max : Unsigned.uint32 option; (** Maximum size in pages *) + } + + (** [get mem addr] reads a byte at address [addr]. *) + val get : t -> int -> Unsigned.uint8 + + (** [set mem addr value] sets a byte at address [addr] to [value]. *) + val set : t -> int -> Unsigned.uint8 -> unit + + (** [length mem] gives you the memory size in bytes. *) + val length : t -> int +end + +module Instance : sig + (** WebAssembly module instance *) + type t + + (** [create store module_ imports] instantiates a module and links the given + imports against what the module needs. *) + val create : Store.t -> Module.t -> (string * string * extern) list -> t Lwt.t + + (** [delete instance] destroys the module instance. Make sure that [instance] + is not used after [delete] is called on it. *) + val delete : t -> unit +end + +module Exports : sig + (** WebAssembly module instance exports *) + type t + + (** [from_intance instance] extracts the exports from the given instance. *) + val from_instance : Instance.t -> t + + (** [fn exports name typ] looks for a function called [name] and type checks + it against [typ]. *) + val fn : t -> string -> 'a fn -> 'a + + (** [mem exports name] looks for a memory called [name]. *) + val mem : t -> string -> Memory.t + + (** [mem0 exports] gives you the first memory instance it finds. The order of + memory instances is not specified and may change in the future. This + function should be avoided unless you know the module in question only + exports one memory instance. *) + val mem0 : t -> Memory.t +end diff --git a/src/lib_wasmer/trap.ml b/src/lib_wasmer/trap.ml new file mode 100644 index 0000000000000000000000000000000000000000..05461609c8d5770ffa3b660dc73264164e4f6e6b --- /dev/null +++ b/src/lib_wasmer/trap.ml @@ -0,0 +1,42 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api +open Vectors + +exception Trap of string + +let none = Ctypes.from_voidp Types.Trap.t Ctypes.null + +let from_string store str = + let msg = Message.from_string str in + Functions.Trap.new_ store (Ctypes.addr msg) + +let message trap = + let msg = Message.empty () in + Functions.Trap.message trap (Ctypes.addr msg) ; + Message.to_string msg + +let check trap = if not (Ctypes.is_null trap) then raise (Trap (message trap)) diff --git a/src/lib_wasmer/utils.ml b/src/lib_wasmer/utils.ml new file mode 100644 index 0000000000000000000000000000000000000000..5bc5145dfb4f1e34a5badefd60ed007bd52b99c5 --- /dev/null +++ b/src/lib_wasmer/utils.ml @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +let check_null_ptr exn ptr = if Ctypes.is_null ptr then raise exn else () diff --git a/src/lib_wasmer/utils.mli b/src/lib_wasmer/utils.mli new file mode 100644 index 0000000000000000000000000000000000000000..c20b237a8860f4921af42443d6c461e70b659ef5 --- /dev/null +++ b/src/lib_wasmer/utils.mli @@ -0,0 +1,27 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** [check_null_ptr exn ptr] raises [exn] if [ptr] is a null pointer. *) +val check_null_ptr : exn -> 'a Ctypes.ptr -> unit diff --git a/src/lib_wasmer/value.ml b/src/lib_wasmer/value.ml new file mode 100644 index 0000000000000000000000000000000000000000..ac5a92e68db9df346a529a6234e850757408aeed --- /dev/null +++ b/src/lib_wasmer/value.ml @@ -0,0 +1,83 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api + +exception Kind_mismatch of {expected : Types.Valkind.t; got : Types.Valkind.t} + +let check_kind value expected = + let got = Ctypes.getf value Types.Val_repr.kind in + if expected <> got then raise (Kind_mismatch {expected; got}) + +let unpack_value value field = + let of_ = Ctypes.getf value Types.Val_repr.of_ in + Ctypes.getf of_ field + +let unpack : type a. a Value_type.t -> Types.Val.t -> a = + fun typ value -> + match typ with + | I32 -> + check_kind value Types.Valkind.i32 ; + unpack_value value Types.Val_repr.Of.i32 + | I64 -> + check_kind value Types.Valkind.i64 ; + unpack_value value Types.Val_repr.Of.i64 + | F32 -> + check_kind value Types.Valkind.f32 ; + unpack_value value Types.Val_repr.Of.f32 + | F64 -> + check_kind value Types.Valkind.f64 ; + unpack_value value Types.Val_repr.Of.f64 + | AnyRef -> + check_kind value Types.Valkind.anyref ; + Ref (unpack_value value Types.Val_repr.Of.ref) + | FuncRef -> + check_kind value Types.Valkind.funcref ; + Ref (unpack_value value Types.Val_repr.Of.ref) + +let pack_value kind field value = + let repr = Ctypes.make Types.Val_repr.t in + let of_ = + let of_ = Ctypes.make Types.Val_repr.Of.t in + Ctypes.setf of_ field value ; + of_ + in + Ctypes.setf repr Types.Val_repr.kind kind ; + Ctypes.setf repr Types.Val_repr.of_ of_ ; + repr + +let pack : type a. a Value_type.t -> a -> Types.Val.t = + fun typ value -> + match typ with + | I32 -> pack_value Types.Valkind.i32 Types.Val_repr.Of.i32 value + | I64 -> pack_value Types.Valkind.i64 Types.Val_repr.Of.i64 value + | F32 -> pack_value Types.Valkind.f32 Types.Val_repr.Of.f32 value + | F64 -> pack_value Types.Valkind.f64 Types.Val_repr.Of.f64 value + | AnyRef -> + let (Ref ref) = value in + pack_value Types.Valkind.anyref Types.Val_repr.Of.ref ref + | FuncRef -> + let (Ref ref) = value in + pack_value Types.Valkind.funcref Types.Val_repr.Of.ref ref diff --git a/src/lib_wasmer/value_type.ml b/src/lib_wasmer/value_type.ml new file mode 100644 index 0000000000000000000000000000000000000000..62595cdc7b200005be1f47d6006b101291f5d5c2 --- /dev/null +++ b/src/lib_wasmer/value_type.ml @@ -0,0 +1,71 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api + +type _ t = + | I32 : int32 t + | I64 : int64 t + | F32 : float t + | F64 : float t + | AnyRef : Ref.t t + | FuncRef : Ref.t t + +let to_valkind : type a. a t -> Types.Valkind.t = function + | I32 -> Types.Valkind.i32 + | I64 -> Types.Valkind.i64 + | F32 -> Types.Valkind.f32 + | F64 -> Types.Valkind.f64 + | AnyRef -> Types.Valkind.anyref + | FuncRef -> Types.Valkind.funcref + +let to_valtype typ = Functions.Valtype.new_ (to_valkind typ) + +exception Type_mismatch of {expected : Types.Valkind.t; got : Types.Valkind.t} + +let () = + Printexc.register_printer (function + | Type_mismatch {expected; got} -> + Some + (Printf.sprintf + "Type mismatch: %s <> %s" + (Unsigned.UInt8.to_string expected) + (Unsigned.UInt8.to_string got)) + | _ -> None) + +let check : type a. a t -> Types.Valtype.t Ctypes.ptr -> unit = + fun typ valtype -> + let got = Functions.Valtype.kind valtype in + let check_assertion expected = + if not (Unsigned.UInt8.equal got expected) then + raise (Type_mismatch {got; expected}) + in + match typ with + | I32 -> check_assertion Types.Valkind.i32 + | I64 -> check_assertion Types.Valkind.i64 + | F32 -> check_assertion Types.Valkind.f32 + | F64 -> check_assertion Types.Valkind.f64 + | AnyRef -> check_assertion Types.Valkind.anyref + | FuncRef -> check_assertion Types.Valkind.funcref diff --git a/src/lib_wasmer/vectors.ml b/src/lib_wasmer/vectors.ml new file mode 100644 index 0000000000000000000000000000000000000000..580898da05573dac3be31b4c5ef60ff3ee4db2cf --- /dev/null +++ b/src/lib_wasmer/vectors.ml @@ -0,0 +1,152 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 TriliTech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +open Api + +module Make_vector + (Vector_type : Api_types.Vec) (Vector_funs : sig + val new_ : + Vector_type.t Ctypes.ptr -> + Unsigned.Size_t.t -> + Vector_type.item Ctypes.ptr -> + unit + + val new_uninitialized : + Vector_type.t Ctypes.ptr -> Unsigned.Size_t.t -> unit + + val new_empty : Vector_type.t Ctypes.ptr -> unit + end) = +struct + type item = Vector_type.item + + type t = Vector_type.t + + let init_empty vec = Vector_funs.new_empty vec + + let empty () = + let vec = Ctypes.make Vector_type.t in + init_empty (Ctypes.addr vec) ; + vec + + let uninitialized len = + if Unsigned.Size_t.(compare len zero > 0) then ( + let vec = Ctypes.make Vector_type.t in + Vector_funs.new_uninitialized (Ctypes.addr vec) len ; + vec) + else empty () + + let init_from_list vec items = + let len = List.length items in + let buffer = Ctypes.CArray.of_list Vector_type.item items in + Vector_funs.new_ + vec + (Unsigned.Size_t.of_int len) + (Ctypes.CArray.start buffer) + + let init_from_array vec items = + let count = Array.length items in + let buffer = Ctypes.allocate_n ~count Vector_type.item in + Array.iteri + Ctypes.( + fun i item -> + let ptr = buffer +@ i in + ptr <-@ item) + items ; + Vector_funs.new_ vec (Unsigned.Size_t.of_int count) buffer + + let init_uninitialized vec len = Vector_funs.new_uninitialized vec len + + let from_list items = + let vec = Ctypes.make Vector_type.t in + init_from_list (Ctypes.addr vec) items ; + vec + + let from_array items = + let vec = Ctypes.make Vector_type.t in + init_from_array (Ctypes.addr vec) items ; + vec + + let length vec = Ctypes.getf vec Vector_type.size + + let to_list vec = + let data = Ctypes.getf vec Vector_type.data in + List.init + (length vec |> Unsigned.Size_t.to_int) + Ctypes.( + fun i -> + let ptr = data +@ i in + !@ptr) + + let to_array vec = + let data = Ctypes.getf vec Vector_type.data in + Array.init + (length vec |> Unsigned.Size_t.to_int) + Ctypes.( + fun i -> + let ptr = data +@ i in + !@ptr) + + let set vec i value = + let data = Ctypes.getf vec Vector_type.data in + Ctypes.(data +@ i <-@ value) + + let get vec i = + let data = Ctypes.getf vec Vector_type.data in + Ctypes.(!@(data +@ i)) +end + +module Value_type_vector = + Make_vector (Types.Valtype.Vec) (Functions.Valtype_vec) +module Value_vector = Make_vector (Types.Val_vec) (Functions.Val_vec) +module Extern_vector = Make_vector (Types.Extern.Vec) (Functions.Extern_vec) +module Export_type_vector = + Make_vector (Types.Exporttype.Vec) (Functions.Exporttype_vec) +module Import_type_vector = + Make_vector (Types.Importtype.Vec) (Functions.Importtype_vec) + +module Byte_vector = struct + let from_string str = + let byte_vec = Ctypes.make Types.Byte_vec.t in + Functions.Byte_vec.new_ + (Ctypes.addr byte_vec) + (String.length str |> Unsigned.Size_t.of_int) + str ; + byte_vec + + let empty () = + let byte_vec = Ctypes.make Types.Byte_vec.t in + Functions.Byte_vec.new_empty (Ctypes.addr byte_vec) ; + byte_vec + + let delete vec = Functions.Byte_vec.delete (Ctypes.addr vec) + + let to_string vec = + let length = Unsigned.Size_t.to_int (Ctypes.getf vec Types.Byte_vec.size) in + let data = Ctypes.getf vec Types.Byte_vec.data in + Ctypes.string_from_ptr Ctypes.(coerce (ptr uint8_t) (ptr char) data) ~length +end + +module Name = Byte_vector +module Message = Name