WASI runtime

Author: vouillon

compiler/bin-wasm_of_ocaml/compile.ml

@@ -165,7 +165,10 @@ let link_and_optimize
   @@ fun opt_temp_sourcemap' ->
   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
@@ -273,7 +276,13 @@ let build_js_runtime ~primitives ?runtime_arguments () =
   in
   let prelude = Link.output_js always_required_js 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

compiler/bin-wasm_of_ocaml/gen/gen.ml

@@ -25,7 +25,7 @@ let print_flags f flags =
 let () =
   let () = set_binary_mode_out stdout true in
   Format.printf
-    "let js_runtime = \"%s\"@."
+    "let js_launcher = \"%s\"@."
     (String.escaped (read_file (open_in_bin Sys.argv.(1))));
   Format.printf
     "let dependencies = \"%s\"@."

compiler/lib-wasm/binaryen.ml

@@ -36,6 +36,7 @@ let common_options () =
     ; "--enable-bulk-memory"
     ; "--enable-nontrapping-float-to-int"
     ; "--enable-strings"
+    ; "--enable-multimemory" (* To keep wasm-merge happy *)
     ]
   in
   if Config.Flag.pretty () then "-g" :: l else l
@@ -111,9 +112,9 @@ let dead_code_elimination
   filter_unused_primitives primitives usage_file
 
 let optimization_options =
