Add flag trap-on-exception

To test with Wasm engines which do not support exceptions

Author: vouillon

compiler/bin-wasm_of_ocaml/compile.ml

@@ -86,6 +86,7 @@ let preprocessor_variables () =
         | `Cps -> "cps"
         | `Double_translation -> assert false) )
   ; "wasi", Wat_preprocess.Bool (Config.Flag.wasi ())
+  ; "trap-on-exception", Wat_preprocess.Bool (Config.Flag.trap_on_exception ())
   ]
 
 let with_runtime_files ~runtime_wasm_files f =

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 = [ "trap-on-exception", `B false ]
 
 let interesting_runtimes =
   [ [ "effects", `S "jspi"; "wasi", `B false ]

compiler/lib-wasm/binaryen.ml

@@ -123,9 +123,9 @@ let dead_code_elimination
   filter_unused_primitives primitives usage_file
 
 let optimization_options : Profile.t -> _ = function
-  | O1 -> [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-  | O2 -> [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-  | O3 -> [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+  | O1 -> [ "-O2"; "--skip-pass=inlining-optimizing" ]
+  | O2 -> [ "-O2"; "--skip-pass=inlining-optimizing" ]
+  | O3 -> [ "-O3"; "--skip-pass=inlining-optimizing" ]
 
 let optimize
     ~profile
@@ -138,6 +138,7 @@ let optimize
   command
     ("wasm-opt"
      :: (common_options ()
+        @ (if Config.Flag.trap_on_exception () then [] else [ "--traps-never-happen" ])
         @ (match options with
           | Some o -> o
           | None -> optimization_options profile)

compiler/lib-wasm/wat_output.ml

@@ -477,19 +477,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))
+          ]
     | ExternConvertAny e' -> [ List (Atom "extern.convert_any" :: expression e') ]
     | AnyConvertExtern e' -> [ List (Atom "any.convert_extern" :: expression e') ]
   and instruction i =
@@ -534,8 +538,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

@@ -416,6 +416,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

@@ -108,6 +108,8 @@ module Flag = struct
   let load_shapes_auto = o ~name:"load-shapes-auto" ~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