WASI runtime

Author: vouillon

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
 

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,21 +118,26 @@ 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" ]
         ~opt_options:[ "-g"; "-O2" ]
         ~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';

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

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,25 +123,31 @@ 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
         let wasm_files, rest =
           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 ->

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

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
@@ -1408,6 +1408,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
@@ -1448,19 +1460,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 ]
@@ -1482,14 +1489,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 ]))
 
@@ -1534,19 +1539,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 ])
@@ -1567,18 +1567,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 =
@@ -1951,21 +1948,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)

compiler/lib-wasm/generate.ml

@@ -225,7 +225,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)
@@ -236,7 +236,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)

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

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