Simplify handling of bound errors and division by zero

ocaml-wasm · May 16, 2024 · 819df87 · 819df87
1 parent d5ce7be
commit 819df87
Show file tree

Hide file tree

Showing 4 changed files with 51 additions and 51 deletions.
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
@@ -735,11 +735,7 @@ module Generate (Target : Wa_target_sig.S) = struct
           { params = []; result = [] }
           (body ~result_typ:[] ~fall_through:(`Block pc) ~context:(`Block pc :: context))
       in
-      if List.is_empty result_typ
-      then handler
-      else
-        let* () = handler in
-        instr (W.Return (Some (RefI31 (Const (I32 0l)))))
+      handler
     else body ~result_typ ~fall_through ~context
 
   let wrap_with_handlers p pc ~result_typ ~fall_through ~context body =
@@ -748,18 +744,20 @@ module Generate (Target : Wa_target_sig.S) = struct
       need_bound_error_handler
       bound_error_pc
       (let* f =
-         register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
+         register_import
+           ~name:"caml_bound_error"
+           (Fun { params = []; result = [ Value.value ] })
        in
-       instr (CallInstr (f, [])))
+       instr (Return_call (f, [])))
       (wrap_with_handler
          need_zero_divide_handler
          zero_divide_pc
          (let* f =
             register_import
               ~name:"caml_raise_zero_divide"
-              (Fun { params = []; result = [] })
+              (Fun { params = []; result = [ Value.value ] })
           in
-          instr (CallInstr (f, [])))
+          instr (Return_call (f, [])))
          body)
       ~result_typ
       ~fall_through

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
@@ -44,7 +44,7 @@
    (import "bindings" "ta_subarray"
       (func $ta_subarray
          (param (ref extern)) (param i32) (param i32) (result (ref extern))))
-   (import "fail" "caml_bound_error" (func $caml_bound_error))
+   (import "fail" "caml_bound_error" (func $caml_bound_error (result (ref eq))))
    (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
@@ -953,7 +953,7 @@
       (if (i32.ge_u (local.get $i)
              (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i)))
 
    (func (export "caml_ba_set_1")
@@ -967,7 +967,7 @@
       (if (i32.ge_u (local.get $i)
              (array.get $int_array (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $i) (local.get $v))
       (ref.i31 (i32.const 0)))
@@ -1005,7 +1005,7 @@
              (i32.ge_u (local.get $j)
                 (array.get $int_array (local.get $dim) (i32.const 1))))
          (then
-            (call $caml_bound_error)))
+            (return_call $caml_bound_error)))
       (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $offset)))
 
    (func (export "caml_ba_set_2")
@@ -1041,7 +1041,7 @@
              (i32.ge_u (local.get $j)
                 (array.get $int_array (local.get $dim) (i32.const 1))))
          (then
-            (call $caml_bound_error)))
+            (return_call $caml_bound_error)))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $offset) (local.get $v))
       (ref.i31 (i32.const 0)))
@@ -1099,7 +1099,7 @@
                 (i32.ge_u (local.get $j)
                    (array.get $int_array (local.get $dim) (i32.const 2)))))
          (then
-            (call $caml_bound_error)))
+            (return_call $caml_bound_error)))
       (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $offset)))
 
    (func (export "caml_ba_set_3")
@@ -1152,7 +1152,7 @@
                 (i32.ge_u (local.get $k)
                    (array.get $int_array (local.get $dim) (i32.const 2)))))
          (then
-            (call $caml_bound_error)))
+            (return_call $caml_bound_error)))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $offset) (local.get $v))
       (ref.i31 (i32.const 0)))
@@ -1183,7 +1183,7 @@
                         (array.get $int_array (local.get $dim) (local.get $i)))
                      (if (i32.ge_u (local.get $idx) (local.get $l))
                         (then
-                           (call $caml_bound_error)))
+                           (drop (call $caml_bound_error))))
                      (local.set $offset
                         (i32.add (i32.mul (local.get $offset) (local.get $l))
                            (local.get $idx)))
@@ -1201,7 +1201,7 @@
                         (array.get $int_array (local.get $dim) (local.get $i)))
                      (if (i32.ge_u (local.get $idx) (local.get $l))
                         (then
-                           (call $caml_bound_error)))
+                           (drop (call $caml_bound_error))))
                      (local.set $offset
                         (i32.add (i32.mul (local.get $offset) (local.get $l))
                            (local.get $idx)))
@@ -1234,7 +1234,7 @@
                         (array.get $int_array (local.get $dim) (local.get $i)))
                      (if (i32.ge_u (local.get $idx) (local.get $l))
                         (then
-                           (call $caml_bound_error)))
+                           (drop (call $caml_bound_error))))
                      (local.set $offset
                         (i32.add (i32.mul (local.get $offset) (local.get $l))
                            (local.get $idx)))
