From 14e2f8e09269cc301963bbda17ce85c107e7d432 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 4 Jul 2024 10:25:10 +0200 Subject: [PATCH 1/9] Flag to generate the new exception handling instructions Wasmtime only supports these instructions. We should eventually use instead of the legacy instructions, but they are not allowed by default in node. --- compiler/bin-wasm_of_ocaml/compile.ml | 1 + compiler/bin-wasm_of_ocaml/gen/gen.ml | 2 +- compiler/lib-wasm/binaryen.ml | 12 ++++++------ compiler/lib/config.ml | 2 ++ compiler/lib/config.mli | 2 ++ 5 files changed, 12 insertions(+), 7 deletions(-) diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 08fcfda78d..8f68b31e57 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/compiler/bin-wasm_of_ocaml/compile.ml @@ -84,6 +84,7 @@ let preprocessor_variables () = | `Disabled | `Jspi -> "jspi" | `Cps -> "cps" | `Double_translation -> assert false) ) + ; "exnref", Wat_preprocess.Bool (Config.Flag.exnref ()) ] let with_runtime_files ~runtime_wasm_files f = diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml index 7f093bf08a..c824c98f6b 100644 --- a/compiler/bin-wasm_of_ocaml/gen/gen.ml +++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml @@ -75,7 +75,7 @@ let check_js_file fname = (* Keep the two variables below in sync with function build_runtime in ../compile.ml *) -let default_flags = [] +let default_flags = [ "exnref", `B false ] let interesting_runtimes = [ [ "effects", `S "jspi" ]; [ "effects", `S "cps" ] ] diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml index 1089330ef2..b3c3301adf 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/compiler/lib-wasm/binaryen.ml @@ -135,11 +135,11 @@ 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 ]) + (("wasm-opt" :: (if Config.Flag.exnref () 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/config.ml b/compiler/lib/config.ml index 65c45d39ca..a64b97e2b8 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -106,6 +106,8 @@ module Flag = struct let es6 = o ~name:"es6" ~default:false let load_shapes_auto = o ~name:"load-shapes-auto" ~default:false + + let exnref = o ~name:"exnref" ~default:false end module Param = struct diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli index fc545a3fc4..69dfb81307 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -76,6 +76,8 @@ module Flag : sig val load_shapes_auto : unit -> bool + val exnref : unit -> bool + val enable : string -> unit val disable : string -> unit From 1d53fa380dcc530b3e69d155d9e67ab49f42f303 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 2/9] WASI runtime --- compiler/bin-wasm_of_ocaml/cmd_arg.ml | 2 + compiler/bin-wasm_of_ocaml/compile.ml | 47 +- 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/config.ml | 2 + compiler/lib/config.mli | 2 + compiler/tests-jsoo/dune | 23 + compiler/tests-jsoo/lib-effects/dune | 6 + compiler/tests-jsoo/test_unix.ml | 79 - compiler/tests-jsoo/test_unix_perms.ml | 78 + compiler/tests-linkall/dune | 2 + compiler/tests-ocaml/basic-io-2/dune | 3 + compiler/tests-ocaml/effect-syntax/dune | 4 + compiler/tests-ocaml/effects/dune | 4 + compiler/tests-ocaml/lib-channels/close_in.ml | 10 +- compiler/tests-ocaml/lib-digest/dune | 4 +- 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-wasm_of_ocaml/dune | 4 +- dune | 8 + lib/deriving_json/tests/dune | 2 + lib/tests/dune.inc | 24 +- lib/tests/gen-rules/gen.ml | 3 +- runtime/wasm/backtrace.wat | 10 + runtime/wasm/bigarray.wat | 518 +++++++ runtime/wasm/bigstring.wat | 35 + runtime/wasm/blake2.wat | 2 +- runtime/wasm/compare.wat | 3 + runtime/wasm/deps-wasi.json | 15 + runtime/wasm/dune | 68 + runtime/wasm/effect.wat | 7 + runtime/wasm/fail.wat | 6 + runtime/wasm/float.wat | 85 + runtime/wasm/fs.wat | 609 ++++++++ runtime/wasm/hash.wat | 3 + runtime/wasm/io.wat | 432 +++++- runtime/wasm/jslib.wat | 3 + 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/runtime-wasi.js | 84 + runtime/wasm/stdlib.wat | 62 +- runtime/wasm/sys.wat | 310 +++- runtime/wasm/unix.wat | 1366 ++++++++++++++++- runtime/wasm/wasi_errors.wat | 86 ++ runtime/wasm/wasi_memory.wat | 98 ++ runtime/wasm/weak.wat | 21 + runtime/wasm/zstd.wat | 6 +- 55 files changed, 4366 insertions(+), 193 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/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml index 5911580f46..4cef59ad33 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 ] option) common : [--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) as e) -> e diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 8f68b31e57..a81cd6b69e 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/compiler/bin-wasm_of_ocaml/compile.ml @@ -81,9 +81,11 @@ let preprocessor_variables () = [ ( "effects" , Wat_preprocess.String (match Config.effects () with - | `Disabled | `Jspi -> "jspi" + | `Disabled -> "disabled" + | `Jspi -> "jspi" | `Cps -> "cps" | `Double_translation -> assert false) ) + ; "wasi", Wat_preprocess.Bool (Config.Flag.wasi ()) ; "exnref", Wat_preprocess.Bool (Config.Flag.exnref ()) ] @@ -116,7 +118,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" ] @@ -124,13 +128,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 @@ -186,7 +193,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 @@ -303,7 +313,13 @@ let build_js_runtime ~primitives ?runtime_arguments () = | _ -> assert false in let init_fun = - match Parse_js.parse (Parse_js.Lexer.of_string Runtime_files.js_runtime) with + match + Parse_js.parse + (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 @@ -601,9 +617,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 e00c918434..da3b5a6057 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 c824c98f6b..61e6291ec6 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 = [ "exnref", `B false ] -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 b3c3301adf..35d5158eb2 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 = if Config.Flag.pretty () then "-g" :: l else l in diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml index df63676c68..8be4cf86c1 100644 --- a/compiler/lib-wasm/gc_target.ml +++ b/compiler/lib-wasm/gc_target.ml @@ -1331,8 +1331,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 @@ -1380,8 +1380,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 @@ -1413,6 +1413,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 @@ -1453,19 +1465,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 ] @@ -1487,14 +1494,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 ])) @@ -1539,19 +1544,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 ]) @@ -1572,18 +1572,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 = @@ -1956,21 +1953,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 5c51a05321..5ed2cffac3 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -209,7 +209,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) @@ -220,7 +220,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 _), _ - | _, (Int _ | Number _ | Tuple _ | Bigarray _) -> + | _, (Int _ | Number _ | Tuple _ | Bigarray _) + | 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/config.ml b/compiler/lib/config.ml index a64b97e2b8..e38bb5f171 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -108,6 +108,8 @@ module Flag = struct let load_shapes_auto = o ~name:"load-shapes-auto" ~default:false let exnref = o ~name:"exnref" ~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 69dfb81307..c600b2d7dd 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -78,6 +78,8 @@ module Flag : sig val exnref : unit -> bool + val wasi : unit -> bool + val enable : string -> unit val disable : string -> unit diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune index 60c7a46832..33d47bd619 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))) @@ -22,6 +24,8 @@ (enabled_if (>= %{ocaml_version} 5.1.1)) (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) @@ -33,6 +37,22 @@ (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) + (enabled_if + (<> %{profile} wasi)) + (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) @@ -48,6 +68,7 @@ test_bigarray test_marshal_compressed test_parsing + test_unix_perms calc_parser calc_lexer)) (libraries unix compiler-libs.common js_of_ocaml-compiler) @@ -55,6 +76,8 @@ (language c) (names bigarray_stubs jsoo_runtime_stubs)) (inline_tests + (deps + (sandbox preserve_file_kind)) (modes js wasm best)) (preprocess (pps ppx_expect))) diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune index 246c25364c..db72a6fc66 100644 --- a/compiler/tests-jsoo/lib-effects/dune +++ b/compiler/tests-jsoo/lib-effects/dune @@ -1,6 +1,10 @@ (env (with-effects-double-translation) (with-effects) + (wasi + (wasm_of_ocaml + (flags + (:standard --enable effects)))) (_ (js_of_ocaml (flags @@ -11,6 +15,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 aa25c0baad..3546260463 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 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 5d1fd7d45f..e39dcbc7e9 100644 --- a/compiler/tests-linkall/dune +++ b/compiler/tests-linkall/dune @@ -10,6 +10,8 @@ (test (name test) (modes byte js wasm) + (enabled_if + (<> %{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/effect-syntax/dune b/compiler/tests-ocaml/effect-syntax/dune index 6439ed0495..36d33cfb28 100644 --- a/compiler/tests-ocaml/effect-syntax/dune +++ b/compiler/tests-ocaml/effect-syntax/dune @@ -1,6 +1,10 @@ (env (with-effects-double-translation) (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 ee1488ad49..8bab7bd398 100644 --- a/compiler/tests-ocaml/effects/dune +++ b/compiler/tests-ocaml/effects/dune @@ -1,6 +1,10 @@ (env (with-effects-double-translation) (with-effects) + (wasi + (wasm_of_ocaml + (flags + (:standard --effects cps)))) (_ (js_of_ocaml (flags 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-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 f93c55c685..fbf0a8dec9 100644 --- a/compiler/tests-ocaml/lib-marshal/intext_par.ml +++ b/compiler/tests-ocaml/lib-marshal/intext_par.ml @@ -17,7 +17,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-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune index 4c17507043..c30014da9f 100644 --- a/compiler/tests-wasm_of_ocaml/dune +++ b/compiler/tests-wasm_of_ocaml/dune @@ -10,7 +10,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 fa9ca7d14d..58794eab31 100644 --- a/dune +++ b/dune @@ -36,6 +36,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 122168b73f..dc22a7cb59 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 true) + (enabled_if (<> %{profile} wasi)) (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 true) + (enabled_if (<> %{profile} wasi)) (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 true) + (enabled_if (<> %{profile} wasi)) (modules test_css_length) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -42,7 +42,7 @@ (library ;; lib/tests/test_fun_call_2.ml (name test_fun_call_2_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_fun_call_2) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -52,7 +52,7 @@ (library ;; lib/tests/test_json.ml (name test_json_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_json) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -62,7 +62,7 @@ (library ;; lib/tests/test_nodejs_filesystem_errors.ml (name test_nodejs_filesystem_errors_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_nodejs_filesystem_errors) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -82,7 +82,7 @@ (library ;; lib/tests/test_poly_equal.ml (name test_poly_equal_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_poly_equal) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -92,7 +92,7 @@ (library ;; lib/tests/test_regexp.ml (name test_regexp_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_regexp) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -102,7 +102,7 @@ (library ;; lib/tests/test_string.ml (name test_string_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_string) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -122,7 +122,7 @@ (library ;; lib/tests/test_typed_array.ml (name test_typed_array_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_typed_array) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -132,7 +132,7 @@ (library ;; lib/tests/test_unsafe_set_get.ml (name test_unsafe_set_get_75) - (enabled_if true) + (enabled_if (<> %{profile} wasi)) (modules test_unsafe_set_get) (libraries js_of_ocaml unix) (inline_tests (modes js wasm)) @@ -142,7 +142,7 @@ (library ;; lib/tests/test_url.ml (name test_url_75) - (enabled_if true) + (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 8cc26a522b..d928746e96 100644 --- a/lib/tests/gen-rules/gen.ml +++ b/lib/tests/gen-rules/gen.ml @@ -81,7 +81,8 @@ let () = basename (Hashtbl.hash prefix mod 100) (match enabled_if basename with - | Any | Not_wasm -> "true" + | Any -> "(<> %{profile} wasi)" + | Not_wasm -> "true" | GE5 -> "(>= %{ocaml_version} 5)" | No_effects_not_wasm -> "(<> %{profile} with-effects)") basename 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 0fe421874e..88303e72a2 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -65,6 +65,517 @@ (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.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" @@ -133,6 +644,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))) @@ -785,6 +1297,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) @@ -814,6 +1328,7 @@ (any.convert_extern (struct.get $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0)))))) +)) (func $caml_ba_get_at_offset (param $ba (ref $bigarray)) (param $i i32) (result (ref eq)) @@ -2118,6 +2633,8 @@ (local.get $view) (local.get $i) (local.get $d) (i32.const 1)) (ref.i31 (i32.const 0))) +(@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)) @@ -2149,6 +2666,7 @@ (local.get $s) (i32.const 0) (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 $bigarray $ba_kind (ref.cast (ref $bigarray) (local.get 0)))) diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index 61c4533b5c..19806d1c43 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -35,6 +35,37 @@ (func $caml_ba_get_view (param (ref eq)) (result (ref extern)))) (import "bigarray" "caml_ba_num_elts" (func $caml_ba_num_elts (param (ref eq)) (result i32))) +(@if wasi +(@then + (import "bigarray" "ta_get_ui8" + (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32))) + (import "bigarray" "ta_get32_ui8" + (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32))) + (import "bigarray" "ta_set_ui8" + (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31)))) + (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" "ta_length" + (func $ta_length (param (ref extern)) (result i32))) + (import "bigarray" "ta_blit_from_bytes" + (func $ta_blit_from_bytes + (param (ref $bytes)) (param i32) (param (ref extern)) (param i32) + (param i32))) + (import "bigarray" "ta_blit_to_bytes" + (func $ta_blit_to_bytes + (param (ref extern)) (param i32) (param (ref $bytes)) (param i32) + (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" @@ -58,6 +89,7 @@ (func $ta_blit_to_bytes (param (ref extern)) (param i32) (param (ref $bytes)) (param i32) (param i32))) +)) (import "hash" "caml_hash_mix_int" (func $caml_hash_mix_int (param i32) (param i32) (result i32))) @@ -104,6 +136,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") @@ -122,6 +156,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 a8b92f7e5c..a7bbc51cf1 100644 --- a/runtime/wasm/compare.wat +++ b/runtime/wasm/compare.wat @@ -479,6 +479,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 @@ -506,6 +508,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 a9305e7a41..521dba7637 100644 --- a/runtime/wasm/dune +++ b/runtime/wasm/dune @@ -17,6 +17,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}))) @@ -32,10 +33,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 @@ -45,3 +82,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/effect.wat b/runtime/wasm/effect.wat index 00ef85d8e8..f945026c73 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 04a6092a0e..2aa44adf42 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 295a358cfe..6be68074b2 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)))) @@ -247,6 +270,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)) @@ -329,6 +395,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)) +)) (@string $float_of_string "float_of_string") @@ -485,6 +552,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 0))) (local.set $len (array.len (local.get $s))) (loop $count @@ -651,9 +719,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 (global.get $float_of_string)) (return (ref.i31 (i32.const 0)))) diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat index ee97b2f011..13d6b01865 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,13 +79,296 @@ (tag $javascript_exception (param externref))) (import "sys" "caml_handle_sys_error" (func $caml_handle_sys_error (param externref))) +)) (import "string" "caml_string_concat" (func $caml_string_concat (param (ref eq) (ref eq)) (result (ref eq)))) (import "fail" "caml_raise_sys_error" (func $caml_raise_sys_error (param (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 $i)) + (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)) @@ -59,7 +377,34 @@ (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))) + (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 @@ -69,7 +414,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 @@ -80,7 +444,128 @@ (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 2)) + (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 $buffer) + (local.get $size) + (local.get $cookie) + (local.get $buffer))) + (if (local.get $res) + (then + (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 @@ -93,7 +578,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 @@ -103,7 +607,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 @@ -113,7 +636,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 @@ -124,11 +672,31 @@ (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 $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))) + (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") @@ -150,6 +718,30 @@ (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))) + (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 @@ -161,7 +753,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 @@ -173,12 +774,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 "")) +) +(@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/hash.wat b/runtime/wasm/hash.wat index a7a78c9e49..ad9fd4d628 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 b74db04e88..eda4ca0fb5 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))) @@ -72,10 +97,11 @@ (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 "custom" "custom_compare_id" (func $custom_compare_id (param (ref eq)) (param (ref eq)) (param i32) (result i32))) @@ -89,6 +115,131 @@ (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 $ta_blit_from_bytes + (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 $ta_blit_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 $ta_blit_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 $ta_blit_from_bytes + (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 @@ -117,6 +268,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))) @@ -215,7 +367,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 @@ -228,6 +397,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) @@ -249,6 +419,41 @@ (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))) + (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)) @@ -265,14 +470,30 @@ (local.get $flags) (i31.get_u (ref.cast (ref i31) (local.get $perm))))) (if (i32.and (local.get $flags) (i32.const 4)) ;; O_APPEND - (then (local.set $offset (call $file_size (local.get $fd)))))) + (then (local.set $offset (call $file_size (local.get $fd))))) + ) (catch $javascript_exception (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 @@ -281,6 +502,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))) @@ -289,9 +511,34 @@ (param (ref eq)) (param (ref eq)) (result (ref eq)) (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)) @@ -353,7 +600,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) @@ -368,14 +615,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) @@ -383,6 +672,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 @@ -409,6 +708,7 @@ (struct.set $fd_offset $offset (local.get $fd_offset) (i64.add (local.get $offset) (i64.extend_i32_u (local.get $n)))) +)) (local.get $n)) (func $caml_refill (param $ch (ref $channel)) (result i32) @@ -630,6 +930,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) @@ -662,6 +982,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)) @@ -678,8 +999,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 @@ -689,14 +1028,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))) @@ -704,6 +1061,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") @@ -781,6 +1139,36 @@ (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))) +)) + (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)) @@ -790,6 +1178,16 @@ (then (local.set $buf (struct.get $channel $buffer (local.get $ch))) (local.set $fd (struct.get $channel $fd (local.get $ch))) +(@if wasi +(@then + (local.set $written + (call $write + (local.get $fd) + (local.get $buf) + (i32.const 0) + (local.get $towrite))) +) +(@else (local.set $fd_offset (call $get_fd_offset (local.get $fd))) (local.set $offset (struct.get $fd_offset $offset (local.get $fd_offset))) @@ -819,6 +1217,7 @@ (i64.add (local.get $offset) (i64.extend_i32_u (local.get $written)))) +)) (if (i32.gt_u (local.get $towrite) (local.get $written)) (then (call $ta_copy (local.get $buf) @@ -989,12 +1388,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 23542f08e5..cd53c237a5 100644 --- a/runtime/wasm/jslib.wat +++ b/runtime/wasm/jslib.wat @@ -16,6 +16,8 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module +(@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))) @@ -681,6 +683,7 @@ (return (array.get $block (local.get $exn) (i32.const 2))))))) (call $wrap (ref.null any))) +)) (func (export "caml_jsoo_flags_use_js_string") (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 4180f7649e..f609df5923 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" @@ -257,4 +259,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 b25fff016e..553d7016e1 100644 --- a/runtime/wasm/marshal.wat +++ b/runtime/wasm/marshal.wat @@ -44,11 +44,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") @@ -130,7 +195,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/runtime-wasi.js b/runtime/wasm/runtime-wasi.js new file mode 100644 index 0000000000..59051ffa5f --- /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 65dfa0c313..7dc56f3634 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -38,10 +38,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))) @@ -187,6 +202,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))) @@ -194,10 +211,18 @@ (func (export "caml_handle_uncaught_exception") (param $exn externref) (global.set $uncaught_exception (local.get $exn)) (call $caml_main (ref.func $reraise_exception))) +)) (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 (drop (call_ref $func (ref.cast (ref $func) (local.get $start))))) @@ -230,8 +255,43 @@ (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 $buf) (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))))) ) diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat index ff904edd50..e667ca976d 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" @@ -47,6 +78,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)))) @@ -62,29 +94,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))) @@ -94,14 +278,47 @@ (array.get $block (ref.cast (ref $block) (call $caml_js_to_string_array (call $argv))) (i32.const 1))) +)) +(@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 @@ -110,7 +327,41 @@ (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)) @@ -130,6 +381,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)) @@ -147,6 +399,11 @@ (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0xfffffff))) +(@if wasi +(@then + (global $on_windows 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)))) @@ -170,9 +427,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_runtime_variant") (param (ref eq)) (result (ref eq)) (@string "")) @@ -206,6 +471,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 @@ -214,4 +501,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/unix.wat b/runtime/wasm/unix.wat index 01adfbcc08..d67b096e63 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,39 @@ (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))) + (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 +1038,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 +1073,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 +1266,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 +1299,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 +1331,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 +1365,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 +1426,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 +1490,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 +1533,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 +1612,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)) @@ -711,7 +1687,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 +1734,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))) - (type $flags (array i8)) + (@string $open "open") + + (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 +1836,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)) @@ -786,6 +1852,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)) @@ -985,7 +2262,28 @@ (struct.set $fd_offset $offset (local.get $fd_offset) (i64.add (local.get $offset) (i64.extend_i32_s (local.get $n)))) (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)) @@ -1021,6 +2319,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)) @@ -1042,6 +2341,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 @@ -1050,6 +2363,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") @@ -1060,6 +2374,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 @@ -1085,6 +2425,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") @@ -1100,6 +2441,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)))) @@ -1109,9 +2464,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 54a984aaed..dc5bff2d92 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" "ta_blit_from_bytes" @@ -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 96df7849d4e68a63d97ae844b6924490f649d58c 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 3/9] WASI: support for separate compilation --- compiler/lib-wasm/generate.ml | 36 +++++ compiler/lib-wasm/generate.mli | 3 + compiler/lib-wasm/link.ml | 226 ++++++++++++++++++++++++++------ 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 +- compiler/lib/build_info.ml | 7 +- dune | 4 +- 9 files changed, 263 insertions(+), 54 deletions(-) diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index 5ed2cffac3..64e0837ce0 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -1995,6 +1995,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 @@ -2164,6 +2196,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 dc31cd455c..0e8b4ce53d 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 3f905507f1..df13d72def 100644 --- a/compiler/lib-wasm/link.ml +++ b/compiler/lib-wasm/link.ml @@ -181,12 +181,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) @@ -201,32 +202,95 @@ module Wasm_binary = struct reftype ch; limits ch + type comptype = + | Func of { arity : int } + | Struct + | Array + + 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 + | 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 @@ -256,6 +320,7 @@ module Wasm_binary = struct type interface = { imports : import list ; exports : string list + ; types : comptype array } let read_interface ch = @@ -263,7 +328,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 } @@ -271,7 +340,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 @@ -397,6 +466,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 @@ -630,17 +706,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 = @@ -676,6 +755,72 @@ let gen_dir dir f = remove_directory d_tmp; raise exc +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 ~files = if times () then Format.eprintf "linking@."; let t = Timer.make () in @@ -766,30 +911,35 @@ let link ~output_file ~linkall ~enable_source_maps ~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 - generate_start_function - ~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) @ [ 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 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 + ~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) @ [ 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 c9353b9716..6d6561c1cd 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 c02b0627ed..e2c73e6ee5 100644 --- a/compiler/lib-wasm/runtime.ml +++ b/compiler/lib-wasm/runtime.ml @@ -31,7 +31,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 d088507a02..07d909c87c 100644 --- a/compiler/lib-wasm/wasm_link.ml +++ b/compiler/lib-wasm/wasm_link.ml @@ -1886,7 +1886,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 } -> @@ -2140,20 +2140,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 = @@ -2166,7 +2174,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 @@ -2175,11 +2183,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/compiler/lib/build_info.ml b/compiler/lib/build_info.ml index 4de9956edf..b5da01bbb4 100644 --- a/compiler/lib/build_info.ml +++ b/compiler/lib/build_info.ml @@ -68,6 +68,7 @@ let create kind = | v -> Printf.sprintf "%s+%s" Compiler_version.s v in [ "use-js-string", string_of_bool (Config.Flag.use_js_string ()) + ; "wasi", string_of_bool (Config.Flag.wasi ()) ; "effects", string_of_effects_backend (Config.effects ()) ; "version", version ; "kind", string_of_kind kind @@ -139,9 +140,9 @@ let merge fname1 info1 fname2 info2 = match k, v1, v2 with | "kind", v1, v2 -> if Option.equal String.equal v1 v2 then v1 else Some (string_of_kind `Unknown) - | ("effects" | "use-js-string" | "version"), Some v1, Some v2 + | ("effects" | "use-js-string" | "wasi" | "version"), Some v1, Some v2 when String.equal v1 v2 -> Some v1 - | (("effects" | "use-js-string" | "version") as key), v1, v2 -> + | (("effects" | "use-js-string" | "wasi" | "version") as key), v1, v2 -> raise (Incompatible_build_info { key; first = fname1, v1; second = fname2, v2 }) | _, Some v1, Some v2 when String.equal v1 v2 -> Some v1 @@ -156,7 +157,7 @@ let configure t = StringMap.iter (fun k v -> match k with - | "use-js-string" -> Config.Flag.set k (bool_of_string v) + | "use-js-string" | "wasi" -> Config.Flag.set k (bool_of_string v) | "effects" -> Config.set_effects_backend (effects_backend_of_string v) | _ -> ()) t diff --git a/dune b/dune index 58794eab31..f22f1831fe 100644 --- a/dune +++ b/dune @@ -38,9 +38,11 @@ (tools/node_wrapper.exe as node.exe))) (wasi (wasm_of_ocaml + (build_runtime_flags + (:standard --enable wasi)) (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 25861214485f0c5c74ef66f71d77128256e0b0be 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 4/9] Node wrapper: support for using alternative Wasm engines --- tools/ci_setup.ml | 1 + tools/dune | 11 +++++++++- tools/node_wrapper.ml | 49 ++++++++++++++++++++++++++++++++++++------- 3 files changed, 53 insertions(+), 8 deletions(-) diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml index 3a665d38bf..df53de7dd8 100644 --- a/tools/ci_setup.ml +++ b/tools/ci_setup.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/dune b/tools/dune index 5953c6bc08..e478bcbf98 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 ci_setup) (modules ci_setup) diff --git a/tools/node_wrapper.ml b/tools/node_wrapper.ml index 9d58203591..a309197a45 100644 --- a/tools/node_wrapper.ml +++ b/tools/node_wrapper.ml @@ -1,6 +1,26 @@ +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-imported-strings" ; "--experimental-wasm-stack-switching" + ; "--experimental-wasm-exnref" ; "--stack-size=10000" ] @@ -23,16 +43,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 () = @@ -45,4 +80,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 1964128b15fce7cf2c5d20c1d9fde3eef700feaf 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 5/9] CI updates: test WASI runtime with node and wasmtime --- .github/workflows/wasm_of_ocaml.yml | 50 +++++++++++++++++++++++++++-- dune | 16 +++++++-- 2 files changed, 61 insertions(+), 5 deletions(-) diff --git a/.github/workflows/wasm_of_ocaml.yml b/.github/workflows/wasm_of_ocaml.yml index c964c54c30..a8300dea7b 100644 --- a/.github/workflows/wasm_of_ocaml.yml +++ b/.github/workflows/wasm_of_ocaml.yml @@ -32,6 +32,8 @@ jobs: - false all_jane_street_tests: - false + wasi: + - false include: - os: macos-latest os-name: MacOS @@ -39,6 +41,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" @@ -52,17 +55,26 @@ 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: "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 @@ -94,6 +106,25 @@ jobs: with: node-version: latest + - 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: @@ -140,7 +171,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 @@ -149,11 +180,24 @@ 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 + - 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 + WASI_FLAGS: --enable exnref + 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 f22f1831fe..983b2e5c69 100644 --- a/dune +++ b/dune @@ -41,8 +41,13 @@ (build_runtime_flags (:standard --enable wasi)) (flags - (:standard --pretty --enable wasi)) - (compilation_mode separate)) + (:standard + --pretty + --enable + wasi + (:include wasi_extra_flags))) + ; 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))) @@ -88,6 +93,13 @@ %{target} (echo "(--debug invariant)")))) +(rule + (targets wasi_extra_flags) + (action + (with-stdout-to + %{targets} + (echo "(%{env:WASI_FLAGS=})")))) + (data_only_dirs _wikidoc doc-dev janestreet) (vendored_dirs) From 8193da1ea1c0802f267f465e167f4663ae78622d 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 6/9] CI: use Wizard engine as well --- .github/workflows/wasm_of_ocaml.yml | 36 +++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/.github/workflows/wasm_of_ocaml.yml b/.github/workflows/wasm_of_ocaml.yml index a8300dea7b..49ccfd4138 100644 --- a/.github/workflows/wasm_of_ocaml.yml +++ b/.github/workflows/wasm_of_ocaml.yml @@ -125,6 +125,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: @@ -190,6 +219,13 @@ 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 - wasmtime) if: ${{ matrix.wasi }} working-directory: ./wasm_of_ocaml From 1d8f5ba530342dffc731a3ac467c3688f7e8a2a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Mon, 8 Sep 2025 14:29:37 +0200 Subject: [PATCH 7/9] Wasm runtime: add dynlink stubs --- runtime/wasm/dynlink.wat | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/runtime/wasm/dynlink.wat b/runtime/wasm/dynlink.wat index 45e7d98f00..049f531965 100644 --- a/runtime/wasm/dynlink.wat +++ b/runtime/wasm/dynlink.wat @@ -16,4 +16,29 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module + (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq)))) + + (type $bytes (array (mut i8))) + +(@if (>= ocaml_version (5 1 0)) +(@then + (func (export "caml_dynlink_open_lib") (param (ref eq)) (result (ref eq)) + (call $caml_failwith (@string "Dll.dll_open is not supported")) + (ref.i31 (i32.const 0))) +) +(@else + (func (export "caml_dynlink_open_lib") + (param (ref eq) (ref eq)) (result (ref eq)) + (call $caml_failwith (@string "Dll.dll_open is not supported")) + (ref.i31 (i32.const 0))) +)) + + (func (export "caml_dynlink_close_lib") (param (ref eq)) (result (ref eq)) + (call $caml_failwith (@string "Dll.dll_close is not supported")) + (ref.i31 (i32.const 0))) + + (func (export "caml_dynlink_lookup_symbol") + (param (ref eq) (ref eq)) (result (ref eq)) + (call $caml_failwith (@string "Dll.dll_sym is not supported")) + (ref.i31 (i32.const 0))) ) From 7247d59fef38f3edca630687036540e729a06890 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 8/9] 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 5cf809bb52..65b847d3a2 100644 --- a/manual/wasm_overview.wiki +++ b/manual/wasm_overview.wiki @@ -53,6 +53,27 @@ one can enable the CPS transformation from {{{js_of_ocaml}}} by passing the [[https://github.com/WebAssembly/js-promise-integration/blob/main/proposals/js-promise-integration/Overview.md|the JavaScript-Promise Integration extension]]. The CPS transformation is not the default since the generated code is slower, larger and less readable. On the other hand, the JSPI extension is not yet enabled by default in Web browsers, and performing effects is slower when using this extension. +== 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. To generate a binary that runs with Wasmtime, add the +{{{--enable exnref}}} flag. + +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. + == Binding with Javascript libraries == Js_of_ocaml lets the user bind their code with Javascript libraries by linking in {{{.js}}} files. Similarly, wasm_of_ocaml allows to link in Wasm modules ({{{.wasm}}} or {{{.wat}}} files): see [[wasm_runtime|Writing Wasm primitives]]. If a js_of_ocaml projects uses some {{{external}}} primitives defined in companion {{{.js}}} files, it will need the same primitives to be implemented in Wasm module in order to be build with wasm_of_ocaml. From 8c5a20c99bc46681f5a726ef41e5864cc298f159 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 9/9] Changes --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index 25ddb1a34e..c2f08709be 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,7 @@ * Compiler/wasm: specialization of number comparisons and bigarray operations (#1954) * Compiler/wasm: make the type of some Wasm primitives more precise (#2100) * Compiler: reference unboxing (#1958) +* Compiler/wasm: WASI 0.1 support (#1831) ## Bug fixes * Compiler: fix purity of comparison functions (again) (#2092)