Add flag trap-on-exception

To test with Wasm engines which do not support exceptions

Author: vouillon

compiler/bin-wasm_of_ocaml/compile.ml

@@ -90,7 +90,9 @@ let with_runtime_files ~runtime_wasm_files f =
 
 let build_runtime ~runtime_file =
   (* Keep this variables in sync with gen/gen.ml *)
-  let variables = [ "wasi", Config.Flag.wasi () ] in
+  let variables =
+    [ "wasi", Config.Flag.wasi (); "trap-on-exception", Config.Flag.trap_on_exception () ]
+  in
   match
     List.find_opt Runtime_files.precompiled_runtimes ~f:(fun (flags, _) ->
         assert (

compiler/bin-wasm_of_ocaml/gen/gen.ml

@@ -3,7 +3,7 @@ let read_file ic = really_input_string ic (in_channel_length ic)
 (* Keep the two variables below in sync with function build_runtime in
    ../compile.ml *)
 
-let default_flags = []
+let default_flags = [ "trap-on-exception", false ]
 
 let interesting_runtimes = [ [ "wasi", false ]; [ "wasi", true ] ]
 

compiler/lib-wasm/binaryen.ml

@@ -112,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
@@ -133,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/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

@@ -407,6 +407,69 @@ let rec rewrite_list st l = List.iter ~f:(rewrite st) l
 
 and rewrite st elt =
   match elt with
+  | { desc =
+        List
+          ({ desc = Atom "try"; _ }
+          :: { 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 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 variable_is_set st "trap-on-exception" ->
+      write st pos;
+      Buffer.add_string st.buf "(unreachable)";
+      skip st pos'
+  | { desc = List ({ desc = Atom "tag"; _ } :: _); loc = pos, pos' }
+  | { desc =
+        List
+          ({ desc = Atom "import"; _ }
+          :: _
+          :: _
+          :: { desc = List ({ desc = Atom "tag"; _ } :: _); _ }
+          :: _)
+    ; loc = pos, pos'
+    }
+  | { desc =
+        List
+          ({ desc = Atom "export"; _ }
+          :: _
+          :: { desc = List ({ desc = Atom "tag"; _ } :: _); _ }
+          :: _)
+    ; loc = pos, pos'
+    }
+    when variable_is_set st "trap-on-exception" ->
+      write st pos;
+      skip st pos'
   | { desc =
         List
           [ { desc = Atom "@if"; _ }

compiler/lib/config.ml

@@ -103,6 +103,8 @@ module Flag = struct
   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

@@ -78,6 +78,8 @@ module Flag : sig
 
   val wasi : unit -> bool
 
+  val trap_on_exception : unit -> bool
+
   val enable : string -> unit
 
   val disable : string -> unit