From 1adc774de6b2bd2c5400d6924aa19441b8763b62 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 8276444458..c5a7a5d355 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/compiler/lib-wasm/binaryen.ml @@ -131,6 +131,7 @@ let optimize in command ("wasm-opt" + :: "--emit-exnref" :: (common_options () @ Option.value ~default:optimization_options.(level - 1) options @ [ Filename.quote input_file; "-o"; Filename.quote output_file ]) From 689e38cc3617d7b613dbf7aa8987d17063e63606 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.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/tools/node_wrapper.ml b/tools/node_wrapper.ml index 9d58203591..6fbc9cd904 100644 --- a/tools/node_wrapper.ml +++ b/tools/node_wrapper.ml @@ -1,6 +1,7 @@ let extra_args_for_wasoo = [ "--experimental-wasm-imported-strings" ; "--experimental-wasm-stack-switching" + ; "--experimental-wasm-exnref" ; "--stack-size=10000" ] From 042cddba5404d5c5bc61a59073358fa7e3a74bd1 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 | 12 +++++---- runtime/wasm/string.wat | 26 ++++++++++---------- 4 files changed, 50 insertions(+), 50 deletions(-) diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index 45f76c6f27..c9c191e538 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -823,11 +823,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 = @@ -836,18 +832,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 (Some (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 (Some (Call (f, []))))) body) ~result_typ ~fall_through diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index 2322ccf192..1fa0b4ae7b 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -77,7 +77,7 @@ (func $ta_blit_to_bytes (param (ref extern)) (param i32) (param (ref $bytes)) (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)))) @@ -1062,7 +1062,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") @@ -1076,7 +1076,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))) @@ -1114,7 +1114,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") @@ -1150,7 +1150,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))) @@ -1208,7 +1208,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") @@ -1261,7 +1261,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))) @@ -1292,7 +1292,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))) @@ -1310,7 +1310,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))) @@ -1343,7 +1343,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))) @@ -1364,7 +1364,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))) @@ -2011,12 +2011,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 (drop (call $caml_bound_error)))) (ref.i31 (call $ta_get16_ui8 (local.get $data) (local.get $p)))) (func (export "caml_ba_uint8_get32") @@ -2028,12 +2028,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 (drop (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 (drop (call $caml_bound_error)))) (return_call $ta_get32_ui8 (local.get $data) (local.get $p))) (func (export "caml_ba_uint8_get64") @@ -2045,12 +2045,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 (drop (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 (drop (call $caml_bound_error)))) (i64.or (i64.extend_i32_u (call $ta_get32_ui8 (local.get $data) (local.get $p))) @@ -2070,12 +2070,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))) @@ -2089,12 +2089,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))) @@ -2108,12 +2108,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 04a6092a0e..445956fea5 100644 --- a/runtime/wasm/fail.wat +++ b/runtime/wasm/fail.wat @@ -73,8 +73,9 @@ (@string $index_out_of_bounds "index out of bounds") - (func (export "caml_bound_error") - (return_call $caml_invalid_argument (global.get $index_out_of_bounds))) + (func (export "caml_bound_error") (result (ref eq)) + (call $caml_invalid_argument (global.get $index_out_of_bounds)) + (ref.i31 (i32.const 0))) (global $END_OF_FILE_EXN i32 (i32.const 4)) @@ -85,10 +86,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 66183061b4..45b3ed5fc8 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)))) @@ -159,10 +159,10 @@ (local.set $s (ref.cast (ref $bytes) (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 (drop (call $caml_bound_error)))) (ref.i31 (i32.or (array.get_u $bytes (local.get $s) (local.get $p)) (i32.shl (array.get_u $bytes (local.get $s) @@ -176,10 +176,10 @@ (local.set $s (ref.cast (ref $bytes) (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 (drop (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 (drop (call $caml_bound_error)))) (i32.or (i32.or (array.get_u $bytes (local.get $s) (local.get $p)) @@ -201,10 +201,10 @@ (local.set $s (ref.cast (ref $bytes) (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 (drop (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 (drop (call $caml_bound_error)))) (i64.or (i64.or (i64.or @@ -250,10 +250,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 $bytes (local.get $s) (local.get $p) (local.get $v)) (array.set $bytes (local.get $s) (i32.add (local.get $p) (i32.const 1)) @@ -266,10 +266,10 @@ (local.set $s (ref.cast (ref $bytes) (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 $bytes (local.get $s) (local.get $p) (local.get $v)) (array.set $bytes (local.get $s) (i32.add (local.get $p) (i32.const 1)) @@ -288,10 +288,10 @@ (local.set $s (ref.cast (ref $bytes) (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 $bytes (local.get $s) (local.get $p) (i32.wrap_i64 (local.get $v))) (array.set $bytes (local.get $s) From 2fc08ebe525edddaa75bfecc43e98b36bc31155b 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. --- compiler/lib-wasm/generate.ml | 16 ++++++------ runtime/wasm/bigarray.wat | 46 +++++++++++++++++------------------ runtime/wasm/fail.wat | 12 ++++----- runtime/wasm/string.wat | 26 ++++++++++---------- 4 files changed, 50 insertions(+), 50 deletions(-) diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index c9c191e538..45f76c6f27 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -823,7 +823,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 = @@ -832,20 +836,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 (Some (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 (Some (Call (f, []))))) + instr (CallInstr (f, []))) body) ~result_typ ~fall_through diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index 1fa0b4ae7b..2322ccf192 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -77,7 +77,7 @@ (func $ta_blit_to_bytes (param (ref extern)) (param i32) (param (ref $bytes)) (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)))) @@ -1062,7 +1062,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") @@ -1076,7 +1076,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))) @@ -1114,7 +1114,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") @@ -1150,7 +1150,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))) @@ -1208,7 +1208,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") @@ -1261,7 +1261,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))) @@ -1292,7 +1292,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))) @@ -1310,7 +1310,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))) @@ -1343,7 +1343,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))) @@ -1364,7 +1364,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))) @@ -2011,12 +2011,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 (drop (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") @@ -2028,12 +2028,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 (drop (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 (drop (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") @@ -2045,12 +2045,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 (drop (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 (drop (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))) @@ -2070,12 +2070,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))) @@ -2089,12 +2089,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))) @@ -2108,12 +2108,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 445956fea5..f0de7224fd 100644 --- a/runtime/wasm/fail.wat +++ b/runtime/wasm/fail.wat @@ -73,9 +73,8 @@ (@string $index_out_of_bounds "index out of bounds") - (func (export "caml_bound_error") (result (ref eq)) - (call $caml_invalid_argument (global.get $index_out_of_bounds)) - (ref.i31 (i32.const 0))) + (func (export "caml_bound_error") + (call $caml_invalid_argument (global.get $index_out_of_bounds))) (global $END_OF_FILE_EXN i32 (i32.const 4)) @@ -86,11 +85,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 45b3ed5fc8..66183061b4 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)))) @@ -159,10 +159,10 @@ (local.set $s (ref.cast (ref $bytes) (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 (drop (call $caml_bound_error)))) + (then (call $caml_bound_error))) (ref.i31 (i32.or (array.get_u $bytes (local.get $s) (local.get $p)) (i32.shl (array.get_u $bytes (local.get $s) @@ -176,10 +176,10 @@ (local.set $s (ref.cast (ref $bytes) (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 (drop (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 (drop (call $caml_bound_error)))) + (then (call $caml_bound_error))) (i32.or (i32.or (array.get_u $bytes (local.get $s) (local.get $p)) @@ -201,10 +201,10 @@ (local.set $s (ref.cast (ref $bytes) (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 (drop (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 (drop (call $caml_bound_error)))) + (then (call $caml_bound_error))) (i64.or (i64.or (i64.or @@ -250,10 +250,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 $bytes (local.get $s) (local.get $p) (local.get $v)) (array.set $bytes (local.get $s) (i32.add (local.get $p) (i32.const 1)) @@ -266,10 +266,10 @@ (local.set $s (ref.cast (ref $bytes) (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 $bytes (local.get $s) (local.get $p) (local.get $v)) (array.set $bytes (local.get $s) (i32.add (local.get $p) (i32.const 1)) @@ -288,10 +288,10 @@ (local.set $s (ref.cast (ref $bytes) (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 $bytes (local.get $s) (local.get $p) (i32.wrap_i64 (local.get $v))) (array.set $bytes (local.get $s) From f6f62d16dcac240e51c7490c8cc786d7b0cd0a43 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 febd2c650e..2c85e5b6aa 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 27c2307801..a3b02f11ae 100644 --- a/compiler/lib-wasm/wat_output.ml +++ b/compiler/lib-wasm/wat_output.ml @@ -445,17 +445,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