-  [| [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-   ; [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-   ; [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+  [| [ "-O2"; "--skip-pass=inlining-optimizing" ]
+   ; [ "-O2"; "--skip-pass=inlining-optimizing" ]
+   ; [ "-O3"; "--skip-pass=inlining-optimizing" ]
   |]
 
 let optimize
@@ -132,6 +133,7 @@ let optimize
   command
     ("wasm-opt"
      :: (common_options ()
+        @ (if Config.Flag.trap_on_exception () then [] else [ "--traps-never-happen" ])
         @ Option.value ~default:optimization_options.(level - 1) options
         @ [ Filename.quote input_file; "-o"; Filename.quote output_file ])
     @ opt_flag "--input-source-map" opt_input_sourcemap

compiler/lib-wasm/gc_target.ml

@@ -573,9 +573,13 @@ module Value = struct
        return ())
       (val_int (if negate then Arith.eqz n else n))
 
-  let eq x y = eq_gen ~negate:false x y
+  let eq x y =
+    if Config.Flag.wasi () then val_int (ref_eq x y) else eq_gen ~negate:false x y
 
-  let neq x y = eq_gen ~negate:true x y
+  let neq x y =
+    if Config.Flag.wasi ()
+    then val_int (Arith.eqz (ref_eq x y))
+    else eq_gen ~negate:true x y
 
   let ult = binop Arith.(ult)
 
@@ -1294,7 +1298,12 @@ module Math = struct
     { W.params = List.init ~len:n ~f:(fun _ : W.value_type -> F64); result = [ F64 ] }
 
   let unary name x =
-    let* f = register_import ~import_module:"Math" ~name (Fun (float_func_type 1)) in
+    let* f =
+      register_import
+        ~import_module:(if Config.Flag.wasi () then "env" else "Math")
+        ~name
+        (Fun (float_func_type 1))
+    in
     let* x = x in
     return (W.Call (f, [ x ]))
 
@@ -1337,7 +1346,12 @@ module Math = struct
   let log10 f = unary "log10" f
 
   let binary name x y =
-    let* f = register_import ~import_module:"Math" ~name (Fun (float_func_type 2)) in
+    let* f =
+      register_import
+        ~import_module:(if Config.Flag.wasi () then "env" else "Math")
+        ~name
+        (Fun (float_func_type 2))
+    in
     let* x = x in
     let* y = y in
     return (W.Call (f, [ x; y ]))
@@ -1682,21 +1696,34 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
          x
          (block_expr
             { params = []; result = [ Value.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, Value.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 = [ Value.value ] }
+                   (body
+                      ~result_typ:[ Value.value ]
+                      ~fall_through:`Skip
+                      ~context:(`Skip :: `Catch :: context))
+                   [ ocaml_tag, 0, Value.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, Value.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/wat_output.ml

@@ -444,19 +444,23 @@ let expression_or_instructions ctx st in_function =
             @ [ List (Atom "else" :: expression iff) ])
         ]
     | Try (ty, body, catches) ->
-        [ List
-            (Atom "try"
-            :: (block_type st ty
-               @ List (Atom "do" :: instructions body)
-                 :: List.map
-                      ~f:(fun (tag, i, ty) ->
-                        List
-                          (Atom "catch"
-                          :: index st.tag_names tag
-                          :: (instruction (Wasm_ast.Event Code_generation.hidden_location)
-                             @ instruction (Wasm_ast.Br (i + 1, Some (Pop ty))))))
-                      catches))
-        ]
+        if Config.Flag.trap_on_exception ()
+        then [ List (Atom "block" :: (block_type st ty @ instructions body)) ]
+        else
+          [ List
+              (Atom "try"
+              :: (block_type st ty
+                 @ List (Atom "do" :: instructions body)
+                   :: List.map
+                        ~f:(fun (tag, i, ty) ->
+                          List
+                            (Atom "catch"
+                            :: index st.tag_names tag
+                            :: (instruction
+                                  (Wasm_ast.Event Code_generation.hidden_location)
+                               @ instruction (Wasm_ast.Br (i + 1, Some (Pop ty))))))
+                        catches))
+          ]
   and instruction i =
     match i with
     | Drop e -> [ List (Atom "drop" :: expression e) ]
@@ -499,8 +503,14 @@ let expression_or_instructions ctx st in_function =
             | None -> []
             | Some e -> expression e))
         ]
-    | Throw (tag, e) -> [ List (Atom "throw" :: index st.tag_names tag :: expression e) ]
-    | Rethrow i -> [ List [ Atom "rethrow"; Atom (string_of_int i) ] ]
+    | Throw (tag, e) ->
+        if Config.Flag.trap_on_exception ()
+        then [ List [ Atom "unreachable" ] ]
+        else [ List (Atom "throw" :: index st.tag_names tag :: expression e) ]
+    | Rethrow i ->
+        if Config.Flag.trap_on_exception ()
+        then [ List [ Atom "unreachable" ] ]
+        else [ List [ Atom "rethrow"; Atom (string_of_int i) ] ]
     | CallInstr (f, l) ->
         [ List
             (Atom "call"

compiler/lib-wasm/wat_preprocess.ml

@@ -410,26 +410,42 @@ and rewrite st elt =
   | { desc =
         List
           ({ desc = Atom "try"; _ }
-          :: ( { desc = List ({ desc = Atom "result"; _ } :: _); _ }
-               :: { desc = List ({ desc = Atom "do"; loc = _, pos_after_do } :: body)
-                  ; loc = _, pos_after_body
-                  }
-               :: _
-             | { desc = List ({ desc = Atom "do"; loc = _, pos_after_do } :: body)
-               ; loc = _, pos_after_body
-               }
-               :: _ ))
+          :: { desc = List ({ desc = Atom "result"; _ } :: _)
+             ; loc = pos_before_result, pos_after_result
+             }
+          :: { desc = List ({ desc = Atom "do"; loc = _, pos_after_do } :: body)
+             ; loc = _, pos_after_body
+             }
+          :: _)
+    ; loc = pos, pos'
+    }
+    when variable_is_set st "trap-on-exception" ->
+      write st pos;
+      Buffer.add_string st.buf "(block";
+      skip st pos_before_result;
+      write st pos_after_result;
+      skip st pos_after_do;
+      rewrite_list st body;
+      write st pos_after_body;
+      skip st pos'
+  | { desc =
+        List
+          ({ desc = Atom "try"; _ }
+          :: { desc = List ({ desc = Atom "do"; loc = _, pos_after_do } :: body)
+             ; loc = _, pos_after_body
+             }
+          :: _)
     ; loc = pos, pos'
     }
-    when false (*ZZZ StringMap.find "trap-on-exception" st.variables*) ->
+    when variable_is_set st "trap-on-exception" ->
       write st pos;
       Buffer.add_string st.buf "(block";
       skip st pos_after_do;
       rewrite_list st body;
       write st pos_after_body;
       skip st pos'
   | { desc = List ({ desc = Atom "throw"; _ } :: _); loc = pos, pos' }
-    when false (*ZZZ StringMap.find "trap-on-exception" st.variables*) ->
+    when variable_is_set st "trap-on-exception" ->
       write st pos;
       Buffer.add_string st.buf "(unreachable)";
       skip st pos'

compiler/lib/config.ml

@@ -101,6 +101,10 @@ module Flag = struct
   let auto_link = o ~name:"auto-link" ~default:true
 
   let es6 = o ~name:"es6" ~default:false
+
+  let wasi = o ~name:"wasi" ~default:false
+
+  let trap_on_exception = o ~name:"trap-on-exception" ~default:false
 end
 
 module Param = struct

compiler/lib/config.mli

@@ -76,6 +76,10 @@ module Flag : sig
 
   val es6 : unit -> bool
 
+  val wasi : unit -> bool
+
+  val trap_on_exception : unit -> bool
+
   val enable : string -> unit
 
   val disable : string -> unit

compiler/lib/inline.ml

@@ -328,7 +328,7 @@ let inline ~first_class_primitives live_vars closures name pc (outer, p) =
 
 let times = Debug.find "times"
 
-let f p live_vars =
+let f p (live_vars : Deadcode.variable_uses) =
   let first_class_primitives =
     match Config.target (), Config.effects () with
     | `JavaScript, `Disabled -> true

compiler/tests-jsoo/dune

@@ -5,6 +5,8 @@
  (enabled_if
   (>= %{ocaml_version} 4.14))
  (inline_tests
+  (deps
+   (sandbox preserve_file_kind))
   (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
@@ -16,6 +18,8 @@
  (enabled_if
   (>= %{ocaml_version} 5.1.1))
  (inline_tests
+  (deps
+   (sandbox preserve_file_kind))
   (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
@@ -27,6 +31,21 @@
  (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)
+ (enabled_if
+  (<> %{profile} wasi))
+ (inline_tests
+  (deps
+   (sandbox preserve_file_kind))
   (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
@@ -41,13 +60,16 @@
    test_float16
    test_marshal_compressed
    test_parsing
+   test_unix_perms
    calc_parser
    calc_lexer))
  (libraries unix compiler-libs.common js_of_ocaml-compiler)
  (foreign_stubs
   (language c)
   (names bigarray_stubs))
  (inline_tests
+  (deps
+   (sandbox preserve_file_kind))
   (modes js wasm best))
  (preprocess
   (pps ppx_expect)))