From 0731d7ad8ac0854f68da9ebd87615d57fb982e6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 4 Jul 2024 10:25:10 +0200 Subject: [PATCH 1/5] Make wasm-opt generate the new exception handling instructions --- compiler/lib-wasm/binaryen.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml index 24ce55a61..027db075c 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/compiler/lib-wasm/binaryen.ml @@ -123,6 +123,7 @@ let optimize ~profile ~opt_input_sourcemap ~input_file ~opt_output_sourcemap ~ou in command ("wasm-opt" + :: "--emit-exnref" :: (common_options () @ optimization_options.(level - 1) @ [ Filename.quote input_file; "-o"; Filename.quote output_file ]) From b915bb2e5691f57e6df32e3d642dcf1243b215af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 4 Jul 2024 10:25:18 +0200 Subject: [PATCH 2/5] Enable the new exception handling instructions in node --- tools/node_wrapper.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh index 9912795db..5e312f639 100755 --- a/tools/node_wrapper.sh +++ b/tools/node_wrapper.sh @@ -1,3 +1,3 @@ #!/bin/sh export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively -exec node --experimental-wasm-imported-strings --experimental-wasm-stack-switching --stack-size=10000 "$@" +exec node --experimental-wasm-exnref --experimental-wasm-imported-strings --experimental-wasm-stack-switching --stack-size=10000 "$@" From 4fec5b356f5ee265246277d9f717b12f7468d937 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Sun, 24 Mar 2024 23:51:33 +0100 Subject: [PATCH 3/5] Simplify handling of bound errors and division by zero --- compiler/lib-wasm/generate.ml | 16 ++++++------ runtime/wasm/bigarray.wat | 46 +++++++++++++++++------------------ runtime/wasm/fail.wat | 14 ++++++----- runtime/wasm/string.wat | 26 ++++++++++---------- 4 files changed, 51 insertions(+), 51 deletions(-) diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index e766b07b1..687f631c9 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -810,11 +810,7 @@ module Generate (Target : 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 = @@ -823,18 +819,20 @@ module Generate (Target : 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 index 812055eca..c981dedf0 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -77,7 +77,7 @@ (func $ta_blit_to_string (param (ref extern)) (param i32) (param (ref $string)) (param i32) (param i32))) - (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)))) @@ -974,7 +974,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") @@ -988,7 +988,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))) @@ -1026,7 +1026,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") @@ -1062,7 +1062,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))) @@ -1120,7 +1120,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))) (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $offset))) (func (export "caml_ba_set_3") @@ -1173,7 +1173,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))) @@ -1204,7 +1204,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))) @@ -1222,7 +1222,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))) @@ -1276,7 +1276,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))) @@ -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 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 (call $ta_get16_ui8 (local.get $data) (local.get $p)))) (func (export "caml_ba_uint8_get32") @@ -1927,12 +1927,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 $ta_get32_ui8 (local.get $data) (local.get $p))) (func (export "caml_ba_uint8_get64") @@ -1944,12 +1944,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))) (i64.or (i64.extend_i32_u (call $ta_get32_ui8 (local.get $data) (local.get $p))) @@ -1969,12 +1969,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_set16_ui8 (local.get $data) (local.get $p) (local.get $d)) (ref.i31 (i32.const 0))) @@ -1988,12 +1988,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))) (call $ta_set32_ui8 (local.get $data) (local.get $p) (local.get $d)) (ref.i31 (i32.const 0))) @@ -2007,12 +2007,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))) (call $ta_set32_ui8 (local.get $data) (local.get $p) (i32.wrap_i64 (local.get $d))) (call $ta_set32_ui8 (local.get $data) diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat index e3dc000d5..a19522030 100644 --- a/runtime/wasm/fail.wat +++ b/runtime/wasm/fail.wat @@ -73,10 +73,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))) + (ref.i31 (i32.const 0))) (global $END_OF_FILE_EXN i32 (i32.const 4)) @@ -87,10 +88,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))) + (ref.i31 (i32.const 0))) (global $NOT_FOUND_EXN i32 (i32.const 6)) diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat index bf43b2f9e..5bcf93ab8 100644 --- a/runtime/wasm/string.wat +++ b/runtime/wasm/string.wat @@ -16,7 +16,7 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (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)))) @@ -162,10 +162,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) @@ -179,10 +179,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))) (i32.or (i32.or (array.get_u $string (local.get $s) (local.get $p)) @@ -204,10 +204,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))) (i64.or (i64.or (i64.or @@ -253,10 +253,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)) @@ -269,10 +269,10 @@ (local.set $s (ref.cast (ref $string) (local.get 0))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1)))) (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)) @@ -291,10 +291,10 @@ (local.set $s (ref.cast (ref $string) (local.get 0))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1)))) (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) From 92c42968740b591126a5e2c36de2241aff493f78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Tue, 20 Aug 2024 21:33:04 +0200 Subject: [PATCH 4/5] Revert "Simplify handling of bound errors and division by zero" This reverts commit fc651d6352b70822017b888e97158ec144fac73e. --- .github/workflows/build-wasm_of_ocaml.yml | 6 +-- compiler/lib-wasm/generate.ml | 16 ++++---- runtime/wasm/bigarray.wat | 46 +++++++++++------------ runtime/wasm/fail.wat | 14 +++---- runtime/wasm/string.wat | 26 ++++++------- 5 files changed, 54 insertions(+), 54 deletions(-) diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml index e0f394dc6..97a206ac2 100644 --- a/.github/workflows/build-wasm_of_ocaml.yml +++ b/.github/workflows/build-wasm_of_ocaml.yml @@ -49,7 +49,7 @@ jobs: uses: actions/cache/restore@v4 with: path: binaryen - key: ${{ runner.os }}-binaryen-version_118 + key: ${{ runner.os }}-binaryen-eh - name: Checkout binaryen if: steps.cache-binaryen.outputs.cache-hit != 'true' @@ -58,7 +58,7 @@ jobs: repository: WebAssembly/binaryen path: binaryen submodules: true - ref: version_118 + ref: d200d06fef7f4edd331c1f928493beb332a2d910 - name: Install ninja (Ubuntu) if: matrix.os == 'ubuntu-latest' && steps.cache-binaryen.outputs.cache-hit != 'true' @@ -80,7 +80,7 @@ jobs: uses: actions/cache/save@v4 with: path: binaryen - key: ${{ runner.os }}-binaryen-version_118 + key: ${{ runner.os }}-binaryen-eh - name: Set binaryen's path run: | diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index 687f631c9..e766b07b1 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -810,7 +810,11 @@ module Generate (Target : Target_sig.S) = struct { params = []; result = [] } (body ~result_typ:[] ~fall_through:(`Block pc) ~context:(`Block pc :: context)) in - handler + if List.is_empty result_typ + then handler + else + let* () = handler in + instr (W.Return (Some (RefI31 (Const (I32 0l))))) else body ~result_typ ~fall_through ~context let wrap_with_handlers p pc ~result_typ ~fall_through ~context body = @@ -819,20 +823,18 @@ module Generate (Target : Target_sig.S) = struct need_bound_error_handler bound_error_pc (let* f = - register_import - ~name:"caml_bound_error" - (Fun { params = []; result = [ Value.value ] }) + register_import ~name:"caml_bound_error" (Fun { params = []; result = [] }) in - instr (Return_call (f, []))) + instr (CallInstr (f, []))) (wrap_with_handler need_zero_divide_handler zero_divide_pc (let* f = register_import ~name:"caml_raise_zero_divide" - (Fun { params = []; result = [ Value.value ] }) + (Fun { params = []; result = [] }) in - instr (Return_call (f, []))) + instr (CallInstr (f, []))) body) ~result_typ ~fall_through diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index c981dedf0..812055eca 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -77,7 +77,7 @@ (func $ta_blit_to_string (param (ref extern)) (param i32) (param (ref $string)) (param i32) (param i32))) - (import "fail" "caml_bound_error" (func $caml_bound_error (result (ref eq)))) + (import "fail" "caml_bound_error" (func $caml_bound_error)) (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)))) @@ -974,7 +974,7 @@ (if (i32.ge_u (local.get $i) (array.get $int_array (struct.get $bigarray 2 (local.get $ba)) (i32.const 0))) - (then (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i))) (func (export "caml_ba_set_1") @@ -988,7 +988,7 @@ (if (i32.ge_u (local.get $i) (array.get $int_array (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) - (then (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (call $caml_ba_set_at_offset (local.get $ba) (local.get $i) (local.get $v)) (ref.i31 (i32.const 0))) @@ -1026,7 +1026,7 @@ (i32.ge_u (local.get $j) (array.get $int_array (local.get $dim) (i32.const 1)))) (then - (return_call $caml_bound_error))) + (call $caml_bound_error))) (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $offset))) (func (export "caml_ba_set_2") @@ -1062,7 +1062,7 @@ (i32.ge_u (local.get $j) (array.get $int_array (local.get $dim) (i32.const 1)))) (then - (return_call $caml_bound_error))) + (call $caml_bound_error))) (call $caml_ba_set_at_offset (local.get $ba) (local.get $offset) (local.get $v)) (ref.i31 (i32.const 0))) @@ -1120,7 +1120,7 @@ (i32.ge_u (local.get $k) (array.get $int_array (local.get $dim) (i32.const 2))))) (then - (return_call $caml_bound_error))) + (call $caml_bound_error))) (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $offset))) (func (export "caml_ba_set_3") @@ -1173,7 +1173,7 @@ (i32.ge_u (local.get $k) (array.get $int_array (local.get $dim) (i32.const 2))))) (then - (return_call $caml_bound_error))) + (call $caml_bound_error))) (call $caml_ba_set_at_offset (local.get $ba) (local.get $offset) (local.get $v)) (ref.i31 (i32.const 0))) @@ -1204,7 +1204,7 @@ (array.get $int_array (local.get $dim) (local.get $i))) (if (i32.ge_u (local.get $idx) (local.get $l)) (then - (drop (call $caml_bound_error)))) + (call $caml_bound_error))) (local.set $offset (i32.add (i32.mul (local.get $offset) (local.get $l)) (local.get $idx))) @@ -1222,7 +1222,7 @@ (array.get $int_array (local.get $dim) (local.get $i))) (if (i32.ge_u (local.get $idx) (local.get $l)) (then - (drop (call $caml_bound_error)))) + (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 - (drop (call $caml_bound_error)))) + (call $caml_bound_error))) (local.set $offset (i32.add (i32.mul (local.get $offset) (local.get $l)) (local.get $idx))) @@ -1276,7 +1276,7 @@ (array.get $int_array (local.get $dim) (local.get $i))) (if (i32.ge_u (local.get $idx) (local.get $l)) (then - (drop (call $caml_bound_error)))) + (call $caml_bound_error))) (local.set $offset (i32.add (i32.mul (local.get $offset) (local.get $l)) (local.get $idx))) @@ -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 (return_call $caml_bound_error))) + (then (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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (ref.i31 (call $ta_get16_ui8 (local.get $data) (local.get $p)))) (func (export "caml_ba_uint8_get32") @@ -1927,12 +1927,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 (return_call $caml_bound_error))) + (then (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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (return_call $ta_get32_ui8 (local.get $data) (local.get $p))) (func (export "caml_ba_uint8_get64") @@ -1944,12 +1944,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 (return_call $caml_bound_error))) + (then (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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (i64.or (i64.extend_i32_u (call $ta_get32_ui8 (local.get $data) (local.get $p))) @@ -1969,12 +1969,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 (return_call $caml_bound_error))) + (then (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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (call $ta_set16_ui8 (local.get $data) (local.get $p) (local.get $d)) (ref.i31 (i32.const 0))) @@ -1988,12 +1988,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 (return_call $caml_bound_error))) + (then (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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (call $ta_set32_ui8 (local.get $data) (local.get $p) (local.get $d)) (ref.i31 (i32.const 0))) @@ -2007,12 +2007,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 (return_call $caml_bound_error))) + (then (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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (call $ta_set32_ui8 (local.get $data) (local.get $p) (i32.wrap_i64 (local.get $d))) (call $ta_set32_ui8 (local.get $data) diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat index a19522030..e3dc000d5 100644 --- a/runtime/wasm/fail.wat +++ b/runtime/wasm/fail.wat @@ -73,11 +73,10 @@ (data $index_out_of_bounds "index out of bounds") - (func (export "caml_bound_error") (result (ref eq)) - (call $caml_invalid_argument + (func (export "caml_bound_error") + (return_call $caml_invalid_argument (array.new_data $string $index_out_of_bounds - (i32.const 0) (i32.const 19))) - (ref.i31 (i32.const 0))) + (i32.const 0) (i32.const 19)))) (global $END_OF_FILE_EXN i32 (i32.const 4)) @@ -88,11 +87,10 @@ (global $ZERO_DIVIDE_EXN i32 (i32.const 5)) - (func (export "caml_raise_zero_divide") (result (ref eq)) - (call $caml_raise_constant + (func (export "caml_raise_zero_divide") + (return_call $caml_raise_constant (array.get $block (global.get $caml_global_data) - (global.get $ZERO_DIVIDE_EXN))) - (ref.i31 (i32.const 0))) + (global.get $ZERO_DIVIDE_EXN)))) (global $NOT_FOUND_EXN i32 (i32.const 6)) diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat index 5bcf93ab8..bf43b2f9e 100644 --- a/runtime/wasm/string.wat +++ b/runtime/wasm/string.wat @@ -16,7 +16,7 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "fail" "caml_bound_error" (func $caml_bound_error (result (ref eq)))) + (import "fail" "caml_bound_error" (func $caml_bound_error)) (import "fail" "caml_invalid_argument" (func $caml_invalid_argument (param $arg (ref eq)))) @@ -162,10 +162,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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (if (i32.ge_u (i32.add (local.get $p) (i32.const 1)) (array.len (local.get $s))) - (then (return_call $caml_bound_error))) + (then (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) @@ -179,10 +179,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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (if (i32.ge_u (i32.add (local.get $p) (i32.const 3)) (array.len (local.get $s))) - (then (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (i32.or (i32.or (array.get_u $string (local.get $s) (local.get $p)) @@ -204,10 +204,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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (if (i32.ge_u (i32.add (local.get $p) (i32.const 7)) (array.len (local.get $s))) - (then (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (i64.or (i64.or (i64.or @@ -253,10 +253,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 (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (if (i32.ge_u (i32.add (local.get $p) (i32.const 1)) (array.len (local.get $s))) - (then (return_call $caml_bound_error))) + (then (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)) @@ -269,10 +269,10 @@ (local.set $s (ref.cast (ref $string) (local.get 0))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1)))) (if (i32.lt_s (local.get $p) (i32.const 0)) - (then (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (if (i32.ge_u (i32.add (local.get $p) (i32.const 3)) (array.len (local.get $s))) - (then (return_call $caml_bound_error))) + (then (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)) @@ -291,10 +291,10 @@ (local.set $s (ref.cast (ref $string) (local.get 0))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1)))) (if (i32.lt_s (local.get $p) (i32.const 0)) - (then (return_call $caml_bound_error))) + (then (call $caml_bound_error))) (if (i32.ge_u (i32.add (local.get $p) (i32.const 7)) (array.len (local.get $s))) - (then (return_call $caml_bound_error))) + (then (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) From 763627dfd0ad1ac8b6c54f43c2e5bcb14d624aa4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Tue, 20 Aug 2024 23:17:13 +0200 Subject: [PATCH 5/5] Emit try_table instruction --- compiler/lib-wasm/wasm_output.ml | 11 ++++++----- compiler/lib-wasm/wat_output.ml | 16 ++++++---------- 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/compiler/lib-wasm/wasm_output.ml b/compiler/lib-wasm/wasm_output.ml index 02fa6d6ad..be71e2e6b 100644 --- a/compiler/lib-wasm/wasm_output.ml +++ b/compiler/lib-wasm/wasm_output.ml @@ -648,15 +648,16 @@ end = struct output_byte ch 0x0B | Try (typ, l, catches) -> Feature.require exception_handling; - output_byte ch 0x06; + output_byte ch 0x1f; output_blocktype st.type_names ch typ; - List.iter ~f:(fun i' -> output_instruction st ch i') l; + output_uint ch (List.length catches); List.iter - ~f:(fun (tag, l, ty) -> - output_byte ch 0x07; + ~f:(fun (tag, l, _) -> + output_byte ch 0x00; output_uint ch (Hashtbl.find st.tag_names tag); - output_instruction st ch (Br (l + 1, Some (Pop ty)))) + output_uint ch l) catches; + List.iter ~f:(fun i' -> output_instruction st ch i') l; output_byte ch 0X0B and output_instruction st ch i = diff --git a/compiler/lib-wasm/wat_output.ml b/compiler/lib-wasm/wat_output.ml index 7f15a6b82..e0d042118 100644 --- a/compiler/lib-wasm/wat_output.ml +++ b/compiler/lib-wasm/wat_output.ml @@ -444,17 +444,13 @@ let expression_or_instructions ctx st in_function = ] | Try (ty, body, catches) -> [ List - (Atom "try" + (Atom "try_table" :: (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)) + @ List.map + ~f:(fun (tag, i, _ty) -> + List [ Atom "catch"; index st.tag_names tag; Atom (string_of_int i) ]) + catches + @ instructions body)) ] and instruction i = match i with