From 8dbd814286080693d58ffabe8f296c5ec1b41488 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 4 Apr 2025 19:45:20 +0200 Subject: [PATCH 1/4] Wasm runtime: code reordering --- runtime/wasm/backtrace.wat | 4 +- runtime/wasm/bigarray.wat | 98 +++++++++++++++++++------------------- runtime/wasm/effect.wat | 6 +-- runtime/wasm/fs.wat | 4 +- runtime/wasm/io.wat | 80 +++++++++++++++++-------------- runtime/wasm/marshal.wat | 10 ++-- runtime/wasm/stdlib.wat | 16 ++++--- runtime/wasm/sys.wat | 25 ++++------ runtime/wasm/unix.wat | 18 +++---- runtime/wasm/weak.wat | 6 ++- 10 files changed, 137 insertions(+), 130 deletions(-) diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat index 9b63e4e554..6b351fb78d 100644 --- a/runtime/wasm/backtrace.wat +++ b/runtime/wasm/backtrace.wat @@ -16,12 +16,12 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module + (import "fail" "caml_invalid_argument" + (func $caml_invalid_argument (param (ref eq)))) (import "bindings" "backtrace_status" (func $backtrace_status (result (ref eq)))) (import "bindings" "record_backtrace" (func $record_backtrace (param (ref eq)))) - (import "fail" "caml_invalid_argument" - (func $caml_invalid_argument (param (ref eq)))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index 59cc22cd7f..8d45f18210 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -16,6 +16,55 @@ ;; 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_raise_out_of_memory" (func $caml_raise_out_of_memory)) + (import "fail" "caml_invalid_argument" + (func $caml_invalid_argument (param (ref eq)))) + (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq)))) + (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq)))) + (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref))) + (import "int32" "caml_copy_int32" + (func $caml_copy_int32 (param i32) (result (ref eq)))) + (import "int32" "Int32_val" + (func $Int32_val (param (ref eq)) (result i32))) + (import "int32" "caml_copy_nativeint" + (func $caml_copy_nativeint (param i32) (result (ref eq)))) + (import "int64" "caml_copy_int64" + (func $caml_copy_int64 (param i64) (result (ref eq)))) + (import "int64" "Int64_val" + (func $Int64_val (param (ref eq)) (result i64))) + (import "obj" "double_array_tag" (global $double_array_tag i32)) + (import "compare" "unordered" (global $unordered i32)) + (import "hash" "caml_hash_mix_int" + (func $caml_hash_mix_int (param i32) (param i32) (result i32))) + (import "hash" "caml_hash_mix_int64" + (func $caml_hash_mix_int64 (param i32) (param i64) (result i32))) + (import "hash" "caml_hash_mix_double" + (func $caml_hash_mix_double (param i32) (param f64) (result i32))) + (import "hash" "caml_hash_mix_float" + (func $caml_hash_mix_float (param i32) (param f32) (result i32))) + (import "hash" "caml_hash_mix_float16" + (func $caml_hash_mix_float16 (param i32) (param i32) (result i32))) + (import "marshal" "caml_serialize_int_1" + (func $caml_serialize_int_1 (param (ref eq)) (param i32))) + (import "marshal" "caml_serialize_int_2" + (func $caml_serialize_int_2 (param (ref eq)) (param i32))) + (import "marshal" "caml_serialize_int_4" + (func $caml_serialize_int_4 (param (ref eq)) (param i32))) + (import "marshal" "caml_serialize_int_8" + (func $caml_serialize_int_8 (param (ref eq)) (param i64))) + (import "marshal" "caml_deserialize_uint_1" + (func $caml_deserialize_uint_1 (param (ref eq)) (result i32))) + (import "marshal" "caml_deserialize_sint_1" + (func $caml_deserialize_sint_1 (param (ref eq)) (result i32))) + (import "marshal" "caml_deserialize_uint_2" + (func $caml_deserialize_uint_2 (param (ref eq)) (result i32))) + (import "marshal" "caml_deserialize_sint_2" + (func $caml_deserialize_sint_2 (param (ref eq)) (result i32))) + (import "marshal" "caml_deserialize_int_4" + (func $caml_deserialize_int_4 (param (ref eq)) (result i32))) + (import "marshal" "caml_deserialize_int_8" + (func $caml_deserialize_int_8 (param (ref eq)) (result i64))) (import "bindings" "ta_create" (func $ta_create (param i32) (param i32) (result (ref extern)))) (import "bindings" "ta_normalize" @@ -72,55 +121,6 @@ (import "bindings" "dv_set_i8" (func $dv_set_i8 (param externref i32 i32))) (import "bindings" "littleEndian" (global $littleEndian i32)) - (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)))) - (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq)))) - (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq)))) - (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref))) - (import "int32" "caml_copy_int32" - (func $caml_copy_int32 (param i32) (result (ref eq)))) - (import "int32" "Int32_val" - (func $Int32_val (param (ref eq)) (result i32))) - (import "int32" "caml_copy_nativeint" - (func $caml_copy_nativeint (param i32) (result (ref eq)))) - (import "int64" "caml_copy_int64" - (func $caml_copy_int64 (param i64) (result (ref eq)))) - (import "int64" "Int64_val" - (func $Int64_val (param (ref eq)) (result i64))) - (import "obj" "double_array_tag" (global $double_array_tag i32)) - (import "compare" "unordered" (global $unordered i32)) - (import "hash" "caml_hash_mix_int" - (func $caml_hash_mix_int (param i32) (param i32) (result i32))) - (import "hash" "caml_hash_mix_int64" - (func $caml_hash_mix_int64 (param i32) (param i64) (result i32))) - (import "hash" "caml_hash_mix_double" - (func $caml_hash_mix_double (param i32) (param f64) (result i32))) - (import "hash" "caml_hash_mix_float" - (func $caml_hash_mix_float (param i32) (param f32) (result i32))) - (import "hash" "caml_hash_mix_float16" - (func $caml_hash_mix_float16 (param i32) (param i32) (result i32))) - (import "marshal" "caml_serialize_int_1" - (func $caml_serialize_int_1 (param (ref eq)) (param i32))) - (import "marshal" "caml_serialize_int_2" - (func $caml_serialize_int_2 (param (ref eq)) (param i32))) - (import "marshal" "caml_serialize_int_4" - (func $caml_serialize_int_4 (param (ref eq)) (param i32))) - (import "marshal" "caml_serialize_int_8" - (func $caml_serialize_int_8 (param (ref eq)) (param i64))) - (import "marshal" "caml_deserialize_uint_1" - (func $caml_deserialize_uint_1 (param (ref eq)) (result i32))) - (import "marshal" "caml_deserialize_sint_1" - (func $caml_deserialize_sint_1 (param (ref eq)) (result i32))) - (import "marshal" "caml_deserialize_uint_2" - (func $caml_deserialize_uint_2 (param (ref eq)) (result i32))) - (import "marshal" "caml_deserialize_sint_2" - (func $caml_deserialize_sint_2 (param (ref eq)) (result i32))) - (import "marshal" "caml_deserialize_int_4" - (func $caml_deserialize_int_4 (param (ref eq)) (result i32))) - (import "marshal" "caml_deserialize_int_8" - (func $caml_deserialize_int_8 (param (ref eq)) (result i64))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat index 40aa1dc7c1..00ef85d8e8 100644 --- a/runtime/wasm/effect.wat +++ b/runtime/wasm/effect.wat @@ -25,6 +25,9 @@ (func $caml_fresh_oo_id (param (ref eq)) (result (ref eq)))) (import "obj" "cont_tag" (global $cont_tag i32)) (import "obj" "object_tag" (global $object_tag i32)) + (import "obj" "caml_callback_1" + (func $caml_callback_1 + (param (ref eq)) (param (ref eq)) (result (ref eq)))) (import "stdlib" "caml_named_value" (func $caml_named_value (param (ref eq)) (result (ref null eq)))) (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) @@ -38,9 +41,6 @@ (param $f funcref) (param $env eqref) (result anyref))) (import "bindings" "resume_fiber" (func $resume_fiber (param externref) (param (ref eq)))) - (import "obj" "caml_callback_1" - (func $caml_callback_1 - (param (ref eq)) (param (ref eq)) (result (ref eq)))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat index 898dabc6a6..ee97b2f011 100644 --- a/runtime/wasm/fs.wat +++ b/runtime/wasm/fs.wat @@ -40,14 +40,14 @@ (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq)))) (import "jslib" "caml_js_to_string_array" (func $caml_js_to_string_array (param $a (ref extern)) (result (ref eq)))) - (import "fail" "caml_raise_sys_error" - (func $caml_raise_sys_error (param (ref eq)))) (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) (import "sys" "caml_handle_sys_error" (func $caml_handle_sys_error (param externref))) (import "string" "caml_string_concat" (func $caml_string_concat (param (ref eq) (ref eq)) (result (ref eq)))) + (import "fail" "caml_raise_sys_error" + (func $caml_raise_sys_error (param (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat index b72f1600b1..b74db04e88 100644 --- a/runtime/wasm/io.wat +++ b/runtime/wasm/io.wat @@ -72,6 +72,10 @@ (func $dv_get_ui8 (param externref i32) (result i32))) (import "bindings" "dv_set_i8" (func $dv_set_i8 (param externref i32 i32))) + (import "fail" "javascript_exception" + (tag $javascript_exception (param externref))) + (import "sys" "caml_handle_sys_error" + (func $caml_handle_sys_error (param externref))) (import "custom" "custom_compare_id" (func $custom_compare_id (param (ref eq)) (param (ref eq)) (param i32) (result i32))) @@ -82,10 +86,6 @@ (func $caml_copy_int64 (param i64) (result (ref eq)))) (import "int64" "Int64_val" (func $Int64_val (param (ref eq)) (result i64))) - (import "fail" "javascript_exception" - (tag $javascript_exception (param externref))) - (import "sys" "caml_handle_sys_error" - (func $caml_handle_sys_error (param externref))) (import "bigarray" "caml_ba_get_data" (func $caml_ba_get_data (param (ref eq)) (result (ref extern)))) @@ -99,6 +99,25 @@ (import "bindings" "map_delete" (func $map_delete (param (ref extern)) (param i32))) + (func $ta_blit_from_buffer + (param $buf (ref extern)) (param $i i32) + (param $ta (ref extern)) (param $j i32) + (param $len i32) + (call $ta_set + (local.get $ta) + (call $ta_subarray (local.get $buf) (local.get $i) + (i32.add (local.get $i) (local.get $len))) + (local.get $j))) + + (func $ta_blit_to_buffer + (param $ta (ref extern)) (param $i i32) + (param $buf (ref extern)) (param $j i32) + (param $len i32) + (call $ta_set (local.get $buf) + (call $ta_subarray (local.get $ta) (local.get $i) + (i32.add (local.get $i) (local.get $len))) + (local.get $j))) + (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (type $offset_array (array (mut i64))) @@ -462,12 +481,12 @@ (then (if (i32.gt_u (local.get $len) (local.get $avail)) (then (local.set $len (local.get $avail)))) - (call $ta_set (local.get $d) - (call $ta_subarray (struct.get $channel $buffer (local.get $ch)) - (struct.get $channel $curr (local.get $ch)) - (i32.add (struct.get $channel $curr (local.get $ch)) - (local.get $len))) - (local.get $pos)) + (call $ta_blit_from_buffer + (struct.get $channel $buffer (local.get $ch)) + (struct.get $channel $curr (local.get $ch)) + (local.get $d) + (local.get $pos) + (local.get $len)) (struct.set $channel $curr (local.get $ch) (i32.add (struct.get $channel $curr (local.get $ch)) (local.get $len))) @@ -478,10 +497,12 @@ (struct.set $channel $max (local.get $ch) (local.get $nread)) (if (i32.gt_u (local.get $len) (local.get $nread)) (then (local.set $len (local.get $nread)))) - (call $ta_set (local.get $d) - (call $ta_subarray (struct.get $channel $buffer (local.get $ch)) - (i32.const 0) (local.get $len)) - (local.get $pos)) + (call $ta_blit_from_buffer + (struct.get $channel $buffer (local.get $ch)) + (i32.const 0) + (local.get $d) + (local.get $pos) + (local.get $len)) (struct.set $channel $curr (local.get $ch) (local.get $len)) (local.get $len)) @@ -576,10 +597,7 @@ (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (ref.i31 (i32.sub - (i32.wrap_i64 - (struct.get $fd_offset $offset - (call $get_fd_offset - (struct.get $channel $fd (local.get $ch))))) + (i32.wrap_i64 (call $caml_ml_get_channel_offset (local.get $ch))) (i32.sub (struct.get $channel $max (local.get $ch)) (struct.get $channel $curr (local.get $ch)))))) @@ -589,10 +607,7 @@ (local $ch (ref $channel)) (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (call $caml_copy_int64 - (i64.sub - (struct.get $fd_offset $offset - (call $get_fd_offset - (struct.get $channel $fd (local.get $ch)))) + (i64.sub (call $caml_ml_get_channel_offset (local.get $ch)) (i64.extend_i32_s (i32.sub (struct.get $channel $max (local.get $ch)) @@ -604,10 +619,7 @@ (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (ref.i31 (i32.add - (i32.wrap_i64 - (struct.get $fd_offset $offset - (call $get_fd_offset - (struct.get $channel $fd (local.get $ch))))) + (i32.wrap_i64 (call $caml_ml_get_channel_offset (local.get $ch))) (struct.get $channel $curr (local.get $ch))))) (func (export "caml_ml_pos_out_64") @@ -615,10 +627,7 @@ (local $ch (ref $channel)) (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (call $caml_copy_int64 - (i64.add - (struct.get $fd_offset $offset - (call $get_fd_offset - (struct.get $channel $fd (local.get $ch)))) + (i64.add (call $caml_ml_get_channel_offset (local.get $ch)) (i64.extend_i32_s (struct.get $channel $curr (local.get $ch)))))) (func $caml_seek_in @@ -850,10 +859,10 @@ (if (i32.ge_u (local.get $len) (local.get $free)) (then (local.set $len (local.get $free)))) (local.set $buf (struct.get $channel $buffer (local.get $ch))) - (call $ta_set (local.get $buf) - (call $ta_subarray (local.get $d) - (local.get $pos) (i32.add (local.get $pos) (local.get $len))) - (local.get $curr)) + (call $ta_blit_to_buffer + (local.get $d) (local.get $pos) + (local.get $buf) (local.get $curr) + (local.get $len)) (struct.set $channel $curr (local.get $ch) (i32.add (local.get $curr) (local.get $len))) (if (i32.ge_u (local.get $len) (local.get $free)) @@ -980,7 +989,8 @@ (struct.set $channel $fd (ref.cast (ref $channel) (local.get 0)) (local.get 1))) - (func (export "caml_ml_get_channel_offset") (param $ch (ref eq)) (result i64) + (func $caml_ml_get_channel_offset (export "caml_ml_get_channel_offset") + (param $ch (ref eq)) (result i64) (struct.get $fd_offset $offset (call $get_fd_offset (struct.get $channel $fd diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat index 4aa53e5936..b25fff016e 100644 --- a/runtime/wasm/marshal.wat +++ b/runtime/wasm/marshal.wat @@ -30,11 +30,6 @@ (func $caml_is_closure (param (ref eq)) (result i32))) (import "effect" "caml_is_continuation" (func $caml_is_continuation (param (ref eq)) (result i32))) - (import "bindings" "map_new" (func $map_new (result (ref any)))) - (import "bindings" "map_get" - (func $map_get (param (ref any)) (param (ref eq)) (result i31ref))) - (import "bindings" "map_set" - (func $map_set (param (ref any)) (param (ref eq)) (param (ref i31)))) (import "io" "caml_really_putblock" (func $caml_really_putblock (param (ref eq)) (param (ref $bytes)) (param i32) (param i32))) @@ -49,6 +44,11 @@ (import "custom" "caml_find_custom_operations" (func $caml_find_custom_operations (param (ref $bytes)) (result (ref null $custom_operations)))) + (import "bindings" "map_new" (func $map_new (result (ref any)))) + (import "bindings" "map_get" + (func $map_get (param (ref any)) (param (ref eq)) (result i31ref))) + (import "bindings" "map_set" + (func $map_set (param (ref any)) (param (ref eq)) (param (ref i31)))) (@string $input_val_from_string "input_value_from_string") diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat index 62ff000f26..65dfa0c313 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -31,7 +31,6 @@ (import "obj" "caml_callback_2" (func $caml_callback_2 (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)))) - (import "bindings" "write" (func $write (param i32) (param anyref))) (import "string" "caml_string_concat" (func $caml_string_concat (param (ref eq)) (param (ref eq)) (result (ref eq)))) @@ -41,6 +40,7 @@ (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) + (import "bindings" "write" (func $write (param i32) (param anyref))) (import "bindings" "exit" (func $exit (param i32))) (type $block (array (mut (ref eq)))) @@ -197,6 +197,7 @@ (func $caml_main (export "caml_main") (param $start (ref func)) (local $exn (ref eq)) + (local $msg (ref eq)) (try (do (drop (call_ref $func (ref.cast (ref $func) (local.get $start))))) @@ -223,13 +224,14 @@ (br_on_null $null (call $caml_named_value (global.get $do_at_exit))) (ref.i31 (i32.const 0))))) + (local.set $msg + (call $caml_string_concat + (global.get $fatal_error) + (call $caml_string_concat + (call $caml_format_exception (local.get $exn)) + (@string "\n")))) (call $write (i32.const 2) (call $unwrap - (call $caml_jsstring_of_string - (call $caml_string_concat - (global.get $fatal_error) - (call $caml_string_concat - (call $caml_format_exception (local.get $exn)) - (@string "\n"))))))) + (call $caml_jsstring_of_string (local.get $msg))))) (call $exit (i32.const 2))))) ) diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat index 7a2a582499..ff904edd50 100644 --- a/runtime/wasm/sys.wat +++ b/runtime/wasm/sys.wat @@ -16,6 +16,9 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module + (import "fail" "caml_raise_sys_error" + (func $caml_raise_sys_error (param (ref eq)))) + (import "fail" "caml_raise_not_found" (func $caml_raise_not_found)) (import "bindings" "ta_length" (func $ta_length (param (ref extern)) (result i32))) (import "bindings" "ta_get_i32" @@ -32,9 +35,6 @@ (import "jslib" "caml_js_meth_call" (func $caml_js_meth_call (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)))) - (import "fail" "caml_raise_sys_error" - (func $caml_raise_sys_error (param (ref eq)))) - (import "fail" "caml_raise_not_found" (func $caml_raise_not_found)) (import "bindings" "argv" (func $argv (result (ref extern)))) (import "bindings" "on_windows" (global $on_windows i32)) (import "bindings" "isatty" @@ -42,15 +42,11 @@ (import "bindings" "system" (func $system (param anyref) (result (ref eq)))) (import "bindings" "getenv" (func $getenv (param anyref) (result anyref))) (import "bindings" "time" (func $time (result f64))) - (import "bindings" "array_length" - (func $array_length (param (ref extern)) (result i32))) - (import "bindings" "array_get" - (func $array_get (param (ref extern)) (param i32) (result anyref))) (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) (import "jsstring" "jsstring_test" (func $jsstring_test (param anyref) (result i32))) - (import "bindings" "exit" (func $exit (param (ref eq)))) + (import "bindings" "exit" (func $exit (param i32))) (import "io" "caml_channel_descriptor" (func $caml_channel_descriptor (param (ref eq)) (result (ref eq)))) @@ -62,12 +58,11 @@ (func (export "caml_sys_exit") (export "unix_exit") (export "caml_unix_exit") (param $code (ref eq)) (result (ref eq)) - (call $exit (local.get $code)) + (call $exit (i31.get_s (ref.cast (ref i31) (local.get $code)))) ;; Fallback: try to exit through an exception (throw $ocaml_exit)) - (export "caml_sys_unsafe_getenv" (func $caml_sys_getenv)) - (func $caml_sys_getenv (export "caml_sys_getenv") + (func (export "caml_sys_getenv") (export "caml_sys_unsafe_getenv") (param (ref eq)) (result (ref eq)) (local $res anyref) (local.set $res @@ -100,8 +95,7 @@ (ref.cast (ref $block) (call $caml_js_to_string_array (call $argv))) (i32.const 1))) - (export "caml_sys_time_include_children" (func $caml_sys_time)) - (func $caml_sys_time (export "caml_sys_time") + (func (export "caml_sys_time") (export "caml_sys_time_include_children") (param (ref eq)) (result (ref eq)) (struct.new $float (f64.mul (call $time) (f64.const 0.001)))) @@ -114,8 +108,8 @@ (call $system (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))) (catch $javascript_exception - (call $caml_handle_sys_error (pop externref)) - (return (ref.i31 (i32.const 0)))))) + (call $caml_handle_sys_error (pop externref)))) + (return (ref.i31 (i32.const 0)))) (func (export "caml_sys_random_seed") (param (ref eq)) (result (ref eq)) @@ -127,7 +121,6 @@ (local.set $a (array.new $block (ref.i31 (i32.const 0)) (i32.add (local.get $n) (i32.const 1)))) - (local.set $i (i32.const 0)) (loop $loop (if (i32.lt_u (local.get $i) (local.get $n)) (then diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat index 0b4a9229ae..01adfbcc08 100644 --- a/runtime/wasm/unix.wat +++ b/runtime/wasm/unix.wat @@ -257,21 +257,21 @@ (ref.i31 (local.get $yday)) (ref.i31 (local.get $isdst)))) - (func $unix_gmtime (export "unix_gmtime") (export "caml_unix_gmtime") + (func (export "caml_unix_gmtime") (export "unix_gmtime") (param (ref eq)) (result (ref eq)) (call $gmtime (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))) - (func $unix_localtime (export "unix_localtime") (export "caml_unix_localtime") + (func (export "caml_unix_localtime") (export "unix_localtime") (param (ref eq)) (result (ref eq)) (call $localtime (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))) - (func $unix_time (export "unix_time") (export "caml_unix_time") + (func (export "caml_unix_time") (export "unix_time") (param (ref eq)) (result (ref eq)) (struct.new $float (f64.floor (call $gettimeofday)))) - (func $unix_mktime (export "unix_mktime") (export "caml_unix_mktime") + (func (export "caml_unix_mktime") (export "unix_mktime") (param (ref eq)) (result (ref eq)) (local $tm (ref $block)) (local $t f64) (local.set $tm (ref.cast (ref $block) (local.get 0))) @@ -520,6 +520,11 @@ (call $throw_ebadf (@string "closedir")))) (ref.i31 (i32.const 0))) + (func (export "unix_rewinddir") (export "caml_unix_rewinddir") + (param (ref eq)) (result (ref eq)) + (call $caml_invalid_argument (@string "rewinddir not implemented")) + (ref.i31 (i32.const 0))) + (func (export "unix_readdir") (export "caml_unix_readdir") (param $dir (ref eq)) (result (ref eq)) (block $return (result (ref eq)) @@ -551,11 +556,6 @@ (call $win_find_next (local.get $dir)) (local.get $dir))) - (func (export "unix_rewinddir") (export "caml_unix_rewinddir") - (param (ref eq)) (result (ref eq)) - (call $caml_invalid_argument (@string "rewinddir not implemented")) - (ref.i31 (i32.const 0))) - (func (export "unix_unlink") (export "caml_unix_unlink") (param $p (ref eq)) (result (ref eq)) (try diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat index 1f704b8071..d725cea8d4 100644 --- a/runtime/wasm/weak.wat +++ b/runtime/wasm/weak.wat @@ -81,9 +81,10 @@ (br_on_null $released (call $map_get (local.get $m) (local.get $v)))) (br $loop)))) + (local.set $d (ref.cast (ref eq) (local.get $m))) (return (array.new_fixed $block 2 (ref.i31 (i32.const 0)) - (ref.cast (ref eq) (local.get $m))))) + (local.get $d)))) (array.set $block (local.get $x) (global.get $caml_ephe_data_offset) (global.get $caml_ephe_none))) (ref.i31 (i32.const 0))) @@ -133,8 +134,9 @@ (array.set $block (local.get $x) (local.get $i) (global.get $caml_ephe_none)) (br $loop)))) + (local.set $data (call $wrap (local.get $m))) (array.set $block (local.get $x) (global.get $caml_ephe_data_offset) - (call $wrap (local.get $m))) + (local.get $data)) (ref.i31 (i32.const 0))) (func (export "caml_ephe_unset_data") From a943a80dbd837407c2cd359bb7a222990a930df4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Tue, 19 Aug 2025 13:04:38 +0200 Subject: [PATCH 2/4] Bigarrays: do not use ta_length unnecessarily --- runtime/wasm/bigarray.wat | 652 +++++++++++++++++++------------------ runtime/wasm/bigstring.wat | 6 +- 2 files changed, 343 insertions(+), 315 deletions(-) diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index 8d45f18210..a6ae0f996f 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -225,6 +225,25 @@ (i32.shl (i32.and (local.get $d) (i32.const 0x8000)) (i32.const 16)))))) + (func $caml_ba_num_elts (export "caml_ba_num_elts") + (param $b (ref eq)) (result i32) + (local $dim (ref $int_array)) + (local $i i32) + (local $num_elts i32) + (local.set $dim + (struct.get $bigarray $ba_dim + (ref.cast (ref $bigarray) (local.get $b)))) + (local.set $num_elts (i32.const 1)) + (loop $loop + (if (i32.lt_u (local.get $i) (array.len (local.get $dim))) + (then + (local.set $num_elts + (i32.mul (local.get $num_elts) + (array.get $int_array (local.get $dim) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (local.get $num_elts)) + (func $bigarray_hash (param (ref eq)) (result i32) (local $b (ref $bigarray)) (local $h i32) (local $len i32) (local $i i32) (local $w i32) @@ -233,148 +252,156 @@ (local.set $b (ref.cast (ref $bigarray) (local.get 0))) (local.set $data (struct.get $bigarray $ba_data (local.get $b))) (local.set $view (struct.get $bigarray $ba_view (local.get $b))) - (local.set $len (call $ta_length (local.get $data))) + (local.set $len (call $caml_ba_num_elts (local.get $b))) (block $float64 - (block $float32 - (block $int8 - (block $int16 - (block $int32 - (block $int64 - (block $float16 - (br_table $float32 $float64 $int8 $int8 $int16 $int16 - $int32 $int64 $int32 $int32 - $float32 $float64 $int8 $float16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (block $complex64 + (block $float32 + (block $complex32 + (block $int8 + (block $int16 + (block $int32 + (block $int64 + (block $float16 + (br_table $float32 $float64 $int8 $int8 $int16 $int16 + $int32 $int64 $int32 $int32 + $complex32 $complex64 $int8 $float16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $h + (call $caml_hash_mix_float16 (local.get $h) + (call $dv_get_ui16 + (local.get $view) + (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) + (br $loop)))) + (return (local.get $h))) + ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $h + (call $caml_hash_mix_int64 (local.get $h) + (call $dv_get_i64 + (local.get $view) + (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) + (br $loop)))) + (return (local.get $h))) + ;; int32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (if (i32.gt_u (local.get $len) (i32.const 256)) (then (local.set $len (i32.const 256)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h - (call $caml_hash_mix_float16 (local.get $h) - (call $dv_get_ui16 + (call $caml_hash_mix_int (local.get $h) + (call $dv_get_i32 (local.get $view) (local.get $i) (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (return (local.get $h))) - ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + ;; int16 / uint16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (if (i32.gt_u (local.get $len) (i32.const 256)) (then (local.set $len (i32.const 256)))) (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) + (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) + (local.get $len)) (then (local.set $h - (call $caml_hash_mix_int64 (local.get $h) - (call $dv_get_i64 - (local.get $view) - (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $caml_hash_mix_int + (local.get $h) + (i32.or + (call $dv_get_ui16 + (local.get $view) + (local.get $i) + (global.get $littleEndian)) + (i32.shl + (call $dv_get_ui16 + (local.get $view) + (i32.add (local.get $i) (i32.const 2)) + (global.get $littleEndian)) + (i32.const 16))))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) + (if (i32.and (local.get $len) (i32.const 2)) + (then + (local.set $h + (call $caml_hash_mix_int (local.get $h) + (call $dv_get_ui16 + (local.get $view) + (local.get $i) + (global.get $littleEndian)))))) (return (local.get $h))) - ;; int32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + ;; int8 / uint8 (if (i32.gt_u (local.get $len) (i32.const 256)) (then (local.set $len (i32.const 256)))) (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) + (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len)) (then (local.set $h - (call $caml_hash_mix_int (local.get $h) + (call $caml_hash_mix_int + (local.get $h) (call $dv_get_i32 - (local.get $view) - (local.get $i) - (global.get $littleEndian)))) + (local.get $view) (local.get $i) (i32.const 1)))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) + (local.set $w (i32.const 0)) + (block $0_bytes + (block $1_byte + (block $2_bytes + (block $3_bytes + (br_table $0_bytes $1_byte $2_bytes $3_bytes + (i32.and (local.get $len) (i32.const 3)))) + (local.set $w + (i32.shl (call $dv_get_ui8 (local.get $view) + (i32.add (local.get $i) (i32.const 2))) + (i32.const 16)))) + (local.set $w + (i32.or (local.get $w) + (i32.shl (call $dv_get_ui8 (local.get $view) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 8))))) + (local.set $w + (i32.or (local.get $w) + (call $dv_get_i8 (local.get $view) (local.get $i)))) + (local.set $h + (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (return (local.get $h))) - ;; int16 / uint16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) - (loop $loop - (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) - (local.get $len)) - (then - (local.set $h - (call $caml_hash_mix_int - (local.get $h) - (i32.or - (call $dv_get_ui16 - (local.get $view) - (local.get $i) - (global.get $littleEndian)) - (i32.shl - (call $dv_get_ui16 - (local.get $view) - (i32.add (local.get $i) (i32.const 2)) - (global.get $littleEndian)) - (i32.const 16))))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) - (br $loop)))) - (if (i32.and (local.get $len) (i32.const 2)) - (then - (local.set $h - (call $caml_hash_mix_int (local.get $h) - (call $dv_get_ui16 - (local.get $view) - (local.get $i) - (global.get $littleEndian)))))) - (return (local.get $h))) - ;; int8 / uint8 + ;; complex32 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough + ;; float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (if (i32.gt_u (local.get $len) (i32.const 256)) (then (local.set $len (i32.const 256)))) (loop $loop - (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len)) + (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h - (call $caml_hash_mix_int - (local.get $h) - (call $dv_get_i32 - (local.get $view) (local.get $i) (i32.const 1)))) + (call $caml_hash_mix_float (local.get $h) + (call $dv_get_f32 (local.get $view) (local.get $i) + (global.get $littleEndian)))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) - (local.set $w (i32.const 0)) - (block $0_bytes - (block $1_byte - (block $2_bytes - (block $3_bytes - (br_table $0_bytes $1_byte $2_bytes $3_bytes - (i32.and (local.get $len) (i32.const 3)))) - (local.set $w - (i32.shl (call $dv_get_ui8 (local.get $view) - (i32.add (local.get $i) (i32.const 2))) - (i32.const 16)))) - (local.set $w - (i32.or (local.get $w) - (i32.shl (call $dv_get_ui8 (local.get $view) - (i32.add (local.get $i) (i32.const 1))) - (i32.const 8))))) - (local.set $w - (i32.or (local.get $w) - (call $dv_get_i8 (local.get $view) (local.get $i)))) - (local.set $h - (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (return (local.get $h))) - ;; float32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $h - (call $caml_hash_mix_float (local.get $h) - (call $dv_get_f32 (local.get $view) (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) - (br $loop)))) - (return (local.get $h))) + ;; complex64 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough ;; float64 (local.set $len (i32.shl (local.get $len) (i32.const 3))) (if (i32.gt_u (local.get $len) (i32.const 256)) @@ -424,20 +451,24 @@ (block $done (local.set $data (struct.get $bigarray $ba_data (local.get $b))) (local.set $view (struct.get $bigarray $ba_view (local.get $b))) - (local.set $len (call $ta_length (local.get $data))) + (local.set $len (call $caml_ba_num_elts (local.get $b))) (local.set $i (i32.const 0)) - (block $float64 - (block $int8 - (block $int16 - (block $int32 + (block $int8 + (block $int16 + (block $int32 + (block $complex32 (block $int (block $int64 - (br_table $int32 $float64 $int8 $int8 $int16 $int16 - $int32 $int64 $int $int - $int32 $float64 $int8 $int16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (block $complex64 + (br_table $int32 $int64 $int8 $int8 $int16 $int16 + $int32 $int64 $int $int + $complex32 $complex64 $int8 $int16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; complex64 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough + ;; int64 / float64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then @@ -449,48 +480,42 @@ (br $loop)))) (br $done)) ;; int - (call $caml_serialize_int_1 (local.get $s) (i32.const 0))) - ;; int32 / float32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_4 (local.get $s) - (call $dv_get_i32 (local.get $view) (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) - (br $loop)))) - (br $done)) - ;; int16 / uint16 / float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_2 (local.get $s) - (call $dv_get_i16 (local.get $view) (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) - (br $loop)))) - (br $done)) - ;; int8 / uint8 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_1 (local.get $s) - (call $dv_get_i8 (local.get $view) (local.get $i))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (call $caml_serialize_int_1 (local.get $s) (i32.const 0)) + (br $int32)) + ;; complex32 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough + ;; int32 / float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_4 (local.get $s) + (call $dv_get_i32 (local.get $view) (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) + (br $loop)))) + (br $done)) + ;; int16 / uint16 / float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_2 (local.get $s) + (call $dv_get_i16 (local.get $view) (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) + (br $loop)))) + (br $done)) + ;; int8 / uint8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_8 (local.get $s) - (call $dv_get_i64 (local.get $view) (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) - (br $loop))))) + (call $caml_serialize_int_1 (local.get $s) + (call $dv_get_i8 (local.get $view) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (br $done)) (tuple.make 2 (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4)) (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 8)))) @@ -526,9 +551,9 @@ (local.get $len)) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) + (local.set $len (call $caml_ba_get_size (local.get $dim))) (local.set $data - (call $caml_ba_create_buffer (local.get $kind) - (call $caml_ba_get_size (local.get $dim)))) + (call $caml_ba_create_buffer (local.get $kind) (local.get $len))) (local.set $view (call $dv_make (local.get $data))) (local.set $b (struct.new $bigarray @@ -540,20 +565,23 @@ (local.get $kind) (i32.shr_u (local.get $flags) (i32.const 8)))) (block $done - (local.set $len (call $ta_length (local.get $data))) (local.set $i (i32.const 0)) - (block $float64 - (block $int8 - (block $int16 - (block $int32 + (block $int8 + (block $int16 + (block $int32 + (block $complex32 (block $int (block $int64 - (br_table $int32 $float64 $int8 $int8 $int16 $int16 - $int32 $int64 $int $int - $int32 $float64 $int8 $int16 - (struct.get $bigarray $ba_kind (local.get $b)))) + (block $complex64 + (br_table $int32 $int64 $int8 $int8 $int16 $int16 + $int32 $int64 $int $int + $complex32 $complex64 $int8 $int16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; complex64 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (local.set $len (i32.shl (local.get $len) (i32.const 3))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then @@ -565,47 +593,40 @@ (br $done)) ;; int (if (call $caml_deserialize_uint_1 (local.get $s)) - (then (call $caml_failwith (global.get $intern_overflow))))) - ;; int32 / float32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $dv_set_i32 (local.get $view) (local.get $i) - (call $caml_deserialize_int_4 (local.get $s)) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 4))) - (br $loop)))) - (br $done)) - ;; int16 / uint16 / float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (then (call $caml_failwith (global.get $intern_overflow)))) + (br $int32)) + ;; complex32 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough + ;; int32 / float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i16 (local.get $view) (local.get $i) - (call $caml_deserialize_sint_2 (local.get $s)) + (call $dv_set_i32 (local.get $view) (local.get $i) + (call $caml_deserialize_int_4 (local.get $s)) (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (br $done)) - ;; int8 / uint8 + ;; int16 / uint16 / float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i8 (local.get $view) (local.get $i) - (call $caml_deserialize_sint_1 (local.get $s))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_set_i16 (local.get $view) (local.get $i) + (call $caml_deserialize_sint_2 (local.get $s)) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (br $done)) - ;; float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) + ;; int8 / uint8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i64 (local.get $view) (local.get $i) - (call $caml_deserialize_int_8 (local.get $s)) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $dv_set_i8 (local.get $view) (local.get $i) + (call $caml_deserialize_sint_1 (local.get $s))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop))))) (tuple.make 2 (local.get $b) @@ -1465,7 +1486,7 @@ ;; complex64 (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $len - (i32.shl (call $ta_length (local.get $data)) (i32.const 3))) + (i32.shl (call $caml_ba_num_elts (local.get $ba)) (i32.const 4))) (local.set $b (ref.cast (ref $float_array) (local.get $v))) (local.set $f1 (array.get $float_array (local.get $b) (i32.const 0))) @@ -1487,7 +1508,7 @@ ;; complex32 (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $len - (i32.shl (call $ta_length (local.get $data)) (i32.const 2))) + (i32.shl (call $caml_ba_num_elts (local.get $ba)) (i32.const 3))) (local.set $b (ref.cast (ref $float_array) (local.get $v))) (local.set $f1' (f32.demote_f64 @@ -1511,8 +1532,7 @@ ;; int64 (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $len - ;; we currently use an Int32Array, so multiply by just 4 - (i32.shl (call $ta_length (local.get $data)) (i32.const 2))) + (i32.shl (call $caml_ba_num_elts (local.get $ba)) (i32.const 3))) (local.set $l (call $Int64_val (local.get $v))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) @@ -1722,179 +1742,187 @@ (local.set $view1 (struct.get $bigarray $ba_view (local.get $b1))) (local.set $d2 (struct.get $bigarray $ba_data (local.get $b2))) (local.set $view2 (struct.get $bigarray $ba_view (local.get $b2))) - (local.set $len (call $ta_length (local.get $d1))) + (local.set $len (call $caml_ba_num_elts (local.get $b1))) (local.set $i (i32.const 0)) (block $float32 - (block $float64 - (block $int8 - (block $uint8 - (block $int16 - (block $uint16 - (block $int32 - (block $int64 - (block $float16 - (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 - $int32 $int64 $int32 $int32 - $float32 $float64 $uint8 $float16 - (struct.get $bigarray $ba_kind (local.get $b1)))) - ;; float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (block $complex32 + (block $float64 + (block $complex64 + (block $int8 + (block $uint8 + (block $int16 + (block $uint16 + (block $int32 + (block $int64 + (block $float16 + (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 + $int32 $int64 $int32 $int32 + $complex32 $complex64 $uint8 $float16 + (struct.get $bigarray $ba_kind (local.get $b1)))) + ;; float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $f1 + (call $float16_to_double + (call $dv_get_ui16 (local.get $view1) (local.get $i) + (global.get $littleEndian)))) + (local.set $f2 + (call $float16_to_double + (call $dv_get_ui16 (local.get $view2) (local.get $i) + (global.get $littleEndian)))) + (if (f64.lt (local.get $f1) (local.get $f2)) + (then (return (i32.const -1)))) + (if (f64.gt (local.get $f1) (local.get $f2)) + (then (return (i32.const 1)))) + (if (f64.ne (local.get $f1) (local.get $f2)) + (then + (if (i32.eqz (local.get $total)) + (then (return (global.get $unordered)))) + (if (f64.eq (local.get $f1) (local.get $f1)) + (then (return (i32.const 1)))) + (if (f64.eq (local.get $f2) (local.get $f2)) + (then (return (i32.const -1)))))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) + (br $loop)))) + (return (i32.const 0))) + ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $l1 + (call $dv_get_i64 (local.get $view1) + (local.get $i) + (global.get $littleEndian))) + (local.set $l2 + (call $dv_get_i64 (local.get $view2) + (local.get $i) + (global.get $littleEndian))) + (if (i64.lt_s (local.get $l1) (local.get $l2)) + (then (return (i32.const -1)))) + (if (i64.gt_s (local.get $l1) (local.get $l2)) + (then (return (i32.const 1)))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) + (br $loop)))) + (return (i32.const 0))) + ;; int32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $f1 - (call $float16_to_double - (call $dv_get_ui16 (local.get $view1) (local.get $i) - (global.get $littleEndian)))) - (local.set $f2 - (call $float16_to_double - (call $dv_get_ui16 (local.get $view2) (local.get $i) - (global.get $littleEndian)))) - (if (f64.lt (local.get $f1) (local.get $f2)) + (local.set $i1 + (call $dv_get_i32 (local.get $view1) (local.get $i) + (global.get $littleEndian))) + (local.set $i2 + (call $dv_get_i32 (local.get $view2) (local.get $i) + (global.get $littleEndian))) + (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) - (if (f64.gt (local.get $f1) (local.get $f2)) + (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (if (f64.ne (local.get $f1) (local.get $f2)) - (then - (if (i32.eqz (local.get $total)) - (then (return (global.get $unordered)))) - (if (f64.eq (local.get $f1) (local.get $f1)) - (then (return (i32.const 1)))) - (if (f64.eq (local.get $f2) (local.get $f2)) - (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (return (i32.const 0))) - ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + ;; uint16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $l1 - (call $dv_get_i64 (local.get $view1) - (local.get $i) + (local.set $i1 + (call $dv_get_ui16 (local.get $view1) (local.get $i) (global.get $littleEndian))) - (local.set $l2 - (call $dv_get_i64 (local.get $view2) - (local.get $i) + (local.set $i2 + (call $dv_get_ui16 (local.get $view2) (local.get $i) (global.get $littleEndian))) - (if (i64.lt_s (local.get $l1) (local.get $l2)) + (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) - (if (i64.gt_s (local.get $l1) (local.get $l2)) + (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (i32.const 0))) - ;; int32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + ;; int16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $dv_get_i32 (local.get $view1) (local.get $i) + (call $dv_get_i16 (local.get $view1) (local.get $i) (global.get $littleEndian))) (local.set $i2 - (call $dv_get_i32 (local.get $view2) (local.get $i) + (call $dv_get_i16 (local.get $view2) (local.get $i) (global.get $littleEndian))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (i32.const 0))) - ;; uint16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + ;; uint8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $dv_get_ui16 (local.get $view1) (local.get $i) - (global.get $littleEndian))) + (call $dv_get_ui8 (local.get $view1) (local.get $i))) (local.set $i2 - (call $dv_get_ui16 (local.get $view2) (local.get $i) - (global.get $littleEndian))) + (call $dv_get_ui8 (local.get $view2) (local.get $i))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) - ;; int16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + ;; int8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $dv_get_i16 (local.get $view1) (local.get $i) - (global.get $littleEndian))) + (call $dv_get_i8 (local.get $view1) (local.get $i))) (local.set $i2 - (call $dv_get_i16 (local.get $view2) (local.get $i) - (global.get $littleEndian))) + (call $dv_get_i8 (local.get $view2) (local.get $i))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) - ;; uint8 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $i1 - (call $dv_get_ui8 (local.get $view1) (local.get $i))) - (local.set $i2 - (call $dv_get_ui8 (local.get $view2) (local.get $i))) - (if (i32.lt_s (local.get $i1) (local.get $i2)) - (then (return (i32.const -1)))) - (if (i32.gt_s (local.get $i1) (local.get $i2)) - (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (return (i32.const 0))) - ;; int8 + ;; complex64 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough + ;; float64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $i1 - (call $dv_get_i8 (local.get $view1) (local.get $i))) - (local.set $i2 - (call $dv_get_i8 (local.get $view2) (local.get $i))) - (if (i32.lt_s (local.get $i1) (local.get $i2)) + (local.set $f1 + (call $dv_get_f64 (local.get $view1) (local.get $i) + (global.get $littleEndian))) + (local.set $f2 + (call $dv_get_f64 (local.get $view2) (local.get $i) + (global.get $littleEndian))) + (if (f64.lt (local.get $f1) (local.get $f2)) (then (return (i32.const -1)))) - (if (i32.gt_s (local.get $i1) (local.get $i2)) + (if (f64.gt (local.get $f1) (local.get $f2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (if (f64.ne (local.get $f1) (local.get $f2)) + (then + (if (i32.eqz (local.get $total)) + (then (return (global.get $unordered)))) + (if (f64.eq (local.get $f1) (local.get $f1)) + (then (return (i32.const 1)))) + (if (f64.eq (local.get $f2) (local.get $f2)) + (then (return (i32.const -1)))))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (return (i32.const 0))) - ;; float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $f1 - (call $dv_get_f64 (local.get $view1) (local.get $i) - (global.get $littleEndian))) - (local.set $f2 - (call $dv_get_f64 (local.get $view2) (local.get $i) - (global.get $littleEndian))) - (if (f64.lt (local.get $f1) (local.get $f2)) - (then (return (i32.const -1)))) - (if (f64.gt (local.get $f1) (local.get $f2)) - (then (return (i32.const 1)))) - (if (f64.ne (local.get $f1) (local.get $f2)) - (then - (if (i32.eqz (local.get $total)) - (then (return (global.get $unordered)))) - (if (f64.eq (local.get $f1) (local.get $f1)) - (then (return (i32.const 1)))) - (if (f64.eq (local.get $f2) (local.get $f2)) - (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) - (br $loop)))) - (return (i32.const 0))) + ;; complex32 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough ;; float32 (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index 7c795ce221..af1af88df3 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -33,6 +33,8 @@ (func $caml_ba_get_data (param (ref eq)) (result (ref extern)))) (import "bigarray" "caml_ba_get_view" (func $caml_ba_get_view (param (ref eq)) (result (ref extern)))) + (import "bigarray" "caml_ba_num_elts" + (func $caml_ba_num_elts (param (ref eq)) (result i32))) (import "bindings" "ta_create" (func $ta_create (param i32) (param anyref) (result anyref))) (import "bindings" "dv_get_i32" @@ -46,8 +48,6 @@ (param (ref extern)) (param i32) (param i32) (result (ref extern)))) (import "bindings" "ta_set" (func $ta_set (param (ref extern)) (param (ref extern)) (param i32))) - (import "bindings" "ta_length" - (func $ta_length (param (ref extern)) (result i32))) (import "bindings" "ta_bytes" (func $ta_bytes (param anyref) (result anyref))) (import "bindings" "ta_blit_from_bytes" @@ -70,7 +70,7 @@ (local $len i32) (local $i i32) (local $w i32) (local.set $data (call $caml_ba_get_data (local.get $b))) (local.set $view (call $caml_ba_get_view (local.get $b))) - (local.set $len (call $ta_length (local.get $data))) + (local.set $len (call $caml_ba_num_elts (local.get $b))) (loop $loop (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len)) (then From ca2555dd2fdd6e96dffb1b3494988231c015358a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Mon, 25 Aug 2025 14:52:08 +0200 Subject: [PATCH 3/4] Bigarrays: do not read/write floats as integers This makes the WASI implementation simpler --- runtime/wasm/bigarray.wat | 164 +++++++++++++++++++++++++------------- 1 file changed, 108 insertions(+), 56 deletions(-) diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index a6ae0f996f..65c2b19139 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -456,36 +456,63 @@ (block $int8 (block $int16 (block $int32 - (block $complex32 - (block $int - (block $int64 - (block $complex64 - (br_table $int32 $int64 $int8 $int8 $int16 $int16 - $int32 $int64 $int $int - $complex32 $complex64 $int8 $int16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; complex64 + (block $int + (block $int64 + (block $float32 + (block $complex32 + (block $float64 + (block $complex64 + (br_table $float32 $float64 $int8 $int8 $int16 $int16 + $int32 $int64 $int $int + $complex32 $complex64 $int8 $int16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; complex64 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough + ;; float64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_8 (local.get $s) + (i64.reinterpret_f64 + (call $dv_get_f64 (local.get $view) + (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) + (br $loop)))) + (br $done)) + ;; complex32 (local.set $len (i32.shl (local.get $len) (i32.const 1)))) ;; fallthrough - ;; int64 / float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) + ;; float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_8 (local.get $s) - (call $dv_get_i64 (local.get $view) - (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $caml_serialize_int_4 (local.get $s) + (i32.reinterpret_f32 + (call $dv_get_f32 (local.get $view) (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (br $done)) - ;; int - (call $caml_serialize_int_1 (local.get $s) (i32.const 0)) - (br $int32)) - ;; complex32 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_8 (local.get $s) + (call $dv_get_i64 (local.get $view) + (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) + (br $loop)))) + (br $done)) + ;; int + (call $caml_serialize_int_1 (local.get $s) (i32.const 0))) ;; fallthrough - ;; int32 / float32 + ;; int32 (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) @@ -496,17 +523,17 @@ (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (br $done)) - ;; int16 / uint16 / float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_2 (local.get $s) - (call $dv_get_i16 (local.get $view) (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) - (br $loop)))) - (br $done)) + ;; int16 / uint16 / float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_2 (local.get $s) + (call $dv_get_i16 (local.get $view) (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) + (br $loop)))) + (br $done)) ;; int8 / uint8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) @@ -514,8 +541,7 @@ (call $caml_serialize_int_1 (local.get $s) (call $dv_get_i8 (local.get $view) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) + (br $loop))))) (tuple.make 2 (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4)) (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 8)))) @@ -569,36 +595,62 @@ (block $int8 (block $int16 (block $int32 - (block $complex32 - (block $int - (block $int64 - (block $complex64 - (br_table $int32 $int64 $int8 $int8 $int16 $int16 - $int32 $int64 $int $int - $complex32 $complex64 $int8 $int16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; complex64 + (block $int + (block $int64 + (block $float32 + (block $complex32 + (block $float64 + (block $complex64 + (br_table $float32 $float64 $int8 $int8 $int16 $int16 + $int32 $int64 $int $int + $complex32 $complex64 $int8 $int16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; complex64 + (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; fallthrough + ;; float64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $dv_set_f64 (local.get $view) (local.get $i) + (f64.reinterpret_i64 + (call $caml_deserialize_int_8 (local.get $s))) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 8))) + (br $loop)))) + (br $done)) + ;; complex32 (local.set $len (i32.shl (local.get $len) (i32.const 1)))) ;; fallthrough - ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) + ;; float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i64 (local.get $view) (local.get $i) - (call $caml_deserialize_int_8 (local.get $s)) + (call $dv_set_f32 (local.get $view) (local.get $i) + (f32.reinterpret_i32 + (call $caml_deserialize_int_4 (local.get $s))) (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (br $done)) - ;; int - (if (call $caml_deserialize_uint_1 (local.get $s)) - (then (call $caml_failwith (global.get $intern_overflow)))) - (br $int32)) - ;; complex32 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) + ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $dv_set_i64 (local.get $view) (local.get $i) + (call $caml_deserialize_int_8 (local.get $s)) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 8))) + (br $loop)))) + (br $done)) + ;; int + (if (call $caml_deserialize_uint_1 (local.get $s)) + (then (call $caml_failwith (global.get $intern_overflow))))) ;; fallthrough - ;; int32 / float32 + ;; int32 (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) From 22e5dce0a30a1546ff0bae5385e2a247c858de56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Mon, 25 Aug 2025 14:55:24 +0200 Subject: [PATCH 4/4] Bigarrays: make it explicit when we are reading multiple bytes from a byte array --- runtime/wasm/bigarray.wat | 26 ++++++++++++++++++++------ runtime/wasm/bigstring.wat | 5 +++-- 2 files changed, 23 insertions(+), 8 deletions(-) diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index 65c2b19139..e5295f959f 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -120,6 +120,18 @@ (func $dv_set_i16 (param externref i32 i32 i32))) (import "bindings" "dv_set_i8" (func $dv_set_i8 (param externref i32 i32))) + (import "bindings" "dv_get_i64" + (func $dv_get_i64_unaligned (param externref i32 i32) (result i64))) + (import "bindings" "dv_get_i32" + (func $dv_get_i32_unaligned (param externref i32 i32) (result i32))) + (import "bindings" "dv_get_ui16" + (func $dv_get_ui16_unaligned (param externref i32 i32) (result i32))) + (import "bindings" "dv_set_i64" + (func $dv_set_i64_unaligned (param externref i32 i64 i32))) + (import "bindings" "dv_set_i32" + (func $dv_set_i32_unaligned (param externref i32 i32 i32))) + (import "bindings" "dv_set_i16" + (func $dv_set_i16_unaligned (param externref i32 i32 i32))) (import "bindings" "littleEndian" (global $littleEndian i32)) (type $block (array (mut (ref eq)))) @@ -2018,7 +2030,8 @@ (i32.const 0))) (then (call $caml_bound_error))) (ref.i31 - (call $dv_get_ui16 (local.get $view) (local.get $p) (i32.const 1)))) + (call $dv_get_ui16_unaligned + (local.get $view) (local.get $p) (i32.const 1)))) (func (export "caml_ba_uint8_get32") (param $vba (ref eq)) (param $i (ref eq)) (result i32) @@ -2035,7 +2048,8 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (return_call $dv_get_i32 (local.get $view) (local.get $p) (i32.const 1))) + (return_call $dv_get_i32_unaligned + (local.get $view) (local.get $p) (i32.const 1))) (func (export "caml_ba_uint8_get64") (param $vba (ref eq)) (param $i (ref eq)) (result i64) @@ -2052,7 +2066,7 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_get_i64 + (call $dv_get_i64_unaligned (local.get $view) (local.get $p) (i32.const 1))) (func (export "caml_ba_uint8_set16") @@ -2072,7 +2086,7 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_set_i16 + (call $dv_set_i16_unaligned (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) (ref.i31 (i32.const 0))) @@ -2092,7 +2106,7 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_set_i32 + (call $dv_set_i32_unaligned (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) (ref.i31 (i32.const 0))) @@ -2112,7 +2126,7 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_set_i64 + (call $dv_set_i64_unaligned (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) (ref.i31 (i32.const 0))) diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index af1af88df3..61c4533b5c 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -38,7 +38,7 @@ (import "bindings" "ta_create" (func $ta_create (param i32) (param anyref) (result anyref))) (import "bindings" "dv_get_i32" - (func $dv_get_i32 (param externref i32 i32) (result i32))) + (func $dv_get_i32_unaligned (param externref i32 i32) (result i32))) (import "bindings" "dv_get_ui8" (func $dv_get_ui8 (param externref i32) (result i32))) (import "bindings" "dv_set_i8" @@ -77,7 +77,8 @@ (local.set $h (call $caml_hash_mix_int (local.get $h) - (call $dv_get_i32 (local.get $view) (local.get $i) + (call $dv_get_i32_unaligned + (local.get $view) (local.get $i) (i32.const 1)))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop))))