Skip to content

Wasm runtime: clean-up #2094

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Sep 5, 2025
Merged

Wasm runtime: clean-up #2094

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
8dbd814
Wasm runtime: code reordering
vouillon Apr 4, 2025
a943a80
Bigarrays: do not use ta_length unnecessarily
vouillon Aug 19, 2025
ca2555d
Bigarrays: do not read/write floats as integers
vouillon Aug 25, 2025
22e5dce
Bigarrays: make it explicit when we are reading multiple bytes from a…
vouillon Aug 25, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions runtime/wasm/backtrace.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down
844 changes: 469 additions & 375 deletions runtime/wasm/bigarray.wat
View file
Open in desktop

Large diffs are not rendered by default.

11 changes: 6 additions & 5 deletions runtime/wasm/bigstring.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,10 +33,12 @@
(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"
(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"
Expand All @@ -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"
Expand All @@ -70,14 +70,15 @@
(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
(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))))
Expand Down
6 changes: 3 additions & 3 deletions runtime/wasm/effect.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))))
Expand All @@ -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)))
Expand Down
4 changes: 2 additions & 2 deletions runtime/wasm/fs.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))

Expand Down
80 changes: 45 additions & 35 deletions runtime/wasm/io.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand All @@ -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))))

Expand All @@ -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)))
Expand Down Expand Up @@ -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)))
Expand All @@ -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))

Expand Down Expand Up @@ -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))))))
Expand All @@ -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))
Expand All @@ -604,21 +619,15 @@
(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")
(param $vch (ref eq)) (result (ref eq))
(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
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions runtime/wasm/marshal.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand All @@ -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")

Expand Down
16 changes: 9 additions & 7 deletions runtime/wasm/stdlib.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))))
Expand All @@ -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))))
Expand Down Expand Up @@ -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)))))
Expand All @@ -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)))))
)
25 changes: 9 additions & 16 deletions runtime/wasm/sys.wat
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand All @@ -32,25 +35,18 @@
(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"
(func $isatty (param (ref eq)) (result (ref eq))))
(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))))

Expand All @@ -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
Expand Down Expand Up @@ -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))))

Expand All @@ -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))
Expand All @@ -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
Expand Down
Loading
Loading