From 7d33b05e2538b2163b7780963f047e7670f8d753 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 22 May 2026 17:55:52 +0200 Subject: [PATCH 01/10] Compiler: shorten --build-config output Use a compact encoding for the [--build-config] output: a key at its default is omitted; all other keys still emit [name=value]. Restructure [set_values] to iterate over the known keys rather than the input entries, so that an omitted bool is reset to its default (instead of silently keeping whatever value the caller left it at) and a missing enum is reported as an error. For the typical wasm builds this reduces e.g. effects=jspi+toplevel=false+use-js-string=true (45 chars) to effects=jspi (12 chars), which keeps the build-config directory that dune derives from this output well within Windows' MAX_PATH limit. --- compiler/lib-cmdline/build_config.ml | 4 +- compiler/lib/build_info.ml | 71 +++++++++++++++++++++------- compiler/lib/build_info.mli | 3 +- compiler/lib/macro.ml | 4 +- 4 files changed, 61 insertions(+), 21 deletions(-) diff --git a/compiler/lib-cmdline/build_config.ml b/compiler/lib-cmdline/build_config.ml index 93f66dab5e..8618e57ce6 100644 --- a/compiler/lib-cmdline/build_config.ml +++ b/compiler/lib-cmdline/build_config.ml @@ -20,7 +20,9 @@ open Js_of_ocaml_compiler open! Stdlib let print_and_exit keys = - Printf.printf "%s\n" (Build_info.to_config_string (Build_info.get_values keys)); + Printf.printf + "%s\n" + (Build_info.to_config_string (Build_info.get_non_default_values keys)); exit 0 let parse keys input = Build_info.set_values keys (Build_info.parse_config_string input) diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml index 2c36bd7a23..2a0adb22eb 100644 --- a/compiler/lib/build_info.ml +++ b/compiler/lib/build_info.ml @@ -67,6 +67,7 @@ type config_key = { name : string ; get : unit -> bool ; set : bool -> unit + ; default : bool } | Enum_key of { name : string @@ -96,9 +97,14 @@ let config_keys target = { name = "use-js-string" ; get = Config.Flag.use_js_string ; set = Config.Flag.set "use-js-string" + ; default = true } ; Bool_key - { name = "toplevel"; get = Config.Flag.toplevel; set = Config.Flag.set "toplevel" } + { name = "toplevel" + ; get = Config.Flag.toplevel + ; set = Config.Flag.set "toplevel" + ; default = false + } ] let config_key_values = function @@ -114,24 +120,40 @@ let get_values keys = keys let set_values keys entries = - List.iter entries ~f:(fun (k, v) -> - match List.find_opt keys ~f:(fun key -> String.equal (config_key_name key) k) with - | None -> failwith (Printf.sprintf "unknown config key %S" k) - | Some (Bool_key { set; _ }) -> ( + (* Reject unknown keys before applying anything. *) + List.iter entries ~f:(fun (k, _) -> + if not (List.exists keys ~f:(fun key -> String.equal (config_key_name key) k)) + then failwith (Printf.sprintf "unknown config key %S" k)); + (* Iterate over [keys] (not [entries]) so that a key omitted from + [entries] is reset to its default rather than silently keeping + whatever value the caller left it at. *) + List.iter keys ~f:(fun key -> + let name = config_key_name key in + let v = + List.find_map entries ~f:(fun (k, v) -> + if String.equal k name then Some v else None) + in + match key with + | Bool_key { set; default; _ } -> ( match v with - | "true" -> set true - | "false" -> set false - | _ -> failwith (Printf.sprintf "key %S expects true or false, got %S" k v)) - | Some (Enum_key { set; valid; _ }) -> - if List.mem ~eq:String.equal v valid - then set v - else - failwith - (Printf.sprintf - "key %S expects one of {%s}, got %S" - k - (String.concat ~sep:", " valid) - v)) + | None -> set default + | Some "true" -> set true + | Some "false" -> set false + | Some v -> + failwith (Printf.sprintf "key %S expects true or false, got %S" name v)) + | Enum_key { set; valid; _ } -> ( + match v with + | None -> failwith (Printf.sprintf "missing required config key %S" name) + | Some v -> + if List.mem ~eq:String.equal v valid + then set v + else + failwith + (Printf.sprintf + "key %S expects one of {%s}, got %S" + name + (String.concat ~sep:", " valid) + v))) let parse_entries ~sep s = if String.is_empty s @@ -149,6 +171,19 @@ let entries_to_string ~sep entries = let entries = List.sort ~cmp:(fun (k1, _) (k2, _) -> String.compare k1 k2) entries in String.concat ~sep (List.map ~f:(fun (k, v) -> Printf.sprintf "%s=%s" k v) entries) +(* Like [get_values] but omits any bool key whose current value equals its + default. Used to produce a compact [--build-config] output: + [set_values] resets an omitted bool back to its default, so the + omitted-at-default convention round-trips. Keeps the build-config + directory name dune derives from this output short on Windows. *) +let get_non_default_values keys = + List.filter_map keys ~f:(fun key -> + match key with + | Bool_key { name; get; default; _ } -> + let v = get () in + if Bool.equal v default then None else Some (name, string_of_bool v) + | Enum_key { name; get; _ } -> Some (name, get ())) + let to_config_string entries = entries_to_string ~sep:"+" entries let parse_config_string s = parse_entries ~sep:'+' s diff --git a/compiler/lib/build_info.mli b/compiler/lib/build_info.mli index 0e224b454f..22dfec006a 100644 --- a/compiler/lib/build_info.mli +++ b/compiler/lib/build_info.mli @@ -34,6 +34,7 @@ type config_key = { name : string ; get : unit -> bool ; set : bool -> unit + ; default : bool } | Enum_key of { name : string @@ -48,7 +49,7 @@ val config_keys : [ `JavaScript | `Wasm ] -> config_key list val config_key_values : config_key -> string list -val get_values : config_key list -> (string * string) list +val get_non_default_values : config_key list -> (string * string) list val set_values : config_key list -> (string * string) list -> unit diff --git a/compiler/lib/macro.ml b/compiler/lib/macro.ml index db95f233d2..9c78a39045 100644 --- a/compiler/lib/macro.ml +++ b/compiler/lib/macro.ml @@ -54,7 +54,9 @@ class macro_mapper ~flags = match flags with | Replace -> let target = Config.target () in - let entries = Build_info.get_values (Build_info.config_keys target) in + let entries = + Build_info.get_non_default_values (Build_info.config_keys target) + in let s = Build_info.to_config_string entries in J.EStr (Utf8_string.of_string_exn s) | Count count -> From 6c790904471264fec9e3ef230323002424dbaae0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Tue, 17 Dec 2024 16:53:01 +0100 Subject: [PATCH 02/10] WASI runtime --- .gitignore | 3 + compiler/bin-wasm_of_ocaml/cmd_arg.ml | 2 + compiler/bin-wasm_of_ocaml/compile.ml | 49 +- compiler/bin-wasm_of_ocaml/dune | 3 + compiler/bin-wasm_of_ocaml/gen/gen.ml | 35 +- compiler/lib-wasm/binaryen.ml | 1 + compiler/lib-wasm/gc_target.ml | 102 +- compiler/lib-wasm/generate.ml | 5 +- compiler/lib/build_info.ml | 11 + compiler/lib/config.ml | 2 + compiler/lib/config.mli | 2 + compiler/tests-dynlink-wasm/dune | 57 +- compiler/tests-io/dune | 6 + compiler/tests-jsoo/dune | 44 +- compiler/tests-jsoo/lib-effects/dune | 6 + compiler/tests-jsoo/test_unix.ml | 81 +- compiler/tests-jsoo/test_unix_perms.ml | 78 + compiler/tests-linkall/dune | 4 +- compiler/tests-ocaml/basic-io-2/dune | 3 + compiler/tests-ocaml/basic-io/dune | 2 + compiler/tests-ocaml/effect-syntax/dune | 4 + compiler/tests-ocaml/effects/dune | 4 + compiler/tests-ocaml/lib-arg/dune | 10 +- compiler/tests-ocaml/lib-array/dune | 6 +- compiler/tests-ocaml/lib-channels/close_in.ml | 10 +- compiler/tests-ocaml/lib-digest/dune | 4 +- compiler/tests-ocaml/lib-either/dune | 10 +- compiler/tests-ocaml/lib-internalformat/dune | 10 +- compiler/tests-ocaml/lib-lazy/dune | 10 +- compiler/tests-ocaml/lib-marshal/intext.ml | 3 +- .../tests-ocaml/lib-marshal/intext_par.ml | 3 +- compiler/tests-ocaml/lib-unix/isatty/dune | 5 +- compiler/tests-toplevel/dune | 2 + compiler/tests-wasm_of_ocaml/dune | 4 +- dune | 8 + lib/deriving_json/tests/dune | 2 + lib/tests/dune.inc | 18 +- lib/tests/gen-rules/gen.ml | 4 +- runtime/wasm/backtrace.wat | 10 + runtime/wasm/bigarray.wat | 519 +++++++ runtime/wasm/bigstring.wat | 19 + runtime/wasm/blake2.wat | 2 +- runtime/wasm/compare.wat | 3 + runtime/wasm/deps-wasi.json | 15 + runtime/wasm/dune | 68 + runtime/wasm/dynlink.wat | 3 + runtime/wasm/effect-native.wat | 3 + runtime/wasm/effect.wat | 7 + runtime/wasm/fail.wat | 6 + runtime/wasm/float.wat | 85 + runtime/wasm/fs.wat | 641 +++++++- runtime/wasm/graphics.wat | 5 + runtime/wasm/hash.wat | 3 + runtime/wasm/io.wat | 489 +++++- runtime/wasm/jslib.wat | 6 +- runtime/wasm/jslib_js_of_ocaml.wat | 3 + runtime/wasm/jsstring.wat | 3 + runtime/wasm/libc.c | 175 +++ runtime/wasm/libc.wasm | Bin 0 -> 63480 bytes runtime/wasm/marshal.wat | 66 +- runtime/wasm/prng.wat | 19 +- runtime/wasm/promise.wat | 5 + runtime/wasm/runtime-wasi.js | 84 + runtime/wasm/stdlib.wat | 62 +- runtime/wasm/sys.wat | 310 +++- runtime/wasm/toplevel.wat | 4 +- runtime/wasm/unix.wat | 1371 ++++++++++++++++- runtime/wasm/wasi_errors.wat | 86 ++ runtime/wasm/wasi_memory.wat | 98 ++ runtime/wasm/weak.wat | 21 + runtime/wasm/zstd.wat | 6 +- 71 files changed, 4589 insertions(+), 221 deletions(-) create mode 100644 compiler/tests-jsoo/test_unix_perms.ml create mode 100644 runtime/wasm/deps-wasi.json create mode 100644 runtime/wasm/libc.c create mode 100644 runtime/wasm/libc.wasm create mode 100644 runtime/wasm/runtime-wasi.js create mode 100644 runtime/wasm/wasi_errors.wat create mode 100644 runtime/wasm/wasi_memory.wat diff --git a/.gitignore b/.gitignore index a584e25498..f7ceb1acfa 100644 --- a/.gitignore +++ b/.gitignore @@ -30,6 +30,9 @@ *.tmpjs *.map +# Wasm runtime: intermediate output of recompile-* aliases +runtime/wasm/*.new.wasm + ocamltests gh-pages diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml index a2b0b322e0..1b04329a31 100644 --- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml +++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml @@ -46,6 +46,8 @@ let normalize_effects (effects : [ `Disabled | `Cps | `Jspi | `Native ] option) [--effects cps] *) if List.mem ~eq:String.equal "effects" common.Jsoo_cmdline.Arg.optim.enable then `Cps + else if List.mem ~eq:String.equal "wasi" common.Jsoo_cmdline.Arg.optim.enable + then `Disabled else `Jspi | Some ((`Disabled | `Cps | `Jspi | `Native) as e) -> e diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 9b2d782f65..b4500dea44 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/compiler/bin-wasm_of_ocaml/compile.ml @@ -81,13 +81,14 @@ let preprocessor_variables () = [ ( "effects" , Wat_preprocess.String ((match Config.effects () with - | `Disabled -> + | `Disabled when not (Config.Flag.wasi ()) -> (* We are using the same runtime [runtime-standard.wasm] in both cases. *) `Jspi - | (`Jspi | `Cps | `Native) as e -> e + | (`Disabled | `Jspi | `Cps | `Native) as e -> e | `Double_translation -> assert false) |> Build_info.string_of_effects_backend) ) + ; "wasi", Wat_preprocess.Bool (Config.Flag.wasi ()) ] let with_runtime_files ~runtime_wasm_files f = @@ -119,7 +120,9 @@ let build_runtime ~runtime_file = ; file = module_name ^ ".wat" ; source = Contents contents }) - Runtime_files.wat_files + (if Config.Flag.wasi () + then ("libc", Runtime_files.wasi_libc) :: Runtime_files.wat_files + else Runtime_files.wat_files) in Runtime.build ~link_options:[ "-g" ] @@ -127,13 +130,16 @@ let build_runtime ~runtime_file = ~variables ~allowed_imports: (Some - [ "bindings" - ; "Math" - ; "js" - ; "wasm:js-string" - ; "wasm:text-encoder" - ; "wasm:text-decoder" - ]) + (if Config.Flag.wasi () + then [ "wasi_snapshot_preview1"; "OCaml" ] + else + [ "bindings" + ; "Math" + ; "js" + ; "wasm:js-string" + ; "wasm:text-encoder" + ; "wasm:text-decoder" + ])) ~inputs ~output_file:runtime_file @@ -214,7 +220,10 @@ let link_and_optimize let t = Timer.make ~get_time:Unix.time () in let primitives = Binaryen.dead_code_elimination - ~dependencies:Runtime_files.dependencies + ~dependencies: + (if Config.Flag.wasi () + then Runtime_files.wasi_dependencies + else Runtime_files.dependencies) ~opt_input_sourcemap:opt_temp_sourcemap ~opt_output_sourcemap:opt_temp_sourcemap' ~input_file:temp_file @@ -322,7 +331,14 @@ let build_js_runtime ~primitives ?runtime_arguments () = | _ -> assert false in let init_fun = - match Parse_js.parse `Script (Parse_js.Lexer.of_string Runtime_files.js_runtime) with + match + Parse_js.parse + `Script + (Parse_js.Lexer.of_string + (if Config.Flag.wasi () + then Runtime_files.js_wasi_launcher + else Runtime_files.js_launcher)) + with | [ (Expression_statement f, _) ] -> f | _ -> assert false in @@ -686,9 +702,12 @@ let run if binaryen_times () then Format.eprintf " link_and_optimize: %a@." Timer.print t2; let wasm_name = - Printf.sprintf - "code-%s" - (String.sub (Digest.to_hex (Digest.file tmp_wasm_file)) ~pos:0 ~len:20) + if Config.Flag.wasi () + then "code" + else + Printf.sprintf + "code-%s" + (String.sub (Digest.to_hex (Digest.file tmp_wasm_file)) ~pos:0 ~len:20) in let tmp_wasm_file' = Filename.concat tmp_dir (wasm_name ^ ".wasm") in Sys.rename tmp_wasm_file tmp_wasm_file'; diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune index e6354ae606..e3b43e1be0 100644 --- a/compiler/bin-wasm_of_ocaml/dune +++ b/compiler/bin-wasm_of_ocaml/dune @@ -28,6 +28,9 @@ gen/gen.exe ../../runtime/wasm/runtime.js ../../runtime/wasm/deps.json + ../../runtime/wasm/runtime-wasi.js + ../../runtime/wasm/deps-wasi.json + ../../runtime/wasm/libc.wasm (glob_files ../../runtime/wasm/*.wat) (glob_files ../../runtime/wasm/runtime-*.wasm)) (action diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml index 513c7a062d..3e879a95e4 100644 --- a/compiler/bin-wasm_of_ocaml/gen/gen.ml +++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml @@ -77,13 +77,26 @@ let check_js_file fname = let default_flags = [] -let interesting_runtimes = [ [ "effects", `S "jspi" ]; [ "effects", `S "cps" ] ] +let interesting_runtimes = + [ [ "effects", `S "jspi"; "wasi", `B false ] + ; [ "effects", `S "cps"; "wasi", `B false ] + ; [ "effects", `S "disabled"; "wasi", `B true ] + ; [ "effects", `S "cps"; "wasi", `B true ] + ] + +let defaults = [ "effects", "disabled" ] let name_runtime standard l = let flags = List.filter_map l ~f:(fun (k, v) -> match v with - | `S s -> Some s + | `S s -> + if + List.exists + ~f:(fun (k', s') -> String.equal k k' && String.equal s s') + defaults + then None + else Some s | `B b -> if b then Some k else None) in String.concat ~sep:"-" ("runtime" :: (if standard then [ "standard" ] else flags)) @@ -110,11 +123,13 @@ let print_flags f flags = let () = let () = set_binary_mode_out stdout true in - let js_runtime, deps, wat_files, runtimes = + let js_launcher, deps, js_wasi_launcher, wasi_deps, wasi_libc, wat_files, runtimes = match Array.to_list Sys.argv with - | _ :: js_runtime :: deps :: rest -> - assert (Filename.check_suffix js_runtime ".js"); + | _ :: js_launcher :: deps :: js_wasi_launcher :: wasi_deps :: wasi_libc :: rest -> + assert (Filename.check_suffix js_launcher ".js"); + assert (Filename.check_suffix js_wasi_launcher ".js"); assert (Filename.check_suffix deps ".json"); + assert (Filename.check_suffix wasi_deps ".json"); let wat_files, rest = List.partition rest ~f:(fun f -> Filename.check_suffix f ".wat") in @@ -122,13 +137,17 @@ let () = List.partition rest ~f:(fun f -> Filename.check_suffix f ".wasm") in assert (List.is_empty rest); - js_runtime, deps, wat_files, wasm_files + js_launcher, deps, js_wasi_launcher, wasi_deps, wasi_libc, wat_files, wasm_files | _ -> assert false in - check_js_file js_runtime; + check_js_file js_launcher; + check_js_file js_wasi_launcher; Format.printf "open Wasm_of_ocaml_compiler@."; - Format.printf "let js_runtime = {|\n%s\n|}@." (Fs.read_file js_runtime); + Format.printf "let js_launcher = {|\n%s\n|}@." (Fs.read_file js_launcher); Format.printf "let dependencies = {|\n%s\n|}@." (Fs.read_file deps); + Format.printf "let js_wasi_launcher = {|\n%s\n|}@." (Fs.read_file js_wasi_launcher); + Format.printf "let wasi_dependencies = {|\n%s\n|}@." (Fs.read_file wasi_deps); + Format.printf "let wasi_libc = %S@." (Fs.read_file wasi_libc); Format.printf "let wat_files = [%a]@." (Format.pp_print_list (fun f file -> diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml index 0420f95aa9..1ef79bd4d1 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/compiler/lib-wasm/binaryen.ml @@ -38,6 +38,7 @@ let common_options () = ; "--enable-bulk-memory" ; "--enable-nontrapping-float-to-int" ; "--enable-strings" + ; "--enable-multimemory" (* To keep wasm-merge happy *) ] in let l = diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml index 7b8af02e43..fc0f400b32 100644 --- a/compiler/lib-wasm/gc_target.ml +++ b/compiler/lib-wasm/gc_target.ml @@ -1395,8 +1395,8 @@ module Math = struct let unary name x = let* f = register_import - ~allow_tail_call:false - ~import_module:"Math" + ~allow_tail_call:(Config.Flag.wasi ()) + ~import_module:(if Config.Flag.wasi () then "env" else "Math") ~name (Fun (float_func_type 1)) in @@ -1444,8 +1444,8 @@ module Math = struct let binary name x y = let* f = register_import - ~allow_tail_call:false - ~import_module:"Math" + ~allow_tail_call:(Config.Flag.wasi ()) + ~import_module:(if Config.Flag.wasi () then "env" else "Math") ~name (Fun (float_func_type 2)) in @@ -1472,6 +1472,18 @@ module Bigarray = struct (Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 3) (Arith.const (Int32.of_int n)) + let little_endian () = + if Config.Flag.wasi () + then Arith.(const 1l) + else + let* le = + register_import + ~import_module:"bindings" + ~name:"littleEndian" + (Global { mut = false; typ = I32 }) + in + return (W.GlobalGet le) + let get_at_offset ~(kind : Typing.Bigarray.kind) a i = let name, (typ : Wasm_ast.value_type), size, box = match kind with @@ -1513,19 +1525,14 @@ module Bigarray = struct return (W.F64PromoteF32 x) ) | Complex64 -> "dv_get_f64", F64, 4, Fun.id in - let* little_endian = - register_import - ~import_module:"bindings" - ~name:"littleEndian" - (Global { mut = false; typ = I32 }) - in + let* little_endian = little_endian () in let* f = register_import - ~import_module:"bindings" + ~import_module:(if Config.Flag.wasi () then "env" else "bindings") ~name (Fun { W.params = - Ref { nullable = true; typ = Extern } + Ref { nullable = not (Config.Flag.wasi ()); typ = Extern } :: I32 :: (if size = 0 then [] else [ I32 ]) ; result = [ typ ] @@ -1548,14 +1555,12 @@ module Bigarray = struct | Nativeint | Float16 -> box - (return - (W.Call - (f, ta :: ofs :: (if size = 0 then [] else [ W.GlobalGet little_endian ])))) + (return (W.Call (f, ta :: ofs :: (if size = 0 then [] else [ little_endian ])))) | Complex32 | Complex64 -> let delta = Int32.shift_left 1l (size - 1) in let* ofs' = Arith.(return ofs + const delta) in - let* x = box (return (W.Call (f, [ ta; ofs; W.GlobalGet little_endian ]))) in - let* y = box (return (W.Call (f, [ ta; ofs'; W.GlobalGet little_endian ]))) in + let* x = box (return (W.Call (f, [ ta; ofs; little_endian ]))) in + let* y = box (return (W.Call (f, [ ta; ofs'; little_endian ]))) in let* ty = Type.float_array_type in return (W.ArrayNewFixed (ty, [ x; y ])) @@ -1601,19 +1606,14 @@ module Bigarray = struct let* ty = Type.bigarray_type in let* ta = Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 2 in let* ofs = Arith.(i lsl const (Int32.of_int size)) in - let* little_endian = - register_import - ~import_module:"bindings" - ~name:"littleEndian" - (Global { mut = false; typ = I32 }) - in + let* little_endian = little_endian () in let* f = register_import - ~import_module:"bindings" + ~import_module:(if Config.Flag.wasi () then "env" else "bindings") ~name (Fun { W.params = - Ref { nullable = true; typ = Extern } + Ref { nullable = not (Config.Flag.wasi ()); typ = Extern } :: I32 :: typ :: (if size = 0 then [] else [ I32 ]) @@ -1635,18 +1635,15 @@ module Bigarray = struct | Float16 -> let* v = unbox v in instr - (W.CallInstr - ( f - , ta :: ofs :: v :: (if size = 0 then [] else [ W.GlobalGet little_endian ]) - )) + (W.CallInstr (f, ta :: ofs :: v :: (if size = 0 then [] else [ little_endian ]))) | Complex32 | Complex64 -> let delta = Int32.shift_left 1l (size - 1) in let* ofs' = Arith.(return ofs + const delta) in let ty = Type.float_array_type in let* x = unbox (Memory.wasm_array_get ~ty v (Arith.const 0l)) in - let* () = instr (W.CallInstr (f, [ ta; ofs; x; W.GlobalGet little_endian ])) in + let* () = instr (W.CallInstr (f, [ ta; ofs; x; little_endian ])) in let* y = unbox (Memory.wasm_array_get ~ty v (Arith.const 1l)) in - instr (W.CallInstr (f, [ ta; ofs'; y; W.GlobalGet little_endian ])) + instr (W.CallInstr (f, [ ta; ofs'; y; little_endian ])) let offset ~bound_error_index ~(layout : Typing.Bigarray.layout) ta ~indices = let l = @@ -2037,21 +2034,34 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler = x (block_expr { params = []; result = [ Type.value ] } - (let* exn = - block_expr - { params = []; result = [ externref ] } - (let* e = - try_expr - { params = []; result = [ externref ] } - (body - ~result_typ:[ externref ] - ~fall_through:`Skip - ~context:(`Skip :: `Skip :: `Catch :: context)) - [ ocaml_tag, 1, Type.value; js_tag, 0, externref ] - in - instr (W.Push e)) - in - instr (W.CallInstr (f, [ exn ])))) + (if Config.Flag.wasi () + then + let* e = + try_expr + { params = []; result = [ Type.value ] } + (body + ~result_typ:[ Type.value ] + ~fall_through:`Skip + ~context:(`Skip :: `Catch :: context)) + [ ocaml_tag, 0, Type.value ] + in + instr (W.Push e) + else + let* exn = + block_expr + { params = []; result = [ externref ] } + (let* e = + try_expr + { params = []; result = [ externref ] } + (body + ~result_typ:[ externref ] + ~fall_through:`Skip + ~context:(`Skip :: `Skip :: `Catch :: context)) + [ ocaml_tag, 1, Type.value; js_tag, 0, externref ] + in + instr (W.Push e)) + in + instr (W.CallInstr (f, [ exn ])))) in let* () = no_event in exn_handler ~result_typ ~fall_through ~context) diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index 7844c78027..288ff176c5 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -257,7 +257,7 @@ module Generate (Target : Target_sig.S) = struct (if negate then Arith.( <> ) else Arith.( = )) Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) x lsl const 1l) Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) y lsl const 1l) - | Top, Top -> + | Top, Top when not (Config.Flag.wasi ()) -> Value.js_eqeqeq ~negate (transl_prim_arg ctx ~typ:Top x) @@ -268,7 +268,8 @@ module Generate (Target : Target_sig.S) = struct (transl_prim_arg ctx ~typ:Top x) (transl_prim_arg ctx ~typ:Top y) | (Int _ | Number _ | Tuple _ | Bigarray _ | Null), _ - | _, (Int _ | Number _ | Tuple _ | Bigarray _ | Null) -> + | _, (Int _ | Number _ | Tuple _ | Bigarray _ | Null) + | Top, Top (* when wasi is enabled *) -> (* Only Top may contain JavaScript values *) (if negate then Value.phys_neq else Value.phys_eq) (transl_prim_arg ctx ~typ:Top x) diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml index 2a0adb22eb..0d0e231fc1 100644 --- a/compiler/lib/build_info.ml +++ b/compiler/lib/build_info.ml @@ -106,6 +106,17 @@ let config_keys target = ; default = false } ] + @ + match target with + | `Wasm -> + [ Bool_key + { name = "wasi" + ; get = Config.Flag.wasi + ; set = Config.Flag.set "wasi" + ; default = false + } + ] + | `JavaScript -> [] let config_key_values = function | Bool_key _ -> [ "true"; "false" ] diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index e95dd673ce..b6ef879364 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -112,6 +112,8 @@ module Flag = struct let load_shapes_auto = o ~name:"load-shapes-auto" ~default:false let toplevel = o ~name:"toplevel" ~default:false + + let wasi = o ~name:"wasi" ~default:false end module Param = struct diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli index d9f0fe2a4b..fe14369558 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -82,6 +82,8 @@ module Flag : sig val toplevel : unit -> bool + val wasi : unit -> bool + val enable : string -> unit val disable : string -> unit diff --git a/compiler/tests-dynlink-wasm/dune b/compiler/tests-dynlink-wasm/dune index dc5fea7c01..21a26eec8a 100644 --- a/compiler/tests-dynlink-wasm/dune +++ b/compiler/tests-dynlink-wasm/dune @@ -42,7 +42,11 @@ (rule (target plugin.wasmo) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (action (run %{bin:wasm_of_ocaml} @@ -55,7 +59,11 @@ (rule (target main.out) (deps plugin.wasmo) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (action (with-outputs-to %{target} @@ -63,7 +71,11 @@ (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (action (diff main.out.expected main.out))) @@ -91,7 +103,11 @@ (rule (target main_compile_and_load.out) (deps plugin_compiled.wasmo) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (action (with-outputs-to %{target} @@ -99,7 +115,11 @@ (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (action (diff main_compile_and_load.out.expected main_compile_and_load.out))) @@ -116,7 +136,11 @@ (rule (target dynlink_loadfile.out) (deps plugin.cmo plugin2.cma) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (action (with-outputs-to %{target} @@ -124,7 +148,11 @@ (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (action (diff dynlink_loadfile.out.expected dynlink_loadfile.out))) @@ -168,7 +196,10 @@ (targets dynlink_loadfile_wp.js (dir dynlink_loadfile_wp.assets)) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (run %{bin:wasm_of_ocaml} @@ -182,7 +213,10 @@ (rule (target dynlink_loadfile_wp.out) (deps plugin.cmo plugin2.cma plugin_uses_dep.cmo plugin_js.cmo) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (with-outputs-to %{target} @@ -190,6 +224,9 @@ (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (diff dynlink_loadfile_wp.out.expected dynlink_loadfile_wp.out))) diff --git a/compiler/tests-io/dune b/compiler/tests-io/dune index c7c4ea26e9..3798704005 100644 --- a/compiler/tests-io/dune +++ b/compiler/tests-io/dune @@ -21,6 +21,8 @@ (tests (names md5) (modes js wasm) + (deps + (sandbox preserve_file_kind)) (action (progn (run node %{test} %{dep:some-random-file}) @@ -89,6 +91,8 @@ (names non_ascii_filenames_wasm) (deps "accentué") (modes wasm) + (enabled_if + (<> %{profile} wasi)) (wasm_of_ocaml (compilation_mode whole_program) (flags @@ -109,6 +113,8 @@ (names gh1856) (deps file.txt) (modes js wasm) + (enabled_if + (<> %{profile} wasi)) (js_of_ocaml (compilation_mode whole_program) (flags diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune index 0a55751e4c..6e4a47b79e 100644 --- a/compiler/tests-jsoo/dune +++ b/compiler/tests-jsoo/dune @@ -11,6 +11,8 @@ (enabled_if (>= %{ocaml_version} 4.14)) (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) @@ -24,6 +26,8 @@ (>= %{ocaml_version} 5.1.1) (not %{oxcaml_supported}))) (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) @@ -35,6 +39,25 @@ (enabled_if (>= %{ocaml_version} 5.1.1)) (inline_tests + (deps + (sandbox preserve_file_kind)) + (modes js wasm best)) + (preprocess + (pps ppx_expect))) + +(library + (name jsoo_testsuite_perms) + (modules test_unix_perms) + (libraries unix) + ;; WASI has no notion of file permissions (it uses capabilities instead), + ;; and the QuickJS shim only approximates [Unix.access] / [Unix.chmod]. + (enabled_if + (and + (<> %{profile} wasi) + (<> %{profile} quickjs))) + (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) @@ -103,6 +126,7 @@ test_unix test_promise test_lwt_promise + test_unix_perms calc_parser calc_lexer)) (libraries unix compiler-libs.common js_of_ocaml-compiler) @@ -110,13 +134,15 @@ (language c) (names bigarray_stubs jsoo_runtime_stubs)) (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) -; test_unix exercises [Unix.access] / [Unix.chmod] semantics that the -; QuickJS shim only approximates, so it lives in its own library that's -; disabled under the quickjs profile. +; test_unix exercises [Unix.link], which the QuickJS shim does not +; implement, so it lives in its own library that's disabled under the +; quickjs profile. (library (name jsoo_testsuite_unix) @@ -125,6 +151,8 @@ (modules test_unix) (libraries unix compiler-libs.common js_of_ocaml-compiler) (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) @@ -140,6 +168,8 @@ (name test_runtime_value) (modules test_runtime_value) (libraries js_of_ocaml) + (enabled_if + (<> %{profile} wasi)) (js_of_ocaml (javascript_files custom.js)) (wasm_of_ocaml @@ -149,6 +179,8 @@ (test (name test_promise) (modules test_promise) + (enabled_if + (<> %{profile} wasi)) (libraries js_of_ocaml) (modes js wasm) (preprocess @@ -158,6 +190,8 @@ (name test_lwt_promise) (package js_of_ocaml-lwt) (modules test_lwt_promise) + (enabled_if + (<> %{profile} wasi)) (libraries js_of_ocaml js_of_ocaml-lwt lwt) (modes js wasm) (preprocess @@ -166,6 +200,8 @@ (library (name test_custom_name) (modules test_custom_name) + (enabled_if + (<> %{profile} wasi)) (inline_tests (modes js wasm)) (libraries js_of_ocaml) @@ -190,6 +226,8 @@ (library (name test_list_of_js_array) (modules test_list_of_js_array) + (enabled_if + (<> %{profile} wasi)) (inline_tests (modes js wasm)) (libraries js_of_ocaml) diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune index 7fa5660470..b6680517eb 100644 --- a/compiler/tests-jsoo/lib-effects/dune +++ b/compiler/tests-jsoo/lib-effects/dune @@ -2,6 +2,10 @@ (with-effects-double-translation) (with-native-effects) (with-effects) + (wasi + (wasm_of_ocaml + (flags + (:standard --effects cps)))) (_ (js_of_ocaml (flags @@ -12,6 +16,8 @@ (enabled_if (>= %{ocaml_version} 5)) (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (modules (:standard diff --git a/compiler/tests-jsoo/test_unix.ml b/compiler/tests-jsoo/test_unix.ml index ae80a2f8ed..798ee28aca 100644 --- a/compiler/tests-jsoo/test_unix.ml +++ b/compiler/tests-jsoo/test_unix.ml @@ -14,85 +14,6 @@ let%expect_test "Unix.times" = then Printf.printf "OK\n"; [%expect {| OK |}] -let on_windows = Sys.os_type = "Win32" - -let%expect_test "Unix.chmod / Unix.fchmod / Unix.access" = - let tmp = Filename.temp_file "a" "txt" in - let test ?(ok_on_windows = false) flags = - try - Unix.access tmp flags; - if on_windows && ok_on_windows - then Printf.printf "denied (success on Windows)\n" - else Printf.printf "success\n" - with - | Unix.Unix_error ((EPERM | EACCES), _, _) -> - if (not on_windows) && ok_on_windows - then Printf.printf "denied (success on Windows)\n" - else Printf.printf "denied\n" - | Unix.Unix_error (ENOENT, _, _) -> Printf.printf "absent\n" - in - let touch perms = - Unix.chmod tmp 0o600; - Unix.unlink tmp; - let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] perms in - Unix.close fd - in - let test_perms set = - set 0o200; - test ~ok_on_windows:true [ R_OK ]; - test [ W_OK ]; - test ~ok_on_windows:true [ R_OK; W_OK ]; - [%expect - {| - denied (success on Windows) - success - denied (success on Windows) - |}]; - set 0o400; - test [ R_OK ]; - test [ W_OK ]; - test [ R_OK; W_OK ]; - [%expect {| - success - denied - denied |}]; - set 0o600; - test [ R_OK ]; - test [ W_OK ]; - test [ R_OK; W_OK ]; - [%expect {| - success - success - success |}]; - set 0o000; - test ~ok_on_windows:true [ R_OK ]; - test [ W_OK ]; - test [ R_OK; W_OK ]; - [%expect {| - denied (success on Windows) - denied - denied - |}] - in - test [ F_OK ]; - [%expect {| - success |}]; - Unix.chmod tmp 0o600; - Unix.unlink tmp; - test [ F_OK ]; - [%expect {| - absent |}]; - let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] 0o666 in - test [ F_OK ]; - [%expect {| - success |}]; - if not on_windows then test_perms (Unix.fchmod fd); - Unix.close fd; - test_perms (Unix.chmod tmp); - test_perms touch; - Unix.chmod tmp 0o600; - Unix.unlink tmp - let%expect_test "Unix.link" = let tmp = Filename.temp_file "a" "txt" in let ch = open_out tmp in @@ -192,7 +113,7 @@ let%expect_test "Unix.symlink to_dir" = let tmp = Filename.temp_file "a" "txt" in Unix.unlink tmp; (try - Unix.symlink ~to_dir:true "/some/target" tmp; + Unix.symlink ~to_dir:true "some/target" tmp; ignore (Unix.readlink tmp); Printf.printf "ok\n"; Unix.unlink tmp diff --git a/compiler/tests-jsoo/test_unix_perms.ml b/compiler/tests-jsoo/test_unix_perms.ml new file mode 100644 index 0000000000..8f07952db9 --- /dev/null +++ b/compiler/tests-jsoo/test_unix_perms.ml @@ -0,0 +1,78 @@ +let on_windows = Sys.os_type = "Win32" + +let%expect_test "Unix.chmod / Unix.fchmod / Unix.access" = + let tmp = Filename.temp_file "a" "txt" in + let test ?(ok_on_windows = false) flags = + try + Unix.access tmp flags; + if on_windows && ok_on_windows + then Printf.printf "denied (success on Windows)\n" + else Printf.printf "success\n" + with + | Unix.Unix_error ((EPERM | EACCES), _, _) -> + if (not on_windows) && ok_on_windows + then Printf.printf "denied (success on Windows)\n" + else Printf.printf "denied\n" + | Unix.Unix_error (ENOENT, _, _) -> Printf.printf "absent\n" + in + let touch perms = + Unix.chmod tmp 0o600; + Unix.unlink tmp; + let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] perms in + Unix.close fd + in + let test_perms set = + set 0o200; + test ~ok_on_windows:true [ R_OK ]; + test [ W_OK ]; + test ~ok_on_windows:true [ R_OK; W_OK ]; + [%expect + {| + denied (success on Windows) + success + denied (success on Windows) + |}]; + set 0o400; + test [ R_OK ]; + test [ W_OK ]; + test [ R_OK; W_OK ]; + [%expect {| + success + denied + denied |}]; + set 0o600; + test [ R_OK ]; + test [ W_OK ]; + test [ R_OK; W_OK ]; + [%expect {| + success + success + success |}]; + set 0o000; + test ~ok_on_windows:true [ R_OK ]; + test [ W_OK ]; + test [ R_OK; W_OK ]; + [%expect {| + denied (success on Windows) + denied + denied + |}] + in + test [ F_OK ]; + [%expect {| + success |}]; + Unix.chmod tmp 0o600; + Unix.unlink tmp; + test [ F_OK ]; + [%expect {| + absent |}]; + let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] 0o666 in + test [ F_OK ]; + [%expect {| + success |}]; + if not on_windows then test_perms (Unix.fchmod fd); + Unix.close fd; + test_perms (Unix.chmod tmp); + test_perms touch; + Unix.chmod tmp 0o600; + Unix.unlink tmp diff --git a/compiler/tests-linkall/dune b/compiler/tests-linkall/dune index 6132a16e81..1290fd438c 100644 --- a/compiler/tests-linkall/dune +++ b/compiler/tests-linkall/dune @@ -14,7 +14,9 @@ (name test) (modes byte js wasm) (enabled_if - (<> %{profile} with-native-effects)) + (and + (<> %{profile} with-native-effects) + (<> %{profile} wasi))) (libraries dynlink) ;; It doesn't seem possible to create a pack-ed module with dune. ;; However, dynlink uses pack to embed a copy diff --git a/compiler/tests-ocaml/basic-io-2/dune b/compiler/tests-ocaml/basic-io-2/dune index 121f745198..e666404c1f 100644 --- a/compiler/tests-ocaml/basic-io-2/dune +++ b/compiler/tests-ocaml/basic-io-2/dune @@ -1,5 +1,8 @@ (tests (names io) (modes js wasm) + ;; Sys.command not available + (enabled_if + (<> %{profile} wasi)) (action (run node %{test} %{dep:test-file-short-lines}))) diff --git a/compiler/tests-ocaml/basic-io/dune b/compiler/tests-ocaml/basic-io/dune index 0dda8c0246..ad8469992a 100644 --- a/compiler/tests-ocaml/basic-io/dune +++ b/compiler/tests-ocaml/basic-io/dune @@ -1,5 +1,7 @@ (tests (names wc) (modes js wasm) + (deps + (sandbox preserve_file_kind)) (action (run node %{test} wc.ml))) diff --git a/compiler/tests-ocaml/effect-syntax/dune b/compiler/tests-ocaml/effect-syntax/dune index 3091fc3a58..2e818b1c16 100644 --- a/compiler/tests-ocaml/effect-syntax/dune +++ b/compiler/tests-ocaml/effect-syntax/dune @@ -2,6 +2,10 @@ (with-effects-double-translation) (with-native-effects) (with-effects) + (wasi + (wasm_of_ocaml + (flags + (:standard --effects cps)))) (_ (js_of_ocaml (flags diff --git a/compiler/tests-ocaml/effects/dune b/compiler/tests-ocaml/effects/dune index 92f582c491..e433b266f6 100644 --- a/compiler/tests-ocaml/effects/dune +++ b/compiler/tests-ocaml/effects/dune @@ -2,6 +2,10 @@ (with-effects-double-translation) (with-native-effects) (with-effects) + (wasi + (wasm_of_ocaml + (flags + (:standard --effects cps)))) (_ (js_of_ocaml (flags diff --git a/compiler/tests-ocaml/lib-arg/dune b/compiler/tests-ocaml/lib-arg/dune index 1fee099413..3de73d0a00 100644 --- a/compiler/tests-ocaml/lib-arg/dune +++ b/compiler/tests-ocaml/lib-arg/dune @@ -17,12 +17,18 @@ (rule (target test_rest_all_wasm.ml.corrected) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_rest_all_wasm.ml}))) (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (diff test_rest_all.ml test_rest_all_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-array/dune b/compiler/tests-ocaml/lib-array/dune index c281ad438c..91e265c401 100644 --- a/compiler/tests-ocaml/lib-array/dune +++ b/compiler/tests-ocaml/lib-array/dune @@ -15,7 +15,10 @@ (rule (target test_array_wasm.ml.corrected) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_array_wasm.ml}))) @@ -24,6 +27,7 @@ (enabled_if (and (>= %{ocaml_version} 5.2) + (<> %{profile} wasi) %{env:WASM_OF_OCAML=false})) (action (diff test_array.ml test_array_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-channels/close_in.ml b/compiler/tests-ocaml/lib-channels/close_in.ml index 9b3717362a..8697d78c6a 100644 --- a/compiler/tests-ocaml/lib-channels/close_in.ml +++ b/compiler/tests-ocaml/lib-channels/close_in.ml @@ -6,8 +6,14 @@ between 1 and IO_BUFFER_SIZE *) let nb_bytes = 3 +let temp_file = + let name, ch = Filename.open_temp_file "data" ".txt" in + output_string ch (String.make 1024 'a'); + close_out ch; + name + let () = - let ic = open_in_bin (Filename.basename Sys.argv.(0)) in + let ic = open_in_bin temp_file in seek_in ic nb_bytes; close_in ic; assert ( @@ -21,7 +27,7 @@ let () = (* A variant of #11878, which #11965 failed to fix. *) let () = - let ic = open_in_bin (Filename.basename Sys.argv.(0)) in + let ic = open_in_bin temp_file in close_in ic; begin try seek_in ic (-1); diff --git a/compiler/tests-ocaml/lib-digest/dune b/compiler/tests-ocaml/lib-digest/dune index 3ba1799930..19fe2dce08 100644 --- a/compiler/tests-ocaml/lib-digest/dune +++ b/compiler/tests-ocaml/lib-digest/dune @@ -8,6 +8,8 @@ (names digests) (libraries) (build_if - (>= %{ocaml_version} 5.2)) + (and + (>= %{ocaml_version} 5.2) + (<> %{profile} wasi))) (modules digests) (modes js wasm)) diff --git a/compiler/tests-ocaml/lib-either/dune b/compiler/tests-ocaml/lib-either/dune index febf0dccb0..b8735af6c6 100644 --- a/compiler/tests-ocaml/lib-either/dune +++ b/compiler/tests-ocaml/lib-either/dune @@ -13,12 +13,18 @@ (rule (target test_wasm.ml.corrected) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (diff test.ml test_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-internalformat/dune b/compiler/tests-ocaml/lib-internalformat/dune index febf0dccb0..b8735af6c6 100644 --- a/compiler/tests-ocaml/lib-internalformat/dune +++ b/compiler/tests-ocaml/lib-internalformat/dune @@ -13,12 +13,18 @@ (rule (target test_wasm.ml.corrected) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (diff test.ml test_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-lazy/dune b/compiler/tests-ocaml/lib-lazy/dune index febf0dccb0..b8735af6c6 100644 --- a/compiler/tests-ocaml/lib-lazy/dune +++ b/compiler/tests-ocaml/lib-lazy/dune @@ -13,12 +13,18 @@ (rule (target test_wasm.ml.corrected) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) (rule (alias runtest-wasm) - (enabled_if %{env:WASM_OF_OCAML=false}) + (enabled_if + (and + %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi))) (action (diff test.ml test_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-marshal/intext.ml b/compiler/tests-ocaml/lib-marshal/intext.ml index 3e0477dffd..5340806495 100644 --- a/compiler/tests-ocaml/lib-marshal/intext.ml +++ b/compiler/tests-ocaml/lib-marshal/intext.ml @@ -4,7 +4,8 @@ (* Test for output_value / input_value *) -let max_data_depth = 500000 +let max_data_depth = 10000 +(* Reduced since we use a quadratic algorithm for sharing in the WASI runtime *) type t = A | B of int | C of float | D of string | E of char | F of t | G of t * t | H of int * t | I of t * float | J diff --git a/compiler/tests-ocaml/lib-marshal/intext_par.ml b/compiler/tests-ocaml/lib-marshal/intext_par.ml index bb4da7f89d..1136a5c115 100644 --- a/compiler/tests-ocaml/lib-marshal/intext_par.ml +++ b/compiler/tests-ocaml/lib-marshal/intext_par.ml @@ -19,7 +19,8 @@ let test_size = let num_domains = 1 lsl test_size -let max_data_depth = 500000 +let max_data_depth = 10000 +(* Reduced since we use a quadratic algorithm for sharing in the WASI runtime *) type t = A | B of int | C of float | D of string | E of char | F of t | G of t * t | H of int * t | I of t * float | J diff --git a/compiler/tests-ocaml/lib-unix/isatty/dune b/compiler/tests-ocaml/lib-unix/isatty/dune index 6740efe55b..852dd49d6a 100644 --- a/compiler/tests-ocaml/lib-unix/isatty/dune +++ b/compiler/tests-ocaml/lib-unix/isatty/dune @@ -6,7 +6,10 @@ (tests (names isatty_tty) (enabled_if - (not %{env:CI=false})) + (and + (<> %{profile} wasi) + (not %{env:CI=false}))) + ; WASI has no notion of tty ; isatty_tty does not work on the CI since we are not running in a tty there (libraries ocaml_testing unix) (modes js wasm)) diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune index c94fcc24ef..54297c898b 100644 --- a/compiler/tests-toplevel/dune +++ b/compiler/tests-toplevel/dune @@ -80,6 +80,7 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi) (>= %{ocaml_version} 5.4))) (action (with-stdout-to @@ -102,6 +103,7 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} + (<> %{profile} wasi) (>= %{ocaml_version} 5.4))) (action (progn diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune index af10af406b..df4bb4cd30 100644 --- a/compiler/tests-wasm_of_ocaml/dune +++ b/compiler/tests-wasm_of_ocaml/dune @@ -18,7 +18,9 @@ (names gh2093) (modes wasm) (enabled_if - (>= %{ocaml_version} 5)) + (and + (>= %{ocaml_version} 5) + (<> %{profile} wasi))) (wasm_of_ocaml (compilation_mode whole_program) (flags :standard))) diff --git a/dune b/dune index 3632c2121b..ad9ef85c4b 100644 --- a/dune +++ b/dune @@ -47,6 +47,14 @@ (binaries (tools/node_wrapper.exe as node) (tools/node_wrapper.exe as node.exe))) + (wasi + (wasm_of_ocaml + (flags + (:standard --pretty --enable wasi)) + (compilation_mode whole_program)) + (binaries + (tools/node_wrapper.exe as node) + (tools/node_wrapper.exe as node.exe))) (bench_no_debug (flags (:standard \ -g)) diff --git a/lib/deriving_json/tests/dune b/lib/deriving_json/tests/dune index c1e0147b3d..b7772e347e 100644 --- a/lib/deriving_json/tests/dune +++ b/lib/deriving_json/tests/dune @@ -2,6 +2,8 @@ (name deriving_expect_tests) (libraries unix js_of_ocaml js_of_ocaml.deriving) (inline_tests + (enabled_if + (<> %{profile} wasi)) (modes js wasm)) (preprocess (pps ppx_expect ppx_deriving_json))) diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc index 6d9c29ecb3..a5db04790c 100644 --- a/lib/tests/dune.inc +++ b/lib/tests/dune.inc @@ -2,6 +2,7 @@ (library ;; lib/tests/test_css_angle.ml (name test_css_angle_75) + (enabled_if (<> %{profile} wasi)) (modules test_css_angle) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -11,6 +12,7 @@ (library ;; lib/tests/test_css_color.ml (name test_css_color_75) + (enabled_if (<> %{profile} wasi)) (modules test_css_color) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -20,6 +22,7 @@ (library ;; lib/tests/test_css_length.ml (name test_css_length_75) + (enabled_if (<> %{profile} wasi)) (modules test_css_length) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -29,6 +32,7 @@ (library ;; lib/tests/test_eval.ml (name test_eval_75) + (enabled_if (<> %{profile} wasi)) (modules test_eval) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -38,7 +42,7 @@ (library ;; lib/tests/test_fetch.ml (name test_fetch_75) - (enabled_if (<> %{profile} quickjs)) + (enabled_if (and (<> %{profile} quickjs) (<> %{profile} wasi))) (modules test_fetch) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -58,6 +62,7 @@ (library ;; lib/tests/test_fun_call_2.ml (name test_fun_call_2_75) + (enabled_if (<> %{profile} wasi)) (modules test_fun_call_2) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -67,6 +72,7 @@ (library ;; lib/tests/test_json.ml (name test_json_75) + (enabled_if (<> %{profile} wasi)) (modules test_json) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -76,6 +82,7 @@ (library ;; lib/tests/test_misc.ml (name test_misc_75) + (enabled_if (<> %{profile} wasi)) (modules test_misc) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -85,6 +92,7 @@ (library ;; lib/tests/test_nodejs_filesystem_errors.ml (name test_nodejs_filesystem_errors_75) + (enabled_if (<> %{profile} wasi)) (modules test_nodejs_filesystem_errors) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -94,6 +102,7 @@ (library ;; lib/tests/test_poly_compare.ml (name test_poly_compare_75) + (enabled_if (<> %{profile} wasi)) (modules test_poly_compare) (libraries js_of_ocaml unix) (inline_tests (modes js)) @@ -103,6 +112,7 @@ (library ;; lib/tests/test_poly_equal.ml (name test_poly_equal_75) + (enabled_if (<> %{profile} wasi)) (modules test_poly_equal) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -112,6 +122,7 @@ (library ;; lib/tests/test_promise.ml (name test_promise_75) + (enabled_if (<> %{profile} wasi)) (modules test_promise) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -121,6 +132,7 @@ (library ;; lib/tests/test_regexp.ml (name test_regexp_75) + (enabled_if (<> %{profile} wasi)) (modules test_regexp) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -130,6 +142,7 @@ (library ;; lib/tests/test_string.ml (name test_string_75) + (enabled_if (<> %{profile} wasi)) (modules test_string) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -149,6 +162,7 @@ (library ;; lib/tests/test_typed_array.ml (name test_typed_array_75) + (enabled_if (<> %{profile} wasi)) (modules test_typed_array) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -158,6 +172,7 @@ (library ;; lib/tests/test_unsafe_set_get.ml (name test_unsafe_set_get_75) + (enabled_if (<> %{profile} wasi)) (modules test_unsafe_set_get) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -167,6 +182,7 @@ (library ;; lib/tests/test_url.ml (name test_url_75) + (enabled_if (<> %{profile} wasi)) (modules test_url) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml index b07cdb5ab7..ba0b58328c 100644 --- a/lib/tests/gen-rules/gen.ml +++ b/lib/tests/gen-rules/gen.ml @@ -87,10 +87,10 @@ let () = basename (Hashtbl.hash prefix mod 100) (match enabled_if basename with - | Any -> "" + | Any -> "\n (enabled_if (<> %{profile} wasi))" | GE5 -> "\n (enabled_if (>= %{ocaml_version} 5))" | No_effects -> "\n (enabled_if (<> %{profile} with-effects))" - | Not_quickjs -> "\n (enabled_if (<> %{profile} quickjs))") + | Not_quickjs -> "\n (enabled_if (and (<> %{profile} quickjs) (<> %{profile} wasi)))") basename (match run_wasm basename with | true -> "js wasm" diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat index 6b351fb78d..25282323a4 100644 --- a/runtime/wasm/backtrace.wat +++ b/runtime/wasm/backtrace.wat @@ -18,10 +18,20 @@ (module (import "fail" "caml_invalid_argument" (func $caml_invalid_argument (param (ref eq)))) +(@if wasi +(@then + (global $backtrace_status (mut (ref eq)) (ref.i31 (i32.const 0))) + (func $backtrace_status (result (ref eq)) + (global.get $backtrace_status)) + (func $record_backtrace (param $b (ref eq)) + (global.set $backtrace_status (local.get $b))) +) +(@else (import "bindings" "backtrace_status" (func $backtrace_status (result (ref eq)))) (import "bindings" "record_backtrace" (func $record_backtrace (param (ref eq)))) +)) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index 34d7d7773e..a38d62ddbe 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -65,6 +65,518 @@ (func $caml_deserialize_int_4 (param (ref eq)) (result i32))) (import "marshal" "caml_deserialize_int_8" (func $caml_deserialize_int_8 (param (ref eq)) (result i64))) + +(@if wasi +(@then + (type $i64_array (array (mut i64))) + (type $i32_array (array (mut i32))) + (type $i16_array (array (mut i16))) + (type $i8_array (array (mut i8))) + (type $f64_array (array (mut f64))) + (type $f32_array (array (mut f32))) + + (type $data + (struct + (field $array (ref array)) + (field $offset i32) + (field $len i32))) + + (func $ta_create (export "ta_create") + (param $kind i32) (param $sz i32) (result (ref extern)) + (local $a (ref array)) + (local.set $a + (block $cont (result (ref array)) + (block $f32 + (block $f64 + (block $i8 + (block $i16 + (block $i32 + (block $i64 + (br_table + $f32 $f64 $i8 $i8 $i16 $i16 $i32 + $i64 $i32 $i32 $f32 $f64 $i8 $i16 + (local.get $kind))) + ;; i64 + (local.set $sz (i32.shr_u (local.get $sz) (i32.const 1))) + (br $cont (array.new $i64_array (i64.const 0) (local.get $sz)))) + ;; i32 + (br $cont (array.new $i32_array (i32.const 0) (local.get $sz)))) + ;; i16 + (br $cont (array.new $i16_array (i32.const 0) (local.get $sz)))) + ;; i8 + (br $cont (array.new $i8_array (i32.const 0) (local.get $sz)))) + ;; f64 + (br $cont (array.new $f64_array (f64.const 0) (local.get $sz)))) + ;; f32 + (array.new $f32_array (f32.const 0) (local.get $sz)))) + (extern.convert_any + (struct.new $data (local.get $a) (i32.const 0) (local.get $sz)))) + + (func $ta_fill_int (param $b (ref extern)) (param $v i32) + (local $d (ref $data)) + (local $a (ref array)) + (local $a32 (ref $i32_array)) (local $a16 (ref $i16_array)) + (local $a8 (ref $bytes)) + (local $ofs i32) (local $i i32) (local $len i32) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $a (struct.get $data $array (local.get $d))) + (local.set $ofs (struct.get $data $offset (local.get $d))) + (local.set $len (struct.get $data $len (local.get $d))) + (if (ref.test (ref $i32_array) (local.get $a)) + (then + (local.set $a32 (ref.cast (ref $i32_array) (local.get $a))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $i32_array (local.get $a32) + (i32.add (local.get $ofs) (local.get $i)) + (local.get $v)) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + (else (if (ref.test (ref $i16_array) (local.get $a)) + (then + (local.set $a16 (ref.cast (ref $i16_array) (local.get $a))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $i16_array (local.get $a16) + (i32.add (local.get $ofs) (local.get $i)) + (local.get $v)) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + (else + (local.set $a8 (ref.cast (ref $bytes) (local.get $a))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $bytes (local.get $a8) + (i32.add (local.get $ofs) (local.get $i)) + (local.get $v)) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))))))) + + (func $ta_fill_float (param $b (ref extern)) (param $f f64) + (local $d (ref $data)) + (local $a (ref array)) + (local $a64 (ref $float_array)) (local $a32 (ref $f32_array)) + (local $f32 f32) + (local $ofs i32) (local $i i32) (local $len i32) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $a (struct.get $data $array (local.get $d))) + (local.set $ofs (struct.get $data $offset (local.get $d))) + (local.set $len (struct.get $data $len (local.get $d))) + (if (ref.test (ref $float_array) (local.get $a)) + (then + (local.set $a64 (ref.cast (ref $float_array) (local.get $a))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $float_array (local.get $a64) + (i32.add (local.get $ofs) (local.get $i)) + (local.get $f)) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + (else + (local.set $a32 (ref.cast (ref $f32_array) (local.get $a))) + (local.set $f32 (f32.demote_f64 (local.get $f))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $f32_array (local.get $a32) + (i32.add (local.get $ofs) (local.get $i)) + (local.get $f32)) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))))) + + (func $ta_set (export "ta_set") + (param $d (ref extern)) (param $s (ref extern)) (param $do i32) + (local $sd (ref $data)) (local $sa (ref array)) (local $so i32) + (local $dd (ref $data)) (local $da (ref array)) + (local $i i32) (local $len i32) + (local $sf64 (ref $float_array)) (local $df64 (ref $float_array)) + (local $sf32 (ref $f32_array)) (local $df32 (ref $f32_array)) + (local $si64 (ref $i64_array)) (local $di64 (ref $i64_array)) + (local $si32 (ref $i32_array)) (local $di32 (ref $i32_array)) + (local $si16 (ref $i16_array)) (local $di16 (ref $i16_array)) + (local $si8 (ref $bytes)) (local $di8 (ref $bytes)) + (local.set $sd (ref.cast (ref $data) (any.convert_extern (local.get $s)))) + (local.set $sa (struct.get $data $array (local.get $sd))) + (local.set $so (struct.get $data $offset (local.get $sd))) + (local.set $len (struct.get $data $len (local.get $sd))) + (local.set $dd (ref.cast (ref $data) (any.convert_extern (local.get $d)))) + (local.set $da (struct.get $data $array (local.get $dd))) + (local.set $do + (i32.add (struct.get $data $offset (local.get $dd)) (local.get $do))) + (if (ref.test (ref $float_array) (local.get $sa)) + (then + (local.set $sf64 (ref.cast (ref $float_array) (local.get $sa))) + (local.set $df64 (ref.cast (ref $float_array) (local.get $da))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $float_array (local.get $df64) + (i32.add (local.get $do) (local.get $i)) + (array.get $float_array (local.get $sf64) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))))) + (if (ref.test (ref $f32_array) (local.get $sa)) + (then + (local.set $sf32 (ref.cast (ref $f32_array) (local.get $sa))) + (local.set $df32 (ref.cast (ref $f32_array) (local.get $da))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $f32_array (local.get $df32) + (i32.add (local.get $do) (local.get $i)) + (array.get $f32_array (local.get $sf32) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))))) + (if (ref.test (ref $i64_array) (local.get $sa)) + (then + (local.set $si64 (ref.cast (ref $i64_array) (local.get $sa))) + (local.set $di64 (ref.cast (ref $i64_array) (local.get $da))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $i64_array (local.get $di64) + (i32.add (local.get $do) (local.get $i)) + (array.get $i64_array (local.get $si64) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))))) + (if (ref.test (ref $i32_array) (local.get $sa)) + (then + (local.set $si32 (ref.cast (ref $i32_array) (local.get $sa))) + (local.set $di32 (ref.cast (ref $i32_array) (local.get $da))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $i32_array (local.get $di32) + (i32.add (local.get $do) (local.get $i)) + (array.get $i32_array (local.get $si32) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))))) + (if (ref.test (ref $i16_array) (local.get $sa)) + (then + (local.set $si16 (ref.cast (ref $i16_array) (local.get $sa))) + (local.set $di16 (ref.cast (ref $i16_array) (local.get $da))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $i16_array (local.get $di16) + (i32.add (local.get $do) (local.get $i)) + (array.get $i16_array (local.get $si16) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))))) + (if (ref.test (ref $bytes) (local.get $sa)) + (then + (local.set $si8 (ref.cast (ref $bytes) (local.get $sa))) + (local.set $di8 (ref.cast (ref $bytes) (local.get $da))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $bytes (local.get $di8) + (i32.add (local.get $do) (local.get $i)) + (array.get $bytes (local.get $si8) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))))) + + (func $ta_blit (param $s (ref extern)) (param $d (ref extern)) + (return_call $ta_set (local.get $d) (local.get $s) (i32.const 0))) + + (func $ta_subarray (export "ta_subarray") + (param $b (ref extern)) (param $s i32) (param $e i32) (result (ref extern)) + (local $d (ref $data)) + (local $a (ref array)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $a (struct.get $data $array (local.get $d))) + (if (ref.test (ref $i64_array) (local.get $a)) + (then + (local.set $s (i32.shr_u (local.get $s) (i32.const 1))) + (local.set $e (i32.shr_u (local.get $e) (i32.const 1))))) + (extern.convert_any + (struct.new $data + (local.get $a) + (i32.add (struct.get $data $offset (local.get $d)) (local.get $s)) + (i32.sub (local.get $e) (local.get $s))))) + + (func $ta_blit_from_bytes (export "ta_blit_from_bytes") + (param $s (ref $bytes)) (param $so i32) + (param $b (ref extern)) (param $do i32) + (param $len i32) + (local $data (ref $data)) + (local $d (ref $bytes)) + (local $i i32) + (local.set $data + (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $d + (ref.cast (ref $bytes) (struct.get $data $array (local.get $data)))) + (local.set $do + (i32.add (local.get $do) (struct.get $data $offset (local.get $data)))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $bytes (local.get $d) + (i32.add (local.get $do) (local.get $i)) + (array.get $bytes (local.get $s) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + + (func $ta_blit_to_bytes (export "ta_blit_to_bytes") + (param $b (ref extern)) (param $so i32) + (param $d (ref $bytes)) (param $do i32) + (param $len i32) + (local $data (ref $data)) + (local $s (ref $bytes)) + (local $i i32) + (local.set $data + (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $s + (ref.cast (ref $bytes) (struct.get $data $array (local.get $data)))) + (local.set $so + (i32.add (local.get $so) (struct.get $data $offset (local.get $data)))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $bytes (local.get $d) + (i32.add (local.get $do) (local.get $i)) + (array.get $bytes (local.get $s) + (i32.add (local.get $so) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + + (func $dv_make (param $a (ref extern)) (result (ref extern)) (local.get $a)) + + (func $dv_get_i8 (export "dv_get_i8") + (param $a (ref extern)) (param $i i32) (result i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get_s $i8_array + (ref.cast (ref $i8_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)))) + + (func $dv_get_ui8 (export "dv_get_ui8") + (param $a (ref extern)) (param $i i32) (result i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get_u $i8_array + (ref.cast (ref $i8_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)))) + + (func $dv_get_i16 (export "dv_get_i16") + (param $a (ref extern)) (param $i i32) (param i32) (result i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get_s $i16_array + (ref.cast (ref $i16_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 1))))) + + (func $dv_get_ui16 (export "dv_get_ui16") + (param $a (ref extern)) (param $i i32) (param i32) (result i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get_u $i16_array + (ref.cast (ref $i16_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 1))))) + + (func $dv_get_i32 (export "dv_get_i32") + (param $a (ref extern)) (param $i i32) (param i32) (result i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get $i32_array + (ref.cast (ref $i32_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 2))))) + + (func $dv_get_i64 (export "dv_get_i64") + (param $a (ref extern)) (param $i i32) (param i32) (result i64) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get $i64_array + (ref.cast (ref $i64_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 3))))) + + (func $dv_get_f32 (export "dv_get_f32") + (param $a (ref extern)) (param $i i32) (param i32) (result f32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get $f32_array + (ref.cast (ref $f32_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 2))))) + + (func $dv_get_f64 (export "dv_get_f64") + (param $a (ref extern)) (param $i i32) (param i32) (result f64) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.get $f64_array + (ref.cast (ref $f64_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 3))))) + + (func $dv_set_i8 (export "dv_set_i8") + (param $a (ref extern)) (param $i i32) (param $v i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.set $i8_array + (ref.cast (ref $i8_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)) + (local.get $v))) + + (func $dv_set_i16 (export "dv_set_i16") + (param $a (ref extern)) (param $i i32) (param $v i32) (param i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.set $i16_array + (ref.cast (ref $i16_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 1))) + (local.get $v))) + + (func $dv_set_i32 (export "dv_set_i32") + (param $a (ref extern)) (param $i i32) (param $v i32) (param i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.set $i32_array + (ref.cast (ref $i32_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 2))) + (local.get $v))) + + (func $dv_set_i64 (export "dv_set_i64") + (param $a (ref extern)) (param $i i32) (param $v i64) (param i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.set $i64_array + (ref.cast (ref $i64_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 3))) + (local.get $v))) + + (func $dv_set_f32 (export "dv_set_f32") + (param $a (ref extern)) (param $i i32) (param $v f32) (param i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.set $f32_array + (ref.cast (ref $f32_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 2))) + (local.get $v))) + + (func $dv_set_f64 (export "dv_set_f64") + (param $a (ref extern)) (param $i i32) (param $v f64) (param i32) + (local $d (ref $data)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $a)))) + (array.set $f64_array + (ref.cast (ref $f64_array) (struct.get $data $array (local.get $d))) + (i32.add (struct.get $data $offset (local.get $d)) + (i32.shr_u (local.get $i) (i32.const 3))) + (local.get $v))) + + (func $dv_get_ui16_unaligned + (param $b (ref extern)) (param $i i32) (param i32) (result i32) + (local $d (ref $data)) (local $s (ref $bytes)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $s + (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))) + (local.set $i + (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))) + (i32.or + (array.get_u $bytes (local.get $s) (local.get $i)) + (i32.shl + (array.get_u $bytes (local.get $s) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 8)))) + + (func $dv_get_i32_unaligned (export "dv_get_i32_unaligned") + (param $b (ref extern)) (param $i i32) (param i32) (result i32) + (local $d (ref $data)) (local $s (ref $bytes)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $s + (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))) + (local.set $i + (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))) + (i32.or + (i32.or + (array.get_u $bytes (local.get $s) (local.get $i)) + (i32.shl + (array.get_u $bytes (local.get $s) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 8))) + (i32.or + (i32.shl + (array.get_u $bytes (local.get $s) + (i32.add (local.get $i) (i32.const 2))) + (i32.const 16)) + (i32.shl + (array.get_u $bytes (local.get $s) + (i32.add (local.get $i) (i32.const 3))) + (i32.const 24))))) + + (func $dv_get_i64_unaligned (export "dv_get_i64_unaligned") + (param $b (ref extern)) (param $i i32) (param $le i32) (result i64) + (i64.or + (i64.extend_i32_u + (call $dv_get_i32_unaligned + (local.get $b) (local.get $i) (local.get $le))) + (i64.shl + (i64.extend_i32_u + (call $dv_get_i32_unaligned + (local.get $b) (i32.add (local.get $i) (i32.const 4)) + (local.get $le))) + (i64.const 32)))) + + (func $dv_set_i16_unaligned + (param $b (ref extern)) (param $i i32) (param $v i32) (param i32) + (local $d (ref $data)) (local $s (ref $bytes)) (local $j i32) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $s + (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))) + (local.set $i + (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))) + (array.set $bytes (local.get $s) (local.get $i) (local.get $v)) + (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 1)) + (i32.shr_u (local.get $v) (i32.const 8)))) + + (func $dv_set_i32_unaligned + (param $b (ref extern)) (param $i i32) (param $v i32) (param i32) + (local $d (ref $data)) (local $s (ref $bytes)) + (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b)))) + (local.set $s + (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))) + (local.set $i + (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))) + (array.set $bytes (local.get $s) (local.get $i) (local.get $v)) + (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 1)) + (i32.shr_u (local.get $v) (i32.const 8))) + (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 2)) + (i32.shr_u (local.get $v) (i32.const 16))) + (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 3)) + (i32.shr_u (local.get $v) (i32.const 24)))) + + (func $dv_set_i64_unaligned + (param $b (ref extern)) (param $i i32) (param $v i64) (param $le i32) + (call $dv_set_i32_unaligned + (local.get $b) (local.get $i) + (i32.wrap_i64 (local.get $v)) + (local.get $le)) + (call $dv_set_i32_unaligned + (local.get $b) (i32.add (local.get $i) (i32.const 4)) + (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 32))) + (local.get $le))) + + (global $littleEndian i32 (i32.const 1)) +) +(@else (import "bindings" "ta_create" (func $ta_create (param i32) (param i32) (result (ref extern)))) (import "bindings" "ta_normalize" @@ -125,6 +637,7 @@ (import "bindings" "dv_set_i16" (func $dv_set_i16_unaligned (param externref i32 i32 i32))) (import "bindings" "littleEndian" (global $littleEndian i32)) +)) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) @@ -777,6 +1290,8 @@ (@string $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind") (@string $ta_too_large "Typed_array.to_genarray: too large") +(@if (not wasi) +(@then (func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq)) (local $data (ref extern)) (local $kind i32) @@ -823,6 +1338,7 @@ (if (i32.eq (local.get $kind) (i32.const 14)) ;; Uint8ClampedArray (then (local.set $kind (i32.const 3)))) (ref.i31 (local.get $kind))) +)) (func $caml_ba_get_at_offset (param $ba (ref $bigarray)) (param $i i32) (result (ref eq)) @@ -2528,6 +3044,8 @@ (array.get_u $bytes (local.get $s) (i32.add (local.get $i) (local.get $k))))))) +(@if (not wasi) +(@then (export "caml_bytes_of_uint8_array" (func $caml_string_of_uint8_array)) (func $caml_string_of_uint8_array (export "caml_string_of_uint8_array") (param (ref eq)) (result (ref eq)) @@ -2561,6 +3079,7 @@ (call $dv_make (local.get $ta)) (i32.const 0) (local.get $len)) (call $wrap (any.convert_extern (local.get $ta)))) +)) (func (export "caml_ba_get_kind") (param (ref eq)) (result i32) (struct.get_u $bigarray $ba_kind (ref.cast (ref $bigarray) (local.get 0)))) diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index 950ceff77f..818651e2ef 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -41,6 +41,21 @@ (import "bigarray" "caml_blit_bytes_to_dataview" (func $caml_blit_bytes_to_dataview (param (ref $bytes) i32 (ref extern) i32 i32))) +(@if wasi +(@then + (import "bigarray" "ta_subarray" + (func $ta_subarray + (param (ref extern)) (param i32) (param i32) (result (ref extern)))) + (import "bigarray" "ta_set" + (func $ta_set (param (ref extern)) (param (ref extern)) (param i32))) + (import "bigarray" "dv_get_i32_unaligned" + (func $dv_get_i32_unaligned (param (ref extern) i32 i32) (result i32))) + (import "bigarray" "dv_get_ui8" + (func $dv_get_ui8 (param (ref extern) i32) (result i32))) + (import "bigarray" "dv_set_i8" + (func $dv_set_i8 (param (ref extern) i32 i32))) +) +(@else (import "bindings" "ta_create" (func $ta_create (param i32) (param anyref) (result anyref))) (import "bindings" "dv_get_i32" @@ -56,6 +71,7 @@ (func $ta_set (param (ref extern)) (param (ref extern)) (param i32))) (import "bindings" "ta_bytes" (func $ta_bytes (param anyref) (result anyref))) +)) (import "hash" "caml_hash_mix_int" (func $caml_hash_mix_int (param i32) (param i32) (result i32))) @@ -102,6 +118,8 @@ (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (i32.xor (local.get $h) (local.get $len))) +(@if (not wasi) +(@then (@string $buffer "buffer") (func (export "bigstring_to_array_buffer") @@ -120,6 +138,7 @@ (func (export "bigstring_of_typed_array") (param (ref eq)) (result (ref eq)) (return_call $caml_ba_from_typed_array (call $wrap (call $ta_bytes (call $unwrap (local.get 0)))))) +)) (func (export "caml_bigstring_memset") (param $s (ref eq)) (param $pos (ref eq)) (param $len (ref eq)) diff --git a/runtime/wasm/blake2.wat b/runtime/wasm/blake2.wat index 25ad007838..214f941b67 100644 --- a/runtime/wasm/blake2.wat +++ b/runtime/wasm/blake2.wat @@ -1,5 +1,5 @@ (module -(@if (>= ocaml_version (5 2 0)) +(@if (and (>= ocaml_version (5 2 0)) (not wasi)) (@then (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq)))) (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref))) diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat index ff4784b9d3..597b1632cd 100644 --- a/runtime/wasm/compare.wat +++ b/runtime/wasm/compare.wat @@ -487,6 +487,8 @@ (call $clear_compare_stack) (call $caml_invalid_argument (global.get $abstract_value)) (ref.i31 (i32.const 0)))) +(@if (not wasi) +(@then (drop (block $v1_not_js (result (ref eq)) (local.set $js1 (struct.get $js 0 @@ -514,6 +516,7 @@ (call $equals (local.get $js1) (local.get $js2))) (return (global.get $unordered)))) (br $heterogeneous (ref.i31 (i32.const 0))))) +)) (if (call $caml_is_closure (local.get $v1)) (then (drop (br_if $heterogeneous (ref.i31 (i32.const 0)) diff --git a/runtime/wasm/deps-wasi.json b/runtime/wasm/deps-wasi.json new file mode 100644 index 0000000000..0a49660901 --- /dev/null +++ b/runtime/wasm/deps-wasi.json @@ -0,0 +1,15 @@ +[ + { + "name": "root", + "reaches": ["start", "memory"], + "root": true + }, + { + "name": "start", + "export": "_start" + }, + { + "name": "memory", + "export": "memory" + } +] diff --git a/runtime/wasm/dune b/runtime/wasm/dune index 8f8b26c023..a69d9e0a3e 100644 --- a/runtime/wasm/dune +++ b/runtime/wasm/dune @@ -28,6 +28,7 @@ --binaryen=-g --binaryen-opt=-O3 --set=effects=jspi + --disable=wasi --allowed-imports=bindings,Math,js,wasm:js-string,wasm:text-encoder,wasm:text-decoder %{target} %{read-lines:args}))) @@ -44,10 +45,46 @@ --binaryen=-g --binaryen-opt=-O3 --set=effects=cps + --disable=wasi --allowed-imports=bindings,Math,js,wasm:js-string,wasm:text-encoder,wasm:text-decoder %{target} %{read-lines:args}))) +(rule + (target runtime-wasi.wasm) + (deps + args + (glob_files *.wat) + libc.wasm) + (action + (run + ../../compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.exe + --binaryen=-g + --binaryen-opt=-O3 + --set=effects=disabled + --enable=wasi + --allowed-imports=wasi_snapshot_preview1,OCaml + %{target} + libc:libc.wasm + %{read-lines:args}))) + +(rule + (target runtime-cps-wasi.wasm) + (deps + args + (glob_files *.wat) + libc.wasm) + (action + (run + ../../compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.exe + --binaryen=-g + --binaryen-opt=-O3 + --set=effects=cps + --enable=wasi + %{target} + libc:libc.wasm + %{read-lines:args}))) + (rule (target args) (deps @@ -57,3 +94,34 @@ (with-stdout-to %{target} (run ocaml %{deps})))) + +(rule + (target libc.new.wasm) + (deps libc.c) + (enabled_if + (not %{env:CI=false})) + (mode promote) + (action + (with-stdout-to + %{target} + (pipe-stdout + (run + docker + run + -v + .:/src + -w + /src + ghcr.io/webassembly/wasi-sdk + /opt/wasi-sdk/bin/clang + -O2 + libc.c + -flto + -o + -) + (run wasm-opt -Oz --strip-debug --strip-dwarf - -o -))))) + +(rule + (alias recompile-libc) + (action + (cmp libc.wasm libc.new.wasm))) diff --git a/runtime/wasm/dynlink.wat b/runtime/wasm/dynlink.wat index 6e49560817..5e1edea6c0 100644 --- a/runtime/wasm/dynlink.wat +++ b/runtime/wasm/dynlink.wat @@ -37,6 +37,8 @@ (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) +(@if (not wasi) +(@then (func (export "caml_wasm_load_module") (param $str (ref eq)) (result (ref eq)) (call $wrap @@ -57,6 +59,7 @@ (call $unwrap (call $caml_jsstring_of_string (local.get $unit_name))) (call $unwrap (call $caml_jsstring_of_string (local.get $source)))) (ref.i31 (i32.const 0))) +)) ;; Field index for prim_count in link_info (must match stdlib.wat) (global $LINK_INFO_PRIM_COUNT i32 (i32.const 3)) diff --git a/runtime/wasm/effect-native.wat b/runtime/wasm/effect-native.wat index 2c23675259..530e56dfc1 100644 --- a/runtime/wasm/effect-native.wat +++ b/runtime/wasm/effect-native.wat @@ -152,9 +152,12 @@ (on $effect $handle_effect) (local.get $f) (local.get $v) (struct.get $fiber $cont (local.get $fiber)))) +(@if (not wasi) +(@then (catch $javascript_exception (br $handle_exception (call $caml_wrap_exception (pop externref)))) +)) (catch $ocaml_exception (br $handle_exception (pop (ref eq)))))) ;; handle return diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat index f314f1c9d8..e3ab3b8b8b 100644 --- a/runtime/wasm/effect.wat +++ b/runtime/wasm/effect.wat @@ -33,6 +33,12 @@ (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) +(@if wasi +(@then + (func $caml_wrap_exception (param externref) (result (ref eq)) + (unreachable)) +) +(@else (import "jslib" "caml_wrap_exception" (func $caml_wrap_exception (param externref) (result (ref eq)))) (import "bindings" "start_fiber" (func $start_fiber (param (ref eq)))) @@ -41,6 +47,7 @@ (param $f funcref) (param $env eqref) (result anyref))) (import "bindings" "resume_fiber" (func $resume_fiber (param externref) (param (ref eq)))) +)) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat index 3a89dd757a..e8320a6cf6 100644 --- a/runtime/wasm/fail.wat +++ b/runtime/wasm/fail.wat @@ -18,7 +18,13 @@ (module (import "stdlib" "caml_global_data" (global $caml_global_data (mut (ref $block)))) +(@if wasi +(@then + (tag $javascript_exception (param externref)) +) +(@else (import "bindings" "jstag" (tag $javascript_exception (param externref))) +)) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat index de248db496..0d4fdc25d4 100644 --- a/runtime/wasm/float.wat +++ b/runtime/wasm/float.wat @@ -16,12 +16,35 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module +(@if wasi +(@then + (import "io" "IO_BUFFER_SIZE" (global $IO_BUFFER_SIZE i32)) + (import "libc" "memory" (memory 2)) + (import "libc" "free" (func $free (param i32))) + (import "libc" "format_float" + (func $format_float (param i32 i32 i32 f64) (result i32))) + (import "libc" "strtod" (func $strtod (param i32) (param i32) (result f64))) + (import "libc" "exp" (func $exp (param f64) (result f64))) + (import "wasi_memory" "checked_malloc" + (func $checked_malloc (param i32) (result i32))) + (import "wasi_memory" "get_buffer" (func $get_buffer (result i32))) + (import "wasi_memory" "write_string_to_memory" + (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32))) + (import "wasi_memory" "release_memory" + (func $release_memory (param i32 i32))) + (import "wasi_memory" "blit_string_to_memory" + (func $blit_string_to_memory (param i32 (ref $bytes)))) + (import "wasi_memory" "blit_memory_to_string" + (func $blit_memory_to_string (param i32 i32) (result (ref $bytes)))) +) +(@else (import "bindings" "format_float" (func $format_float (param i32) (param i32) (param i32) (param f64) (result anyref))) (import "bindings" "identity" (func $parse_float (param anyref) (result f64))) (import "Math" "exp" (func $exp (param f64) (result f64))) +)) (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq)))) (import "fail" "caml_invalid_argument" (func $caml_invalid_argument (param (ref eq)))) @@ -251,6 +274,49 @@ (global $inf (ref $chars) (array.new_fixed $chars 3 (@char "i") (@char "n") (@char "f"))) +(@if wasi +(@then + (func (export "caml_format_float") + (param $vfmt (ref eq)) (param $arg (ref eq)) (result (ref eq)) + (local $fmt (ref $bytes)) (local $res (ref $bytes)) + (local $d f64) + (local $buffer i32) (local $out_buffer i32) + (local $fmt_len i32) (local $avail i32) (local $len i32) + (local.set $fmt (ref.cast (ref $bytes) (local.get $vfmt))) + (local.set $d + (struct.get $float 0 (ref.cast (ref $float) (local.get $arg)))) + (local.set $buffer (call $get_buffer)) + (local.set $fmt_len (array.len (local.get $fmt))) + (call $blit_string_to_memory (local.get $buffer) (local.get $fmt)) + (i32.store8 + (i32.add (local.get $buffer) (local.get $fmt_len)) (i32.const 0)) + (local.set $out_buffer + (i32.add (local.get $buffer) + (i32.add (local.get $fmt_len) (i32.const 1)))) + (local.set $avail + (i32.sub (global.get $IO_BUFFER_SIZE) (local.get $fmt_len))) + (local.set $len + (call $format_float + (local.get $out_buffer) (local.get $avail) + (local.get $buffer) (local.get $d))) + (if (i32.ge_u (local.get $len) (local.get $avail)) + (then + (local.set $out_buffer + (call $checked_malloc (i32.add (local.get $len) (i32.const 1)))) + (drop + (call $format_float + (local.get $out_buffer) + (i32.add (local.get $len) (i32.const 1)) + (local.get $buffer) (local.get $d))))) + (local.set $res + (call $blit_memory_to_string (local.get $out_buffer) (local.get $len))) + (if (i32.ge_u (local.get $len) (local.get $avail)) + (then + (call $free (local.get $out_buffer)))) + (local.get $res) + ) +) +(@else (func (export "caml_format_float") (param (ref eq)) (param (ref eq)) (result (ref eq)) (local $f f64) (local $b i64) (local $format (tuple i32 i32 i32 i32)) @@ -333,6 +399,7 @@ (local.set $i (i32.add (local.get $i) (i32.const 1))) (br_if $uppercase (i32.lt_u (local.get $i) (local.get $len)))))) (local.get $s)) +)) (func $caml_float_of_hex (param $err_msg (ref eq)) (param $s (ref $bytes)) (param $i i32) @@ -490,6 +557,7 @@ (local $s' (ref $bytes)) (local $negative i32) (local $c i32) (local $f f64) + (local $buffer i32) (local $buf i32) (local.set $s (ref.cast (ref $bytes) (local.get 1))) (local.set $len (array.len (local.get $s))) (loop $count @@ -657,9 +725,26 @@ (f64.const inf) (local.get $negative)))) )))))))))))))))))) +(@if wasi +(@then + (local.set $buffer (call $get_buffer)) + (local.set $buf + (call $write_string_to_memory + (i32.add (local.get $buffer) (i32.const 4)) + (global.get $IO_BUFFER_SIZE) + (local.get $s))) + (local.set $f (call $strtod (local.get $buf) (local.get $buffer))) + (call $release_memory (i32.add (local.get $buffer) (i32.const 4)) + (local.get $buf)) + (br_if $error + (i32.ne (i32.load (local.get $buffer)) + (i32.add (local.get $buf) (local.get $len)))) +) +(@else (local.set $f (call $parse_float (call $jsstring_of_bytes (local.get $s)))) (br_if $error (f64.ne (local.get $f) (local.get $f))) +)) (return (struct.new $float (local.get $f)))) (call $caml_failwith (local.get $err_msg)) (return (ref.i31 (i32.const 0)))) diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat index 11a92da7c0..fff3ec814a 100644 --- a/runtime/wasm/fs.wat +++ b/runtime/wasm/fs.wat @@ -16,6 +16,41 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module +(@if wasi +(@then + (import "libc" "memory" (memory 2)) + (import "libc" "free" (func $free (param i32))) + (import "wasi_memory" "checked_malloc" + (func $checked_malloc (param i32) (result i32))) + (import "wasi_memory" "get_buffer" (func $get_buffer (result i32))) + (import "wasi_memory" "write_string_to_memory" + (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32))) + (import "wasi_memory" "blit_memory_to_string" + (func $blit_memory_to_string (param i32 i32) (result (ref $bytes)))) + (import "wasi_snapshot_preview1" "fd_prestat_get" + (func $fd_prestat_get (param i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_prestat_dir_name" + (func $fd_prestat_dir_name (param i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_rename" + (func $path_rename (param i32 i32 i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_unlink_file" + (func $path_unlink_file (param i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_create_directory" + (func $path_create_directory (param i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_remove_directory" + (func $path_remove_directory (param i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_filestat_get" + (func $path_filestat_get (param i32 i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_open" + (func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_readdir" + (func $fd_readddir (param i32 i32 i32 i64 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_close" + (func $fd_close (param i32) (result i32))) + (import "sys" "caml_handle_sys_error" + (func $caml_handle_sys_error (param (ref eq) i32))) +) +(@else (import "bindings" "on_windows" (global $on_windows i32)) (import "bindings" "getcwd" (func $getcwd (result anyref))) (import "bindings" "chdir" (func $chdir (param anyref))) @@ -44,6 +79,11 @@ (tag $javascript_exception (param externref))) (import "sys" "caml_handle_sys_error" (func $caml_handle_sys_error (param externref))) + (import "bigarray" "caml_uint8_array_of_string" + (func $caml_uint8_array_of_string (param (ref eq)) (result (ref eq)))) + (import "bigarray" "caml_string_of_uint8_array" + (func $caml_string_of_uint8_array (param (ref eq)) (result (ref eq)))) +)) (import "string" "caml_string_concat" (func $caml_string_concat (param (ref eq) (ref eq)) (result (ref eq)))) (import "fail" "caml_raise_sys_error" @@ -52,13 +92,291 @@ (func $register_file (param anyref) (param anyref))) (import "bindings" "read_file" (func $read_file (param anyref) (result anyref))) - (import "bigarray" "caml_uint8_array_of_string" - (func $caml_uint8_array_of_string (param (ref eq)) (result (ref eq)))) - (import "bigarray" "caml_string_of_uint8_array" - (func $caml_string_of_uint8_array (param (ref eq)) (result (ref eq)))) (type $bytes (array (mut i8))) + (type $block (array (mut (ref eq)))) + +(@if wasi +(@then + (type $preopen + (struct + (field $prefix (ref $bytes)) + (field $fd i32) + (field $next (ref null $preopen)))) + + (global $preopens (mut (ref null $preopen)) (ref.null $preopen)) + + (global $preopens_initialized (mut i32) (i32.const 0)) + + (func $normalize_prefix (param $prefix (ref $bytes)) (result (ref $bytes)) + (local $i i32) (local $len i32) (local $c i32) (local $res (ref $bytes)) + (local.set $len (array.len (local.get $prefix))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $c + (array.get $bytes (local.get $prefix) (local.get $i))) + (if (i32.eq (local.get $c) (i32.const 47)) ;; '/' + (then + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))) + (if (i32.eq (local.get $c) (i32.const 46)) ;; '.' + (then + (if (i32.eq (local.get $i) + (i32.sub (local.get $len) (i32.const 1))) + (then + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)) + (else + (local.set $c + (array.get $bytes (local.get $prefix) + (i32.add (local.get $i) (i32.const 1)))) + (if (i32.eq (local.get $c) (i32.const 47)) ;; '/' + (then + (local.set $i + (i32.add (local.get $i) (i32.const 2))) + (br $loop)))))))))) + (if (i32.eq (local.get $i) (local.get $len)) + (then (return (@string "")))) + (local.set $i (i32.sub (local.get $i) (i32.const 1))) + (if (i32.gt_u (local.get $i) (i32.const 0)) + (then + (local.set $res + (array.new $bytes (i32.const 0) + (i32.sub (local.get $len) (local.get $i)))) + (array.copy $bytes $bytes + (local.get $res) (i32.const 0) + (local.get $prefix) (local.get $i) + (i32.sub (local.get $len) (local.get $i))) + (return (local.get $res)))) + (return (local.get $prefix))) + + (func $get_preopens (result (ref null $preopen)) + (local $fd i32) (local $buffer i32) (local $res i32) (local $len i32) + (if $done (i32.eqz (global.get $preopens_initialized)) + (then + (local.set $buffer (call $get_buffer)) + (local.set $fd (i32.const 3)) + (loop $loop + (local.set $res + (call $fd_prestat_get (local.get $fd) (local.get $buffer))) + (br_if $done (i32.eq (local.get $res) (i32.const 8))) ;; EBADF + (block $skip + (br_if $skip + (i32.eqz + (i32.and (i32.eqz (local.get $res)) + (i32.eqz (i32.load8_u (local.get $buffer)))))) + (local.set $len (i32.load offset=4 (local.get $buffer))) + (local.set $res + (call $fd_prestat_dir_name + (local.get $fd) (local.get $buffer) (local.get $len))) + (br_if $skip (local.get $res)) + (global.set $preopens + (struct.new $preopen + (call $normalize_prefix + (call $blit_memory_to_string + (local.get $buffer) (local.get $len))) + (local.get $fd) + (global.get $preopens)))) + (local.set $fd (i32.add (local.get $fd) (i32.const 1))) + (br $loop)) + (global.set $preopens_initialized (i32.const 1)))) + (global.get $preopens)) + + (global $current_dir (mut (ref $bytes)) (@string "")) + + (@string $root_dir "/") + + (func $make_absolute + (param $path (ref $bytes)) (result (ref $bytes)) + (local $need_slash i32) (local $i i32) (local $abs_path (ref $bytes)) + (if (i32.eqz (array.len (local.get $path))) + (then ;; empty path + (return (global.get $current_dir)))) + (if (i32.eq (i32.const 47) ;; '/' + (array.get_u $bytes (local.get $path) (i32.const 0))) + (then ;; absolute path + (return (local.get $path)))) + (if (i32.and + (i32.eq (i32.const 46) ;; '.' + (array.get_u $bytes (local.get $path) (i32.const 0))) + (i32.eq (array.len (local.get $path)) (i32.const 1))) + (then + ;; "." + (return (global.get $current_dir)))) + (if (i32.ge_u (array.len (local.get $path)) (i32.const 2)) + (then + (if (i32.and + (i32.eq (i32.const 46) ;; '.' + (array.get_u $bytes (local.get $path) (i32.const 0))) + (i32.eq (i32.const 47) ;; '/' + (array.get_u $bytes (local.get $path) (i32.const 1)))) + (then ;; starts with "./" + (local.set $i (i32.const 2)))))) + (if (i32.eq (local.get $i) (array.len (local.get $path))) + (then ;; "./" + (return (global.get $current_dir)))) + (local.set $need_slash + (if (result i32) (array.len (global.get $current_dir)) + (then + (i32.ne (i32.const 47) ;; '/' + (array.get_u $bytes (global.get $current_dir) + (i32.sub (array.len (global.get $current_dir)) + (i32.const 1))))) + (else + (i32.const 1)))) + (local.set $abs_path + (array.new $bytes (i32.const 0) + (i32.add (array.len (global.get $current_dir)) + (i32.add (i32.sub (local.get $need_slash) (local.get $i)) + (array.len (local.get $path)))))) + (array.copy $bytes $bytes + (local.get $abs_path) (i32.const 0) + (global.get $current_dir) (i32.const 0) + (array.len (global.get $current_dir))) + (array.set $bytes (local.get $abs_path) + (array.len (global.get $current_dir)) + (i32.const 47)) ;; '/' + (array.copy $bytes $bytes + (local.get $abs_path) + (i32.add (array.len (global.get $current_dir)) + (local.get $need_slash)) + (local.get $path) (local.get $i) + (i32.sub (array.len (local.get $path)) (local.get $i))) + (local.get $abs_path)) + (func $wasi_chdir (export "wasi_chdir") (param $name (ref eq)) + (local $abs_path (ref $bytes)) (local $path (ref $bytes)) (local $i i32) + (local.set $abs_path + (call $make_absolute (ref.cast (ref $bytes) (local.get $name)))) + (local.set $i (i32.sub (array.len (local.get $abs_path)) (i32.const 1))) + ;; remove trailing slashes + (loop $loop + (if (i32.ge_s (local.get $i) (i32.const 0)) + (then + (if (i32.eq (i32.const 47) ;; '/' + (array.get $bytes (local.get $abs_path) (local.get $i))) + (then + (local.set $i (i32.sub (local.get $i) (i32.const 1))) + (br $loop)))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (if (i32.lt_u (local.get $i) (array.len (local.get $abs_path))) + (then + (local.set $path (array.new $bytes (i32.const 0) (local.get $i))) + (array.copy $bytes $bytes + (local.get $path) (i32.const 0) + (local.get $abs_path) (i32.const 0) + (local.get $i)) + (local.set $abs_path (local.get $path)))) + (global.set $current_dir (local.get $abs_path))) + + (func $prefix_match + (param $prefix (ref $bytes)) (param $path (ref $bytes)) (result i32) + (local $i i32) (local $len i32) + (local.set $len (array.len (local.get $prefix))) + (if (i32.lt_u (array.len (local.get $path)) (local.get $len)) + (then (return (i32.const 0)))) + (if (i32.gt_u (array.len (local.get $path)) (local.get $len)) + (then + (if (i32.ne (array.get_u $bytes (local.get $path) (local.get $len)) + (i32.const 47)) + (then (return (i32.const 0)))))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (if (i32.ne (array.get_u $bytes (local.get $path) (local.get $i)) + (array.get_u $bytes (local.get $prefix) (local.get $i))) + (then (return (i32.const 0)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (return (i32.const 1))) + + (func $resolve_abs_path + (param $path (ref $bytes)) (result i32 (ref $bytes)) + (local $fd i32) (local $len i32) (local $i i32) + (local $preopens (ref null $preopen)) (local $current (ref $preopen)) + (local $prefix (ref $bytes)) (local $rel_path (ref $bytes)) + (local.set $preopens (call $get_preopens)) + (local.set $i (i32.const -1)) + (block $done + (loop $loop + (local.set $current (br_on_null $done (local.get $preopens))) + (local.set $prefix + (struct.get $preopen $prefix (local.get $current))) + (if (i32.and + (i32.gt_s (array.len (local.get $prefix)) (local.get $i)) + (call $prefix_match (local.get $prefix) (local.get $path))) + (then + (local.set $fd (struct.get $preopen $fd (local.get $current))) + (local.set $i (array.len (local.get $prefix))))) + (local.set $preopens + (struct.get $preopen $next (local.get $current))) + (br $loop))) + (if (i32.eq (local.get $i) (i32.const -1)) + (then ;; not found + (return (tuple.make 2 (i32.const -1) (@string ""))))) + ;; skip leading slashes + (local.set $len (local.get $i)) + (loop $loop + (if (i32.lt_u (local.get $i) (array.len (local.get $path))) + (then + (if (i32.eq (array.get_u $bytes (local.get $path) (local.get $i)) + (i32.const 47)) ;; 47 + (then + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))) + (local.set $rel_path + (array.new $bytes (i32.const 0) + (i32.sub (array.len (local.get $path)) (local.get $i)))) + (array.copy $bytes $bytes + (local.get $rel_path) (i32.const 0) + (local.get $path) (local.get $i) + (i32.sub (array.len (local.get $path)) (local.get $i))) + (return + (tuple.make 2 (local.get $fd) (local.get $rel_path)))))) + (return (tuple.make 2 (local.get $fd) (@string ".")))) + + (func (export "wasi_resolve_path") + (param $vpath (ref eq)) + (result (;fd;) i32 (;address;) i32 (;length;) i32) + (local $res (tuple i32 (ref $bytes))) + (local $p i32) + (local.set $res + (call $resolve_abs_path + (call $make_absolute + (ref.cast (ref $bytes) (local.get $vpath))))) + (if (i32.ge_u (tuple.extract 2 0 (local.get $res)) (i32.const 0)) + (then + (local.set $p + (call $write_string_to_memory + (i32.const 0) (i32.const 0) + (tuple.extract 2 1 (local.get $res)))))) + (return + (tuple.make 3 + (tuple.extract 2 0 (local.get $res)) + (local.get $p) + (array.len (tuple.extract 2 1 (local.get $res)))))) + + (func $caml_sys_resolve_path (export "caml_sys_resolve_path") + (param $path (ref eq)) (result i32 i32 i32) + (local $res (tuple i32 i32 i32)) + (local.set $res (call $wasi_resolve_path (local.get $path))) + (if (i32.lt_s (tuple.extract 3 0 (local.get $res)) (i32.const 0)) + (then ;; ENOENT + (call $caml_handle_sys_error (local.get $path) (i32.const 44)))) + (local.get $res)) +)) + +(@if wasi +(@then + (func (export "caml_sys_getcwd") + (export "unix_getcwd") (export "caml_unix_getcwd") + (param (ref eq)) (result (ref eq)) + (if (array.len (global.get $current_dir)) + (then (return (global.get $current_dir)))) + (global.get $root_dir)) +) +(@else (func (export "caml_sys_getcwd") (param (ref eq)) (result (ref eq)) (try (result (ref eq)) @@ -67,7 +385,35 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)) (ref.i31 (i32.const 0))))) +)) +(@if wasi +(@then + (func (export "caml_sys_chdir") + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $buffer i32) (local $res i32) (local $kind i32) + (local.set $p (call $caml_sys_resolve_path (local.get $name))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_filestat_get + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then (call $caml_handle_sys_error (local.get $name) (local.get $res)))) + (local.set $kind (i32.load8_u offset=16 (local.get $buffer))) + (if (i32.ne (local.get $kind) (i32.const 3)) + (then + (call $caml_handle_sys_error + (local.get $name) (i32.const 54)))) ;; ENOTDIR + (call $wasi_chdir (local.get $name)) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_sys_chdir") (param $name (ref eq)) (result (ref eq)) (try @@ -77,7 +423,26 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (func (export "caml_sys_mkdir") + (param $name (ref eq)) (param $perm (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) + (local.set $p (call $caml_sys_resolve_path (local.get $name))) + (local.set $res + (call $path_create_directory + (tuple.extract 3 0 (local.get $p)) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then (call $caml_handle_sys_error (local.get $name) (local.get $res)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_sys_mkdir") (param $name (ref eq)) (param $perm (ref eq)) (result (ref eq)) (try @@ -88,7 +453,130 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (func (export "caml_sys_read_directory") + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $buffer i32) (local $res i32) (local $fd i32) + (local $buf i32) (local $new_buf i32) + (local $size i32) (local $pos i32) (local $available i32) + (local $left i32) (local $namelen i32) + (local $entry i32) (local $entry_size i32) + (local $cookie i64) (local $tbl (ref $block)) (local $new_tbl (ref $block)) + (local $i i32) (local $s (ref $bytes)) + (local.set $p (call $caml_sys_resolve_path (local.get $name))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_open + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) ;; symlink_follow + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (i32.const 2) ;; O_DIRECTORY + (i64.const 0x4000) ;; allow fd_readdir + (i64.const 0) + (i32.const 0) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_handle_sys_error (local.get $name) (local.get $res)))) + (local.set $fd (i32.load (local.get $buffer))) + (local.set $buf (call $checked_malloc (i32.const 512))) + (local.set $size (i32.const 512)) + (local.set $tbl (array.new $block (ref.i31 (i32.const 0)) (i32.const 50))) + (local.set $i (i32.const 1)) + (loop $loop + (block $refill + (local.set $left (i32.sub (local.get $available) (local.get $pos))) + (br_if $refill (i32.lt_u (local.get $left) (i32.const 24))) + (local.set $entry (i32.add (local.get $buf) (local.get $pos))) + (local.set $namelen (i32.load offset=16 (local.get $entry))) + (local.set $entry_size (i32.add (local.get $namelen) (i32.const 24))) + (br_if $refill (i32.lt_u (local.get $left) (local.get $entry_size))) + (local.set $pos (i32.add (local.get $pos) (local.get $entry_size))) + (local.set $cookie (i64.load (local.get $entry))) + (if (i32.eq (local.get $i) (array.len (local.get $tbl))) + (then + (local.set $new_tbl + (array.new $block (ref.i31 (i32.const 0)) + (i32.shl (local.get $i) (i32.const 1)))) + (array.copy $block $block + (local.get $new_tbl) (i32.const 0) + (local.get $tbl) (i32.const 0) (local.get $i)) + (local.set $tbl (local.get $new_tbl)))) + (local.set $s + (call $blit_memory_to_string + (i32.add (local.get $entry) (i32.const 24)) + (local.get $namelen))) + ;; skip "." and ".." + (if (i32.eq (local.get $namelen) (i32.const 2)) + (then + (br_if $loop + (i32.and + (i32.eq (i32.const 46) + (array.get_u $bytes (local.get $s) (i32.const 0))) + (i32.eq (i32.const 46) + (array.get_u $bytes (local.get $s) (i32.const 1)))))) + (else + (if (i32.eq (local.get $namelen) (i32.const 1)) + (then + (br_if $loop + (i32.eq + (array.get_u $bytes (local.get $s) (i32.const 0)) + (i32.const 46))))))) + (array.set $block (local.get $tbl) (local.get $i) (local.get $s)) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)) + ;; refill + (if (i32.lt_u (local.get $size) (local.get $entry_size)) + (then + ;; the entry does not fit + (local.set $new_buf + (call $checked_malloc (local.get $entry_size))) + (call $free (local.get $buf)) + (local.set $buf (local.get $new_buf)) + (local.set $size (local.get $entry_size)))) + (block $done + (br_if $done + (i32.and + (i32.ne (i32.const 0) (local.get $available)) + (i32.lt_u (local.get $available) (local.get $size)))) + (local.set $res + (call $fd_readddir + (local.get $fd) + (local.get $buf) + (local.get $size) + (local.get $cookie) + (local.get $buffer))) + (if (local.get $res) + (then + (call $free (local.get $buf)) + (drop (call $fd_close (local.get $fd))) + (call $caml_handle_sys_error + (local.get $name) (local.get $res)))) + (local.set $available (i32.load (local.get $buffer))) + (br_if $done (i32.eqz (local.get $available))) + (local.set $pos (i32.const 0)) + (br $loop))) + ;; done + (call $free (local.get $buf)) + (local.set $res (call $fd_close (local.get $fd))) + (if (local.get $res) + (then (call $caml_handle_sys_error (local.get $name) (local.get $res)))) + (if (i32.eq (local.get $i) (array.len (local.get $tbl))) + (then (return (local.get $tbl)))) + (local.set $new_tbl + (array.new $block (ref.i31 (i32.const 0)) (local.get $i))) + (array.copy $block $block + (local.get $new_tbl) (i32.const 0) + (local.get $tbl) (i32.const 0) (local.get $i)) + (local.get $new_tbl)) +) +(@else (func (export "caml_sys_read_directory") (param $name (ref eq)) (result (ref eq)) (try @@ -101,7 +589,26 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)) (return (ref.i31 (i32.const 0)))))) +)) +(@if wasi +(@then + (func (export "caml_sys_rmdir") + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) + (local.set $p (call $caml_sys_resolve_path (local.get $name))) + (local.set $res + (call $path_remove_directory + (tuple.extract 3 0 (local.get $p)) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then (call $caml_handle_sys_error (local.get $name) (local.get $res)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_sys_rmdir") (param $name (ref eq)) (result (ref eq)) (try @@ -111,7 +618,26 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (func (export "caml_sys_remove") + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) + (local.set $p (call $caml_sys_resolve_path (local.get $name))) + (local.set $res + (call $path_unlink_file + (tuple.extract 3 0 (local.get $p)) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then (call $caml_handle_sys_error (local.get $name) (local.get $res)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_sys_remove") (param $name (ref eq)) (result (ref eq)) (try @@ -121,7 +647,32 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (func (export "caml_sys_rename") + (param $o (ref eq)) (param $n (ref eq)) (result (ref eq)) + (local $op (tuple i32 i32 i32)) + (local $np (tuple i32 i32 i32)) + (local $res i32) + (local.set $op (call $caml_sys_resolve_path (local.get $o))) + (local.set $np (call $caml_sys_resolve_path (local.get $n))) + (local.set $res + (call $path_rename + (tuple.extract 3 0 (local.get $op)) + (tuple.extract 3 1 (local.get $op)) + (tuple.extract 3 2 (local.get $op)) + (tuple.extract 3 0 (local.get $np)) + (tuple.extract 3 1 (local.get $np)) + (tuple.extract 3 2 (local.get $np)))) + (call $free (tuple.extract 3 1 (local.get $op))) + (call $free (tuple.extract 3 1 (local.get $np))) + (if (local.get $res) + (then (call $caml_handle_sys_error (local.get $o) (local.get $res)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_sys_rename") (param $o (ref eq)) (param $n (ref eq)) (result (ref eq)) (try @@ -132,11 +683,34 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (func (export "caml_sys_file_exists") + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) (local $buffer i32) + (local.set $p (call $wasi_resolve_path (local.get $name))) + (if (i32.lt_s (tuple.extract 3 0 (local.get $p)) (i32.const 0)) + (then (return (ref.i31 (i32.const 0))))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_filestat_get + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (ref.i31 (i32.eqz (local.get $res)))) +) +(@else (func (export "caml_sys_file_exists") (param $name (ref eq)) (result (ref eq)) (return_call $file_exists (call $unwrap (call $caml_jsstring_of_string (local.get $name))))) +)) (@string $no_such_file ": No such file or directory") @@ -145,6 +719,14 @@ (call $caml_string_concat (local.get $name) (global.get $no_such_file)))) +(@if wasi +(@then + (func (export "caml_read_file_content") + (param $name (ref eq)) (result (ref eq)) + (call $caml_raise_no_such_file (local.get $name)) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_read_file_content") (param $name (ref eq)) (result (ref eq)) (local $res anyref) @@ -157,17 +739,51 @@ (return (ref.i31 (i32.const 0))))) (return_call $caml_string_of_uint8_array (call $wrap (local.get $res)))) +)) +(@if wasi +(@then + (func (export "caml_create_file") + (param $name (ref eq)) (param $content (ref eq)) (result (ref eq)) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_create_file") (param $name (ref eq)) (param $content (ref eq)) (result (ref eq)) (call $register_file (call $unwrap (call $caml_jsstring_of_string (local.get $name))) (call $unwrap (call $caml_uint8_array_of_string (local.get $content)))) (ref.i31 (i32.const 0))) +)) (func (export "caml_fs_init") (result (ref eq)) (ref.i31 (i32.const 0))) +(@if wasi +(@then + (func $caml_sys_file_mode (param $name (ref eq)) (result i32) + (local $p (tuple i32 i32 i32)) + (local $res i32) (local $buffer i32) + (local.set $p (call $caml_sys_resolve_path (local.get $name))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_filestat_get + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then (call $caml_handle_sys_error (local.get $name) (local.get $res)))) + (i32.load8_u offset=16 (local.get $buffer))) + + (func (export "caml_sys_is_directory") + (param $name (ref eq)) (result (ref eq)) + (ref.i31 + (i32.eq (call $caml_sys_file_mode (local.get $name)) (i32.const 3)))) +) +(@else (func (export "caml_sys_is_directory") (param $name (ref eq)) (result (ref eq)) (try @@ -179,7 +795,16 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)) (return (ref.i31 (i32.const 0)))))) +)) +(@if wasi +(@then + (func (export "caml_sys_is_regular_file") + (param $name (ref eq)) (result (ref eq)) + (ref.i31 + (i32.eq (call $caml_sys_file_mode (local.get $name)) (i32.const 4)))) +) +(@else (func (export "caml_sys_is_regular_file") (param $name (ref eq)) (result (ref eq)) (try @@ -191,12 +816,20 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)) (return (ref.i31 (i32.const 0)))))) +)) +(@if wasi +(@then + (func (export "caml_sys_temp_dir_name") (param (ref eq)) (result (ref eq)) + (@string "/tmp")) +) +(@else (func (export "caml_sys_temp_dir_name") (param (ref eq)) (result (ref eq)) (if (global.get $on_windows) (then (return_call $caml_string_of_jsstring (call $wrap (call $tmpdir))))) (@string "")) +)) (func (export "caml_mount_autoload") (param (ref eq) (ref eq)) (result (ref eq)) diff --git a/runtime/wasm/graphics.wat b/runtime/wasm/graphics.wat index 5046b2a7c9..7a8003ce20 100644 --- a/runtime/wasm/graphics.wat +++ b/runtime/wasm/graphics.wat @@ -16,6 +16,10 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module + +(@if (not wasi) +(@then + ;; Imports from other wasm modules (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq)))) (import "fail" "caml_raise_with_arg" @@ -546,4 +550,5 @@ (param (ref eq)) (result (ref eq)) (call $caml_failwith (global.get $close_subwindow)) (ref.i31 (i32.const 0))) +)) ) diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat index 671eb50595..0912b448fa 100644 --- a/runtime/wasm/hash.wat +++ b/runtime/wasm/hash.wat @@ -304,6 +304,8 @@ (local.get $v)))))))) (local.set $num (i32.sub (local.get $num) (i32.const 1))) (br $loop))) +(@if (not wasi) +(@then (drop (block $not_jsstring (result anyref) (local.set $str (struct.get $js 0 @@ -315,6 +317,7 @@ (local.set $h (call $jsstring_hash (local.get $h) (local.get $str))) (ref.i31 (i32.const 0)))) +)) ;; closures and continuations and other js values are ignored (br $loop))))) ;; clear the queue to avoid a memory leak diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat index 8e057b1f87..e84f181114 100644 --- a/runtime/wasm/io.wat +++ b/runtime/wasm/io.wat @@ -25,6 +25,31 @@ (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq)))) (import "jslib" "caml_list_of_js_array" (func $caml_list_of_js_array (param (ref eq)) (result (ref eq)))) +(@if wasi +(@then + (import "wasi_snapshot_preview1" "fd_close" + (func $fd_close (param i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_write" + (func $fd_write (param i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_read" + (func $fd_read (param i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_seek" + (func $fd_seek (param i32 i64 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_open" + (func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32) (result i32))) + (import "libc" "memory" (memory 2)) + (import "libc" "free" (func $free (param i32))) + (import "wasi_memory" "get_buffer" (func $get_buffer (result i32))) + (import "wasi_memory" "blit_memory_to_substring" + (func $blit_memory_to_substring (param i32 (ref $bytes) i32 i32))) + (import "wasi_memory" "blit_substring_to_memory" + (func $blit_substring_to_memory (param i32 (ref $bytes) i32 i32))) + (import "sys" "caml_handle_sys_error" + (func $caml_handle_sys_error (param (ref eq) i32))) + (import "fs" "caml_sys_resolve_path" + (func $caml_sys_resolve_path (param (ref eq)) (result i32 i32 i32))) +) +(@else (import "bindings" "open" (func $open (param anyref) (param i32) (param i32) (result i32))) (import "bindings" "close" (func $close (param i32))) @@ -69,10 +94,17 @@ (func $dv_get_ui8 (param externref i32) (result i32))) (import "bindings" "dv_set_i8" (func $dv_set_i8 (param externref i32 i32))) - (import "fail" "javascript_exception" - (tag $javascript_exception (param externref))) (import "sys" "caml_handle_sys_error" (func $caml_handle_sys_error (param externref))) + (import "fail" "javascript_exception" + (tag $javascript_exception (param externref))) + (import "bigarray" "caml_blit_dataview_to_bytes" + (func $caml_blit_dataview_to_bytes + (param (ref extern) i32 (ref $bytes) i32 i32))) + (import "bigarray" "caml_blit_bytes_to_dataview" + (func $caml_blit_bytes_to_dataview + (param (ref $bytes) i32 (ref extern) i32 i32))) +)) (import "custom" "custom_compare_id" (func $custom_compare_id (param (ref eq)) (param (ref eq)) (param i32) (result i32))) @@ -83,15 +115,134 @@ (func $caml_copy_int64 (param i64) (result (ref eq)))) (import "int64" "Int64_val" (func $Int64_val (param (ref eq)) (result i64))) - (import "bigarray" "caml_blit_dataview_to_bytes" - (func $caml_blit_dataview_to_bytes - (param (ref extern) i32 (ref $bytes) i32 i32))) - (import "bigarray" "caml_blit_bytes_to_dataview" - (func $caml_blit_bytes_to_dataview - (param (ref $bytes) i32 (ref extern) i32 i32))) (import "bigarray" "caml_ba_get_data" (func $caml_ba_get_data (param (ref eq)) (result (ref extern)))) +(@if wasi +(@then + (func $ta_new (param $sz i32) (result (ref extern)) + (extern.convert_any (array.new $bytes (i32.const 0) (local.get $sz)))) + + (func $ta_copy + (param $buf (ref extern)) + (param $dst i32) (param $src i32) (param $end i32) + (local $b (ref $bytes)) + (local.set $b + (ref.cast (ref $bytes) (any.convert_extern (local.get $buf)))) + (array.copy $bytes $bytes + (local.get $b) (local.get $dst) + (local.get $b) (local.get $src) + (i32.sub (local.get $end) (local.get $src)))) + + (func $caml_blit_bytes_to_dataview + (param $s (ref $bytes)) (param $i i32) (param $buf (ref extern)) + (param $j i32) (param $l i32) + (array.copy $bytes $bytes + (ref.cast (ref $bytes) (any.convert_extern (local.get $buf))) + (local.get $j) + (local.get $s) (local.get $i) + (local.get $l))) + + (func $caml_blit_dataview_to_bytes + (param $buf (ref extern)) (param $i i32) (param $s (ref $bytes)) + (param $j i32) (param $l i32) + (array.copy $bytes $bytes + (local.get $s) (local.get $j) + (ref.cast (ref $bytes) (any.convert_extern (local.get $buf))) + (local.get $i) + (local.get $l))) + + (func $dv_make) + + (func $dv_get_ui8 + (param $a (ref extern)) (param $i i32) (result i32) + (array.get_u $bytes + (ref.cast (ref $bytes) (any.convert_extern (local.get $a))) + (local.get $i))) + + (func $dv_set_i8 + (param $a (ref extern)) (param $i i32) (param $v i32) + (array.set $bytes + (ref.cast (ref $bytes) (any.convert_extern (local.get $a))) + (local.get $i) + (local.get $v))) + + (type $data + (struct + (field $array (ref array)) + (field $offset i32) + (field $len i32))) + + (func $ta_blit_from_buffer + (param $buf (ref extern)) (param $i i32) + (param $ta (ref extern)) (param $j i32) + (param $len i32) + (local $data (ref $data)) + (local.set $data + (ref.cast (ref $data) (any.convert_extern (local.get $ta)))) + (call $caml_blit_dataview_to_bytes + (local.get $buf) + (local.get $i) + (ref.cast (ref $bytes) (struct.get $data $array (local.get $data))) + (i32.add (struct.get $data $offset (local.get $data)) (local.get $j)) + (local.get $len))) + + (func $ta_blit_to_buffer + (param $ta (ref extern)) (param $i i32) + (param $buf (ref extern)) (param $j i32) + (param $len i32) + (local $data (ref $data)) + (local.set $data + (ref.cast (ref $data) (any.convert_extern (local.get $ta)))) + (call $caml_blit_bytes_to_dataview + (ref.cast (ref $bytes) (struct.get $data $array (local.get $data))) + (i32.add (struct.get $data $offset (local.get $data)) (local.get $i)) + (local.get $buf) + (local.get $j) + (local.get $len))) + + (global $caml_stdout + (mut (ref eq)) (ref.i31 (i32.const 0))) + + (func $register_channel (param $ch (ref eq)) + (if (i32.eq + (struct.get $channel $fd (ref.cast (ref $channel) (local.get $ch))) + (i32.const 1)) + (then + (global.set $caml_stdout (local.get $ch))))) + + (func $unregister_channel (param (ref eq))) + (func $map_new (result (ref extern)) + (extern.convert_any (ref.i31 (i32.const 0)))) + (func $map_get (param (ref extern)) (param i32) (result (ref $fd_offset)) + (struct.new $fd_offset (i64.const 0) (i32.const 0))) + (func $map_set (param (ref extern)) (param i32) (param (ref $fd_offset))) + (func $map_delete (param (ref extern)) (param i32)) + + (func $file_size (param $fd i32) (result i64) + (local $cur i64) (local $end i64) (local $buffer i32) (local $res i32) + (local.set $buffer (call $get_buffer)) + (block $error + (local.set $res + (call $fd_seek + (local.get $fd) (i64.const 0) (i32.const 1) (local.get $buffer))) + (br_if $error (local.get $res)) + (local.set $cur (i64.load (local.get $buffer))) + (local.set $res + (call $fd_seek + (local.get $fd) (i64.const 0) (i32.const 2) (local.get $buffer))) + (br_if $error (local.get $res)) + (local.set $end (i64.load (local.get $buffer))) + (local.set $res + (call $fd_seek + (local.get $fd) (local.get $cur) (i32.const 0) + (local.get $buffer))) + (br_if $error (local.get $res)) + (return (local.get $end))) + (call $caml_handle_sys_error (ref.i31 (i32.const 0)) (local.get $res)) + (i64.const 0)) +) +(@else (import "bindings" "map_new" (func $map_new (result (ref extern)))) (import "bindings" "map_get" (func $map_get @@ -120,6 +271,7 @@ (call $ta_subarray (local.get $ta) (local.get $i) (i32.add (local.get $i) (local.get $len))) (local.get $j))) +)) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) @@ -220,7 +372,24 @@ (global $IO_BUFFER_SIZE (export "IO_BUFFER_SIZE") i32 (i32.const 65536)) - (type $open_flags (array i8)) + (type $open_flags (array i16)) + +(@if wasi +(@then + ;; 1 O_RDONLY + ;; 2 O_WRONLY + ;; 0x10 O_CREAT + ;; 0x40 O_EXCL + ;; 0x80 O_TRUNC + ;; 0x100 O_APPEND + ;; 0x400 O_NONBLOCK + (global $sys_open_flags (ref $open_flags) + (array.new_fixed $open_flags 9 + (i32.const 1) (i32.const 2) (i32.const 0x102) (i32.const 0x10) + (i32.const 0x80) (i32.const 0x40) (i32.const 0) (i32.const 0) + (i32.const 0x400))) +) +(@else ;; 1 O_RDONLY ;; 2 O_WRONLY ;; 4 O_RDWR @@ -233,6 +402,7 @@ (array.new_fixed $open_flags 9 (i32.const 1) (i32.const 2) (i32.const 10) (i32.const 16) (i32.const 32) (i32.const 64) (i32.const 0) (i32.const 0) (i32.const 128))) +)) (func $convert_flag_list (export "convert_flag_list") (param $tbl (ref $open_flags)) (param $vflags (ref eq)) (result i32) @@ -254,6 +424,55 @@ (br $loop)))) (local.get $flags)) +(@if wasi +(@then + (func (export "caml_sys_open") + (param $vpath (ref eq)) (param $vflags (ref eq)) (param $perm (ref eq)) + (result (ref eq)) + (local $fd i32) (local $flags i32) (local $offset i64) + (local $path (tuple i32 i32 i32)) + (local $res i32) (local $buffer i32) + (local.set $path (call $caml_sys_resolve_path (local.get $vpath))) + (local.set $buffer (call $get_buffer)) + (local.set $flags + (call $convert_flag_list + (global.get $sys_open_flags) (local.get $vflags))) + (local.set $res + (call $path_open + (tuple.extract 3 0 (local.get $path)) + (i32.const 1) ;; symlink_follow + (tuple.extract 3 1 (local.get $path)) + (tuple.extract 3 2 (local.get $path)) + (i32.and (i32.shr_u (local.get $flags) (i32.const 4)) + (i32.const 0xF)) + (select (i64.const 0x860007c) (i64.const 0x820003e) + (i32.and (local.get $flags) (i32.const 2))) + (i64.const 0) + (i32.shr_u (local.get $flags) (i32.const 8)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $path))) + (if (local.get $res) + (then + (call $caml_handle_sys_error (local.get $vpath) (local.get $res)))) + (local.set $fd (i32.load (local.get $buffer))) + (if (i32.and (local.get $flags) (i32.const 0x100)) ;; O_APPEND + (then + ;; WASI's O_APPEND only affects writes; the fd position itself + ;; stays at 0, so [caml_ml_get_channel_offset] (which calls + ;; fd_seek/CUR) would return 0. Seek to EOF so [pos_out] is + ;; consistent with the bytes already in the file. + (local.set $res + (call $fd_seek + (local.get $fd) (i64.const 0) (i32.const 2) + (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (local.get $vpath) (local.get $res)))))) + (call $initialize_fd_offset (local.get $fd) (local.get $offset)) + (ref.i31 (local.get $fd))) +) +(@else (func (export "caml_sys_open") (param $path (ref eq)) (param $vflags (ref eq)) (param $perm (ref eq)) (result (ref eq)) @@ -275,9 +494,24 @@ (call $caml_handle_sys_error (pop externref)))) (call $initialize_fd_offset (local.get $fd) (local.get $offset)) (ref.i31 (local.get $fd))) +)) +(@if wasi +(@then (func (export "caml_sys_close") (param (ref eq)) (result (ref eq)) - (local $fd i32) + (local $fd i32) (local $res i32) + (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get 0)))) + (call $release_fd_offset (local.get $fd)) + (local.set $res (call $fd_close (local.get $fd))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (ref.i31 (i32.const 0))) +) +(@else + (func (export "caml_sys_close") (param (ref eq)) (result (ref eq)) + (local $fd i32) (local $res i32) (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get 0)))) (call $release_fd_offset (local.get $fd)) (try @@ -286,6 +520,7 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)))) (ref.i31 (i32.const 0))) +)) (func (export "caml_sys_io_buffer_size") (param (ref eq)) (result (ref eq)) (ref.i31 (global.get $IO_BUFFER_SIZE))) @@ -308,9 +543,34 @@ (local.get $f)) (ref.i31 (i32.const 0))) +(@if wasi +(@then + (func $push_channel (param $l (ref eq)) (param $ch (ref eq)) (result (ref eq)) + (local $c (ref $channel)) + (block $continue + (br_if $continue (i32.eqz (ref.test (ref $channel) (local.get $ch)))) + (local.set $c (ref.cast (ref $channel) (local.get $ch))) + (br_if $continue + (i32.eq (struct.get $channel $fd (local.get $c)) (i32.const -1))) + (local.set $l + (array.new_fixed $block 3 + (ref.i31 (i32.const 0)) (local.get $ch) (local.get $l)))) + (local.get $l)) +)) + +(@if wasi +(@then + (func (export "caml_ml_out_channels_list") + (param (ref eq)) (result (ref eq)) + (call $push_channel + (call $push_channel (ref.i31 (i32.const 0)) (global.get $caml_stdout)) + (global.get $caml_stderr))) +) +(@else (func (export "caml_ml_out_channels_list") (param (ref eq)) (result (ref eq)) (return_call $caml_list_of_js_array (call $wrap (call $channel_list)))) +)) (func (export "caml_ml_open_descriptor_in") (param $fd (ref eq)) (result (ref eq)) @@ -376,7 +636,7 @@ (func (export "caml_ml_close_channel") (param (ref eq)) (result (ref eq)) (local $ch (ref $channel)) - (local $fd i32) + (local $fd i32) (local $res i32) (local.set $ch (ref.cast (ref $channel) (local.get 0))) ;; output channels: any output will trigger a flush since the ;; buffer is non-empty (curr > 0) and full (curr = size) @@ -391,14 +651,56 @@ (struct.set $channel $fd (local.get $ch) (i32.const -1)) (call $unregister_channel (local.get $ch)) (call $release_fd_offset (local.get $fd)) +(@if wasi +(@then + (local.set $res (call $fd_close (local.get $fd))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) +) +(@else (try (do (call $close (local.get $fd))) (catch $javascript_exception ;; ignore exception - (drop (pop externref)))))) + (drop (pop externref)))) +)) + )) (ref.i31 (i32.const 0))) +(@if wasi +(@then + (func $read + (param $fd i32) (param $buf (ref extern)) (param $pos i32) (param $n i32) + (result i32) + (local $buffer i32) + (local $iovs i32) (local $iovs_len i32) (local $nread i32) + (local $s (ref $bytes)) (local $res i32) + (local.set $buffer (call $get_buffer)) + (local.set $nread (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (i32.store (local.get $iovs) (local.get $buffer)) + (i32.store offset=4 (local.get $iovs) (local.get $n)) + (local.set $iovs_len (i32.const 1)) + (local.set $res + (call $fd_read + (local.get $fd) (local.get $iovs) (local.get $iovs_len) + (local.get $nread))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (local.set $n (i32.load (local.get $nread))) + (local.set $s + (ref.cast (ref $bytes) (any.convert_extern (local.get $buf)))) + (call $blit_memory_to_substring + (local.get $buffer) (local.get $s) (local.get $pos) (local.get $n)) + (local.get $n)) +)) + (func $caml_do_read (param $ch (ref $channel)) (param $pos i32) (param $len i32) (result i32) (local $fd i32) @@ -406,6 +708,16 @@ (local $offset i64) (local $n i32) (local.set $fd (struct.get $channel $fd (local.get $ch))) +(@if wasi +(@then + (local.set $n + (call $read + (local.get $fd) + (struct.get $channel $buffer (local.get $ch)) + (local.get $pos) + (local.get $len))) +) +(@else (local.set $fd_offset (call $get_fd_offset (local.get $fd))) (local.set $offset (struct.get $fd_offset $offset (local.get $fd_offset))) (try @@ -432,8 +744,22 @@ (struct.set $fd_offset $offset (local.get $fd_offset) (i64.add (local.get $offset) (i64.extend_i32_u (local.get $n)))) +)) (local.get $n)) +(@if wasi +(@then + (func $caml_do_read_or_refill + (param $ch (ref $channel)) (param $pos i32) (param $len i32) (result i32) + (local $f (ref null eq)) + (local $str (ref $bytes)) + (local $str_len i32) + (local $n i32) + (local.set $f (struct.get $channel $refill (local.get $ch))) + (return_call $caml_do_read + (local.get $ch) (local.get $pos) (local.get $len))) +) +(@else (func $caml_do_read_or_refill (param $ch (ref $channel)) (param $pos i32) (param $len i32) (result i32) (local $f (ref null eq)) @@ -463,6 +789,7 @@ (struct.get $channel $buffer_view (local.get $ch)) (local.get $pos) (local.get $n)) (local.get $n)) +)) (func $caml_refill (param $ch (ref $channel)) (result i32) (local $n i32) @@ -683,6 +1010,26 @@ (i64.add (call $caml_ml_get_channel_offset (local.get $ch)) (i64.extend_i32_s (struct.get $channel $curr (local.get $ch)))))) +(@if wasi +(@then + (func $caml_seek_in + (param $ch (ref $channel)) (param $dest i64) (result (ref eq)) + (local $fd i32) (local $buffer i32) (local $res i32) + (local.set $fd (struct.get $channel $fd (local.get $ch))) + (local.set $buffer (call $get_buffer)) + ;; ZZZ store current offset in channel do avoid some syscalls? + (local.set $res + (call $fd_seek + (local.get $fd) (local.get $dest) (i32.const 0) (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (struct.set $channel $curr (local.get $ch) (i32.const 0)) + (struct.set $channel $max (local.get $ch) (i32.const 0)) + (ref.i31 (i32.const 0))) +) +(@else (func $caml_seek_in (param $ch (ref $channel)) (param $dest i64) (result (ref eq)) (local $fd i32) (local $offset i64) @@ -715,6 +1062,7 @@ (struct.set $channel $curr (local.get $ch) (i32.const 0)) (struct.set $channel $max (local.get $ch) (i32.const 0)))) (ref.i31 (i32.const 0))) +)) (func (export "caml_ml_seek_in") (param $ch (ref eq)) (param $dest (ref eq)) (result (ref eq)) @@ -731,8 +1079,26 @@ (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq)) (local $ch (ref $channel)) (local $fd_offset (ref $fd_offset)) (local $offset i64) + (local $buffer i32) (local $res i32) (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (call $caml_flush (local.get $ch)) +(@if wasi +(@then + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $fd_seek + (struct.get $channel $fd (local.get $ch)) + (i64.extend_i32_s + (i31.get_s (ref.cast (ref i31) (local.get $voffset)))) + (i32.const 0) + (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) +) +(@else + ;; ZZZ Check for error (local.set $fd_offset (call $get_fd_offset (struct.get $channel $fd (local.get $ch)))) (local.set $offset @@ -742,14 +1108,32 @@ (then (call $caml_raise_sys_error (@string "Invalid argument")))) (struct.set $fd_offset $offset (local.get $fd_offset) (local.get $offset)) (struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1)) +)) (ref.i31 (i32.const 0))) (func (export "caml_ml_seek_out_64") (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq)) (local $ch (ref $channel)) (local $fd_offset (ref $fd_offset)) (local $offset i64) + (local $buffer i32) (local $res i32) (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (call $caml_flush (local.get $ch)) +(@if wasi +(@then + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $fd_seek + (struct.get $channel $fd (local.get $ch)) + (call $Int64_val (local.get $voffset)) + (i32.const 0) + (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) +) +(@else + ;; ZZZ Check for error (local.set $fd_offset (call $get_fd_offset (struct.get $channel $fd (local.get $ch)))) (local.set $offset (call $Int64_val (local.get $voffset))) @@ -757,6 +1141,7 @@ (then (call $caml_raise_sys_error (@string "Invalid argument")))) (struct.set $fd_offset $offset (local.get $fd_offset) (local.get $offset)) (struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1)) +)) (ref.i31 (i32.const 0))) (func (export "caml_ml_input_scan_line") @@ -834,6 +1219,66 @@ (then (call $caml_flush (local.get $ch)))) (ref.i31 (i32.const 0))) +(@if wasi +(@then + (func $write + (param $fd i32) (param $buf (ref extern)) (param $pos i32) (param $n i32) + (result i32) + (local $buffer i32) + (local $iovs i32) (local $iovs_len i32) (local $nwritten i32) + (local $s (ref $bytes)) (local $res i32) + (local.set $buffer (call $get_buffer)) + (local.set $nwritten (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (i32.store (local.get $iovs) (local.get $buffer)) + (i32.store offset=4 (local.get $iovs) (local.get $n)) + (local.set $iovs_len (i32.const 1)) + (local.set $s + (ref.cast (ref $bytes) (any.convert_extern (local.get $buf)))) + (call $blit_substring_to_memory + (local.get $buffer) (local.get $s) (local.get $pos) (local.get $n)) + (local.set $res + (call $fd_write + (local.get $fd) (local.get $iovs) (local.get $iovs_len) + (local.get $nwritten))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (i32.load (local.get $nwritten))) +)) + +(@if wasi +(@then + (func $caml_flush_partial (param $ch (ref $channel)) (result i32) + (local $towrite i32) (local $written i32) (local $fd i32) + (local $fd_offset (ref $fd_offset)) + (local $offset i64) (local $buf (ref extern)) + (local $tmp (ref $bytes)) + (local.set $towrite (struct.get $channel $curr (local.get $ch))) + (if (i32.gt_u (local.get $towrite) (i32.const 0)) + (then + (local.set $buf (struct.get $channel $buffer (local.get $ch))) + (local.set $fd (struct.get $channel $fd (local.get $ch))) + (local.set $written + (call $write + (local.get $fd) + (local.get $buf) + (i32.const 0) + (local.get $towrite))) + (if (i32.gt_u (local.get $towrite) (local.get $written)) + (then + (call $ta_copy (local.get $buf) + (i32.const 0) (local.get $written) + (local.get $towrite)))) + (local.set $towrite + (i32.sub (local.get $towrite) (local.get $written))) + (struct.set $channel $curr (local.get $ch) + (local.get $towrite)))) + (i32.eqz (local.get $towrite))) +) +(@else (func $caml_flush_partial (param $ch (ref $channel)) (result i32) (local $towrite i32) (local $written i32) (local $fd i32) (local $fd_offset (ref $fd_offset)) @@ -901,6 +1346,7 @@ (struct.set $channel $curr (local.get $ch) (i32.const 0)) (local.set $towrite (i32.const 0)))))) (i32.eqz (local.get $towrite))) +)) (func $caml_putblock (param $ch (ref $channel)) (param $s (ref $bytes)) (param $pos i32) @@ -1063,12 +1509,31 @@ (struct.set $channel $fd (ref.cast (ref $channel) (local.get 0)) (local.get 1))) +(@if wasi +(@then + (func $caml_ml_get_channel_offset (export "caml_ml_get_channel_offset") + (param $ch (ref eq)) (result i64) + (local $fd i32) (local $buffer i32) (local $res i32) + (local.set $fd + (struct.get $channel $fd (ref.cast (ref $channel) (local.get $ch)))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $fd_seek + (local.get $fd) (i64.const 0) (i32.const 1) (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (i64.load (local.get $buffer))) +) +(@else (func $caml_ml_get_channel_offset (export "caml_ml_get_channel_offset") (param $ch (ref eq)) (result i64) (struct.get $fd_offset $offset (call $get_fd_offset (struct.get $channel $fd (ref.cast (ref $channel) (local.get $ch)))))) +)) (func (export "caml_ml_output_bigarray") (param $ch (ref eq)) (param $a (ref eq)) (param $vpos (ref eq)) diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat index 96659c52ec..75716c5f7f 100644 --- a/runtime/wasm/jslib.wat +++ b/runtime/wasm/jslib.wat @@ -16,6 +16,10 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module + (type $bytes (array (mut i8))) + +(@if (not wasi) +(@then (import "bindings" "identity" (func $to_float (param anyref) (result f64))) (import "bindings" "identity" (func $from_float (param f64) (result anyref))) (import "bindings" "identity" (func $to_bool (param anyref) (result i32))) @@ -104,7 +108,6 @@ (type $block (array (mut (ref eq)))) (type $float (struct (field f64))) (type $float_array (array (mut f64))) - (type $bytes (array (mut i8))) (type $js (struct (field anyref))) (func $wrap (export "wrap") (param anyref) (result (ref eq)) @@ -681,6 +684,7 @@ (return (array.get $block (local.get $exn) (i32.const 2))))))) (call $wrap (ref.null any))) +)) (func (export "caml_exn_with_js_backtrace") (param $exn (ref eq)) (param (ref eq)) (result (ref eq)) diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat index 5f3c4c14e0..ec69833df0 100644 --- a/runtime/wasm/jslib_js_of_ocaml.wat +++ b/runtime/wasm/jslib_js_of_ocaml.wat @@ -16,6 +16,8 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module +(@if (not wasi) +(@then (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq)))) (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref))) (import "jslib" "caml_js_global" @@ -56,4 +58,5 @@ (call $caml_js_global (ref.i31 (i32.const 0))) (global.get $XMLHttpRequest)) (array.new_fixed $block 1 (ref.i31 (i32.const 0))))) +)) ) diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat index 2b3ca0e3bc..821614063e 100644 --- a/runtime/wasm/jsstring.wat +++ b/runtime/wasm/jsstring.wat @@ -16,6 +16,8 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module +(@if (not wasi) +(@then (import "wasm:js-string" "compare" (func $compare_strings (param externref externref) (result i32))) (import "wasm:js-string" "test" @@ -290,4 +292,5 @@ (local.set $s (array.new $bytes (i32.const 0) (local.get $len))) (call $read_from_buffer (local.get $s) (i32.const 0) (local.get $len)) (global.set $stack (struct.new $stack (local.get $s) (global.get $stack)))) +)) ) diff --git a/runtime/wasm/libc.c b/runtime/wasm/libc.c new file mode 100644 index 0000000000..3b0c44bd04 --- /dev/null +++ b/runtime/wasm/libc.c @@ -0,0 +1,175 @@ +/* +Primitives implemented by the WASI libc. Use 'dune build @recompile-libc' +to update libc.wasm. + +clang -O2 --target=wasm32-wasi --sysroot=/path/to/wasi-libc/sysroot -nodefaultlibs -lc libc.c -o libc.wasm +*/ + +#include +#include +#include +#include +#include + +__attribute__((export_name("cos"))) +double libc_cos (double x) { + return cos(x); +} + +__attribute__((export_name("sin"))) +double libc_sin (double x) { + return sin(x); +} + +__attribute__((export_name("tan"))) +double libc_tan (double x) { + return tan(x); +} + +__attribute__((export_name("acos"))) +double libc_acos (double x) { + return acos(x); +} + +__attribute__((export_name("asin"))) +double libc_asin (double x) { + return asin(x); +} + +__attribute__((export_name("atan"))) +double libc_atan (double x) { + return atan(x); +} + +__attribute__((export_name("cosh"))) +double libc_cosh (double x) { + return cosh(x); +} + +__attribute__((export_name("sinh"))) +double libc_sinh (double x) { + return sinh(x); +} + +__attribute__((export_name("tanh"))) +double libc_tanh (double x) { + return tanh(x); +} + +__attribute__((export_name("acosh"))) +double libc_acosh (double x) { + return acosh(x); +} + +__attribute__((export_name("asinh"))) +double libc_asinh (double x) { + return asinh(x); +} + +__attribute__((export_name("atanh"))) +double libc_atanh (double x) { + return atanh(x); +} + +__attribute__((export_name("cbrt"))) +double libc_cbrt (double x) { + return cbrt(x); +} + +__attribute__((export_name("exp"))) +double libc_exp (double x) { + return exp(x); +} + +__attribute__((export_name("expm1"))) +double libc_expm1 (double x) { + return expm1(x); +} + +__attribute__((export_name("log"))) +double libc_log (double x) { + return log(x); +} + +__attribute__((export_name("log1p"))) +double libc_log1p (double x) { + return log1p(x); +} + +__attribute__((export_name("log2"))) +double libc_log2 (double x) { + return log2(x); +} + +__attribute__((export_name("log10"))) +double libc_log10 (double x) { + return log10(x); +} + +__attribute__((export_name("atan2"))) +double libc_atan2 (double x, double y) { + return atan2(x, y); +} + +__attribute__((export_name("hypot"))) +double libc_hypot (double x, double y) { + return hypot(x, y); +} + +__attribute__((export_name("pow"))) +double libc_pow (double x, double y) { + return pow(x, y); +} + +__attribute__((export_name("fmod"))) +double libc_fmod (double x, double y) { + return fmod(x, y); +} + +__attribute__((export_name("strtod"))) +double libc_strtod (const char * buf, char ** end) { + return strtod(buf, end); +} + +__attribute__((export_name("format_float"))) +int format_float (char * buf, size_t len, const char * fmt, double f) { + return snprintf(buf, len, fmt, f); +} + +__attribute__((export_name("malloc"))) +void * libc_malloc (size_t len) { + return malloc(len); +} + +__attribute__((export_name("free"))) +void libc_free (void * ptr) { + return free(ptr); +} + +__attribute__((export_name("strlen"))) +size_t libc_strlen (const char * s) { + return strlen(s); +} + + +__attribute__((export_name("gmtime"))) +struct tm * libc_gmtime (const time_t * timep) { + return gmtime(timep); +} + +__attribute__((export_name("localtime"))) +struct tm * libc_localtime (const time_t * timep) { + return localtime(timep); +} + +__attribute__((export_name("mktime"))) +time_t libc_mktime(struct tm *tm) { + return mktime(tm); +} + +__attribute__((import_module("OCaml"), import_name("_initialize"))) +void start(void); + +int main () { + start(); +} diff --git a/runtime/wasm/libc.wasm b/runtime/wasm/libc.wasm new file mode 100644 index 0000000000000000000000000000000000000000..5e3f34061dd970da900036fecb03ad0ee8e5a69f GIT binary patch literal 63480 zcmeF4d4OD1o$t@Rx2mhEt2^DeRCa;x+jJ7b4zfAUJkul%Np~lmUJ`y><45S!9e} zt>e`og;Rs;Z0Qu0Y=uf{t!=|B@~KNhu6{(9@YLH|=;I(_PK?aRCK?^?EE z*}$^)?q%=pFf~&yZ0}$8uKpG6EBlxB47_V)U&rcY9T&bid;XGlE$;5=?=b#rl*mw` zzoVneeT@>eeeElj^elhZ1sww>9~^#IO&$2LKSAXosQ1SOzLI{1 zT))B3WclzK)9Gy5_fq30q|)9>#+D8|CMZT$dSN}kJ z-+)O6i+lRbgrI-f3bSu8(7wXVNwq60lL8AXOg`1F%=#30OU=X-c}vZHDe{(@gVHLw z)MV2ty42LARd%UqOf5c-rpE^zYgU>`Y5p#MvzZcf_grB1PV@K8D@`HA=UYtCCg+;a z)_jX;NH4u;WzT@wGg#Skq1h*O{_>tBW?D`EK;Hll``4Y{)3>~R;9ci;_p}d~nwsV9 z-Q7Kl&6`r^_jPob87kM^vBJ!%xnTLgvgIA7DaY&fZu`7f&GIh$Ff&){naInh<{ozV z5q17mUhT`@^$#oiUN9JyKJLx(O{&G@^%!}F`Q}X~YV0bSnI<$*U1yYPOclJSbRGZS zch{%i9hzBwUFbzScLu#pl%`N)=S&-`Q#o z57gvCqmNrFk9v701@*awPXYe453s8IwBK2*;d8s!SyT&KNM{@0Ot;X@R%s*`_^0u) zjnAVsvcvq)!nuK3z<&e@K4!U(nUrK~C-Kq9Yr3fc7c^P`KbBQev;4VY71uH?ssn1z z@@E!6lK>5)K}I?V^1{>{(-?)lO%~Is$l)eWrR_ef8Ky0VhMD|>=!dmd5v~o*-9^7O zykawqymM!!w-`i2LtA$Sr>0ukO#IU}ZBE;nFBftxq2FrW(G>cd!?;ve-@JNnMx`LY zo8e8M-d{@z+IuB9nRZNhO;qk;dAJ}8Rqk^qGy0PwPE^Qha zW)u~mOLcx;<9>VfK+I_I_-T9dNYPwxM_~u#hV{3PByQ}l97%%ZyGo^DnAT`870@+G zH);#KgIIt6A444qk0Su$-Q7CG&&tcnf*rDWj9^oVKXxqne7@iFVE(&X4-x-1^cGRa z890t1xPk2`+oDv~xJsq#OO3gPJhF97))phLQc@)vy;cd&^^cc+)_e}VdlqaUf2ln94;4Auv9k)S_WINe zb(m1Vm`#GKb#Dej#jj)*Y7{n0DA@M&tuNA6y%$4kjJVQuOV7XGY0lN;Ay|{~G?$9L zAd_hS;7j|UyP`>}K~ERm`boF2yOK$ra%niML2k=KsS^?NO_knU?#9%~O$GFq9c{y9 zHnX`m`qVuecLtrew1$_jFORlVFn8pOYI(cGn-n$@A*LQqZ0YlA3uKWwby=2a&DWTT-zDPes97r@1@+c!6R2M zng5{5z2l?Bt7b0znjSxDRl^HBmZ;^otv>pqLw|AP|2bwPOqEJudbm`|=buOg>9s!A zp(t9Dkns1-7u(_Py#8MA+}&|jJb+S!3M+-)uv9?8M%&9H#Z-xL+0l#?eLFafvhAz$ zo>(>Uj4zZ0&3m`q`uj^SxuY2zwe4KG<+z_*`^EA|+gF}CVAlHHyP8W5R1cK*4x!ikza9mM+kw*wkC_Sa3D1=Py*1rMU7qT7FX zmotVE5`oMB^1CT$bbcMi>WRttVsrJ(<%d366~vXOmz0;)!wWm5`KUs`Ee#JRM#qcH zGDWkIGHL9Nrh-9W^7&1kj5e4lG}i)Li#RH%%zS=yZ5Ep?^s48of+sWBkA~bUU`WIm z5QXT3-eBHR2%IC zz$m36@@g({zikJ1cOKaG`4N=M#y>xM#++wwDKjlC-#BpVueRK-$KEM#dgaT#cj@u| zpIjp)&LfQICoQ0H#(%r`+)=k|0EnN|ubz40dp^@l>C=zdRyx1_Ha)HgPkP|1^X|~& z&dbb4G(+%MpJ@M)f>(uFL5Z$H`wutdqhO%OispGEJ(=WFc$>=^Ms=gR#gVA#Q5q=Jt#t<6_# z?kfa-3%a{%F_NN|>iGP!dhol(`Nj(pLCdu?R35k5CN<-+hVet&(=Lp~^2NfEnQ!?< zU}YAdC<8{1h-m0E;&g6ifh{}~c7~}_HLhLSVvelLiAD?wlTy~#(nbv6ZMqgQC>Q~5 zLHD}G1;+DJyxcenbqieT7DB^!m7qg)GVU?ARp_)ZmMn};9lSeU!NtnJO)!2%9R$&z ztsxvl-$Rlu6G>xv)gq4}u&E>kkyw>G&@hO?(}=6bl-EfhH{b>@J}P_D&sVdE&b#XSA6NkKi+gVD&@A%-~Fkd7mlU$ zEoWRebn3c~dX8DjirGO{ z5*xF4CJK7-?TiaNKQI-g$oQ&;mKrXmM~9Xk4pYM#zkXkLXws*);OmbHtu}%QR);DU z+RR2Fc%j7-)*X!`_=UGgsol1<-+25Vj{4RM$DmuUoBe?wzVHtq$aZ(}E4Q8V+@24D z@^7@?1M&|L%5QwBas2r4mxy~j;V~F44R0K4+x$Np_C_nx|9#`eWVe2${H>nnEZu91 zsPuSE{Llw~-ORdalhNJ8YjoEwhkuqH&1zItW3^7YmJq4Ea+P_7o{pn zv?h8u(-k#qDPB{^s8QvRtU!upu8H2Cm93OY^wkmCn8R6iFFjy(F zquJ?M=_^^&aj_lEi&HF?Dk-h(D1cTfRpmPJ}nK2F5q-719;YL&4Rw&XKZ~Mfk@nZ||;tYuO*G*t9vm_&sDZ z_GdfV^+wp?+9VwCR ze_l(-$Q05tW)f=1O^9m-O`QC;&ABhP;*LLm;7cQIN1pM+%fIsYHcc^ieCM;Dn*P`% zDa!Yr^$I%kAKBpR+Je7>qFWB}>9-E%Z#zCRxF0cujzi!E|U1 zCE2dS@R#OCEr;|A&b?0TEZ@^gfp>B10G>RRWlbdm+E%s*tE9I#my#-GtH|kagJ8wg z0of9HX9iQ`kju+VgX!og`OVVK^jR`2p+a2nOT^PJ5sTPyLB zN+V(T+Tq#hTrL^>sw8s)pobY;Qg5iX z3RS>38yxzDfZP&~7px`^?BuZ0;uI=BPkXpxZUGbsp#bJ$DWIgUthsP^` zb$vPi)4Z3lbC%s^jIv#*N)x5JwDsskYkG^OvycWZw%mFdtjB6g3JdR}EkW_<^LE$M zd5gTxg7HC>-xA$vv%^4JmK3f7Dm?3+mc=lGHY-yL>iy^jHcI(VYZ0r!C|G@AuXf(h z8I+kOE~qq-#dP%91tg2@uWTLbAj(WCdZ|H1HK~)a&GH+I-n@Fi!<=9R0P0eZ-D3qg zsgwD}x8)g#&wH1qf+dnR#f;3owB1jYB^oTCr8H2j1Ey4T^T$2y#W8!i4`Isd1NbZ(0S3~KTw@WB5V4-N@xA!>{! zg*A+e8ci$?)xQr3)MbtK3Eh}2R>4YRXmK9;^tD-OEOp=;syW_Di#=^47H<{aa(v);D{Xm;LYB9r zt^YdSf}9m*3M-=<#Uac$hHdEaRcs^t{bg*E-aXs6;k=q{$Y<2MVVm6mTt#$Kkq)S3 zVmUWZEqe6hC zNWo2eqfO|A3BbD9qJ2qaS6@){x>lp8U>9$oD>}AQGKlGSn7@Zyi-#i}ejn1EKKClvxO;|Mpv0aD#{8r6HTWHZ*^BB6|(n&rUAW$f1Ro+0(;7`>U@kh zKiYG(bPT{q`Gu({)!Pa06jh;^LhIPZJvEM-hbg5pepp(=kFu&5WjhNQikise3+a$q z%qjti2TF%}4mp-U1RI#>e#DCZ^rC4<`}#)FCHeeeNG|4gbk`@m#y!TyIz$GvKK}_X zx=Tf)XFlNxVYX=gTY;Y&4Ax;?)}YNy>m|SY?T(#~Z+pqGt@Zv7TsgG;*?(SlCMw0W z4*kb39|$fk@~|mASj@K$efQnCn%9!i{Jt>1mYmyun;k6Hw?6)X3)d;5PA}@$wr-&L zX;Bc?$=OF4G+kIHPZ7zRKk2Uki(7u1?b7qYreY>~@&^}phXhaf(HHW|d3nnx{VpDP zmxaPOAD%beowS#Y9vO%W{>)dw&*!_MpQ(*p=gn*3qjZ>yJ{q@WiM97Bn(blj+nPEH zwS2<9Y{y_@L6q794N*s@*f}?dawitkw`dI4i4!ljlkG|&0#*uh^RPwe-z?~Z>ThE} z(dYaw`}cTIya$Eyt-;#X%q7LV2A$E6^BS_Wy0}GADUtwV9iW@iDqv!qY}jLkoEuyZ~ zQt9q6xckgvuBnI>D2tDs%$*Hqu%zN$m}`<2)=CYIaeh}yWGPYEx!WApZ0?HgF<_Dk z0Y)loyi8(??D(FMeW*pJe&$ZXH(0Tvlu9hBEnSG*s3}`9`hN7Lv*lDu8rafR-GEX_ z19K(JW#_8_QXpV`I_pv3$ZM+mvD`NC`UF`5Nz0SC2Sxg8(8D1jvkOj zl}QXx;sMUaKD%U1AxCB?63d|%oB{2!n`PqIB+hk!jC&)bfH~}u3#pROz`AHve{~PyJ0RgqB_16ptU|Qfe?u`{0q#bsSR|R;aco9y1 z&m-TVMZbjoEdtkQ(O;=!6f}Tnh}L!$Y8@SL#p^{0s40H`!YBbIwqbFGbxp*eh3U4# zX8&^huU~nG-Re!1+P-ni#;+W4)qfl#|7poB$sD0``Il0b(1e@X-Crj}J3jWAB&6W_ zkF9@oNWmyZd|?DX5bJ#z_MzOw;NtheQP1Qae3liha|is01$8l{AOnk*8Wue&cK*-* zVb;O7Z>8ALM;y5M`S;&TF|to++HvL+>+dJ~6PuUZ)javZvfa$)&0#;ff3MZ;U*XLQ zSFZkU?!m`gh3DV7ip@QuPpbu;pdgZ`BM5qLn~qPVO?p#!Y; zP&7gA4Mh_em?>WOD4w9+pMj1ijvx*u5bMXgOb9YK*(9q!VX9rD2{ICixHUx+WLpm+ zbN~h=av&F7bFAI$%GwYE9Bg#7!DVGa$&3B50R+7GvUP?HQ|6lZk%jXpt%6ZpI9kNy z5=j8>pg&Cg{yygkw|9Ny|IE7G;Z{^S{-hwr?#lS@c6vTqZ}M z;*q3sZy0^t!XruL-aPtvCyykR`}xtwtvr%c?p>pg5AjG+x%ZDgZsU=pa-Zh$QTND4 zlDnP9CtWTdNr4~p_>9ZtBPpJl$| zU@MQGce#8d1s>w@E|<$kQeYd8_q$v^k^+y8=H3N!-FaQQ$im(&w>LQUy6d`h^e^u5 z(Vdy-2)*7)*$>$maZ>n~{XI?II)PK zZfM)$kNhS|Dh`@{1I$yg|!fQkIj3;+h@yZUI_4D>D)q!p-m|DQnR zUD#XHN=Yj?G@OG=jvASV3_OO#HmC@4oPtGZBfafp-o*82i)3Z`jIL>8p9XG6MVNTJ z(yF$mvZ}>*NHt7G_3Ku(tOlJ;&qr3~iBirxk>E(J+7+H%Q40)^lB`nma=zu4CW}}R zfd#u=a%Q?%rlbod0AIqWoE5;!lU>g{5aN>HT-HFauxOg71+7>ivJ~Spdfi^(?*#)@?bM!44VLj@)KA3uAC!A$p&0ofDSm*;zm`(w=xX-!8eLBHrf;j9FInVI!g{fiyBnJGc4ZBZl zk)6VLVTHuvKVI+KzUDW9=2R2iz)b_-TBDYj`0}mO44#QFCx)hVm^_Q?Rfsgz#I`{c za{hr=P?-RQ<8xtwE=5#FPvoJgf?mjDpe?A+TVE$aApcH~xZW~d8WOHi=Mv)~ra4d9 z;#iv3Q`ypxM&(mYD+vh&s(h+AD1a@^N;;;w>v)vrHXYMEScg0{Mvtg|_Woq*o@6lAEO(dRdM1rOq~Hc%5ek%T6|Zf96?V!Z@F z{3369zFC9EDJH8>h3$R_?uw`pHO~BkfcW@ALd-*u*VT(Jp1q+kb25tb6|G=T?5oG+ zLa!BoQ#v{0oeaP=3;XKXA4oMG%s4plM0UZK0HR&HBsfVM@T3Y^H3J(9Qnno6kHPu% z0b2|jbY0$khptK{R%@9~WQzq5b zc<>ByBJI&#-Ws}~6FfxLr6^4wH-VV2+zooQ6ptELw=ky)IAse{&Gy5bstm@41B1!G z^W=K^k(udmL)X?BFC&ybLId0C*)lkaFEQPNDjGVJz}G@bG2JP5C6A7JTElHI*L5I|B#Qce68zIJYlnNTemJQ_f~&oKg&sopNxH5vFVbmEG~0Sr>Ipo5SVXK`k&eI;dB zjXZ}nJFILxEVeTpu(X(t4#(dPraPl%1};=#Td+zo(VKQZ@T|z8f!paAwb>c{bfdSw zFINNVJ-Tif-3x=H6ws=HZFQ)kWfbam*Hr^8IAmFtlF9_ z?WQ``ufJRC7eYX!s!g!UR&>GmkT9{V6=C7UTVNWEP>Rtlb`wNyN}CQwoQdo?6B&qM z7iacqMQDvuW@RQ6?SH{dvUfGEbh7`Y4e(-Gn6%qmd^sH z_Bt#U>`>TNq0lrif$q z{Gx`f4i>;EJ{0$n(vGxv#VHLbXhm^ACKe7(y%ShvgJfzd3d4*l3}lIdV-*I>XcdMP zP>BqyJSQqvhP8PPNZLFH){5fL5lyE!YET@kT6VK+X56o-I1;6Srjyc0#~$^H(qQ(p zP&vt_9o`5O$*|a^hQ;>oH3>u%4-}!C)g?9aHAzaBfK;bT!b_M5)S>pg6>Q?iV`m`Y@nkz-Un5U@9 zZa2;*%|=X_46+iv1*dFCc#&;8{V}#cs`DSvg~H>D5$WTJ;@)R zCfOH&UW46ir9FtM8iH8fWTLs4X=Is0{7E(n6`k2wOht9FVEI^H3?gDiWbbih z3w^L=JYHwk(S_08t2%EEGiwWWThPC_^$NTD%CR&r8v4=thHi@7&xG%<<{{{vM?g|U zC=8(}Lr>lMT&DA8;VaYnywS1b4Z&bB*ScdZL91)oS8RUY<}kOJ*#fIEs|GiKJ+NaV zKIF?~nghqQKmjj$$WwR)bH6W-Pf!qaH~U@MnD=esAy4rW?ocyClrGwW(V7r zd*?d~4N&t1=D1c3g1FIWS~tq;`^3;#o2u((1@x?2+dA~wf4?tSo5w@z+rWicp)XMl zQA?l`(+LDJ^KNaj`vZZ-4hQI35j0NZozQeM+t^y~cuAA0mu=m!$2wjd;-^}VUbl8_ zk>+jq0|P|STFV`JMY9w{GpnxqW$iY{F#S6Ub- z$T-#N#fScP?(8Afqs`c#9nIJ_snbAPygB?*^XYxq%5Z22wRefjT^Wb>R!XfrSIe#$ zqt$lUjqSKmLv3vm2e8VRB4_qD+2tkx?E(%Rnh}{us zFo$WoM;;fZTyY#cq&9|8b!?#Hy%P$03-#eR+K46$6vly_B$j07PIH+oA7PETtI{q2 zfX>XqQJ@_ zs|RYUt{$k5?sSz)MJ*%=<|~Kk;gMn;4G@4)g7>v+mKiREb+}r`G)c@vZPhga_0iV2 zDH>wpu{-x7N=WDF5n4%8|GwsZKRDa$Aa3BrdB=a^oeO{EVlv)+!~PuKd7(VgcFI}r z;HWU?#cgm$jb&3Ec35N&yS<>`j#4oTcs5i)=u0!anDa$+5aP}_)hE#IsNCVv9FA*( zH6CIeMi@rD&N-pRpjwP7Gn70Sl@y0jFwWbtGkF-~r3@-B%ngSOjTIKWS7NA)8rCm` zHE}4*1uY|Sr6V};M2wOB(TOKhb>d0gCnuh2h>H;MY$VVK82ihPJf%?%l_O6LyB>LJ zs2q6;!g05(wa1?Pupa3ls3m4Jd+e#gfvDyk%T#w>0U*Rg>Ca$}T+#7q(VmbStjS2m`-DIJbEAti#uU;u>FMmnGWetMTf ztu4|6RmZVM54B<^5G+!;Xu^gjjR1xH9pP#B2P%2p_BsbDM=B>Z#nUCbtLb{%nH(%0 zcA3b^UvVnv+5`%Ex8!pdwU zmO_(h8uuzgE^QhfasFZ}6IJ=85i5P6Po390q&gCZ6yD(xhVQosPOM8zKDjIA7-P*r z8@BJs=B;|cg2)g&yqnBmcbV2?)@GKh&U9DoKTX?>e*C96(S|Nv&#b7Wl;4HhA{x5n z()Fx6?FTMZyRS{$b5UTCl)^V%`OUL~hQZWYYrOABIqThzwwq3D&j15a3o0y8ec)SB z=D9iv8L|PV#e)4fGsJq<-~;~i%aNhb9{ymFVk51w@99)lvEO(=o;5(OE0VjH*J0PV zafSoF@sAg9eS}7FruvXmN2jz1T!^4@GzSaHzD=?6Rv|gVaI(jpr09h5Qk{(l*ou)? z$m44m{iTt2^+peyu5mRc#gCVgD?%N;szrs=vGi1%=@|41OmdLX&SQpSdanMN?kJTT zu_9dDm@O0z95);pfU5dsy9bcA;Hm|<2ZuI8N-&4V*!n)xRhVC3PNVaMaO~X}9>wKfVQbv;IYmqjED zAHC;9E6S-Ti1TWy@=|dgJ3J|!?M+d`jz4bFvkkH`%F|vx%zy4UV}=H=`j5hR%I*UYR8) zGrWro)PRdv!M!wC82>6v()Ez7>9(iAh! z@>do`gjf?A7WQ}CXlDS8;tU9pJIfx%&)*TI?i`8Vv~Eo4ZV265d_RO&r8egU`Nbgj zc-bGGlG4wu=77-H(#HO9??v1(Pp)(ha_6F~s9sHIxx))6un;SW%d%41&$D~L0c2;M zggQh;INg>bN-(FBi$q^iTJB2d-W3-gy7!w0yBfIFR0B)fZcQi>51pIQ+*cdrPC+il zpVbHNP3Bt36QC>^xzm9QR0wYt8<;MWTeG@AwUQfg8!{f*foO~MO5U-Ff!Si?-@z+~ zaeUAhcXQ!#=jtZfb+{#uNK3$dln}x7lK)Zx(a=>tc?Ql3$5nw{tXp1apa8B> z$y@a*UGKz|lpE?yzJ{ExG3)6ng`kt-s_F7=|FAHC}jhJYmB)`urjg`CxMA{!emq%Z@i$)uW((BnKe zozPSq7uM>WEI?@zvy=$Ot%g_e*$qU4{e^mQYUs=$3u}?P3@omQjupfi%7ZHxa-V<- z9nxrP%e71t6|Uu3&cFIz@v0QC!x~Zgj1(%NXaOb6VX=c!h`=U*4e-q&TZp}b!0IB{ zRQnYU#Q>mv`e?{oNV6Jdq2A%#UK|6S?GB*Bu6BytlWvHppJ&HW!JvENR#o-rfA||K zFsI(@HCfb#Q7 zYBaJ-OLvw~ZADJlPVifzLs6=*K0bV>6>}ZZ&grU0{ z4-6;VSezJ62q%obIn=&roL(G1Tq;a(fX1LH3Z%lGR(FWl;QQe({M<%3q~ooeGt=xMM8Nxnh_8mqkian);K#!B66j zZ8`4zB8JBV1~J$#vuFYH7g#>Nx6(hI_0B_jYIV8xBbk#Fi(Q$=)q73jfgl1lsSE2s zptXxkoxv35)Xy8VzM*MsVzRejtt}J|Hr>UADSt^5Rc59vwowKtOhCp{v91qvVGPKU z@o9}P6pjr3q7KuCeK4GsUg;BwEDvj?j8Hk)uHodu6wx~!ebaOy!9jH73G7AD(BxJf zXhwOn^g(7dMUq!9FIxJJ3NvoOAv$4{>fsstjwS;LagI7C% zvh`of$dnsotgU~LL^Bf`lDk-dFuHRL=)4L>ZR`_BaAss>$gs0x(fC@iXD)8dTvnWV z8ZFuhAvM6{GZivnqUx?8DGa1l>x0(Jnao-70uWqb)Na#CZZ`&P;{a8#RpdYU+8Y;C z!*cELpb?x?SZ?iIO#BJHWE2!Gd!WbLg|FEj@vD(0L2=D74F%g;%GJ+GHEQfa z107-vU5u6iiCs5yw;2tk3H!i6#I8;nSMNn$xgL1Kt-$=TxH-yzbOl6%b1(l2cedF} zvYmCvUygfKP;3{=6vKM3L!RSY+(s^LKbmbX6gJjZ@y65V!qC8`MZ^6=`0@NxgHOHs%HIfmRzmJcfX?RDDP=5*(Q^= zo_u$CVC4ZXbJ_2Un|HjW;m!#vy0r1bGk(ACTs=;{Z2Kz@edioKesukc7oXerQa!#B z-QM)?!~e=72^0TRKbDGK2{PntjF257SKr1Z*%w9}G?tMHfw|#v({M>+EDgJB*KH)3 z+x8Y}xw%}kBn5_DCOp-6WSG{K%os@1pFUQM&k5bO91>^QX6W6l
^(YLfzktP5f=D)uuY1Cx=+xEAUCiI9X@CX>O#1IZ5MXqzs_zsq! zqeKXUYV5OP9@cPglBOf}2@<*4Q6_eZYC+W{AR^;v(uCYpIs!^e!W57d2m)9^rm~#_ zO#YjmukYgWTjCvP-^#(3KR>^tSywH&fZ-M{^ zc*k^{Qrpw^9HiZ$)?rEZq|Ncx35uPOoSBSGFr9jh25r&Cfd-aHpY^=7)#GhNx##3E z(Bw!EZem;%IoYcS{Tj{})qpLWPhriUYK`SYst}{^ToVwAs%+KhG6Cj1$Hsii5$;b_ zgAuB$u^Vn34{=$av!Z1#qw)trNhpi;vWRt-l44$Sa+S!GlLV%78K7iJ8;k7|2PfM6!Kd7qb_CLa)3$}w+h%D zmV9v>k^tw+RZNBYXlScpAYj~8wMUo6fdcH497c!;W@9U8HYKOyIA=K#lPPx{_7nn) zb6Ti(Y;qzhoR$S~LCmYz3{V}nh>^m1l=@n^w(Ot=Rn}3>c4@5`?bZR1>RF0<)_W0} z`fNA@;bu4!>vThdJf|s6(U9di&A~Z=&JZ2g_*T8kx_5r^4$ofYU7dRuB<~0XuDsLr z1hk16FKh=y43EB3_&e{!#`YZ{#+7>0+`F3O-Q22ogz2kZCV6*6)w|HWV-|I7wseiQ zIn%x4D{tI8j+(od3|UyPJY(%!w2Az=k~(|#Fq$R*rY%OqJBrK~Z|hd8gXDM}EYy-| zk33jOsc{_IBB_w+j3*|Mnjqm%>#BGBsZt2Ax+-|EC{8u!PNvmUXco(Hh6TmfdpmY^ zH-N^ziutp~@u%~Y#udS;BRWk2#RSWRst2_4f$~8KNueDAFTxzm#?Y)y?>IB>ICDZL zi|`6(viFEDmD>1n#FaVMzB8QR?X<>Iq%jH3%eb88i(6Hg5wHe}j$-vt&UGRx6u{T6 zEBN!V;%lEp`wmW3)^0(gSR(H)=rF z0BG((+ab<`O7DD6Z*f9c??jd_+Z<27Ha08%+fqsEiC&H)=I8hg*$3J!Y43gBu@!7QAr^(29DS!O<+VMv31seM``v*r9_KUV= z5oW>ax=sFqE?8|`)_8u9nvt&I3u>~n_$JbcT4YbJPH-B|y&(|9)ZtEYskeEiZc371 z2CSQ$B-8>IHC9!cn2)k}$+lPsvfSZK8H7WdOVlvD9&G96E1 z1_8ySAU+#)gjt09Z5F1s)r-hDZ#47n*V=G4e^OTz_JiDNT%q;UPOYNh&O#%{CmJ-T z(NNL}v>nqX?%%m_V;MCTxW=lWbItmUVyd0@;5vv^%Q=!-@r00F+z%56@G+Fb{Vp!< z2O}XD4Wa--Gd>z>#Fb%l?y<+H?#=Rwe5T}vrhGv@kNvEj*LWta>{pm2h*fng23l)} zinCgO=dBC(Tf4aewzT{8-r3Tq@gS28?&mar01O5;9H8{LHzJp?V=fR$d zw%2zGE8;KY=NI?@!Crf9V>InB;?r*bPSF5-e!0#@ia$z**~IdqA@ryV{p6m&39 z<_-d#-1cs3+S!k8sK((zZBi$NwD}D>)jZtkYvW~ig@UR=1X=FB5D`GKR5Q}nY4}O( z%GFRXmhBB;O)Zpxj8e4`mkP%y=DWiD*oaG+bh0TJ5jE7YzG(syF*+NGVq2r5v{UnL zW~VH&RbvaXYYcm1FVr;^^Rm?vvWYcLkzHd^R3j6>5+DOFcrtGUHj0w{t~&Oj#W2U> znd6r!Uv~2mnhppkx0Fi9WEbi*Rls5#cjHv*ox0iCFutts}|DKPF7u`OS}$*y)7V$X>& zhQ#GV{z4)M^mW=fu!%;D?RKHom8Y1s-c?rBc6yGXMh$#hj>UkA(XYLf$XFxX?gfkU z!dx{?eJkmrb}d0BwU!lPx!1>TNNWRb-WWyg(&g_!QP)mPQK7qJ5>V=Vf03zI{>RSQ~3$>39HF`*4C3>LgDZ8Mg(a%%kTv=!s1LuS0REDG(9C{WZ{ z7f!cJr-$R&9>t17NGZ+|v5tp2;tFapoZK4Z1cpkKLD-;y=hP$|%<|D=WD^(}e9PKx z7rtfmWB7Kw9ozW7&)BN?zAVAOQnl>!gaj&IL_% zW5!);d#nAs^j6Jq()?D`?V>XoH8*<2dSlm7|82Y#x9d1udf3?>Tsxql&&G1yhn|^C zy795^Bi|7!X`hXSeJ~%UMPJDlnj-6bL(Roj)wJlVNp7@_TjFEOYFbmFDV)Y(*a_i2 zv0rM(;9{@`rllhZr{bD=-N;i>lPRYr@z?O>Jep9YCjXP+Qa(|WDywR{Rg(yG>X@*rXQgfdW~?`ESHvY||1_9~oOcMnc?oSlltR(Jj zKO6T}w=SHu*2cQYmZJ%7b;PiDh2(j~1i%dx?nfET3rguiU6b*i;NVtZl|WeE!JHC+-ce$AVrh zOyPmJNrEwjQqDr+3&Qu9TV9+3Y{fmJ^^2k#&I{|Cio{)rRXd3qQNy_*#@s+NA`cp3xBtiJYuW)67foRKV@3pgj{2 zfSUn$I2%msjH-xYS)KM34ksvWxGt~NAYq-FxUs_RJ0gEGAePlZUM~QpR+pP1G zPxFj^R5XdI+1{M!?BwC4W>CFXNngDcq->cTib~x0m){6(7$#%oe z$-0(dv%k~x~h*fF`R6{6mL?!kj0v@)3DZ!6kVOC_tQX0Z-!m?R_F&?Ct#Sxvq_3;YxEnZWbV6ToO4A9< zA$5p@SwJ92r)9{v_XWj0g`pbjv~wFLYyklP|Lt@}@C2__X1bF$slUBf71RAT#$CCL zy4t6b-;Ga&@OUdr(@~(2r+I=^Lv+9CBut*inPkH-5!Pf>+rYrkogJRiv8g`eI|>qJBCYSuIg-4(N@##)maEn_kg z7;An=Km8SE&1n7Dq!B9hy&_oA^L`LBFZD2!hd=mW2t9tQs z+G^7pM$O8O5PNO0i54sH7>)6e$y`C6t)nbwiRvho14nGtiS_Hl@$xR?eLucFB~ym2 z8RCe=!a0`cdX0Lc{M@6=xnTj5$)>c?he8QM5fRA*%ruD6qz0#1o~WWoI^2WY#6(Bq z)`tyvNQB`jh+INEMDu4H8%hjB<|pwUR}8Ap+OS@ew@bf9NN4W!Y0_m*d3`mn35Ra0Jdd(#D zOb+#Et0;E@73-`NNj>CH0gZ<;41i`>$6MVkFNmfS)IK`V5xGKOjp+4;!eK&&BAw-k z5|hY&!6T%zbdATA*7fy{LY6!lmMV=In8Uo#CmV9YJb|hh;G|SFeV{1E1X&YQVMh8- z|Bp{FBc)Tf3uau*WN2u7LT5Cg@zA6R`k8E1g+nW%r`T3>RESLt;r6X$jTH6; z^VlI`I$FWzmm(D_)N<+;6k}xc_11s=A}C{4GyF092Y#wXHN3y1%8}|GK&s zXQH$fp*k_y9Om9orck)=aEaBl$Yo8TeTOl+z@}ZHO4yvX+smHC#K}ZpbJK*eWgNXnTT?%!7_H5_2E<1vxQ! zSiy?(tfhf~<-3Xvm?cFNaxLctL0mlTs%Kx0JJ%}BYq%8BDWzID!8jN5dXsX!os?y- z!)8^=;cuOkaqTDbLhg-C%70(4$EcdK*a0K48>7}u7$)|6S^MC>!AOxsE(l=tDm{t+ z>Ayrz#_c*i$<$2Z(d9;fx;TtIB*w8Tr8#k@cU0v*!B1@s(@^nn&nGXV$fQd|^ zsksAyFKpq~3uYY~6C4^+ybFn=p264twKym+;I+ne#~VZUy(I1&ho?(9#I{@&XrU6( zYjtirkpAWyHkdG7QMMN7C~iEo2jwY6SgZ0Fo=jL`Zfppag_^HK#CtF)pD(A3AbIsK z!34RkaT98?x!P<_Tidm{TAosAodr>|MiJ%K1;N1H;_12(q2^Vu-ul|F=9<^6_2#j! z_zFla;iN}(!nG2ut*S`&f`mGy3V(d`psh#mX3qPjT{8 zLrb4m;~&K6g|RFd?}_c`@vKc ze>*9L0XXgpGUFFJjvL|YA`W3-qGHsd!2mAfj9$s$;Doo63xeLqtzC9wpUG-R^ZIf+ zWY}vwPv6ESe{nF=`1BF_(tn(?(j%ARXqBcv3yYqe5F}<}Cj?>%Ok!o|4|UB`xw z#WP|_K%PB~08QC5R^U-ki0>w{+Ca-#RDk+ra5@XNM`t4^R|J5)qQFLR?orI>l&5@> z93|uSN})DY%$~@ajM$u_y>UA-9CRj>(jLpTlFY515%)3U>~*vVvljg3?i7wFz--hwbI zt1@c1FrBY7CDw}(bh#ikaDTcZI!2jj4*xlXh;F?gCEMA^qooQ$t{t{7(=c5RyM1Oqp?xB=cfXZXP z`Q`g&I?ep2&wbFnIN05U!eC+ZmNQ>2{6QBXw!L}rc{AESzwPc)aW?uZHQ>7jM!U|nRMp&V*V|p! z>!`_kJ&69}L%(zg2%@`Q{$}#{r_Vhy#QAD}ENpWJ*M4h)h3zX>eRT7`jC*kx*ebb# zEvQC|t!ZJ4%j^PMC08}M<5Fk|pwjb#!W#>Ph%>zkLpyeX!jX(zwUycxL(?r3ahYA9 zsN|~V+5|&?yzlw2V^!Yjv& z6b~9MY7%5%lU5TePhj{Vd;urdPIg7(kH_yg7|t1M>CdUM^zE%|ENDV6RIA1;5?|7) z87>}3M*qs-pbt#n^tKURA2=ME;o;H##&q=-*)IncW=oX4P*oX)tE#rt_&p0*C|&lR zBS&~WdrVuZGMmQ3gNDJ8nn1ZG=Px{=CmtiuLZShQ6sluv2Pcz4rZOdLxyP(8k6!uc zmN%wq(054c*lVD=l{;g9Rz{3^ET&#nX&TOiu~m)?Lc9iHXMxNA6Zfsuq>pKWTF7=) zo$hGISfkH6P9@j_!9G*M7HutQPJnvR)hxJ!DCml&Ek{M8nB_t(j*pghWBqAgBf9D_ z=|%1ou!}8iWEA-VxIh|Sdj;cILgD=n12#g(vq^%V!{-~`Zc@CvPL8rmL1+Y*>*L+Q zjfN|^tDq(LR?Ra3S8f6x-?AnjFGe&J#bU(&PM3Fx#eDLG__UNX$uKW}j&ch@%&Y`1 zvinR{U%tQv1FFe)7Pu}LB-4&asObVEsC6O=Ip$0apTmc2F35VZ01){QPVAx;oJnzg za7=xTHkI5hXpHVS;2x3^W3;`|x}3k$xST?aLew_V-$EoKt#@8+-5~+)dU4U$)11Rfc2@$*L43CSp7!d^mw#IKvp?&QuEwNyJa_XTIsJIz z^7-g0%#4w_V=#W$J{V4Js$e*NSQLa)lT1!D$M5b+BGK> z_6x_^Yi1liioS4EFiSfNgv8cEEsGtoEJ%`lV83Lnm)KrEEDC8Bcu3+Tnala4 zA!1-w9y?MzaIAVbaEwklFe!M?NNAWZ$Cj;DB{G)~t4`Z~!Y&7Dij6hV-?uBPiVhUx z#nJ}zAJG_;4| z1o*J{%Ki@8!x?Z9Y8C||v541Qe1y|ik(xe$WQ*EpN<{*&=deoplMv79dZ?{v>Z*LP z0dBRoVPS#cNr^$@;6DsZ+$c5q&_*I0Z6g3-V>uubwk0NDyX+%+7|Y=MQ!f=3+}DjN znBf4ri zgYHBpf?tU@i)&6`*wWy@4rS&z-!m*oXaH+kNEszn%Fa!p-%E9N=%qAu5!EhZZ=H60}&nf+Bmm#i9yS@L8wn4WAT0v=YlOrf3)KHHxTk1;GYsdfwAX z?`Ui2V^yK7#6I@>+oP7iH;NVB5)lCiuum7$x1B{Zj?k6*I-jY{ooJe71TampYu0F2 zEE&E#TaCo&DhCv_Ehn>JOaVqfz ztQc7pqe;eq1O)Jr#?WW)fv_X4+QQ=2*2%8s9|TlTcSXX{3|75q95Sd=W8TE7_NC|S z_aMNV1nqNN#~E+%X`Ejh8*?SlQn3m#2UCa`sPS~?6CYi4fTq-q6amLJ;>x;VgE)>| zOv0$dNg4v05FOhXP}TIENgX3j=Qm{=*&I=H%&H)g&}#c zR>~L{RMkcXvV67^ZeIZvC+$efB7!yHlVMe0w=-V_FJoX=O#BvmQ%s&MT?w@2i@j_U z)UXJ1bAc4O)G&-oY-OJFhyk%HBD!6~Bx?r3S?no14VqPAIKC5UtE`kj7TEb8x75KJ ze?#k>FwZ=})XmL42B$aFr~}Ce5{@rLH^T!P#Ser&aAO0H*dsLUW)EJDzT=g`p6r*~ z`1w<;D;q~WlThMHVb5Ww_QYpII&FG;mfd&G=(Oq)XYDPQ7k#dr3e9Eq7Aguwv>*DH zoz|4k=imE5?bJxtCyCx)SMf(b~Y{mKJl;{+*@Ra%HATw*ls_yRn&D&S4 zT-nn%5T4)Dr~k{_2L_g{xFGEA;m?wuRp)hggsa=TS9SD<%lgB`tNQvnRt$7s6fRlT z-_E-w2i2b06Lzf7bGU5az_5MEl5kG<;yEk(maQ1*U);W8j#`=%w=~cb4lL~myO*u# z3K#b*U*5ig22A`j-PD@t)2Azyc3C-ny=w?jBj$v&KdrWGtme0c}`D9AJ69}PgH69Cs$`H@|RZ+P@<9cDA7Q6 zN`FkQ(U#yZuXa*m0!`KB_ZqKk`zJTSmf$b{X7D^?#takPTbCb~B<%Z~iGE#|_a@Ow zU4HUZ<=H>EN%l2=d38&D-kV~gFV^S(_t}$`Z~x?`*dqMp-`qF9<*kPtdf4Gd92vD9 z*EVnd+gB}K+|l1}7It@cT+rSfo_EneN7&!dyQ*Ww;ttc+v%G!Tim;=vucyzP(b2!E zdmvoVGZ6N5tnBOPhpZx^Ifb0|aA4pfb6Q8=@@4(~%X(IXOFC98>sVq=UD?ssKA;TM zBe8thzySHD^o0GZ7B3CYUj`SzM@yFVbu1p}>AR@%W@TTGg>1e`bgWs{KhST^7F&e_ zJw0J}d*1~emIIfx577BVD+Nc`zp{NX%+hiGKxkoDy^K+ux{B2K;qs2oG zd8_&_G7DD>FuGMMfhp|2sDGeidAPW}yL+@0IWT*B-!eFO)r$7j?aR9Dpck%y$Cpv5 zqod0l*VohEKW9mYy0ffG{q`kudR9=$j?gu2+LBRPY|t_|JFaKN3WhEe38w>)06cZ{ zRiSQR*>b?^Sv4@W@cFCy!Q}Bh{R0xTRV(^B+7~aiz(q@z&=&HyBBYFI?d$34SP`yV z29g#Yd}>V3gak3z5CKV4wF(K`80Y+j343=>&q^cWuV`N$(_Dqlg!m|di^86j3`yPE zVa5n%Ocs(Q9sP^@maT-LfVD!i*7ha4zSdY5FJ0EXBuw~Cg%U)l`%!iq?OWQ&qN%%Q zaaVN@73Nw3{q-`uuxAyG_bf&anzs+MBVA5_7Wb@1G9*5y^}#nitNO#93s-bV62^!P z`fzavTGPy5wZd_U>MvWqvb#gLbfUBzsCID7I$D^Jz^#Vdj64Oi%XLm^1vNgI@;EoBM)`Q;(X@1{bAg`YXKUK{55OsW$Vn z_rJ|$!6Ng5mq}ff`d_Kp=3MVc?<3~k^e4RI{Q2JR;`v=u{}TTHIABWM&zREXo@r@q zFhf^gW6bw|o8Egbe%+rv&pPusN*Xit>?||%(8o zZ1IL(yudRLZSc%lcY5XseLL9?o9ABe;78B-^+CsYwuSBGcg{VXYs|jUykXu?@cKMn z9`F5f=Iz%$+>w&T@X113vj4wNTL=k9|tNZT9_>Q-Sn>Ww9fHx16=RVuE zY39Ovn>&tay!00z-;P6m-)uJg@S?#-zggb<#REInOeAgU@BMktH_N3j{4u-eSHEjE+fSeP+{AB| zFaFTPy>EPi^qN^myz|bd%1?a$f&9YTlpfk});~Q}{`b0r-@4#mNSkS^xA{+%-_%;1 zc6~4D4I3{1%1z%We`~K#Uwi5qq)!XZKJL_Sl<%K;d*a^!D*_Vx0!8{YZI zUH?vc<&|xZUH$d)ni=2vRr@DNm+qdrSIgJS?>l?`gtLc856%C@4_^FQ`RiRjdhFwi zNpGKfMAKDYD}Quw^AGk}K>CVrf9Qc@zgE6%UQO%H14wV!Z~yPV_(b`8cYp3X#Rk$Z z9Y1^d$DSyE^VvfdT>0zYkpAMv3!*2=Ewi3|{J5t{U-OHrw*72d`Jqi~wjO&o>BjF& z`}D?bO7CB6tM?x(zx>kV=nJ9hU%3CsqOX>3`^~Z6 zzBEI6!^cwI)`mYv0OnS$jOE0|X;qo5uUjM*5SCO83 z{IcbB50`&%*ewem`zO*{=iM0gK2&ab^5knSny>ehK7Zv?50+;>vh%TjJec&#^Nzmr z=m*OS>xWleIF0n8!#}Zc)0fK|jy(48hdk1yJI;J_{>$a)rH}o`DL?rY^=GcWxc`Cj z6Q7yx*M39kd#`-YGxwJd`12h%{ozZb&DTypaQ^+}e{HIJ_a2{7`m(z|u;sq;+%HU8 z)b~-P7j|9SbYJ7tju`0IPhcmMXv%Rc#b zr4QWap+)zU-oJ=93Qn@DkO3-|}()>kH-YzH7e? zUp$@k_Tgv$@%Yb|Px{(hZWz~0y3~2{x88bt`P+YJ?EBz>q!&H#(naCt%5VO{PiM`Y zK{`C|n)%~yE8lv^`ftCSA#J|a+5N{`%eQx(((v=&?qEC@p77ys-%@_;`UC!{hTG6Xb$o?AFvetFg@2Veglz5mIjTl+p$ zo_^*3t?Nvnsrugk|0v2-hLYxJAY^W!PBx7iM1xET6)F)56>&3W9vh^h(wwN2=x`7! zWK2@%ri^i~F%g~rK9|p0-}PU=tfhP3z3y|LJ)M2_@SJT$*z==|-nFa8_zJabsPi_* zjM3-H53IdNMJ=m*zhw*7@F48Z(irM~N_SC_7Ndt`Jk`Uf`x>XG*)HXA%N4WyDg6^2 z@{4COx-);Gc(b(DV}_c%J)VUs`i2BX)m(5nwZ zD)Hyi#1CT4$}hN87K`4eaEM<^7#=)5FEIhNPK%!Sww;5uMA@gb8|dMal2fe5Sm*Lp zScKe038L3-&OV7X>yxhEzWeBTys%&NYDSxIkIJW@y;rP-*nG_AFE?LyOGB4mc{KAC zcj5Y(@_k_UQ#3K!OQbgjYtRa9P)SE+`~KKH+J|+nNs!s37wB5!{s+tC8Gdwy`)Ay* zFLTgw>g~k!J$J|YhnZ-?>AN=_a~M74)tghVkfY!#N4Zd}Wm+|+tpP^TLVSs zU%=X^@J{W-*Jzmzx3I|;YjI8D_1D)Z^!z(}{Z&}A&N!^hDnMJ+=E-go!n(V1sdj83 z^5*siw0-HodgkKyM~l$SwbttMQn8M*>-??z2HiESMlHS!pFNN(^%jMm5aQ~ZV9olq zN1^>KlHc|)N^u$1y1yr^eDw}h_Qp<2;=>x2&Fu;;MstWSixX?xaev3RZ>L2GihA-! zV98^wbIDSBg;JzicBxk-0BdXgniaoFk=wRpPS!q#Z(5$6_a15Kw_Yn+jy1ddC0|$> zYT0G4YB&Y!DCt}w<8pMZmX6rf(uVu@1(L_6Rv<4ZO)R6Zu85ub(xn1TeVy|;Hy&%} z!0QelD$pP4MGxdpGJKn6(8@|Ac;(q6FvMDak^Pj*mB?7fwrz_d)~r%C{ksxbPw2nE zHwo**2Wzd&s*u7h_Q54ht@wU8T}Umn3Z*=+_js0rwe@;&*O}EQf5|2L2MJiu>~xg# zs75A}q$A}H_SnTUxI=JtE!XBEKSJl1z)zanf_5u6&E{u$ldMaD zQ$f5H?K&;wVn=%tlI`{*v}!9_9F#5B1YyKciF03R!&X$q*W(mD!HJBzYA*)Pt?1;{ zJ?~vc?8y~xy@%<@R^-P&a6K>Q9MO_5^OsI-MYe}Z6{NkLNqC34=<-%HH`G(mmBk|6 zXUnzI+*b5>=$hlw+;F1p)>VEGZ$p~fn|D_E1QU_VVx>W?4V~*#d(r+kguHq}a}pS} zA##PS14RWBMZxQ2z_|^%c}n!zQlTXO>4BegWE(OmS$oq7g2}J^}lr-e3bM=A&Cx^C}CvQm<0q>s0wEG@Z<4}6`;DIpvC>Bx4(y>}>j z4l9V%QMueer?#V2vF0Ic-5}EL&la42ru`=536>#Z=hYq==x#^C7U$(3pb&CW+C~Ww z??8J$o5t(YCyC)-uO@?92b$@q6!I`9j5s~-k~kQ3Ahpw{8jAm(C-hYY=7Dnu`ttD8 zT6euja+jvrT!`vGlJ5Eb6Q~Gsn~tF(q;()GL=*g@N65+K|S!ld}YUt0Ainnx@;IiK$|S)X;GjyC*> z5)}gvi_@pctG3q{gY!?MV;ESmkq#krX9Nw=kw4MU>->uzf4vC968gCAO z2g!~5^s4CcpGdZ24JU&>Mt&7K_?zbbMEgWkE=|-sNA7li{*4yvM6-@v~DCBB;s z_t2`HsH;dVocs3>x%dZFPaAe3x6Pg8VdPH^X71^tk9VR@_U`Um-u^^QWIV3_PSg`K z6h6uC1c9HWk%hEQ#6NZBp@`ALGzcxAl`*s%royrpLHYV4T?~sfh*o8#@nij5_YDzW-)vJJW z7uq0}XYi5bLq71WmxZVAZkN1&Fw9CS!6P~#$Fi4(n#&V>+h%Y6rELoQnXruKs#3LzY}-yflmbCKJr%X9lD93b@yhQ85} zT(qs#qrdX32jTsljq9I_)NgrRnZv*QlSgISIOkjl_1Ek{n#)DzLC$=u z1e{1GYukQWtQ&n6p1UQ*JA^bn6WB+qb|d!Fk=I9jE|JnxMn-AFZe$TxvivV~iSRXe zKM|a}QOVvPxqjeFw3YPY_ScPOyRFLkN;{IapGEl~tsDK6YkBO0qDiglWIm|qMuUm^ zr-#q7h|$r{!!)-W79`x8q(%A#95Lb+4asStYIE~+%hDO5)xjphDbYu@Y;ku??4WbD%Vyz^k^`P^7 z6IrKy;)#sw3cu;{9%LVu_)ufWmV^%>{WP}+{j|7yjq-^lk^@6ULA)0&v>1(cU?mb0 z*9YMKzZYpzi9hq{Si=7oNz;bC$W=wfyOqzKsFPI~ppW+=8&MzkS0g?Iu{w4-MD-#i zy$M9|1Xps}LF4I=){7=A=+*RP#gJ=u{ryRo_oCiLviG~ss?^Y>qFnP+?^eK0tl0LPY3AoKBO*5iLah; zhM1Y2hOfUql(y@MoukiXqCZtb3dH--;(%FJtA5)P3Za{E|KE?+@2q!i;qxO7reA2K z4f~OK@Y9z^=wO2F#*f>7KiboqpYSC20@<2(oJ&XcBUi=My+XPP1pnQfW;(SWZ9F@L z%An)OMtN~*sOU#)kJh^!%8e(Rbh^c$yC2Qn9Uv0ybBU zUCF$wTj^wonO#q`zc}FO6Bmct`~aKi2kTLAKENcOX+W)Xmre@3Xw4#OP{?d zqf~~Zzb!dXjQ;wLeSUD_*yoWKqid-j7TvthH%GcR2;tAKY%Q4YZc~gB?j9nM)EjE+ zobEl9{soB8T6XtGa6VsMDvJ#C%l`(riMY~9rX!xhw%?0{LbreLkss&RE* z1y$?vw0H>{&rhv~Z=MY(qkP{_E9XyV=C5lHzO62$j7q$grJct*Y5MkwawSx=LEOQG z`>|#ls?PO#M?H}WT)THU*1$p&@O)k?Rpr6_1;cl_+zs&sX#pb5%FQ~}X6&^BQu-4^!dI~+G>R4tUTQacD zT{ruzRvHzq>-ksb0`vLjf-%P*P=0F)i{g&~d9PSnmdFL|oJEJGN{{|xeo?q3r8<_c@*tgQT zH;|9Gf8yj)X8sl$He&DywV7XvUu}Z5uE~6j2hUK;+U)L+&3Hb>3av<*nTeih(dS-x zV6Dslx!pAft#3DQeJ+Z%wU1F%eI7dKHnsj~GM;ZGHBNl!UVwI%d~AzA%>1m$WBuee zXuIeHL!|~hU(&rF+8FT;6-!yev9nmStB$^$Qi>uqRh(AJFuE*N*uM;E8!5;+7c%oB z`*h*c6{ta7p5$}HI+yRTz@thO+JngI8CbLbevtTr=MR7Fw^Zii@gb{l$EHai(1due z{vXa*cdr)8QLaI~q_6fL8LTUeWTJL{L_KDML44JCKGNOszRIN*IsVH0*&K*<)Y*Wm z5uZ?8rs<1I1lHEyjQQ@>p@rf_v_L@jWh{O)qFgPkgQ9bw@)8@u_A~VBL!J{1&CVjk=OG7PgX* z)Qa4d7JIb_o+9qFn`r>M6=f{^CHF({09o}ky^CJZhE(6(p1)~=KlyrOSQ)I_(1I(y zH~R-22_uKFK{~Mwjb7Lyw3|PIw3D*e26h|T==mn6k3WRmC`~od3)&GOGgWu_um@S0 zxUZD9YDbnwk_1?^J88c;YYimf@xFIwLBVfl;TEB&<{P1qE+xem{-Qb$#4=>;9g z`|*1NW6`7J1)9H+w(39*Pus)ppA96G!uJ=`i5;kM+VO>2+ zx4G+zoFOfRw%5^LJ5lZPD?^$?=ZW%p_MnqmhYSpM9lCeZGnx)x1W+{%;$3>qc{J;!GavbKEM@HWd#$T?$nxq zH3tn3ikiBKc$1>JUGk8G$B&mc3i^77!KOKR4Hwb6-Oly-0QTm2kUGB{AIhW^S$P7%>1vxkBR`$Y=; zAk&S`ZPKvq^GP5MfBgQPw(3Tn7alhV4hIq@cLRhWsT)QAsb)1cnUJN(YBsRD(e&;@ z0Zrd%av&@9H@%<-B<#M=g}67(g46Zi5%Qa`F94WsrA2a|p4S77^oq_A7MYl*}uQp{&UDZO9-)$j4} z|KxX>IQ}eXl(rf`lb2Sgw+aQ3S%dR>>BIpv!PE6{;$RSQZu!Vh`s)DFX;)K;Vnvg9 z+XeW?e<$HrzoDD3VTTipC`du2i99qcAAkd2a)F4y0D4jD;o#1{@T&14WY`qKYNy3e zWv~vmOk#sjhYHM%sf3^N{({1jxzMI_7Y0`N!iHBWaJAhZ(&d~%&)W(5@4r&wkg6GI4=ziz`GGsZd?7srv@6Ut%HqjtB zrv(DyZSk$x3c_^{<0V2Gj;3rWEwQR5#(#M!DYincy(3-Gr&=TUYnb0FV2WFLhg+z54?B*YZcoQ3V^k*}8`+S0hwi%$&77Q(v zHE;{w!?Be@V2M7!jK*3pUDF7S2{BN$a49SeY=b6K11Kui0KxAwfPJLF z@|_3p%S{K#O$kt7Rse4cH-N#@XdFq?2Orj_fWnq$7_GsvIyoaSKduy<%Q!GiX8<~T zSn#a%HN5$~6k-M9AkReyRD_=4ryBa;yyR7QDB}q#&l6#DOg?yOsDh}mBe>p;0*BTG zpk8tjPS4m1dZ(M9|7$R`#a)7?7JrCWzXa#I9KgzICA=D)3i?;l!9MvIxVWx^a7ztH zlzItdvk-)o&o|u#960n;%5M$<_&w{c$l2p1lK3`mT^Tg9{OH zcOX6b7gX-v3FX4QAahw02DW*_(}RbhLB|SoEhj=iun!pTQh-&5a>4PFIB4i=fW>w< z*x~X4Htul(5urR#95@2g?P@@N@-?vJH-hvvU!cRi5Q2uJ@lMWJm?xhF7mp}FQRyQ{ znZ5_2nvTNxx?ou5Y6SerIp8rl4*Jxb0Y>DZ!{r{>>P(E`Na`#?>iO3Ixx_^O^ZWuVK$AfnIWDu2+f={n4U?8Rdic+@0 zj^f*Jch!4nxxW$~#>7Fxy2CK*U?aGPap7?2E*SZ;3Lf8h2w$bt0lxv!KcC@{fgN-S zWPpOL8kp>*U^BfMjt*slTTUM=jr|G_S!!Sx_6zt+q+odAB&ho_57s_Q29r6Fu=2eS z>{!2hUJ`2$pt*qC30cxKk5we*z?I zHHCuD8Sua^3*5`gp>o1Jc+#T`VextJI>iG5^*_U)WfByz`r%QxDl~Ln0kn^Vibh8~ z66?!ebmDnvRu!38`#Q>QGz zzg8dAzRrL*%Ijf?%?fzuTn1_-FM&EX3dwL21djax^M)jlJ-!(ZNLE4SK7Vkw*#ZuG z*$}^r4~&dg!Tg#G(CjIIX--yPsrCZ`RPMvPr?26L#!3*(NQRClxQ`l?g~%g6K%Vvh z(TObFuPcM$`y`OL9S_fLR)eagFr*Ky1BuTia5kp`629cYL+NZNzIhG=kM08%V`-2F zWAK^Y4c{gQ!gP^Ca8WNDf^r(+^Qa;?EO`N*!OKCQ?=NIh*WvI{L)fZ#4-5;;LHRcc zwdR+h|IG!MVh|28tM5Rvi4{yoPk^O$0ZL`~z@;G&-Zj1e%6b6D(?|f{WCsXKdjwB& zD`2OwKFt3!6)w2GhFg=?K(6izm{jix?2V9wnvQ`tYY33#{cC&)2>;Z6!DS}5TmN0cg7tGaJ2Q~#kpfK7Ftsnbf zp;s{+k6r_VVx!@=oj6Qqq6L9AdNcv+qVhm@!A-su|XxOzg7#8DV5zYhv0zQXf& zS&#ucq3P)qIGME=n$KFp$xk6LMQRzGn<)z3c5%R`Far|LxWnjZ4(#2?g*tri?yQ>z zp;?(waA^e8@5w`t(`$$;TnV4S$* zC|(5#t5O&h*$UtK|3JhVM`#LM2JIjGVI=)Na5@6YTJO8>;{-q_ZH5L2*aPP zM?rP&C)l0t4?E(+V9&x*P&BTG+@g;lGV3DDc76#*E*t_mb8A4mIN&282K~<^V5DRK zmXpf(mji8e78tfwyAV!l5@1$RXjcEdWGa+H8UlDxL5r+mBeNdj;0I4%?fb6nO zVAfX)b!RTa^*y;@7&r`jCyhY!>BkVfa3yG^ECl=5dN6K#0KRfsP~4gTJEtT=yyg?Q zUpp0!20`h0Eo#pqp3^^_z|1+sV~n|8pJuz4jIM zf3N~i`((&^bOwxn-2|oc_!;3WV=!|P1X;yE(BA9^!QWe;`T7Ug@<$iwz3nhptQZQ- zLLhEf399o7L9DPGzL-CT&4qywu>JtZ2Cji+r{h4}CI}R_djf0OY*VM^A}GjSe*}Y{T(o9kJ~^D1-7@8U~TLZ$o3L}m>!P{#Qh-GTP-GK<0zPA-*dj#P*9@8B6Hh|l+cEa$cK8|aeR&@oH1@$Jc?%o^)CE=G0VDm!z-MLvY!?=e zuKf-oU3|LuAO*a(0HD0#qz-;zUEcJYz^~RjOHZv~wBMX=ZTzY$v*e5xqZj&qUx{B~ zUf+=whOcY{>>oA!7ln-yex0ilIl&#*L#WACb)k>a8REY`qnKUNedhdR=W!iPjIGt# z>oVVm_mgq(5)+H$POV;ZoxCzAnw`yyDf)_tJxq{MA&OR#E;ly5jif7*?Ik46@zM?O zb{$uHEQV=ufiIm+m7(YTqP2n!k5H-6rmBZe{gD6a9SQ7OWBj+>IL#oEk5^ZmsPnT8 z*CY@tH2>UR`-_V#>pxwcX6-`Susn3GbaGLpU6A;h{ZV9qk5ik}cP^Ut%YMbKsxabY zfK+u_9TyEp3@u`ng_4cG8WbGxYQD|e7MmS|*2LQcx0xH?a8Z1CyFi4Y4OI%fKui$=JkF|(gX5QCdtm0})Ye^*tV*XHODH!G_(I&X22h*MPX z@`*>uIn{qt?Gm_XYPPE4uDut?ofeW6e6e^pqGLxGmt{njsvpbE4&kC1{WY13-bIsa z<@=AX_;OLI@xJ!&)huFX#O=42&v21`?ClPzIV{q1=UL*VD;KTRXf*C#5J`4~hiMHR z%ExL>WiNPgJI@6Wd2B5T#vI)j~8hzFU6)r0nM(KW5W z65rNHa$eoYLL&n%3V(fPgWmBF;$zr>^J_M7(OLc@E`>5LZU`X_s5?hhi+ou`In>Ri;@y5O?XW){)l)nvO-iHr6Nx**S&7s+!62flq> zjCW5S3ORlo^d-JEE*Q8rAD2IMe0GBDS~9BcbA``LE=m^`b@g2pN{CGSaVJ0$&$dg- zf@7vT5qnj2?x%`!(Tj&^25ts^gj9yQ@ZU*XwEg6xCcbrng!-rLBhGwWwDotjrFKIk zLC-k!RB(iY_$?yVux7G&DKqX#Xc$9D5 zb#OhQ9BgAPSjIuzLzC7B*ENmtAvzn#n<1 zZpGG@HU^RF?8D4iefkx9Qu#C_-V6e#7L49Mn-X%P8Q@aw21s zS%}(w8JYQp0AouZBmpPAn;PhzEqRQzLHpMGoS-(4USOBT`5A{My573LoceR@h7O! z)5Z??`bxhRaq0b6U-C>}HRXV>zaY($7?0UuL`t=Jd}143y{oI-8tEBD+Pw%@n9Sjz ztjG0x>s}j^f20gw-t6Nb-CuXsPEC#?SDQ75yAI*4sXG02jS)uoAAt(F#?0+oI;<{^rr;nBhO!(WKD)T8n(#A3YOIReS7og1EXX zpdn!v?hi*3_i22OAkI|KRuA#&;3G4k%1E|9v8~cXrAMBN>}T)LN_~Hjc-}fG&QX<% z4$q1?w#>nvI1zL}bg`~Q=R znl3*MCwuH8l=boMxS-4fJ@Rz~A#ZNOnUlpu8b9y9j#Kg{E@e5aQYz#kPC%vl{X;mq zVxyCVJHFp`eP8na#%4HrxgDKJR=}j0YTu}zV6ml_dX3~lm4Mlm z!9PiOH%~9~7l=r|&FuAE_K{-kUA1&^`YS zh7K{*bfdI~dky7i^r9yDz@jm#%h32iOn)l}rOd9OYV6al|L||YyQ26@;4+I*l&{kQ9@ewwzHXUoPrhI&H`y%!j$#{Yp@E#lkN zx2}FH&AAMX|Bb2s5##N5swwNZoq);zxqJ>NLZJh+NNY2`1b7fbyQjUW04)#dqR=&ABQdJ0vP z`{&(D7n{$>9xDx=Uxr>jl6U!SCB?s|^)Q*bV2lFKFGKG=e7MiPlIp(at68*Q!I)pX zK8*7_jH&+Pp-_QJ%FbM1wBVlHm~AdYGZ`9nqG|E13To=aes7M0=orOo%{addtw@hs zqFX`vDED7~xw3n#j(BwFUzEl3`v=?V?suG-SxyBJ@edVEri`V^n&+3H*7YSR-DT9` z)WEA5a!O-Vm*8tpMu#Zz_WM~0z849zukklpv5nsd1LRdkl@m@V-9 zj$oQ}<;`GZDUSM1JZyMc{(orZzbIad$N6Pwl=8{I{1PfMBUC+Y$E-2iT!s!YG?%sG zU0*R}7xf+;+>tfbu96rUKZm|tt2Uxr$%)+lD=Q5SDX%uHsf z{0|-a7uDtYJ;(U1@ba$BrTQ(}&R;wtJeFo2&HNXY;rV4K`-^&XCq?yY-rBdvZM;u`)Fgoi~=BT!z*$ zl)ZJeV@wwH_JKv)3hnW}j7Nw5MUxoYct32Lr2cW^>zCBwy{ZNZUgJG1k7oXhvUq+O zYTX=C)s5rkPiVedb!oiEv1aHHLuDqR$#b4lCi{zQEGCTiRy-Q-{|~Cm*k&@6J?CPr z-ZSd!w4u_^`tD{Y@pLboE__j^qrFJ^|u2QXA3S4}vTijG+6 zcil|+e`w~vDBgj@<;Vcg&VYhyF!#8Qb_k>^E2Am+8s76z4|o z@=YVlvd69jhGzbYCh`38=-$j)}f8_=;CJc=CM+_bM7iBT@N)T>Vr=}+OCQ?6y zyuIXD3S(}0FzX-Cn&%ZmX;#hTIhmIz?K{JtUOE4NLm9?0i-F<}ifkY1hwkSosA<;N*Ye=!e?VX?BZBcsxy+js{AOY<9tP=U z;de8F-K4}>s7>iwyu+LEevQSzIt-;*v8H=vqEOXf(Yc~UKXY^R6abmOGZmav)xY27_Unf z1M3*m+{Eb*;_jida^@8mPLF3$m!U&E+VK8F$s@dH`)PCU;o0NaXJ~vVV>>BVz2hD88n5`~DGa1VMq8;5vp;6%*h98&z*PHVE@~FITgmfP2 zovd7TiYq&oDjaQr{W7$Bk+;%=JhVJsYeU4{@zO|QXnX{wtUytl%6xPq{anehYZJ$8 zSq#l&Xp~gii0x|>?7D5yJ=LPI($HmS9YfPJ{nkbopi?hK_nh_{?`>sxetGo9k7oHo z^yci5<~Ggo{IYROkY0QwwiOS{*({fEm&_ll0~v-6V>+YZN6J7Ml8AU^D_oa+PRq_w9pIWydcfYlgz{ULCWy_GW6wC$BomgP)F9Ltj3`6K?e?lmu0>9H%n8tu!T^kUDNnPb$N=a->vHH*?`eL&aPQJpJ)2#!%*p5F_Y zzIDkDclm(aKH3YF$*X4b`bZg`UxunlUuVDjfRaB6&k2@M8Kc1S%g`jP$&VM-AhS1z z&N=6(jD0f>HN*L3XvN#zgPt{rt82;WN*NzIV-4_y*B(Gq7%kG2h2mh5Wy#epV2<#cF@-K z#00@(Hcs|#_+fm$iR;zXK@=0_7z^7&$_GyK2^?gomAbZyy2=V=51SK5lusOTkXd^8 zGByX6A6Q|dap=GbEe-7zS~hm- zwzisTS~jb+)ehPnIhz#)z0t2ERUV6WIo=6H;gR(7^FC*AO~;{r-zj&8ieI+X2? z9Y0`m?1YlY0k>lg%426@C<&f8V(+Ak&v8%^bG5}!urr5$C^Jv%pHLEZWF8;qo#*oZ E0MJPC_5c6? literal 0 HcmV?d00001 diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat index d3120e489f..dfb92bf614 100644 --- a/runtime/wasm/marshal.wat +++ b/runtime/wasm/marshal.wat @@ -45,11 +45,76 @@ (import "custom" "caml_find_custom_operations" (func $caml_find_custom_operations (param (ref $bytes)) (result (ref null $custom_operations)))) + (type $block (array (mut (ref eq)))) +(@if wasi +(@then + (type $map + (struct + (field $size (mut i32)) + (field $keys (mut (ref $block))) + (field $values (mut (ref $block))))) + (func $map_new (result (ref any)) + (struct.new $map + (i32.const 0) + (array.new $block (ref.i31 (i32.const 0)) (i32.const 2)) + (array.new $block (ref.i31 (i32.const 0)) (i32.const 2)))) + (func $map_get (param $map (ref any)) (param $k (ref eq)) (result i31ref) + (local $m (ref $map)) (local $keys (ref $block)) + (local $i i32) (local $size i32) + (local.set $m (ref.cast (ref $map) (local.get $map))) + (local.set $size (struct.get $map $size (local.get $m))) + (local.set $keys (struct.get $map $keys (local.get $m))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $size)) + (then + (if (ref.eq (array.get $block (local.get $keys) (local.get $i)) + (local.get $k)) + (then + (return + (ref.cast (ref i31) + (array.get $block + (struct.get $map $values (local.get $m)) + (local.get $i)))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (ref.null i31)) + (func $map_set (param $map (ref any)) (param $k (ref eq)) (param $v (ref i31)) + (local $m (ref $map)) (local $i i32) (local $size i32) + (local $keys (ref $block)) (local $a (ref $block)) + (local.set $m (ref.cast (ref $map) (local.get $map))) + (local.set $i (struct.get $map $size (local.get $m))) + (local.set $keys (struct.get $map $keys (local.get $m))) + (if (i32.eq (local.get $i) (array.len (local.get $keys))) + (then + (local.set $size (i32.shl (local.get $i) (i32.const 1))) + (local.set $a + (array.new $block (ref.i31 (i32.const 0)) (local.get $size))) + (array.copy $block $block + (local.get $a) (i32.const 0) + (local.get $keys) (i32.const 0) + (local.get $i)) + (struct.set $map $keys (local.get $m) (local.get $a)) + (local.set $keys (local.get $a)) + (local.set $a + (array.new $block (ref.i31 (i32.const 0)) (local.get $size))) + (array.copy $block $block + (local.get $a) (i32.const 0) + (struct.get $map $values (local.get $m)) (i32.const 0) + (local.get $i)) + (struct.set $map $values (local.get $m) (local.get $a)))) + (array.set $block (local.get $keys) (local.get $i) (local.get $k)) + (array.set $block (struct.get $map $values (local.get $m)) + (local.get $i) (local.get $v)) + (struct.set $map $size (local.get $m) + (i32.add (local.get $i) (i32.const 1)))) +) +(@else (import "bindings" "map_new" (func $map_new (result (ref any)))) (import "bindings" "map_get" (func $map_get (param (ref any)) (param (ref eq)) (result i31ref))) (import "bindings" "map_set" (func $map_set (param (ref any)) (param (ref eq)) (param (ref i31)))) +)) (@string $input_val_from_string "input_value_from_string") @@ -132,7 +197,6 @@ (global.get $input_value)) (return_call $intern_rec (local.get $s) (local.get $h))) - (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (type $float (struct (field f64))) (type $float_array (array (mut f64))) diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat index 4be35de7ed..40adb85ce3 100644 --- a/runtime/wasm/prng.wat +++ b/runtime/wasm/prng.wat @@ -16,13 +16,30 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module + +(@if wasi +(@then + (import "bigarray" "dv_get_i64" + (func $dv_get_i64 (param (ref extern) i32 i32) (result i64))) + (import "bigarray" "dv_set_i64" + (func $dv_set_i64 (param (ref extern) i32 i64 i32))) +) +(@else (import "bindings" "dv_get_i64" (func $dv_get_i64 (param externref i32 i32) (result i64))) (import "bindings" "dv_set_i64" (func $dv_set_i64 (param externref i32 i64 i32))) + (import "bindings" "littleEndian" (global $littleEndian i32)) +)) + (import "bigarray" "caml_ba_get_data" + (func $caml_ba_get_data (param (ref eq)) (result (ref extern)))) (import "bigarray" "caml_ba_get_view" (func $caml_ba_get_view (param (ref eq)) (result (ref extern)))) - (import "bindings" "littleEndian" (global $littleEndian i32)) + +(@if wasi +(@then + (global $littleEndian i32 (i32.const 1)) +)) (func (export "caml_lxm_next") (param $v (ref eq)) (result i64) (local $view (ref extern)) diff --git a/runtime/wasm/promise.wat b/runtime/wasm/promise.wat index b2a051494a..f59e96a201 100644 --- a/runtime/wasm/promise.wat +++ b/runtime/wasm/promise.wat @@ -20,6 +20,9 @@ ;; (ref eq) representation and the JS [anyref] world. (module + +(@if (not wasi) +(@then (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq)))) (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref))) (import "js" "caml_jsoo_promise_wrap" @@ -34,4 +37,6 @@ (func (export "caml_jsoo_promise_unwrap") (param (ref eq)) (result (ref eq)) (return_call $wrap (call $caml_jsoo_promise_unwrap_js (call $unwrap (local.get 0))))) +)) + ) diff --git a/runtime/wasm/runtime-wasi.js b/runtime/wasm/runtime-wasi.js new file mode 100644 index 0000000000..e5bf61e0ca --- /dev/null +++ b/runtime/wasm/runtime-wasi.js @@ -0,0 +1,84 @@ +// Wasm_of_ocaml runtime support +// http://www.ocsigen.org/js_of_ocaml/ +// +// This program is free software; you can redistribute it and/or modify +// it under the terms of the GNU Lesser General Public License as published by +// the Free Software Foundation, with linking exception; +// either version 2.1 of the License, or (at your option) any later version. +// +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU Lesser General Public License for more details. +// +// You should have received a copy of the GNU Lesser General Public License +// along with this program; if not, write to the Free Software +// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +() => async (args) => { + // biome-ignore lint/suspicious/noRedundantUseStrict: .. + "use strict"; + + const emitWarning = globalThis.process.emitWarning; + globalThis.process.emitWarning = function (...args) { + if (args[1] !== "ExperimentalWarning") emitWarning(...args); + }; + + const { link, src } = args; + + const { argv, env } = require("node:process"); + const { WASI } = require("node:wasi"); + const wasi = new WASI({ + version: "preview1", + args: argv.slice(1), + env, + preopens: { ".": ".", "/tmp": "/tmp" }, + returnOnExit: false, + }); + const imports = wasi.getImportObject(); + function loadRelative(src) { + const path = require("node:path"); + const f = path.join(path.dirname(require.main.filename), src); + return require("node:fs/promises").readFile(f); + } + async function instantiateModule(code) { + return WebAssembly.instantiate(await code, imports); + } + async function instantiateFromDir() { + imports.env = {}; + imports.OCaml = {}; + const deps = []; + async function loadModule(module, isRuntime) { + const sync = module[1].constructor !== Array; + async function instantiate() { + const code = loadRelative(src + "/" + module[0] + ".wasm"); + await Promise.all(sync ? deps : module[1].map((i) => deps[i])); + const wasmModule = await instantiateModule(code); + Object.assign( + isRuntime ? imports.env : imports.OCaml, + wasmModule.instance.exports, + ); + } + const promise = instantiate(); + deps.push(promise); + return promise; + } + async function loadModules(lst) { + for (const module of lst) { + await loadModule(module); + } + } + await loadModule(link[0], 1); + if (link.length > 1) { + await loadModule(link[1]); + const workers = new Array(20) + .fill(link.slice(2).values()) + .map(loadModules); + await Promise.all(workers); + } + return { instance: { exports: Object.assign(imports.env, imports.OCaml) } }; + } + const wasmModule = await instantiateFromDir(); + + wasi.start(wasmModule.instance); +}; diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat index 88ca67e8d5..3e8fee2f03 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -39,10 +39,25 @@ (func $caml_format_exception (param (ref eq)) (result (ref eq)))) (import "sys" "ocaml_exit" (tag $ocaml_exit)) (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) +(@if wasi +(@then + (import "wasi_snapshot_preview1" "proc_exit" (func $exit (param i32))) + (import "wasi_snapshot_preview1" "fd_write" + (func $fd_write (param i32 i32 i32 i32) (result i32))) + (import "wasi_memory" "get_buffer" (func $get_buffer (result i32))) + (import "wasi_memory" "write_string_to_memory" + (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32))) + (import "wasi_memory" "release_memory" + (func $release_memory (param i32 i32))) + (import "io" "IO_BUFFER_SIZE" (global $IO_BUFFER_SIZE i32)) + (import "libc" "memory" (memory 2)) +) +(@else (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) (import "bindings" "write" (func $write (param i32) (param anyref))) (import "bindings" "exit" (func $exit (param i32))) +)) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) @@ -447,6 +462,8 @@ (global $uncaught_exception (mut externref) (ref.null extern)) +(@if (not wasi) +(@then (func $reraise_exception (result (ref eq)) (throw $javascript_exception (global.get $uncaught_exception)) (ref.i31 (i32.const 0))) @@ -454,6 +471,7 @@ (func (export "caml_handle_uncaught_exception") (param $exn externref) (global.set $uncaught_exception (local.get $exn)) (call $caml_main (ref.func $reraise_exception))) +)) (type $wrapper_func (func (param (ref $func)))) (global $caml_main_wrapper (export "caml_main_wrapper") @@ -463,6 +481,13 @@ (func $caml_main (export "caml_main") (param $start (ref func)) (local $exn (ref eq)) (local $msg (ref eq)) +(@if wasi +(@then + (local $buffer i32) (local $i i32) (local $len i32) + (local $buf i32) (local $remaining i32) + (local $iovs i32) (local $iovs_len i32) (local $nwritten i32) + (local $res i32) +)) (try (do (block $fallback @@ -500,9 +525,44 @@ (call $caml_string_concat (call $caml_format_exception (local.get $exn)) (@string "\n")))) +(@if wasi +(@then + (local.set $len + (array.len (ref.cast (ref $bytes) (local.get $msg)))) + (local.set $buffer (call $get_buffer)) + (local.set $nwritten (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $iovs_len (i32.const 1)) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (local.set $buf + (call $write_string_to_memory + (local.get $buffer) (global.get $IO_BUFFER_SIZE) + (local.get $msg))) + (local.set $remaining (local.get $buf)) + (loop $write + (i32.store (local.get $iovs) (local.get $remaining)) + (i32.store offset=4 (local.get $iovs) (local.get $len)) + (local.set $res + (call $fd_write + (i32.const 2) (local.get $iovs) (local.get $iovs_len) + (local.get $nwritten))) + (if (i32.eqz (local.get $res)) + (then + (local.set $len + (i32.sub (local.get $len) + (i32.load (local.get $nwritten)))) + (local.set $remaining + (i32.add (local.get $remaining) + (i32.load (local.get $nwritten)))) + (br_if $write (local.get $len))))) + (call $release_memory (local.get $buffer) (local.get $buf)) +) +(@else (call $write (i32.const 2) (call $unwrap - (call $caml_jsstring_of_string (local.get $msg))))) + (call $caml_jsstring_of_string (local.get $msg)))) +)) + ) (call $exit (i32.const 2))))) (func (export "caml_with_async_exns") (param $f (ref eq)) (result (ref eq)) diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat index b978e4cdb8..52bd8329d0 100644 --- a/runtime/wasm/sys.wat +++ b/runtime/wasm/sys.wat @@ -19,6 +19,37 @@ (import "fail" "caml_raise_sys_error" (func $caml_raise_sys_error (param (ref eq)))) (import "fail" "caml_raise_not_found" (func $caml_raise_not_found)) +(@if wasi +(@then + (import "wasi_snapshot_preview1" "random_get" + (func $random_get (param i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "clock_time_get" + (func $clock_time_get (param i32 i64 i32) (result i32))) + (import "wasi_snapshot_preview1" "args_get" + (func $args_get (param i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "args_sizes_get" + (func $args_sizes_get (param i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "environ_get" + (func $environ_get (param i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "environ_sizes_get" + (func $environ_sizes_get (param i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "proc_exit" (func $exit (param i32))) + (import "libc" "memory" (memory 2)) + (import "libc" "free" (func $free (param i32))) + (import "libc" "strlen" (func $strlen (param i32) (result i32))) + (import "wasi_memory" "checked_malloc" + (func $checked_malloc (param i32) (result i32))) + (import "wasi_memory" "get_buffer" (func $get_buffer (result i32))) + (import "wasi_memory" "blit_memory_to_string" + (func $blit_memory_to_string (param i32 i32) (result (ref $bytes)))) + (import "wasi_errors" "error_messages" (global $error_messages (ref $block))) + (import "string" "caml_string_concat" + (func $caml_string_concat + (param (ref eq)) (param (ref eq)) (result (ref eq)))) + (import "fail" "caml_invalid_argument" + (func $caml_invalid_argument (param (ref eq)))) +) +(@else (import "bindings" "ta_length" (func $ta_length (param (ref extern)) (result i32))) (import "bindings" "ta_get_i32" @@ -48,6 +79,7 @@ (import "jsstring" "jsstring_test" (func $jsstring_test (param anyref) (result i32))) (import "bindings" "exit" (func $exit (param i32))) +)) (import "io" "caml_channel_descriptor" (func $caml_channel_descriptor (param (ref eq)) (result (ref eq)))) @@ -63,29 +95,181 @@ ;; Fallback: try to exit through an exception (throw $ocaml_exit)) - (func (export "caml_sys_getenv") (export "caml_sys_unsafe_getenv") - (param (ref eq)) (result (ref eq)) +(@if wasi +(@then + (global $environment (mut i32) (i32.const 0)) + (global $environment_count (mut i32) (i32.const 0)) + (global $environment_data (mut i32) (i32.const 0)) + + (func $initialize_env + (local $buffer i32) (local $res i32) (local $env i32) (local $data i32) + (if (i32.eqz (global.get $environment)) + (then + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $environ_sizes_get + (local.get $buffer) + (i32.add (local.get $buffer) (i32.const 4)))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (local.set $env + (call $checked_malloc + (i32.shl (i32.load (local.get $buffer)) (i32.const 2)))) + (local.set $data + (call $checked_malloc (i32.load offset=4 (local.get $buffer)))) + (local.set $res + (call $environ_get (local.get $env) (local.get $data))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (global.set $environment (local.get $env)) + (global.set $environment_data (local.get $data)) + (global.set $environment_count (i32.load (local.get $buffer)))))) + + (func $caml_getenv + (param $name (ref eq)) (result eqref) + (local $var (ref $bytes)) (local $i i32) (local $j i32) + (local $len i32) (local $s i32) (local $c i32) + (call $initialize_env) + (local.set $var (ref.cast (ref $bytes) (local.get $name))) + (local.set $len (array.len (local.get $var))) + (block $not_found + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (br_if $not_found + (i32.eq (i32.const 61) ;; '=' + (array.get_u $bytes (local.get $var) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (local.set $i (i32.const 0)) + (loop $loop + (if (i32.lt_u (local.get $i) (global.get $environment_count)) + (then + (local.set $s + (i32.load + (i32.add (global.get $environment) + (i32.shl (local.get $i) (i32.const 2))))) + (local.set $j (i32.const 0)) + (block $next + (loop $scan + (if (i32.lt_u (local.get $j) (local.get $len)) + (then + (local.set $c + (i32.load8_u + (i32.add (local.get $s) (local.get $j)))) + (br_if $next (i32.eqz (local.get $c))) + (br_if $next + (i32.ne (local.get $c) + (array.get $bytes + (local.get $var) (local.get $j)))) + (local.set $j + (i32.add (local.get $j) (i32.const 1))) + (br $scan)))) + (br_if $next + (i32.ne (i32.const 61) ;; '=' + (i32.load8_u + (i32.add (local.get $s) (local.get $j))))) + (local.set $s + (i32.add (local.get $s) + (i32.add (local.get $j) (i32.const 1)))) + (return_call $blit_memory_to_string + (local.get $s) (call $strlen (local.get $s)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + (ref.null eq)) +) +(@else + (func $caml_getenv + (param (ref eq)) (result eqref) (local $res anyref) (local.set $res (call $getenv (call $unwrap (call $caml_jsstring_of_string (local.get 0))))) (if (i32.eqz (call $jsstring_test (local.get $res))) + (then (return (ref.null eq)))) + (return_call $caml_string_of_jsstring (call $wrap (local.get $res)))) +)) + + (func (export "caml_sys_getenv") (export "caml_sys_unsafe_getenv") + (param $name (ref eq)) (result (ref eq)) + (local $res eqref) + (local.set $res (call $caml_getenv (local.get $name))) + (if (ref.is_null (local.get $res)) (then (call $caml_raise_not_found))) - (return_call $caml_string_of_jsstring (call $wrap (local.get $res)))) + (ref.as_non_null (local.get $res))) (func (export "caml_sys_getenv_opt") - (param (ref eq)) (result (ref eq)) - (local $res anyref) - (local.set $res - (call $getenv - (call $unwrap (call $caml_jsstring_of_string (local.get 0))))) - (if (i32.eqz (call $jsstring_test (local.get $res))) + (param $name (ref eq)) (result (ref eq)) + (local $res eqref) + (local.set $res (call $caml_getenv (local.get $name))) + (if (ref.is_null (local.get $res)) (then (return (ref.i31 (i32.const 0))))) (array.new_fixed $block 2 (ref.i31 (i32.const 0)) - (call $caml_string_of_jsstring (call $wrap (local.get $res))))) + (ref.as_non_null (local.get $res)))) +(@if wasi +(@then + (global $argv (mut (ref null $block)) (ref.null $block)) + + (func $caml_sys_argv (export "caml_sys_argv") + (param (ref eq)) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local $argc i32) (local $argv i32) (local $argv_buf i32) + (local $args (ref $block)) (local $arg i32) (local $i i32) + (block $init + (return (br_on_null $init (global.get $argv)))) + (block $error + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $args_sizes_get + (local.get $buffer) + (i32.add (local.get $buffer) (i32.const 4)))) + (br_if $error (local.get $res)) + (local.set $argc (i32.load (local.get $buffer))) + (local.set $argv + (call $checked_malloc (i32.shl (local.get $argc) (i32.const 2)))) + (local.set $argv_buf + (call $checked_malloc (i32.load offset=4 (local.get $buffer)))) + (local.set $res + (call $args_get (local.get $argv) (local.get $argv_buf))) + (br_if $error (local.get $res)) + (local.set $args + (array.new $block (ref.i31 (i32.const 0)) + (i32.add (local.get $argc) (i32.const 1)))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $argc)) + (then + (local.set $arg + (i32.load + (i32.add (local.get $argv) + (i32.shl (local.get $i) (i32.const 2))))) + (array.set $block (local.get $args) + (i32.add (local.get $i) (i32.const 1)) + (call $blit_memory_to_string + (local.get $arg) (call $strlen (local.get $arg)))) + (local.set $i + (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (global.set $argv (local.get $args)) + (call $free (local.get $argv)) + (call $free (local.get $argv_buf)) + (return (local.get $args))) + (call $caml_handle_sys_error (ref.i31 (i32.const 0)) (local.get $res)) + (array.new_fixed $block 0)) + + (func (export "caml_sys_executable_name") + (param (ref eq)) (result (ref eq)) + (array.get $block + (ref.cast (ref $block) (call $caml_sys_argv (ref.i31 (i32.const 0)))) + (i32.const 1))) +) +(@else (func (export "caml_sys_argv") (param (ref eq)) (result (ref eq)) ;; ZZZ (call $caml_js_to_string_array (call $argv))) @@ -95,18 +279,51 @@ (array.get $block (ref.cast (ref $block) (call $caml_js_to_string_array (call $argv))) (i32.const 1))) +)) (func (export "caml_sys_proc_self_exe") (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) +(@if wasi +(@then + (func (export "caml_sys_time") (export "caml_sys_time_include_children") + (param (ref eq)) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $clock_time_get (i32.const 2) (i64.const 1) (local.get $buffer))) + ;; wasmtime does not support the CPU-time clock, so use the + ;; monotonic clock instead as a fallback + (if (i32.eq (local.get $res) (i32.const 8)) + (then + (local.set $res + (call $clock_time_get + (i32.const 1) (i64.const 1) (local.get $buffer))))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (struct.new $float + (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer))) + (f64.const 1e-9)))) +) +(@else (func (export "caml_sys_time") (export "caml_sys_time_include_children") (param (ref eq)) (result (ref eq)) (struct.new $float (f64.mul (call $time) (f64.const 0.001)))) +)) +(@if wasi +(@then + (func (export "caml_sys_system_command") + (param (ref eq)) (result (ref eq)) + (call $caml_invalid_argument (@string "Sys.command not implemented")) + (return (ref.i31 (i32.const 0)))) +) +(@else (func (export "caml_sys_system_command") (param (ref eq)) (result (ref eq)) - ;; ZZZ (try (do (return @@ -115,7 +332,40 @@ (catch $javascript_exception (call $caml_handle_sys_error (pop externref)))) (return (ref.i31 (i32.const 0)))) +)) +(@if wasi +(@then + (func (export "caml_sys_random_seed") + (param (ref eq)) (result (ref eq)) + (local $r (ref extern)) + (local $a (ref $block)) + (local $i i32) (local $n i32) + (local $buffer i32) (local $res i32) + (local.set $n (i32.const 12)) + (local.set $buffer (call $get_buffer)) + (local.set $res (call $random_get (local.get $buffer) (i32.const 96))) + (if (local.get $res) + (then + (call $caml_handle_sys_error + (ref.i31 (i32.const 0)) (local.get $res)))) + (local.set $a + (array.new $block (ref.i31 (i32.const 0)) + (i32.add (local.get $n) (i32.const 1)))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $n)) + (then + (array.set $block + (local.get $a) (i32.add (local.get $i) (i32.const 1)) + (ref.i31 + (i32.load + (i32.add (local.get $buffer) + (i32.shl (local.get $i) (i32.const 2)))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (local.get $a)) +) +(@else (func (export "caml_sys_random_seed") (param (ref eq)) (result (ref eq)) (local $r (ref extern)) @@ -135,6 +385,7 @@ (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (local.get $a)) +)) (func (export "caml_sys_const_bigendian") (param (ref eq)) (result (ref eq)) @@ -152,6 +403,12 @@ (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0xfffffff))) +(@if wasi +(@then + (global $on_windows i32 (i32.const 0)) + (global $on_arm64 i32 (i32.const 0)) +)) + (func (export "caml_sys_const_ostype_unix") (param (ref eq)) (result (ref eq)) (ref.i31 (i32.eqz (global.get $on_windows)))) @@ -197,9 +454,17 @@ (ref.i31 (i32.const 32)) (ref.i31 (i32.const 0)))) +(@if wasi +(@then + (func (export "caml_sys_isatty") + (param $ch (ref eq)) (result (ref eq)) + (ref.i31 (i32.const 0))) +) +(@else (func (export "caml_sys_isatty") (param $ch (ref eq)) (result (ref eq)) (return_call $isatty (call $caml_channel_descriptor (local.get $ch)))) +)) (func (export "caml_sys_const_runtime5") (param (ref eq)) (result (ref eq)) @@ -241,6 +506,28 @@ (@string $toString "toString") +(@if wasi +(@then + (func $caml_handle_sys_error (export "caml_handle_sys_error") + (param $arg (ref eq)) (param $errno i32) + (local $msg (ref eq)) + (local.set $msg + (if (result (ref eq)) (i32.gt_u (local.get $errno) + (array.len (global.get $error_messages))) + (then + (@string "unknown system error")) + (else + (array.get $block (global.get $error_messages) + (local.get $errno))))) + (if (ref.test (ref $bytes) (local.get $arg)) + (then + (local.set $msg + (call $caml_string_concat (local.get $arg) + (call $caml_string_concat (@string ": ") (local.get $msg)))))) + (call $caml_raise_sys_error (local.get $msg)) + ) +) +(@else (func $caml_handle_sys_error (export "caml_handle_sys_error") (param $exn externref) (call $caml_raise_sys_error @@ -249,4 +536,5 @@ (call $wrap (any.convert_extern (local.get $exn))) (global.get $toString) (array.new_fixed $block 1 (ref.i31 (i32.const 0))))))) +)) ) diff --git a/runtime/wasm/toplevel.wat b/runtime/wasm/toplevel.wat index 22099d4023..e72d6138bc 100644 --- a/runtime/wasm/toplevel.wat +++ b/runtime/wasm/toplevel.wat @@ -16,6 +16,8 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module +(@if (not wasi) +(@then (import "stdlib" "caml_global_data" (global $caml_global_data (mut (ref $block)))) (import "stdlib" "link_info" @@ -284,5 +286,5 @@ (call $caml_failwith (@string "caml_invoke_traced_function: not available in Wasm")) (unreachable)) - +)) ) diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat index 61b313ba22..71ed24a778 100644 --- a/runtime/wasm/unix.wat +++ b/runtime/wasm/unix.wat @@ -16,6 +16,73 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module +(@if wasi +(@then + (import "wasi_snapshot_preview1" "clock_time_get" + (func $clock_time_get (param i32 i64 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_filestat_get" + (func $path_filestat_get (param i32 i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_rename" + (func $path_rename (param i32 i32 i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_link" + (func $path_link (param i32 i32 i32 i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_symlink" + (func $path_symlink (param i32 i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_readlink" + (func $path_readlink (param i32 i32 i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_create_directory" + (func $path_create_directory (param i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_unlink_file" + (func $path_unlink_file (param i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_remove_directory" + (func $path_remove_directory (param i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_open" + (func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "path_filestat_set_times" + (func $path_filestat_set_times + (param i32 i32 i32 i32 i64 i64 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_filestat_get" + (func $fd_filestat_get (param i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_filestat_set_size" + (func $fd_filestat_set_size (param i32 i64) (result i32))) + (import "wasi_snapshot_preview1" "fd_write" + (func $fd_write (param i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_read" + (func $fd_read (param i32 i32 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_seek" + (func $fd_seek (param i32 i64 i32 i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_sync" + (func $fd_sync (param i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_close" + (func $fd_close (param i32) (result i32))) + (import "wasi_snapshot_preview1" "fd_readdir" + (func $fd_readddir (param i32 i32 i32 i64 i32) (result i32))) + (import "libc" "memory" (memory 2)) + (import "libc" "free" (func $free (param i32))) + (import "libc" "gmtime" (func $gmtime (param i32) (result i32))) + (import "libc" "localtime" (func $localtime (param i32) (result i32))) + (import "libc" "mktime" (func $mktime (param i32) (result i64))) + (import "wasi_memory" "checked_malloc" + (func $checked_malloc (param i32) (result i32))) + (import "wasi_memory" "get_buffer" (func $get_buffer (result i32))) + (import "wasi_memory" "write_string_to_memory" + (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32))) + (import "wasi_memory" "blit_memory_to_string" + (func $blit_memory_to_string (param i32 i32) (result (ref $bytes)))) + (import "wasi_memory" "blit_memory_to_substring" + (func $blit_memory_to_substring (param i32 (ref $bytes) i32 i32))) + (import "wasi_memory" "blit_substring_to_memory" + (func $blit_substring_to_memory (param i32 (ref $bytes) i32 i32))) + (import "fs" "wasi_resolve_path" + (func $wasi_resolve_path (param (ref eq)) (result i32 i32 i32))) + (import "fs" "wasi_chdir" (func $wasi_chdir (param (ref eq)))) + (import "wasi_errors" "error_messages" (global $error_messages (ref $block))) + (import "ints" "caml_format_int" + (func $caml_format_int (param (ref eq) (ref eq)) (result (ref eq)))) + (import "string" "caml_string_concat" + (func $caml_string_concat (param (ref eq) (ref eq)) (result (ref eq)))) +) +(@else (import "bindings" "gettimeofday" (func $gettimeofday (result f64))) (import "bindings" "times" (func $times (result (ref eq)))) (import "bindings" "gmtime" (func $gmtime (param f64) (result (ref eq)))) @@ -80,6 +147,7 @@ (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq)))) (import "jsstring" "jsstring_test" (func $jsstring_test (param anyref) (result i32))) +)) (import "stdlib" "caml_named_value" (func $caml_named_value (param (ref eq)) (result (ref null eq)))) (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) @@ -149,6 +217,102 @@ (@string $no_arg "") +(@if wasi +(@then + (func $unix_resolve_path (export "unix_resolve_path") + (param $cmd (ref eq)) (param $path (ref eq)) (result i32 i32 i32) + (local $res (tuple i32 i32 i32)) + (local.set $res (call $wasi_resolve_path (local.get $path))) + (if (i32.lt_s (tuple.extract 3 0 (local.get $res)) (i32.const 0)) + (then + (call $caml_unix_error + (i32.const 44) ;; ENOENT + (local.get $cmd) (local.get $path)))) + (local.get $res)) + + (type $constr_table (array i8)) + (global $error_codes (ref $constr_table) + (array.new_fixed $constr_table 77 + (i32.const -1) + (i32.const 0) (i32.const 1) (i32.const 50) (i32.const 51) + (i32.const 49) (i32.const 2) (i32.const 39) (i32.const 3) + (i32.const -1) (i32.const 4) (i32.const -1) (i32.const 5) + (i32.const 55) (i32.const 63) (i32.const 56) (i32.const 6) + (i32.const 41) (i32.const 7) (i32.const -1) (i32.const 8) + (i32.const 9) (i32.const 10) (i32.const 65) (i32.const -1) + (i32.const -1) (i32.const 38) (i32.const 11) (i32.const 12) + (i32.const 13) (i32.const 58) (i32.const 14) (i32.const 66) + (i32.const 15) (i32.const 16) (i32.const 42) (i32.const -1) + (i32.const 17) (i32.const 52) (i32.const 54) (i32.const 53) + (i32.const 18) (i32.const 57) (i32.const 19) (i32.const 20) + (i32.const 21) (i32.const 22) (i32.const -1) (i32.const 23) + (i32.const -1) (i32.const 44) (i32.const 24) (i32.const 25) + (i32.const 59) (i32.const 26) (i32.const 27) (i32.const -1) + (i32.const 40) (i32.const 47) (i32.const 28) (i32.const 29) + (i32.const 67) (i32.const -1) (i32.const 30) (i32.const 31) + (i32.const -1) (i32.const 45) (i32.const 43) (i32.const 32) + (i32.const 33) (i32.const 34) (i32.const 35) (i32.const -1) + (i32.const 62) (i32.const -1) (i32.const 36) (i32.const -1))) + + (func $caml_unix_error_of_code (param $errcode i32) (result (ref eq)) + (local $err i32) + (if (i32.le_u (local.get $errcode) (i32.const 76)) + (then + (local.set $err + (array.get_s $constr_table (global.get $error_codes) + (local.get $errcode))) + (if (i32.ne (local.get $err) (i32.const -1)) + (then + (return (ref.i31 (local.get $err))))))) + (array.new_fixed $block 2 + (ref.i31 (i32.const 0)) (ref.i31 (local.get $errcode)))) + + (func $caml_unix_error + (param $errcode i32) (param $cmd_name (ref eq)) (param $cmd_arg (ref eq)) + (throw $ocaml_exception + (array.new_fixed $block 5 + (ref.i31 (i32.const 0)) + (call $get_unix_error_exn) + (call $caml_unix_error_of_code (local.get $errcode)) + (local.get $cmd_name) + (local.get $cmd_arg)))) + + (func (export "unix_error_message") (export "caml_unix_error_message") + (param $err (ref eq)) (result (ref eq)) + (local $errcode i32) (local $i i32) (local $n i32) + (if (ref.test (ref i31) (local.get $err)) + (then + (local.set $n (i31.get_u (ref.cast (ref i31) (local.get $err)))) + (loop $loop + (if (i32.lt_u (local.get $errcode) + (array.len (global.get $error_codes))) + (then + (if (i32.ne (local.get $n) + (array.get $constr_table (global.get $error_codes) + (local.get $errcode))) + (then + (local.set $errcode + (i32.add (local.get $errcode) (i32.const 1))) + (br $loop)))) + (else + (local.set $errcode (i32.const -1)))))) + (else + (local.set $errcode + (i31.get_u + (ref.cast (ref i31) + (array.get $block + (ref.cast (ref $block) (local.get $err)) + (i32.const 1))))))) + (if (i32.gt_u (local.get $errcode) + (array.len (global.get $error_messages))) + (then + (return_call $caml_string_concat + (@string "Unknown error ") + (call $caml_format_int (@string "%d") + (ref.i31 (local.get $errcode)))))) + (array.get $block (global.get $error_messages) (local.get $errcode))) +) +(@else (global $unix_error (ref eq) (struct.new $js (global.get $unix_error_js))) (func $ensure_string (param $s (ref eq)) (result (ref eq)) @@ -228,11 +392,59 @@ (i32.const 1)))))))) (return_call $caml_string_of_jsstring (call $wrap (call $caml_strerror (local.get $errno))))) +)) +(@if wasi +(@then + (func (export "unix_gettimeofday") (export "caml_unix_gettimeofday") + (param (ref eq)) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $clock_time_get + (i32.const 0) (i64.const 1000) (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "gettimeofday") (global.get $no_arg)))) + (struct.new $float + (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer))) + (f64.const 1e-9)))) +) +(@else (func (export "unix_gettimeofday") (export "caml_unix_gettimeofday") (param (ref eq)) (result (ref eq)) (struct.new $float (call $gettimeofday))) +)) +(@if wasi +(@then + (func (export "unix_times") (export "caml_unix_times") + (param (ref eq)) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $clock_time_get + (i32.const 2) (i64.const 1) (local.get $buffer))) + ;; wasmtime does not support the CPU-time clock, so use the + ;; monotonic clock instead as a fallback + (if (i32.eq (local.get $res) (i32.const 8)) + (then + (local.set $res + (call $clock_time_get + (i32.const 1) (i64.const 1) (local.get $buffer))))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) + (@string "time") + (global.get $no_arg)))) + (array.new_fixed $float_array 4 + (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer))) + (f64.const 1e-9)) + (f64.const 0) (f64.const 0) (f64.const 0))) +) +(@else (func (export "caml_alloc_times") (param $u f64) (param $s f64) (result (ref eq)) (array.new_fixed $float_array 4 @@ -241,7 +453,24 @@ (func (export "unix_times") (export "caml_unix_times") (param (ref eq)) (result (ref eq)) (return_call $times)) +)) +(@if wasi +(@then + (func $alloc_tm (param $tm i32) (result (ref eq)) + (array.new_fixed $block 10 (ref.i31 (i32.const 0)) + (ref.i31 (i32.load (local.get $tm))) + (ref.i31 (i32.load offset=4 (local.get $tm))) + (ref.i31 (i32.load offset=8 (local.get $tm))) + (ref.i31 (i32.load offset=12 (local.get $tm))) + (ref.i31 (i32.load offset=16 (local.get $tm))) + (ref.i31 (i32.load offset=20 (local.get $tm))) + (ref.i31 (i32.load offset=24 (local.get $tm))) + (ref.i31 (i32.load offset=28 (local.get $tm))) + (ref.i31 (select (i32.const 1) (i32.const 0) + (i32.load offset=32 (local.get $tm)))))) +) +(@else (func (export "caml_alloc_tm") (param $sec i32) (param $min i32) (param $hour i32) (param $mday i32) (param $mon i32) (param $year i32) (param $wday i32) (param $yday i32) @@ -256,21 +485,131 @@ (ref.i31 (local.get $wday)) (ref.i31 (local.get $yday)) (ref.i31 (local.get $isdst)))) +)) +(@if wasi +(@then + (func (export "caml_unix_gmtime") (export "unix_gmtime") + (param $t (ref eq)) (result (ref eq)) + (local $buffer i32) (local $tm i32) + (local.set $buffer (call $get_buffer)) + (i64.store (local.get $buffer) + (i64.trunc_sat_f64_s + (struct.get $float 0 (ref.cast (ref $float) (local.get $t))))) + (local.set $tm (call $gmtime (local.get $buffer))) + (if (i32.eqz (local.get $tm)) + (then + (call $caml_unix_error (i32.const 28) (; EINVAL ;) + (@string "gmtime") (global.get $no_arg)))) + (return_call $alloc_tm (local.get $tm))) +) +(@else (func (export "caml_unix_gmtime") (export "unix_gmtime") (param (ref eq)) (result (ref eq)) (call $gmtime (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))) +)) +(@if wasi +(@then + (func (export "caml_unix_localtime") (export "unix_localtime") + (param $t (ref eq)) (result (ref eq)) + (local $buffer i32) (local $tm i32) + (local.set $buffer (call $get_buffer)) + (i64.store (local.get $buffer) + (i64.trunc_sat_f64_s + (struct.get $float 0 (ref.cast (ref $float) (local.get $t))))) + (local.set $tm (call $localtime (local.get $buffer))) + (if (i32.eqz (local.get $tm)) + (then + (call $caml_unix_error (i32.const 28) (; EINVAL ;) + (@string "localtime") (global.get $no_arg)))) + (return_call $alloc_tm (local.get $tm))) +) +(@else (func (export "caml_unix_localtime") (export "unix_localtime") (param (ref eq)) (result (ref eq)) (call $localtime (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))) +)) +(@if wasi +(@then + (func (export "caml_unix_time") (export "unix_time") (param (ref eq)) + (result (ref eq)) + (local $buffer i32) (local $res i32) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $clock_time_get + (i32.const 0) (i64.const 1000) (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "time") (global.get $no_arg)))) + (struct.new $float + (f64.floor + (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer))) + (f64.const 1e-9))))) +) +(@else (func (export "caml_unix_time") (export "unix_time") (param (ref eq)) (result (ref eq)) (struct.new $float (f64.floor (call $gettimeofday)))) +)) +(@if wasi +(@then + (func (export "caml_unix_mktime") (export "unix_mktime") + (param $v (ref eq)) (result (ref eq)) + (local $t (ref $block)) (local $tm i32) (local $time i64) + (local.set $t (ref.cast (ref $block) (local.get $v))) + (local.set $tm (call $get_buffer)) + (i32.store (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 1))))) + (i32.store offset=4 (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 2))))) + (i32.store offset=8 (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 3))))) + (i32.store offset=12 (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 4))))) + (i32.store offset=16 (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 5))))) + (i32.store offset=20 (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 6))))) + (i32.store offset=24 (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 7))))) + (i32.store offset=28 (local.get $tm) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $t) (i32.const 8))))) + (i32.store offset=32 (local.get $tm) + (i32.const -1)) + (local.set $time (call $mktime (local.get $tm))) + (if (i64.eq (local.get $time) (i64.const -1)) + (then + (call $caml_unix_error + (i32.const 68) (; ERANGE ;) + (@string "mktime") (global.get $no_arg)))) + (array.new_fixed $block 3 + (ref.i31 (i32.const 0)) + (struct.new $float (f64.convert_i64_s (local.get $time))) + (call $alloc_tm (local.get $tm)))) +) +(@else (func (export "caml_unix_mktime") (export "unix_mktime") (param (ref eq)) (result (ref eq)) (local $tm (ref $block)) (local $t f64) @@ -302,7 +641,53 @@ (array.new_fixed $block 3 (ref.i31 (i32.const 0)) (struct.new $float (local.get $t)) (call $localtime (local.get $t)))) +)) + +(@if wasi +(@then + (@string $utimes "utimes") + (func (export "unix_utimes") (export "caml_unix_utimes") + (param $path (ref eq)) (param $atime (ref eq)) (param $mtime (ref eq)) + (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $atim i64) (local $mtim i64) + (local $set_to_now i32) (local $res i32) + (local $at f64) (local $mt f64) + (local.set $p + (call $unix_resolve_path (global.get $utimes) (local.get $path))) + (local.set $at + (struct.get $float 0 (ref.cast (ref $float) (local.get $atime)))) + (local.set $mt + (struct.get $float 0 (ref.cast (ref $float) (local.get $mtime)))) + (local.set $set_to_now + (i32.and (f64.eq (local.get $at) (f64.const 0)) + (f64.eq (local.get $mt) (f64.const 0)))) + (if (i32.eqz (local.get $set_to_now)) + (then + (local.set $atim + (i64.trunc_sat_f64_s + (f64.mul (local.get $at) (f64.const 1e9)))) + (local.set $mtim + (i64.trunc_sat_f64_s + (f64.mul (local.get $mt) (f64.const 1e9)))))) + (local.set $res + (call $path_filestat_set_times + (tuple.extract 3 0 (local.get $p)) + (i32.const 0) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $atim) + (local.get $mtim) + (i32.shl (i32.const 5) (local.get $set_to_now)))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $utimes) (local.get $path)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_utimes") (export "caml_unix_utimes") (param $path (ref eq)) (param $atime (ref eq)) (param $mtime (ref eq)) (result (ref eq)) @@ -324,6 +709,48 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (global $file_kinds (ref $constr_table) + (array.new_fixed $constr_table 8 + (i32.const 3) + (i32.const 3) + (i32.const 2) + (i32.const 1) + (i32.const 0) + (i32.const 6) + (i32.const 6) + (i32.const 4))) + + (func $alloc_stat (param $large i32) (param $p i32) (result (ref eq)) + (array.new_fixed $block 13 (ref.i31 (i32.const 0)) + (ref.i31 (i32.wrap_i64 (i64.load (local.get $p)))) + (ref.i31 (i32.wrap_i64 (i64.load offset=8 (local.get $p)))) + (ref.i31 + (array.get $constr_table + (global.get $file_kinds) (i32.load8_u offset=16 (local.get $p)))) + (ref.i31 (i32.const 384 (;0600;))) + (ref.i31 (i32.wrap_i64 (i64.load offset=24 (local.get $p)))) + (ref.i31 (i32.const 1)) + (ref.i31 (i32.const 1)) + (ref.i31 (i32.wrap_i64 (i64.load (local.get $p)))) + (if (result (ref eq)) (local.get $large) + (then + (call $caml_copy_int64 (i64.load offset=32 (local.get $p)))) + (else + (ref.i31 (i32.wrap_i64 (i64.load offset=32 (local.get $p)))))) + (struct.new $float + (f64.mul (f64.const 1e-9) + (f64.convert_i64_s (i64.load offset=40 (local.get $p))))) + (struct.new $float + (f64.mul (f64.const 1e-9) + (f64.convert_i64_s (i64.load offset=48 (local.get $p))))) + (struct.new $float + (f64.mul (f64.const 1e-9) + (f64.convert_i64_s (i64.load offset=56 (local.get $p))))))) +)) (func (export "caml_alloc_stat") (param $large i32) @@ -349,6 +776,76 @@ (struct.new $float (local.get $mtime)) (struct.new $float (local.get $ctime)))) +(@if wasi +(@then + (func $stat + (param $path (ref eq)) (param $large i32) (param $follow i32) + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $buffer i32) (local $res i32) + (local.set $p + (call $unix_resolve_path (local.get $name) (local.get $path))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_filestat_get + (tuple.extract 3 0 (local.get $p)) + (local.get $follow) ;; symlink_follow + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (local.get $name) (local.get $path)))) + (return_call $alloc_stat (local.get $large) (local.get $buffer))) + + (@string $stat "stat") + + (func (export "unix_stat") (export "caml_unix_stat") + (param $path (ref eq)) (result (ref eq)) + (return_call $stat + (local.get $path) (i32.const 0) (i32.const 1) (global.get $stat))) + + (func (export "unix_stat_64") (export "caml_unix_stat_64") + (param $path (ref eq)) (result (ref eq)) + (return_call $stat + (local.get $path) (i32.const 1) (i32.const 1) (global.get $stat))) + + (@string $lstat "lstat") + + (func (export "unix_lstat") (export "caml_unix_lstat") + (param $path (ref eq)) (result (ref eq)) + (return_call $stat + (local.get $path) (i32.const 0) (i32.const 0) (global.get $lstat))) + + (func (export "unix_lstat_64") (export "caml_unix_lstat_64") + (param $path (ref eq)) (result (ref eq)) + (return_call $stat + (local.get $path) (i32.const 1) (i32.const 0) (global.get $lstat))) + + (func $fstat (param $fd (ref eq)) (param $large i32) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $fd_filestat_get + (i31.get_u (ref.cast (ref i31) (local.get $fd))) + (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "fstat") (global.get $no_arg)))) + (return_call $alloc_stat (local.get $large) (local.get $buffer))) + + (func (export "unix_fstat") (export "caml_unix_fstat") + (param $fd (ref eq)) (result (ref eq)) + (return_call $fstat (local.get $fd) (i32.const 0))) + + (func (export "unix_fstat_64") (export "caml_unix_fstat_64") + (param $fd (ref eq)) (result (ref eq)) + (return_call $fstat (local.get $fd) (i32.const 1))) +) +(@else (func (export "unix_stat") (export "caml_unix_stat") (param $path (ref eq)) (result (ref eq)) (try (result (ref eq)) @@ -410,7 +907,16 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)) (ref.i31 (i32.const 0))))) +)) +(@if wasi +(@then + (func (export "unix_chmod") (export "caml_unix_chmod") + (param (ref eq) (ref eq)) (result (ref eq)) + ;; no notion of permissions in WASI + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_chmod") (export "caml_unix_chmod") (param $path (ref eq)) (param $perms (ref eq)) (result (ref eq)) (try @@ -421,7 +927,16 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (func (export "unix_fchmod") (export "caml_unix_fchmod") + (param (ref eq) (ref eq)) (result (ref eq)) + ;; no notion of permissions in WASI + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_fchmod") (export "caml_unix_fchmod") (param $fd (ref eq)) (param $perms (ref eq)) (result (ref eq)) (try @@ -430,7 +945,38 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (@string $rename "rename") + (func (export "unix_rename") (export "caml_unix_rename") + (param $o (ref eq)) (param $n (ref eq)) (result (ref eq)) + (local $op (tuple i32 i32 i32)) + (local $np (tuple i32 i32 i32)) + (local $res i32) + (local.set $op + (call $unix_resolve_path (global.get $rename) (local.get $o))) + (local.set $np + (call $unix_resolve_path (global.get $rename) (local.get $n))) + (local.set $res + (call $path_rename + (tuple.extract 3 0 (local.get $op)) + (tuple.extract 3 1 (local.get $op)) + (tuple.extract 3 2 (local.get $op)) + (tuple.extract 3 0 (local.get $np)) + (tuple.extract 3 1 (local.get $np)) + (tuple.extract 3 2 (local.get $np)))) + (call $free (tuple.extract 3 1 (local.get $op))) + (call $free (tuple.extract 3 1 (local.get $np))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $rename) (local.get $o)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_rename") (export "caml_unix_rename") (param $o (ref eq)) (param $n (ref eq)) (result (ref eq)) (try @@ -441,7 +987,40 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (@string $chdir "chdir") + (func (export "unix_chdir") (export "caml_unix_chdir") + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $buffer i32) (local $res i32) (local $kind i32) + (local.set $p + (call $unix_resolve_path (global.get $chdir) (local.get $name))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_filestat_get + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $chdir) (local.get $name)))) + (local.set $kind (i32.load8_u offset=16 (local.get $buffer))) + (if (i32.ne (local.get $kind) (i32.const 3)) + (then + (call $caml_unix_error (i32.const 54) ;; ENOTDIR + (global.get $chdir) (local.get $name)))) + (call $wasi_chdir (local.get $name)) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_getcwd") (export "caml_unix_getcwd") (param (ref eq)) (result (ref eq)) (try (result (ref eq)) @@ -460,7 +1039,31 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (@string $mkdir "mkdir") + (func (export "unix_mkdir") (export "caml_unix_mkdir") + (param $path (ref eq)) (param $perm (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) + (local.set $p + (call $unix_resolve_path (global.get $mkdir) (local.get $path))) + (local.set $res + (call $path_create_directory + (tuple.extract 3 0 (local.get $p)) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $mkdir) (local.get $path)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_mkdir") (export "caml_unix_mkdir") (param $name (ref eq)) (param $perm (ref eq)) (result (ref eq)) (try @@ -471,7 +1074,147 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (type $directory + (struct + (field $fd i32) + (field $buffer (mut i32)) + (field $size (mut i32)) + (field $pos (mut i32)) + (field $available (mut i32)) + (field $cookie (mut i64)))) + + (@string $opendir "opendir") + (func $unix_opendir (export "unix_opendir") (export "caml_unix_opendir") + (param $name (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $buffer i32) (local $res i32) + (local.set $p + (call $unix_resolve_path (global.get $opendir) (local.get $name))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_open + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) ;; symlink_follow + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (i32.const 2) ;; O_DIRECTORY + (i64.const 0x4000) ;; allow fd_readdir + (i64.const 0) + (i32.const 0) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $opendir) (local.get $name)))) + (struct.new $directory + (i32.load (local.get $buffer)) + (call $checked_malloc (i32.const 512)) + (i32.const 512) + (i32.const 0) + (i32.const 0) + (i64.const 0))) + + (func $readdir_helper + (param $vdir (ref eq)) (result (ref eq)) + (local $dir (ref $directory)) (local $buf i32) (local $res i32) + (local $buffer i32) (local $available i32) (local $left i32) + (local $namelen i32) (local $entry i32) (local $entry_size i32) + (local.set $dir (ref.cast (ref $directory) (local.get $vdir))) + (loop $loop + (block $refill + (local.set $left + (i32.sub (struct.get $directory $available (local.get $dir)) + (struct.get $directory $pos (local.get $dir)))) + (br_if $refill (i32.lt_u (local.get $left) (i32.const 24))) + (local.set $entry + (i32.add (struct.get $directory $buffer (local.get $dir)) + (struct.get $directory $pos (local.get $dir)))) + (local.set $namelen (i32.load offset=16 (local.get $entry))) + (local.set $entry_size (i32.add (local.get $namelen) (i32.const 24))) + (br_if $refill (i32.lt_u (local.get $left) (local.get $entry_size))) + (struct.set $directory $pos (local.get $dir) + (i32.add (struct.get $directory $pos (local.get $dir)) + (local.get $entry_size))) + (struct.set $directory $cookie (local.get $dir) + (i64.load (local.get $entry))) + (return_call $blit_memory_to_string + (i32.add (local.get $entry) (i32.const 24)) + (local.get $namelen))) + ;; refill + (if (i32.lt_u (struct.get $directory $size (local.get $dir)) + (local.get $entry_size)) + (then + ;; the entry does not fit + (local.set $buf (call $checked_malloc (local.get $entry_size))) + (call $free (struct.get $directory $buffer (local.get $dir))) + (struct.set $directory $buffer (local.get $dir) (local.get $buf)) + (struct.set $directory $size (local.get $dir) + (local.get $entry_size)))) + (block $done + (br_if $done + (i32.and + (i32.ne (i32.const 0) + (struct.get $directory $available (local.get $dir)) + (i32.lt_u (struct.get $directory $available (local.get $dir)) + (struct.get $directory $size (local.get $dir)))))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $fd_readddir + (struct.get $directory $fd (local.get $dir)) + (struct.get $directory $buffer (local.get $dir)) + (struct.get $directory $size (local.get $dir)) + (struct.get $directory $cookie (local.get $dir)) + (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "readdir") (global.get $no_arg)))) + (local.set $available (i32.load (local.get $buffer))) + (br_if $done (i32.eqz (local.get $available))) + (struct.set $directory $pos (local.get $dir) (i32.const 0)) + (struct.set $directory $available (local.get $dir) + (local.get $available)) + (br $loop))) + ;; done + (call $caml_raise_end_of_file) + (ref.i31 (i32.const 0))) + + (func $unix_closedir (export "unix_closedir") (export "caml_unix_closedir") + (param $vdir (ref eq)) (result (ref eq)) + (local $dir (ref $directory)) (local $buf i32) (local $res i32) + (local.set $dir (ref.cast (ref $directory) (local.get $vdir))) + (local.set $buf (struct.get $directory $buffer (local.get $dir))) + (block $error + (if (i32.eqz (local.get $buf)) + (then + (local.set $res (i32.const 8)) ;; EBADF + (br $error))) + (call $free (local.get $buf)) + (struct.set $directory $buffer (local.get $dir) (i32.const 0)) + (local.set $res + (call $fd_close (struct.get $directory $fd (local.get $dir)))) + (br_if $error (local.get $res)) + (return (ref.i31 (i32.const 0)))) + (call $caml_unix_error + (local.get $res) (@string "closedir") (global.get $no_arg)) + (ref.i31 (i32.const 0))) + + (func (export "unix_rewinddir") (export "caml_unix_rewinddir") + (param $vdir (ref eq)) (result (ref eq)) + (local $dir (ref $directory)) + (local.set $dir (ref.cast (ref $directory) (local.get $vdir))) + (struct.set $directory $cookie (local.get $dir) (i64.const 0)) + (struct.set $directory $pos (local.get $dir) (i32.const 0)) + (struct.set $directory $available (local.get $dir) (i32.const 0)) + (ref.i31 (i32.const 0))) +) +(@else (func $unix_opendir (export "unix_opendir") (export "caml_unix_opendir") (param $name (ref eq)) (result (ref eq)) (try (result (ref eq)) @@ -524,6 +1267,7 @@ (param (ref eq)) (result (ref eq)) (call $caml_invalid_argument (@string "rewinddir not implemented")) (ref.i31 (i32.const 0))) +)) (func (export "unix_readdir") (export "caml_unix_readdir") (param $dir (ref eq)) (result (ref eq)) @@ -556,6 +1300,29 @@ (call $win_find_next (local.get $dir)) (local.get $dir))) +(@if wasi +(@then + (@string $unlink "unlink") + + (func (export "unix_unlink") (export "caml_unix_unlink") + (param $path (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) + (local.set $p + (call $unix_resolve_path (global.get $unlink) (local.get $path))) + (local.set $res + (call $path_unlink_file + (tuple.extract 3 0 (local.get $p)) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $unlink) (local.get $path)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_unlink") (export "caml_unix_unlink") (param $p (ref eq)) (result (ref eq)) (try @@ -565,7 +1332,31 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (@string $rmdir "rmdir") + (func (export "unix_rmdir") (export "caml_unix_rmdir") + (param $path (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) + (local.set $p + (call $unix_resolve_path (global.get $rmdir) (local.get $path))) + (local.set $res + (call $path_remove_directory + (tuple.extract 3 0 (local.get $p)) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $rmdir) (local.get $path)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_rmdir") (export "caml_unix_rmdir") (param $p (ref eq)) (result (ref eq)) (try @@ -575,7 +1366,47 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (@string $link "link") + (func (export "unix_link") (export "caml_unix_link") + (param $follow (ref eq)) (param $o (ref eq)) (param $n (ref eq)) + (result (ref eq)) + (local $op (tuple i32 i32 i32)) + (local $np (tuple i32 i32 i32)) + (local $flags i32) + (local $res i32) + (local.set $op (call $unix_resolve_path (global.get $link) (local.get $o))) + (local.set $np (call $unix_resolve_path (global.get $link) (local.get $n))) + (if (ref.test (ref $block) (local.get $follow)) + (then + (local.set $flags + (i31.get_u + (ref.cast (ref i31) + (array.get $block + (ref.cast (ref $block) (local.get $follow)) + (i32.const 1))))))) + (local.set $res + (call $path_link + (tuple.extract 3 0 (local.get $op)) + (local.get $flags) + (tuple.extract 3 1 (local.get $op)) + (tuple.extract 3 2 (local.get $op)) + (tuple.extract 3 0 (local.get $np)) + (tuple.extract 3 1 (local.get $np)) + (tuple.extract 3 2 (local.get $np)))) + (call $free (tuple.extract 3 1 (local.get $op))) + (call $free (tuple.extract 3 1 (local.get $np))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $link) (local.get $o)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_link") (export "caml_unix_link") (param $follow (ref eq)) (param $d (ref eq)) (param $s (ref eq)) (result (ref eq)) @@ -596,11 +1427,48 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) (func (export "unix_has_symlink") (export "caml_unix_has_symlink") (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 1))) +(@if wasi +(@then + (@string $symlink "symlink") + + (func (export "unix_symlink") (export "caml_unix_symlink") + (param $to_dir (ref eq)) (param $o (ref eq)) (param $n (ref eq)) + (result (ref eq)) + (local $path (ref $bytes)) + (local $len i32) + (local $op i32) + (local $np (tuple i32 i32 i32)) + (local $flags i32) + (local $res i32) + (local.set $path (ref.cast (ref $bytes) (local.get $o))) + (local.set $len (array.len (local.get $path))) + (local.set $op + (call $write_string_to_memory + (i32.const 0) (i32.const 0) (local.get $path))) + (local.set $np + (call $unix_resolve_path (global.get $symlink) (local.get $n))) + (local.set $res + (call $path_symlink + (local.get $op) + (local.get $len) + (tuple.extract 3 0 (local.get $np)) + (tuple.extract 3 1 (local.get $np)) + (tuple.extract 3 2 (local.get $np)))) + (call $free (local.get $op)) + (call $free (tuple.extract 3 1 (local.get $np))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $symlink) (local.get $o)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_symlink") (export "caml_unix_symlink") (param $to_dir (ref eq)) (param $t (ref eq)) (param $p (ref eq)) (result (ref eq)) @@ -623,7 +1491,37 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (@string $readlink "readlink") + + (func (export "unix_readlink") (export "caml_unix_readlink") + (param $path (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $buffer i32) (local $buf i32) (local $res i32) + (local.set $p + (call $unix_resolve_path (global.get $readlink) (local.get $path))) + (local.set $buffer (call $get_buffer)) + (local.set $buf (i32.add (local.get $buffer) (i32.const 4))) + (local.set $res + (call $path_readlink + (tuple.extract 3 0 (local.get $p)) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $buf) + (global.get $IO_BUFFER_SIZE) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $readlink) (local.get $path)))) + (return_call $blit_memory_to_string + (local.get $buf) (i32.load (local.get $buffer)))) +) +(@else (func (export "unix_readlink") (export "caml_unix_readlink") (param $path (ref eq)) (result (ref eq)) (try @@ -636,7 +1534,60 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (@string $truncate "truncate") + + (func $truncate (param $path (ref eq)) (param $len i64) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $fd i32) (local $res i32) (local $buffer i32) + (block $error + (local.set $p + (call $unix_resolve_path (global.get $truncate) (local.get $path))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_open + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) ;; symlink_follow + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (i32.const 0) + (i64.const 0x400040) ;; allow fd_filestat_set_size and fd_write + (i64.const 0) + (i32.const 0) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (br_if $error (local.get $res)) + (local.set $fd (i32.load (local.get $buffer))) + (local.set $res + (call $fd_filestat_set_size (local.get $fd) (local.get $len))) + (if (local.get $res) + (then + (drop (call $fd_close (local.get $fd))) + (br $error))) + (local.set $res (call $fd_close (local.get $fd))) + (br_if $error (local.get $res)) + (return (ref.i31 (i32.const 0)))) + (call $caml_unix_error + (local.get $res) (global.get $truncate) (local.get $path)) + (return (ref.i31 (i32.const 0)))) + (func (export "unix_truncate") (export "caml_unix_truncate") + (param $path (ref eq)) (param $len (ref eq)) + (result (ref eq)) + (return_call $truncate (local.get $path) + (i64.extend_i32_s + (i31.get_s (ref.cast (ref i31) (local.get $len)))))) + + (func (export "unix_truncate_64") (export "caml_unix_truncate_64") + (param $path (ref eq)) (param $len (ref eq)) + (result (ref eq)) + (return_call $truncate (local.get $path) + (call $Int64_val (local.get $len)))) +) +(@else (func (export "unix_truncate") (export "caml_unix_truncate") (param $path (ref eq)) (param $len (ref eq)) (result (ref eq)) @@ -662,7 +1613,33 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (func $ftruncate (param $vfd (ref eq)) (param $len i64) (result (ref eq)) + (local $fd i32) (local $res i32) + (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd)))) + (local.set $res + (call $fd_filestat_set_size (local.get $fd) (local.get $len))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "ftruncate") (global.get $no_arg)))) + (ref.i31 (i32.const 0))) + (func (export "unix_ftruncate") (export "caml_unix_ftruncate") + (param $fd (ref eq)) (param $len (ref eq)) (result (ref eq)) + (return_call $ftruncate (local.get $fd) + (i64.extend_i32_s + (i31.get_s (ref.cast (ref i31) (local.get $len)))))) + + (func (export "unix_ftruncate_64") (export "caml_unix_ftruncate_64") + (param $fd (ref eq)) (param $len (ref eq)) (result (ref eq)) + (return_call $ftruncate (local.get $fd) + (call $Int64_val (local.get $len)))) +) +(@else (func (export "unix_ftruncate") (export "caml_unix_ftruncate") (param $fd (ref eq)) (param $vlen (ref eq)) (result (ref eq)) @@ -677,7 +1654,7 @@ (i64.extend_i32_s (i31.get_s (ref.cast (ref i31) (local.get $vlen))))) ;; node truncates to 0 without failure when $len < 0 - (if (i64.lt_s (local.get $len (i64.const 0))) + (if (i64.lt_s (local.get $len) (i64.const 0)) (then (local.set $len (i64.const 0)))) (local.set $fd_offset (call $get_fd_offset (i31.get_u (ref.cast (ref i31) (local.get $fd))))) @@ -701,7 +1678,7 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) ;; node truncates to 0 without failure when $len < 0 - (if (i64.lt_s (local.get $len (i64.const 0))) + (if (i64.lt_s (local.get $len) (i64.const 0)) (then (local.set $len (i64.const 0)))) (local.set $fd_offset (call $get_fd_offset (i31.get_u (ref.cast (ref i31) (local.get $fd))))) @@ -711,7 +1688,35 @@ (struct.set $fd_offset $offset (local.get $fd_offset) (local.get $len)))) (ref.i31 (i32.const 0))) +)) + +(@if wasi +(@then + (@string $access "access") + ;; We can only check that the file exists + (func (export "unix_access") (export "caml_unix_access") + (param $path (ref eq)) (param $flags (ref eq)) (result (ref eq)) + (local $p (tuple i32 i32 i32)) + (local $res i32) (local $buffer i32) + (local.set $p + (call $unix_resolve_path (global.get $access) (local.get $path))) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $path_filestat_get + (tuple.extract 3 0 (local.get $p)) + (i32.const 1) + (tuple.extract 3 1 (local.get $p)) + (tuple.extract 3 2 (local.get $p)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $p))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $access) (local.get $path)))) + (return (ref.i31 (i32.const 0)))) +) +(@else (global $access_flags (ref $flags) (array.new_fixed $flags 4 (i32.const 1) (i32.const 2) (i32.const 4) (i32.const 8))) @@ -730,8 +1735,69 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) + + (type $flags (array i16)) + +(@if wasi +(@then + ;; 0x1 O_RDONLY + ;; 0x2 O_WRONLY + ;; 0x3 O_RDWR + ;; 0x400 O_NONBLOCK + ;; 0x100 O_APPEND + ;; 0x10 O_CREAT + ;; 0x80 O_TRUNC + ;; 0x40 O_EXCL + ;; 0 O_NOCTTY + ;; 0x200 O_DSYNC + ;; 0x1000 O_SYNC + ;; 0x800 O_RSYNC + (global $unix_open_flags (ref $flags) + (array.new_fixed $flags 15 + (i32.const 1) (i32.const 2) (i32.const 3) (i32.const 0x400) + (i32.const 0x100) (i32.const 0x10) (i32.const 0x80) (i32.const 0x40) + (i32.const 0) (i32.const 0x200) (i32.const 0x1000) (i32.const 0x800) + (i32.const 0) (i32.const 0) (i32.const 0))) + + (@string $open "open") - (type $flags (array i8)) + (func (export "unix_open") (export "caml_unix_open") + (param $vpath (ref eq)) (param $vflags (ref eq)) (param $perm (ref eq)) + (result (ref eq)) + (local $flags i32) (local $offset i64) + (local $path (tuple i32 i32 i32)) + (local $res i32) (local $buffer i32) + (local.set $path + (call $unix_resolve_path (global.get $open) (local.get $vpath))) + (local.set $buffer (call $get_buffer)) + (local.set $flags + (call $convert_flag_list + (global.get $unix_open_flags) (local.get $vflags))) + (local.set $res + (call $path_open + (tuple.extract 3 0 (local.get $path)) + (i32.const 1) ;; symlink_follow + (tuple.extract 3 1 (local.get $path)) + (tuple.extract 3 2 (local.get $path)) + (i32.and (i32.shr_u (local.get $flags) (i32.const 4)) + (i32.const 0xF)) + (select + (i64.const 0x860007e) + (select (i64.const 0x860007c) (i64.const 0x820003e) + (i32.and (local.get $flags) (i32.const 2))) + (i32.eq (i32.and (local.get $flags) (i32.const 3)) (i32.const 3))) + (i64.const 0) + (i32.shr_u (local.get $flags) (i32.const 8)) + (local.get $buffer))) + (call $free (tuple.extract 3 1 (local.get $path))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (global.get $open) (local.get $vpath)))) + (ref.i31 (i32.load (local.get $buffer)))) +) +(@else ;; 1 O_RDONLY ;; 2 O_WRONLY ;; 4 O_RDWR @@ -771,6 +1837,7 @@ (call $caml_unix_error (pop externref) (ref.null eq)))) (call $initialize_fd_offset (local.get $fd) (local.get $offset)) (ref.i31 (local.get $fd))) +)) (global $io_buffer (mut externref) (ref.null extern)) (global $io_buffer_view (mut externref) (ref.null extern)) @@ -790,6 +1857,217 @@ (br_on_null $null (call $get_fd_offset_unchecked (local.get $fd))))) (struct.new $fd_offset (i64.const 0) (i32.const 0))) +(@if wasi +(@then + (func (export "unix_write") (export "caml_unix_write") + (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq)) + (param $vlen (ref eq)) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local $iovs i32) (local $iovs_len i32) (local $nwritten i32) + (local $fd i32) (local $s (ref $bytes)) + (local $pos i32) (local $len i32) (local $numbytes i32) + (local $written i32) (local $n i32) + (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd)))) + (local.set $s (ref.cast (ref $bytes) (local.get $vbuf))) + (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos)))) + (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen)))) + (local.set $buffer (call $get_buffer)) + (local.set $nwritten (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (i32.store (local.get $iovs) (local.get $buffer)) + (local.set $iovs_len (i32.const 1)) + (loop $loop + (if (i32.gt_u (local.get $len) (i32.const 0)) + (then + (local.set $numbytes + (select (global.get $IO_BUFFER_SIZE) (local.get $len) + (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE)))) + (call $blit_substring_to_memory + (local.get $buffer) (local.get $s) (local.get $pos) + (local.get $numbytes)) + (i32.store offset=4 (local.get $iovs) (local.get $numbytes)) + (local.set $res + (call $fd_write + (local.get $fd) (local.get $iovs) (local.get $iovs_len) + (local.get $nwritten))) + (if (local.get $res) + (then + (call $caml_unix_error (local.get $res) (@string "write") + (global.get $no_arg)))) + (local.set $n (i32.load (local.get $nwritten))) + (local.set $written (i32.add (local.get $written) (local.get $n))) + (local.set $pos (i32.add (local.get $pos) (local.get $n))) + (local.set $len (i32.sub (local.get $len) (local.get $n))) + (br $loop)))) + (ref.i31 (local.get $n))) + + (func (export "unix_single_write") (export "caml_unix_single_write") + (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq)) + (param $vlen (ref eq)) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local $iovs i32) (local $iovs_len i32) (local $nwritten i32) + (local $fd i32) (local $s (ref $bytes)) + (local $pos i32) (local $len i32) (local $numbytes i32) + (local $written i32) (local $n i32) + (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd)))) + (local.set $s (ref.cast (ref $bytes) (local.get $vbuf))) + (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos)))) + (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen)))) + (if (i32.eqz (local.get $len)) + (then (return (ref.i31 (i32.const 0))))) + (local.set $buffer (call $get_buffer)) + (local.set $nwritten (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (i32.store (local.get $iovs) (local.get $buffer)) + (local.set $iovs_len (i32.const 1)) + (local.set $numbytes + (select (global.get $IO_BUFFER_SIZE) (local.get $len) + (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE)))) + (call $blit_substring_to_memory + (local.get $buffer) (local.get $s) (local.get $pos) + (local.get $numbytes)) + (i32.store offset=4 (local.get $iovs) (local.get $numbytes)) + (local.set $res + (call $fd_write + (local.get $fd) (local.get $iovs) (local.get $iovs_len) + (local.get $nwritten))) + (if (local.get $res) + (then + (call $caml_unix_error (local.get $res) (@string "write") + (global.get $no_arg)))) + (ref.i31 (i32.load (local.get $nwritten)))) + + (func (export "unix_read") (export "caml_unix_read") + (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq)) + (param $vlen (ref eq)) (result (ref eq)) + (local $buffer i32) (local $res i32) + (local $iovs i32) (local $iovs_len i32) (local $nread i32) + (local $fd i32) (local $pos i32) (local $len i32) (local $n i32) + (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd)))) + (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos)))) + (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen)))) + (if (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE)) + (then + (local.set $len (global.get $IO_BUFFER_SIZE)))) + (local.set $buffer (call $get_buffer)) + (local.set $nread (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (i32.store (local.get $iovs) (local.get $buffer)) + (i32.store offset=4 (local.get $iovs) (local.get $len)) + (local.set $iovs_len (i32.const 1)) + (local.set $res + (call $fd_read + (local.get $fd) (local.get $iovs) (local.get $iovs_len) + (local.get $nread))) + (if (local.get $res) + (then + (call $caml_unix_error (local.get $res) (@string "read") + (global.get $no_arg)))) + (local.set $n (i32.load (local.get $nread))) + (call $blit_memory_to_substring (local.get $buffer) + (ref.cast (ref $bytes) (local.get $vbuf)) + (local.get $pos) (local.get $n)) + (ref.i31 (local.get $n))) + + (type $data + (struct + (field $array (ref array)) + (field $offset i32) + (field $len i32))) + + (func (export "unix_write_bigarray") (export "caml_unix_write_bigarray") + (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq)) + (param $vlen (ref eq)) (param $vsingle (ref eq)) (result (ref eq)) + (local $fd i32) (local $data (ref $data)) (local $buf (ref $bytes)) + (local $pos i32) (local $len i32) (local $n i32) (local $written i32) + (local $buffer i32) (local $nwritten i32) (local $iovs i32) + (local $iovs_len i32) (local $numbytes i32) (local $res i32) + (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd)))) + (local.set $data + (ref.cast (ref $data) + (any.convert_extern (call $caml_ba_get_data (local.get $vbuf))))) + (local.set $buf + (ref.cast (ref $bytes) (struct.get $data $array (local.get $data)))) + (local.set $pos + (i32.add (i31.get_u (ref.cast (ref i31) (local.get $vpos))) + (struct.get $data $offset (local.get $data)))) + (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen)))) + (local.set $buffer (call $get_buffer)) + (local.set $nwritten (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (i32.store (local.get $iovs) (local.get $buffer)) + (local.set $iovs_len (i32.const 1)) + (loop $loop + (if (i32.gt_u (local.get $len) (i32.const 0)) + (then + (local.set $numbytes + (select (global.get $IO_BUFFER_SIZE) (local.get $len) + (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE)))) + (call $blit_substring_to_memory + (local.get $buffer) (local.get $buf) (local.get $pos) + (local.get $numbytes)) + (i32.store offset=4 (local.get $iovs) (local.get $numbytes)) + (local.set $res + (call $fd_write + (local.get $fd) (local.get $iovs) (local.get $iovs_len) + (local.get $nwritten))) + (if (local.get $res) + (then + (call $caml_unix_error (local.get $res) (@string "write") + (global.get $no_arg)))) + (local.set $n (i32.load (local.get $nwritten))) + (local.set $written (i32.add (local.get $written) (local.get $n))) + (local.set $pos (i32.add (local.get $pos) (local.get $n))) + (local.set $len (i32.sub (local.get $len) (local.get $n))) + (br_if $loop + (ref.eq (local.get $vsingle) (ref.i31 (i32.const 0))))))) + (ref.i31 (local.get $written))) + + (func (export "unix_read_bigarray") (export "caml_unix_read_bigarray") + (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq)) + (param $vlen (ref eq)) (result (ref eq)) + (local $fd i32) (local $data (ref $data)) (local $buf (ref $bytes)) + (local $pos i32) (local $len i32) (local $n i32) + (local $buffer i32) (local $nread i32) (local $iovs i32) + (local $iovs_len i32) (local $res i32) + (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd)))) + (local.set $data + (ref.cast (ref $data) + (any.convert_extern (call $caml_ba_get_data (local.get $vbuf))))) + (local.set $buf + (ref.cast (ref $bytes) (struct.get $data $array (local.get $data)))) + (local.set $pos + (i32.add (i31.get_u (ref.cast (ref i31) (local.get $vpos))) + (struct.get $data $offset (local.get $data)))) + (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen)))) + (if (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE)) + (then + (local.set $len (global.get $IO_BUFFER_SIZE)))) + (local.set $buffer (call $get_buffer)) + (local.set $nread (local.get $buffer)) + (local.set $iovs (i32.add (local.get $buffer) (i32.const 4))) + (local.set $buffer (i32.add (local.get $buffer) (i32.const 12))) + (i32.store (local.get $iovs) (local.get $buffer)) + (i32.store offset=4 (local.get $iovs) (local.get $len)) + (local.set $iovs_len (i32.const 1)) + (local.set $res + (call $fd_read + (local.get $fd) (local.get $iovs) (local.get $iovs_len) + (local.get $nread))) + (if (local.get $res) + (then + (call $caml_unix_error (local.get $res) (@string "read") + (global.get $no_arg)))) + (local.set $n (i32.load (local.get $nread))) + (call $blit_memory_to_substring (local.get $buffer) + (local.get $buf) (local.get $pos) (local.get $n)) + (ref.i31 (local.get $n))) +) +(@else (func (export "unix_write") (export "caml_unix_write") (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq)) (param $vlen (ref eq)) (result (ref eq)) @@ -1007,7 +2285,28 @@ (struct.set $fd_offset $offset (local.get $fd_offset) (local.get $offset)) (ref.i31 (local.get $n))) +)) +(@if wasi +(@then + (func $lseek + (param $fd (ref eq)) (param $offset i64) (param $cmd (ref eq)) + (result i64) + (local $res i32) (local $buffer i32) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $fd_seek + (i31.get_u (ref.cast (ref i31) (local.get $fd))) + (local.get $offset) + (i31.get_u (ref.cast (ref i31) (local.get $cmd))) + (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "lseek") (global.get $no_arg)))) + (i64.load (local.get $buffer))) +) +(@else (func $lseek_exn (param $errno i32) (result (ref eq)) (array.new_fixed $block 5 (ref.i31 (i32.const 0)) @@ -1043,6 +2342,7 @@ (struct.set $fd_offset $offset (local.get $fd_offset) (local.get $offset)) (struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1)) (local.get $offset)) +)) (func (export "unix_lseek") (export "caml_unix_lseek") (param $fd (ref eq)) (param $ofs (ref eq)) (param $cmd (ref eq)) @@ -1064,6 +2364,20 @@ (call $Int64_val (local.get $ofs)) (local.get $cmd)))) +(@if wasi +(@then + (func (export "unix_fsync") (export "caml_unix_fsync") + (param $fd (ref eq)) (result (ref eq)) + (local $res i32) + (local.set $res + (call $fd_sync (i31.get_u (ref.cast (ref i31) (local.get $fd))))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "fsync") (global.get $no_arg)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_fsync") (export "caml_unix_fsync") (param $fd (ref eq)) (result (ref eq)) (try @@ -1072,6 +2386,7 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) (@string $out_channel_of_descr "out_channel_of_descr") (@string $in_channel_of_descr "in_channel_of_descr") @@ -1082,6 +2397,32 @@ (global.get $in_channel_of_descr) (local.get $out))) +(@if wasi +(@then + (func $caml_unix_check_stream_semantics (param $fd (ref eq)) (param $out i32) + (local $s (ref $block)) (local $kind i32) + (local $buffer i32) (local $res i32) (local $file_type i32) + (local.set $buffer (call $get_buffer)) + (local.set $res + (call $fd_filestat_get + (i31.get_u (ref.cast (ref i31) (local.get $fd))) + (local.get $buffer))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) + (call $channel_of_descr_name (local.get $out)) + (global.get $no_arg)))) + (local.set $kind (i32.load8_u offset=16 (local.get $buffer))) + (block $ok + (block $bad + (br_table $ok $bad $ok $bad $ok $bad $ok $bad (local.get $kind))) + (call $caml_unix_error + (i32.const 28) (; EINVAL ;) + (call $channel_of_descr_name (local.get $out)) + (global.get $no_arg)))) +) +(@else (func $caml_unix_check_stream_semantics (param $fd (ref eq)) (param $out i32) (local $s (ref $block)) (local $kind i32) (local.set $s @@ -1107,6 +2448,7 @@ (ref.i31 (i32.const 12)) ;; EINVAL (call $channel_of_descr_name (local.get $out)) (global.get $no_arg))))) +)) (func (export "unix_inchannel_of_filedescr") (export "win_inchannel_of_filedescr") @@ -1122,6 +2464,20 @@ (call $caml_unix_check_stream_semantics (local.get $fd) (i32.const 1)) (return_call $caml_ml_open_descriptor_out (local.get $fd))) +(@if wasi +(@then + (func (export "unix_close") (export "caml_unix_close") + (param $fd (ref eq)) (result (ref eq)) + (local $res i32) + (local.set $res + (call $fd_close (i31.get_u (ref.cast (ref i31) (local.get $fd))))) + (if (local.get $res) + (then + (call $caml_unix_error + (local.get $res) (@string "close") (global.get $no_arg)))) + (ref.i31 (i32.const 0))) +) +(@else (func (export "unix_close") (export "caml_unix_close") (param $fd (ref eq)) (result (ref eq)) (call $release_fd_offset (i31.get_u (ref.cast (ref i31) (local.get $fd)))) @@ -1131,9 +2487,18 @@ (catch $javascript_exception (call $caml_unix_error (pop externref) (ref.null eq)))) (ref.i31 (i32.const 0))) +)) +(@if wasi +(@then + (func (export "unix_isatty") (export "caml_unix_isatty") + (param (ref eq)) (result (ref eq)) + (ref.i31 (i32.const 0))) +) +(@else (export "unix_isatty" (func $isatty)) (export "caml_unix_isatty" (func $isatty)) +)) (func (export "unix_getuid") (export "caml_unix_getuid") (export "unix_geteuid") (export "caml_unix_geteuid") diff --git a/runtime/wasm/wasi_errors.wat b/runtime/wasm/wasi_errors.wat new file mode 100644 index 0000000000..577fb410fa --- /dev/null +++ b/runtime/wasm/wasi_errors.wat @@ -0,0 +1,86 @@ +(module +(@if wasi +(@then + (type $block (array (mut (ref eq)))) + (type $bytes (array (mut i8))) + (global (export "error_messages") (ref $block) + (array.new_fixed $block 77 + (@string "Success") + (@string "Argument list too long") + (@string "Permission denied") + (@string "Address in use") + (@string "Address not available") + (@string "Address family not supported") + (@string "Resource unavailable, or operation would block") + (@string "Connection already in progress") + (@string "Bad file descriptor") + (@string "Bad message") + (@string "Device or resource busy") + (@string "Operation canceled") + (@string "No child processes") + (@string "Connection aborted") + (@string "Connection refused") + (@string "Connection reset") + (@string "Resource deadlock would occur") + (@string "Destination address required") + (@string "Mathematics argument out of domain of function") + (@string "Reserved") + (@string "File exists") + (@string "Bad address") + (@string "File too large") + (@string "Host is unreachable") + (@string "Identifier removed") + (@string "Illegal byte sequence") + (@string "Operation in progress") + (@string "Interrupted function") + (@string "Invalid argument") + (@string "I/O error") + (@string "Socket is connected") + (@string "Is a directory") + (@string "Too many levels of symbolic links") + (@string "File descriptor value too large") + (@string "Too many links") + (@string "Message too large") + (@string "Reserved") + (@string "Filename too long") + (@string "Network is down") + (@string "Connection aborted by network") + (@string "Network unreachable") + (@string "Too many files open in system") + (@string "No buffer space available") + (@string "No such device") + (@string "No such file or directory") + (@string "Executable file format error") + (@string "No locks available") + (@string "Reserved") + (@string "Not enough space") + (@string "No message of the desired type") + (@string "Protocol not available") + (@string "No space left on device") + (@string "Function not supported") + (@string "The socket is not connected") + (@string "Not a directory or a symbolic link to a directory") + (@string "Directory not empty") + (@string "State not recoverable") + (@string "Not a socket") + (@string "Not supported, or operation not supported on socket") + (@string "Inappropriate I/O control operation") + (@string "No such device or address") + (@string "Value too large to be stored in data type") + (@string "Previous owner died") + (@string "Operation not permitted") + (@string "Broken pipe") + (@string "Protocol error") + (@string "Protocol not supported") + (@string "Protocol wrong type for socket") + (@string "Result too large") + (@string "Read-only file system") + (@string "Invalid seek") + (@string "No such process") + (@string "Reserved") + (@string "Connection timed out") + (@string "Text file busy") + (@string "Cross-device link") + (@string "Capabilities insufficient"))) +)) +) diff --git a/runtime/wasm/wasi_memory.wat b/runtime/wasm/wasi_memory.wat new file mode 100644 index 0000000000..0e737a46db --- /dev/null +++ b/runtime/wasm/wasi_memory.wat @@ -0,0 +1,98 @@ +(module +(@if wasi +(@then + (import "libc" "memory" (memory 2)) + (import "libc" "malloc" (func $malloc (param i32) (result i32))) + (import "libc" "free" (func $free (param i32))) + (import "io" "IO_BUFFER_SIZE" (global $IO_BUFFER_SIZE i32)) + (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory)) + + (type $bytes (array (mut i8))) + + (func (export "checked_malloc") (param $size i32) (result i32) + (local $p i32) + (local.set $p (call $malloc (local.get $size))) + (if (i32.eqz (local.get $p)) + (then (call $caml_raise_out_of_memory))) + (local.get $p)) + + (func (export "blit_substring_to_memory") + (param $buf i32) (param $s (ref $bytes)) (param $ofs i32) (param $len i32) + (local $i i32) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (i32.store8 (i32.add (local.get $buf) (local.get $i)) + (array.get $bytes (local.get $s) + (i32.add (local.get $ofs) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + + (func $blit_string_to_memory (export "blit_string_to_memory") + (param $buf i32) (param $s (ref $bytes)) + (local $i i32) (local $len i32) + (local.set $len (array.len (local.get $s))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (i32.store8 (i32.add (local.get $buf) (local.get $i)) + (array.get $bytes (local.get $s) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + + (func (export "blit_memory_to_substring") + (param $buf i32) (param $s (ref $bytes)) (param $ofs i32) (param $len i32) + (local $i i32) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $bytes (local.get $s) + (i32.add (local.get $ofs) (local.get $i)) + (i32.load8_u (i32.add (local.get $buf) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop))))) + + (func $blit_memory_to_string (export "blit_memory_to_string") + (param $buf i32) (param $len i32) (result (ref $bytes)) + (local $s (ref $bytes)) + (local $i i32) + (local.set $s (array.new $bytes (i32.const 0) (local.get $len))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (array.set $bytes (local.get $s) (local.get $i) + (i32.load8_u (i32.add (local.get $buf) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (local.get $s)) + + (func (export "write_string_to_memory") + (param $buf i32) (param $avail i32) (param $v (ref eq)) + (result i32) + (local $s (ref $bytes)) (local $i i32) (local $len i32) + (local.set $s (ref.cast (ref $bytes) (local.get $v))) + (local.set $len (array.len (local.get $s))) + (if (i32.lt_u (local.get $avail) (i32.add (local.get $len) (i32.const 1))) + (then + (local.set $buf + (call $checked_malloc (i32.add (local.get $len) (i32.const 1)))))) + (call $blit_string_to_memory (local.get $buf) (local.get $s)) + (i32.store8 (i32.add (local.get $buf) (local.get $len)) (i32.const 0)) + (local.get $buf)) + + (func (export "release_memory") (param $initial_buffer i32) (param $buf i32) + (if (i32.ne (local.get $initial_buffer) (local.get $buf)) + (then + (call $free (local.get $buf))))) + + (global $buffer (mut i32) (i32.const 0)) + + (func $get_buffer (export "get_buffer") (result i32) + (if (i32.eqz (global.get $buffer)) + (then + (global.set $buffer + (call $checked_malloc + (i32.add (global.get $IO_BUFFER_SIZE) (i32.const 12)))))) + (global.get $buffer)) +)) +) diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat index d725cea8d4..68d5328c04 100644 --- a/runtime/wasm/weak.wat +++ b/runtime/wasm/weak.wat @@ -21,6 +21,19 @@ (func $caml_obj_dup (param (ref eq)) (result (ref eq)))) (import "fail" "caml_invalid_argument" (func $caml_invalid_argument (param $arg (ref eq)))) + +(@if wasi +(@then + (func $wrap (param (ref eq)) (result (ref eq)) + (local.get 0)) + (func $unwrap (param (ref eq)) (result (ref eq)) + (local.get 0)) + (func $weak_new (param $v (ref eq)) (result (ref eq)) + (local.get $v)) + (func $weak_deref (param $r (ref eq)) (result (ref eq)) + (local.get $r)) +) +(@else (import "bindings" "weak_new" (func $weak_new (param (ref eq)) (result anyref))) (import "bindings" "weak_deref" @@ -32,6 +45,8 @@ (func $map_set (param (ref any)) (param (ref eq)) (param (ref any)))) (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref))) (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq)))) +)) + (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (type $js (struct (field anyref))) @@ -62,6 +77,8 @@ (block $released (br_if $no_data (ref.eq (local.get $d) (global.get $caml_ephe_none))) +(@if (not wasi) +(@then (local.set $i (global.get $caml_ephe_key_offset)) (local.set $len (array.len (local.get $x))) (local.set $m (ref.as_non_null (call $unwrap (local.get $d)))) @@ -82,6 +99,7 @@ (call $map_get (local.get $m) (local.get $v)))) (br $loop)))) (local.set $d (ref.cast (ref eq) (local.get $m))) +)) (return (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $d)))) @@ -111,6 +129,8 @@ (local $m (ref any)) (local $m' (ref any)) (local $i i32) (local.set $x (ref.cast (ref $block) (local.get $vx))) +(@if (not wasi) +(@then (local.set $i (array.len (local.get $x))) (local.set $m (local.get $data)) (loop $loop @@ -135,6 +155,7 @@ (global.get $caml_ephe_none)) (br $loop)))) (local.set $data (call $wrap (local.get $m))) +)) (array.set $block (local.get $x) (global.get $caml_ephe_data_offset) (local.get $data)) (ref.i31 (i32.const 0))) diff --git a/runtime/wasm/zstd.wat b/runtime/wasm/zstd.wat index a6dff7db4f..879ea60a0f 100644 --- a/runtime/wasm/zstd.wat +++ b/runtime/wasm/zstd.wat @@ -16,7 +16,7 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module -(@if (>= ocaml_version (5 1 0)) +(@if (and (>= ocaml_version (5 1 0)) (not wasi)) (@then (import "bindings" "ta_new" (func $ta_new (param i32) (result (ref extern)))) (import "bindings" "dv_make" @@ -58,5 +58,9 @@ (func (export "caml_zstd_initialize") (param (ref eq)) (result (ref eq)) (global.set $caml_intern_decompress_input (ref.func $decompress)) (ref.i31 (i32.const 1))) +) +(@else + (func (export "caml_zstd_initialize") (param (ref eq)) (result (ref eq)) + (ref.i31 (i32.const 0))) )) ) From 6562d4648107629d62d162fa939d998c10bfdd62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 22 May 2026 19:14:42 +0200 Subject: [PATCH 03/10] Emit new exception handling instructions when WASI is enabled Wasmtime only supports these instructions and not the legacy ones. So, emit them when WASI support is requested, since Wasmtime is the primary target for WASI binaries. --- compiler/bin-wasm_of_ocaml/link_wasm.ml | 3 ++ compiler/lib-wasm/binaryen.ml | 17 +++++++---- compiler/lib-wasm/wasm_output.ml | 31 +++++++++++++------ compiler/lib-wasm/wat_output.ml | 40 +++++++++++++++++-------- 4 files changed, 63 insertions(+), 28 deletions(-) diff --git a/compiler/bin-wasm_of_ocaml/link_wasm.ml b/compiler/bin-wasm_of_ocaml/link_wasm.ml index 2237493e17..1e518f164b 100644 --- a/compiler/bin-wasm_of_ocaml/link_wasm.ml +++ b/compiler/bin-wasm_of_ocaml/link_wasm.ml @@ -117,6 +117,9 @@ let link (* So that the --enable-stack-switching option is passed to Binaryen tools for native effects. *) Js_of_ocaml_compiler.Config.set_effects_backend effects_backend; + (* So that wasm-opt is invoked with --emit-exnref when targeting WASI. *) + if List.mem ~eq:String.equal "wasi" variables.Preprocess.enable + then Js_of_ocaml_compiler.Config.Flag.enable "wasi"; let inputs = List.map ~f:(fun (module_name, file) -> { Wat_preprocess.module_name; file; source = File }) diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml index 1ef79bd4d1..b8a1d77c08 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/compiler/lib-wasm/binaryen.ml @@ -141,11 +141,16 @@ let optimize ~output_file () = command - ("wasm-opt" - :: (common_options () - @ (match options with - | Some o -> o - | None -> optimization_options profile) - @ [ Filename.quote input_file; "-o"; Filename.quote output_file ]) + (* [--emit-exnref] is needed even though [Wasm_output] and + [Wat_output] now emit [try_table] directly when targeting WASI: + the runtime [.wat] files still use the legacy [try]/[catch] syntax, + and this flag converts them to [try_table] so the whole output is + uniformly in the new form. *) + (("wasm-opt" :: (if Config.Flag.wasi () then [ "--emit-exnref" ] else [])) + @ common_options () + @ (match options with + | Some o -> o + | None -> optimization_options profile) + @ [ Filename.quote input_file; "-o"; Filename.quote output_file ] @ opt_flag "--input-source-map" opt_input_sourcemap @ opt_flag "--output-source-map" opt_output_sourcemap) diff --git a/compiler/lib-wasm/wasm_output.ml b/compiler/lib-wasm/wasm_output.ml index 767cc19e71..98924d95be 100644 --- a/compiler/lib-wasm/wasm_output.ml +++ b/compiler/lib-wasm/wasm_output.ml @@ -690,15 +690,28 @@ end = struct output_byte ch 0x0B | Try (typ, l, catches) -> Feature.require exception_handling; - output_byte ch 0x06; - output_blocktype st.type_names ch typ; - List.iter ~f:(fun i' -> output_instruction st ch i') l; - List.iter - ~f:(fun (tag, l, ty) -> - output_byte ch 0x07; - output_uint ch (Code.Var.Hashtbl.find st.tag_names tag); - output_instruction st ch (Br (l + 1, Some (Pop ty)))) - catches; + if Config.Flag.wasi () + then ( + output_byte ch 0x1f; + output_blocktype st.type_names ch typ; + output_uint ch (List.length catches); + List.iter + ~f:(fun (tag, l, _) -> + output_byte ch 0x00; + output_uint ch (Code.Var.Hashtbl.find st.tag_names tag); + output_uint ch l) + catches; + List.iter ~f:(fun i' -> output_instruction st ch i') l) + else ( + output_byte ch 0x06; + output_blocktype st.type_names ch typ; + List.iter ~f:(fun i' -> output_instruction st ch i') l; + List.iter + ~f:(fun (tag, l, ty) -> + output_byte ch 0x07; + output_uint ch (Code.Var.Hashtbl.find st.tag_names tag); + output_instruction st ch (Br (l + 1, Some (Pop ty)))) + catches); output_byte ch 0X0B | ExternConvertAny e' -> Feature.require gc; diff --git a/compiler/lib-wasm/wat_output.ml b/compiler/lib-wasm/wat_output.ml index 5ebac15e4a..3095752219 100644 --- a/compiler/lib-wasm/wat_output.ml +++ b/compiler/lib-wasm/wat_output.ml @@ -483,19 +483,33 @@ let expression_or_instructions ctx st in_function = @ [ List (Atom "else" :: expression iff) ]) ] | Try (ty, body, catches) -> - [ List - (Atom "try" - :: (block_type st ty - @ List (Atom "do" :: instructions body) - :: List.map - ~f:(fun (tag, i, ty) -> - List - (Atom "catch" - :: index st.tag_names tag - :: (instruction (Wasm_ast.Event Code_generation.hidden_location) - @ instruction (Wasm_ast.Br (i + 1, Some (Pop ty)))))) - catches)) - ] + if Config.Flag.wasi () + then + [ List + (Atom "try_table" + :: (block_type st ty + @ List.map + ~f:(fun (tag, i, _ty) -> + List + [ Atom "catch"; index st.tag_names tag; Atom (string_of_int i) ]) + catches + @ instructions body)) + ] + else + [ List + (Atom "try" + :: (block_type st ty + @ List (Atom "do" :: instructions body) + :: List.map + ~f:(fun (tag, i, ty) -> + List + (Atom "catch" + :: index st.tag_names tag + :: (instruction + (Wasm_ast.Event Code_generation.hidden_location) + @ instruction (Wasm_ast.Br (i + 1, Some (Pop ty)))))) + catches)) + ] | ExternConvertAny e' -> [ List (Atom "extern.convert_any" :: expression e') ] | AnyConvertExtern e' -> [ List (Atom "any.convert_extern" :: expression e') ] and instruction i = From 8b4fbfa00546cc11571159cf74a2763c08af5f81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Wed, 19 Feb 2025 11:45:49 +0100 Subject: [PATCH 04/10] WASI: support for separate compilation --- compiler/lib-wasm/generate.ml | 36 +++++ compiler/lib-wasm/generate.mli | 3 + compiler/lib-wasm/link.ml | 254 +++++++++++++++++++++++++------- compiler/lib-wasm/link.mli | 8 + compiler/lib-wasm/runtime.ml | 2 +- compiler/lib-wasm/wasm_link.ml | 28 ++-- compiler/lib-wasm/wasm_link.mli | 3 +- dune | 2 +- 8 files changed, 273 insertions(+), 63 deletions(-) diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index 288ff176c5..6486598e56 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -2405,6 +2405,38 @@ module Generate (Target : Target_sig.S) = struct :: context.other_fields; name + let add_missing_primitives ~context l = + let failwith_desc = W.Fun { params = [ Type.value ]; result = [] } in + List.iter l ~f:(fun (exported_name, arity) -> + let name = Code.Var.fresh_n exported_name in + let locals, body = + function_body + ~context + ~param_names:[] + ~body: + (let* failwith = + register_import ~import_module:"env" ~name:"caml_failwith" failwith_desc + in + let* msg = + Constant.translate + ~unboxed:false + (String (exported_name ^ " not implemented")) + in + let* () = instr (CallInstr (failwith, [ msg ])) in + push Value.unit) + in + context.other_fields <- + W.Function + { name + ; exported_name = Some exported_name + ; typ = None + ; signature = Type.primitive_type arity + ; param_names = [] + ; locals + ; body + } + :: context.other_fields) + let entry_point context toplevel_fun entry_name = let signature, param_names, body = entry_point ~toplevel_fun in let locals, body = function_body ~context ~param_names ~body in @@ -2594,6 +2626,10 @@ let add_start_function = G.add_start_function let add_init_function = G.add_init_function +let add_missing_primitives = + let module G = Generate (Gc_target) in + G.add_missing_primitives + let output ch ~context = let t = Timer.make () in let fields = G.output ~context in diff --git a/compiler/lib-wasm/generate.mli b/compiler/lib-wasm/generate.mli index 47cfb17095..8c777e9250 100644 --- a/compiler/lib-wasm/generate.mli +++ b/compiler/lib-wasm/generate.mli @@ -34,6 +34,9 @@ val add_start_function : context:Code_generation.context -> Wasm_ast.var -> unit val add_init_function : context:Code_generation.context -> to_link:string list -> unit +val add_missing_primitives : + context:Code_generation.context -> (string * int) list -> unit + val output : out_channel -> context:Code_generation.context -> unit val wasm_output : diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml index 04661f1940..0110d01627 100644 --- a/compiler/lib-wasm/link.ml +++ b/compiler/lib-wasm/link.ml @@ -214,12 +214,13 @@ module Wasm_binary = struct let reftype ch = reftype' (input_byte ch) ch - let valtype ch = - let i = read_uint ch in + let valtype' i ch = match i with - | 0x7b | 0x7c | 0x7d | 0x7e | 0x7f -> () + | 0x7B | 0x7C | 0x7D | 0x7E | 0x7F -> () | _ -> reftype' i ch + let valtype ch = valtype' (read_uint ch) ch + let limits ch = match input_byte ch with | 0 -> ignore (read_uint ch) @@ -234,32 +235,99 @@ module Wasm_binary = struct reftype ch; limits ch + type comptype = + | Func of { arity : int } + | Struct + | Array + | Cont + + let supertype ch = + match input_byte ch with + | 0 -> () + | 1 -> ignore (read_uint ch) + | _ -> assert false + + let storagetype ch = + let i = read_uint ch in + match i with + | 0x78 | 0x77 -> () + | _ -> valtype' i ch + + let fieldtype ch = + storagetype ch; + ignore (input_byte ch) + + let comptype i ch = + match i with + | 0x5D -> + ignore (read_sint ch); + Cont + | 0x5E -> + fieldtype ch; + Array + | 0x5F -> + ignore (vec fieldtype ch); + Struct + | 0x60 -> + let params = vec valtype ch in + let _ = vec valtype ch in + Func { arity = List.length params } + | c -> failwith (Printf.sprintf "Unknown comptype %d" c) + + let subtype i ch = + match i with + | 0x50 -> + supertype ch; + comptype (input_byte ch) ch + | 0x4F -> + supertype ch; + comptype (input_byte ch) ch + | _ -> comptype i ch + + let rectype ch = + match input_byte ch with + | 0x4E -> vec (fun ch -> subtype (input_byte ch) ch) ch + | i -> [ subtype i ch ] + + type importdesc = + | Func of int + | Table + | Mem + | Global + | Tag + type import = { module_ : string ; name : string + ; desc : importdesc } let import ch = let module_ = name ch in let name = name ch in let d = read_uint ch in - let _ = + let desc = match d with - | 0 -> ignore (read_uint ch) - | 1 -> tabletype ch - | 2 -> memtype ch + | 0 -> Func (read_uint ch) + | 1 -> + tabletype ch; + Table + | 2 -> + memtype ch; + Mem | 3 -> let _typ = valtype ch in let _mut = input_byte ch in - () + Global | 4 -> assert (read_uint ch = 0); - ignore (read_uint ch) + ignore (read_uint ch); + Tag | _ -> Format.eprintf "Unknown import %x@." d; assert false in - { module_; name } + { module_; name; desc } let export ch = let name = name ch in @@ -289,6 +357,7 @@ module Wasm_binary = struct type interface = { imports : import list ; exports : string list + ; types : comptype array } let read_interface ch = @@ -296,7 +365,11 @@ module Wasm_binary = struct match next_section ch with | None -> i | Some s -> - if s.id = 2 + if s.id = 1 + then + find_sections + { i with types = Array.of_list (List.flatten (vec rectype ch.ch)) } + else if s.id = 2 then find_sections { i with imports = vec import ch.ch } else if s.id = 7 then { i with exports = vec export ch.ch } @@ -304,7 +377,7 @@ module Wasm_binary = struct skip_section ch s; find_sections i) in - find_sections { imports = []; exports = [] } + find_sections { imports = []; exports = []; types = [||] } let append_source_map_section ~file ~url = let ch = open_out_gen [ Open_wronly; Open_append; Open_binary ] 0o666 file in @@ -416,6 +489,13 @@ let generate_start_function ~to_link ~out_file = Generate.wasm_output ch ~opt_source_map_file:None ~context; if times () then Format.eprintf " generate start: %a@." Timer.print t1 +let generate_missing_primitives ~missing_primitives ~out_file = + Filename.gen_file out_file + @@ fun ch -> + let context = Generate.start () in + Generate.add_missing_primitives ~context missing_primitives; + Generate.wasm_output ch ~opt_source_map_file:None ~context + let output_js js = let js = Driver.simplify_js js in let js = Driver.name_variables js in @@ -674,17 +754,20 @@ let compute_dependencies ~files_to_link ~files = let compute_missing_primitives (runtime_intf, intfs) = let provided_primitives = StringSet.of_list runtime_intf.Wasm_binary.exports in - StringSet.elements + StringMap.bindings @@ List.fold_left - ~f:(fun s { Wasm_binary.imports; _ } -> + ~f:(fun s { Wasm_binary.imports; types; _ } -> List.fold_left - ~f:(fun s { Wasm_binary.module_; name; _ } -> - if String.equal module_ "env" && not (StringSet.mem name provided_primitives) - then StringSet.add name s - else s) + ~f:(fun s { Wasm_binary.module_; name; desc } -> + match module_, desc with + | "env", Func idx when not (StringSet.mem name provided_primitives) -> ( + match types.(idx) with + | Func { arity } -> StringMap.add name arity s + | _ -> s) + | _ -> s) ~init:s imports) - ~init:StringSet.empty + ~init:StringMap.empty intfs let load_information files = @@ -757,6 +840,72 @@ let read_embedded_files file = then Marshal.from_string (Zip.read_entry z ~name:"embedded_files") 0 else []) +let link_to_module ~to_link ~files_to_link ~files ~enable_source_maps:_ ~dir = + let process_file ~name ~module_name file = + Zip.with_open_in file + @@ fun z -> + let intf = + let ch, pos, len, _ = Zip.get_entry z ~name in + Wasm_binary.read_interface (Wasm_binary.from_channel ~name ch pos len) + in + ( { Wasm_link.module_name + ; file + ; code = Some (Zip.read_entry z ~name) + ; opt_source_map = None + } + , intf ) + in + let runtime_file = fst (List.hd files) in + let z = Zip.open_in runtime_file in + let runtime, runtime_intf = + process_file ~name:"runtime.wasm" ~module_name:"env" runtime_file + in + let prelude = + { Wasm_link.module_name = "OCaml" + ; file = runtime_file + ; code = Some (Zip.read_entry z ~name:"prelude.wasm") + ; opt_source_map = None + } + in + Zip.close_in z; + let lst = + List.tl files + |> List.filter_map ~f:(fun (file, _) -> + if StringSet.mem file files_to_link + then Some (process_file ~name:"code.wasm" ~module_name:"OCaml" file) + else None) + in + let missing_primitives = + if Config.Flag.genprim () + then compute_missing_primitives (runtime_intf, List.map ~f:snd lst) + else [] + in + Fs.with_intermediate_file (Filename.temp_file "start" ".wasm") + @@ fun start_module -> + generate_start_function ~to_link ~out_file:start_module; + let start = + { Wasm_link.module_name = "OCaml" + ; file = start_module + ; code = None + ; opt_source_map = None + } + in + Fs.with_intermediate_file (Filename.temp_file "stubs" ".wasm") + @@ fun stubs_module -> + generate_missing_primitives ~missing_primitives ~out_file:stubs_module; + let missing_primitives = + { Wasm_link.module_name = "env" + ; file = stubs_module + ; code = None + ; opt_source_map = None + } + in + ignore + (Wasm_link.f + (runtime :: prelude :: missing_primitives :: start :: List.map ~f:fst lst) + ~filter_export:(fun nm -> String.equal nm "_start" || String.equal nm "memory") + ~output_file:(Filename.concat dir "code.wasm")) + let link ~output_file ~linkall ~enable_source_maps ~embedded_files ~files = if times () then Format.eprintf "linking@."; let t = Timer.make () in @@ -855,42 +1004,47 @@ let link ~output_file ~linkall ~enable_source_maps ~embedded_files ~files = if times () then Format.eprintf " finding what to link: %a@." Timer.print t1; if times () then Format.eprintf " scan: %a@." Timer.print t; let t = Timer.make () in - let interfaces, wasm_dir, link_spec = + let missing_primitives, wasm_dir, link_spec = let dir = Filename.chop_extension output_file ^ ".assets" in gen_dir dir @@ fun tmp_dir -> Sys.mkdir tmp_dir 0o777; - let start_module = - "start-" - ^ String.sub - (Digest.to_hex (Digest.string (String.concat ~sep:"/" to_link))) - ~pos:0 - ~len:8 - in - let all_primitives = - List.fold_left files ~init:StringSet.empty ~f:(fun acc (_, (_, units)) -> - List.fold_left units ~init:acc ~f:(fun acc { unit_info; _ } -> - List.fold_left unit_info.Unit_info.primitives ~init:acc ~f:(fun acc p -> - StringSet.add p acc))) - in - let link_info_wasm = build_dynlink_init ~to_link ~all_primitives in - let link_info_module = "_link_info" in - let out = Filename.concat tmp_dir (link_info_module ^ ".wasm") in - Fs.write_file ~name:out ~contents:link_info_wasm; - let start_to_link = link_info_module :: to_link in - generate_start_function - ~to_link:start_to_link - ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm")); - let module_names, interfaces = - link_to_directory ~files_to_link ~files ~enable_source_maps ~dir:tmp_dir - in - ( interfaces - , dir - , let to_link = compute_dependencies ~files_to_link ~files in - List.combine module_names (None :: None :: to_link) - @ [ link_info_module, None; start_module, None ] ) + if not (Config.Flag.wasi ()) + then ( + let start_module = + "start-" + ^ String.sub + (Digest.to_hex (Digest.string (String.concat ~sep:"/" to_link))) + ~pos:0 + ~len:8 + in + let all_primitives = + List.fold_left files ~init:StringSet.empty ~f:(fun acc (_, (_, units)) -> + List.fold_left units ~init:acc ~f:(fun acc { unit_info; _ } -> + List.fold_left unit_info.Unit_info.primitives ~init:acc ~f:(fun acc p -> + StringSet.add p acc))) + in + let link_info_wasm = build_dynlink_init ~to_link ~all_primitives in + let link_info_module = "_link_info" in + let out = Filename.concat tmp_dir (link_info_module ^ ".wasm") in + Fs.write_file ~name:out ~contents:link_info_wasm; + let start_to_link = link_info_module :: to_link in + let module_names, interfaces = + link_to_directory ~files_to_link ~files ~enable_source_maps ~dir:tmp_dir + in + let missing_primitives = compute_missing_primitives interfaces in + generate_start_function + ~to_link:start_to_link + ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm")); + ( List.map ~f:fst missing_primitives + , dir + , let to_link = compute_dependencies ~files_to_link ~files in + List.combine module_names (None :: None :: to_link) + @ [ link_info_module, None; start_module, None ] )) + else ( + link_to_module ~to_link ~files_to_link ~files ~enable_source_maps ~dir:tmp_dir; + [], dir, [ "code", None ]) in - let missing_primitives = compute_missing_primitives interfaces in if times () then Format.eprintf " copy wasm files: %a@." Timer.print t; let t1 = Timer.make () in let js_runtime = diff --git a/compiler/lib-wasm/link.mli b/compiler/lib-wasm/link.mli index 0b0c9434ae..38e58ab710 100644 --- a/compiler/lib-wasm/link.mli +++ b/compiler/lib-wasm/link.mli @@ -19,9 +19,17 @@ open! Stdlib module Wasm_binary : sig + type importdesc = + | Func of int + | Table + | Mem + | Global + | Tag + type import = { module_ : string ; name : string + ; desc : importdesc } val check : contents:string -> bool diff --git a/compiler/lib-wasm/runtime.ml b/compiler/lib-wasm/runtime.ml index f20560d2da..8e6925ad3d 100644 --- a/compiler/lib-wasm/runtime.ml +++ b/compiler/lib-wasm/runtime.ml @@ -49,7 +49,7 @@ let build ~allowed_imports ~link_options ~opt_options ~variables ~inputs ~output then ( Format.eprintf "The runtime contains unknown imports:@."; List.iter - ~f:(fun { Link.Wasm_binary.module_; name } -> + ~f:(fun { Link.Wasm_binary.module_; name; _ } -> Format.eprintf " %s %s@." module_ name) missing_imports; exit 2)) diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml index 02fa54e1ca..9e61437bd1 100644 --- a/compiler/lib-wasm/wasm_link.ml +++ b/compiler/lib-wasm/wasm_link.ml @@ -1951,7 +1951,7 @@ type input = ; opt_source_map : Source_map.Standard.t option } -let f files ~output_file = +let f ?(filter_export = fun _ -> true) files ~output_file = let files = Array.map ~f:(fun { module_name; file; code; opt_source_map } -> @@ -2205,20 +2205,28 @@ let f files ~output_file = Array.iter ~f:Scan.clear_position_data positions; (* 7: export *) + let exports = + Array.map + ~f:(fun intf -> + map_exportable_info + (fun _ exports -> List.filter ~f:(fun (nm, _) -> filter_export nm) exports) + intf.Read.exports) + intfs + in let export_count = Array.fold_left - ~f:(fun count intf -> + ~f:(fun count exports -> fold_exportable_info (fun _ exports count -> List.length exports + count) count - intf.Read.exports) + exports) ~init:0 - intfs + exports in Write.uint buf export_count; - let exports = String.Hashtbl.create 128 in + let export_tbl = String.Hashtbl.create 128 in Array.iteri - ~f:(fun i intf -> + ~f:(fun i exports -> iter_exportable_info (fun kind lst -> let map = @@ -2231,7 +2239,7 @@ let f files ~output_file = in List.iter ~f:(fun (name, idx) -> - match String.Hashtbl.find exports name with + match String.Hashtbl.find export_tbl name with | i' -> failwith (Printf.sprintf @@ -2240,11 +2248,11 @@ let f files ~output_file = files.(i').file files.(i).file) | exception Not_found -> - String.Hashtbl.add exports name i; + String.Hashtbl.add export_tbl name i; Write.export buf kind name map.(idx)) lst) - intf.Read.exports) - intfs; + exports) + exports; add_section out_ch ~id:7 buf; (* 8: start *) diff --git a/compiler/lib-wasm/wasm_link.mli b/compiler/lib-wasm/wasm_link.mli index 0c0ed0a582..4cbd769668 100644 --- a/compiler/lib-wasm/wasm_link.mli +++ b/compiler/lib-wasm/wasm_link.mli @@ -23,4 +23,5 @@ type input = ; opt_source_map : Source_map.Standard.t option } -val f : input list -> output_file:string -> Source_map.t +val f : + ?filter_export:(string -> bool) -> input list -> output_file:string -> Source_map.t diff --git a/dune b/dune index ad9ef85c4b..f59770a8c7 100644 --- a/dune +++ b/dune @@ -51,7 +51,7 @@ (wasm_of_ocaml (flags (:standard --pretty --enable wasi)) - (compilation_mode whole_program)) + (compilation_mode separate)) (binaries (tools/node_wrapper.exe as node) (tools/node_wrapper.exe as node.exe))) From 7019f9c3553974104542ca229c2c788be3565c76 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 14 Feb 2025 13:05:37 +0100 Subject: [PATCH 05/10] Node wrapper: support for using alternative Wasm engines --- tools/ci_setup-mainstream.ml | 1 + tools/ci_setup-oxcaml.ml | 1 + tools/dune | 11 ++++++++- tools/node_wrapper.ml | 48 ++++++++++++++++++++++++++++++------ 4 files changed, 53 insertions(+), 8 deletions(-) diff --git a/tools/ci_setup-mainstream.ml b/tools/ci_setup-mainstream.ml index 7c0e0c6044..f083e854b8 100644 --- a/tools/ci_setup-mainstream.ml +++ b/tools/ci_setup-mainstream.ml @@ -49,6 +49,7 @@ let node_wrapper = (name node_wrapper) (libraries unix))|} ) ; "node_wrapper/node_wrapper_per_profile.ml", {|let args = []|} + ; "node_wrapper/node_wrapper_per_engine.ml", {|let engine = "node"|} ; "node_wrapper/dune-project", "(lang dune 3.17)" ; "node_wrapper/node_wrapper.opam", "" ] diff --git a/tools/ci_setup-oxcaml.ml b/tools/ci_setup-oxcaml.ml index 80a671ca2b..8fa69744f5 100644 --- a/tools/ci_setup-oxcaml.ml +++ b/tools/ci_setup-oxcaml.ml @@ -55,6 +55,7 @@ let node_wrapper = (name node_wrapper) (libraries unix))|} ) ; "node_wrapper/node_wrapper_per_profile.ml", {|let args = []|} + ; "node_wrapper/node_wrapper_per_engine.ml", {|let engine = "node"|} ; "node_wrapper/dune-project", "(lang dune 3.17)" ; "node_wrapper/node_wrapper.opam", "" ] diff --git a/tools/dune b/tools/dune index aacd4855b6..7f278f329b 100644 --- a/tools/dune +++ b/tools/dune @@ -1,8 +1,17 @@ (executable (name node_wrapper) - (modules node_wrapper) + (link_deps + (env_var WASM_ENGINE)) + (modules node_wrapper node_wrapper_per_engine) (libraries unix)) +(rule + (target node_wrapper_per_engine.ml) + (action + (with-stdout-to + %{target} + (run echo "let engine = \"%{env:WASM_ENGINE=node}\"")))) + (executable (name quickjs_wrapper) (modules quickjs_wrapper) diff --git a/tools/node_wrapper.ml b/tools/node_wrapper.ml index 5f6bffb7cf..a2ecc5bc06 100644 --- a/tools/node_wrapper.ml +++ b/tools/node_wrapper.ml @@ -1,3 +1,22 @@ +let wizard_args = + [ "--ext:stack-switching" + ; "--ext:legacy-eh" + ; "--stack-size=2M" + ; "--dir=." + ; "--dir=/tmp" + ] + +let wasmtime_args = + [ (* "-C"; "collector=null"; *) "-W=all-proposals=y"; "--dir=."; "--dir=/tmp" ] + +let wasmedge_args = + [ "--enable-gc" + ; "--enable-exception-handling" + ; "--enable-tail-call" + ; "--dir=." + ; "--dir=/tmp" + ] + let extra_args_for_wasoo = [ "--experimental-wasm-wasmfx"; "--stack-size=10000" ] let extra_args_for_jsoo = [] @@ -19,16 +38,31 @@ let env = else e) env -let args = +let environment_args () = + List.filter + (fun e -> not (String.contains e ',')) + (Array.to_list (Array.map (fun e -> "--env=" ^ e) env)) + +let wasm_file file = + Filename.concat (Filename.chop_extension file ^ ".assets") "code.wasm" + +let common_args file argv = environment_args () @ (wasm_file file :: List.tl argv) + +let exe, args = match Array.to_list Sys.argv with | exe :: argv -> - let argv = + let exe', argv = match argv with - | file :: _ when Filename.check_suffix file ".wasm.js" -> - extra_args_for_wasoo @ argv - | _ -> extra_args_for_jsoo @ argv + | file :: _ when Filename.check_suffix file ".wasm.js" -> ( + match Node_wrapper_per_engine.engine with + | "wizard" -> "wizeng.x86-linux", wizard_args @ common_args file argv + | "wizard-fast" -> "wizeng.x86-64-linux", wizard_args @ common_args file argv + | "wasmtime" -> "wasmtime", wasmtime_args @ common_args file argv + | "wasmedge" -> "wasmedge", wasmedge_args @ common_args file argv + | _ -> "node", extra_args_for_wasoo @ argv) + | _ -> "node", extra_args_for_jsoo @ argv in - Array.of_list (exe :: argv) + exe', Array.of_list (exe :: argv) | [] -> assert false let () = @@ -41,4 +75,4 @@ let () = | _, WEXITED n -> exit n | _, WSIGNALED _ -> exit 9 | _, WSTOPPED _ -> exit 9 - else Unix.execvpe "node" args env + else Unix.execvpe exe args env From 0e4782ec6ee324f7c98ae0801994cc16424c1bbb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 14 Feb 2025 13:06:30 +0100 Subject: [PATCH 06/10] CI updates: test WASI runtime with node and wasmtime --- .github/workflows/wasm_of_ocaml.yml | 50 +++++++++++++++++++++++++++-- dune | 3 +- 2 files changed, 49 insertions(+), 4 deletions(-) diff --git a/.github/workflows/wasm_of_ocaml.yml b/.github/workflows/wasm_of_ocaml.yml index 311b4171eb..7d12eeaf28 100644 --- a/.github/workflows/wasm_of_ocaml.yml +++ b/.github/workflows/wasm_of_ocaml.yml @@ -34,6 +34,8 @@ jobs: - false all_jane_street_tests: - false + wasi: + - false include: - os: macos-latest os-name: MacOS @@ -41,6 +43,7 @@ jobs: separate_compilation: true jane_street_tests: false all_jane_street_tests: false + wasi: false - os: windows-latest os-name: Windows ocaml-compiler: "5.3" @@ -54,23 +57,33 @@ jobs: separate_compilation: true jane_street_tests: true all_jane_street_tests: true + wasi: false - os: ubuntu-latest os-name: Ubuntu ocaml-compiler: "5.3" separate_compilation: false jane_street_tests: true all_jane_street_tests: false + wasi: false - os: ubuntu-latest os-name: Ubuntu ocaml-compiler: "ocaml-variants.5.2.0+ox" separate_compilation: true jane_street_tests: true all_jane_street_tests: true + wasi: false + - os: ubuntu-latest + os-name: Ubuntu + ocaml-compiler: "5.3" + separate_compilation: true + jane_street_tests: false + all_jane_street_tests: false + wasi: true runs-on: ${{ matrix.os }} name: - ${{ (! matrix.separate_compilation) && 'Whole program / ' || ''}}${{ matrix.ocaml-compiler }} / ${{ matrix.os-name }}${{ matrix.all_jane_street_tests && ' / Jane Street tests' || ''}} + ${{ matrix.wasi && 'WASI / ' || '' }}${{ (! matrix.separate_compilation) && 'Whole program / ' || ''}}${{ matrix.ocaml-compiler }} / ${{ matrix.os-name }}${{ matrix.all_jane_street_tests && ' / Jane Street tests' || ''}} steps: - name: Update apt cache @@ -103,6 +116,25 @@ jobs: with: node-version: ${{ matrix.os == 'windows-latest' && 'latest' || 'v26.0.0-v8-canary20260216631fb6e5ef' }} + - name: Set-up Rust toolchain + if: matrix.wasi + uses: actions-rust-lang/setup-rust-toolchain@v1 + + - name: Checkout Wasmtime + if: matrix.wasi + uses: actions/checkout@v4 + with: + repository: bytecodealliance/wasmtime + path: wasmtime + submodules: true + + - name: Build Wasmtime + if: matrix.wasi + working-directory: ./wasmtime + run: | + cargo build + echo `pwd`/target/debug >> "$GITHUB_PATH" + - name: Set-up OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v3 with: @@ -191,7 +223,7 @@ jobs: opam install . -t - name: Run tests - if: ${{ matrix.separate_compilation }} + if: ${{ matrix.separate_compilation && ! matrix.wasi }} working-directory: ./wasm_of_ocaml run: opam exec -- dune build @runtest-wasm @@ -200,7 +232,7 @@ jobs: # See https://github.com/libuv/libuv/issues/3622 - name: Run tests with CPS effects - if: ${{ matrix.ocaml-compiler >= '5.' && matrix.separate_compilation }} + if: ${{ matrix.ocaml-compiler >= '5.' && matrix.separate_compilation && ! matrix.wasi }} continue-on-error: ${{ matrix.os == 'windows-latest' }} working-directory: ./wasm_of_ocaml run: opam exec -- dune build @runtest-wasm --profile with-effects @@ -210,6 +242,18 @@ jobs: working-directory: ./wasm_of_ocaml run: opam exec -- dune build @runtest-wasm --profile with-native-effects + - name: Run tests (WASI runtime - node) + if: ${{ matrix.wasi }} + working-directory: ./wasm_of_ocaml + run: opam exec -- dune build @runtest-wasm --profile wasi + + - name: Run tests (WASI runtime - wasmtime) + if: ${{ matrix.wasi }} + working-directory: ./wasm_of_ocaml + env: + WASM_ENGINE: wasmtime + run: opam exec -- dune build @runtest-wasm --profile wasi + - name: Run Base tests if: matrix.all_jane_street_tests continue-on-error: ${{ matrix.os == 'windows-latest' }} diff --git a/dune b/dune index f59770a8c7..35cc5b45e5 100644 --- a/dune +++ b/dune @@ -51,7 +51,8 @@ (wasm_of_ocaml (flags (:standard --pretty --enable wasi)) - (compilation_mode separate)) + ; Wasmtime is slow on large binaries, so use whole program compilation + (compilation_mode whole_program)) (binaries (tools/node_wrapper.exe as node) (tools/node_wrapper.exe as node.exe))) From ad53a7d48c6b4c13b6ab10cfd37709e947a2003e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 6 Feb 2025 19:07:05 +0100 Subject: [PATCH 07/10] CI: use Wizard engine as well --- .github/workflows/wasm_of_ocaml.yml | 43 +++++++++++++++++++++++++++++ tools/node_wrapper.ml | 3 ++ 2 files changed, 46 insertions(+) diff --git a/.github/workflows/wasm_of_ocaml.yml b/.github/workflows/wasm_of_ocaml.yml index 7d12eeaf28..91b710d419 100644 --- a/.github/workflows/wasm_of_ocaml.yml +++ b/.github/workflows/wasm_of_ocaml.yml @@ -135,6 +135,35 @@ jobs: cargo build echo `pwd`/target/debug >> "$GITHUB_PATH" + - name: Checkout Virgil + if: matrix.wasi + uses: actions/checkout@v4 + with: + repository: titzer/virgil + path: virgil + + - name: Build Virgil + if: matrix.wasi + working-directory: ./virgil + run: | + export PATH=$PATH:`pwd`/bin + echo `pwd`/bin >> "$GITHUB_PATH" + make + + - name: Checkout Wizard engine + if: matrix.wasi + uses: actions/checkout@v4 + with: + repository: titzer/wizard-engine + path: wizard-engine + + - name: Build Wizard engine + if: matrix.wasi + working-directory: ./wizard-engine + run: | + make -j 4 + echo `pwd`/bin >> "$GITHUB_PATH" + - name: Set-up OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v3 with: @@ -247,6 +276,20 @@ jobs: working-directory: ./wasm_of_ocaml run: opam exec -- dune build @runtest-wasm --profile wasi + - name: Run tests (WASI runtime - Wizard engine) + if: ${{ matrix.wasi }} + working-directory: ./wasm_of_ocaml + env: + WASM_ENGINE: wizard-fast + run: opam exec -- dune build @runtest-wasm --profile wasi + + - name: Run tests (WASI runtime - Wizard engine - SPC) + if: ${{ matrix.wasi }} + working-directory: ./wasm_of_ocaml + env: + WASM_ENGINE: wizard-spc + run: opam exec -- dune build @runtest-wasm --profile wasi + - name: Run tests (WASI runtime - wasmtime) if: ${{ matrix.wasi }} working-directory: ./wasm_of_ocaml diff --git a/tools/node_wrapper.ml b/tools/node_wrapper.ml index a2ecc5bc06..1498c74f6c 100644 --- a/tools/node_wrapper.ml +++ b/tools/node_wrapper.ml @@ -57,6 +57,9 @@ let exe, args = match Node_wrapper_per_engine.engine with | "wizard" -> "wizeng.x86-linux", wizard_args @ common_args file argv | "wizard-fast" -> "wizeng.x86-64-linux", wizard_args @ common_args file argv + | "wizard-spc" -> + ( "wizeng.x86-64-linux" + , ("--mode=jit" :: wizard_args) @ common_args file argv ) | "wasmtime" -> "wasmtime", wasmtime_args @ common_args file argv | "wasmedge" -> "wasmedge", wasmedge_args @ common_args file argv | _ -> "node", extra_args_for_wasoo @ argv) From 55a616a07c63633fadf45dc5740a1f292de7e7fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Mon, 22 Sep 2025 15:26:49 +0200 Subject: [PATCH 08/10] WASI: update documentation --- manual/wasm_overview.wiki | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/manual/wasm_overview.wiki b/manual/wasm_overview.wiki index be3c4fa93e..907239b276 100644 --- a/manual/wasm_overview.wiki +++ b/manual/wasm_overview.wiki @@ -85,6 +85,27 @@ runtime with support for the WasmFX extension (currently available, behind the {{{--experimental-wasm-wasmfx}}} flag, in Chrome 148 or higher, or in a recent Node.js canary release (V8 version 14.7.100 or higher)). +==@@id="wasi"@@ WASI support + +You can produce a WASI binary by running {{{wasm_of_ocaml}}} with the +{{{--enable wasi}}} flag. At the moment, {{{wasm_of_ocaml}}} supports +WASI 0.1. Features from the Sys and Unix modules are available +whenever they're supported by the WASI API. + +The binaries produced by {{{wasm_of_ocaml}}} require the GC and +exception-handling proposals, which are supported by Node.js, Wasmtime +(with the {{{-W=all-proposals=y}}} flag), and the Wizard engine (with +the {{{--ext:gc --ext:exception-handling --ext:legacy-eh}}} flags). +Wasmtime does not support the legacy Wasm exception-handling +instructions, so when {{{--enable wasi}}} is used the compiler emits +the new {{{exnref}}}-based instructions instead. + +For now, the output remains the same as without the {{{--enable +wasi}}} flag: a JavaScript file {{{foo.js}}} and a directory +{{{foo.assets}}} containing the Wasm code {{{code.wasm}}}. The +JavaScript file can be used to run the WASI binary with {{{node}}}, +while the Wasm code can be run directly by other Wasm engines. + ==@@id="js-bindings"@@ Binding with JavaScript libraries Js_of_ocaml lets you bind code with JavaScript libraries by linking {{{.js}}} files. From 0988285e5fa88e8a24ac194888cd3343c5161d7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 28 May 2026 15:43:35 +0200 Subject: [PATCH 09/10] Test WASI + native effects --- .github/workflows/wasm_of_ocaml.yml | 4 +-- compiler/tests-dynlink-wasm/dune | 21 ++++++++---- compiler/tests-io/dune | 8 +++-- compiler/tests-jsoo/dune | 21 +++++++++--- compiler/tests-jsoo/lib-effects/dune | 1 + compiler/tests-ocaml/basic-io-2/dune | 4 ++- compiler/tests-ocaml/effect-syntax/dune | 1 + compiler/tests-ocaml/effects/dune | 1 + compiler/tests-ocaml/lib-arg/dune | 6 ++-- compiler/tests-ocaml/lib-array/dune | 4 ++- compiler/tests-ocaml/lib-digest/dune | 3 +- compiler/tests-ocaml/lib-either/dune | 6 ++-- compiler/tests-ocaml/lib-internalformat/dune | 6 ++-- compiler/tests-ocaml/lib-lazy/dune | 6 ++-- compiler/tests-ocaml/lib-unix/isatty/dune | 1 + compiler/tests-toplevel/dune | 2 ++ dune | 11 +++++++ lib/deriving_json/tests/dune | 4 ++- lib/tests/dune.inc | 34 ++++++++++---------- lib/tests/gen-rules/gen.ml | 10 ++++-- 20 files changed, 107 insertions(+), 47 deletions(-) diff --git a/.github/workflows/wasm_of_ocaml.yml b/.github/workflows/wasm_of_ocaml.yml index 91b710d419..d0e4b642d7 100644 --- a/.github/workflows/wasm_of_ocaml.yml +++ b/.github/workflows/wasm_of_ocaml.yml @@ -281,14 +281,14 @@ jobs: working-directory: ./wasm_of_ocaml env: WASM_ENGINE: wizard-fast - run: opam exec -- dune build @runtest-wasm --profile wasi + run: opam exec -- dune build @runtest-wasm --profile wasi-with-native-effects - name: Run tests (WASI runtime - Wizard engine - SPC) if: ${{ matrix.wasi }} working-directory: ./wasm_of_ocaml env: WASM_ENGINE: wizard-spc - run: opam exec -- dune build @runtest-wasm --profile wasi + run: opam exec -- dune build @runtest-wasm --profile wasi-with-native-effects - name: Run tests (WASI runtime - wasmtime) if: ${{ matrix.wasi }} diff --git a/compiler/tests-dynlink-wasm/dune b/compiler/tests-dynlink-wasm/dune index 21a26eec8a..da304fb054 100644 --- a/compiler/tests-dynlink-wasm/dune +++ b/compiler/tests-dynlink-wasm/dune @@ -46,7 +46,8 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} with-native-effects) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (run %{bin:wasm_of_ocaml} @@ -63,7 +64,8 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} with-native-effects) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (with-outputs-to %{target} @@ -75,7 +77,8 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} with-native-effects) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (diff main.out.expected main.out))) @@ -107,7 +110,8 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} with-native-effects) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (with-outputs-to %{target} @@ -119,7 +123,8 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} with-native-effects) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (diff main_compile_and_load.out.expected main_compile_and_load.out))) @@ -140,7 +145,8 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} with-native-effects) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (with-outputs-to %{target} @@ -152,7 +158,8 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} with-native-effects) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (diff dynlink_loadfile.out.expected dynlink_loadfile.out))) diff --git a/compiler/tests-io/dune b/compiler/tests-io/dune index 3798704005..a76568cc03 100644 --- a/compiler/tests-io/dune +++ b/compiler/tests-io/dune @@ -92,7 +92,9 @@ (deps "accentué") (modes wasm) (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (wasm_of_ocaml (compilation_mode whole_program) (flags @@ -114,7 +116,9 @@ (deps file.txt) (modes js wasm) (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (js_of_ocaml (compilation_mode whole_program) (flags diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune index 6e4a47b79e..f4a320dc13 100644 --- a/compiler/tests-jsoo/dune +++ b/compiler/tests-jsoo/dune @@ -54,6 +54,7 @@ (enabled_if (and (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects) (<> %{profile} quickjs))) (inline_tests (deps @@ -169,7 +170,9 @@ (modules test_runtime_value) (libraries js_of_ocaml) (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (js_of_ocaml (javascript_files custom.js)) (wasm_of_ocaml @@ -180,7 +183,9 @@ (name test_promise) (modules test_promise) (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (libraries js_of_ocaml) (modes js wasm) (preprocess @@ -191,7 +196,9 @@ (package js_of_ocaml-lwt) (modules test_lwt_promise) (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (libraries js_of_ocaml js_of_ocaml-lwt lwt) (modes js wasm) (preprocess @@ -201,7 +208,9 @@ (name test_custom_name) (modules test_custom_name) (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (inline_tests (modes js wasm)) (libraries js_of_ocaml) @@ -227,7 +236,9 @@ (name test_list_of_js_array) (modules test_list_of_js_array) (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (inline_tests (modes js wasm)) (libraries js_of_ocaml) diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune index b6680517eb..0ee6ee594c 100644 --- a/compiler/tests-jsoo/lib-effects/dune +++ b/compiler/tests-jsoo/lib-effects/dune @@ -2,6 +2,7 @@ (with-effects-double-translation) (with-native-effects) (with-effects) + (wasi-with-native-effects) (wasi (wasm_of_ocaml (flags diff --git a/compiler/tests-ocaml/basic-io-2/dune b/compiler/tests-ocaml/basic-io-2/dune index e666404c1f..67f0e42929 100644 --- a/compiler/tests-ocaml/basic-io-2/dune +++ b/compiler/tests-ocaml/basic-io-2/dune @@ -3,6 +3,8 @@ (modes js wasm) ;; Sys.command not available (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (run node %{test} %{dep:test-file-short-lines}))) diff --git a/compiler/tests-ocaml/effect-syntax/dune b/compiler/tests-ocaml/effect-syntax/dune index 2e818b1c16..6020b7eb6d 100644 --- a/compiler/tests-ocaml/effect-syntax/dune +++ b/compiler/tests-ocaml/effect-syntax/dune @@ -2,6 +2,7 @@ (with-effects-double-translation) (with-native-effects) (with-effects) + (wasi-with-native-effects) (wasi (wasm_of_ocaml (flags diff --git a/compiler/tests-ocaml/effects/dune b/compiler/tests-ocaml/effects/dune index e433b266f6..f13bf2c3d6 100644 --- a/compiler/tests-ocaml/effects/dune +++ b/compiler/tests-ocaml/effects/dune @@ -2,6 +2,7 @@ (with-effects-double-translation) (with-native-effects) (with-effects) + (wasi-with-native-effects) (wasi (wasm_of_ocaml (flags diff --git a/compiler/tests-ocaml/lib-arg/dune b/compiler/tests-ocaml/lib-arg/dune index 3de73d0a00..0a5d506913 100644 --- a/compiler/tests-ocaml/lib-arg/dune +++ b/compiler/tests-ocaml/lib-arg/dune @@ -20,7 +20,8 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_rest_all_wasm.ml}))) @@ -29,6 +30,7 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (diff test_rest_all.ml test_rest_all_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-array/dune b/compiler/tests-ocaml/lib-array/dune index 91e265c401..a4267854b4 100644 --- a/compiler/tests-ocaml/lib-array/dune +++ b/compiler/tests-ocaml/lib-array/dune @@ -18,7 +18,8 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_array_wasm.ml}))) @@ -28,6 +29,7 @@ (and (>= %{ocaml_version} 5.2) (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects) %{env:WASM_OF_OCAML=false})) (action (diff test_array.ml test_array_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-digest/dune b/compiler/tests-ocaml/lib-digest/dune index 19fe2dce08..2f714ee213 100644 --- a/compiler/tests-ocaml/lib-digest/dune +++ b/compiler/tests-ocaml/lib-digest/dune @@ -10,6 +10,7 @@ (build_if (and (>= %{ocaml_version} 5.2) - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (modules digests) (modes js wasm)) diff --git a/compiler/tests-ocaml/lib-either/dune b/compiler/tests-ocaml/lib-either/dune index b8735af6c6..49e232da40 100644 --- a/compiler/tests-ocaml/lib-either/dune +++ b/compiler/tests-ocaml/lib-either/dune @@ -16,7 +16,8 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) @@ -25,6 +26,7 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (diff test.ml test_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-internalformat/dune b/compiler/tests-ocaml/lib-internalformat/dune index b8735af6c6..49e232da40 100644 --- a/compiler/tests-ocaml/lib-internalformat/dune +++ b/compiler/tests-ocaml/lib-internalformat/dune @@ -16,7 +16,8 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) @@ -25,6 +26,7 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (diff test.ml test_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-lazy/dune b/compiler/tests-ocaml/lib-lazy/dune index b8735af6c6..49e232da40 100644 --- a/compiler/tests-ocaml/lib-lazy/dune +++ b/compiler/tests-ocaml/lib-lazy/dune @@ -16,7 +16,8 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) @@ -25,6 +26,7 @@ (enabled_if (and %{env:WASM_OF_OCAML=false} - (<> %{profile} wasi))) + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (action (diff test.ml test_wasm.ml.corrected))) diff --git a/compiler/tests-ocaml/lib-unix/isatty/dune b/compiler/tests-ocaml/lib-unix/isatty/dune index 852dd49d6a..7a3e2d99f5 100644 --- a/compiler/tests-ocaml/lib-unix/isatty/dune +++ b/compiler/tests-ocaml/lib-unix/isatty/dune @@ -8,6 +8,7 @@ (enabled_if (and (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects) (not %{env:CI=false}))) ; WASI has no notion of tty ; isatty_tty does not work on the CI since we are not running in a tty there diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune index 54297c898b..63a3bfaeab 100644 --- a/compiler/tests-toplevel/dune +++ b/compiler/tests-toplevel/dune @@ -81,6 +81,7 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects) (>= %{ocaml_version} 5.4))) (action (with-stdout-to @@ -104,6 +105,7 @@ (and %{env:WASM_OF_OCAML=false} (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects) (>= %{ocaml_version} 5.4))) (action (progn diff --git a/dune b/dune index 35cc5b45e5..93777419ef 100644 --- a/dune +++ b/dune @@ -56,6 +56,17 @@ (binaries (tools/node_wrapper.exe as node) (tools/node_wrapper.exe as node.exe))) + (wasi-with-native-effects + (js_of_ocaml + ;; Native effects is not supported in js + (enabled_if false)) + (wasm_of_ocaml + (compilation_mode separate) + (flags + (:standard --effects native --enable wasi))) + (binaries + (tools/node_wrapper.exe as node) + (tools/node_wrapper.exe as node.exe))) (bench_no_debug (flags (:standard \ -g)) diff --git a/lib/deriving_json/tests/dune b/lib/deriving_json/tests/dune index b7772e347e..dc06d408e6 100644 --- a/lib/deriving_json/tests/dune +++ b/lib/deriving_json/tests/dune @@ -3,7 +3,9 @@ (libraries unix js_of_ocaml js_of_ocaml.deriving) (inline_tests (enabled_if - (<> %{profile} wasi)) + (and + (<> %{profile} wasi) + (<> %{profile} wasi-with-native-effects))) (modes js wasm)) (preprocess (pps ppx_expect ppx_deriving_json))) diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc index a5db04790c..6d40702599 100644 --- a/lib/tests/dune.inc +++ b/lib/tests/dune.inc @@ -2,7 +2,7 @@ (library ;; lib/tests/test_css_angle.ml (name test_css_angle_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_css_angle) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -12,7 +12,7 @@ (library ;; lib/tests/test_css_color.ml (name test_css_color_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_css_color) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -22,7 +22,7 @@ (library ;; lib/tests/test_css_length.ml (name test_css_length_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_css_length) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -32,7 +32,7 @@ (library ;; lib/tests/test_eval.ml (name test_eval_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_eval) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -42,7 +42,7 @@ (library ;; lib/tests/test_fetch.ml (name test_fetch_75) - (enabled_if (and (<> %{profile} quickjs) (<> %{profile} wasi))) + (enabled_if (and (<> %{profile} quickjs) (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_fetch) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -62,7 +62,7 @@ (library ;; lib/tests/test_fun_call_2.ml (name test_fun_call_2_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_fun_call_2) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -72,7 +72,7 @@ (library ;; lib/tests/test_json.ml (name test_json_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_json) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -82,7 +82,7 @@ (library ;; lib/tests/test_misc.ml (name test_misc_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_misc) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -92,7 +92,7 @@ (library ;; lib/tests/test_nodejs_filesystem_errors.ml (name test_nodejs_filesystem_errors_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_nodejs_filesystem_errors) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -102,7 +102,7 @@ (library ;; lib/tests/test_poly_compare.ml (name test_poly_compare_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_poly_compare) (libraries js_of_ocaml unix) (inline_tests (modes js)) @@ -112,7 +112,7 @@ (library ;; lib/tests/test_poly_equal.ml (name test_poly_equal_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_poly_equal) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -122,7 +122,7 @@ (library ;; lib/tests/test_promise.ml (name test_promise_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_promise) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -132,7 +132,7 @@ (library ;; lib/tests/test_regexp.ml (name test_regexp_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_regexp) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -142,7 +142,7 @@ (library ;; lib/tests/test_string.ml (name test_string_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_string) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -162,7 +162,7 @@ (library ;; lib/tests/test_typed_array.ml (name test_typed_array_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_typed_array) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -172,7 +172,7 @@ (library ;; lib/tests/test_unsafe_set_get.ml (name test_unsafe_set_get_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_unsafe_set_get) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -182,7 +182,7 @@ (library ;; lib/tests/test_url.ml (name test_url_75) - (enabled_if (<> %{profile} wasi)) + (enabled_if (and (<> %{profile} wasi) (<> %{profile} wasi-with-native-effects))) (modules test_url) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml index ba0b58328c..2f5e7d0097 100644 --- a/lib/tests/gen-rules/gen.ml +++ b/lib/tests/gen-rules/gen.ml @@ -87,10 +87,16 @@ let () = basename (Hashtbl.hash prefix mod 100) (match enabled_if basename with - | Any -> "\n (enabled_if (<> %{profile} wasi))" + | Any -> + "\n\ + \ (enabled_if (and (<> %{profile} wasi) (<> %{profile} \ + wasi-with-native-effects)))" | GE5 -> "\n (enabled_if (>= %{ocaml_version} 5))" | No_effects -> "\n (enabled_if (<> %{profile} with-effects))" - | Not_quickjs -> "\n (enabled_if (and (<> %{profile} quickjs) (<> %{profile} wasi)))") + | Not_quickjs -> + "\n\ + \ (enabled_if (and (<> %{profile} quickjs) (<> %{profile} wasi) (<> \ + %{profile} wasi-with-native-effects)))") basename (match run_wasm basename with | true -> "js wasm" From 2d361218d776c40d335a4ec66632d61cff087933 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Mon, 22 Sep 2025 15:26:55 +0200 Subject: [PATCH 10/10] Changes --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index f87aa33517..79ee3ffab3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -26,6 +26,7 @@ * Lib: add `Fetch` and `Abort` modules — Fetch API binding with a typed `AbortController`/`AbortSignal` primitive for cancellation (#596) * Wasm_of_ocaml: alternative effect implementation based on the Stack Switching proposal (#2189) +* Compiler/wasm: WASI 0.1 support (#1831) ## Bug fixes * Compiler: fix UGEINT bytecode lowering (returned wrong result on