@@ -1255,7 +1255,7 @@
                         (array.get $int_array (local.get $dim) (local.get $i)))
                      (if (i32.ge_u (local.get $idx) (local.get $l))
                         (then
-                           (call $caml_bound_error)))
+                           (drop (call $caml_bound_error))))
                      (local.set $offset
                         (i32.add (i32.mul (local.get $offset) (local.get $l))
                            (local.get $idx)))
@@ -1889,12 +1889,12 @@
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
              (array.get $int_array
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (ref.i31 (i32.or
                   (call $ta_get_ui8 (local.get $data) (local.get $p))
                   (i32.shl (call $ta_get_ui8 (local.get $data)
@@ -1910,12 +1910,12 @@
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
              (array.get $int_array
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (return_call $caml_copy_int32
          (i32.or
             (i32.or
@@ -1940,12 +1940,12 @@
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
              (array.get $int_array
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (return_call $caml_copy_int64
          (i64.or
             (i64.or
@@ -1996,12 +1996,12 @@
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (local.set $d (ref.cast (ref i31) (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
              (array.get $int_array
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (call $ta_set_ui8 (local.get $data) (local.get $p) (local.get $d))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 1))
@@ -2019,12 +2019,12 @@
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (local.set $d (call $Int32_val (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
              (array.get $int_array
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (call $ta_set_ui8 (local.get $data) (local.get $p)
          (ref.i31 (local.get $d)))
       (call $ta_set_ui8 (local.get $data)
@@ -2049,12 +2049,12 @@
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (local.set $d (call $Int64_val (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
              (array.get $int_array
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (call $ta_set_ui8 (local.get $data) (local.get $p)
          (ref.i31 (i32.wrap_i64 (local.get $d))))
       (call $ta_set_ui8 (local.get $data)

diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
@@ -56,10 +56,11 @@
 
    (data $index_out_of_bounds "index out of bounds")
 
-   (func (export "caml_bound_error")
-      (return_call $caml_invalid_argument
+   (func (export "caml_bound_error") (result (ref eq))
+      (call $caml_invalid_argument
          (array.new_data $string $index_out_of_bounds
-            (i32.const 0) (i32.const 19))))
+            (i32.const 0) (i32.const 19)))
+      (i31.new (i32.const 0)))
 
    (global $END_OF_FILE_EXN i32 (i32.const 4))
 
@@ -70,10 +71,11 @@
 
    (global $ZERO_DIVIDE_EXN i32 (i32.const 5))
 
-   (func (export "caml_raise_zero_divide")
-      (return_call $caml_raise_constant
+   (func (export "caml_raise_zero_divide") (result (ref eq))
+      (call $caml_raise_constant
          (array.get $block (global.get $caml_global_data)
-                    (global.get $ZERO_DIVIDE_EXN))))
+                    (global.get $ZERO_DIVIDE_EXN)))
+      (i31.new (i32.const 0)))
 
    (global $NOT_FOUND_EXN i32 (i32.const 6))
 

diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
@@ -1,5 +1,5 @@
 (module
-   (import "fail" "caml_bound_error" (func $caml_bound_error))
+   (import "fail" "caml_bound_error" (func $caml_bound_error (result (ref eq))))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param $arg (ref eq))))
    (import "int32" "caml_copy_int32"
@@ -153,10 +153,10 @@
       (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
                     (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (ref.i31 (i32.or
                   (array.get_u $string (local.get $s) (local.get $p))
                   (i32.shl (array.get_u $string (local.get $s)
@@ -170,10 +170,10 @@
       (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
                     (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (return_call $caml_copy_int32
          (i32.or
             (i32.or
@@ -196,10 +196,10 @@
       (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
                     (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (return_call $caml_copy_int64
          (i64.or
             (i64.or
@@ -246,10 +246,10 @@
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
       (local.set $v (i31.get_s (ref.cast (ref i31) (local.get 2))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
                     (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (array.set $string (local.get $s) (local.get $p) (local.get $v))
       (array.set $string (local.get $s)
          (i32.add (local.get $p) (i32.const 1))
@@ -263,10 +263,10 @@
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
       (local.set $v (call $Int32_val (local.get 2)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
                     (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (array.set $string (local.get $s) (local.get $p) (local.get $v))
       (array.set $string (local.get $s)
          (i32.add (local.get $p) (i32.const 1))
@@ -286,10 +286,10 @@
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
       (local.set $v (call $Int64_val (local.get 2)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
                     (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
+         (then (return_call $caml_bound_error)))
       (array.set $string (local.get $s) (local.get $p)
          (i32.wrap_i64 (local.get $v)))
       (array.set $string (local.get $s)