From 85805fd6499fb57fb0c521142d8119614157e81a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Apr 2025 19:45:20 +0200
Subject: [PATCH 01/10] 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 2322ccf192..9c83528475 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"
@@ -77,55 +126,6 @@
(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_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 05bc0ad9c2..c34b41c69b 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 89903e2c92..90a529d744 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -38,14 +38,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 deff2a6d40..45566431b9 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -70,6 +70,10 @@
(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 "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)))
@@ -80,10 +84,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))))
@@ -97,6 +97,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)))
@@ -450,12 +469,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)))
@@ -466,10 +485,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))
@@ -564,10 +585,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))))))
@@ -577,10 +595,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))
@@ -592,10 +607,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")
@@ -603,10 +615,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
@@ -837,10 +846,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))
@@ -967,7 +976,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..ccf38af3be 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 $exn)))))
(call $exit (i32.const 2)))))
)
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 788e0ee478..ea3b8ec621 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
@@ -88,8 +83,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))))
@@ -102,8 +96,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))
@@ -115,7 +109,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 a61517beae6994a75666c07fe0cb9ca3ae8f408c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 17 Dec 2024 16:53:01 +0100
Subject: [PATCH 02/10] WASI runtime
---
compiler/bin-wasm_of_ocaml/cmd_arg.ml | 6 +-
compiler/bin-wasm_of_ocaml/compile.ml | 30 +-
compiler/bin-wasm_of_ocaml/dune | 3 +
compiler/bin-wasm_of_ocaml/gen/gen.ml | 29 +-
compiler/lib-wasm/binaryen.ml | 1 +
compiler/lib-wasm/gc_target.ml | 65 +-
compiler/lib-wasm/generate.ml | 3 +-
compiler/lib/config.ml | 2 +
compiler/lib/config.mli | 2 +
compiler/lib/driver.ml | 5 +-
compiler/lib/inline.ml | 2 +-
compiler/tests-jsoo/dune | 23 +
compiler/tests-jsoo/lib-effects/dune | 6 +
compiler/tests-jsoo/test_unix.ml | 79 -
compiler/tests-jsoo/test_unix_perms.ml | 78 +
compiler/tests-ocaml/basic-io-2/dune | 3 +
compiler/tests-ocaml/effect-syntax/dune | 4 +
compiler/tests-ocaml/effects/dune | 4 +
compiler/tests-ocaml/lib-channels/close_in.ml | 10 +-
compiler/tests-ocaml/lib-digest/dune | 4 +-
compiler/tests-ocaml/lib-marshal/intext.ml | 3 +-
.../tests-ocaml/lib-marshal/intext_par.ml | 3 +-
compiler/tests-ocaml/lib-unix/isatty/dune | 5 +-
dune | 8 +
lib/deriving_json/tests/dune | 2 +
lib/tests/dune.inc | 22 +-
lib/tests/gen-rules/gen.ml | 3 +-
runtime/wasm/backtrace.wat | 10 +
runtime/wasm/bigarray.wat | 449 ++++++
runtime/wasm/bigstring.wat | 29 +
runtime/wasm/blake2.wat | 2 +-
runtime/wasm/compare.wat | 3 +
runtime/wasm/deps-wasi.json | 15 +
runtime/wasm/dune | 68 +
runtime/wasm/effect.wat | 7 +
runtime/wasm/fail.wat | 6 +
runtime/wasm/float.wat | 85 ++
runtime/wasm/fs.wat | 602 ++++++++
runtime/wasm/hash.wat | 3 +
runtime/wasm/io.wat | 427 +++++-
runtime/wasm/jslib.wat | 3 +
runtime/wasm/jslib_js_of_ocaml.wat | 3 +
runtime/wasm/jsstring.wat | 3 +
runtime/wasm/libc.c | 175 +++
runtime/wasm/libc.wasm | Bin 0 -> 63480 bytes
runtime/wasm/marshal.wat | 66 +-
runtime/wasm/prng.wat | 10 +
runtime/wasm/runtime-wasi.js | 84 +
runtime/wasm/stdlib.wat | 62 +-
runtime/wasm/sys.wat | 278 +++-
runtime/wasm/unix.wat | 1359 ++++++++++++++++-
runtime/wasm/wasi_errors.wat | 86 ++
runtime/wasm/wasi_memory.wat | 98 ++
runtime/wasm/weak.wat | 21 +
runtime/wasm/zstd.wat | 6 +-
55 files changed, 4215 insertions(+), 150 deletions(-)
create mode 100644 compiler/tests-jsoo/test_unix_perms.ml
create mode 100644 runtime/wasm/deps-wasi.json
create mode 100644 runtime/wasm/libc.c
create mode 100644 runtime/wasm/libc.wasm
create mode 100644 runtime/wasm/runtime-wasi.js
create mode 100644 runtime/wasm/wasi_errors.wat
create mode 100644 runtime/wasm/wasi_memory.wat
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index f079595690..d449f5a23b 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -44,7 +44,11 @@ let normalize_effects (effects : [ `Cps | `Jspi ] option) common : Config.effect
| None ->
(* For backward compatibility, consider that [--enable effects] alone means
[--effects cps] *)
- if List.mem "effects" ~set:common.Jsoo_cmdline.Arg.optim.enable then `Cps else `Jspi
+ if List.mem "effects" ~set:common.Jsoo_cmdline.Arg.optim.enable
+ then `Cps
+ else if List.mem "wasi" ~set:common.Jsoo_cmdline.Arg.optim.enable
+ then `Disabled
+ else `Jspi
| Some ((`Cps | `Jspi) as e) -> e
type t =
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index efc1be643b..14df5cdb94 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -89,9 +89,11 @@ let build_runtime ~runtime_file =
[ ( "effects"
, Wat_preprocess.String
(match Config.effects () with
+ | `Disabled -> "disabled"
| `Jspi -> "jspi"
| `Cps -> "cps"
- | `Disabled | `Double_translation -> assert false) )
+ | `Double_translation -> assert false) )
+ ; "wasi", Wat_preprocess.Bool (Config.Flag.wasi ())
]
in
match
@@ -113,7 +115,9 @@ let build_runtime ~runtime_file =
; file = module_name ^ ".wat"
; source = Contents contents
})
- Runtime_files.wat_files
+ (if Config.Flag.wasi ()
+ then ("libc", Runtime_files.wasi_libc) :: Runtime_files.wat_files
+ else Runtime_files.wat_files)
in
Runtime.build
~link_options:[ "-g" ]
@@ -175,7 +179,10 @@ let link_and_optimize
@@ fun opt_temp_sourcemap' ->
let primitives =
Binaryen.dead_code_elimination
- ~dependencies:Runtime_files.dependencies
+ ~dependencies:
+ (if Config.Flag.wasi ()
+ then Runtime_files.wasi_dependencies
+ else Runtime_files.dependencies)
~opt_input_sourcemap:opt_temp_sourcemap
~opt_output_sourcemap:opt_temp_sourcemap'
~input_file:temp_file
@@ -293,7 +300,13 @@ let build_js_runtime ~primitives ?runtime_arguments () =
| _ -> assert false
in
let init_fun =
- match Parse_js.parse (Parse_js.Lexer.of_string Runtime_files.js_runtime) with
+ match
+ Parse_js.parse
+ (Parse_js.Lexer.of_string
+ (if Config.Flag.wasi ()
+ then Runtime_files.js_wasi_launcher
+ else Runtime_files.js_launcher))
+ with
| [ (Expression_statement f, _) ] -> f
| _ -> assert false
in
@@ -530,9 +543,12 @@ let run
tmp_wasm_file
in
let wasm_name =
- Printf.sprintf
- "code-%s"
- (String.sub (Digest.to_hex (Digest.file tmp_wasm_file)) ~pos:0 ~len:20)
+ if Config.Flag.wasi ()
+ then "code"
+ else
+ Printf.sprintf
+ "code-%s"
+ (String.sub (Digest.to_hex (Digest.file tmp_wasm_file)) ~pos:0 ~len:20)
in
let tmp_wasm_file' = Filename.concat tmp_dir (wasm_name ^ ".wasm") in
Sys.rename tmp_wasm_file tmp_wasm_file';
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index 1870a60f7c..024b987d36 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -27,6 +27,9 @@
gen/gen.exe
../../runtime/wasm/runtime.js
../../runtime/wasm/deps.json
+ ../../runtime/wasm/runtime-wasi.js
+ ../../runtime/wasm/deps-wasi.json
+ ../../runtime/wasm/libc.wasm
(glob_files ../../runtime/wasm/*.wat)
(glob_files ../../runtime/wasm/runtime-*.wasm))
(action
diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml
index a9f3c0e1b2..574e5f2c1d 100644
--- a/compiler/bin-wasm_of_ocaml/gen/gen.ml
+++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml
@@ -34,13 +34,20 @@ let check_js_file fname =
let default_flags = []
-let interesting_runtimes = [ [ "effects", `S "jspi" ]; [ "effects", `S "cps" ] ]
+let interesting_runtimes =
+ [ [ "effects", `S "jspi"; "wasi", `B false ]
+ ; [ "effects", `S "cps"; "wasi", `B false ]
+ ; [ "effects", `S "disabled"; "wasi", `B true ]
+ ; [ "effects", `S "cps"; "wasi", `B true ]
+ ]
+
+let defaults = [ "effects", "disabled" ]
let name_runtime standard l =
let flags =
List.filter_map l ~f:(fun (k, v) ->
match v with
- | `S s -> Some s
+ | `S s -> if List.mem (k, s) ~set:defaults then None else Some s
| `B b -> if b then Some k else None)
in
String.concat ~sep:"-" ("runtime" :: (if standard then [ "standard" ] else flags))
@@ -67,11 +74,13 @@ let print_flags f flags =
let () =
let () = set_binary_mode_out stdout true in
- let js_runtime, deps, wat_files, runtimes =
+ let js_launcher, deps, js_wasi_launcher, wasi_deps, wasi_libc, wat_files, runtimes =
match Array.to_list Sys.argv with
- | _ :: js_runtime :: deps :: rest ->
- assert (Filename.check_suffix js_runtime ".js");
+ | _ :: js_launcher :: deps :: js_wasi_launcher :: wasi_deps :: wasi_libc :: rest ->
+ assert (Filename.check_suffix js_launcher ".js");
+ assert (Filename.check_suffix js_wasi_launcher ".js");
assert (Filename.check_suffix deps ".json");
+ assert (Filename.check_suffix wasi_deps ".json");
let wat_files, rest =
List.partition rest ~f:(fun f -> Filename.check_suffix f ".wat")
in
@@ -79,13 +88,17 @@ let () =
List.partition rest ~f:(fun f -> Filename.check_suffix f ".wasm")
in
assert (List.is_empty rest);
- js_runtime, deps, wat_files, wasm_files
+ js_launcher, deps, js_wasi_launcher, wasi_deps, wasi_libc, wat_files, wasm_files
| _ -> assert false
in
- check_js_file js_runtime;
+ check_js_file js_launcher;
+ check_js_file js_wasi_launcher;
Format.printf "open Wasm_of_ocaml_compiler@.";
- Format.printf "let js_runtime = {|\n%s\n|}@." (Fs.read_file js_runtime);
+ Format.printf "let js_launcher = {|\n%s\n|}@." (Fs.read_file js_launcher);
Format.printf "let dependencies = {|\n%s\n|}@." (Fs.read_file deps);
+ Format.printf "let js_wasi_launcher = {|\n%s\n|}@." (Fs.read_file js_wasi_launcher);
+ Format.printf "let wasi_dependencies = {|\n%s\n|}@." (Fs.read_file wasi_deps);
+ Format.printf "let wasi_libc = %S@." (String.escaped (Fs.read_file wasi_libc));
Format.printf
"let wat_files = [%a]@."
(Format.pp_print_list (fun f file ->
diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml
index 5886e28c6b..86e07bc492 100644
--- a/compiler/lib-wasm/binaryen.ml
+++ b/compiler/lib-wasm/binaryen.ml
@@ -36,6 +36,7 @@ let common_options () =
; "--enable-bulk-memory"
; "--enable-nontrapping-float-to-int"
; "--enable-strings"
+ ; "--enable-multimemory" (* To keep wasm-merge happy *)
]
in
if Config.Flag.pretty () then "-g" :: l else l
diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml
index 4557751d77..6947379306 100644
--- a/compiler/lib-wasm/gc_target.ml
+++ b/compiler/lib-wasm/gc_target.ml
@@ -574,9 +574,13 @@ module Value = struct
return ())
(val_int (if negate then Arith.eqz n else n))
- let eq x y = eq_gen ~negate:false x y
+ let eq x y =
+ if Config.Flag.wasi () then val_int (ref_eq x y) else eq_gen ~negate:false x y
- let neq x y = eq_gen ~negate:true x y
+ let neq x y =
+ if Config.Flag.wasi ()
+ then val_int (Arith.eqz (ref_eq x y))
+ else eq_gen ~negate:true x y
let ult = binop Arith.(ult)
@@ -1302,7 +1306,12 @@ module Math = struct
{ W.params = List.init ~len:n ~f:(fun _ : W.value_type -> F64); result = [ F64 ] }
let unary name x =
- let* f = register_import ~import_module:"Math" ~name (Fun (float_func_type 1)) in
+ let* f =
+ register_import
+ ~import_module:(if Config.Flag.wasi () then "env" else "Math")
+ ~name
+ (Fun (float_func_type 1))
+ in
let* x = x in
return (W.Call (f, [ x ]))
@@ -1345,7 +1354,12 @@ module Math = struct
let log10 f = unary "log10" f
let binary name x y =
- let* f = register_import ~import_module:"Math" ~name (Fun (float_func_type 2)) in
+ let* f =
+ register_import
+ ~import_module:(if Config.Flag.wasi () then "env" else "Math")
+ ~name
+ (Fun (float_func_type 2))
+ in
let* x = x in
let* y = y in
return (W.Call (f, [ x; y ]))
@@ -1688,21 +1702,34 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
x
(block_expr
{ params = []; result = [ Value.value ] }
- (let* exn =
- block_expr
- { params = []; result = [ externref ] }
- (let* e =
- try_expr
- { params = []; result = [ externref ] }
- (body
- ~result_typ:[ externref ]
- ~fall_through:`Skip
- ~context:(`Skip :: `Skip :: `Catch :: context))
- [ ocaml_tag, 1, Value.value; js_tag, 0, externref ]
- in
- instr (W.Push e))
- in
- instr (W.CallInstr (f, [ exn ]))))
+ (if Config.Flag.wasi ()
+ then
+ let* e =
+ try_expr
+ { params = []; result = [ Value.value ] }
+ (body
+ ~result_typ:[ Value.value ]
+ ~fall_through:`Skip
+ ~context:(`Skip :: `Catch :: context))
+ [ ocaml_tag, 0, Value.value ]
+ in
+ instr (W.Push e)
+ else
+ let* exn =
+ block_expr
+ { params = []; result = [ externref ] }
+ (let* e =
+ try_expr
+ { params = []; result = [ externref ] }
+ (body
+ ~result_typ:[ externref ]
+ ~fall_through:`Skip
+ ~context:(`Skip :: `Skip :: `Catch :: context))
+ [ ocaml_tag, 1, Value.value; js_tag, 0, externref ]
+ in
+ instr (W.Push e))
+ in
+ instr (W.CallInstr (f, [ exn ]))))
in
let* () = no_event in
exn_handler ~result_typ ~fall_through ~context)
diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml
index f3028fcdb7..4e89bafc8f 100644
--- a/compiler/lib-wasm/generate.ml
+++ b/compiler/lib-wasm/generate.ml
@@ -26,8 +26,7 @@ let times = Debug.find "times"
let effects_cps () =
match Config.effects () with
| `Cps | `Double_translation -> true
- | `Jspi -> false
- | `Disabled -> assert false
+ | `Disabled | `Jspi -> false
module Generate (Target : Target_sig.S) = struct
open Target
diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml
index 15488319a4..e9217aac3c 100644
--- a/compiler/lib/config.ml
+++ b/compiler/lib/config.ml
@@ -101,6 +101,8 @@ module Flag = struct
let auto_link = o ~name:"auto-link" ~default:true
let es6 = o ~name:"es6" ~default:false
+
+ let wasi = o ~name:"wasi" ~default:false
end
module Param = struct
diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli
index 71642430bf..a4f7a5538f 100644
--- a/compiler/lib/config.mli
+++ b/compiler/lib/config.mli
@@ -76,6 +76,8 @@ module Flag : sig
val es6 : unit -> bool
+ val wasi : unit -> bool
+
val enable : string -> unit
val disable : string -> unit
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 484489069e..28828e6e89 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -691,8 +691,9 @@ let optimize ~profile p =
+> map_fst
(match Config.target (), Config.effects () with
| `JavaScript, `Disabled -> Generate_closure.f
- | `JavaScript, (`Cps | `Double_translation) | `Wasm, (`Jspi | `Cps) -> Fun.id
- | `JavaScript, `Jspi | `Wasm, (`Disabled | `Double_translation) -> assert false)
+ | `JavaScript, (`Cps | `Double_translation) | `Wasm, (`Disabled | `Jspi | `Cps)
+ -> Fun.id
+ | `JavaScript, `Jspi | `Wasm, `Double_translation -> assert false)
+> map_fst deadcode'
in
if times () then Format.eprintf "Start Optimizing...@.";
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index b4f5cdcd44..1d5c78f934 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -306,7 +306,7 @@ let times = Debug.find "times"
let stats = Debug.find "stats"
-let f p live_vars =
+let f p (live_vars : Deadcode.variable_uses) =
let inline_count = ref 0 in
Code.invariant p;
let t = Timer.make () in
diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune
index a8daf4e0a9..bafb9378b5 100644
--- a/compiler/tests-jsoo/dune
+++ b/compiler/tests-jsoo/dune
@@ -11,6 +11,8 @@
(enabled_if
(>= %{ocaml_version} 4.14))
(inline_tests
+ (deps
+ (sandbox preserve_file_kind))
(modes js wasm best))
(preprocess
(pps ppx_expect)))
@@ -22,6 +24,8 @@
(enabled_if
(>= %{ocaml_version} 5.1.1))
(inline_tests
+ (deps
+ (sandbox preserve_file_kind))
(modes js wasm best))
(preprocess
(pps ppx_expect)))
@@ -33,6 +37,22 @@
(enabled_if
(>= %{ocaml_version} 5.1.1))
(inline_tests
+ (deps
+ (sandbox preserve_file_kind))
+ (modes js wasm best))
+ (preprocess
+ (pps ppx_expect)))
+
+(library
+ (name jsoo_testsuite_perms)
+ (modules test_unix_perms)
+ (libraries unix)
+ ;; WASI has no notion of file permissions (it uses capabilities instead)
+ (enabled_if
+ (<> %{profile} wasi))
+ (inline_tests
+ (deps
+ (sandbox preserve_file_kind))
(modes js wasm best))
(preprocess
(pps ppx_expect)))
@@ -47,6 +67,7 @@
test_float16
test_marshal_compressed
test_parsing
+ test_unix_perms
calc_parser
calc_lexer))
(libraries unix compiler-libs.common js_of_ocaml-compiler)
@@ -54,6 +75,8 @@
(language c)
(names bigarray_stubs jsoo_runtime_stubs))
(inline_tests
+ (deps
+ (sandbox preserve_file_kind))
(modes js wasm best))
(preprocess
(pps ppx_expect)))
diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune
index be8029f8b1..679ccb2f43 100644
--- a/compiler/tests-jsoo/lib-effects/dune
+++ b/compiler/tests-jsoo/lib-effects/dune
@@ -1,6 +1,10 @@
(env
(with-effects-double-translation)
(with-effects)
+ (wasi
+ (wasm_of_ocaml
+ (flags
+ (:standard --enable effects))))
(_
(js_of_ocaml
(flags
@@ -11,6 +15,8 @@
(enabled_if
(>= %{ocaml_version} 5))
(inline_tests
+ (deps
+ (sandbox preserve_file_kind))
(modes js wasm best))
(modules
(:standard
diff --git a/compiler/tests-jsoo/test_unix.ml b/compiler/tests-jsoo/test_unix.ml
index aa25c0baad..3546260463 100644
--- a/compiler/tests-jsoo/test_unix.ml
+++ b/compiler/tests-jsoo/test_unix.ml
@@ -14,85 +14,6 @@ let%expect_test "Unix.times" =
then Printf.printf "OK\n";
[%expect {| OK |}]
-let on_windows = Sys.os_type = "Win32"
-
-let%expect_test "Unix.chmod / Unix.fchmod / Unix.access" =
- let tmp = Filename.temp_file "a" "txt" in
- let test ?(ok_on_windows = false) flags =
- try
- Unix.access tmp flags;
- if on_windows && ok_on_windows
- then Printf.printf "denied (success on Windows)\n"
- else Printf.printf "success\n"
- with
- | Unix.Unix_error ((EPERM | EACCES), _, _) ->
- if (not on_windows) && ok_on_windows
- then Printf.printf "denied (success on Windows)\n"
- else Printf.printf "denied\n"
- | Unix.Unix_error (ENOENT, _, _) -> Printf.printf "absent\n"
- in
- let touch perms =
- Unix.chmod tmp 0o600;
- Unix.unlink tmp;
- let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] perms in
- Unix.close fd
- in
- let test_perms set =
- set 0o200;
- test ~ok_on_windows:true [ R_OK ];
- test [ W_OK ];
- test ~ok_on_windows:true [ R_OK; W_OK ];
- [%expect
- {|
- denied (success on Windows)
- success
- denied (success on Windows)
- |}];
- set 0o400;
- test [ R_OK ];
- test [ W_OK ];
- test [ R_OK; W_OK ];
- [%expect {|
- success
- denied
- denied |}];
- set 0o600;
- test [ R_OK ];
- test [ W_OK ];
- test [ R_OK; W_OK ];
- [%expect {|
- success
- success
- success |}];
- set 0o000;
- test ~ok_on_windows:true [ R_OK ];
- test [ W_OK ];
- test [ R_OK; W_OK ];
- [%expect {|
- denied (success on Windows)
- denied
- denied
- |}]
- in
- test [ F_OK ];
- [%expect {|
- success |}];
- Unix.chmod tmp 0o600;
- Unix.unlink tmp;
- test [ F_OK ];
- [%expect {|
- absent |}];
- let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] 0o666 in
- test [ F_OK ];
- [%expect {|
- success |}];
- if not on_windows then test_perms (Unix.fchmod fd);
- Unix.close fd;
- test_perms (Unix.chmod tmp);
- test_perms touch;
- Unix.chmod tmp 0o600;
- Unix.unlink tmp
-
let%expect_test "Unix.link" =
let tmp = Filename.temp_file "a" "txt" in
let ch = open_out tmp in
diff --git a/compiler/tests-jsoo/test_unix_perms.ml b/compiler/tests-jsoo/test_unix_perms.ml
new file mode 100644
index 0000000000..8f07952db9
--- /dev/null
+++ b/compiler/tests-jsoo/test_unix_perms.ml
@@ -0,0 +1,78 @@
+let on_windows = Sys.os_type = "Win32"
+
+let%expect_test "Unix.chmod / Unix.fchmod / Unix.access" =
+ let tmp = Filename.temp_file "a" "txt" in
+ let test ?(ok_on_windows = false) flags =
+ try
+ Unix.access tmp flags;
+ if on_windows && ok_on_windows
+ then Printf.printf "denied (success on Windows)\n"
+ else Printf.printf "success\n"
+ with
+ | Unix.Unix_error ((EPERM | EACCES), _, _) ->
+ if (not on_windows) && ok_on_windows
+ then Printf.printf "denied (success on Windows)\n"
+ else Printf.printf "denied\n"
+ | Unix.Unix_error (ENOENT, _, _) -> Printf.printf "absent\n"
+ in
+ let touch perms =
+ Unix.chmod tmp 0o600;
+ Unix.unlink tmp;
+ let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] perms in
+ Unix.close fd
+ in
+ let test_perms set =
+ set 0o200;
+ test ~ok_on_windows:true [ R_OK ];
+ test [ W_OK ];
+ test ~ok_on_windows:true [ R_OK; W_OK ];
+ [%expect
+ {|
+ denied (success on Windows)
+ success
+ denied (success on Windows)
+ |}];
+ set 0o400;
+ test [ R_OK ];
+ test [ W_OK ];
+ test [ R_OK; W_OK ];
+ [%expect {|
+ success
+ denied
+ denied |}];
+ set 0o600;
+ test [ R_OK ];
+ test [ W_OK ];
+ test [ R_OK; W_OK ];
+ [%expect {|
+ success
+ success
+ success |}];
+ set 0o000;
+ test ~ok_on_windows:true [ R_OK ];
+ test [ W_OK ];
+ test [ R_OK; W_OK ];
+ [%expect {|
+ denied (success on Windows)
+ denied
+ denied
+ |}]
+ in
+ test [ F_OK ];
+ [%expect {|
+ success |}];
+ Unix.chmod tmp 0o600;
+ Unix.unlink tmp;
+ test [ F_OK ];
+ [%expect {|
+ absent |}];
+ let fd = Unix.openfile tmp [ O_WRONLY; O_CREAT; O_TRUNC ] 0o666 in
+ test [ F_OK ];
+ [%expect {|
+ success |}];
+ if not on_windows then test_perms (Unix.fchmod fd);
+ Unix.close fd;
+ test_perms (Unix.chmod tmp);
+ test_perms touch;
+ Unix.chmod tmp 0o600;
+ Unix.unlink tmp
diff --git a/compiler/tests-ocaml/basic-io-2/dune b/compiler/tests-ocaml/basic-io-2/dune
index 121f745198..e666404c1f 100644
--- a/compiler/tests-ocaml/basic-io-2/dune
+++ b/compiler/tests-ocaml/basic-io-2/dune
@@ -1,5 +1,8 @@
(tests
(names io)
(modes js wasm)
+ ;; Sys.command not available
+ (enabled_if
+ (<> %{profile} wasi))
(action
(run node %{test} %{dep:test-file-short-lines})))
diff --git a/compiler/tests-ocaml/effect-syntax/dune b/compiler/tests-ocaml/effect-syntax/dune
index 22b9fdf7e4..6b08c88e72 100644
--- a/compiler/tests-ocaml/effect-syntax/dune
+++ b/compiler/tests-ocaml/effect-syntax/dune
@@ -1,6 +1,10 @@
(env
(with-effects-double-translation)
(with-effects)
+ (wasi
+ (wasm_of_ocaml
+ (flags
+ (:standard --enable=effects))))
(_
(js_of_ocaml
(flags
diff --git a/compiler/tests-ocaml/effects/dune b/compiler/tests-ocaml/effects/dune
index 019935b596..d832b983a7 100644
--- a/compiler/tests-ocaml/effects/dune
+++ b/compiler/tests-ocaml/effects/dune
@@ -1,6 +1,10 @@
(env
(with-effects-double-translation)
(with-effects)
+ (wasi
+ (wasm_of_ocaml
+ (flags
+ (:standard --enable=effects))))
(_
(js_of_ocaml
(flags
diff --git a/compiler/tests-ocaml/lib-channels/close_in.ml b/compiler/tests-ocaml/lib-channels/close_in.ml
index 9b3717362a..8697d78c6a 100644
--- a/compiler/tests-ocaml/lib-channels/close_in.ml
+++ b/compiler/tests-ocaml/lib-channels/close_in.ml
@@ -6,8 +6,14 @@
between 1 and IO_BUFFER_SIZE *)
let nb_bytes = 3
+let temp_file =
+ let name, ch = Filename.open_temp_file "data" ".txt" in
+ output_string ch (String.make 1024 'a');
+ close_out ch;
+ name
+
let () =
- let ic = open_in_bin (Filename.basename Sys.argv.(0)) in
+ let ic = open_in_bin temp_file in
seek_in ic nb_bytes;
close_in ic;
assert (
@@ -21,7 +27,7 @@ let () =
(* A variant of #11878, which #11965 failed to fix. *)
let () =
- let ic = open_in_bin (Filename.basename Sys.argv.(0)) in
+ let ic = open_in_bin temp_file in
close_in ic;
begin try
seek_in ic (-1);
diff --git a/compiler/tests-ocaml/lib-digest/dune b/compiler/tests-ocaml/lib-digest/dune
index 3ba1799930..19fe2dce08 100644
--- a/compiler/tests-ocaml/lib-digest/dune
+++ b/compiler/tests-ocaml/lib-digest/dune
@@ -8,6 +8,8 @@
(names digests)
(libraries)
(build_if
- (>= %{ocaml_version} 5.2))
+ (and
+ (>= %{ocaml_version} 5.2)
+ (<> %{profile} wasi)))
(modules digests)
(modes js wasm))
diff --git a/compiler/tests-ocaml/lib-marshal/intext.ml b/compiler/tests-ocaml/lib-marshal/intext.ml
index 3e0477dffd..5340806495 100644
--- a/compiler/tests-ocaml/lib-marshal/intext.ml
+++ b/compiler/tests-ocaml/lib-marshal/intext.ml
@@ -4,7 +4,8 @@
(* Test for output_value / input_value *)
-let max_data_depth = 500000
+let max_data_depth = 10000
+(* Reduced since we use a quadratic algorithm for sharing in the WASI runtime *)
type t = A | B of int | C of float | D of string | E of char
| F of t | G of t * t | H of int * t | I of t * float | J
diff --git a/compiler/tests-ocaml/lib-marshal/intext_par.ml b/compiler/tests-ocaml/lib-marshal/intext_par.ml
index f93c55c685..fbf0a8dec9 100644
--- a/compiler/tests-ocaml/lib-marshal/intext_par.ml
+++ b/compiler/tests-ocaml/lib-marshal/intext_par.ml
@@ -17,7 +17,8 @@ let test_size =
let num_domains = 1 lsl test_size
-let max_data_depth = 500000
+let max_data_depth = 10000
+(* Reduced since we use a quadratic algorithm for sharing in the WASI runtime *)
type t = A | B of int | C of float | D of string | E of char
| F of t | G of t * t | H of int * t | I of t * float | J
diff --git a/compiler/tests-ocaml/lib-unix/isatty/dune b/compiler/tests-ocaml/lib-unix/isatty/dune
index 6740efe55b..852dd49d6a 100644
--- a/compiler/tests-ocaml/lib-unix/isatty/dune
+++ b/compiler/tests-ocaml/lib-unix/isatty/dune
@@ -6,7 +6,10 @@
(tests
(names isatty_tty)
(enabled_if
- (not %{env:CI=false}))
+ (and
+ (<> %{profile} wasi)
+ (not %{env:CI=false})))
+ ; WASI has no notion of tty
; isatty_tty does not work on the CI since we are not running in a tty there
(libraries ocaml_testing unix)
(modes js wasm))
diff --git a/dune b/dune
index a4064b14a9..150a7dacbd 100644
--- a/dune
+++ b/dune
@@ -30,6 +30,14 @@
(binaries
(tools/node_wrapper.exe as node)
(tools/node_wrapper.exe as node.exe)))
+ (wasi
+ (wasm_of_ocaml
+ (flags
+ (:standard --pretty --enable wasi))
+ (compilation_mode whole_program))
+ (binaries
+ (tools/node_wrapper.exe as node)
+ (tools/node_wrapper.exe as node.exe)))
(bench_no_debug
(flags
(:standard \ -g))
diff --git a/lib/deriving_json/tests/dune b/lib/deriving_json/tests/dune
index c1e0147b3d..b7772e347e 100644
--- a/lib/deriving_json/tests/dune
+++ b/lib/deriving_json/tests/dune
@@ -2,6 +2,8 @@
(name deriving_expect_tests)
(libraries unix js_of_ocaml js_of_ocaml.deriving)
(inline_tests
+ (enabled_if
+ (<> %{profile} wasi))
(modes js wasm))
(preprocess
(pps ppx_expect ppx_deriving_json)))
diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc
index 7abcb2b003..2025f19ffc 100644
--- a/lib/tests/dune.inc
+++ b/lib/tests/dune.inc
@@ -2,7 +2,7 @@
(library
;; lib/tests/test_css_angle.ml
(name test_css_angle_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_css_angle)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -12,7 +12,7 @@
(library
;; lib/tests/test_css_color.ml
(name test_css_color_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_css_color)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -22,7 +22,7 @@
(library
;; lib/tests/test_css_length.ml
(name test_css_length_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_css_length)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -42,7 +42,7 @@
(library
;; lib/tests/test_fun_call_2.ml
(name test_fun_call_2_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_fun_call_2)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -52,7 +52,7 @@
(library
;; lib/tests/test_json.ml
(name test_json_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_json)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -62,7 +62,7 @@
(library
;; lib/tests/test_nodejs_filesystem_errors.ml
(name test_nodejs_filesystem_errors_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_nodejs_filesystem_errors)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -82,7 +82,7 @@
(library
;; lib/tests/test_poly_equal.ml
(name test_poly_equal_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_poly_equal)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -92,7 +92,7 @@
(library
;; lib/tests/test_regexp.ml
(name test_regexp_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_regexp)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -112,7 +112,7 @@
(library
;; lib/tests/test_typed_array.ml
(name test_typed_array_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_typed_array)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -122,7 +122,7 @@
(library
;; lib/tests/test_unsafe_set_get.ml
(name test_unsafe_set_get_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_unsafe_set_get)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
@@ -132,7 +132,7 @@
(library
;; lib/tests/test_url.ml
(name test_url_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasi))
(modules test_url)
(libraries js_of_ocaml unix)
(inline_tests (modes js wasm))
diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml
index 8cc26a522b..d928746e96 100644
--- a/lib/tests/gen-rules/gen.ml
+++ b/lib/tests/gen-rules/gen.ml
@@ -81,7 +81,8 @@ let () =
basename
(Hashtbl.hash prefix mod 100)
(match enabled_if basename with
- | Any | Not_wasm -> "true"
+ | Any -> "(<> %{profile} wasi)"
+ | Not_wasm -> "true"
| GE5 -> "(>= %{ocaml_version} 5)"
| No_effects_not_wasm -> "(<> %{profile} with-effects)")
basename
diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat
index 6b351fb78d..25282323a4 100644
--- a/runtime/wasm/backtrace.wat
+++ b/runtime/wasm/backtrace.wat
@@ -18,10 +18,20 @@
(module
(import "fail" "caml_invalid_argument"
(func $caml_invalid_argument (param (ref eq))))
+(@if wasi
+(@then
+ (global $backtrace_status (mut (ref eq)) (ref.i31 (i32.const 0)))
+ (func $backtrace_status (result (ref eq))
+ (global.get $backtrace_status))
+ (func $record_backtrace (param $b (ref eq))
+ (global.set $backtrace_status (local.get $b)))
+)
+(@else
(import "bindings" "backtrace_status"
(func $backtrace_status (result (ref eq))))
(import "bindings" "record_backtrace"
(func $record_backtrace (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 9c83528475..c468ada3f6 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -65,6 +65,448 @@
(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)))
+
+(@if wasi
+(@then
+ (type $i32_array (array (mut i32)))
+ (type $i16_array (array (mut i16)))
+ (type $f32_array (array (mut f32)))
+
+ (type $data
+ (struct
+ (field $array (ref array))
+ (field $offset i32)
+ (field $len i32)))
+
+ (func $ta_create (export "ta_create")
+ (param $kind i32) (param $sz i32) (result (ref extern))
+ (local $a (ref array))
+ (local.set $a
+ (block $cont (result (ref array))
+ (block $f32
+ (block $f64
+ (block $i8
+ (block $i16
+ (block $i32
+ (br_table
+ $f32 $f64 $i8 $i8 $i16 $i16 $i32
+ $i32 $i32 $i32 $f32 $f64 $i8 $i16
+ (local.get $kind)))
+ ;; i32
+ (br $cont (array.new $i32_array (i32.const 0) (local.get $sz))))
+ ;; i16
+ (br $cont (array.new $i16_array (i32.const 0) (local.get $sz))))
+ ;; i8
+ (br $cont (array.new $bytes (i32.const 0) (local.get $sz))))
+ ;; f64
+ (br $cont (array.new $float_array (f64.const 0) (local.get $sz))))
+ ;; f32
+ (array.new $f32_array (f32.const 0) (local.get $sz))))
+ (extern.convert_any
+ (struct.new $data (local.get $a) (i32.const 0) (local.get $sz))))
+
+ (func $ta_length (export "ta_length") (param $b (ref extern)) (result i32)
+ (struct.get $data $len
+ (ref.cast (ref $data) (any.convert_extern (local.get $b)))))
+
+ (func $ta_get_f64 (param $b (ref extern)) (param $i i32) (result f64)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.get $float_array
+ (ref.cast (ref $float_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))))
+
+ (func $ta_get_f32 (param $b (ref extern)) (param $i i32) (result f64)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (f64.promote_f32
+ (array.get $f32_array
+ (ref.cast (ref $f32_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)))))
+
+ (func $ta_get_i32 (export "ta_get_i32")
+ (param $b (ref extern)) (param $i i32) (result i32)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.get $i32_array
+ (ref.cast (ref $i32_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))))
+
+ (func $ta_get_i16 (param $b (ref extern)) (param $i i32) (result i32)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.get_s $i16_array
+ (ref.cast (ref $i16_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))))
+
+ (func $ta_get_ui16 (param $b (ref extern)) (param $i i32) (result i32)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.get_u $i16_array
+ (ref.cast (ref $i16_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))))
+
+ (func $ta_get_i8 (param $b (ref extern)) (param $i i32) (result i32)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.get_s $bytes
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))))
+
+ (func $ta_get_ui8 (export "ta_get_ui8")
+ (param $b (ref extern)) (param $i i32) (result i32)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.get_u $bytes
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))))
+
+ (func $ta_get32_ui8 (export "ta_get32_ui8")
+ (param $b (ref extern)) (param $i i32) (result i32)
+ (local $d (ref $data)) (local $s (ref $bytes))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $s
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d))))
+ (local.set $i
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)))
+ (i32.or
+ (i32.or
+ (array.get_u $bytes (local.get $s) (local.get $i))
+ (i32.shl
+ (array.get_u $bytes (local.get $s)
+ (i32.add (local.get $i) (i32.const 1)))
+ (i32.const 8)))
+ (i32.or
+ (i32.shl
+ (array.get_u $bytes (local.get $s)
+ (i32.add (local.get $i) (i32.const 2)))
+ (i32.const 16))
+ (i32.shl
+ (array.get_u $bytes (local.get $s)
+ (i32.add (local.get $i) (i32.const 3)))
+ (i32.const 24)))))
+
+ (func $ta_get16_ui8 (export "ta_get16_ui8")
+ (param $b (ref extern)) (param $i i32) (result i32)
+ (local $d (ref $data)) (local $s (ref $bytes))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $s
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d))))
+ (local.set $i
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)))
+ (i32.or
+ (array.get_u $bytes (local.get $s) (local.get $i))
+ (i32.shl
+ (array.get_u $bytes (local.get $s)
+ (i32.add (local.get $i) (i32.const 1)))
+ (i32.const 8))))
+
+ (func $ta_set_f64 (param $b (ref extern)) (param $i i32) (param $v f64)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.set $float_array
+ (ref.cast (ref $float_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))
+ (local.get $v)))
+
+ (func $ta_set_f32 (param $b (ref extern)) (param $i i32) (param $v f64)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.set $f32_array
+ (ref.cast (ref $f32_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))
+ (f32.demote_f64 (local.get $v))))
+
+ (func $ta_set_i32 (export "ta_set_i32")
+ (param $b (ref extern)) (param $i i32) (param $v i32)
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.set $i32_array
+ (ref.cast (ref $i32_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))
+ (local.get $v)))
+
+ (func $ta_set_i16 (param $b (ref extern)) (param $i i32) (param $v (ref i31))
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.set $i16_array
+ (ref.cast (ref $i16_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))
+ (i31.get_u (local.get $v))))
+
+ (func $ta_set_ui16 (param $b (ref extern)) (param $i i32) (param $v (ref i31))
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.set $i16_array
+ (ref.cast (ref $i16_array) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))
+ (i31.get_u (local.get $v))))
+
+ (func $ta_set_i8 (param $b (ref extern)) (param $i i32) (param $v (ref i31))
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.set $bytes
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))
+ (i31.get_u (local.get $v))))
+
+ (func $ta_set_ui8 (export "ta_set_ui8")
+ (param $b (ref extern)) (param $i i32) (param $v (ref i31))
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (array.set $bytes
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d)))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i))
+ (i31.get_u (local.get $v))))
+
+ (func $ta_set16_ui8
+ (param $b (ref extern)) (param $i i32) (param $v (ref i31))
+ (local $d (ref $data)) (local $s (ref $bytes)) (local $j i32)
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $s
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d))))
+ (local.set $j (i31.get_u (local.get $v)))
+ (local.set $i
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)))
+ (array.set $bytes (local.get $s) (local.get $i) (local.get $j))
+ (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 1))
+ (i32.shr_u (local.get $j) (i32.const 8))))
+
+ (func $ta_set32_ui8 (param $b (ref extern)) (param $i i32) (param $v i32)
+ (local $d (ref $data)) (local $s (ref $bytes))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $s
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $d))))
+ (local.set $i
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $i)))
+ (array.set $bytes (local.get $s) (local.get $i) (local.get $v))
+ (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 1))
+ (i32.shr_u (local.get $v) (i32.const 8)))
+ (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 2))
+ (i32.shr_u (local.get $v) (i32.const 16)))
+ (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 3))
+ (i32.shr_u (local.get $v) (i32.const 24))))
+
+ (func $ta_fill_int (param $b (ref extern)) (param $v i32)
+ (local $d (ref $data))
+ (local $a (ref array))
+ (local $a32 (ref $i32_array)) (local $a16 (ref $i16_array))
+ (local $a8 (ref $bytes))
+ (local $ofs i32) (local $i i32) (local $len i32)
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $a (struct.get $data $array (local.get $d)))
+ (local.set $ofs (struct.get $data $offset (local.get $d)))
+ (local.set $len (struct.get $data $len (local.get $d)))
+ (if (ref.test (ref $i32_array) (local.get $a))
+ (then
+ (local.set $a32 (ref.cast (ref $i32_array) (local.get $a)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $i32_array (local.get $a32)
+ (i32.add (local.get $ofs) (local.get $i))
+ (local.get $v))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+ (else (if (ref.test (ref $i16_array) (local.get $a))
+ (then
+ (local.set $a16 (ref.cast (ref $i16_array) (local.get $a)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $i16_array (local.get $a16)
+ (i32.add (local.get $ofs) (local.get $i))
+ (local.get $v))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+ (else
+ (local.set $a8 (ref.cast (ref $bytes) (local.get $a)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $bytes (local.get $a8)
+ (i32.add (local.get $ofs) (local.get $i))
+ (local.get $v))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))))))
+
+ (func $ta_fill_float (param $b (ref extern)) (param $f f64)
+ (local $d (ref $data))
+ (local $a (ref array))
+ (local $a64 (ref $float_array)) (local $a32 (ref $f32_array))
+ (local $f32 f32)
+ (local $ofs i32) (local $i i32) (local $len i32)
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $a (struct.get $data $array (local.get $d)))
+ (local.set $ofs (struct.get $data $offset (local.get $d)))
+ (local.set $len (struct.get $data $len (local.get $d)))
+ (if (ref.test (ref $float_array) (local.get $a))
+ (then
+ (local.set $a64 (ref.cast (ref $float_array) (local.get $a)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $float_array (local.get $a64)
+ (i32.add (local.get $ofs) (local.get $i))
+ (local.get $f))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+ (else
+ (local.set $a32 (ref.cast (ref $f32_array) (local.get $a)))
+ (local.set $f32 (f32.demote_f64 (local.get $f)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $f32_array (local.get $a32)
+ (i32.add (local.get $ofs) (local.get $i))
+ (local.get $f32))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))))
+
+ (func $ta_set (export "ta_set")
+ (param $d (ref extern)) (param $s (ref extern)) (param $do i32)
+ (local $sd (ref $data)) (local $sa (ref array)) (local $so i32)
+ (local $dd (ref $data)) (local $da (ref array))
+ (local $i i32) (local $len i32)
+ (local $sf64 (ref $float_array)) (local $df64 (ref $float_array))
+ (local $sf32 (ref $f32_array)) (local $df32 (ref $f32_array))
+ (local $si32 (ref $i32_array)) (local $di32 (ref $i32_array))
+ (local $si16 (ref $i16_array)) (local $di16 (ref $i16_array))
+ (local $si8 (ref $bytes)) (local $di8 (ref $bytes))
+ (local.set $sd (ref.cast (ref $data) (any.convert_extern (local.get $s))))
+ (local.set $sa (struct.get $data $array (local.get $sd)))
+ (local.set $so (struct.get $data $offset (local.get $sd)))
+ (local.set $len (struct.get $data $len (local.get $sd)))
+ (local.set $dd (ref.cast (ref $data) (any.convert_extern (local.get $d))))
+ (local.set $da (struct.get $data $array (local.get $dd)))
+ (local.set $do
+ (i32.add (struct.get $data $offset (local.get $dd)) (local.get $do)))
+ (if (ref.test (ref $float_array) (local.get $sa))
+ (then
+ (local.set $sf64 (ref.cast (ref $float_array) (local.get $sa)))
+ (local.set $df64 (ref.cast (ref $float_array) (local.get $da)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $float_array (local.get $df64)
+ (i32.add (local.get $do) (local.get $i))
+ (array.get $float_array (local.get $sf64)
+ (i32.add (local.get $so) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))))
+ (if (ref.test (ref $f32_array) (local.get $sa))
+ (then
+ (local.set $sf32 (ref.cast (ref $f32_array) (local.get $sa)))
+ (local.set $df32 (ref.cast (ref $f32_array) (local.get $da)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $f32_array (local.get $df32)
+ (i32.add (local.get $do) (local.get $i))
+ (array.get $f32_array (local.get $sf32)
+ (i32.add (local.get $so) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))))
+ (if (ref.test (ref $i32_array) (local.get $sa))
+ (then
+ (local.set $si32 (ref.cast (ref $i32_array) (local.get $sa)))
+ (local.set $di32 (ref.cast (ref $i32_array) (local.get $da)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $i32_array (local.get $di32)
+ (i32.add (local.get $do) (local.get $i))
+ (array.get $i32_array (local.get $si32)
+ (i32.add (local.get $so) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))))
+ (if (ref.test (ref $i16_array) (local.get $sa))
+ (then
+ (local.set $si16 (ref.cast (ref $i16_array) (local.get $sa)))
+ (local.set $di16 (ref.cast (ref $i16_array) (local.get $da)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $i16_array (local.get $di16)
+ (i32.add (local.get $do) (local.get $i))
+ (array.get $i16_array (local.get $si16)
+ (i32.add (local.get $so) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))))
+ (if (ref.test (ref $bytes) (local.get $sa))
+ (then
+ (local.set $si8 (ref.cast (ref $bytes) (local.get $sa)))
+ (local.set $di8 (ref.cast (ref $bytes) (local.get $da)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $bytes (local.get $di8)
+ (i32.add (local.get $do) (local.get $i))
+ (array.get $bytes (local.get $si8)
+ (i32.add (local.get $so) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))))
+
+ (func $ta_blit (param $s (ref extern)) (param $d (ref extern))
+ (return_call $ta_set (local.get $d) (local.get $s) (i32.const 0)))
+
+ (func $ta_subarray (export "ta_subarray")
+ (param $b (ref extern)) (param $s i32) (param $e i32) (result (ref extern))
+ (local $d (ref $data))
+ (local.set $d (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (extern.convert_any
+ (struct.new $data
+ (struct.get $data $array (local.get $d))
+ (i32.add (struct.get $data $offset (local.get $d)) (local.get $s))
+ (i32.sub (local.get $e) (local.get $s)))))
+
+ (func $ta_blit_from_bytes (export "ta_blit_from_bytes")
+ (param $s (ref $bytes)) (param $so i32)
+ (param $b (ref extern)) (param $do i32)
+ (param $len i32)
+ (local $data (ref $data))
+ (local $d (ref $bytes))
+ (local $i i32)
+ (local.set $data
+ (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $d
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $data))))
+ (local.set $do
+ (i32.add (local.get $do (struct.get $data $offset (local.get $data)))))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $bytes (local.get $d)
+ (i32.add (local.get $do) (local.get $i))
+ (array.get $bytes (local.get $s)
+ (i32.add (local.get $so) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+
+ (func $ta_blit_to_bytes (export "ta_blit_to_bytes")
+ (param $b (ref extern)) (param $so i32)
+ (param $d (ref $bytes)) (param $do i32)
+ (param $len i32)
+ (local $data (ref $data))
+ (local $s (ref $bytes))
+ (local $i i32)
+ (local.set $data
+ (ref.cast (ref $data) (any.convert_extern (local.get $b))))
+ (local.set $s
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $data))))
+ (local.set $so
+ (i32.add (local.get $so (struct.get $data $offset (local.get $data)))))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $bytes (local.get $d)
+ (i32.add (local.get $do) (local.get $i))
+ (array.get $bytes (local.get $s)
+ (i32.add (local.get $so) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+)
+(@else
(import "bindings" "ta_create"
(func $ta_create (param i32) (param i32) (result (ref extern))))
(import "bindings" "ta_normalize"
@@ -126,6 +568,7 @@
(func $ta_blit_to_bytes
(param (ref extern)) (param i32) (param (ref $bytes)) (param i32)
(param i32)))
+))
(type $block (array (mut (ref eq))))
(type $bytes (array (mut i8)))
@@ -831,6 +1274,8 @@
(@string $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind")
(@string $ta_too_large "Typed_array.to_genarray: too large")
+(@if (not wasi)
+(@then
(func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq))
(local $data (ref extern))
(local $kind i32)
@@ -859,6 +1304,7 @@
(any.convert_extern
(struct.get $bigarray $ba_data
(ref.cast (ref $bigarray) (local.get 0))))))
+))
(func $caml_ba_get_at_offset
(param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
@@ -2121,6 +2567,8 @@
(i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32))))
(ref.i31 (i32.const 0)))
+(@if (not wasi)
+(@then
(export "caml_bytes_of_uint8_array" (func $caml_string_of_uint8_array))
(func $caml_string_of_uint8_array (export "caml_string_of_uint8_array")
(param (ref eq)) (result (ref eq))
@@ -2152,6 +2600,7 @@
(local.get $s) (i32.const 0) (local.get $ta) (i32.const 0)
(local.get $len))
(call $wrap (any.convert_extern (local.get $ta))))
+))
(func (export "caml_ba_get_kind") (param (ref eq)) (result i32)
(struct.get $bigarray $ba_kind (ref.cast (ref $bigarray) (local.get 0))))
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 1d9afd2ae9..ec3b903b02 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -31,6 +31,31 @@
(func $caml_ba_fill (param (ref eq)) (param (ref eq)) (result (ref eq))))
(import "bigarray" "caml_ba_get_data"
(func $caml_ba_get_data (param (ref eq)) (result (ref extern))))
+(@if wasi
+(@then
+ (import "bigarray" "ta_get_ui8"
+ (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32)))
+ (import "bigarray" "ta_get32_ui8"
+ (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32)))
+ (import "bigarray" "ta_set_ui8"
+ (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31))))
+ (import "bigarray" "ta_subarray"
+ (func $ta_subarray
+ (param (ref extern)) (param i32) (param i32) (result (ref extern))))
+ (import "bigarray" "ta_set"
+ (func $ta_set (param (ref extern)) (param (ref extern)) (param i32)))
+ (import "bigarray" "ta_length"
+ (func $ta_length (param (ref extern)) (result i32)))
+ (import "bigarray" "ta_blit_from_bytes"
+ (func $ta_blit_from_bytes
+ (param (ref $bytes)) (param i32) (param (ref extern)) (param i32)
+ (param i32)))
+ (import "bigarray" "ta_blit_to_bytes"
+ (func $ta_blit_to_bytes
+ (param (ref extern)) (param i32) (param (ref $bytes)) (param i32)
+ (param i32)))
+)
+(@else
(import "bindings" "ta_create"
(func $ta_create (param i32) (param anyref) (result anyref)))
(import "bindings" "ta_get_ui8"
@@ -56,6 +81,7 @@
(func $ta_blit_to_bytes
(param (ref extern)) (param i32) (param (ref $bytes)) (param i32)
(param i32)))
+))
(import "hash" "caml_hash_mix_int"
(func $caml_hash_mix_int (param i32) (param i32) (result i32)))
@@ -98,6 +124,8 @@
(local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
(i32.xor (local.get $h) (local.get $len)))
+(@if (not wasi)
+(@then
(@string $buffer "buffer")
(func (export "bigstring_to_array_buffer")
@@ -116,6 +144,7 @@
(func (export "bigstring_of_typed_array") (param (ref eq)) (result (ref eq))
(return_call $caml_ba_from_typed_array
(call $wrap (call $ta_bytes (call $unwrap (local.get 0))))))
+))
(func (export "caml_bigstring_memset")
(param $s (ref eq)) (param $pos (ref eq)) (param $len (ref eq))
diff --git a/runtime/wasm/blake2.wat b/runtime/wasm/blake2.wat
index 25ad007838..214f941b67 100644
--- a/runtime/wasm/blake2.wat
+++ b/runtime/wasm/blake2.wat
@@ -1,5 +1,5 @@
(module
-(@if (>= ocaml_version (5 2 0))
+(@if (and (>= ocaml_version (5 2 0)) (not wasi))
(@then
(import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
(import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index b6a48a62b7..4b8805a4a7 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -479,6 +479,8 @@
(call $clear_compare_stack)
(call $caml_invalid_argument (global.get $abstract_value))
(ref.i31 (i32.const 0))))
+(@if (not wasi)
+(@then
(drop (block $v1_not_js (result (ref eq))
(local.set $js1
(struct.get $js 0
@@ -506,6 +508,7 @@
(call $equals (local.get $js1) (local.get $js2)))
(return (global.get $unordered))))
(br $heterogeneous (ref.i31 (i32.const 0)))))
+))
(if (call $caml_is_closure (local.get $v1))
(then
(drop (br_if $heterogeneous (ref.i31 (i32.const 0))
diff --git a/runtime/wasm/deps-wasi.json b/runtime/wasm/deps-wasi.json
new file mode 100644
index 0000000000..0a49660901
--- /dev/null
+++ b/runtime/wasm/deps-wasi.json
@@ -0,0 +1,15 @@
+[
+ {
+ "name": "root",
+ "reaches": ["start", "memory"],
+ "root": true
+ },
+ {
+ "name": "start",
+ "export": "_start"
+ },
+ {
+ "name": "memory",
+ "export": "memory"
+ }
+]
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index a9305e7a41..521dba7637 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -17,6 +17,7 @@
--binaryen=-g
--binaryen-opt=-O3
--set=effects=jspi
+ --disable=wasi
--allowed-imports=bindings,Math,js,wasm:js-string,wasm:text-encoder,wasm:text-decoder
%{target}
%{read-lines:args})))
@@ -32,10 +33,46 @@
--binaryen=-g
--binaryen-opt=-O3
--set=effects=cps
+ --disable=wasi
--allowed-imports=bindings,Math,js,wasm:js-string,wasm:text-encoder,wasm:text-decoder
%{target}
%{read-lines:args})))
+(rule
+ (target runtime-wasi.wasm)
+ (deps
+ args
+ (glob_files *.wat)
+ libc.wasm)
+ (action
+ (run
+ ../../compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.exe
+ --binaryen=-g
+ --binaryen-opt=-O3
+ --set=effects=disabled
+ --enable=wasi
+ --allowed-imports=wasi_snapshot_preview1,OCaml
+ %{target}
+ libc:libc.wasm
+ %{read-lines:args})))
+
+(rule
+ (target runtime-cps-wasi.wasm)
+ (deps
+ args
+ (glob_files *.wat)
+ libc.wasm)
+ (action
+ (run
+ ../../compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.exe
+ --binaryen=-g
+ --binaryen-opt=-O3
+ --set=effects=cps
+ --enable=wasi
+ %{target}
+ libc:libc.wasm
+ %{read-lines:args})))
+
(rule
(target args)
(deps
@@ -45,3 +82,34 @@
(with-stdout-to
%{target}
(run ocaml %{deps}))))
+
+(rule
+ (target libc.new.wasm)
+ (deps libc.c)
+ (enabled_if
+ (not %{env:CI=false}))
+ (mode promote)
+ (action
+ (with-stdout-to
+ %{target}
+ (pipe-stdout
+ (run
+ docker
+ run
+ -v
+ .:/src
+ -w
+ /src
+ ghcr.io/webassembly/wasi-sdk
+ /opt/wasi-sdk/bin/clang
+ -O2
+ libc.c
+ -flto
+ -o
+ -)
+ (run wasm-opt -Oz --strip-debug --strip-dwarf - -o -)))))
+
+(rule
+ (alias recompile-libc)
+ (action
+ (cmp libc.wasm libc.new.wasm)))
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index c34b41c69b..717eed01b1 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -33,6 +33,12 @@
(import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
(import "fail" "javascript_exception"
(tag $javascript_exception (param externref)))
+(@if wasi
+(@then
+ (func $caml_wrap_exception (param externref) (result (ref eq))
+ (unreachable))
+)
+(@else
(import "jslib" "caml_wrap_exception"
(func $caml_wrap_exception (param externref) (result (ref eq))))
(import "bindings" "start_fiber" (func $start_fiber (param (ref eq))))
@@ -41,6 +47,7 @@
(param $f funcref) (param $env eqref) (result anyref)))
(import "bindings" "resume_fiber"
(func $resume_fiber (param externref) (param (ref eq))))
+))
(type $block (array (mut (ref eq))))
(type $bytes (array (mut i8)))
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 04a6092a0e..2aa44adf42 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -18,7 +18,13 @@
(module
(import "stdlib" "caml_global_data"
(global $caml_global_data (mut (ref $block))))
+(@if wasi
+(@then
+ (tag $javascript_exception (param externref))
+)
+(@else
(import "bindings" "jstag" (tag $javascript_exception (param externref)))
+))
(type $block (array (mut (ref eq))))
(type $bytes (array (mut i8)))
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index b0bf76e609..18ee32cc19 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -16,12 +16,35 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
+(@if wasi
+(@then
+ (import "io" "IO_BUFFER_SIZE" (global $IO_BUFFER_SIZE i32))
+ (import "libc" "memory" (memory 2))
+ (import "libc" "free" (func $free (param i32)))
+ (import "libc" "format_float"
+ (func $format_float (param i32 i32 i32 f64) (result i32)))
+ (import "libc" "strtod" (func $strtod (param i32) (param i32) (result f64)))
+ (import "libc" "exp" (func $exp (param f64) (result f64)))
+ (import "wasi_memory" "checked_malloc"
+ (func $checked_malloc (param i32) (result i32)))
+ (import "wasi_memory" "get_buffer" (func $get_buffer (result i32)))
+ (import "wasi_memory" "write_string_to_memory"
+ (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32)))
+ (import "wasi_memory" "release_memory"
+ (func $release_memory (param i32 i32)))
+ (import "wasi_memory" "blit_string_to_memory"
+ (func $blit_string_to_memory (param i32 (ref $bytes))))
+ (import "wasi_memory" "blit_memory_to_string"
+ (func $blit_memory_to_string (param i32 i32) (result (ref $bytes))))
+)
+(@else
(import "bindings" "format_float"
(func $format_float
(param i32) (param i32) (param i32) (param f64) (result anyref)))
(import "bindings" "identity"
(func $parse_float (param anyref) (result f64)))
(import "Math" "exp" (func $exp (param f64) (result f64)))
+))
(import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
(import "fail" "caml_invalid_argument"
(func $caml_invalid_argument (param (ref eq))))
@@ -247,6 +270,49 @@
(global $inf (ref $chars)
(array.new_fixed $chars 3 (@char "i") (@char "n") (@char "f")))
+(@if wasi
+(@then
+ (func (export "caml_format_float")
+ (param $vfmt (ref eq)) (param $arg (ref eq)) (result (ref eq))
+ (local $fmt (ref $bytes)) (local $res (ref $bytes))
+ (local $d f64)
+ (local $buffer i32) (local $out_buffer i32)
+ (local $fmt_len i32) (local $avail i32) (local $len i32)
+ (local.set $fmt (ref.cast (ref $bytes) (local.get $vfmt)))
+ (local.set $d
+ (struct.get $float 0 (ref.cast (ref $float) (local.get $arg))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $fmt_len (array.len (local.get $fmt)))
+ (call $blit_string_to_memory (local.get $buffer) (local.get $fmt))
+ (i32.store8
+ (i32.add (local.get $buffer) (local.get $fmt_len)) (i32.const 0))
+ (local.set $out_buffer
+ (i32.add (local.get $buffer)
+ (i32.add (local.get $fmt_len) (i32.const 1))))
+ (local.set $avail
+ (i32.sub (global.get $IO_BUFFER_SIZE) (local.get $fmt_len)))
+ (local.set $len
+ (call $format_float
+ (local.get $out_buffer) (local.get $avail)
+ (local.get $buffer) (local.get $d)))
+ (if (i32.ge_u (local.get $len) (local.get $avail))
+ (then
+ (local.set $out_buffer
+ (call $checked_malloc (i32.add (local.get $len) (i32.const 1))))
+ (drop
+ (call $format_float
+ (local.get $out_buffer)
+ (i32.add (local.get $len) (i32.const 1))
+ (local.get $buffer) (local.get $d)))))
+ (local.set $res
+ (call $blit_memory_to_string (local.get $out_buffer) (local.get $len)))
+ (if (i32.ge_u (local.get $len) (local.get $avail))
+ (then
+ (call $free (local.get $out_buffer))))
+ (local.get $res)
+ )
+)
+(@else
(func (export "caml_format_float")
(param (ref eq)) (param (ref eq)) (result (ref eq))
(local $f f64) (local $b i64) (local $format (tuple i32 i32 i32 i32))
@@ -329,6 +395,7 @@
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br_if $uppercase (i32.lt_u (local.get $i) (local.get $len))))))
(local.get $s))
+))
(@string $float_of_string "float_of_string")
@@ -485,6 +552,7 @@
(local $s' (ref $bytes))
(local $negative i32) (local $c i32)
(local $f f64)
+ (local $buffer i32) (local $buf i32)
(local.set $s (ref.cast (ref $bytes) (local.get 0)))
(local.set $len (array.len (local.get $s)))
(loop $count
@@ -651,9 +719,26 @@
(f64.const inf)
(local.get $negative))))
))))))))))))))))))
+(@if wasi
+(@then
+ (local.set $buffer (call $get_buffer))
+ (local.set $buf
+ (call $write_string_to_memory
+ (i32.add (local.get $buffer) (i32.const 4))
+ (global.get $IO_BUFFER_SIZE)
+ (local.get $s)))
+ (local.set $f (call $strtod (local.get $buf) (local.get $buffer)))
+ (call $release_memory (i32.add (local.get $buffer) (i32.const 4))
+ (local.get $buf))
+ (br_if $error
+ (i32.ne (i32.load (local.get $buffer))
+ (i32.add (local.get $buf) (local.get $len))))
+)
+(@else
(local.set $f
(call $parse_float (call $jsstring_of_bytes (local.get $s))))
(br_if $error (f64.ne (local.get $f) (local.get $f)))
+))
(return (struct.new $float (local.get $f))))
(call $caml_failwith (global.get $float_of_string))
(return (ref.i31 (i32.const 0))))
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index 90a529d744..2d92f8e192 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -16,6 +16,41 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
+(@if wasi
+(@then
+ (import "libc" "memory" (memory 2))
+ (import "libc" "free" (func $free (param i32)))
+ (import "wasi_memory" "checked_malloc"
+ (func $checked_malloc (param i32) (result i32)))
+ (import "wasi_memory" "get_buffer" (func $get_buffer (result i32)))
+ (import "wasi_memory" "write_string_to_memory"
+ (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32)))
+ (import "wasi_memory" "blit_memory_to_string"
+ (func $blit_memory_to_string (param i32 i32) (result (ref $bytes))))
+ (import "wasi_snapshot_preview1" "fd_prestat_get"
+ (func $fd_prestat_get (param i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_prestat_dir_name"
+ (func $fd_prestat_dir_name (param i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_rename"
+ (func $path_rename (param i32 i32 i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_unlink_file"
+ (func $path_unlink_file (param i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_create_directory"
+ (func $path_create_directory (param i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_remove_directory"
+ (func $path_remove_directory (param i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_filestat_get"
+ (func $path_filestat_get (param i32 i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_open"
+ (func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_readdir"
+ (func $fd_readddir (param i32 i32 i32 i64 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_close"
+ (func $fd_close (param i32) (result i32)))
+ (import "sys" "caml_handle_sys_error"
+ (func $caml_handle_sys_error (param (ref eq) i32)))
+)
+(@else
(import "bindings" "getcwd" (func $getcwd (result anyref)))
(import "bindings" "chdir" (func $chdir (param anyref)))
(import "bindings" "mkdir" (func $mkdir (param anyref) (param i32)))
@@ -42,13 +77,296 @@
(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)))
+ (type $block (array (mut (ref eq))))
+
+(@if wasi
+(@then
+ (type $preopen
+ (struct
+ (field $prefix (ref $bytes))
+ (field $fd i32)
+ (field $next (ref null $preopen))))
+
+ (global $preopens (mut (ref null $preopen)) (ref.null $preopen))
+
+ (global $preopens_initialized (mut i32) (i32.const 0))
+
+ (func $normalize_prefix (param $prefix (ref $bytes)) (result (ref $bytes))
+ (local $i i32) (local $len i32) (local $c i32) (local $res (ref $bytes))
+ (local.set $len (array.len (local.get $prefix)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (local.set $c
+ (array.get $bytes (local.get $prefix) (local.get $i)))
+ (if (i32.eq (local.get $c) (i32.const 47)) ;; '/'
+ (then
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))
+ (if (i32.eq (local.get $c) (i32.const 46)) ;; '.'
+ (then
+ (if (i32.eq (local.get $i)
+ (i32.sub (local.get $len) (i32.const 1)))
+ (then
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))
+ (else
+ (local.set $c
+ (array.get $bytes (local.get $prefix)
+ (i32.add (local.get $i) (i32.const 1))))
+ (if (i32.eq (local.get $c) (i32.const 47)) ;; '/'
+ (then
+ (local.set $i
+ (i32.add (local.get $i) (i32.const 2)))
+ (br $loop))))))))))
+ (if (i32.eq (local.get $i) (local.get $len))
+ (then (return (@string ""))))
+ (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+ (if (i32.gt_u (local.get $i) (i32.const 0))
+ (then
+ (local.set $res
+ (array.new $bytes (i32.const 0)
+ (i32.sub (local.get $len) (local.get $i))))
+ (array.copy $bytes $bytes
+ (local.get $res) (i32.const 0)
+ (local.get $prefix) (local.get $i)
+ (i32.sub (local.get $len) (local.get $i)))
+ (return (local.get $res))))
+ (return (local.get $prefix)))
+
+ (func $get_preopens (result (ref null $preopen))
+ (local $fd i32) (local $buffer i32) (local $res i32) (local $len i32)
+ (if $done (i32.eqz (global.get $preopens_initialized))
+ (then
+ (local.set $buffer (call $get_buffer))
+ (local.set $fd (i32.const 3))
+ (loop $loop
+ (local.set $res
+ (call $fd_prestat_get (local.get $fd) (local.get $buffer)))
+ (br_if $done (i32.eq (local.get $res) (i32.const 8))) ;; EBADF
+ (block $skip
+ (br_if $skip
+ (i32.eqz
+ (i32.and (i32.eqz (local.get $res))
+ (i32.eqz (i32.load8_u (local.get $buffer))))))
+ (local.set $len (i32.load offset=4 (local.get $buffer)))
+ (local.set $res
+ (call $fd_prestat_dir_name
+ (local.get $fd) (local.get $buffer) (local.get $len)))
+ (br_if $skip (local.get $res))
+ (global.set $preopens
+ (struct.new $preopen
+ (call $normalize_prefix
+ (call $blit_memory_to_string
+ (local.get $buffer) (local.get $len)))
+ (local.get $fd)
+ (global.get $preopens))))
+ (local.set $fd (i32.add (local.get $fd) (i32.const 1)))
+ (br $loop))
+ (global.set $preopens_initialized (i32.const 1))))
+ (global.get $preopens))
+
+ (global $current_dir (mut (ref $bytes)) (@string ""))
+
+ (@string $root_dir "/")
+
+ (func $make_absolute
+ (param $path (ref $bytes)) (result (ref $bytes))
+ (local $need_slash i32) (local $i i32) (local $abs_path (ref $bytes))
+ (if (i32.eqz (array.len (local.get $path)))
+ (then ;; empty path
+ (return (global.get $current_dir))))
+ (if (i32.eq (i32.const 47) ;; '/'
+ (array.get_u $bytes (local.get $path) (i32.const 0)))
+ (then ;; absolute path
+ (return (local.get $path))))
+ (if (i32.and
+ (i32.eq (i32.const 46) ;; '.'
+ (array.get_u $bytes (local.get $path) (i32.const 0)))
+ (i32.eq (array.len (local.get $path)) (i32.const 1)))
+ (then
+ ;; "."
+ (return (global.get $current_dir))))
+ (if (i32.ge_u (array.len (local.get $path)) (i32.const 2))
+ (then
+ (if (i32.and
+ (i32.eq (i32.const 46) ;; '.'
+ (array.get_u $bytes (local.get $path) (i32.const 0)))
+ (i32.eq (i32.const 47) ;; '/'
+ (array.get_u $bytes (local.get $path) (i32.const 1))))
+ (then ;; starts with "./"
+ (local.set $i (i32.const 2))))))
+ (if (i32.eq (local.get $i) (array.len (local.get $path)))
+ (then ;; "./"
+ (return (global.get $current_dir))))
+ (local.set $need_slash
+ (if (result i32) (array.len (global.get $current_dir))
+ (then
+ (i32.ne (i32.const 47) ;; '/'
+ (array.get_u $bytes (global.get $current_dir)
+ (i32.sub (array.len (global.get $current_dir))
+ (i32.const 1)))))
+ (else
+ (i32.const 1))))
+ (local.set $abs_path
+ (array.new $bytes (i32.const 0)
+ (i32.add (array.len (global.get $current_dir))
+ (i32.add (i32.sub (local.get $need_slash) (local.get $i))
+ (array.len (local.get $path))))))
+ (array.copy $bytes $bytes
+ (local.get $abs_path) (i32.const 0)
+ (global.get $current_dir) (i32.const 0)
+ (array.len (global.get $current_dir)))
+ (array.set $bytes (local.get $abs_path)
+ (array.len (global.get $current_dir))
+ (i32.const 47)) ;; '/'
+ (array.copy $bytes $bytes
+ (local.get $abs_path)
+ (i32.add (array.len (global.get $current_dir))
+ (local.get $need_slash))
+ (local.get $path) (local.get $i)
+ (i32.sub (array.len (local.get $path)) (local.get $i)))
+ (local.get $abs_path))
+
+ (func $wasi_chdir (export "wasi_chdir") (param $name (ref eq))
+ (local $abs_path (ref $bytes)) (local $path (ref $bytes)) (local $i i32)
+ (local.set $abs_path
+ (call $make_absolute (ref.cast (ref $bytes) (local.get $name))))
+ (local.set $i (i32.sub (array.len (local.get $abs_path)) (i32.const 1)))
+ ;; remove trailing slashes
+ (loop $loop
+ (if (i32.ge_s (local.get $i) (i32.const 0))
+ (then
+ (if (i32.eq (i32.const 47) ;; '/'
+ (array.get $bytes (local.get $abs_path) (local.get $i)))
+ (then
+ (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+ (br $loop))))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (if (i32.lt_u (local.get $i) (array.len (local.get $abs_path)))
+ (then
+ (local.set $path (array.new $bytes (i32.const 0) (local.get $i)))
+ (array.copy $bytes $bytes
+ (local.get $path) (i32.const 0)
+ (local.get $abs_path) (i32.const 0)
+ (local.get $i))
+ (local.set $abs_path (local.get $path))))
+ (global.set $current_dir (local.get $abs_path)))
+
+ (func $prefix_match
+ (param $prefix (ref $bytes)) (param $path (ref $bytes)) (result i32)
+ (local $i i32) (local $len i32)
+ (local.set $len (array.len (local.get $prefix)))
+ (if (i32.lt_u (array.len (local.get $path)) (local.get $len))
+ (then (return (i32.const 0))))
+ (if (i32.gt_u (array.len (local.get $path)) (local.get $len))
+ (then
+ (if (i32.ne (array.get_u $bytes (local.get $path) (local.get $i))
+ (i32.const 47))
+ (then (return (i32.const 0))))))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (if (i32.ne (array.get_u $bytes (local.get $path) (local.get $i))
+ (array.get_u $bytes (local.get $prefix) (local.get $i)))
+ (then (return (i32.const 0))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))
+ (return (i32.const 1)))
+
+ (func $resolve_abs_path
+ (param $path (ref $bytes)) (result i32 (ref $bytes))
+ (local $fd i32) (local $len i32) (local $i i32)
+ (local $preopens (ref null $preopen)) (local $current (ref $preopen))
+ (local $prefix (ref $bytes)) (local $rel_path (ref $bytes))
+ (local.set $preopens (call $get_preopens))
+ (local.set $i (i32.const -1))
+ (block $done
+ (loop $loop
+ (local.set $current (br_on_null $done (local.get $preopens)))
+ (local.set $prefix
+ (struct.get $preopen $prefix (local.get $current)))
+ (if (i32.and
+ (i32.gt_s (array.len (local.get $prefix)) (local.get $i))
+ (call $prefix_match (local.get $prefix) (local.get $path)))
+ (then
+ (local.set $fd (struct.get $preopen $fd (local.get $current)))
+ (local.set $i (array.len (local.get $prefix)))))
+ (local.set $preopens
+ (struct.get $preopen $next (local.get $current)))
+ (br $loop)))
+ (if (i32.eq (local.get $i) (i32.const -1))
+ (then ;; not found
+ (return (tuple.make 2 (i32.const -1) (@string "")))))
+ ;; skip leading slashes
+ (local.set $len (local.get $i))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (array.len (local.get $path)))
+ (then
+ (if (i32.eq (array.get_u $bytes (local.get $path) (local.get $i))
+ (i32.const 47)) ;; 47
+ (then
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))
+ (local.set $rel_path
+ (array.new $bytes (i32.const 0)
+ (i32.sub (array.len (local.get $path)) (local.get $i))))
+ (array.copy $bytes $bytes
+ (local.get $rel_path) (i32.const 0)
+ (local.get $path) (local.get $i)
+ (i32.sub (array.len (local.get $path)) (local.get $i)))
+ (return
+ (tuple.make 2 (local.get $fd) (local.get $rel_path))))))
+ (return (tuple.make 2 (local.get $fd) (@string "."))))
+ (func (export "wasi_resolve_path")
+ (param $vpath (ref eq))
+ (result (;fd;) i32 (;address;) i32 (;length;) i32)
+ (local $res (tuple i32 (ref $bytes)))
+ (local $p i32)
+ (local.set $res
+ (call $resolve_abs_path
+ (call $make_absolute
+ (ref.cast (ref $bytes) (local.get $vpath)))))
+ (if (i32.ge_u (tuple.extract 2 0 (local.get $res)) (i32.const 0))
+ (then
+ (local.set $p
+ (call $write_string_to_memory
+ (i32.const 0) (i32.const 0)
+ (tuple.extract 2 1 (local.get $res))))))
+ (return
+ (tuple.make 3
+ (tuple.extract 2 0 (local.get $res))
+ (local.get $p)
+ (array.len (tuple.extract 2 1 (local.get $res))))))
+
+ (func $caml_sys_resolve_path (export "caml_sys_resolve_path")
+ (param $path (ref eq)) (result i32 i32 i32)
+ (local $res (tuple i32 i32 i32))
+ (local.set $res (call $wasi_resolve_path (local.get $path)))
+ (if (i32.lt_s (tuple.extract 3 0 (local.get $res)) (i32.const 0))
+ (then ;; ENOENT
+ (call $caml_handle_sys_error (local.get $path) (i32.const 44))))
+ (local.get $res))
+))
+
+(@if wasi
+(@then
+ (func (export "caml_sys_getcwd")
+ (export "unix_getcwd") (export "caml_unix_getcwd")
+ (param (ref eq)) (result (ref eq))
+ (if (array.len (global.get $current_dir))
+ (then (return (global.get $current_dir))))
+ (global.get $root_dir))
+)
+(@else
(func (export "caml_sys_getcwd")
(param (ref eq)) (result (ref eq))
(try (result (ref eq))
@@ -57,7 +375,34 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))
(ref.i31 (i32.const 0)))))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_chdir")
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $buffer i32) (local $res i32) (local $kind i32)
+ (local.set $p (call $caml_sys_resolve_path (local.get $name)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_filestat_get
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1)
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then (call $caml_handle_sys_error (local.get $name) (local.get $res))))
+ (local.set $kind (i32.load8_u offset=16 (local.get $buffer)))
+ (if (i32.ne (local.get $kind) (i32.const 3))
+ (then
+ (call $caml_handle_sys_error
+ (local.get $name) (i32.const 54)))) ;; ENOTDIR
+ (call $wasi_chdir (local.get $name))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "caml_sys_chdir")
(param $name (ref eq)) (result (ref eq))
(try
@@ -67,7 +412,26 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_mkdir")
+ (param $name (ref eq)) (param $perm (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $p (call $caml_sys_resolve_path (local.get $name)))
+ (local.set $res
+ (call $path_create_directory
+ (tuple.extract 3 0 (local.get $p))
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then (call $caml_handle_sys_error (local.get $name) (local.get $res))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "caml_sys_mkdir")
(param $name (ref eq)) (param $perm (ref eq)) (result (ref eq))
(try
@@ -78,7 +442,128 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_read_directory")
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $buffer i32) (local $res i32) (local $fd i32)
+ (local $buf i32) (local $new_buf i32)
+ (local $size i32) (local $pos i32) (local $available i32)
+ (local $left i32) (local $namelen i32)
+ (local $entry i32) (local $entry_size i32)
+ (local $cookie i64) (local $tbl (ref $block)) (local $new_tbl (ref $block))
+ (local $i i32) (local $s (ref $bytes))
+ (local.set $p (call $caml_sys_resolve_path (local.get $name)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_open
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1) ;; symlink_follow
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (i32.const 2) ;; O_DIRECTORY
+ (i64.const 0x4000) ;; allow fd_readdir
+ (i64.const 0)
+ (i32.const 0)
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error (local.get $name) (local.get $res))))
+ (local.set $fd (i32.load (local.get $buffer)))
+ (local.set $buf (call $checked_malloc (i32.const 512)))
+ (local.set $size (i32.const 512))
+ (local.set $tbl (array.new $block (ref.i31 (i32.const 0)) (i32.const 50)))
+ (local.set $i (i32.const 1))
+ (loop $loop
+ (block $refill
+ (local.set $left (i32.sub (local.get $available) (local.get $pos)))
+ (br_if $refill (i32.lt_u (local.get $left) (i32.const 24)))
+ (local.set $entry (i32.add (local.get $buf) (local.get $pos)))
+ (local.set $namelen (i32.load offset=16 (local.get $entry)))
+ (local.set $entry_size (i32.add (local.get $namelen) (i32.const 24)))
+ (br_if $refill (i32.lt_u (local.get $left) (local.get $entry_size)))
+ (local.set $pos (i32.add (local.get $pos) (local.get $entry_size)))
+ (local.set $cookie (i64.load (local.get $entry)))
+ (if (i32.eq (local.get $i) (array.len (local.get $tbl)))
+ (then
+ (local.set $new_tbl
+ (array.new $block (ref.i31 (i32.const 0))
+ (i32.shl (local.get $i) (i32.const 1))))
+ (array.copy $block $block
+ (local.get $new_tbl) (i32.const 0)
+ (local.get $tbl) (i32.const 0) (local.get $i))
+ (local.set $tbl (local.get $new_tbl))))
+ (local.set $s
+ (call $blit_memory_to_string
+ (i32.add (local.get $entry) (i32.const 24))
+ (local.get $namelen)))
+ ;; skip "." and ".."
+ (if (i32.eq (local.get $namelen) (i32.const 2))
+ (then
+ (br_if $loop
+ (i32.and
+ (i32.eq (i32.const 46)
+ (array.get_u $bytes (local.get $s) (i32.const 0)))
+ (i32.eq (i32.const 46)
+ (array.get_u $bytes (local.get $s) (i32.const 1))))))
+ (else
+ (if (i32.eq (local.get $namelen) (i32.const 2))
+ (then
+ (br_if $loop
+ (i32.eq
+ (array.get_u $bytes (local.get $s) (i32.const 0))
+ (i32.const 46)))))))
+ (array.set $block (local.get $tbl) (local.get $i) (local.get $s))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))
+ ;; refill
+ (if (i32.lt_u (local.get $size) (local.get $entry_size))
+ (then
+ ;; the entry does not fit
+ (local.set $new_buf
+ (call $checked_malloc (local.get $entry_size)))
+ (call $free (local.get $buf))
+ (local.set $buf (local.get $new_buf))
+ (local.set $size (local.get $entry_size))))
+ (block $done
+ (br_if $done
+ (i32.and
+ (i32.ne (i32.const 0) (local.get $available))
+ (i32.lt_u (local.get $available) (local.get $size))))
+ (local.set $res
+ (call $fd_readddir
+ (local.get $fd)
+ (local.get $buffer)
+ (local.get $size)
+ (local.get $cookie)
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (local.get $name) (local.get $res))))
+ (local.set $available (i32.load (local.get $buffer)))
+ (br_if $done (i32.eqz (local.get $available)))
+ (local.set $pos (i32.const 0))
+ (br $loop)))
+ ;; done
+ (call $free (local.get $buf))
+ (local.set $res (call $fd_close (local.get $fd)))
+ (if (local.get $res)
+ (then (call $caml_handle_sys_error (local.get $name) (local.get $res))))
+ (if (i32.eq (local.get $i) (array.len (local.get $tbl)))
+ (then (return (local.get $tbl))))
+ (local.set $new_tbl
+ (array.new $block (ref.i31 (i32.const 0)) (local.get $i)))
+ (array.copy $block $block
+ (local.get $new_tbl) (i32.const 0)
+ (local.get $tbl) (i32.const 0) (local.get $i))
+ (local.get $new_tbl))
+)
+(@else
(func (export "caml_sys_read_directory")
(param $name (ref eq)) (result (ref eq))
(try
@@ -91,7 +576,26 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))
(return (ref.i31 (i32.const 0))))))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_rmdir")
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $p (call $caml_sys_resolve_path (local.get $name)))
+ (local.set $res
+ (call $path_remove_directory
+ (tuple.extract 3 0 (local.get $p))
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then (call $caml_handle_sys_error (local.get $name) (local.get $res))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "caml_sys_rmdir")
(param $name (ref eq)) (result (ref eq))
(try
@@ -101,7 +605,26 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_remove")
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $p (call $caml_sys_resolve_path (local.get $name)))
+ (local.set $res
+ (call $path_unlink_file
+ (tuple.extract 3 0 (local.get $p))
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then (call $caml_handle_sys_error (local.get $name) (local.get $res))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "caml_sys_remove")
(param $name (ref eq)) (result (ref eq))
(try
@@ -111,7 +634,32 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_rename")
+ (param $o (ref eq)) (param $n (ref eq)) (result (ref eq))
+ (local $op (tuple i32 i32 i32))
+ (local $np (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $op (call $caml_sys_resolve_path (local.get $o)))
+ (local.set $np (call $caml_sys_resolve_path (local.get $n)))
+ (local.set $res
+ (call $path_rename
+ (tuple.extract 3 0 (local.get $op))
+ (tuple.extract 3 1 (local.get $op))
+ (tuple.extract 3 2 (local.get $op))
+ (tuple.extract 3 0 (local.get $np))
+ (tuple.extract 3 1 (local.get $np))
+ (tuple.extract 3 2 (local.get $np))))
+ (call $free (tuple.extract 3 1 (local.get $op)))
+ (call $free (tuple.extract 3 1 (local.get $np)))
+ (if (local.get $res)
+ (then (call $caml_handle_sys_error (local.get $o) (local.get $res))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "caml_sys_rename")
(param $o (ref eq)) (param $n (ref eq)) (result (ref eq))
(try
@@ -122,11 +670,31 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_file_exists")
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32) (local $buffer i32)
+ (local.set $p (call $caml_sys_resolve_path (local.get $name)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_filestat_get
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1)
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $buffer)))
+ (ref.i31 (i32.eqz (local.get $res))))
+)
+(@else
(func (export "caml_sys_file_exists")
(param $name (ref eq)) (result (ref eq))
(return_call $file_exists
(call $unwrap (call $caml_jsstring_of_string (local.get $name)))))
+))
(@string $no_such_file ": No such file or directory")
@@ -148,6 +716,30 @@
(func (export "caml_fs_init") (result (ref eq))
(ref.i31 (i32.const 0)))
+(@if wasi
+(@then
+ (func $caml_sys_file_mode (param $name (ref eq)) (result i32)
+ (local $p (tuple i32 i32 i32))
+ (local $res i32) (local $buffer i32)
+ (local.set $p (call $caml_sys_resolve_path (local.get $name)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_filestat_get
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1)
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then (call $caml_handle_sys_error (local.get $name) (local.get $res))))
+ (i32.load8_u offset=16 (local.get $buffer)))
+
+ (func (export "caml_sys_is_directory")
+ (param $name (ref eq)) (result (ref eq))
+ (ref.i31
+ (i32.eq (call $caml_sys_file_mode (local.get $name)) (i32.const 3))))
+)
+(@else
(func (export "caml_sys_is_directory")
(param $name (ref eq)) (result (ref eq))
(try
@@ -159,7 +751,16 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))
(return (ref.i31 (i32.const 0))))))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_is_regular_file")
+ (param $name (ref eq)) (result (ref eq))
+ (ref.i31
+ (i32.eq (call $caml_sys_file_mode (local.get $name)) (i32.const 4))))
+)
+(@else
(func (export "caml_sys_is_regular_file")
(param $name (ref eq)) (result (ref eq))
(try
@@ -175,4 +776,5 @@
(func (export "caml_mount_autoload")
(param (ref eq) (ref eq)) (result (ref eq))
(ref.i31 (i32.const 0)))
+))
)
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index a7a78c9e49..ad9fd4d628 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -304,6 +304,8 @@
(local.get $v))))))))
(local.set $num (i32.sub (local.get $num) (i32.const 1)))
(br $loop)))
+(@if (not wasi)
+(@then
(drop (block $not_jsstring (result anyref)
(local.set $str
(struct.get $js 0
@@ -315,6 +317,7 @@
(local.set $h
(call $jsstring_hash (local.get $h) (local.get $str)))
(ref.i31 (i32.const 0))))
+))
;; closures and continuations and other js values are ignored
(br $loop)))))
;; clear the queue to avoid a memory leak
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 45566431b9..422c57c373 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -25,6 +25,31 @@
(func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
(import "jslib" "caml_list_of_js_array"
(func $caml_list_of_js_array (param (ref eq)) (result (ref eq))))
+(@if wasi
+(@then
+ (import "wasi_snapshot_preview1" "fd_close"
+ (func $fd_close (param i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_write"
+ (func $fd_write (param i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_read"
+ (func $fd_read (param i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_seek"
+ (func $fd_seek (param i32 i64 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_open"
+ (func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32) (result i32)))
+ (import "libc" "memory" (memory 2))
+ (import "libc" "free" (func $free (param i32)))
+ (import "wasi_memory" "get_buffer" (func $get_buffer (result i32)))
+ (import "wasi_memory" "blit_memory_to_substring"
+ (func $blit_memory_to_substring (param i32 (ref $bytes) i32 i32)))
+ (import "wasi_memory" "blit_substring_to_memory"
+ (func $blit_substring_to_memory (param i32 (ref $bytes) i32 i32)))
+ (import "sys" "caml_handle_sys_error"
+ (func $caml_handle_sys_error (param (ref eq) i32)))
+ (import "fs" "caml_sys_resolve_path"
+ (func $caml_sys_resolve_path (param (ref eq)) (result i32 i32 i32)))
+)
+(@else
(import "bindings" "open"
(func $open (param anyref) (param i32) (param i32) (result i32)))
(import "bindings" "close" (func $close (param i32)))
@@ -70,10 +95,11 @@
(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 "fail" "javascript_exception"
- (tag $javascript_exception (param externref)))
(import "sys" "caml_handle_sys_error"
(func $caml_handle_sys_error (param externref)))
+ (import "fail" "javascript_exception"
+ (tag $javascript_exception (param externref)))
+))
(import "custom" "custom_compare_id"
(func $custom_compare_id
(param (ref eq)) (param (ref eq)) (param i32) (result i32)))
@@ -87,6 +113,126 @@
(import "bigarray" "caml_ba_get_data"
(func $caml_ba_get_data (param (ref eq)) (result (ref extern))))
+(@if wasi
+(@then
+ (func $ta_new (param $sz i32) (result (ref extern))
+ (extern.convert_any (array.new $bytes (i32.const 0) (local.get $sz))))
+
+ (func $ta_copy
+ (param $buf (ref extern))
+ (param $dst i32) (param $src i32) (param $end i32)
+ (local $b (ref $bytes))
+ (local.set $b
+ (ref.cast (ref $bytes) (any.convert_extern (local.get $buf))))
+ (array.copy $bytes $bytes
+ (local.get $b) (local.get $dst)
+ (local.get $b) (local.get $src)
+ (i32.sub (local.get $end) (local.get $src))))
+
+ (func $ta_set_ui8 (param $buf (ref extern)) (param $i i32) (param $c i32)
+ (array.set $bytes
+ (ref.cast (ref $bytes) (any.convert_extern (local.get $buf)))
+ (local.get $i) (local.get $c)))
+
+ (func $ta_get_ui8 (param $buf (ref extern)) (param $i i32) (result i32)
+ (array.get_u $bytes
+ (ref.cast (ref $bytes) (any.convert_extern (local.get $buf)))
+ (local.get $i)))
+
+ (func $ta_blit_from_bytes
+ (param $s (ref $bytes)) (param $i i32) (param $buf (ref extern))
+ (param $j i32) (param $l i32)
+ (array.copy $bytes $bytes
+ (ref.cast (ref $bytes) (any.convert_extern (local.get $buf)))
+ (local.get $j)
+ (local.get $s) (local.get $i)
+ (local.get $l)))
+
+ (func $ta_blit_to_bytes
+ (param $buf (ref extern)) (param $i i32) (param $s (ref $bytes))
+ (param $j i32) (param $l i32)
+ (array.copy $bytes $bytes
+ (local.get $s) (local.get $j)
+ (ref.cast (ref $bytes) (any.convert_extern (local.get $buf)))
+ (local.get $i)
+ (local.get $l)))
+
+ (type $data
+ (struct
+ (field $array (ref array))
+ (field $offset i32)
+ (field $len i32)))
+
+ (func $ta_blit_from_buffer
+ (param $buf (ref extern)) (param $i i32)
+ (param $ta (ref extern)) (param $j i32)
+ (param $len i32)
+ (local $data (ref $data))
+ (local.set $data
+ (ref.cast (ref $data) (any.convert_extern (local.get $ta))))
+ (call $ta_blit_to_bytes
+ (local.get $buf)
+ (local.get $i)
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $data)))
+ (i32.add (struct.get $data $offset (local.get $data)) (local.get $j))
+ (local.get $len)))
+
+ (func $ta_blit_to_buffer
+ (param $ta (ref extern)) (param $i i32)
+ (param $buf (ref extern)) (param $j i32)
+ (param $len i32)
+ (local $data (ref $data))
+ (local.set $data
+ (ref.cast (ref $data) (any.convert_extern (local.get $ta))))
+ (call $ta_blit_from_bytes
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $data)))
+ (i32.add (struct.get $data $offset (local.get $data)) (local.get $i))
+ (local.get $buf)
+ (local.get $j)
+ (local.get $len)))
+
+ (global $caml_stdout
+ (mut (ref eq)) (ref.i31 (i32.const 0)))
+
+ (func $register_channel (param $ch (ref eq))
+ (if (i32.eq
+ (struct.get $channel $fd (ref.cast (ref $channel) (local.get $ch)))
+ (i32.const 1))
+ (then
+ (global.set $caml_stdout (local.get $ch)))))
+
+ (func $unregister_channel (param (ref eq)))
+ (func $map_new (result (ref extern))
+ (extern.convert_any (ref.i31 (i32.const 0))))
+ (func $map_get (param (ref extern)) (param i32) (result (ref $fd_offset))
+ (struct.new $fd_offset (i64.const 0) (i32.const 0)))
+ (func $map_set (param (ref extern)) (param i32) (param (ref $fd_offset)))
+ (func $map_delete (param (ref extern)) (param i32))
+
+ (func $file_size (param $fd i32) (result i64)
+ (local $cur i64) (local $end i64) (local $buffer i32) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (block $error
+ (local.set $res
+ (call $fd_seek
+ (local.get $fd) (i64.const 0) (i32.const 1) (local.get $buffer)))
+ (br_if $error (local.get $res))
+ (local.set $cur (i64.load (local.get $buffer)))
+ (local.set $res
+ (call $fd_seek
+ (local.get $fd) (i64.const 0) (i32.const 2) (local.get $buffer)))
+ (br_if $error (local.get $res))
+ (local.set $end (i64.load (local.get $buffer)))
+ (local.set $res
+ (call $fd_seek
+ (local.get $fd) (local.get $cur) (i32.const 0)
+ (local.get $buffer)))
+ (br_if $error (local.get $res))
+ (return (local.get $end)))
+ (call $caml_handle_sys_error (ref.i31 (i32.const 0)) (local.get $res))
+ (i64.const 0))
+)
+(@else
(import "bindings" "map_new" (func $map_new (result (ref extern))))
(import "bindings" "map_get"
(func $map_get
@@ -115,6 +261,7 @@
(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)))
@@ -212,7 +359,24 @@
(global $IO_BUFFER_SIZE (export "IO_BUFFER_SIZE") i32 (i32.const 65536))
- (type $open_flags (array i8))
+ (type $open_flags (array i16))
+
+(@if wasi
+(@then
+ ;; 1 O_RDONLY
+ ;; 2 O_WRONLY
+ ;; 0x10 O_CREAT
+ ;; 0x40 O_EXCL
+ ;; 0x80 O_TRUNC
+ ;; 0x100 O_APPEND
+ ;; 0x400 O_NONBLOCK
+ (global $sys_open_flags (ref $open_flags)
+ (array.new_fixed $open_flags 9
+ (i32.const 1) (i32.const 2) (i32.const 0x102) (i32.const 0x10)
+ (i32.const 0x80) (i32.const 0x40) (i32.const 0) (i32.const 0)
+ (i32.const 0x400)))
+)
+(@else
;; 1 O_RDONLY
;; 2 O_WRONLY
;; 4 O_RDWR
@@ -225,6 +389,7 @@
(array.new_fixed $open_flags 9
(i32.const 1) (i32.const 2) (i32.const 10) (i32.const 16) (i32.const 32)
(i32.const 64) (i32.const 0) (i32.const 0) (i32.const 128)))
+))
(func $convert_flag_list (export "convert_flag_list")
(param $tbl (ref $open_flags)) (param $vflags (ref eq)) (result i32)
@@ -246,6 +411,41 @@
(br $loop))))
(local.get $flags))
+(@if wasi
+(@then
+ (func (export "caml_sys_open")
+ (param $vpath (ref eq)) (param $vflags (ref eq)) (param $perm (ref eq))
+ (result (ref eq))
+ (local $fd i32) (local $flags i32) (local $offset i64)
+ (local $path (tuple i32 i32 i32))
+ (local $res i32) (local $buffer i32)
+ (local.set $path (call $caml_sys_resolve_path (local.get $vpath)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $flags
+ (call $convert_flag_list
+ (global.get $sys_open_flags) (local.get $vflags)))
+ (local.set $res
+ (call $path_open
+ (tuple.extract 3 0 (local.get $path))
+ (i32.const 1) ;; symlink_follow
+ (tuple.extract 3 1 (local.get $path))
+ (tuple.extract 3 2 (local.get $path))
+ (i32.and (i32.shr_u (local.get $flags) (i32.const 4))
+ (i32.const 0xF))
+ (select (i64.const 0x860007c) (i64.const 0x820003e)
+ (i32.and (local.get $flags) (i32.const 2)))
+ (i64.const 0)
+ (i32.shr_u (local.get $flags) (i32.const 8))
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $path)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error (local.get $vpath) (local.get $res))))
+ (local.set $fd (i32.load (local.get $buffer)))
+ (call $initialize_fd_offset (local.get $fd) (local.get $offset))
+ (ref.i31 (local.get $fd)))
+)
+(@else
(func (export "caml_sys_open")
(param $path (ref eq)) (param $vflags (ref eq)) (param $perm (ref eq))
(result (ref eq))
@@ -262,14 +462,30 @@
(local.get $flags)
(i31.get_u (ref.cast (ref i31) (local.get $perm)))))
(if (i32.and (local.get $flags) (i32.const 4)) ;; O_APPEND
- (then (local.set $offset (call $file_size (local.get $fd))))))
+ (then (local.set $offset (call $file_size (local.get $fd)))))
+ )
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(call $initialize_fd_offset (local.get $fd) (local.get $offset))
(ref.i31 (local.get $fd)))
+))
+(@if wasi
+(@then
(func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
- (local $fd i32)
+ (local $fd i32) (local $res i32)
+ (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get 0))))
+ (call $release_fd_offset (local.get $fd))
+ (local.set $res (call $fd_close (local.get $fd)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
+ (func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
+ (local $fd i32) (local $res i32)
(local.set $fd (i31.get_u (ref.cast (ref i31) (local.get 0))))
(call $release_fd_offset (local.get $fd))
(try
@@ -278,14 +494,40 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(ref.i31 (i32.const 0)))
+))
(func (export "caml_ml_set_channel_name")
(param (ref eq)) (param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 0)))
+(@if wasi
+(@then
+ (func $push_channel (param $l (ref eq)) (param $ch (ref eq)) (result (ref eq))
+ (local $c (ref $channel))
+ (block $continue
+ (br_if $continue (i32.eqz (ref.test (ref $channel) (local.get $ch))))
+ (local.set $c (ref.cast (ref $channel) (local.get $ch)))
+ (br_if $continue
+ (i32.eq (struct.get $channel $fd (local.get $c)) (i32.const -1)))
+ (local.set $l
+ (array.new_fixed $block 3
+ (ref.i31 (i32.const 0)) (local.get $ch) (local.get $l))))
+ (local.get $l))
+))
+
+(@if wasi
+(@then
+ (func (export "caml_ml_out_channels_list")
+ (param (ref eq)) (result (ref eq))
+ (call $push_channel
+ (call $push_channel (ref.i31 (i32.const 0)) (global.get $caml_stdout))
+ (global.get $caml_stderr)))
+)
+(@else
(func (export "caml_ml_out_channels_list")
(param (ref eq)) (result (ref eq))
(return_call $caml_list_of_js_array (call $wrap (call $channel_list))))
+))
(func (export "caml_ml_open_descriptor_in")
(param $fd (ref eq)) (result (ref eq))
@@ -341,7 +583,7 @@
(func (export "caml_ml_close_channel")
(param (ref eq)) (result (ref eq))
(local $ch (ref $channel))
- (local $fd i32)
+ (local $fd i32) (local $res i32)
(local.set $ch (ref.cast (ref $channel) (local.get 0)))
;; output channels: any output will trigger a flush since the
;; buffer is non-empty (curr > 0) and full (curr = size)
@@ -356,14 +598,56 @@
(struct.set $channel $fd (local.get $ch) (i32.const -1))
(call $unregister_channel (local.get $ch))
(call $release_fd_offset (local.get $fd))
+(@if wasi
+(@then
+ (local.set $res (call $fd_close (local.get $fd)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+)
+(@else
(try
(do
(call $close (local.get $fd)))
(catch $javascript_exception
;; ignore exception
- (drop (pop externref))))))
+ (drop (pop externref))))
+))
+ ))
(ref.i31 (i32.const 0)))
+(@if wasi
+(@then
+ (func $read
+ (param $fd i32) (param $buf (ref extern)) (param $pos i32) (param $n i32)
+ (result i32)
+ (local $buffer i32)
+ (local $iovs i32) (local $iovs_len i32) (local $nread i32)
+ (local $s (ref $bytes)) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $nread (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (i32.store (local.get $iovs) (local.get $buffer))
+ (i32.store offset=4 (local.get $iovs) (local.get $n))
+ (local.set $iovs_len (i32.const 1))
+ (local.set $res
+ (call $fd_read
+ (local.get $fd) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nread)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (local.set $n (i32.load (local.get $nread)))
+ (local.set $s
+ (ref.cast (ref $bytes) (any.convert_extern (local.get $buf))))
+ (call $blit_memory_to_substring
+ (local.get $buffer) (local.get $s) (local.get $pos) (local.get $n))
+ (local.get $n))
+))
+
(func $caml_do_read
(param $ch (ref $channel)) (param $pos i32) (param $len i32) (result i32)
(local $fd i32)
@@ -371,6 +655,16 @@
(local $offset i64)
(local $n i32)
(local.set $fd (struct.get $channel $fd (local.get $ch)))
+(@if wasi
+(@then
+ (local.set $n
+ (call $read
+ (local.get $fd)
+ (struct.get $channel $buffer (local.get $ch))
+ (local.get $pos)
+ (local.get $len)))
+)
+(@else
(local.set $fd_offset (call $get_fd_offset (local.get $fd)))
(local.set $offset (struct.get $fd_offset $offset (local.get $fd_offset)))
(try
@@ -397,6 +691,7 @@
(struct.set $fd_offset $offset
(local.get $fd_offset)
(i64.add (local.get $offset) (i64.extend_i32_u (local.get $n))))
+))
(local.get $n))
(func $caml_refill (param $ch (ref $channel)) (result i32)
@@ -618,6 +913,26 @@
(i64.add (call $caml_ml_get_channel_offset (local.get $ch))
(i64.extend_i32_s (struct.get $channel $curr (local.get $ch))))))
+(@if wasi
+(@then
+ (func $caml_seek_in
+ (param $ch (ref $channel)) (param $dest i64) (result (ref eq))
+ (local $fd i32) (local $buffer i32) (local $res i32)
+ (local.set $fd (struct.get $channel $fd (local.get $ch)))
+ (local.set $buffer (call $get_buffer))
+ ;; ZZZ store current offset in channel do avoid some syscalls?
+ (local.set $res
+ (call $fd_seek
+ (local.get $fd) (local.get $dest) (i32.const 0) (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (struct.set $channel $curr (local.get $ch) (i32.const 0))
+ (struct.set $channel $max (local.get $ch) (i32.const 0))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func $caml_seek_in
(param $ch (ref $channel)) (param $dest i64) (result (ref eq))
(local $fd i32) (local $offset i64)
@@ -650,6 +965,7 @@
(struct.set $channel $curr (local.get $ch) (i32.const 0))
(struct.set $channel $max (local.get $ch) (i32.const 0))))
(ref.i31 (i32.const 0)))
+))
(func (export "caml_ml_seek_in")
(param $ch (ref eq)) (param $dest (ref eq)) (result (ref eq))
@@ -666,8 +982,26 @@
(param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
(local $ch (ref $channel))
(local $fd_offset (ref $fd_offset)) (local $offset i64)
+ (local $buffer i32) (local $res i32)
(local.set $ch (ref.cast (ref $channel) (local.get $vch)))
(call $caml_flush (local.get $ch))
+(@if wasi
+(@then
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $fd_seek
+ (struct.get $channel $fd (local.get $ch))
+ (i64.extend_i32_s
+ (i31.get_s (ref.cast (ref i31) (local.get $voffset))))
+ (i32.const 0)
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+)
+(@else
+ ;; ZZZ Check for error
(local.set $fd_offset
(call $get_fd_offset (struct.get $channel $fd (local.get $ch))))
(local.set $offset
@@ -677,14 +1011,32 @@
(then (call $caml_raise_sys_error (@string "Invalid argument"))))
(struct.set $fd_offset $offset (local.get $fd_offset) (local.get $offset))
(struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1))
+))
(ref.i31 (i32.const 0)))
(func (export "caml_ml_seek_out_64")
(param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
(local $ch (ref $channel))
(local $fd_offset (ref $fd_offset)) (local $offset i64)
+ (local $buffer i32) (local $res i32)
(local.set $ch (ref.cast (ref $channel) (local.get $vch)))
(call $caml_flush (local.get $ch))
+(@if wasi
+(@then
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $fd_seek
+ (struct.get $channel $fd (local.get $ch))
+ (call $Int64_val (local.get $voffset))
+ (i32.const 0)
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+)
+(@else
+ ;; ZZZ Check for error
(local.set $fd_offset
(call $get_fd_offset (struct.get $channel $fd (local.get $ch))))
(local.set $offset (call $Int64_val (local.get $voffset)))
@@ -692,6 +1044,7 @@
(then (call $caml_raise_sys_error (@string "Invalid argument"))))
(struct.set $fd_offset $offset (local.get $fd_offset) (local.get $offset))
(struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1))
+))
(ref.i31 (i32.const 0)))
(func (export "caml_ml_input_scan_line")
@@ -768,6 +1121,36 @@
(then (call $caml_flush (local.get $ch))))
(ref.i31 (i32.const 0)))
+(@if wasi
+(@then
+ (func $write
+ (param $fd i32) (param $buf (ref extern)) (param $pos i32) (param $n i32)
+ (result i32)
+ (local $buffer i32)
+ (local $iovs i32) (local $iovs_len i32) (local $nwritten i32)
+ (local $s (ref $bytes)) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $nwritten (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (i32.store (local.get $iovs) (local.get $buffer))
+ (i32.store offset=4 (local.get $iovs) (local.get $n))
+ (local.set $iovs_len (i32.const 1))
+ (local.set $s
+ (ref.cast (ref $bytes) (any.convert_extern (local.get $buf))))
+ (call $blit_substring_to_memory
+ (local.get $buffer) (local.get $s) (local.get $pos) (local.get $n))
+ (local.set $res
+ (call $fd_write
+ (local.get $fd) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nwritten)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (i32.load (local.get $nwritten)))
+))
+
(func $caml_flush_partial (param $ch (ref $channel)) (result i32)
(local $towrite i32) (local $written i32) (local $fd i32)
(local $fd_offset (ref $fd_offset))
@@ -777,6 +1160,16 @@
(then
(local.set $buf (struct.get $channel $buffer (local.get $ch)))
(local.set $fd (struct.get $channel $fd (local.get $ch)))
+(@if wasi
+(@then
+ (local.set $written
+ (call $write
+ (local.get $fd)
+ (local.get $buf)
+ (i32.const 0)
+ (local.get $towrite)))
+)
+(@else
(local.set $fd_offset (call $get_fd_offset (local.get $fd)))
(local.set $offset
(struct.get $fd_offset $offset (local.get $fd_offset)))
@@ -806,6 +1199,7 @@
(i64.add
(local.get $offset)
(i64.extend_i32_u (local.get $written))))
+))
(if (i32.gt_u (local.get $towrite) (local.get $written))
(then
(call $ta_copy (local.get $buf)
@@ -976,12 +1370,31 @@
(struct.set $channel $fd
(ref.cast (ref $channel) (local.get 0)) (local.get 1)))
+(@if wasi
+(@then
+ (func $caml_ml_get_channel_offset (export "caml_ml_get_channel_offset")
+ (param $ch (ref eq)) (result i64)
+ (local $fd i32) (local $buffer i32) (local $res i32)
+ (local.set $fd
+ (struct.get $channel $fd (ref.cast (ref $channel) (local.get $ch))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $fd_seek
+ (local.get $fd) (i64.const 0) (i32.const 1) (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (i64.load (local.get $buffer)))
+)
+(@else
(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
(ref.cast (ref $channel) (local.get $ch))))))
+))
(func (export "caml_ml_output_bigarray")
(param $ch (ref eq)) (param $a (ref eq)) (param $vpos (ref eq))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 84b8690151..906768ebfb 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -16,6 +16,8 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
+(@if (not wasi)
+(@then
(import "bindings" "identity" (func $to_float (param anyref) (result f64)))
(import "bindings" "identity" (func $from_float (param f64) (result anyref)))
(import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
@@ -686,6 +688,7 @@
(return
(array.get $block (local.get $exn) (i32.const 2)))))))
(call $wrap (ref.null any)))
+))
(func (export "caml_jsoo_flags_use_js_string")
(param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index 5f3c4c14e0..ec69833df0 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -16,6 +16,8 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
+(@if (not wasi)
+(@then
(import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
(import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
(import "jslib" "caml_js_global"
@@ -56,4 +58,5 @@
(call $caml_js_global (ref.i31 (i32.const 0)))
(global.get $XMLHttpRequest))
(array.new_fixed $block 1 (ref.i31 (i32.const 0)))))
+))
)
diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
index de0780d990..c769ea514a 100644
--- a/runtime/wasm/jsstring.wat
+++ b/runtime/wasm/jsstring.wat
@@ -16,6 +16,8 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
+(@if (not wasi)
+(@then
(import "wasm:js-string" "compare"
(func $compare_strings (param externref externref) (result i32)))
(import "wasm:js-string" "test"
@@ -257,4 +259,5 @@
(local.set $s (array.new $bytes (i32.const 0) (local.get $len)))
(call $read_from_buffer (local.get $s) (i32.const 0) (local.get $len))
(global.set $stack (struct.new $stack (local.get $s) (global.get $stack))))
+))
)
diff --git a/runtime/wasm/libc.c b/runtime/wasm/libc.c
new file mode 100644
index 0000000000..3b0c44bd04
--- /dev/null
+++ b/runtime/wasm/libc.c
@@ -0,0 +1,175 @@
+/*
+Primitives implemented by the WASI libc. Use 'dune build @recompile-libc'
+to update libc.wasm.
+
+clang -O2 --target=wasm32-wasi --sysroot=/path/to/wasi-libc/sysroot -nodefaultlibs -lc libc.c -o libc.wasm
+*/
+
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <time.h>
+#include <string.h>
+
+__attribute__((export_name("cos")))
+double libc_cos (double x) {
+ return cos(x);
+}
+
+__attribute__((export_name("sin")))
+double libc_sin (double x) {
+ return sin(x);
+}
+
+__attribute__((export_name("tan")))
+double libc_tan (double x) {
+ return tan(x);
+}
+
+__attribute__((export_name("acos")))
+double libc_acos (double x) {
+ return acos(x);
+}
+
+__attribute__((export_name("asin")))
+double libc_asin (double x) {
+ return asin(x);
+}
+
+__attribute__((export_name("atan")))
+double libc_atan (double x) {
+ return atan(x);
+}
+
+__attribute__((export_name("cosh")))
+double libc_cosh (double x) {
+ return cosh(x);
+}
+
+__attribute__((export_name("sinh")))
+double libc_sinh (double x) {
+ return sinh(x);
+}
+
+__attribute__((export_name("tanh")))
+double libc_tanh (double x) {
+ return tanh(x);
+}
+
+__attribute__((export_name("acosh")))
+double libc_acosh (double x) {
+ return acosh(x);
+}
+
+__attribute__((export_name("asinh")))
+double libc_asinh (double x) {
+ return asinh(x);
+}
+
+__attribute__((export_name("atanh")))
+double libc_atanh (double x) {
+ return atanh(x);
+}
+
+__attribute__((export_name("cbrt")))
+double libc_cbrt (double x) {
+ return cbrt(x);
+}
+
+__attribute__((export_name("exp")))
+double libc_exp (double x) {
+ return exp(x);
+}
+
+__attribute__((export_name("expm1")))
+double libc_expm1 (double x) {
+ return expm1(x);
+}
+
+__attribute__((export_name("log")))
+double libc_log (double x) {
+ return log(x);
+}
+
+__attribute__((export_name("log1p")))
+double libc_log1p (double x) {
+ return log1p(x);
+}
+
+__attribute__((export_name("log2")))
+double libc_log2 (double x) {
+ return log2(x);
+}
+
+__attribute__((export_name("log10")))
+double libc_log10 (double x) {
+ return log10(x);
+}
+
+__attribute__((export_name("atan2")))
+double libc_atan2 (double x, double y) {
+ return atan2(x, y);
+}
+
+__attribute__((export_name("hypot")))
+double libc_hypot (double x, double y) {
+ return hypot(x, y);
+}
+
+__attribute__((export_name("pow")))
+double libc_pow (double x, double y) {
+ return pow(x, y);
+}
+
+__attribute__((export_name("fmod")))
+double libc_fmod (double x, double y) {
+ return fmod(x, y);
+}
+
+__attribute__((export_name("strtod")))
+double libc_strtod (const char * buf, char ** end) {
+ return strtod(buf, end);
+}
+
+__attribute__((export_name("format_float")))
+int format_float (char * buf, size_t len, const char * fmt, double f) {
+ return snprintf(buf, len, fmt, f);
+}
+
+__attribute__((export_name("malloc")))
+void * libc_malloc (size_t len) {
+ return malloc(len);
+}
+
+__attribute__((export_name("free")))
+void libc_free (void * ptr) {
+ return free(ptr);
+}
+
+__attribute__((export_name("strlen")))
+size_t libc_strlen (const char * s) {
+ return strlen(s);
+}
+
+
+__attribute__((export_name("gmtime")))
+struct tm * libc_gmtime (const time_t * timep) {
+ return gmtime(timep);
+}
+
+__attribute__((export_name("localtime")))
+struct tm * libc_localtime (const time_t * timep) {
+ return localtime(timep);
+}
+
+__attribute__((export_name("mktime")))
+time_t libc_mktime(struct tm *tm) {
+ return mktime(tm);
+}
+
+__attribute__((import_module("OCaml"), import_name("_initialize")))
+void start(void);
+
+int main () {
+ start();
+}
diff --git a/runtime/wasm/libc.wasm b/runtime/wasm/libc.wasm
new file mode 100644
index 0000000000000000000000000000000000000000..5e3f34061dd970da900036fecb03ad0ee8e5a69f
GIT binary patch
literal 63480
zcmeF4d4OD1o$t@Rx2mhEt2^D<mu9(D1_*>eRCa;x+jJ7b4zfAUJkul%Np~lmUJ`<a
zbORA_8#0Or5v96=1RZz;(E(?`3Y&l+1Vuzei~=gpE$%2v-sgMHz17tr47kj^`Qvpb
zUH6=Omf!hp=XZYRcTSo1{^g!A##=RUk+;@cyC@hO9P|bkdHUn8bvf$>y><45S!9e}
zt>e`og;Rs;Z0Qu0Y=uf{t!=|B@~KNh<gZ<nRw>u6{(9@YLH|=;I(_PK?aRCK?^?EE
z*}$^)?q%=pFf~&yZ0}$8uKpG6EBlxB47_V)U&rcY9T&bid;XGlE$;5=?=b#rl*mw`
zzoVne<X)qInz*oU*+7S>eT@>eeeElj^elhZ1sww>9~^#IO&$2LKSAXosQ1SOzLI{1
zT))B3WclzK)9Gy5_fq30q|)9>#+D8|<JV-tS+wQ4bUyQ5zfiNhV|h>CMZT$dSN}kJ
z-+)O6i+lRbgrI-f3bSu8(7wXVNwq60lL8AXOg`1F%=#30OU=X-c}vZHDe{(@gVHLw
z)MV2ty42LARd%UqOf5c-rpE^zYgU>`Y5p#MvzZcf_grB1PV@K8D@`HA=UYtCCg+;a
z)_jX;NH4u;WzT@wGg#Skq1h*O{_>tBW?D`EK;Hll``4Y{)3>~R;9ci;_p}d~nwsV9
z-Q7Kl&6`r^_jPob87kM^vBJ!%xnTLgvgIA7DaY&fZu`7f&GIh$Ff&){naInh<{ozV
z5q17mUhT`@^$#oiUN9JyKJLx(O{&G@^%!}F`Q}X~YV0bSnI<$*U1yYPOclJSbRGZS
zch{%i9hzBwUFbzScLu#pl%`N)=S<UR{FdmdPpGk?nO9HtEPs;zOk0p@p$xxDh2uRl
zBd@1a(bGq^=+9T_&<p*pn<JYyb9{<I{{`*cboJj6zWkQJOAk6^r9oCY42}$hyzPEh
zF-1lyOdsagMT3P5kD#`zSOXHgu;x_oc7;bKWukxfIzz9iXb$t&lLan8)eiHgyxt8S
z=AXs~M43zJRJ7jfJj_4SK3=KEBm5Q`Hpi!0qU)f~F_5Fq1G|wq%EbLY<5O>&-`Q#o
z57gvCqmNrFk9v701@*awPXYe453s8IwBK2*;d8s!SyT&KNM{@0Ot;X@R%s*`_^0u)
zjnAVsvcvq)!nuK3z<&e@K4!U(nUrK~C-Kq9Yr3fc7c^P`KbBQev;4VY71uH?ssn1z
z@@E!6lK>5)K}I?V^1{>{(-?)lO%~Is$l)eWrR_ef8Ky0VhMD|>=!dmd5v~o*-9^7O
zykawqymM!!w-`i2LtA$Sr>0ukO#IU}ZBE;nFBftxq2FrW(G>cd!?;ve-@JNnMx`LY
zo8e8M-d{@z+IuB9nRZ<DKQxnf$<WYq!9vx^{Ntpz?tA0E9IZN`8DaF5-?rTE|6Kq5
zWBlfkwktm8t=j&Jh0Udrwzplm^b4~ty`jwGS#4L0JL{f@m3wi|Pl5?gJ!x~#($53r
zCQY?n`jLZfd*II7Y3Lo^hnu=<eyDN}ec&C}y>NhO;qk;dAJ}8Rqk^qGy0PwPE^Qha
zW)u~mOLcx;<9>VfK+I_I_-T9dNYPwxM_~u#hV{3PByQ}l97%%ZyGo^DnAT`870@+G
zH);#KgIIt6A444qk0Su$-Q7CG&&tcnf*rDWj9^oVKXxqne7@iFVE(&X4-x-1^cGRa
z890t1xPk2`+oDv~xJsq#OO3gPJhF97))phLQc@)<Y)~#;Z~JPjrMPLVZTrQMe|)9&
zpdU7u@=pbUw=T8TAN1GqOJ8>vy;cd&^^cc+)_e}VdlqaUf2ln94;4Auv9k)S_WINe
zb(m1Vm`#GKb#Dej#jj)*Y7{n0DA@M&tuNA6y%$4kjJVQuOV7XGY0lN;Ay|{~G?$9L
zAd_hS;7j|UyP`>}K~ERm`boF2yOK$ra%niML2k=KsS^?NO_knU?#9%~O$GFq9c{y9
zHnX`m`qVuecLtrew1$_jFORlVFn8pOYI(cGn<YR6I)raiF%Sac3UJ^^k(nb5M#$$6
zuXuU=m)C5|ZM+Zpy>-n$@A*LQqZ0YlA3uKWwby=2a&DWTT-zDPes97r@1@+c!6R2M
zng5{5z2l?Bt7b0znjSxDRl^HBmZ;^otv>pqLw|AP|2bwPOqEJudbm`|=buOg>9s!A
zp(t9Dkns1-7u(_Py#8MA+}&|jJb+S!3M+-)uv9?8M%&9H#Z-xL+0l#?eLFafvhAz$
zo>(>Uj4zZ0&3m`q`uj^SxuY2zwe4KG<+z_*`^EA|+gF}CVAlHHyP8W5<c?!nZ-6pX
zFl}?6ZQC?+p@zG8-UZTm<+xDYcRvPd9=0t#@@FyS<Fs_49sM_4ONdoMeZT`U4~%FE
z78XjS2I=ma*11<~E@q=0JH4*x`k{4F;;}%DGO;o3=yA%5LHT)Ur#U@lT3fSM)fe#I
zyrXxXUcl`ls~FwH&CNY-#K}1IOTop3n*3;cziz&`m}x!aeVgwP8y(@qZzRmL&XKU2
z-Y7Kyh*#{{IXgfh1YtHBvd_$+nFOXamt9=ei#aMZ%+nR_3H~Y-HE4dJn<fmH?V*|%
zR)Ncrw(;ICXWkAP!Hj9!Fz+WZ9^X0lbTBDAQlZVW7!eNrwz(HP_|bEIeGvR)pl-@y
z5|(--6$C6vymjCdrb<`Ov#H8FOCQM$nJ~`EBjC!-Ox$)Ze$837g%ZGKXIWdgrBmAD
zSDIlfgJW#*@87Q1lZO7fc@>R1cK*4x!ikza9mM+kw*wkC_Sa3D1=Py*1rMU7qT7FX
zmotVE5`oMB^1CT$bbcMi>WRttVsrJ(<%d366~vXOmz0;)!wWm5`KUs`Ee#JRM#qcH
zGDWkIGHL9Nrh-9W^7&1kj5e4lG}i)Li#RH%%zS=yZ5Ep?^s48of+sWBkA~bUU`WIm
z5QXT3-<SukXJ&1zO=`T5S;&Oq$_Tnjz0&ogk5tGN=)l`Z$v~jyYbe_|F8^Er<NIQK
z3ueu$7{8PfuoOOzIjw?Pb0g|!&@%NeEK_6FN(SKQQ_(e=^BB8~@0~jz*(ux7K7QOi
z(pqJF<x&M^%{2uR*%`Akj;i-E`FL+prG`H|l&Ur%UaBhk5*pXopSY4Qs>eBHR2%IC
zz$m36@@g({zikJ1cOKaG`4N=M#y>xM#++wwDKjlC-#BpVueRK-$KEM#dgaT#cj@u|
zpIjp)&LfQICoQ0H#(%r`+)=k|0EnN|ubz40dp^@l>C=zdRyx1_Ha)HgPkP|1^X|~&
z&dbb4G(+%MpJ@M)f>(uFL5Z$H`wutdqhO%OispGEJ(=WFc$>=^Ms=gR#gVA<gd<<}
z{j}JTA-1cv_E^n(Od?1C${X9G2={3{(G_Mk7t?)qB4`{(0YBPnb>#Q5q=Jt#t<6_#
z?kfa-3%a{%F_NN|>iGP!dhol(`Nj(pLCdu?R35k5CN<-+hVet&(=Lp~^2NfEnQ!?<
zU}YAdC<8{1h-m0E;&g6ifh{}~c7~}_HLhLSVvelLiAD?wlTy~#(nbv6ZMqgQC>Q~5
zLHD}G1;+DJyxcenbqieT7DB^!m7qg)GVU?ARp_)ZmMn};9lSeU!NtnJO)!2%9R$&z
ztsxvl-$Rlu6G>xv)gq4}u&E>kkyw>G&<ev&8RZ*uF<)buRb<?^GJdHaVE9@^w9B04
zR)v{Zw1L|Wedo^R6H|lHM}PU}C;fCqEKg(VA3GxktR+?I5kHTWnNH^Lp`pRcH2xJ~
zDmF5$Y#|wDQ!HU4DCD+p{_OcD%@!F&-#YzAUwWkN$7M~^ytwzNg(ocf<sWzv&fM{l
z?XzCtMcYSy*xvBN;1%X_<kZ<9YcI21X4jUHTj9zZ5i-1CJ(f@|n`p1((EpJdA7e50
zdeqD`7XQ_pn~7e&?*^-v68+E|W@IYc$vIgvgK-3hQH&zH=nofz(K^8}*17=DZ`+2+
zk4!Ile>@hO?(}=6bl-EfhH{b>@J}P_D&sVdE&b#XSA6NkKi+gVD&@A%-~Fkd7mlU$
zEoWRebn3c~d<j!n){SvLLm0-E7XW7%K&^0`T94xak#9T_he8eFA$?{i>X8DjirGO{
z5*xF4CJK7-?TiaNKQI-g$oQ&;mKrXmM~9Xk4pYM#zkXkLXws*);OmbHtu}%QR);DU
z+RR2Fc%j7-)*X!`_=UGgsol1<-+25Vj{4RM$DmuUoBe?wzVHtq$aZ(}E4Q8V+@24D
z@^7@?1M&|L%5QwBas2r4mxy~j;V~F44R0K4+x$Np_C_nx|9#`eWVe2${H>nnEZu91
zsPuSE{Llw~-ORdal<Jkm@lD5`sr7?toQjYc(ZJXrrdDN?lGP_^J0iEne&~buZ8dfw
z);PI1S_NHD8pXKEo3;;rcgE!N!>hNJ8YjoEwhkuqH&1zItW3^7YmJq4Ea+P_7o{pn
zv?h8u(-k#qDPB{^s8QvRtU!upu8H2Cm93OY^wk<xL2&`2355l9gJzsjU{Q=o3xk!C
zG=Oi-P64l6I=f@R<O^C7V2?PCwR~Lgi2F(~^HFd6)Lk2YUw60ko-tY)trlaKEat3I
z6h5bJyWs+H=}6nZ%%1xAS!cy6!n7TIri9@EUfgXLiQkj%z*~^s%%UpVfg`0R+Wtap
z44@b=xoV;xld(V6LArI$<!e#U8O_UUNiy{fWiLBTlWKy4E1EC1N>mCn8R6iFFjy(F
zquJ?M=_^^&aj_lEi&HF?Dk-h(D1cTfRpm<HN=eH&dD0ljag|0hk_U^aO8<_`Q}a)z
zgOpp0wOExE`)<bArs?R9+dh2hsBM}KW$#qzxub09<9tDvw=7}8ssOcpaD<oX=)Py3
zeuecHCP;MK1NZI>PJ}nK2F5q-719;YL&4Rw&XKZ~Mfk@nZ||;tYuO*G*t9vm_&sDZ
z_GdfV^+wp?+9Vw<h6vtg!L#g<p*8tpT8rn3w?oacT8(`&<q<72$iZoW()Wg)@t>CR
ze_l(-$Q05tW)f=1O^9m-O`QC;&ABhP;*LLm;7cQIN1pM+%fIsYHcc^ieCM;Dn*P`%
zDa!Yr^$I%kAK<UH-$-SSA6BjdUxJ>BpR+Je7>qFWB}>9-E%Z#zCRxF0cujzi!E|U1
zCE2dS@R#OCEr;|A&b?0TEZ@^gfp>B10G>RRWlbdm+E%s*tE9I#my#-GtH|kagJ8wg
z0of9HX9iQ`kju+VgX!o<XYW*c)3|^&sRLus4wDRs&CYL1S`r|*<HB^8Yl%Td6HiX9
zP2S@zAGZCM()tL43TU*C`8?tbk*u)dHBQg(2>g`OVVK^jR`2p+a2nOT^PJ5sTPyLB
zN+V(T+Tq#hTrL^<S0x{ZWd$EbY8hGwr%N$a6k{RduM2A+2@Fz0wK}R<4i8Y2*Z^eu
zwk<O2S-FZVVNKU9mrDVpojVOX-I-fb9_#Z3pC+YIXp(IrH5nvLX4GVc1*XQ7G|6sI
zn2DQA?Y_yBJV7U<S^{wfJ2)4s_S+H1K;WLiL&67)lko{=*)?>>sw8s)pobY;Qg5iX
z3RS>38yxzDfZ<kSL?X#g>P&~7px`^?BuZ0;uI=BPkXpxZUGbsp#bJ$DWIgUthsP^`
zb$vPi)4Z3lbC%s^jIv#*N)x5JwDsskYkG^OvycWZw%mFdtjB6g3JdR}EkW_<^LE$M
zd5gTxg7HC>-xA$vv%^4JmK3f7Dm?3+mc=lGHY-yL>iy^jHcI(VYZ0r!C|G@AuXf(h
z8I+kOE~qq-#dP%91tg2@uWTLbAj(WCdZ|H1HK~)a&GH+I-n@Fi!<=9R0P0eZ-D3qg
zsgwD}x8)g#&wH1qf+dnR#f;3owB1jYB^oTCr8H2j1Ey4T^T$2y#W8!i4`Isd<BjMZ
zrT_{3BLJm|O#$^$16DyEVC?}m{ekGoYuUnM;|>1NbZ(0S3~KTw@WB5V4-N@xA!>{!
zg*A+e8ci$?)xQr3)MbtK3Eh}2R>4YRXmK<xL5;|2(KTuGMVQ7YPloA1PhfPvj=l)c
zU5<EZfYfss&~3B@5cx0Y4cnK3q=Etv?g+l1zD9_$*i@E%Kug8!U|ZzbwWxyp-+ha;
z-f0mHdc}%#iVXpEs#%F7j1>9;^tD-OEOp=;syW_Di#=^47H<{aa(v);D{Xm;LYB9r
zt^YdSf}9m*3M-=<#Uac$hHdEaRcs^t{bg*E-aXs6;k=q{$Y<2MVVm6mTt#$Kkq)S3
zVmUWZEqe6hC<V_SjHMhGkw<}G^+3_cC!%bSkwT78FH-KXLsm8gJV$JVKC<8l-mVj>
zNWo2eqfO|A3BbD9qJ2qaS6@){x>lp8U>9$oD>}AQGKlGSn7@Zyi-#i}ej<g;Kj=Nc
zazclA!T>n1EKKClvxO;|Mpv0aD#{8r6HTWHZ*^BB6|(n&rUAW$f1Ro+0(;7`>U@kh
zKiYG(bPT{q`Gu({)!Pa06jh;^LhIPZJvEM-hbg5pepp(=kFu&5WjhNQikise3+a$q
z%qjti2TF%}4mp-U1RI#>e#DCZ^rC4<`}#)FCHeeeNG|4gbk`@m#y!TyIz$GvKK}_X
zx=Tf)XFlNxVYX=gTY;Y&4Ax;?)}YNy>m|SY?T(#~Z+pqGt@Zv7TsgG;*?(SlCMw0W
z4*kb39|$fk@~|mASj@K$efQnCn%9!i{Jt>1mYmyun;k6Hw?6)X3)d;5PA}@$wr-&L
zX;Bc?$=OF4G+kIHPZ7zRKk2Uki(7u1?b7qYreY>~@&^}phXhaf(HHW|d3nnx{VpDP
zmxaPOAD%beowS#Y9vO%W{>)dw&*!_MpQ(*p=gn*3qjZ>yJ{q@WiM97Bn(blj+nPEH
zwS2<9Y{y_@L6q794N*s@*f}?dawitkw`dI4i4!ljlkG|&0#*uh^RPwe-z?~Z>ThE}
z(dYaw`}cTIya$Eyt-;#X%q7LV2A$E6^BS_Wy0}GADUtwV9iW@iDqv!qY}jLk<iZ1C
z43&abzeh)}K)#M%$(+QiAgb$vInqs$PXWygsi;lJ5P`9}m|gNu`8e5AcEj>oEuyZ~
zQt9q6xckgvuBnI>D2tDs%$*Hqu%zN$m}`<2)=CYIaeh}yWGPYEx!WApZ0?HgF<_Dk
z0Y)loyi8(??D(FMeW*pJe&$ZXH(0Tvlu9hBEnSG*s3}`9`hN7Lv*lDu8rafR-GEX_
z19K<IJjFE@gdRQ?=*Nc|^o`M8tAx@YX7Mwu^~i|cmf}ygGg%#~c2#+gv`2X}TvU5{
zTZ%tN!oY3VT|a`3&*#sP8w0sR+VEoRPGG=6bQOU{PToFrT`X@u{RB-%{FQ*7B2RE7
z90~Dv>(JW#_8_QXpV`I_pv3$ZM+mvD`N<GKkl?K>C`UF`5Nz0SC2Sxg8(8D1jvkOj
zl}QXx;sMUaKD%U1AxCB?63d|%oB{2!n`PqIB+hk!jC&)bfH~}u3#pROz`AHve{<f2
z5Y!Sv5av4XkQZ;!^`}j2`#LK^>~PyJ0RgqB_16ptU|Qfe?u`{0q#bsSR|R;aco9y1
z&m-TVMZbjoEdtkQ(O;=!6f}Tnh}L!$Y8@SL#p^{0s40H`!YBbIwqbFGbxp*eh3U4#
zX8&^huU~nG-Re!1+P-ni#;+W4)qfl#|7poB$sD0``Il0b(1e@X-Crj}J3jWAB&6W_
zkF9@oNWmyZd|?DX5bJ#z_MzOw;NtheQP1Qae3liha|is01$8l{AOnk*8Wue&cK*-*
zVb;O7Z>8ALM;y5M`S;&TF|to++HvL+>+dJ~6PuUZ)javZvfa$)&0#;ff3MZ;U*XLQ
zSFZkU?!m`gh3DV7<FxJzzeaZRT6v|uNd>ip@QuPpbu;pdgZ`BM5qLn~qPVO?p#!Y;
zP&7gA4Mh_em?>WOD4w9+pMj1ijvx*u5bMXgOb9YK*(9q!VX9rD2{ICixHUx+WLpm+
zbN~h=av&F7bFAI$%GwYE9Bg#7!DVGa$&3B50R+7GvUP?HQ|6lZk%jXpt%6ZpI9kNy
z5=j8>pg&Cg{yygkw|9Ny|IE7G;Z{^S{-hwr?#l<STw<}S@?T0NG(Pe&Asre!q+9Pu
z%oG}SHPSI|Ez${#dhAdyAMZ`n&cqI|_C(RH*#ERqwnZ_RhYGs_Lt#*c!VnKbL+csw
zR%<v=2wBc{Mk{-xr$76R&!+o}vRk4J*ce(nMB6vI2h0wh2r*VBi^=5ip=6ctG<jH&
zdM(R_U`HzR@TAM*BYFK}9-nc!d?W>S@c6vT<s&KZ5|2N1xqKuAhOY6V-?&^pk^)zd
z`zM#nM^fO&fW7TGt;nLMM<1UYecV8`_19Ry`AAy$&}i;8Jd#ukSB*ZFcqFOZ>qZ}M
z;*q3sZy0^t!XruL-aPtvCyykR`}xtwtvr%c?p>pg5AjG+x%ZDgZsU=pa-Zh$QTND4
zlDnP9CtWTdNr4~p_>9ZtBPp<h$LC!xA4!3ic>Jl$<s&IDbS?OGxqKuAt|0eME|-s_
zzy@;HUu%KnBPnnVj~{Zmd?W=*JYMB;`A7=f#N%}?mye{t79MYKxqKuA?&R@im&->|
zU@MQGce#8d1s>w@E|<$kQeYd8_q$v^k^+y8=H3N!-FaQQ$im(&w>LQUy6d`h^e^u5
z(Vdy-2)*7)*$>$maZ>n~{<B}!EkBj#WpoYJNY=#8Xh*=ZI+EGU*4yf$S<N~q=+$01
zMhFWj(-(RD7^iIQ8@rOz^dY(Glmf6J=XOPZ1G1XJf#W;Jg;sHjd(MW;C>XI?II)PK
zZfM)$kNhS|Dh`@<uy&PG*ND1}T>{1I$yg|!fQkIj3;+h@yZUI_4D>D)q!p-m|DQnR
zUD#XHN=Yj?G@OG=jvASV3_OO#HmC@4oPtGZBfafp-o*82i)3Z`jIL>8p9XG6MVNTJ
z(yF$mvZ}>*NHt7G_3Ku(tOlJ;&qr3~iBirxk>E(J+7+H%Q40)^lB`nma=zu4CW}}R
zfd#u=a%Q?%rlbod0AIqWoE5;!lU>g{5aN>HT-HFauxOg71+7>ivJ~<P!cpuV$&pLr
zbw#h@BVjBKd@aN4F#oN$z~FzY@{w?2K`4`t#AhMJsgY2=MEq}zSI`)(kmP@}=|-jH
z=+dN6H%@yP8K_wv)TW1+l)5W>Spdfi^(?*#)@?bM!44VLj@<wm+yE?=aRV6V24MN?
z+yJ>)KA3uAC!A$p&0ofDSm*;zm`(w=xX-!8eLBHrf;j9FInVI!g{fiyBnJGc4ZBZl
zk)6VLVTHuvKVI+KzUDW9=2R2iz)b_-TBDYj`0}mO44#QFCx)hVm^_Q?Rfsgz#I`{c
za{hr=P?-RQ<8xtwE=5#FPvoJgf?mjDpe?A+TVE$aApcH~xZW~d8WOHi=Mv)~ra4d9
z;#iv3Q`ypxM&(mYD+vh&s(h+AD1a@^N;;;w>v)vrHXYME<!Fu=R%G6nmO=u+8BQa(
zN3zJN7#o%*X#{bxG=e(k9|Vc95L-b54kytn0Qe9k)-GT<&42tZHzQ-#2$8T^QMX<e
z5B{Sq=j1H<cGFg!f*rwuN|YY39#LDHf|3X}=Mo6uV<|fEF$2I?lZhV0SsLJIa#j<=
zTW_^Cu)d!0#DSrT@kB4LHl0|4rErzuQjWwmMKKMSvMa{9PMrLf=ox3Or6o96Ct^oN
z-&xFs-ia_x?o>Scg0{Mvtg|_Woq*o@6lAEO(dRdM1rOq~Hc%5ek%T6|Zf96?V!Z@F
z{3369zFC9EDJH8>h3$R_?uw`pHO~BkfcW@ALd-*u*VT(Jp1q+kb25tb6|G=T?5oG+
zLa!BoQ#v{0oeaP=3;XKXA4oMG%s4plM0UZK0HR&HBsfVM@T3Y^H3J(9Qnno6kHPu%
z0b2|jbY0$k<X~*_1w{0a={(g+rK1$R&`_5^^}2LEz(GjsUgN>hptK{R%@9~WQzq5b
zc<>ByBJI&#-Ws}~6FfxLr6^4wH-VV2+zooQ6ptELw=ky)IAse{&Gy5bstm@41B1!G
z^W=K^k(udmL)X?BFC&ybLId0C*)lkaFEQPNDjGVJz}G@bG2JP5C6A7JTEl<dnfvgC
zdOo>HI*L5I|B#Qce68zIJYln<r?E!<C)(&NB4WXl0PO&2R&f8nW$ujW|8JQ)bNr21
z=E(CJgfJqq1?4HVuZaSMbp+O;w68b|O_0n_Sel(O)l*|lbtx*Gq9-F)0b0(J+~Me#
z3JB;RNIJmbZDmm6jRmDy&{?5$Nz1Ql*8*din^lArO0-sug8*+Glb)05&_A(SmVpJ;
zm3G?QZwZ*Z1rdtK>NTemJQ_f~&oKg&sopNxH5vFVbmEG~0Sr>Ipo5SVXK`k&eI;dB
zjXZ}nJFILxEVeTpu(X(t4#(dPraPl%1};=#Td+zo(VKQZ@T|z8f!paAwb>c{bfdSw
zFINN<K~LG|ta3?btq=UwYAjI@6q(614mP|fW62sZEKCKWw6tgl+&NooTG-8D^2qHf
z${WA{d^ac-27a>VJ-Tif-3x=H6ws=HZFQ)kWfbam*Hr^8I<uRPY*Yuev>AmFtlF9_
z?WQ``ufJRC7eYX!s!g!UR&>GmkT9{V6=C7UTVNWEP>Rtlb`wNyN}CQwoQdo?6B&qM
z7iacqMQDvuW@RQ6?SH{dvUfGEbh7`Y4e(-Gn6%qmd<L4VrbStb2Su48b?S}QU>^sH
z_Bt#U>`>TNq0lrif$<n`6N_(Hya8!GvEVSkPR6!@FDysPlmo14Q!cUKEbmz2Rjmk}
zDW^%j+BlM-<Kzo;F<#^co&@(XgL9&{Vhyqbis*`wHFsm~6ayk#K)C}cOug0ydySjZ
zg&4<5BDk}QT_qW=mO_}ai6Q^0N<y8pk%dmso+`p_gxG2q8Gw6n)RSB1OzoIc$*@+x
zK!YJ;pMe(laB3wm0kUWbi^797<JPCKsfxseDXEU6nW_aNo?M$hspzwONZI8B#TttW
zXdtcSgF)utrqFjwM%veM!)JkFmy9+|1u+k{ykkqz2fH2n*0sL}dLjw7V0nT`X2<Jv
zgSTt2g{h1wV}mW&o#ha=cFnCWVK1D<VH$fV+b(vj!AIXXQB;Ot3r4}ZR;wycc;T>q
z{Gx`f4i>;EJ{0$n(vGxv#VHLbXhm^ACKe7(y%ShvgJfzd3d4*l3}lIdV-*I>XcdMP
zP>BqyJSQqvhP8PPNZLFH){5fL5lyE!YET@kT6VK+X56o-I1;6Srjyc0#~$^H(qQ(p
zP&vt_9o`5O$*|a^hQ;>oH3>u%4-}!C)g?9aHAzaBfK;bT<nD?0((ynrS6Ozj@<11e
zF<~(d1+HIpNONLq^{@HYLL&xJQEDW?1$o>!b_M5)S>pg6>Q?iV`m`Y@nkz-Un5U@9
zZa2;*%|=X_46+iv<G+fbZ1fH-vlxCgLy^B*h61J_YOwkqxHElldg8v?WwC3=ERBbb
ztxU0rvy1giXN<0x-LO64SdCrSEwJon>1*dFCc#&;8{V}#cs`DSvg~H>D5$WTJ;@)R
zCfOH&UW46ir9Ft<v%wlw^AxBZ!)J2m*~uv#W-U0ZkgR|vFbE={Ab4FqgPNAlnA3OV
zGdUY#J|hGx<};*OG-p<<bXZ49V^@bXCq7gEu!nNdY%y%qP*GA@Swxo4tWwN5-9_DM
zK7$FEHD9f}!o1_Nn9FjO%W_g%HrQv3+R6z?+TAUek^eeeCZEz6E=!Mfsn`*_c{SlO
zB2;3YM9g9?8|yhWqaL0?$Qt`iLl=8vUCFWMv`VE}&Jd4Di8(E+*a+d*PK<U&wtgK%
z+fEL`Zk{bD-KY|J`Ol>M8iH8fWTLs4X=Is0{7E(n6`k2wOht9FVEI^H3?gDiWbbih
z3w^L=JYHwk(S_08t2%EEGiwWWThPC_^$NTD%CR&r8v4=thHi@7&xG%<<{{{vM?g|U
zC=8(}Lr>lMT&DA8;VaYnywS1b4Z&bB*ScdZL91)oS8RUY<}kOJ*#fIEs|GiKJ+NaV
zKIF?~nghqQKmjj$$WwR)bH6W-Pf!qaH~U@MnD=esAy4rW<UVh@>?ocyClrGwW(V7r
zd*?d~4N&t1=D1c3g1FIWS~tq;`^3;#o2u((1@x?2+dA~wf4?tSo5w@z+rWicp)XMl
zQA?l`(+LDJ^KNaj`vZZ-4hQI35j0NZozQeM+t^y~cuAA0mu=m!$2wjd;-^}VUbl8_
zk>+jq0|P|STFV`JMY9w{Gpn<b)?v9Q98FJCdfI5ZQR&9fw4#a-I#-|ZS0XD~@i|K%
z=ZaM_`G2nsf_2%oDc#P{!q5nV89gN15PgX#*~Vz+x)T+2VUNod>xqW$iY{F#S6Ub-
z$T-#N#fScP?(8Afqs`c#9nIJ_snbAPygB?*^XYxq%5Z22wRefjT^Wb>R!XfrSIe#$
zqt$lUjqSKmLv3vm2e8VRB4_qD+2tkx?E(%Rnh}{<Q~}HBjp(YN@hB`q_5skE3J>us
zFo$WoM;;fZTyY#cq&9|8b!?#Hy%P$03-#eR+K46$6vly_B$j07PIH+oA7PETtI{q2
zfX>XqQJ@_<k^)sHTgHy<rRKBU(CWdriHqB<d#oDwV=hZjtV;pxY#u15g+P%U7J$R;
zw$FZAyZRMGvsVwTMTIQf&X3|sgr?-efb;;wzUg;%E5Dc-Ngyqkgorq$D;sJ?ifr(>
zs|RYUt{$k5?sSz)MJ*%=<|~Kk;gMn;4G@4)g7>v+mKiREb+}r`G)c@vZPhga_0iV2
zDH>wpu{-x7N=WDF5n4%8|GwsZKRDa$Aa3BrdB=a^oeO{EVlv)+!~PuKd7(VgcFI}r
z;HWU?#cgm$jb&3Ec35N&yS<>`j#4oTcs5i)=u0!anDa$+5aP}_)hE#IsNCVv9FA*(
zH6CIeMi@rD&N-pRpjwP7Gn70Sl@y0jFwWbtGkF-~r3@-B%ngSOjTIKWS7NA)8rCm`
zHE}4*1uY|Sr6V};M2wOB(TOKhb>d0gCnuh2h>H;MY$VVK82ihPJf%?%l_O6LyB>LJ
zs2q6;!g05(wa1?Pupa3ls3m4Jd+e#gfv<h+sZxYvPetFIO@duKpifTkxRXznf;tUA
z09b;>Dyk%T#w>0U*Rg>Ca$}T+#7q(VmbStjS2m`-DIJbEAti#uU;u>FMmnGWetMTf
ztu4|6RmZVM54B<^5G+!;Xu^gjjR1xH9pP#B2P%2p_BsbDM=B>Z#nUCbtLb{%nH(%0
zcA3b^UvV<kg81KbBosI~tZwX&j{3%rNN6$j-+B}lK&%9M|80k1Es6do41J@5^4tkk
zMBv{%-{<BtKRIT#9je?&6abultwLr4JMCRxIc4fKPA#w^PbS0P>nv+5`%Ex8!pdwU
zmO_(h8uuzgE^QhfasFZ}6IJ=85i5P6Po390q&gCZ6yD(xhVQosPOM8zKDjIA7-P*r
z8@BJs=B;|cg2)g&yqnBmcbV2?)@GKh&U9DoKTX?>e*C96(S|Nv&#b7Wl;4HhA{x5n
z()Fx6?FTMZyRS{$b5UTCl)^V%`OUL~hQZWYYrOABIqThzwwq3D&j15a3o0y8ec)SB
z=D9iv8L|PV#e)4fGsJq<-~;~i%aNhb9{ymFVk51w@99)lvEO(=o;5(OE0VjH*J0PV
zafSoF@sAg9eS}7FruvXmN2jz1T!^4@GzSaHzD=?6Rv|gVaI(jpr09h5Qk{(l*ou)?
z$m44m{iTt2^+peyu5mRc#gCVgD?%N;szrs=vGi1%=@|41OmdLX&SQpSdanMN?kJTT
zu_9dDm@O0z95);pfU5dsy9bcA;Hm|<2ZuI8N-&4V*!n)xRhV<IvuMR@m2%}@4R-={
zg6;%RGb2j>C3PNVaMaO~X}9><T|ZCSI)6!xZyENBqfEXKuowx>wKfVQbv;IYmqjED
zAHC;9E6S-Ti1TWy@=|dgJ3J|!?M+d`jz4bFvkkH`%F|vx%zy4UV}=H=`j5hR%<I2_
z0q)Uw|2hVEjDh3tDTv)Il$=0j;0O!{{{*F7LG2-Th(*UNwm@z^JXi#KTM>I*UYR8)
zGrWro)PRdv!M!wC82>6v(<eRBav<S-L)1oy=XOQ43jz2Z7UeS*_VM&RGrw;hpWj!G
zy_N;d&KVC5q3T0oGzN|!+TS8UFA-?aP@KZ*$Ra{eIJofYIv=*8=PYyuuDd{&7HbLt
z?#xOR9YihSONPP@jdEQQDb}S3h;(Fc-BPn-YXuz1bQp(ic+}w`03FpCLN_#Kz*h3!
z7=9#mPn(zo3Bg`pSV8MS+|iM(HMMd@ydhF(I1WCkLmEISLG*N8?HkaQXj!W(wTqdj
zR;EtwGmE6x;7gP{@6QzBcG2%BUV3MH3bs?ghSm130bSP4y}Q%9(9daIH2GNQ6!hX1
z<OzJEs1cWf6l$fY1+PqItzMY?msHo(sb1qY7?eDYE5#0WyJ?h9?BKQc26N`v8?!w^
z7<gZdo6@p=N@22X2vlX~K_ZYerPW(on1TuYCvy@dYQrg;)i_gKEq(1UoxJh~wDFr`
zXNQ@UDL$&j?KQWHcpVg)vEUiS*Qr!G%FQpPo7jG0smtj$z_9HBmsKR&K_YHlKAy=I
zM!C#RxABC!ySYc4NxOF3#2nQUC?q3dayUhycas?ouVDHIIFzL&7?RpJyErv*6tG<4
zM0cwxOs#027@mrhPY$Q9Eld_lgc@4o=3bc$u@0{)?xtpfu5`Z_mk)>)Ez7>9(iAh!
z@>do`gjf?A7WQ}CXlDS8;tU9pJIfx%&)*TI?i`8Vv~Eo4ZV265d_RO&r8egU`Nbgj
zc-bGGlG4wu=77-H(#HO9??v1(Pp)(ha_6F~s9sHIxx))6un;SW%d%41&$D~L0c2;M
zggQh;INg>bN-(FBi$q^iTJB2d-W3-gy7!w0yBfIFR0B)fZcQi>51pIQ+*cdrPC+il
zpVbHNP3Bt36QC>^xzm9QR0wYt8<;MWTeG@AwUQfg8!{f*foO~MO5U-Ff!Si?-@z+~
zaeUAhcXQ!#=jtZfb+{#uN<W?<SLPitHY`Mn!s3jfPly3WlBM0n9&!*<5|&62i91gc
zX$rN#o{e%nMO{8YT9cfZAGa!S>K3$dln}x7lK)Zx(a=>tc?Ql3$5nw{tXp1apa8B>
z$y<T<Oq*1qdtCIk?_zyex1z|F4^DpxxYwyWE<tB*9{ttK@8wJ%^Be#XCZ~gZY{<zj
z55js{sO#<u8@lO$oee9cm<?`MHKx2=y9m14X23RNFDn??;mk^JIsT|osX_z2OgO$!
z@9gbRZaOj)eb*q>@a*<ar_esp1T-aThAZ<JQclC89T+Lh+!8mJ(-4YvYP6U-)Hkhr
zUcR<Cx%CpE=uB<|GeV?A*bwvb&`+=0gg<>UGKz|lpE?yzJ{ExG3)6ng<kOnKM;+0)
zq@bE@Jy;<3zMRr1B;MMA*G7AGq1_b9s-0!6|Kj3o05NAe_)s=P8ybsf2c!0a#RYIk
zTCC%CK{dOBcQ93rCW}lcF6;@Vf(8&ABE?k7u=uPC&{pnO)`A6F%NMxEl}@V|-Jt@%
z2XfuQMNh(c!U}>`kt-s_F7=|FAHC}jhJYmB)`urjg`CxMA{!emq%Z@i$)uW((BnKe
zozPSq7uM>WEI?@zvy=$Ot%g_e*$qU4{e^mQYUs=$3u}?P3@omQjupfi%7ZHxa-V<-
z9nxrP%e71t6|Uu3&cFIz@v0QC!x~Zgj1(%NXaOb6VX=c!h`=U*4e-q&TZp}b!0IB{
zRQnYU#Q>mv`e?{oNV6Jdq2A%#UK|6S?GB*Bu6BytlWvHppJ&HW!JvENR#o-rfA||K
zFsI(@HCfb#<G`564pupZtDy8)n`qiL75Y1h%KC;alYv^^L&z+%6nCx5G<v61;T>Q7
zYBaJ-OLvw~ZADJlPVifzLs6<fA|M4Nf+Uy|nn*u(;VDfp&>=*K0bV>6>}ZZ&grU0{
z4-6;VSezJ62q%obIn=&roL(G1Tq;a(fX1LH3Z%lGR(FWl;QQe({M<%3q~<ZI!0D*m
zd<DQwiW}a>ooeGt=xMM8Nxnh_8mqkian);K#<d}tOd7yDR%sx~OKRoA@%pWdp`_F&
zhr{tV##zRk$9`4x))Siw<MRx6d?}nbES!O%Lp!5CF`Z_5qd(c}wQHS9PcWi>!B66j
zZ8`4zB8JBV1~J$#vuFYH7g#>Nx6(hI_0B_jYIV8xBbk#Fi(Q$=)q73jfgl1lsSE2s
zptXxkoxv35)Xy8VzM*MsVzRejtt}J|Hr>UADSt^5Rc59vwowKtOhCp{v91qvVGPKU
z@o9}P6pjr3q7KuCeK4GsUg;BwEDvj?j8Hk)uHodu6wx~!ebaOy!9jH73G7AD(BxJf
zXhwOn^g(7dMUq!9FIxJJ3NvoOAv$4{>f<Xf94|<lFu^RKf5^%s>sstjwS;LagI7C%
zvh`of$dnsotgU~LL^Bf`lDk-dFuHRL=)4L>ZR`_BaAss>$gs0x(fC@iXD)8dTvnWV
z8ZFuhAvM6{GZivnqUx?8DGa1l>x0(Jnao-70uWqb)Na#CZZ`&P;<VtrH*;-kwRMYX
za&8Q!8ZAlnl0N9aA_}8mP6;ufn_B(LF@amdi<yLP&%Qyc(+=|a)mk(&0QRlz@H`Gn
zRpelM^Z8uu%6O|plUsAgLnRb}9W!$}CX&5;!CxC4O5WG9Yl~C35*DO56*i^y(08z(
z5gjTGoxh`y$fb4cMPG;e-A!52gA;Dd7tm&-BOMQLT!%wb;lc`BlFwdvMslq{$U8^E
ziR_I`94;mrgq;y4zEPPK$8JXAhO*kAPfBrv7sDV7ra`Al_|)Mg**;?mM1P)&n&9Hq
zsi!tYuQaF#xZ^7?)^L+lrRbu-wRPu86g6)jW(j2rCT-aQ(T=6ItsP5GZi+tAKoMy^
z_3Z8)qYWA#1st5jxY%VGfESi-?DAz%2rnZf`ZKGmQ&F^bN=<3we0=^_K7oC{Vl4R5
zn_#A~dVo6+&Ml@-lL^WrEl9{beaylOeDm63%{j?&>{<TN_?o@0P>a8#RpdYU+8Y;C
z!*cELpb?x?SZ?i<J6+<TX#h^xGqx-JIgs#AIfNO57VrcVYP(+Asi8Bn5beSDq_BUj
zIa}~?go=-p;z$gqoP%>IO#BJHWE2!Gd!WbLg|FEj@vD(0L2=D74F%g;%GJ+GHEQfa
z107-vU5u6iiCs5yw;2tk3H!i6#I8;nSMNn$xgL1Kt-$=TxH-yzbOl6%b1(l2cedF}
zvYmCvUygfKP;3{=6vKM3L!RSY+(s^LKbmbX6gJjZ@y6<S(NSH|DzTl9ryDEL<LHe*
zx9SfSQ?-_6OTl-=F+pFW0O$wSSp6`}(bSlRz#q{WEHyY3$W-H@KR`cAO?eog`lHw0
z{zG$oGIC3`c;ukWh3AePIki$aK%hU|eKQsxDcV-Mw{X2&?Ygy0J#QS57Kj{&lUnCO
z+SdPl<$J&R;JrWD<h|W>5V!qC8`MZ^6=`0<EBLO)4T?HUUkoD=&U2H8n1KtYZcHq~
zQa2*IQ#blb6SiZdZpIXly74GgQ8(_WYOHROqS7X6%c&dBsvBEyOaZAIwN+6!R`k?!
ztZwp8*XXX9ihf8-KPZGITfIG;s@!=DN!T8<+r#lS)?A8jxbELwc74gwC2$g7vLFwK
zxvZG8OtWMC3%_bUo123)xpAKh-_5}0|6&`?@C^(!k9t5#CJ*+vt^e(dzVpbcUvmZJ
zjUPF@bj7+!&83kxuj5z0db;g6J<bZwez>@NxgHOHs%HIfmRzmJcfX?RDDP=5*(Q^=
zo_u$CVC4ZXbJ_2Un|HjW;m!#vy0r1bGk(ACTs=;{Z2Kz@edioKesukc7oXerQa!#B
z-QM)?!~e=72^0TRKbDGK2{PntjF257SKr1Z*%w9}G?tMHfw|#v({M>+EDgJB*KH)3
z+x8Y}xw%}kBn5_DCOp-6WSG{K%os<ys+sFt#~`?>@1pFUQM&k5bO91>^QX6W6l<DT
z7WkF%ph%fvndB>^(YLfzktP5f=D)uuY1Cx=+xEAUCiI9X@CX>O#1IZ5MXqzs_zsq!
zqeKXUYV5OP9@cPglBOf}2@<*4Q6_eZYC+W{AR^;v(uCYpIs!^e!W57d2m)9^rm~#_
zO#YjmukYgWTjCvP-^#(3KR>^tSywH&<c6W4jazl~QbLX)ZkVqyP|2!?N-`<aB4U;r
zr&iJo%guJK(H$SV`p32pSB!Z*;Yq_yJJltT<*dCMD`{%$2)8!tYafyfTLE>fZ-M{^
zc*k^{Qrpw^9HiZ$)?rEZq|Ncx35uPOoSBSGFr9jh25r&Cfd-aHpY^=7)#GhNx##3E
z(Bw!EZem;%IoYcS{Tj{})qpLWPhriUYK`SYst}{^ToVwAs%+KhG6Cj1$Hsii5$;b_
zgAuB$u^Vn34{<fS{U@3k=5KMNW_XN=X*}~WDfIJSK0XMEIduEnbdzO*$BqoT3VY*`
zkh8JK=i!}&H}UZ}$&gQ+mc{8&wy#hKr$@QI!XD&3#=Dt(9?@BtDzhNqf5-|4ASWvB
ze`ls&_9Us!!o-T*&=O{tB#UX8=gI_DF3nMzr+wr{@`^R?pwArRk)s!o7`w8DSr*fW
zePE0k8!>=$av!Z1#qw<K$*BvTNBb{MKA}EKANJ6Mp<ljp4v++*X?zQKs^@I6T1{hK
zH3<9zjaSUOHKnF%g)aEfOq@QH3n-@&K|%W<e4$W*+w6!lqh6lvdn|;#WjVl|13bU~
z2||rEezl(qXgjR$BXluWOzVEPxJJm=g~UawE81x}A05DA%Wk<*#dAi8g-R%JP|3i=
zgA>)trNhpi;vWRt-l44$Sa+S!GlLV%78K7iJ8;k7|2PfM6!Kd7qb_CLa)3$}w+h%D
zmV9v>k^tw+RZNBYXlScpAYj~8wMUo6fdcH497c!;W@9U8HYKOyIA=K#lPPx{_7nn)
zb6Ti(Y;qzhoR$S~LCmYz3{V}nh>^m1l=@n^w(Ot=Rn}3>c4@5`?bZR1>RF0<)_W0}
z`fNA@;bu4!>vThdJf|s6(U9di&A~Z=&JZ2g_*T8kx_5r^4$ofYU7dRuB<~0XuDsLr
z1hk16FKh=y43EB3_&e{!#`YZ{#+7>0+`F3O-Q22ogz2kZCV6*6)w|HWV-|I7wseiQ
zIn%x4D{tI8j+(od3|UyPJY(%!w2Az=k~(|#Fq$R*rY%OqJBrK~Z|hd8gXDM}EYy-|
zk33jOsc{_IBB_w+j3*|Mnjqm%>#BGBsZt2Ax+-|EC{8u!PNvmUXco(Hh6TmfdpmY^
zH-N^ziutp~@u%~Y#udS;BRWk2#RSWRst2_4f$~8KNueDAFTxzm#?Y)y?>IB>ICDZL
zi|`6(viFEDmD>1n#FaVMzB8QR?X<>Iq%jH3%eb88i(6Hg5wHe}j$-vt&UGRx6u{T6
zEBN!V;%l<XO}AP!Sce75zCqILe91b<)F2FTz2D&hUjvI>Ep`wmW3)^0(gSR(H)=rF
z0BG((+ab<`O7DD6Z*f9c??jd_+Z<27Ha08%+fqsEiC<wwaK62lmeZUljJOY2!)Pi_
zitZs+=!l8q>&H)=I8hg*$3J!Y43gBu@!7QAr^(29DS!O<+VMv31seM``v*r9_KUV=
z5oW>ax=sFqE?8|`)_8u9nvt&I3u>~n_$JbcT4YbJPH-B|y&(|9)ZtEYskeEiZc371
z2CSQ$B-8>IHC9!cn2)k}$+<m@?+UC9$7^;QAH8G>lPsvfSZK8H7WdOVlvD9&G96E1
z1_8ySAU+#)gjt09Z5F1s)r-hDZ#47n*V=G4e^OTz_JiDNT%q;UPOYNh&O#%{CmJ-T
z(NNL}v>nqX?%%m_V;MCTxW=lWbItmUVyd0@;5vv^%Q=!-@r00F+z%56@G+Fb{Vp!<
z2O}XD4Wa--Gd>z>#Fb%l?y<+H?#=Rwe5T}vrhGv@kNvEj*LWta>{pm2h*fng23l)}
zinCgO=dBC(Tf4aewzT{8-r3<Si-mkROOA<Io9*l#<1QW5u0U)2&g*7xB(BKT<%uCS
zfSm;EppZGfx4sUb#L#$`>Tq@gS28?&mar01O5;<D8Da^Lj@od)(=1l7k7Aq%W*Z8U
zwN;Nchl?dGok2i8d=sQli5w?;?S&!|HlCtuK7r|EtP{&kkeX>9H8{LHzJp?V=fR$d
zw%2zGE8;KY=NI?@!Cr<A>f9V>InB;?r*bPSF5-e!0#@ia$z**~IdqA@ryV{p6m&39
z<_-d#-1cs3+S!k8sK((zZBi$NwD}D>)jZtkYvW~ig@UR=1X=FB5D`GKR5Q}nY4}O(
z%GFRXmhBB;O)Zpxj8e4`mkP%y=DWiD*oaG+bh0TJ5jE7YzG(syF*+NGVq2r5v{UnL
zW~VH&RbvaXYYcm1FVr;^^Rm?vvWYcLkzHd^R3j6>5+DOFcrtGUHj0w{t~&Oj#W2U>
znd6r!Uv~2mnhppkx0Fi9WEbi*Rls5#cjH<as9=pSZHTg;3=+mLhWMkvc=8nH4Ui8F
z5^Y-6Q9tYWoG#_V5pwF=LzP*cnknHS-RuIAs#zUvRSI{$Af|;D-fs;S=y6Nn0?4YX
z)!1rvtE26<TGB|R)yR5%sXUZodv|9uGn_4x6wvvPnrOo6Xvc2rSDH`CLqGr<9Sy^!
z0RimgS=WHWE{Mv!2b~peqt#3(!;ON_>v*ox0iCFutts}|DKPF7u`OS}$*y)7V$X>&
zhQ#GV{z4)M^mW=fu!%;D?RKHom8Y1s-c?rBc6yGXMh$#hj>UkA(XYLf$XFxX?gfkU
z!dx{?eJkmrb}d0BwU!lPx!1>TNNWRb-WWyg(&g_!QP)mPQK7q<BmPE;MuS#;jnY&%
zH>J5>V=Vf03zI{>RSQ~3$>39HF`*4C3>LgDZ8Mg(a%%kTv=!s1LuS0REDG(9C{WZ{
z7f!cJr-$R&9>t17NGZ+|v5tp2;tFapoZK4Z1cpkKLD-;y=hP$|%<|D=WD^(}e9PKx
z7rtfmWB7Kw9ozW7&)BN?zA<b_c$wwbP-?+0kj!ONV<Bm<kTm>VAOQnl>!gaj&IL_%
zW5!);d#nAs^j6Jq()?D`?V>XoH8*<2dSlm7|82Y#x9d1udf3?>Tsxql&&G1yhn|^C
zy795^Bi|7!X`hXSeJ~%UMPJDlnj-6bL(Roj)wJlVNp7@_TjFEOYFbmFDV)Y(*a_i2
zv0rM(;9{@`rllhZr{bD=-N;i>lPRYr@z?O>Jep9YCjXP+Qa(|WDywR{Rg(yG><htF
zB-20aMFFPMApi>X@*rXQgfdW~?`ESHvY||1_9~<AXQLNo=Y;!&`<&Ml;XZWQ)@gYS
zgX!zPa|Cpz4z-~V_3WZT;mRT!Zmq^ciU3+FCKzYW)lQ074Bbp3+MDjy*!qf-qwniD
zgY2D3T35}eB$k4m?wVqCN&J=qt-C9P+!Bqz5UxzVfZ1VL)kGyO_hTX~);Dz)8*D(G
z&J!fS?1&auo{c$Q+l%}BD_uk;pF}J%v(_+{^qs?&Wo+n8^<dD#43<6=MTzwsHV_Sj
zDai*G+MYPQGSQx=Hrd-#tRaT*XuB_SOJV<3Q`iq}oW|CdHf*>oOcMnc?oSlltR(Jj
zKO6T}w=SHu*2cQYmZJ%7b;PiDh2(j~1i%dx?nfE<eu$hYrnMQ31%b+tiDZoeY%s7X
zRcx`RWi+7UFGNQRPt>T3rguiU6<SIYKoR}W%r7)D5{ze6<NEL@$8c&HG+@ZUk+n9D
z^|OtZiG##yR~M$>b*i;NVtZl|W<tzt0Ml7S8*H^#Si4#duW-+BuikKqViV<JpaXXg
z(`c(UM32sFaH2D5Wd_-S5Lsgf(m=!9!jcOc@$-gxx0<I8XEgj(VP3px$ESe;O-&3v
zh-*-ktG_DBb%P6Qc-Gqexv18zHDl*zEwyo=WrTJqC~SR;n*~i>eE!JHC+-ce$AVrh
zOyPmJNrEwjQqDr+3&Qu9TV9+3Y{fmJ^^2k#&I{|Cio{)rRXd3qQ<nfXCAzRX%y)9~
zR$nniNA)yHAg-1!_!MwvC^|`n#b>Ny_*#@s+NA`cp3xBtiJYuW)67foRKV@3pgj{2
zfSUn$I2%msjH-xYS)KM34ksvWxGt~NAYq-FxUs_RJ0gEGAePlZUM~QpR+<YhN0?br
zBz(NPn4ize021!SRTa|R^<kct?T84ysO(L&99P&!ohiywb4%^1x+#sCU32gh>pP1G
zPxFj^R5XdI+1{M!?BwC4W>CFX<r~vTYW&{n;uO3m_2HC-O@)2weFC5~sp&cLC-1wl
zu&<pxv{+T}I>NngDcq->cTib~x0m){<qAOUq7?~_*%Ja;{$+qJkPmK=fH}dlS*#!|
zZwq^tStajQ!ghX?rev^L9+z+H)oh0!481Ux?L^*DwzJ3;d%?@ZucamEX>6(7$#%oe
z$-0(<R@NDLBS>dv%k~x~h*fF`R6{6<h1HS{;W&Y;_ngpM%;Rk8WXU|p)gwG}o9`rB
ztqAI(3k&i_!aJ5kqPciNt324DcBKQE1zlRuNNbQEgT0c1T8I!RiW3<lFOjqi8vb26
zgNCD>mL?!kj0v@)3DZ!6kVOC_tQX0Z-!m?R_F&?Ct#Sxvq_3;YxEnZWbV6ToO4A9<
zA$5p@SwJ92r)9{v_XWj0g`pbjv~wFLYyklP|Lt@}@C2__X1bF$slUBf71RAT#$CCL
zy4t6b-;Ga&@OUdr(@~(2r+I=^Lv+9CBut*inPkH-5!Pf>+r<h@=)-iF98Qu?ORYz9
zqS*rK_$K8{4<~C5kf+fB&5TJ>YrkogJRiv8g`eI|>qJBCYSuIg-4(N@##)maEn_kg
z7;An=Km8SE&1n7Dq!B9hy&_oA<HE+1;&mu3&sF-r3=(>^L`LBFZD2!hd=mW2t9tQs
z+G^7pM$O8O5PNO0i54sH7>)6e$y`C6t)nbwiRvho14nGtiS_Hl@$xR?eLucFB~ym2
z8RCe=!a0`cdX0Lc{M@6=xnTj5$)>c?he8QM5fRA*%ruD6qz0#1o~WWoI^2WY#6(Bq
z)`tyvNQB`jh+INEMDu4H8%hjB<|pwUR}8Ap+OS@ew@b<EQo)AUeGeD<$_H3+J|TyZ
z%vg+ARNytUs?A}6i`}IN-R33YYHeo?C8KeKm>f9NN4W!Y0_m*d3`mn35Ra0Jdd(#D
zOb+#Et0;E@73-`NNj>CH0gZ<;41i`>$6MVkFNmfS)IK`V5xGKOjp+4;!eK&&BAw-k
z5|hY&!6T%zbdATA*7fy{LY6!lmMV=In8Uo#CmV9YJb|hh;G|SFeV{1E1X&YQVMh8-
z|Bp{FBc)Tf3uau*WN2u7LT5Cg@zA6R`k8E1g+nW%r<H*dJ;nD+sO19sdx~D%E<m#=
z5k8nqq8S6I%qYh_&~=cjHp(**;`m{eC!yznkyK7Rx6f@U>`T3>RESLt;r6X$jTH6;
z^VlI`I$FWzmm(D_)N<+;<A{-Si>6k}xc_11s=A}C{4GyF092Y#wXHN3y1%8}|GK&s
zXQH$fp*k_y9Om9orck)=aEaBl$Yo8TeTOl+z@}ZH<tT*W96Ra#HIj5{7)tV|MSdTK
zq}|WKXxBWa<z7RlCN?P=JJqq+a8sQ%USjp?1h}Zsy?v4({O$G|jraL1z%#YjZ#1q+
zwuBn&E)EKT$-HkKW2?Ett>O4yvX+smHC#K}ZpbJK*eWgNXnTT?%!7_H5_2E<1vxQ!
zSiy?(tfhf~<-3Xvm?cFNaxLctL0mlTs%Kx0JJ%}BYq%8BDWzID!8jN5dXsX!os?y-
z!)8^=;cuOkaqTDbLhg-C%70(4$EcdK*a0K48>7}u7$)|6S^MC>!AOxsE(l=tDm{t+
z>Ayrz#_c*i$<<k?VHB}^pW0c$dv9H;$FMrlS7uC<y|AN3A;A;#|Ll8#+$#i)G#0t`
zT@RDolx}zGk0$oj>$2Z(d9;fx;TtIB*w8Tr8#k@cU0v*!B1@s(@^nn&nGXV$fQd|^
zsksAyFKpq~3uYY~6C4^+ybFn=p264twKym+;I+ne#~VZUy(I1&ho?(9#I{@&XrU6(
zYjtirkpAWyHkdG7QMMN7C~iEo2jwY6SgZ0Fo=jL`Zfppag_^HK#CtF)pD(A3AbIsK
z!34RkaT98?x!P<_Tidm{TAosAodr>|MiJ%K1;N1H;_12(q2^Vu-ul|F=9<^6_2#j!
z_zFla;iN}<J2j*Ah`~HkJqq$@>(!nG2ut*S`&f`mGy3V(d`psh#mX3qPjT<jmLx}X
zRVu_(w-NC^7lB{xiMS?uh`LY5B~^=db%}~mUsQO;z9P0lOcs*U6<uP#Mu_&J-({mq
z`Ti?gMAQZrz#NQr*c?l6$`JE(sX|=@!md?#!!}f9Fwsjy#mM&{LVKYvLh5B)fD>{8
zLrb4m;~&K6<!))iy@antHauz7uU<_68{c8_mw3KMjJ<-DM=t{8>g|RFd?}_c`@vKc
ze>*9L0XXgpGUFFJjvL|YA`W3-qGHsd!2mAfj9$s$;Doo63xeLqtzC9wpUG-R^ZIf+
zWY}vwPv6ESe{nF=`1BF_(tn(?(j%ARXqBcv3yYqe5F}<}Cj?>%<NZ06Q<Yaco)yGu
zm7EHrPVz;@!Pa@B;%>Ok!o|4|UB`xw<CVeuH+{ZD9N-AF12ze%c69@HRcD~;(<~2>
z#WP|_K%PB~08QC5R^U-ki0>w{+Ca-#RDk+ra5@XNM`t4^R|J5)qQFLR?orI>l&5@>
z93|uSN})DY%$~@ajM$u_y>UA-9CRj>(jLpTlFY515%)3U>~*vVvljg<vt?YfoYML&
zWdpR_D2euzwaE8!D1yGSlcg-XP_qac8_OvM2Koc(knbFZ|B)tG0>3?i7wFz--hwbI
zt1@c1FrBY7CDw}(bh#ikaDTcZI!2jj4*xlXh;F?gCEMA^qooQ$t{t{7(=c5<YUb-(
zd|U0#VX%L|?z=lLk{_BC?9Ww7UVIN~omfe~V(o(!hcBj(%b>RyM1Oqp?xB=cfXZXP
z`Q`g&I?ep2&wbFnIN05U!eC+ZmNQ>2{6QBXw!L}rc{AESzwPc)aW?uZ<aIcEcr^FO
zfF)<aSJYrt&E~3_$LzM|F(uU;q$c4$uj)Ftb+m!)yX~4>HQ>7jM!U|nRMp&V*V|p!
z>!`_kJ&69}L%(zg2%@`Q{$}#{r_Vhy#QAD}ENpWJ*M4h)h3zX>eRT7`jC*kx*ebb#
zEvQC|t!ZJ4%j^PMC08}M<5Fk|pwjb#!W#>Ph%>zkLpyeX!jX(zwUycxL(?r3ahYA9
zsN|~V+5|&?yzlw<r`(r7h$Y)Dd+6cibKmtm_evW3!|ja8(|x7loC^DlK>2V^!Yjv&
z6b~9MY7%5%lU5TePhj{Vd;urdPIg7(kH_yg7|t1M>CdUM^zE%|ENDV6RIA1;5?|7)
z87>}3M*qs-pbt#n^tKURA2=ME;o;H##&q=-*)IncW=oX4P*oX)tE#rt_&p0*C|&lR
zBS&~WdrVuZGMmQ3gNDJ8nn1ZG=Px{=CmtiuLZShQ6sluv2Pcz4rZOdLxyP(8k6!uc
zmN%wq(054c*lVD=l{;g9Rz{3^ET&#nX&TOiu~m)?Lc9iHXMxNA6Zfsuq>pKWTF7=)
zo$hGISfkH6P9@j_!9G*M7HutQPJnvR)hxJ!DCml&Ek{M8nB_t(j*pghWBqAgBf9D_
z=|%1ou!}8iWEA-VxIh|Sdj;cILgD=n12#g(vq^%V!{-~`Zc@CvPL8rmL1+Y*>*L+Q
zjfN|^tDq(LR?Ra3S8f6x-?AnjFGe&J#bU(&PM3Fx#eDLG__UNX$uKW}j&ch@%&Y`1
zvinR{U%tQv1FFe)7Pu}LB-4&asObVEsC6O=Ip$0apTmc2F35VZ01){QPVAx;oJnzg
za7=xTHkI5hXpHVS;2x3^W3;`|x}3k$xST?aLew_V-$EoKt#@8+-5~+)dU4U$)1<yw
zWeXU{1`I~_Ho0>1Rfc2@$*L43CSp7!d^mw#IKvp?&QuEwNyJa_XT<S=Mrl)~R4RZs
zja^HLMqP@+{O)`T)c3<l+IJv|*A7+9SmIz9Ozgyn(fH$r3XD<{e+8rVT7F$v0yVhP
z3EF^69bi+SXmWrJ#C$x<`kAw{Cl)6+vBAixG!;lrrBUEE9FDco7gsJUPHiGM;9$-B
zdtgQJF&%K8VIi_77$w-Zuovk&!JOiux51(zpWA~@zQ(Ii;F0kaY4Dot@r5_>IsJIz
z^7-g0%#4w_V=#W$J{V4Js$e*NSQLa)lT1!<WulF1jxX-h#KXt4ClvQ>D$M5b+BGK>
z_6x_^Yi1liioS4EFi<Igj>SfNgv8cEEsGtoEJ%`lV83Lnm)KrEEDC8Bcu3+Tnala4
zA!1-w9y?MzaIAVbaEwklFe!M?NNAWZ$Cj;DB{G)~t4`Z~!Y&7Dij6hV-?uBPiVhUx
z#nJ}<p_VM;A%ePz2HDGsT`coiEGTopLHJ(;7Ll7)^0HlGbHOL&_@?T`0*5p!NZ~oe
z8_OZF&|ZU38}28IFaeG;n3bYDQxxVk;j}z6oYXuPT5`^^Qf_PW$aOKw!>zAJG_;4|
z1o*J{%Ki@8!x?Z9Y8C||v541Qe1y|ik(xe$WQ*EpN<{*&=deoplMv79dZ?{v>Z*LP
z0dBRoVPS#cNr^$@;6DsZ+$c5q&_*I0Z6g3-V>uubwk0NDyX+%+7|Y=MQ!f=3+}DjN
znBf4r<Tf<fu|)pZk4Cjf+x8+R7FITd-15T#_*UE!K$nzgtj{CrOmVgmL1l|`Idz;_
z%vy<Ko)##I$FbD`0<$)+LelzvxIYXD=h=H{T$nJrLwQ=8sBzRPEeX7M?5rhO5UV>i
zgYHBpf?tU@i)&6`*wWy@4rS&z-!m*oXaH+kNEszn%Fa!p-%E9N=%qAu5<xRijCb87
z47DvSw4o6)@pDhwG}I+JXkXBlFchV<v}cVFS2ae9TrRYRochp8k{|-9ASo9vg~Bfr
zt#vDhwY>!EhZZ=H60}&nf+Bmm#i9yS@L8wn4WAT0v=YlOrf3)KHHxTk1;GYsdfwAX
z?`Ui2V^yK7#6I@>+oP7iH;NVB5)lCiuum7$x1B{Zj?k6*I-jY{ooJe71TampYu0F2
zEE&E#TaCo&DhCv_Ehn>JOaV<zT97AGlVe=zcG)sXQDhl0_TAa)==($h(WlsIOaaYe
zYAcz=pti_CPK8Jnsb3kLpU8|u`m5CZ?6InQc9ohhrjk1#R=y!M4<g;w6H-EBo2{M^
zpbm(aB_;_FMUVr_nSr@<N4|`um#-Ww8j;v=AB{8U#HyBl@R0X5S+Z|fxj<R*e
zonO~n?2fEw?2+}P^dh^{3P#md1*6GZW38(SS_`N{v5P|Q0(l2wizH0lF=AIG2yBH`
z%%Kod%#|<Nb4Elzjp07|C8S_5n^Ul1s=6j?2x%PGtY$JxUn?ap&sp2(4{KJ<j>qfz
ztQc7pqe;eq1O)Jr#?WW)fv_X4+QQ=2*2%8s9|TlTcSXX{3|75q95Sd=W8TE7_NC|S
z_aMNV1nqNN#~E+%X`Ejh8*?SlQn3m#2UCa`sPS~?6CYi4fTq-q6amLJ;>x;VgE)>|
zOv0$dNg4v05<?raP#Qu~Z-w6ls#&7#c97y&l$E`ZuWCr4y+5VKwr)vW@T=dZExi~7
z19F4W$_HAYYwTd;0nd{|UF|LUk_)L6NAD|0K?_UKX+l!Tq9cB=Xd|c6cIeth=c#SQ
zl5u{VFtjFdT+QsD1j`LWAhf<4sB;9Of>FOhXP}TIENgX3j=Qm{=*&I=H%&H)g&}#c
zR>~L{RMkcXvV67^ZeIZvC+$efB7!yHlVMe0w=-V_FJoX=O#BvmQ%s&MT?w@2i@j_U
z)UXJ1bAc4O)G&-oY-OJFhyk%HBD!6~Bx?r3S?no14VqPAIKC5UtE`kj7TEb8x75KJ
ze?#k>FwZ=})XmL42B$aFr~}Ce5{@rLH^T!P#Ser&aAO0H*dsLUW)EJDzT=g`p6r*~
z`1w<;D;q~WlThMHVb5Ww_QYpII&FG;mfd&G=(Oq)XYDPQ7k#dr3e9Eq7Aguwv>*DH
zoz|4k=imE5?<x<+G<{5)(}tJn#pd|4{I$Yc@qPI%@#j_(-I~pR#2<3+b1m`b);Y7o
zFr0ht+%;y-+;eBoJ(uS>bJxtCyCx)SMf(b~Y{mKJl;{+*@Ra%HATw*ls_yRn&D&S4
zT-nn%5T4)Dr~k{_2L_g{xFGEA;m?wuRp)hggsa=TS9SD<%lgB`tNQvnRt$7s6fRlT
z-_E-w2i2b06Lzf7bGU5az_5MEl5kG<;yEk(maQ1*U);W8j#`=%w=~cb4lL~myO*u#
z3K#b*U*5ig22A`j-PD@t)2Azyc3C-n<lVC|)6Mu=-UqcA<2B{-(~Qa0@G@^|R7W+V
zCu;MBaiisH>y=w?jBj$v&KdrWGtme0c}`D9AJ69}PgH69Cs$`H@|RZ+P@<9cDA7Q6
zN`FkQ(U#yZuXa*m0!`KB_ZqKk`zJTSmf$b{X7D^?#takPTbCb~B<%Z~iGE#|_a@Ow
zU4HUZ<=H>EN%l2=d38&D-kV~gFV^S(_t}$`Z~x?`*dqMp-`qF9<*kPtdf4Gd92vD9
z*EVnd+gB}K+|l1}7It@cT+rSfo_EneN7&!dyQ*Ww;ttc+v%G!Tim;=vucyzP(b2!E
zdmvoVGZ6N5tnBOPhpZx^Ifb0|aA4pfb6Q8=@@4(~%X(IXOFC98>sVq=UD?ssKA;TM
zBe8thzySHD^o0GZ7B3CYUj`SzM@yFVbu1p}>AR@%W@TTGg>1e`bgWs{KhST^7F&e_
zJw0J}d*1~emIIfx577BVD+Nc`zp{NX%+hiGKxkoDy^K+ux{B2K;qs2<YM){Btm>oG
zd8_&_G7DD>FuGMMfhp|2sDGeidAPW}yL+@0IWT*B-!eFO)r$7j?aR9Dpck%y$Cpv5
zqod0l*VohEKW9mYy0ffG{q`kudR9=$j?gu2+LBRPY|t_|JFaKN3WhEe38w>)06cZ{
zRiSQR*>b?^Sv4@W@cFCy!Q}Bh{R0xTRV(^B+7~aiz(q@z&=&HyBBYFI?d$34SP`yV
z29g#Yd}>V3gak3z5CKV4wF(K`8<L{$D1{dGk4c`{u?AfrDp`!qThp;PRts@Q392C3
zs^u_^iQ)%P1?-lbNW6LbMa$3Y>0Y+j343=>&q^cWuV`N$(_Dqlg!m|di^86j3`yPE
zVa5n%Ocs(Q9sP^@maT-LfVD!i*7ha4zSdY5FJ0EXBuw~Cg%U)l`%!iq?OWQ&qN%%Q
zaaVN@73Nw3{q-`uuxAyG_bf&anzs+MBVA5_7Wb@1G9*5y^}#nitNO#93s-bV62^!P
z`fzavTGPy5wZd_U>MvWqvb#gLbfUBzs<k5za5*D~$(A^YScnu3EIWT0&Gy0lt0{ew
z6zS6T{_wmG@Ymk~6y%=P*E7(wxTia&m~arc8B@QXv2+ZWwvK*uy%XpdNwnO%N?n?h
zV<;-}Ioj-neVQC3rB-I+)+)VfNTXyLlilwo8#~ScbcUUJNF^+Oe*1EXrdp`Hv?3Ib
zs8VojAE$H-T-ejsCBaz&-c6FOmZIHB<_cG@S`gdMV=}bxApqx}53ZdS8XeHvE%NMa
z=!Bipah{-BT*(~OmhIh0^OB1s!7%0pRxC%~R_DT0FsbGGrA&@6)ak2wP>CID7I$<k
zp{JA4+RK*qtPGi_rE<tRu6<?udCR(&4J@<L(+}9o7B7=%8nenj#XRNxAoa!6H1D6&
zKl7)geq}z+7q1+VzSX<bJ2f~swU>D^Jz^#Vdj<D;&jwj@bJ}=I{9k$<=|lVv`H%Z^
zf|F9urLXs2O6`%(rf>64Oi%XLm^1vNgI@;EoBM)`Q;(X@1{bAg`YXKUK{55OsW$Vn
z_rJ|$!6Ng5mq}ff`d_Kp=3MVc?<3~k^e4RI{Q2JR;`v=u{}TTHIABWM&zREXo@r@q
zFhf^gW6bw|o8Egbe%+rv&pPusN*Xit>?||%(8<PZUTw@FpE5%e9yCMO|J;~$Q@x>o
zZ1IL(yudRLZSc%lcY5XseLL9?o9ABe;78B-^+CsYwuSBGcg{VXYs|jUykXu?@cKMn
z9`F5f=Iz%$+<g5*H7~3>>w&T@X113vj4wNTL=k9|tNZT9_>Q-Sn>Ww9fHx16=RVuE
zY39Ovn>&tay<z9ha``Jy9WZNs?_JG1mu@-kC)a+l{N8Q1{{GTS?r8q%yeC#oJmU-H
z>!00z-;P6m-)uJg@S?#-zggb<#REInOeAgU@BMktH_N3j{4u-eSHEjE+fSeP+{AB|
zFaFTPy>EPi^qN^myz|bd%1?a$f&9YTlpfk});~Q}{`b0r-@4#mNSkS^xA{+%-_%;1
zc6~4D4I3{1%1z%We`~K#Uwi5qq)!XZKJL_Sl<%K;<!8@+E9sW5`wsuzljTXze6s8I
zNqT?NpErN<$?{46_~kQ}{O-5S=BD=_`H^`~mQOwKU%qg`)1>d*a^!D*_Vx0!8{YZI
zUH?vc<&|xZUH$d)ni=2vRr@DNm+qdrSIgJS?>l?`gtLc856%C@4_^FQ`RiRjdhFwi
zNpGKfMAKDYD}Quw^AGk}K>CVrf9Qc@zgE6%UQO%H14wV!Z~yPV_(b`8cYp3X#Rk$Z
z9Y1^d$DSyE^VvfdT>0zYkpAMv3!*2=Ewi3|{J5t{U-OHrw*72d`Jqi~wjO&o>BjF&
z`}D?b<qzz${l38w(swRC<A)2jl@D3}<jnLHq<36CulSS4%lSFen;u(Eddt*RCoFip
zeCD(xzy7Valb+jnOxq2QmH%P==iBx>O7CB6tM?x(zx>kV=nJ9hU%3CsqOX>3`^~Z6
zzBEI6!^cwI)<?@%zH-h#UHS80)BpR=-amY_{NhRZ(zm{$^d%pjddVZ@+4nSVU353;
zZC`)%;U9dZeCM}U&7R3OC7KNr4r-bAm9oF>`mYv0OnS$jOE0|X;qo5uUjM*5SCO83
z{IcbB50`&%*ewem`zO*{=iM0gK2&ab^5knSny>ehK7Zv?50+;>vh%TjJec&#^Nzmr
z=m*OS>xWleIF0n8!#}Zc)0fK|jy(48hdk1yJI;J_{>$a)rH}o`DL?rY^=GcWxc`Cj
z6Q7yx*M39kd#`-YGxwJd`12h%{ozZb&DTypaQ^+}e{HIJ_a2{7`m(z|u;sq;+%HU8
z)b~-P7j|9SbYJ<m!{?my$BRj~+_2%y_uX4AzirP?+`g1_>7tju`0IPhcmMXv%Rc#b
zr4QWap+)zU-<Ey&vv(XzI{f`PgO6=3|69vvW_t(d{VNNfIeKgPEzzS_Uo@HY(1~~5
zeNMUji9da9&(I^?(sFh7@Gq6~$Dh3LH$VL)=|3EM&D6Wg%Q~(+<F`+fE<Jt91%LRD
z^4fLhjDOPuq!%3=Ui8ermtWlXk%6_hksg}$qx-ggvHWi{4y^M&MS5%B?elNEvwZi;
ze|yiC50ExD-|l_*j`F|V^^1KzaG}yi%=_iQzm>oJ=93Qn@DkO3-|}()>kH-YzH7e?
zUp$@k_Tgv$@%Yb|Px{(hZWz~0y3~2{x88bt`P+YJ?EBz>q!&H#(naCt%5VO{PiM`Y
zK{`C|n)%~yE8lv^`ftCSA#J|a+5N{`%eQx(((v=&?qEC@p77ys-%@_;`UC!{hTG<h
zdGGT-z3X4gg-;*2xb17Cw@zqz|L|wZGp_l;+Ra;)_TPH$6`RXX9QNhQ4!)K2&{G%u
zuij6WkDOS#<~yHMx?|x7{&7?Jdp|nk)_?sF>6Xb$o?AFvetFg@2Veglz5mIjTl+p$
zo_^*3t?Nvnsrugk|0v2-hLYxJAY^W!PBx7iM1xET6)F)56>&3W9vh^h(wwN2=x`7!
zWK2@%ri^i~F%g~rK9|p0-}PU=tfhP3z3y|LJ)M2_@SJT$*z==|-nFa8_zJabsPi_*
zjM3-H53IdNMJ=m*zhw*7@F48Z(irM~N_SC_7Ndt`Jk`Uf`x>XG*)HXA%N4WyDg6^2
z@{4COx-);G<SFXHlj)QA1sT2gv=F~FHG5cYZ~>c(b(DV}_c%J)VUs`i2BX)m(5nwZ
zD)Hyi#1CT4$}hN87K`4eaEM<^7#=)5FEIhNPK%!Sww;5uMA@gb8|dMal2fe5Sm*Lp
zScKe038L3-&OV7X>yxhEzWeBTys%&NYDSxIkIJW@y;rP-*nG_AFE?LyOGB4mc{KAC
zcj5Y(@_k_UQ#3K!OQbgjYtRa9P)SE+`~KKH+J|+nNs!s37wB5!{s+tC8Gdwy`)Ay*
zFLTgw>g~k!J$J|YhnZ-?>AN=_a~M74)tghVkfY!#N4Zd}Wm+|+t<OgMrk2@prVMX%
zQ5U9ASmG<q=W<x<Mk`6#=OWbF$?+TbiTj@z-+;||DDUDIx6uNu)r#Lc$>pP^TLVSs
zU%=X^@J{W-*Jzmzx3I|;YjI8D_1D)Z^!z(}{Z&}A&N!^hDnMJ+=E-go!n(V1sdj83
z^5*siw0-HodgkKyM~l$SwbttMQn8M*>-??z2HiESMlHS!pFNN(^%jMm5aQ~ZV9olq
zN1^>KlHc|)N^u$1y1yr^eDw}h_Qp<2;=>x2&Fu;;MstWSixX?xaev3RZ>L2GihA-!
zV98^wbIDSBg;JzicBxk-0BdXgniaoFk=wRpPS!q#Z(5$6_a15Kw_Yn+jy1ddC0|$>
zYT0G4YB&Y!DCt}w<8pMZmX6rf(uVu@1(L_6Rv<4ZO)R6Zu85ub(xn1TeVy|;Hy&%}
z!0QelD$pP4MGxdpGJKn6(8@|Ac;(q6FvMDak^Pj*mB?7fwrz_d)~r%C{ksxbPw2nE
zHwo**2Wzd&s*u7h_Q54ht@wU8T}Umn3Z*=+_js0rwe@;&*O}EQf5|2L2MJiu>~xg#
zs75A}q<bfy##$})k6}$U5}o$(OYvT;*{a_;8Xu6u3qw8-Z$X5`y69sQyon3x1`|Q8
z1?gFWeg_p!oca(q1&mry#_f-RcYPv=l;b-lgL4bozGRO>$A}H_SnTUxI<f_gPBq&u
z@9jmBg$E}?S_|U)T(5sPFNFM+w{JdFv>=JtE!XBEKSJl1z)zanf_5u6&E{u$ldMaD
zQ$f5H?K&;wVn=%tlI`{*v}!9_9F#5B1YyKciF03R!&X$q*W(mD!HJBzYA*)Pt?1;{
zJ?~vc?8y~xy@%<@R^-P&a6K>Q9MO_5^OsI-MYe}Z6{NkLNqC34=<-%HH`G(mmBk|6
zXUnzI+*b5>=$hlw+;F1p)>VEGZ$p~fn|D_E1QU_VVx>W?4V~*#d(r+kguHq}a}pS}
zA##PS14RWBMZxQ2z_|^%c}n!zQlTXO>4BegWE(OmS$oq7g2}J^<U&YmL&DqGT3_KT
z88Sz-nJ#Zb0*Uk{7dTI@kBA<jxot?x`Ami9IX~i!)$n`}Z$}f;zq&{31QVH_o2G$U
zJ93|JdD{+_4{>}lr-e3bM=A&Cx^C}CvQm<0q>s0wEG@Z<4}6`;DIpvC>Bx4(y>}>j
z4l9V%QMueer?#V2vF0Ic-5}EL&la42ru`=536>#Z=hYq==x#^C7U$(3pb&CW+C~Ww
z??8J$o5t(YCyC)-uO@?92b$@q6!I`9j5s~-k~kQ3Ahpw{8jAm(C-hYY=7Dnu`ttD8
zT6euja+jvrT!`vGlJ5Eb6Q~Gsn~tF(q;()GL=*g@N65<gk8A1j4wUX3CE2RuOP=E2
z$)UL&=vL!Yw$7xZgvAuwFSOWClqtMG>+K|S!ld}YUt0Ainnx@;IiK$|S)X;GjyC*>
z5)}gvi_@pctG3q{gY!?MV;ESmkq#krX9Nw=kw4MU>->uzf4vC968<VW^(QJ&>gCAO
z2g!~5^s4CcpGdZ24JU&>Mt&7K_?zbbMEgWkE=|-sNA7li{*4yvM6-@v~DCBB;s
z_t2`HsH;dVocs3>x%dZFPaAe3x6Pg8VdPH^X71^tk9VR@_U`Um-u^^QWIV3_PSg`K
z6h6uC1c9HWk%hEQ#6NZBp@`AL<kd}a4Rm=Ya_x9CH^)1Ia4#6`pt+ss@A<?O?VJcg
z>GzcxAl`*s%royrpLHYV4T?<xwJ!Aejq{PHykMe0>~sfh*o8#@nij5_YDzW-)vJJW
z7uq0}XYi5bLq71WmxZV<v~S;NT%^}Y(r<#pCpxtYdE3Yq&hrT)v^V1g)ru~(`w9K@
zI^TI>AZkN1&Fw<LrMrr%z=??a_3%9{#z9p_lx1}Ne8`5kyS~t>9CS!<PH`T165JW<
zdTB!r+W9ap?H=t)NbC=3qmOftSq}HfiC-q<6#BXZL~#(`Tao?YEPrx?^zE;7DhEB6
zSzj{=P7ybJBxgef2gU5$YyEqI5m`WHO@?j`l4x0Bxj{F8oDhCyfEME-foQI_`X58`
zO-S>6P~#$Fi4(n#&V>+h%Y6rELoQnXruKs#3LzY}-yflmbCKJr%X9lD93b@yhQ85}
zT(qs#qrdX32jTsljq9I_)NgrRnZ<XUy#B*uE>v*QlSgISIOkjl_1Ek{n#)DzLC$=u
z1e{1GYukQWtQ&n6p1UQ*JA^bn6WB+qb|d!Fk=I9jE|JnxMn-AFZe$TxvivV~iSRXe
zKM|a}QOVvPxqjeFw3YPY_ScPOyRFLkN;{IapGEl~tsDK6YkBO0qDiglWIm|qMuUm^
zr-#q7h|$r{!!)-W<vM(H7U1_FFOFu3fOro&AmZr%ffYem_BRjHsy&Fia`ezJb&aUI
zQiJ>79`x8q(%A#95Lb+4asStYIE~+%hDO5)xjphDbYu@Y;ku??4WbD%Vyz^k^`P^7
z6IrKy;)#sw3cu;{9%LVu_)ufWmV^%>{WP}+{j|7yjq-^lk^@6ULA)0&v>1(cU?mb0
z*9YMKzZYpzi9hq{Si=7oNz;bC$W=wfyOqzKsFPI~ppW+=8&MzkS0g?Iu{w4-MD-#i
zy$M9|1Xps}LF4I=){7=A=+*RP#gJ=u{ryRo_oCi<LoILmJb5wYr3iHQqC!12qn&gB
znc8&b4=vV*t}Wev-UZH)K30$L_1}l2GBS`Q9Zl}Fzat7peJI;EbfK@$1wwZ4j|4dP
zq0*Wu1zEr%GF8oR`S+oncb_U>LviG~ss?^Y>qFnP+?^eK0tl0LPY3AoKBO*5iLah;
zhM1Y2hOfUql(y@MoukiXqCZtb3dH--;(%FJtA5)P3Za{E|KE?+@2q!i;qxO7reA2K
z4f~OK@Y9z^=wO2F#*f>7KiboqpYSC20@<2(oJ&XcBUi=My+XPP1pnQfW;(SWZ9F@L
z%An)OMtN~*sOU#)kJh^!%8e(Rbh^c$yC2Qn9Uv0ybBU<jRxb(S188Nkor^8MHE~8>
zU<RlSAR&!KWo6Vwa=Y`FPTFt))!q;gaGelL-rr-zrH>CF$wTj^wonO#q<D)oL=B)Q
zZtA&0@AE{A&bx__Hh^+PDPcjqM3S7fWgb)vAcf6K{wSWiOa`BM*-CQ<5dV=bR)%*R
z2_R#;SqjhhZ*o;e1X|Z>`zc}FO6Bmct`~aKi2kTLAKENcOX+W)Xmre@3Xw4#OP{?d
zqf~~Zzb!dXjQ;wLeSUD_*yoWKqid-j7TvthH%GcR2;tAKY%Q4YZc~gB?j9nM)EjE+
zobEl9{soB8T6XtGa6V<nF<+|sEEoNL^u%H5Vw|3|_Z%ysZ`6&_D!ajNcs-!PJv+{y
zO@(|=o4WP}*1y{xujgY^0mmvdI&GNs1Cf=5e;cXamnAL?FT$FgF}rTGfjTy!JlUd^
zna{rweN5L=FAZhQ1s-9YG%BIRUr)_<njzNZf;D@!hP}uaYQ=96Ga+rP)0E9sr9M*)
zDK=e(d{|rmHusUOqbfZ0BVHCW^KF+j1GP^S$51m}`vTVN`$NHcwbYTC)UPGh44?H}
z$@n9+JM+g5J7uiJ6K*bYsG;tBnkT{chnfFciP`#npjMiSW?Xp3=wGYauT@i9M_+86
z8_&#_!*}1vs-m99vqdA0V69uM>sMDvJ#C%l`(riMY~9rX!xhw%?0{LbreLkss&RE*
z1y$?vw0H>{&rhv~Z=MY(qkP{_E9XyV=C5lHzO62$j7q$grJct*Y5MkwawSx=LEOQG
z`>|#ls?PO#M?H}WT)THU*1$p&@O)k?Rp<LA5rzxQzN=Y8HQahX%4uTeize*@aRro`
zwutH0S6C;p7ylT_r(mIv|L!=fb4Sh14&+fpZB6bZC#+f7Zda~SRQ`{Q%~tvhAF?p<
zB&o^(NHJZ+@P4r(>r6_1;cl_+zs&sX#pb5%FQ~}X6&^BQu-4^!dI~+G>R4tUTQacD
zT{ruzRvHzq>-ksb0`vLjf-%P*P=0F)i<g{Ww1?q^Gs)DxIa7XI+R13q!h4IZQ8y!G
z@}kukeM&*@Xf!43{cMT2IHTJ>{g&~d9PSnmdFL|oJEJGN{{|xeo?q3r8<_c@*tgQT
zH;|9Gf8yj)X8sl$He&DywV7XvUu}Z5uE~6j2hUK;+U)L+&3Hb>3av<*nTeih(dS-x
zV6Dslx!pAft#3DQeJ+Z%wU1F%eI7dKHnsj~GM;ZGHBNl!UVwI%d~AzA%>1m$WBuee
zXuIeHL!|~hU(&rF+8FT;6-!yev9nmStB$^$Qi>uqRh(AJFuE*N*uM;E8!5;+7c%oB
z`*h*c6{ta7p5$}HI+yRTz@thO+JngI8CbLbevtTr=MR7Fw^Zii@gb{l$EHai(1due
z{vXa*cdr)8QLaI~q_6fL8LTUeWTJL{L_KDML44JCKGNOszRIN*IsVH0*&K*<)Y*Wm
z5uZ?8rs<1I1lHEyjQQ@>p@rf_v_L<eZ&Xw}&CL0X(?5OY!W3ryk@UE?;tL9+uMgGR
zW35ZAO=j1l2;odgkZC~zFE&hi$RAAHS#H7))-CA%;DL?=+J-3XUGkbvY(ZI3L`k`~
zFTrn~sRis7Bo}*P?|J$>@jWh{O)qFgPkgQ9bw@)8@u_A~VBL!J{1&CVjk=OG7PgX*
z)Qa4d7JIb_o+9qFn`r>M6=f{^CHF({09o}ky^CJZhE(6(p1)~=KlyrOSQ)I_(1I(y
zH~R-22_uKFK{~Mwjb7Lyw3|PIw3D*e26h|T==mn6k3WRmC`~od3)&GOGgWu_um@S0
zxUZD9YDbnwk_1?^J88c;YYimf@xFIwLBVfl;<j>TEB&<{P1qE+xem{-Qb$#4=>;9g
z`|*1NW6`7J1)9H+w(39*Pus)ppA96G!uJ=`i5;kM+V<z~{C&xei75^A*A7IeSa-aY
zG$jnyPU)c+{6tqz$)_|7N08<-WXou)pJ<h2(Jbkb-NeZjqdGbfx0kXwy}H2@MC!e(
z(}4XG<tA9l76`i$@n1JtfJ`TPm)E}g4#$CbJea8q)}831^H%x9$zEj0sPO?v>O>2+
zx4G+zoFOfRw%5^LJ5lZPD?^$?=ZW%<ZbS5fE|l}l%1&^ZDH%I=?@ijO3-w*7N?6M8
zNs5LpyhbN>p_MnqmhYSpM9lCeZGnx)x1W+{%;$3>qc{J;!GavbKEM@HWd#$T?$nxq
zH3tn3ikiBKc$1>JUGk8G$B&mc3i<hmkzOSO$AHa2{q9m1<XMqq=~<;yAj3tGyHC2-
zor@%eH;T%EH5b*>^77!KOKR4Hwb6-Oly-0QTm2kUGB{AIhW^S$P7%>1vxkBR`$Y=;
zAk&S`ZPKvq^GP5MfBgQPw(3Tn7alhV4hIq@cLRhWsT)QAsb)1cnUJN(YBsRD(e&;@
z0Zrd%av&@9H@%<-<!7<%UJZwmDbWVav=tuDwXTwu^tncUTlq)=l6nw5Fhf8Xt`hp|
z-p&Gc4@$E9{Ns;r6zR18uNcVmqV<2SZm$?UPey-A#Od!vzLjyO75|12pIh!IKoTB5
zh3<DbF~OPC)=^;7UwhHeou{9*y%GrD?)pJ`K_A+)tKLbo=PY3zYTiv-^`W2Y@3-%r
zc%3YLJXHmf`jAI*^|sb-H)7?}HT=NtLz?HWO)oinm7s$varyV7rE8VTQw6<=Ctg}p
z0N>B<#M=g}67(g46Zi5%Qa`F94WsrA2a|p4S77^oq_A7MYl*}uQp{&UDZO9-)$j4}
z|KxX>IQ}eXl(rf`lb2Sgw+aQ3S%dR>>BIpv!PE6{;$RSQZu!Vh`s)DFX;)K;Vnvg9
z+XeW?e<$HrzoDD3VTTipC`du2i99qcAAkd2a)F4y0D4jD;o#1{@T&14WY`qKYNy3e
zWv~vmOk#sjhYHM%sf3^N{({1jxzMI_7Y0`N!iHBWaJAhZ(&d~%&)W(<Mr*@vKW(_$
zuMMGA{;+f?8-6cX1C8`05W6e@5~^GfHV*~I1&&bey%K~<<YALx23)s8pxj{vS@Les
z{PPX0_3VK`?a2_cD+K;HbijfqRv>5@4r&wkg6GI4=ziz`GGsZd?7srv@6Ut%HqjtB
zrv(DyZSk$x3c_^{<0V2G<WCsDq)F;fi~}s*-8%uEP1fKLmJ72AHp6@S*C5nZ4`zOf
z5b9n4cjjJ%4XF(<%cK%+>j;3rWEwQR5#(#M!DYincy(3-<kr51`3_u2{JkGmELaUb
zy~WTIG!ML@WZ~#yFQ{=E1~p|5kXo}Io=-1=*R!rcN<ls>Gr&=TU<rX|H^FxoWk@Kx
z0-6T^(yP26{q7}LWn2TbI=|qS_)IWxAAv*H6v4UnAsqDj4QJ9!Kw7F5a<}Y-H6QEX
zuD=#6UQ_}fLp;EI&mw>Ynb0FV2WFLhg+z54?B*YZcoQ3V^k*}8`+S0hwi%$&77Q(v
zHE;{w!?Be@V2M7!jK*3pUDF7S2{BN$a49SeY=b6K11Kui0KxAwfPJ<Eq;rj+Z{A&)
z$+iHMY0JS+@&Neh^T9xb1*D|;!2I@J(BHZq#O<r$LBl6_Y_$%K+LVFt(qyQPPlri&
zdSRc358TT40~_Kzgq%19sbS`Dyfzz@?;M1FsszH%aX~K69*m1OLUG+nSbDDt@@>LF
z@|_3p%S{K#O$kt7Rse4cH-N#@XdFq?2Orj_fWnq$7_GsvIyoaSKduy<%Q!GiX8<~T
zSn#a%HN5$~6k-M9AkReyRD_=4ryBa;yyR7QDB}q#&l6#DOg?yOsDh}mBe>p;0*BTG
zpk8tjPS4m1dZ(M9|7$R`#a)7?7JrCWzXa#I9KgzICA=D)3i?;l!9MvIxVWx^a7ztH
zlzItdvk-)<FM+|6+Mp&d7pCB;>o&o|u#960n;%5M$<_&w{c$l2p1lK3`mT^Tg9{OH
zcOX6b7gX-v3FX4QAahw02DW*_(}RbhLB|SoEhj=iun!pTQh-&5a>4PFIB4i=fW>w<
z*x~X4Htul(5urR#95@2g?P@@N@-?vJH-hvvU!cRi5Q2uJ@lMWJm?xhF7mp}FQRyQ{
znZ5_2nvTNxx?ou5Y6SerIp8rl4*Jxb0Y>DZ!{r{><!^yQ?6q*I!4GbsORzp}6s81*
zfx2EJ#AsiG2Inx4&S(X}uWLYRl@jb@C4o6B7Q`iDK&<T(9Al-z7kV3LMTvpgOm{eN
zTMBGSUcsB-Oc2-2hN@nE*y1J+KVSTUFAHCR@bm`|ET;;G{M<okjV4Tun+-cxKY)3+
z@*%bBG3=9*1jl>>P(E`Na`#?>iO3Ixx_^O^ZWuVK$AfnIWDu2+f={n4U?8Rdic+@0
zj^f*Jch!4nxxW$~#>7Fxy2CK*U?aGPap7?2E*SZ;3Lf8h2w$bt0lxv!KcC@{fgN-S
zWPpOL8kp>*U^BfMjt*slTTUM=jr|G_S!!Sx_6zt+q+odAB&ho_57s_Q29r6Fu=2eS
z>{!<h({hqQbJ26?elQyhZSO%<-fa*;VqkIVJuDh>2hUJ`2$pt*qC30cxKk5we*z?I
zHHCuD8Sua^3*5`gp>o1Jc+#T`VextJI>iG5^*_U)WfByz`r%QxDl~Ln0kn^Vibh8~
z6<Yv`UtYkiCHUNz)GLs(I~HExVV;6=I&5Qk!{^C&!TrHh@HD#tGb9zEK0_IXn@1t|
z%U=l28HFG2$6(U^5zt{dLx7VMj0VxLRA(~S*lU8~%s?>6?!ebmDnvRu!38`#Q>QGz
zzg8dAzRrL*%Ijf?%?fzuTn1_-FM&EX3dwL21djax^M)jlJ-!(ZNLE4SK7Vkw*#ZuG
z*$}^r4~&dg!Tg#G(CjIIX--yPsrCZ`RPMvPr?26L#!3*(NQRClxQ`l?g~%g6K%Vvh
z(TObFuPcM$`y`OL9S_fLR)eagFr*Ky1BuTia5kp`629cYL+NZNzIhG=kM08%V`-2F
zWAK^Y4c{gQ!gP^Ca8WNDf^r(+^Qa;?EO`N*!OKCQ?=NIh*WvI{L)fZ#4-5;;LHRcc
zwdR+h|IG!MVh|28tM5Rvi4{yoPk^O$0ZL`~z@;G&-Zj1e%6b6D(?|f{WCsXKdjwB&
zD`2OwKFt3!6)w2GhFg=?K(6izm{jix?2V<cLtz*`7QcnIK0WX{)CdWOK0#fMIwW6u
z4IZW+;K=tv=>9wnvQ`tYY33#{cC&)2>;Z6!DS}5TmN0cg7tGaJ2Q~#kpfK7Ftsnbf
zp;s{+k6r<S>_VVx!@=oj6Qqq6L9AdNcv+qVhm@!A-su|XxOzg7#8DV5zYhv0zQXf&
zS&#ucq3P)qIGME=n$KFp$xk6LMQRzGn<)z3c5%R`Far|LxWnjZ4(#2?g*tri?yQ>z
zp;?(waA^e8@5w`t(`$$;TnV4<?S=Gv&!N0@Do6$^!*P@4uxxKI#Fu@Ck20Cyu>S$*
zC|(5#t5O&h*$UtK|3JhVM`#LM2JIjGVI=)Na5<Hrvf>@6YTJO8>;{-q_ZH5L2*aPP
zM?rP&C)l0t4?E(+V9&x*P&BTG+@g;lGV3DDc76#*E*t_mb8A4mIN&282K~<^V5DRK
zmXpf(mji8<rO>e78tfwyAV!l5@1$RXjcEdWGa+H8UlDxL5r+mBeNdj;0I4%?fb6nO
zVAfX)b!RTa^*y;@7&r`jCyhY!>BkVfa3yG^ECl=5dN6K#0KRfsP~4gTJEtT=yyg?Q
zUpp0!2<U_D({AuNe;3YgzXU^-D?v8q8F>0`h0Eo#pqp3^^_z|1+sV~n|8pJuz4jIM
zf3N~i`((&^bOwxn-2|oc_!;3WV=!|P1X;yE(BA9^!QWe;`T7Ug@<$iwz3nhptQZQ-
zLLhEf399o7L9DPGzL-CT&4qywu>JtZ2Cji+r{h4}CI}R_djf0OY*<f8!g;wUys{h&
z_X>VM^A}GjSe*}Y{T(o9kJ~^D1-7@8U~TLZ$o3L}<el{(-*6C)d~1L!akJo_!UZ^7
zwiJZA(qTiQ4D7gE49>m>!P{#Qh-GTP-GK<0zPA-*dj#P*9@8B6Hh|l+cEa<ahv575
zBV25-ff@J#mx9%a;CJ%|xOO>$cK8|aeR&@oH1@$Jc?%o^)CE=G0VDm!z-MLvY!?=e
zuKf-oU3|LuAO*a(0HD0#qz-;zUEcJYz^~RjOHZv~wBMX=ZTzY$v*e5xqZj&qUx{B~
zUf+=whOcY{>>oA!7ln-yex0ilIl&#*L#WACb)k>a8REY`qnKUNedhdR=W!iPjIGt#
z>oVVm_mgq(5)+H$POV;ZoxCzAnw`yyDf)_tJxq{MA&OR#E;ly5jif7*?Ik46@zM?O
zb{$uHEQV=ufiIm+m7(YTqP2n!k5H-6rmBZe{gD6a9SQ7OWBj+>IL#oEk5^ZmsPnT8
z*CY@tH2>UR`-_V#>pxwcX6-`Susn3GbaGLpU6A;h{ZV9qk5ik}cP^Ut%YMbKsxabY
zfK+u_9TyEp3@u`ng_4cG8WbGxYQD|e7MmS|*2LQcx0xH?a8Z1<rp1q2QG{P#QL#=A
z7dd+RS>CyFi4Y4OI%fKui$=JkF|(gX5QCdtm0})Ye^*tV*XHODH!G_(I&X22h*MPX
z@`*>uIn{qt?Gm_XYPPE4uDut?ofeW6e6e^pqGLxGmt{njsvpbE4&kC1{WY13-bIsa
z<@=AX_;OLI@xJ!&)huFX#O=42&v21`?ClPzIV{q1=UL*VD;KTRXf*C#5J`4~hiMHR
z<sxeLG!zybO1PCA|7n4v3*>%ExL>WiNPgJI@6Wd2B5T#vI)j~8hzFU6)r0nM(KW5W
z65rNHa$eoYLL&n%3V(fPgWmBF;$zr>^J_M7(OLc<X#!_h#Krov(OVD~#ofF2eKg`C
zp>@E`>5LZU`X_s5?hhi+ou`In>Ri;@y5O?XW){)l)nvO-iHr6Nx**S&7s+!62flq>
zjCW5S3ORlo^d-JEE*Q8rAD2IMe0GBDS~9BcbA``LE=m^`b@g2pN{CGSaVJ0$&$dg-
zf@7vT5qnj2?x%`!(Tj&^25ts^gj9yQ@ZU*XwEg6xCcbrng!-rLBhGwWwDotjrFKIk
zLC-k!RB(iY_$?yVux<sCJ&7?^g}*rHu+g^CuB|a-$^F%<?)Gp{g!0ZgzbD6&cAo?s
zA9v#2s+Dm%ZIv$MU}E#~FRdITHK**^tXc77^Sx=WmA`Y4<95Zn`iTL=!sU|N?=*5y
z$dRRItR-W~xvWS08$WZ9MX<Df<XuxzQDsn8_#+3+xw6GRVVM_s>7G&DKqX#Xc$9D5
zb#OhQ9BgAPSjIuzLzC7B*<B<|U|yGAF$bNVc;oZ8QYWH<$a{XXh=bH5#ZUy^EorQ-
z?N)rvL20RHUX?|;6Y`2HYd%vP<iXzaGkabvF{NQN{way`bIS#m$3>ENmtAvzn#n<1
zZpGG@HU^RF?8<L`e!)RjT4LEnji*Ro!)tq$(mCkYKF`igl7XaHjAe216Kr2QI#Xap
zEb&?X`O3|Bw@n}+L^b2GCo%fw(g(>D4iefkx9Qu#C_-V6e#7L49Mn-X%P8Q@aw21s
zS%}<y4qB0WNU235j?kA)kve{tgA(22ZMOahBZcbSGr!&DpnC?~HHDgCWPtJNH1A{%
zdfcuQd}_BpDf7B?`KDVOWNNziR6|)Txn!ZSuhvbxTR6*`^+4Q&IB|db2jd$Yv~=Nq
ziu){<e80xW?mAwr@y%Qwlp=YQq&|zdNn*{p@A#5ye~?t2ZA&~&#Jh{<*?ZR3vq=BA
zokM4_F4r;lKD6KzdD5!0%?<0cv!S_LIf3NKbGP-cU>(w8JYQp0Ao<RI-QJ&ASAP)N
zUvf2yK$eY$NAUO0yKRtJui;4s@%=n89jC`3*M84vXB?rCr^eTXwehi!55N7iB@XN;
zU)hJ#zpnh5YT=FZq~vU!J@Poe%U7-Gd2u9`oL06yJ{XtBe0tVu|NSg7<;|i^vvGMj
znYey3`VdEU#cW8ZyN6eQL#A5Tr$iC)b|H0d9&k{4M|YlTMmX^$NpW5CBMzcl3$I$g
zuqDGbJfER~>uZBmpPAn;PhzEqRQzLHpMGoS-(4USOBT`5A{My573LoceR<!KY%YAC
zwkiYfwq{0o4J|rGitTz^vLTCu9t`y_T)#esG}_Ua=$p+!+am00j}-^tz13ppo?H%+
zFN;<hNp&Hjx^MYL7jV$46T;tCR5=oh7JZ*}@GS=&TzFt1e_;@5+idA+hgY*})SJEs
z&J86rmA7^#;N4oOS7deNt7y`4iO$oBHTZf{=Ui1UjUr5+sZG0H$3f4`PdND>@h7O!
z)5Z??`bxhRaq0b6U-C>}HRXV>zaY($7?0UuL`t=Jd}143y{oI-8tEBD+Pw%@n9Sjz
ztjG0x>s}j^f20gw-t6Nb-CuXsPEC#?SDQ75yAI*<k4@3)|9F_(y#G(HJB{0Gh^a#p
zCz{+k>4sXG02jS)uoAAt(F#?0+oI;<{^rr;nBhO!(WKD)T8n(#A3YOIReS7og1EXX
zpdn!v?hi*3_i22OAkI|KRuA#&;3G4k%1E|9v8~cXrAMBN>}T)LN_~Hjc-}fG&QX<%
z4$q1?w#>nvI1<IJms!O{RnJTPW`?lH;n$YNBDjA&K1?Ialt|Jmc=A@|&0MtQzMIzL
zDN$r^@D#xyLoT{IdF`EmTPKO2<UjQ@O}R*Hp{~sJXkYTO-@6&#@oMCwn7kSz^9Uk9
z<IBXBBY5}Pf$x#oYJb8yov%+8-_aN7q)(Qu@g=PiJT)(QanZXeo7ZG229pXm2BvQc
z<f7{HtF8H8oFsms&{mZwE^=|bwzIR)kMP_6=FiS6T+|(19Vs~&Nq&w>zL}bg`~Q=R
znl3*MCwuH8l=boMxS-4fJ@Rz~A#ZNOnUlpu8b9y9j#Kg{E@e5aQYz#kPC%vl{X;mq
zVxyCVJHFp`eP8n<YgGg}J?Co5=ofrHdLM1DCfI}c6m|VvUMm+z6Ikoz3G60%Tq2e7
z`|xhb{}<&vHsWAY*1YKDW{O$a17M>a#%4HrxgDKJR=}j0YTu}zV6ml_dX3~lm4Mlm
z!9PiOH%~9~7l=r|&FuAE_K{-kUA1&^`Y<zY!XqSx)-hDjl*+EGp=1Wxp9F8u&E`>S
zh7K{*bfdI~dky7i^r9yDz@jm#%h32iOn)l}rOd9OYV6al|L||YyQ26<hUb@|r#voL
z<$R#nItsBz=J1c%0?#i)t>@;4+I*l&{kQ9@ewwzHXUoPrhI&H`y%!j$#{Yp@E#lkN
zx2}FH&AAMX|Bb2s5##N5swwNZoq<J9WX5ch7@EmY*5xY=o2#i9R^bN&vn6Ac#n3v2
z%6!XeYOA6?DP_dZ_mmr>);zxqJ>NLZJh+NNY2`1b7fbyQjUW04)#dqR=&ABQdJ0vP
z`{&(D7n{$>9xDx=Uxr>jl6U!SCB?s|^)Q*bV2lFKFGKG=e7MiPlIp(at68*Q!I)pX
zK8*7_jH&+Pp-_QJ%FbM1wBVlHm~AdYGZ`9nqG|E13To=aes7M0=orOo%{addtw@hs
zqFX`vDED7~xw3n#j(BwFUzEl3`v=?V?suG-SxyBJ@edVEri`V^n&+3H*7YSR-DT9`
z)WEA5a!O-Vm*<zE-HJ|=<;y5>8tpMu#Zz_WM~0z849zukklpv5nsd1LRdkl@m@V-9
zj$oQ}<;`GZDUSM1JZyMc{(orZzbIad$N6Pwl=8{I{1PfMBUC+Y$E-2iT!s!YG?%sG
zU0*R}7xf+;+>tfbu96rUKZ<Eu(*kl)G1ZZ`ss2#dlCd=NXy(5ti|3c2M*UaKcfF&&
zf5_vnt5h7bwdVO{XoZYzlFwU8X!wf{mHl5?@%;Y9lr26X_~9GMbn9-{s4xFZGyg?p
zczzjLF{@SVV-aQ7^z_!zAL3(vf#;W@QFooy=t4@{NIY@<_4)rp<LQ4;W*1y9lc8xh
zzBkJiQjr#uqe2^H#%yyLTE|dU$uT8^0*W}b!X{5tdM&Shd35Ms6z{*_a%S=2RLz$e
zad}Ox-Xm`ic&cZt7FayL4DDX<d)I}0O0d91S}lC>m|tt2Uxr$%)+lD=Q5SDX%uHsf
z{0|-a7uDtYJ;(U1@ba$BrTQ(}&R;wtJeFo2&HNXY;rV4K`-^&XCq?yY-rBdvZM<y&
zLx(Y)p@bWI4n;t>;<Dw6V_(dJSA73(i1)5=DPt&|YZ19;KS@o>u`)Fgoi~=BT!z*$
zl)ZJeV@wwH_JKv)3hnW}j7Nw5MUxoYct32Lr2cW^>zCBwy{ZNZUgJG1k7oXhvUq+O
zYTX=C)s5rkPiVedb!oiEv1aHHLuDqR$#b4lCi{zQEGCTiRy-Q-{|~Cm*k&@6J?CPr
z-ZSd!w4u_^`<IQ^0nhKhs0`09Ls_>tD{Y@pLboE__j^qrFJ^|u2QXA3S4}vTijG+6
zcil|+e`w~vDBgj@<;<hATpHFrq_#VMY(C>Vcg&VYhyF!#8Qb_k>^E2Am+8s76z4|o
z@=YVlvd69jhGzbYCh`38=-<qs>$j)}f8_=;CJc=CM+_bM7iBT@N)T>Vr=}+OCQ?6y
zyuIXD3S(}0FzX-Cn&%ZmX;#hTIhmIz?K{J<d%~BFnd&lhm@yqmyO$eDUA<HN%WMAE
zu^R>tUOE4NLm9?0i-F<}ifkY1hwkSosA<;N*Ye=!e?VX?BZBcsxy+js{AOY<9tP=U
z;de8F-K4}>s7>iwyu+LEevQSzIt-;*v8H=vqEOXf(<F=f|HdT@9cE15EnTwZGFmQb
zu91~A-W3A_<3q5iZfmfmUJ}|}+p{lMf^Y3ub>Yc~UKXY^R6abmOGZmav)xY27_Unf
z1M3*m+{Eb*;_jida^@8mPLF3$m!U&E+VK8F$s@dH`)PCU;o0NaXJ~vVV>>BVz2h<R
zT=ULQM`G$2#XI=8l`zzLQ{|dVPf)`3DSIt7{=4%qw2q<d%DV&E&rt1-FSqx<9lvI*
z89Kz!q)P_o?a$Htd6vYaBjah-WoUdD<F`Y&8ZwYZ*R}iM^E<~{81VcuRM*UMzh)--
zyg7UIK8Z!+g@NN}^y(ODof7``=quEGcu<KIHEk@-IEn%L<=K*arsqji{m8tia?^h!
zDTc;}V_O+vKkYX;h`q5T^>D88n5`~DGa1VMq8;5vp;6%*h98&z*PHVE@~FITgmfP2
zovd7TiYq&oDjaQr{W7$Bk+;%=JhVJsYeU4{@zO|QXnX{wtUytl%6xPq{anehYZJ$8
zSq#l&Xp~gii0x|>?7D5yJ=LPI($HmS9YfPJ{nkbopi?hK_nh_{?`>sxetGo9k7oHo
z^yci5<~Ggo{IYROkY0QwwiOS{*<n(IPN@*fLd*XfcQ7=Qq0VlhlHEn<o9xx*aEbrw
zm!WkGHQEpm9{dIgtdDjUxBG7l&d^~@XK4RS&3TI|m$g6Gvv%@$K{D`46o!NK=H~Cv
zaXQI#Y47B*+yc)lhSKa1qARu-9g*E@wBB|6I%ngkB)vL@R#=#PQZGRdzCGFzzG8gb
zn9I;1p6wc~po$XoLUNB;!M5@G!x1<*x6#;Eyu0Yn@lsT!bg|I2vuCW6ux4l`L!&;V
zt$p$ytw@s^RHVl*KwX|+o^2~Vb$1z3>({fEm&_ll0~v-6V>+YZN6J7Ml8AU^D<xYz
z_Qk++8-u?%?b)%p@#RSEt7vg&$(*t5=Hjp^y-bFh8dz(&RG{b`T{FI1<t-57X%Iu}
z7;0@}uUt@p+B=9Dp)<z^l`Mu1F|>_oa+PRq_w9pIWydcfYlg<hV*2}0$v%flbZ*A&
z!S`4G8=&$0GW4+d!FZ|?Wn^#O*>z{ULCWy_GW6wC$BomgP)F9Ltj3`6K?e?<!hRVV
zRqxfEQ-%8ZjkXS79UnR5GBiF8Q|sz)J=3evOG38#Ow)J;;xH_nUxte3xZ68aqqiPC
zY44pR#+y1r>lmu0>9H%n8tu!T^kUDNnPb$N=a->vHH*?`eL&aPQJpJ)2#!%*p5F_Y
zzIDkDclm(aKH3YF$*X4b`bZg`UxunlUuVDjfRaB6&k2@M8Kc1S%g`jP$&VM-AhS1z
z&N=6(jD0f>HN*L3XvN#zgPt{rt82;WN*NzI<T5n=BA<wuwb|F~ni^DZn=Gg(BAg9+
z_wfG;scqvW00cmf#F`JE0Ef?67ZLt1>V-4_y*B(Gq7%kG2h2mh5Wy#epV2<#cF@-K
z#00@(Hcs|#_+fm$iR;zXK@=0_7z^7&$_GyK2^?gomAbZyy2=V=51SK5lusOTkXd^8
z<Voift5sF)kDNU0c0dK6bE10enETj2_*|6ZNAUp>GByX6A6Q|dap=GbEe-7zS~hm-
zwzisTS~jb+)ehPnI<Q>hz#)z0t2ERUV6WIo=6H;gR(7^FC*AO~;{r-zj&8ieI+X2?
z9Y0`m?1YlY0k>lg%426@C<&f8V(+Ak&v8%^bG5}!urr5$C^Jv%pHLEZWF8;qo#*oZ
E0MJPC_5c6?
literal 0
HcmV?d00001
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index b25fff016e..553d7016e1 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -44,11 +44,76 @@
(import "custom" "caml_find_custom_operations"
(func $caml_find_custom_operations
(param (ref $bytes)) (result (ref null $custom_operations))))
+ (type $block (array (mut (ref eq))))
+(@if wasi
+(@then
+ (type $map
+ (struct
+ (field $size (mut i32))
+ (field $keys (mut (ref $block)))
+ (field $values (mut (ref $block)))))
+ (func $map_new (result (ref any))
+ (struct.new $map
+ (i32.const 0)
+ (array.new $block (ref.i31 (i32.const 0)) (i32.const 2))
+ (array.new $block (ref.i31 (i32.const 0)) (i32.const 2))))
+ (func $map_get (param $map (ref any)) (param $k (ref eq)) (result i31ref)
+ (local $m (ref $map)) (local $keys (ref $block))
+ (local $i i32) (local $size i32)
+ (local.set $m (ref.cast (ref $map) (local.get $map)))
+ (local.set $size (struct.get $map $size (local.get $m)))
+ (local.set $keys (struct.get $map $keys (local.get $m)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $size))
+ (then
+ (if (ref.eq (array.get $block (local.get $keys) (local.get $i))
+ (local.get $k))
+ (then
+ (return
+ (ref.cast (ref i31)
+ (array.get $block
+ (struct.get $map $values (local.get $m))
+ (local.get $i))))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))
+ (ref.null i31))
+ (func $map_set (param $map (ref any)) (param $k (ref eq)) (param $v (ref i31))
+ (local $m (ref $map)) (local $i i32) (local $size i32)
+ (local $keys (ref $block)) (local $a (ref $block))
+ (local.set $m (ref.cast (ref $map) (local.get $map)))
+ (local.set $i (struct.get $map $size (local.get $m)))
+ (local.set $keys (struct.get $map $keys (local.get $m)))
+ (if (i32.eq (local.get $i) (array.len (local.get $keys)))
+ (then
+ (local.set $size (i32.shl (local.get $i) (i32.const 1)))
+ (local.set $a
+ (array.new $block (ref.i31 (i32.const 0)) (local.get $size)))
+ (array.copy $block $block
+ (local.get $a) (i32.const 0)
+ (local.get $keys) (i32.const 0)
+ (local.get $i))
+ (struct.set $map $keys (local.get $m) (local.get $a))
+ (local.set $keys (local.get $a))
+ (local.set $a
+ (array.new $block (ref.i31 (i32.const 0)) (local.get $size)))
+ (array.copy $block $block
+ (local.get $a) (i32.const 0)
+ (struct.get $map $values (local.get $m)) (i32.const 0)
+ (local.get $i))
+ (struct.set $map $values (local.get $m) (local.get $a))))
+ (array.set $block (local.get $keys) (local.get $i) (local.get $k))
+ (array.set $block (struct.get $map $values (local.get $m))
+ (local.get $i) (local.get $v))
+ (struct.set $map $size (local.get $m)
+ (i32.add (local.get $i) (i32.const 1))))
+)
+(@else
(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")
@@ -130,7 +195,6 @@
(global.get $input_value))
(return_call $intern_rec (local.get $s) (local.get $h)))
- (type $block (array (mut (ref eq))))
(type $bytes (array (mut i8)))
(type $float (struct (field f64)))
(type $float_array (array (mut f64)))
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index 4918eaa0bf..08e242056e 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -16,10 +16,20 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
+
+(@if wasi
+(@then
+ (import "bigarray" "ta_get_i32"
+ (func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
+ (import "bigarray" "ta_set_i32"
+ (func $ta_set_i32 (param (ref extern)) (param i32) (param i32)))
+)
+(@else
(import "bindings" "ta_get_i32"
(func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
(import "bindings" "ta_set_i32"
(func $ta_set_i32 (param (ref extern)) (param i32) (param i32)))
+))
(import "bigarray" "caml_ba_get_data"
(func $caml_ba_get_data (param (ref eq)) (result (ref extern))))
diff --git a/runtime/wasm/runtime-wasi.js b/runtime/wasm/runtime-wasi.js
new file mode 100644
index 0000000000..b892b15866
--- /dev/null
+++ b/runtime/wasm/runtime-wasi.js
@@ -0,0 +1,84 @@
+// Wasm_of_ocaml runtime support
+// http://www.ocsigen.org/js_of_ocaml/
+//
+// This program is free software; you can redistribute it and/or modify
+// it under the terms of the GNU Lesser General Public License as published by
+// the Free Software Foundation, with linking exception;
+// either version 2.1 of the License, or (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU Lesser General Public License for more details.
+//
+// You should have received a copy of the GNU Lesser General Public License
+// along with this program; if not, write to the Free Software
+// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(js) => async (args) => {
+ // biome-ignore lint/suspicious/noRedundantUseStrict:
+ "use strict";
+
+ const emitWarning = globalThis.process.emitWarning;
+ globalThis.process.emitWarning = function (...args) {
+ if (args[1] !== "ExperimentalWarning") emitWarning(...args);
+ };
+
+ const { link, src, generated } = args;
+
+ const { argv, env } = require("node:process");
+ const { WASI } = require("node:wasi");
+ const wasi = new WASI({
+ version: "preview1",
+ args: argv.slice(1),
+ env,
+ preopens: { ".": ".", "/tmp": "/tmp" },
+ returnOnExit: false,
+ });
+ const imports = wasi.getImportObject();
+ function loadRelative(src) {
+ const path = require("node:path");
+ const f = path.join(path.dirname(require.main.filename), src);
+ return require("node:fs/promises").readFile(f);
+ }
+ async function instantiateModule(code) {
+ return WebAssembly.instantiate(await code, imports);
+ }
+ async function instantiateFromDir() {
+ imports.env = {};
+ imports.OCaml = {};
+ const deps = [];
+ async function loadModule(module, isRuntime) {
+ const sync = module[1].constructor !== Array;
+ async function instantiate() {
+ const code = loadRelative(src + "/" + module[0] + ".wasm");
+ await Promise.all(sync ? deps : module[1].map((i) => deps[i]));
+ const wasmModule = await instantiateModule(code);
+ Object.assign(
+ isRuntime ? imports.env : imports.OCaml,
+ wasmModule.instance.exports,
+ );
+ }
+ const promise = instantiate();
+ deps.push(promise);
+ return promise;
+ }
+ async function loadModules(lst) {
+ for (const module of lst) {
+ await loadModule(module);
+ }
+ }
+ await loadModule(link[0], 1);
+ if (link.length > 1) {
+ await loadModule(link[1]);
+ const workers = new Array(20)
+ .fill(link.slice(2).values())
+ .map(loadModules);
+ await Promise.all(workers);
+ }
+ return { instance: { exports: Object.assign(imports.env, imports.OCaml) } };
+ }
+ const wasmModule = await instantiateFromDir();
+
+ wasi.start(wasmModule.instance);
+};
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index ccf38af3be..7dc56f3634 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -38,10 +38,25 @@
(func $caml_format_exception (param (ref eq)) (result (ref eq))))
(import "sys" "ocaml_exit" (tag $ocaml_exit))
(import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
+(@if wasi
+(@then
+ (import "wasi_snapshot_preview1" "proc_exit" (func $exit (param i32)))
+ (import "wasi_snapshot_preview1" "fd_write"
+ (func $fd_write (param i32 i32 i32 i32) (result i32)))
+ (import "wasi_memory" "get_buffer" (func $get_buffer (result i32)))
+ (import "wasi_memory" "write_string_to_memory"
+ (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32)))
+ (import "wasi_memory" "release_memory"
+ (func $release_memory (param i32 i32)))
+ (import "io" "IO_BUFFER_SIZE" (global $IO_BUFFER_SIZE i32))
+ (import "libc" "memory" (memory 2))
+)
+(@else
(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))))
(type $bytes (array (mut i8)))
@@ -187,6 +202,8 @@
(global $uncaught_exception (mut externref) (ref.null extern))
+(@if (not wasi)
+(@then
(func $reraise_exception (result (ref eq))
(throw $javascript_exception (global.get $uncaught_exception))
(ref.i31 (i32.const 0)))
@@ -194,10 +211,18 @@
(func (export "caml_handle_uncaught_exception") (param $exn externref)
(global.set $uncaught_exception (local.get $exn))
(call $caml_main (ref.func $reraise_exception)))
+))
(func $caml_main (export "caml_main") (param $start (ref func))
(local $exn (ref eq))
(local $msg (ref eq))
+(@if wasi
+(@then
+ (local $buffer i32) (local $i i32) (local $len i32)
+ (local $buf i32) (local $remaining i32)
+ (local $iovs i32) (local $iovs_len i32) (local $nwritten i32)
+ (local $res i32)
+))
(try
(do
(drop (call_ref $func (ref.cast (ref $func) (local.get $start)))))
@@ -230,8 +255,43 @@
(call $caml_string_concat
(call $caml_format_exception (local.get $exn))
(@string "\n"))))
+(@if wasi
+(@then
+ (local.set $len
+ (array.len (ref.cast (ref $bytes) (local.get $msg))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $nwritten (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $iovs_len (i32.const 1))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (local.set $buf
+ (call $write_string_to_memory
+ (local.get $buf) (global.get $IO_BUFFER_SIZE)
+ (local.get $msg)))
+ (local.set $remaining (local.get $buf))
+ (loop $write
+ (i32.store (local.get $iovs) (local.get $remaining))
+ (i32.store offset=4 (local.get $iovs) (local.get $len))
+ (local.set $res
+ (call $fd_write
+ (i32.const 2) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nwritten)))
+ (if (i32.eqz (local.get $res))
+ (then
+ (local.set $len
+ (i32.sub (local.get $len)
+ (i32.load (local.get $nwritten))))
+ (local.set $remaining
+ (i32.add (local.get $remaining)
+ (i32.load (local.get $nwritten))))
+ (br_if $write (local.get $len)))))
+ (call $release_memory (local.get $buffer) (local.get $buf))
+)
+(@else
(call $write (i32.const 2)
(call $unwrap
- (call $caml_jsstring_of_string (local.get $exn)))))
+ (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 ea3b8ec621..98cd53016d 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -19,6 +19,37 @@
(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))
+(@if wasi
+(@then
+ (import "wasi_snapshot_preview1" "random_get"
+ (func $random_get (param i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "clock_time_get"
+ (func $clock_time_get (param i32 i64 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "args_get"
+ (func $args_get (param i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "args_sizes_get"
+ (func $args_sizes_get (param i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "environ_get"
+ (func $environ_get (param i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "environ_sizes_get"
+ (func $environ_sizes_get (param i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "proc_exit" (func $exit (param i32)))
+ (import "libc" "memory" (memory 2))
+ (import "libc" "free" (func $free (param i32)))
+ (import "libc" "strlen" (func $strlen (param i32) (result i32)))
+ (import "wasi_memory" "checked_malloc"
+ (func $checked_malloc (param i32) (result i32)))
+ (import "wasi_memory" "get_buffer" (func $get_buffer (result i32)))
+ (import "wasi_memory" "blit_memory_to_string"
+ (func $blit_memory_to_string (param i32 i32) (result (ref $bytes))))
+ (import "wasi_errors" "error_messages" (global $error_messages (ref $block)))
+ (import "string" "caml_string_concat"
+ (func $caml_string_concat
+ (param (ref eq)) (param (ref eq)) (result (ref eq))))
+ (import "fail" "caml_invalid_argument"
+ (func $caml_invalid_argument (param (ref eq))))
+)
+(@else
(import "bindings" "ta_length"
(func $ta_length (param (ref extern)) (result i32)))
(import "bindings" "ta_get_i32"
@@ -47,6 +78,7 @@
(import "jsstring" "jsstring_test"
(func $jsstring_test (param anyref) (result i32)))
(import "bindings" "exit" (func $exit (param i32)))
+))
(import "io" "caml_channel_descriptor"
(func $caml_channel_descriptor (param (ref eq)) (result (ref eq))))
@@ -62,6 +94,95 @@
;; Fallback: try to exit through an exception
(throw $ocaml_exit))
+(@if wasi
+(@then
+ (global $environment (mut i32) (i32.const 0))
+ (global $environment_count (mut i32) (i32.const 0))
+ (global $environment_data (mut i32) (i32.const 0))
+
+ (func $initialize_env
+ (local $buffer i32) (local $res i32) (local $env i32) (local $data i32)
+ (if (i32.eqz (global.get $environment))
+ (then
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $environ_sizes_get
+ (local.get $buffer)
+ (i32.add (local.get $buffer) (i32.const 4))))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (local.set $env
+ (call $checked_malloc
+ (i32.shl (i32.load (local.get $buffer)) (i32.const 2))))
+ (local.set $data
+ (call $checked_malloc (i32.load offset=4 (local.get $buffer))))
+ (local.set $res
+ (call $environ_get (local.get $env) (local.get $data)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (global.set $environment (local.get $env))
+ (global.set $environment_data (local.get $data))
+ (global.set $environment_count (i32.load (local.get $buffer))))))
+
+ (func (export "caml_sys_getenv") (export "caml_sys_unsafe_getenv")
+ (param $name (ref eq)) (result (ref eq))
+ (local $var (ref $bytes)) (local $i i32) (local $j i32)
+ (local $len i32) (local $s i32) (local $c i32)
+ (call $initialize_env)
+ (local.set $var (ref.cast (ref $bytes) (local.get $name)))
+ (local.set $len (array.len (local.get $var)))
+ (block $not_found
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (br_if $not_found
+ (i32.eq (i32.const 61) ;; '='
+ (array.get_u $bytes (local.get $var) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))
+ (local.set $i (i32.const 0))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (global.get $environment_count))
+ (then
+ (local.set $s
+ (i32.load
+ (i32.add (global.get $environment)
+ (i32.shl (local.get $i) (i32.const 2)))))
+ (local.set $j (i32.const 0))
+ (block $next
+ (loop $scan
+ (if (i32.lt_u (local.get $j) (local.get $len))
+ (then
+ (local.set $c
+ (i32.load8_u
+ (i32.add (local.get $s) (local.get $j))))
+ (br_if $next (i32.eqz (local.get $c)))
+ (br_if $next
+ (i32.ne (local.get $c)
+ (array.get $bytes
+ (local.get $var) (local.get $j))))
+ (local.set $j
+ (i32.add (local.get $j) (i32.const 1)))
+ (br $scan))))
+ (br_if $next
+ (i32.ne (i32.const 61) ;; '='
+ (i32.load8_u
+ (i32.add (local.get $s) (local.get $j)))))
+ (local.set $s
+ (i32.add (local.get $s)
+ (i32.add (local.get $j) (i32.const 1))))
+ (return_call $blit_memory_to_string
+ (local.get $s) (call $strlen (local.get $s))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+ (call $caml_raise_not_found)
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "caml_sys_getenv") (export "caml_sys_unsafe_getenv")
(param (ref eq)) (result (ref eq))
(local $res anyref)
@@ -72,7 +193,65 @@
(then
(call $caml_raise_not_found)))
(return_call $caml_string_of_jsstring (call $wrap (local.get $res))))
+))
+(@if wasi
+(@then
+ (global $argv (mut (ref null $block)) (ref.null $block))
+
+ (func $caml_sys_argv (export "caml_sys_argv")
+ (param (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local $argc i32) (local $argv i32) (local $argv_buf i32)
+ (local $args (ref $block)) (local $arg i32) (local $i i32)
+ (block $init
+ (return (br_on_null $init (global.get $argv))))
+ (block $error
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $args_sizes_get
+ (local.get $buffer)
+ (i32.add (local.get $buffer) (i32.const 4))))
+ (br_if $error (local.get $res))
+ (local.set $argc (i32.load (local.get $buffer)))
+ (local.set $argv
+ (call $checked_malloc (i32.shl (local.get $argc) (i32.const 2))))
+ (local.set $argv_buf
+ (call $checked_malloc (i32.load offset=4 (local.get $buffer))))
+ (local.set $res
+ (call $args_get (local.get $argv) (local.get $argv_buf)))
+ (br_if $error (local.get $res))
+ (local.set $args
+ (array.new $block (ref.i31 (i32.const 0))
+ (i32.add (local.get $argc) (i32.const 1))))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $argc))
+ (then
+ (local.set $arg
+ (i32.load
+ (i32.add (local.get $argv)
+ (i32.shl (local.get $i) (i32.const 2)))))
+ (array.set $block (local.get $args)
+ (i32.add (local.get $i) (i32.const 1))
+ (call $blit_memory_to_string
+ (local.get $arg) (call $strlen (local.get $arg))))
+ (local.set $i
+ (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))
+ (global.set $argv (local.get $args))
+ (call $free (local.get $argv))
+ (call $free (local.get $argv_buf))
+ (return (local.get $args)))
+ (call $caml_handle_sys_error (ref.i31 (i32.const 0)) (local.get $res))
+ (array.new_fixed $block 0))
+
+ (func (export "caml_sys_executable_name")
+ (param (ref eq)) (result (ref eq))
+ (array.get $block
+ (ref.cast (ref $block) (call $caml_sys_argv (ref.i31 (i32.const 0))))
+ (i32.const 1)))
+)
+(@else
(func (export "caml_sys_argv") (param (ref eq)) (result (ref eq))
;; ZZZ
(call $caml_js_to_string_array (call $argv)))
@@ -82,14 +261,40 @@
(array.get $block
(ref.cast (ref $block) (call $caml_js_to_string_array (call $argv)))
(i32.const 1)))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_time") (export "caml_sys_time_include_children")
+ (param (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $clock_time_get (i32.const 2) (i64.const 1) (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (struct.new $float
+ (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer)))
+ (f64.const 1e-9))))
+)
+(@else
(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))))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_system_command")
+ (param (ref eq)) (result (ref eq))
+ (call $caml_invalid_argument (@string "Sys.command not implemented"))
+ (return (ref.i31 (i32.const 0))))
+)
+(@else
(func (export "caml_sys_system_command")
(param (ref eq)) (result (ref eq))
- ;; ZZZ
(try
(do
(return
@@ -98,7 +303,41 @@
(catch $javascript_exception
(call $caml_handle_sys_error (pop externref))))
(return (ref.i31 (i32.const 0))))
+))
+(@if wasi
+(@then
+ (func (export "caml_sys_random_seed")
+ (param (ref eq)) (result (ref eq))
+ (local $r (ref extern))
+ (local $a (ref $block))
+ (local $i i32) (local $n i32)
+ (local $buffer i32) (local $res i32)
+ (local.set $n (i32.const 12))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res (call $random_get (local.get $buffer) (i32.const 96)))
+ (if (local.get $res)
+ (then
+ (call $caml_handle_sys_error
+ (ref.i31 (i32.const 0)) (local.get $res))))
+ (local.set $a
+ (array.new $block (ref.i31 (i32.const 0))
+ (i32.add (local.get $n) (i32.const 1))))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $n))
+ (then
+ (array.set $block
+ (local.get $a) (i32.add (local.get $i) (i32.const 1))
+ (ref.i31
+ (i32.load
+ (i32.add
+ (local.get $buffer
+ (i32.shl (local.get $i) (i32.const 2)))))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))
+ (local.get $a))
+)
+(@else
(func (export "caml_sys_random_seed")
(param (ref eq)) (result (ref eq))
(local $r (ref extern))
@@ -118,6 +357,7 @@
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $loop))))
(local.get $a))
+))
(func (export "caml_sys_const_bigendian")
(param (ref eq)) (result (ref eq))
@@ -135,6 +375,11 @@
(param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 0xfffffff)))
+(@if wasi
+(@then
+ (global $on_windows i32 (i32.const 0))
+))
+
(func (export "caml_sys_const_ostype_unix")
(param (ref eq)) (result (ref eq))
(ref.i31 (i32.eqz (global.get $on_windows))))
@@ -158,9 +403,17 @@
(ref.i31 (i32.const 32))
(ref.i31 (i32.const 0))))
+(@if wasi
+(@then
+ (func (export "caml_sys_isatty")
+ (param $ch (ref eq)) (result (ref eq))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "caml_sys_isatty")
(param $ch (ref eq)) (result (ref eq))
(return_call $isatty (call $caml_channel_descriptor (local.get $ch))))
+))
(func (export "caml_runtime_variant") (param (ref eq)) (result (ref eq))
(@string ""))
@@ -186,6 +439,28 @@
(@string $toString "toString")
+(@if wasi
+(@then
+ (func $caml_handle_sys_error (export "caml_handle_sys_error")
+ (param $arg (ref eq)) (param $errno i32)
+ (local $msg (ref eq))
+ (local.set $msg
+ (if (result (ref eq)) (i32.gt_u (local.get $errno)
+ (array.len (global.get $error_messages)))
+ (then
+ (@string "unknown system error"))
+ (else
+ (array.get $block (global.get $error_messages)
+ (local.get $errno)))))
+ (if (ref.test (ref $bytes) (local.get $arg))
+ (then
+ (local.set $msg
+ (call $caml_string_concat (local.get $arg)
+ (call $caml_string_concat (@string ": ") (local.get $msg))))))
+ (call $caml_raise_sys_error (local.get $msg))
+ )
+)
+(@else
(func $caml_handle_sys_error (export "caml_handle_sys_error")
(param $exn externref)
(call $caml_raise_sys_error
@@ -194,4 +469,5 @@
(call $wrap (any.convert_extern (local.get $exn)))
(global.get $toString)
(array.new_fixed $block 1 (ref.i31 (i32.const 0)))))))
+))
)
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index 01adfbcc08..748ce5656c 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -16,6 +16,73 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
+(@if wasi
+(@then
+ (import "wasi_snapshot_preview1" "clock_time_get"
+ (func $clock_time_get (param i32 i64 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_filestat_get"
+ (func $path_filestat_get (param i32 i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_rename"
+ (func $path_rename (param i32 i32 i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_link"
+ (func $path_link (param i32 i32 i32 i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_symlink"
+ (func $path_symlink (param i32 i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_readlink"
+ (func $path_readlink (param i32 i32 i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_create_directory"
+ (func $path_create_directory (param i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_unlink_file"
+ (func $path_unlink_file (param i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_remove_directory"
+ (func $path_remove_directory (param i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_open"
+ (func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "path_filestat_set_times"
+ (func $path_filestat_set_times
+ (param i32 i32 i32 i32 i64 i64 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_filestat_get"
+ (func $fd_filestat_get (param i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_filestat_set_size"
+ (func $fd_filestat_set_size (param i32 i64) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_write"
+ (func $fd_write (param i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_read"
+ (func $fd_read (param i32 i32 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_seek"
+ (func $fd_seek (param i32 i64 i32 i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_sync"
+ (func $fd_sync (param i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_close"
+ (func $fd_close (param i32) (result i32)))
+ (import "wasi_snapshot_preview1" "fd_readdir"
+ (func $fd_readddir (param i32 i32 i32 i64 i32) (result i32)))
+ (import "libc" "memory" (memory 2))
+ (import "libc" "free" (func $free (param i32)))
+ (import "libc" "gmtime" (func $gmtime (param i32) (result i32)))
+ (import "libc" "localtime" (func $localtime (param i32) (result i32)))
+ (import "libc" "mktime" (func $mktime (param i32) (result i64)))
+ (import "wasi_memory" "checked_malloc"
+ (func $checked_malloc (param i32) (result i32)))
+ (import "wasi_memory" "get_buffer" (func $get_buffer (result i32)))
+ (import "wasi_memory" "write_string_to_memory"
+ (func $write_string_to_memory (param i32 i32 (ref eq)) (result i32)))
+ (import "wasi_memory" "blit_memory_to_string"
+ (func $blit_memory_to_string (param i32 i32) (result (ref $bytes))))
+ (import "wasi_memory" "blit_memory_to_substring"
+ (func $blit_memory_to_substring (param i32 (ref $bytes) i32 i32)))
+ (import "wasi_memory" "blit_substring_to_memory"
+ (func $blit_substring_to_memory (param i32 (ref $bytes) i32 i32)))
+ (import "fs" "wasi_resolve_path"
+ (func $wasi_resolve_path (param (ref eq)) (result i32 i32 i32)))
+ (import "fs" "wasi_chdir" (func $wasi_chdir (param (ref eq))))
+ (import "wasi_errors" "error_messages" (global $error_messages (ref $block)))
+ (import "ints" "caml_format_int"
+ (func $caml_format_int (param (ref eq) (ref eq)) (result (ref eq))))
+ (import "string" "caml_string_concat"
+ (func $caml_string_concat (param (ref eq) (ref eq)) (result (ref eq))))
+)
+(@else
(import "bindings" "gettimeofday" (func $gettimeofday (result f64)))
(import "bindings" "times" (func $times (result (ref eq))))
(import "bindings" "gmtime" (func $gmtime (param f64) (result (ref eq))))
@@ -80,6 +147,7 @@
(func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
(import "jsstring" "jsstring_test"
(func $jsstring_test (param anyref) (result i32)))
+))
(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))))
@@ -149,6 +217,102 @@
(@string $no_arg "")
+(@if wasi
+(@then
+ (func $unix_resolve_path (export "unix_resolve_path")
+ (param $cmd (ref eq)) (param $path (ref eq)) (result i32 i32 i32)
+ (local $res (tuple i32 i32 i32))
+ (local.set $res (call $wasi_resolve_path (local.get $path)))
+ (if (i32.lt_s (tuple.extract 3 0 (local.get $res)) (i32.const 0))
+ (then
+ (call $caml_unix_error
+ (i32.const 44) ;; ENOENT
+ (local.get $cmd) (local.get $path))))
+ (local.get $res))
+
+ (type $constr_table (array i8))
+ (global $error_codes (ref $constr_table)
+ (array.new_fixed $constr_table 77
+ (i32.const -1)
+ (i32.const 0) (i32.const 1) (i32.const 50) (i32.const 51)
+ (i32.const 49) (i32.const 2) (i32.const 39) (i32.const 3)
+ (i32.const -1) (i32.const 4) (i32.const -1) (i32.const 5)
+ (i32.const 55) (i32.const 63) (i32.const 56) (i32.const 6)
+ (i32.const 41) (i32.const 7) (i32.const -1) (i32.const 8)
+ (i32.const 9) (i32.const 10) (i32.const 65) (i32.const -1)
+ (i32.const -1) (i32.const 38) (i32.const 11) (i32.const 12)
+ (i32.const 13) (i32.const 58) (i32.const 14) (i32.const 66)
+ (i32.const 15) (i32.const 16) (i32.const 42) (i32.const -1)
+ (i32.const 17) (i32.const 52) (i32.const 54) (i32.const 53)
+ (i32.const 18) (i32.const 57) (i32.const 19) (i32.const 20)
+ (i32.const 21) (i32.const 22) (i32.const -1) (i32.const 23)
+ (i32.const -1) (i32.const 44) (i32.const 24) (i32.const 25)
+ (i32.const 59) (i32.const 26) (i32.const 27) (i32.const -1)
+ (i32.const 40) (i32.const 47) (i32.const 28) (i32.const 29)
+ (i32.const 67) (i32.const -1) (i32.const 30) (i32.const 31)
+ (i32.const -1) (i32.const 45) (i32.const 43) (i32.const 32)
+ (i32.const 33) (i32.const 34) (i32.const 35) (i32.const -1)
+ (i32.const 62) (i32.const -1) (i32.const 36) (i32.const -1)))
+
+ (func $caml_unix_error_of_code (param $errcode i32) (result (ref eq))
+ (local $err i32)
+ (if (i32.le_u (local.get $errcode) (i32.const 76))
+ (then
+ (local.set $err
+ (array.get_s $constr_table (global.get $error_codes)
+ (local.get $errcode)))
+ (if (i32.ne (local.get $err) (i32.const -1))
+ (then
+ (return (ref.i31 (local.get $err)))))))
+ (array.new_fixed $block 2
+ (ref.i31 (i32.const 0)) (ref.i31 (local.get $errcode))))
+
+ (func $caml_unix_error
+ (param $errcode i32) (param $cmd_name (ref eq)) (param $cmd_arg (ref eq))
+ (throw $ocaml_exception
+ (array.new_fixed $block 5
+ (ref.i31 (i32.const 0))
+ (call $get_unix_error_exn)
+ (call $caml_unix_error_of_code (local.get $errcode))
+ (local.get $cmd_name)
+ (local.get $cmd_arg))))
+
+ (func (export "unix_error_message") (export "caml_unix_error_message")
+ (param $err (ref eq)) (result (ref eq))
+ (local $errcode i32) (local $i i32) (local $n i32)
+ (if (ref.test (ref i31) (local.get $err))
+ (then
+ (local.set $n (i31.get_u (ref.cast (ref i31) (local.get $err))))
+ (loop $loop
+ (if (i32.lt_u (local.get $errcode)
+ (array.len (global.get $error_codes)))
+ (then
+ (if (i32.ne (local.get $n)
+ (array.get $constr_table (global.get $error_codes)
+ (local.get $errcode)))
+ (then
+ (local.set $errcode
+ (i32.add (local.get $errcode) (i32.const 1)))
+ (br $loop))))
+ (else
+ (local.set $errcode (i32.const -1))))))
+ (else
+ (local.set $errcode
+ (i31.get_u
+ (ref.cast (ref i31)
+ (array.get $block
+ (ref.cast (ref $block) (local.get $err))
+ (i32.const 1)))))))
+ (if (i32.gt_u (local.get $errcode)
+ (array.len (global.get $error_messages)))
+ (then
+ (return_call $caml_string_concat
+ (@string "Unknown error ")
+ (call $caml_format_int (@string "%d")
+ (ref.i31 (local.get $errcode))))))
+ (array.get $block (global.get $error_messages) (local.get $errcode)))
+)
+(@else
(global $unix_error (ref eq) (struct.new $js (global.get $unix_error_js)))
(func $ensure_string (param $s (ref eq)) (result (ref eq))
@@ -228,11 +392,52 @@
(i32.const 1))))))))
(return_call $caml_string_of_jsstring
(call $wrap (call $caml_strerror (local.get $errno)))))
+))
+(@if wasi
+(@then
+ (func (export "unix_gettimeofday") (export "caml_unix_gettimeofday")
+ (param (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $clock_time_get
+ (i32.const 0) (i64.const 1000) (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "gettimeofday") (global.get $no_arg))))
+ (struct.new $float
+ (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer)))
+ (f64.const 1e-9))))
+)
+(@else
(func (export "unix_gettimeofday") (export "caml_unix_gettimeofday")
(param (ref eq)) (result (ref eq))
(struct.new $float (call $gettimeofday)))
+))
+(@if wasi
+(@then
+ (func (export "unix_times") (export "caml_unix_times")
+ (param (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $clock_time_get
+ (i32.const 2) (i64.const 1) (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res)
+ (@string "time")
+ (global.get $no_arg))))
+ (array.new_fixed $float_array 4
+ (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer)))
+ (f64.const 1e-9))
+ (f64.const 0) (f64.const 0) (f64.const 0)))
+)
+(@else
(func (export "caml_alloc_times")
(param $u f64) (param $s f64) (result (ref eq))
(array.new_fixed $float_array 4
@@ -241,7 +446,24 @@
(func (export "unix_times") (export "caml_unix_times")
(param (ref eq)) (result (ref eq))
(return_call $times))
+))
+(@if wasi
+(@then
+ (func $alloc_tm (param $tm i32) (result (ref eq))
+ (array.new_fixed $block 10 (ref.i31 (i32.const 0))
+ (ref.i31 (i32.load (local.get $tm)))
+ (ref.i31 (i32.load offset=4 (local.get $tm)))
+ (ref.i31 (i32.load offset=8 (local.get $tm)))
+ (ref.i31 (i32.load offset=12 (local.get $tm)))
+ (ref.i31 (i32.load offset=16 (local.get $tm)))
+ (ref.i31 (i32.load offset=20 (local.get $tm)))
+ (ref.i31 (i32.load offset=24 (local.get $tm)))
+ (ref.i31 (i32.load offset=28 (local.get $tm)))
+ (ref.i31 (select (i32.const 1) (i32.const 0)
+ (i32.load offset=32 (local.get $tm))))))
+)
+(@else
(func (export "caml_alloc_tm")
(param $sec i32) (param $min i32) (param $hour i32) (param $mday i32)
(param $mon i32) (param $year i32) (param $wday i32) (param $yday i32)
@@ -256,21 +478,131 @@
(ref.i31 (local.get $wday))
(ref.i31 (local.get $yday))
(ref.i31 (local.get $isdst))))
+))
+(@if wasi
+(@then
+ (func (export "caml_unix_gmtime") (export "unix_gmtime")
+ (param $t (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $tm i32)
+ (local.set $buffer (call $get_buffer))
+ (i64.store (local.get $buffer)
+ (i64.trunc_sat_f64_s
+ (struct.get $float 0 (ref.cast (ref $float) (local.get $t)))))
+ (local.set $tm (call $gmtime (local.get $buffer)))
+ (if (i32.eqz (local.get $tm))
+ (then
+ (call $caml_unix_error (i32.const 28) (; EINVAL ;)
+ (@string "gmtime") (global.get $no_arg))))
+ (return_call $alloc_tm (local.get $tm)))
+)
+(@else
(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)))))
+))
+(@if wasi
+(@then
+ (func (export "caml_unix_localtime") (export "unix_localtime")
+ (param $t (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $tm i32)
+ (local.set $buffer (call $get_buffer))
+ (i64.store (local.get $buffer)
+ (i64.trunc_sat_f64_s
+ (struct.get $float 0 (ref.cast (ref $float) (local.get $t)))))
+ (local.set $tm (call $localtime (local.get $buffer)))
+ (if (i32.eqz (local.get $tm))
+ (then
+ (call $caml_unix_error (i32.const 28) (; EINVAL ;)
+ (@string "localtime") (global.get $no_arg))))
+ (return_call $alloc_tm (local.get $tm)))
+)
+(@else
(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)))))
+))
+(@if wasi
+(@then
+ (func (export "caml_unix_time") (export "unix_time") (param (ref eq))
+ (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $clock_time_get
+ (i32.const 0) (i64.const 1000) (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "time") (global.get $no_arg))))
+ (struct.new $float
+ (f64.floor
+ (f64.mul (f64.convert_i64_u (i64.load (local.get $buffer)))
+ (f64.const 1e-9)))))
+)
+(@else
(func (export "caml_unix_time") (export "unix_time")
(param (ref eq)) (result (ref eq))
(struct.new $float (f64.floor (call $gettimeofday))))
+))
+(@if wasi
+(@then
+ (func (export "caml_unix_mktime") (export "unix_mktime")
+ (param $v (ref eq)) (result (ref eq))
+ (local $t (ref $block)) (local $tm i32) (local $time i64)
+ (local.set $t (ref.cast (ref $block) (local.get $v)))
+ (local.set $tm (call $get_buffer))
+ (i32.store (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 1)))))
+ (i32.store offset=4 (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 2)))))
+ (i32.store offset=8 (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 3)))))
+ (i32.store offset=12 (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 4)))))
+ (i32.store offset=16 (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 5)))))
+ (i32.store offset=20 (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 6)))))
+ (i32.store offset=24 (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 7)))))
+ (i32.store offset=28 (local.get $tm)
+ (i31.get_s
+ (ref.cast (ref i31)
+ (array.get $block (local.get $t) (i32.const 8)))))
+ (i32.store offset=32 (local.get $tm)
+ (i32.const -1))
+ (local.set $time (call $mktime (local.get $tm)))
+ (if (i64.eq (local.get $time) (i64.const -1))
+ (then
+ (call $caml_unix_error
+ (i32.const 68) (; ERANGE ;)
+ (@string "mktime") (global.get $no_arg))))
+ (array.new_fixed $block 3
+ (ref.i31 (i32.const 0))
+ (struct.new $float (f64.convert_i64_s (local.get $time)))
+ (call $alloc_tm (local.get $tm))))
+)
+(@else
(func (export "caml_unix_mktime") (export "unix_mktime")
(param (ref eq)) (result (ref eq))
(local $tm (ref $block)) (local $t f64)
@@ -302,7 +634,53 @@
(array.new_fixed $block 3 (ref.i31 (i32.const 0))
(struct.new $float (local.get $t))
(call $localtime (local.get $t))))
+))
+
+(@if wasi
+(@then
+ (@string $utimes "utimes")
+ (func (export "unix_utimes") (export "caml_unix_utimes")
+ (param $path (ref eq)) (param $atime (ref eq)) (param $mtime (ref eq))
+ (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $atim i64) (local $mtim i64)
+ (local $set_to_now i32) (local $res i32)
+ (local $at f64) (local $mt f64)
+ (local.set $p
+ (call $unix_resolve_path (global.get $utimes) (local.get $path)))
+ (local.set $at
+ (struct.get $float 0 (ref.cast (ref $float) (local.get $atime))))
+ (local.set $mt
+ (struct.get $float 0 (ref.cast (ref $float) (local.get $mtime))))
+ (local.set $set_to_now
+ (i32.and (f64.eq (local.get $at) (f64.const 0))
+ (f64.eq (local.get $mt) (f64.const 0))))
+ (if (i32.eqz (local.get $set_to_now))
+ (then
+ (local.set $atim
+ (i64.trunc_sat_f64_s
+ (f64.mul (local.get $at) (f64.const 1e9))))
+ (local.set $mtim
+ (i64.trunc_sat_f64_s
+ (f64.mul (local.get $mt) (f64.const 1e9))))))
+ (local.set $res
+ (call $path_filestat_set_times
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 0)
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $atim)
+ (local.get $mtim)
+ (i32.shl (i32.const 5) (local.get $set_to_now))))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $utimes) (local.get $path))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_utimes") (export "caml_unix_utimes")
(param $path (ref eq)) (param $atime (ref eq)) (param $mtime (ref eq))
(result (ref eq))
@@ -324,6 +702,48 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (global $file_kinds (ref $constr_table)
+ (array.new_fixed $constr_table 8
+ (i32.const 3)
+ (i32.const 3)
+ (i32.const 2)
+ (i32.const 1)
+ (i32.const 0)
+ (i32.const 6)
+ (i32.const 6)
+ (i32.const 4)))
+
+ (func $alloc_stat (param $large i32) (param $p i32) (result (ref eq))
+ (array.new_fixed $block 13 (ref.i31 (i32.const 0))
+ (ref.i31 (i32.wrap_i64 (i64.load (local.get $p))))
+ (ref.i31 (i32.wrap_i64 (i64.load offset=8 (local.get $p))))
+ (ref.i31
+ (array.get $constr_table
+ (global.get $file_kinds) (i32.load8_u offset=16 (local.get $p))))
+ (ref.i31 (i32.const 384 (;0600;)))
+ (ref.i31 (i32.wrap_i64 (i64.load offset=24 (local.get $p))))
+ (ref.i31 (i32.const 1))
+ (ref.i31 (i32.const 1))
+ (ref.i31 (i32.wrap_i64 (i64.load (local.get $p))))
+ (if (result (ref eq)) (local.get $large)
+ (then
+ (call $caml_copy_int64 (i64.load offset=32 (local.get $p))))
+ (else
+ (ref.i31 (i32.wrap_i64 (i64.load offset=32 (local.get $p))))))
+ (struct.new $float
+ (f64.mul (f64.const 1e-9)
+ (f64.convert_i64_s (i64.load offset=40 (local.get $p)))))
+ (struct.new $float
+ (f64.mul (f64.const 1e-9)
+ (f64.convert_i64_s (i64.load offset=48 (local.get $p)))))
+ (struct.new $float
+ (f64.mul (f64.const 1e-9)
+ (f64.convert_i64_s (i64.load offset=56 (local.get $p)))))))
+))
(func (export "caml_alloc_stat")
(param $large i32)
@@ -349,6 +769,76 @@
(struct.new $float (local.get $mtime))
(struct.new $float (local.get $ctime))))
+(@if wasi
+(@then
+ (func $stat
+ (param $path (ref eq)) (param $large i32) (param $follow i32)
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $buffer i32) (local $res i32)
+ (local.set $p
+ (call $unix_resolve_path (local.get $name) (local.get $path)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_filestat_get
+ (tuple.extract 3 0 (local.get $p))
+ (local.get $follow) ;; symlink_follow
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (local.get $name) (local.get $path))))
+ (return_call $alloc_stat (local.get $large) (local.get $buffer)))
+
+ (@string $stat "stat")
+
+ (func (export "unix_stat") (export "caml_unix_stat")
+ (param $path (ref eq)) (result (ref eq))
+ (return_call $stat
+ (local.get $path) (i32.const 0) (i32.const 1) (global.get $stat)))
+
+ (func (export "unix_stat_64") (export "caml_unix_stat_64")
+ (param $path (ref eq)) (result (ref eq))
+ (return_call $stat
+ (local.get $path) (i32.const 1) (i32.const 1) (global.get $stat)))
+
+ (@string $lstat "lstat")
+
+ (func (export "unix_lstat") (export "caml_unix_lstat")
+ (param $path (ref eq)) (result (ref eq))
+ (return_call $stat
+ (local.get $path) (i32.const 0) (i32.const 0) (global.get $lstat)))
+
+ (func (export "unix_lstat_64") (export "caml_unix_lstat_64")
+ (param $path (ref eq)) (result (ref eq))
+ (return_call $stat
+ (local.get $path) (i32.const 1) (i32.const 0) (global.get $lstat)))
+
+ (func $fstat (param $fd (ref eq)) (param $large i32) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $fd_filestat_get
+ (i31.get_u (ref.cast (ref i31) (local.get $fd)))
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "fstat") (global.get $no_arg))))
+ (return_call $alloc_stat (local.get $large) (local.get $buffer)))
+
+ (func (export "unix_fstat") (export "caml_unix_fstat")
+ (param $fd (ref eq)) (result (ref eq))
+ (return_call $fstat (local.get $fd) (i32.const 0)))
+
+ (func (export "unix_fstat_64") (export "caml_unix_fstat_64")
+ (param $fd (ref eq)) (result (ref eq))
+ (return_call $fstat (local.get $fd) (i32.const 1)))
+)
+(@else
(func (export "unix_stat") (export "caml_unix_stat")
(param $path (ref eq)) (result (ref eq))
(try (result (ref eq))
@@ -410,7 +900,16 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))
(ref.i31 (i32.const 0)))))
+))
+(@if wasi
+(@then
+ (func (export "unix_chmod") (export "caml_unix_chmod")
+ (param (ref eq) (ref eq)) (result (ref eq))
+ ;; no notion of permissions in WASI
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_chmod") (export "caml_unix_chmod")
(param $path (ref eq)) (param $perms (ref eq)) (result (ref eq))
(try
@@ -421,7 +920,16 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (func (export "unix_fchmod") (export "caml_unix_fchmod")
+ (param (ref eq) (ref eq)) (result (ref eq))
+ ;; no notion of permissions in WASI
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_fchmod") (export "caml_unix_fchmod")
(param $fd (ref eq)) (param $perms (ref eq)) (result (ref eq))
(try
@@ -430,7 +938,38 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (@string $rename "rename")
+ (func (export "unix_rename") (export "caml_unix_rename")
+ (param $o (ref eq)) (param $n (ref eq)) (result (ref eq))
+ (local $op (tuple i32 i32 i32))
+ (local $np (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $op
+ (call $unix_resolve_path (global.get $rename) (local.get $o)))
+ (local.set $np
+ (call $unix_resolve_path (global.get $rename) (local.get $n)))
+ (local.set $res
+ (call $path_rename
+ (tuple.extract 3 0 (local.get $op))
+ (tuple.extract 3 1 (local.get $op))
+ (tuple.extract 3 2 (local.get $op))
+ (tuple.extract 3 0 (local.get $np))
+ (tuple.extract 3 1 (local.get $np))
+ (tuple.extract 3 2 (local.get $np))))
+ (call $free (tuple.extract 3 1 (local.get $op)))
+ (call $free (tuple.extract 3 1 (local.get $np)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $rename) (local.get $o))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_rename") (export "caml_unix_rename")
(param $o (ref eq)) (param $n (ref eq)) (result (ref eq))
(try
@@ -441,7 +980,39 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (@string $chdir "chdir")
+
+ (func (export "unix_chdir") (export "caml_unix_chdir")
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $buffer i32) (local $res i32) (local $kind i32)
+ (local.set $p
+ (call $unix_resolve_path (global.get $chdir) (local.get $name)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_filestat_get
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1)
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $chdir) (local.get $name))))
+ (local.set $kind (i32.load8_u offset=16 (local.get $buffer)))
+ (if (i32.ne (local.get $kind) (i32.const 3))
+ (then
+ (call $caml_unix_error (i32.const 54) ;; ENOTDIR
+ (global.get $chdir) (local.get $name))))
+ (call $wasi_chdir (local.get $name))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_getcwd") (export "caml_unix_getcwd")
(param (ref eq)) (result (ref eq))
(try (result (ref eq))
@@ -460,7 +1031,31 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (@string $mkdir "mkdir")
+
+ (func (export "unix_mkdir") (export "caml_unix_mkdir")
+ (param $path (ref eq)) (param $perm (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $p
+ (call $unix_resolve_path (global.get $mkdir) (local.get $path)))
+ (local.set $res
+ (call $path_create_directory
+ (tuple.extract 3 0 (local.get $p))
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $mkdir) (local.get $path))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_mkdir") (export "caml_unix_mkdir")
(param $name (ref eq)) (param $perm (ref eq)) (result (ref eq))
(try
@@ -471,7 +1066,147 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (type $directory
+ (struct
+ (field $fd i32)
+ (field $buffer (mut i32))
+ (field $size (mut i32))
+ (field $pos (mut i32))
+ (field $available (mut i32))
+ (field $cookie (mut i64))))
+
+ (@string $opendir "opendir")
+ (func $unix_opendir (export "unix_opendir") (export "caml_unix_opendir")
+ (param $name (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $buffer i32) (local $res i32)
+ (local.set $p
+ (call $unix_resolve_path (global.get $opendir) (local.get $name)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_open
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1) ;; symlink_follow
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (i32.const 2) ;; O_DIRECTORY
+ (i64.const 0x4000) ;; allow fd_readdir
+ (i64.const 0)
+ (i32.const 0)
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $opendir) (local.get $name))))
+ (struct.new $directory
+ (i32.load (local.get $buffer))
+ (call $checked_malloc (i32.const 512))
+ (i32.const 512)
+ (i32.const 0)
+ (i32.const 0)
+ (i64.const 0)))
+
+ (func $readdir_helper
+ (param $vdir (ref eq)) (result (ref eq))
+ (local $dir (ref $directory)) (local $buf i32) (local $res i32)
+ (local $buffer i32) (local $available i32) (local $left i32)
+ (local $namelen i32) (local $entry i32) (local $entry_size i32)
+ (local.set $dir (ref.cast (ref $directory) (local.get $vdir)))
+ (loop $loop
+ (block $refill
+ (local.set $left
+ (i32.sub (struct.get $directory $available (local.get $dir))
+ (struct.get $directory $pos (local.get $dir))))
+ (br_if $refill (i32.lt_u (local.get $left) (i32.const 24)))
+ (local.set $entry
+ (i32.add (struct.get $directory $buffer (local.get $dir))
+ (struct.get $directory $pos (local.get $dir))))
+ (local.set $namelen (i32.load offset=16 (local.get $entry)))
+ (local.set $entry_size (i32.add (local.get $namelen) (i32.const 24)))
+ (br_if $refill (i32.lt_u (local.get $left) (local.get $entry_size)))
+ (struct.set $directory $pos (local.get $dir)
+ (i32.add (struct.get $directory $pos (local.get $dir))
+ (local.get $entry_size)))
+ (struct.set $directory $cookie (local.get $dir)
+ (i64.load (local.get $entry)))
+ (return_call $blit_memory_to_string
+ (i32.add (local.get $entry) (i32.const 24))
+ (local.get $namelen)))
+ ;; refill
+ (if (i32.lt_u (struct.get $directory $size (local.get $dir))
+ (local.get $entry_size))
+ (then
+ ;; the entry does not fit
+ (local.set $buf (call $checked_malloc (local.get $entry_size)))
+ (call $free (struct.get $directory $buffer (local.get $dir)))
+ (struct.set $directory $buffer (local.get $dir) (local.get $buf))
+ (struct.set $directory $size (local.get $dir)
+ (local.get $entry_size))))
+ (block $done
+ (br_if $done
+ (i32.and
+ (i32.ne (i32.const 0)
+ (struct.get $directory $available (local.get $dir))
+ (i32.lt_u (struct.get $directory $available (local.get $dir))
+ (struct.get $directory $size (local.get $dir))))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $fd_readddir
+ (struct.get $directory $fd (local.get $dir))
+ (struct.get $directory $buffer (local.get $dir))
+ (struct.get $directory $size (local.get $dir))
+ (struct.get $directory $cookie (local.get $dir))
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "readdir") (global.get $no_arg))))
+ (local.set $available (i32.load (local.get $buffer)))
+ (br_if $done (i32.eqz (local.get $available)))
+ (struct.set $directory $pos (local.get $dir) (i32.const 0))
+ (struct.set $directory $available (local.get $dir)
+ (local.get $available))
+ (br $loop)))
+ ;; done
+ (call $caml_raise_end_of_file)
+ (ref.i31 (i32.const 0)))
+
+ (func $unix_closedir (export "unix_closedir") (export "caml_unix_closedir")
+ (param $vdir (ref eq)) (result (ref eq))
+ (local $dir (ref $directory)) (local $buf i32) (local $res i32)
+ (local.set $dir (ref.cast (ref $directory) (local.get $vdir)))
+ (local.set $buf (struct.get $directory $buffer (local.get $dir)))
+ (block $error
+ (if (i32.eqz (local.get $buf))
+ (then
+ (local.set $res (i32.const 8)) ;; EBADF
+ (br $error)))
+ (call $free (local.get $buf))
+ (struct.set $directory $buffer (local.get $dir) (i32.const 0))
+ (local.set $res
+ (call $fd_close (struct.get $directory $fd (local.get $dir))))
+ (br_if $error (local.get $res))
+ (return (ref.i31 (i32.const 0))))
+ (call $caml_unix_error
+ (local.get $res) (@string "closedir") (global.get $no_arg))
+ (ref.i31 (i32.const 0)))
+
+ (func (export "unix_rewinddir") (export "caml_unix_rewinddir")
+ (param $vdir (ref eq)) (result (ref eq))
+ (local $dir (ref $directory))
+ (local.set $dir (ref.cast (ref $directory) (local.get $vdir)))
+ (struct.set $directory $cookie (local.get $dir) (i64.const 0))
+ (struct.set $directory $pos (local.get $dir) (i32.const 0))
+ (struct.set $directory $available (local.get $dir) (i32.const 0))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func $unix_opendir (export "unix_opendir") (export "caml_unix_opendir")
(param $name (ref eq)) (result (ref eq))
(try (result (ref eq))
@@ -524,6 +1259,7 @@
(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))
@@ -556,6 +1292,29 @@
(call $win_find_next (local.get $dir))
(local.get $dir)))
+(@if wasi
+(@then
+ (@string $unlink "unlink")
+
+ (func (export "unix_unlink") (export "caml_unix_unlink")
+ (param $path (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $p
+ (call $unix_resolve_path (global.get $unlink) (local.get $path)))
+ (local.set $res
+ (call $path_unlink_file
+ (tuple.extract 3 0 (local.get $p))
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $unlink) (local.get $path))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_unlink") (export "caml_unix_unlink")
(param $p (ref eq)) (result (ref eq))
(try
@@ -565,7 +1324,31 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (@string $rmdir "rmdir")
+ (func (export "unix_rmdir") (export "caml_unix_rmdir")
+ (param $path (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32)
+ (local.set $p
+ (call $unix_resolve_path (global.get $rmdir) (local.get $path)))
+ (local.set $res
+ (call $path_remove_directory
+ (tuple.extract 3 0 (local.get $p))
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $rmdir) (local.get $path))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_rmdir") (export "caml_unix_rmdir")
(param $p (ref eq)) (result (ref eq))
(try
@@ -575,7 +1358,47 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (@string $link "link")
+ (func (export "unix_link") (export "caml_unix_link")
+ (param $follow (ref eq)) (param $o (ref eq)) (param $n (ref eq))
+ (result (ref eq))
+ (local $op (tuple i32 i32 i32))
+ (local $np (tuple i32 i32 i32))
+ (local $flags i32)
+ (local $res i32)
+ (local.set $op (call $unix_resolve_path (global.get $link) (local.get $o)))
+ (local.set $np (call $unix_resolve_path (global.get $link) (local.get $n)))
+ (if (ref.test (ref $block) (local.get $follow))
+ (then
+ (local.set $flags
+ (i31.get_u
+ (ref.cast (ref i31)
+ (array.get $block
+ (ref.cast (ref $block) (local.get $follow))
+ (i32.const 1)))))))
+ (local.set $res
+ (call $path_link
+ (tuple.extract 3 0 (local.get $op))
+ (local.get $flags)
+ (tuple.extract 3 1 (local.get $op))
+ (tuple.extract 3 2 (local.get $op))
+ (tuple.extract 3 0 (local.get $np))
+ (tuple.extract 3 1 (local.get $np))
+ (tuple.extract 3 2 (local.get $np))))
+ (call $free (tuple.extract 3 1 (local.get $op)))
+ (call $free (tuple.extract 3 1 (local.get $np)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $link) (local.get $o))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_link") (export "caml_unix_link")
(param $follow (ref eq)) (param $d (ref eq)) (param $s (ref eq))
(result (ref eq))
@@ -596,11 +1419,48 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
(func (export "unix_has_symlink") (export "caml_unix_has_symlink")
(param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 1)))
+(@if wasi
+(@then
+ (@string $symlink "symlink")
+
+ (func (export "unix_symlink") (export "caml_unix_symlink")
+ (param $to_dir (ref eq)) (param $o (ref eq)) (param $n (ref eq))
+ (result (ref eq))
+ (local $path (ref $bytes))
+ (local $len i32)
+ (local $op i32)
+ (local $np (tuple i32 i32 i32))
+ (local $flags i32)
+ (local $res i32)
+ (local.set $path (ref.cast (ref $bytes) (local.get $o)))
+ (local.set $len (array.len (local.get $path)))
+ (local.set $op
+ (call $write_string_to_memory
+ (i32.const 0) (i32.const 0) (local.get $path)))
+ (local.set $np
+ (call $unix_resolve_path (global.get $symlink) (local.get $n)))
+ (local.set $res
+ (call $path_symlink
+ (local.get $op)
+ (local.get $len)
+ (tuple.extract 3 0 (local.get $np))
+ (tuple.extract 3 1 (local.get $np))
+ (tuple.extract 3 2 (local.get $np))))
+ (call $free (local.get $op))
+ (call $free (tuple.extract 3 1 (local.get $np)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $symlink) (local.get $o))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_symlink") (export "caml_unix_symlink")
(param $to_dir (ref eq)) (param $t (ref eq)) (param $p (ref eq))
(result (ref eq))
@@ -623,7 +1483,37 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (@string $readlink "readlink")
+ (func (export "unix_readlink") (export "caml_unix_readlink")
+ (param $path (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $buffer i32) (local $buf i32) (local $res i32)
+ (local.set $p
+ (call $unix_resolve_path (global.get $readlink) (local.get $path)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $buf (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $res
+ (call $path_readlink
+ (tuple.extract 3 0 (local.get $p))
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $buf)
+ (global.get $IO_BUFFER_SIZE)
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $readlink) (local.get $path))))
+ (return_call $blit_memory_to_string
+ (local.get $buf) (i32.load (local.get $buffer))))
+)
+(@else
(func (export "unix_readlink") (export "caml_unix_readlink")
(param $path (ref eq)) (result (ref eq))
(try
@@ -636,7 +1526,60 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (@string $truncate "truncate")
+
+ (func $truncate (param $path (ref eq)) (param $len i64) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $fd i32) (local $res i32) (local $buffer i32)
+ (block $error
+ (local.set $p
+ (call $unix_resolve_path (global.get $truncate) (local.get $path)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_open
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1) ;; symlink_follow
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (i32.const 0)
+ (i64.const 0x400000) ;; allow fd_filestat_set_size
+ (i64.const 0)
+ (i32.const 0)
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (br_if $error (local.get $res))
+ (local.set $fd (i32.load (local.get $buffer)))
+ (local.set $res
+ (call $fd_filestat_set_size (local.get $fd) (local.get $len)))
+ (if (local.get $res)
+ (then
+ (drop (call $fd_close (local.get $fd)))
+ (br $error)))
+ (local.set $res (call $fd_close (local.get $fd)))
+ (br_if $error (local.get $res))
+ (return (ref.i31 (i32.const 0))))
+ (call $caml_unix_error
+ (local.get $res) (global.get $truncate) (local.get $path))
+ (return (ref.i31 (i32.const 0))))
+ (func (export "unix_truncate") (export "caml_unix_truncate")
+ (param $path (ref eq)) (param $len (ref eq))
+ (result (ref eq))
+ (return_call $truncate (local.get $path)
+ (i64.extend_i32_s
+ (i31.get_s (ref.cast (ref i31) (local.get $len))))))
+
+ (func (export "unix_truncate_64") (export "caml_unix_truncate_64")
+ (param $path (ref eq)) (param $len (ref eq))
+ (result (ref eq))
+ (return_call $truncate (local.get $path)
+ (call $Int64_val (local.get $len))))
+)
+(@else
(func (export "unix_truncate") (export "caml_unix_truncate")
(param $path (ref eq)) (param $len (ref eq))
(result (ref eq))
@@ -662,7 +1605,33 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+(@if wasi
+(@then
+ (func $ftruncate (param $vfd (ref eq)) (param $len i64) (result (ref eq))
+ (local $fd i32) (local $res i32)
+ (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd))))
+ (local.set $res
+ (call $fd_filestat_set_size (local.get $fd) (local.get $len)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "ftruncate") (global.get $no_arg))))
+ (ref.i31 (i32.const 0)))
+ (func (export "unix_ftruncate") (export "caml_unix_ftruncate")
+ (param $fd (ref eq)) (param $len (ref eq)) (result (ref eq))
+ (return_call $ftruncate (local.get $fd)
+ (i64.extend_i32_s
+ (i31.get_s (ref.cast (ref i31) (local.get $len))))))
+
+ (func (export "unix_ftruncate_64") (export "caml_unix_ftruncate_64")
+ (param $fd (ref eq)) (param $len (ref eq)) (result (ref eq))
+ (return_call $ftruncate (local.get $fd)
+ (call $Int64_val (local.get $len))))
+)
+(@else
(func (export "unix_ftruncate") (export "caml_unix_ftruncate")
(param $fd (ref eq)) (param $vlen (ref eq))
(result (ref eq))
@@ -711,7 +1680,35 @@
(struct.set $fd_offset $offset (local.get $fd_offset)
(local.get $len))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (@string $access "access")
+
+ ;; We can only check that the file exists
+ (func (export "unix_access") (export "caml_unix_access")
+ (param $path (ref eq)) (param $flags (ref eq)) (result (ref eq))
+ (local $p (tuple i32 i32 i32))
+ (local $res i32) (local $buffer i32)
+ (local.set $p
+ (call $unix_resolve_path (global.get $access) (local.get $path)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $path_filestat_get
+ (tuple.extract 3 0 (local.get $p))
+ (i32.const 1)
+ (tuple.extract 3 1 (local.get $p))
+ (tuple.extract 3 2 (local.get $p))
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $p)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $access) (local.get $path))))
+ (return (ref.i31 (i32.const 0))))
+)
+(@else
(global $access_flags (ref $flags)
(array.new_fixed $flags 4
(i32.const 1) (i32.const 2) (i32.const 4) (i32.const 8)))
@@ -730,8 +1727,69 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+
+ (type $flags (array i16))
+
+(@if wasi
+(@then
+ ;; 0x1 O_RDONLY
+ ;; 0x2 O_WRONLY
+ ;; 0x3 O_RDWR
+ ;; 0x400 O_NONBLOCK
+ ;; 0x100 O_APPEND
+ ;; 0x10 O_CREAT
+ ;; 0x80 O_TRUNC
+ ;; 0x40 O_EXCL
+ ;; 0 O_NOCTTY
+ ;; 0x200 O_DSYNC
+ ;; 0x1000 O_SYNC
+ ;; 0x800 O_RSYNC
+ (global $unix_open_flags (ref $flags)
+ (array.new_fixed $flags 15
+ (i32.const 1) (i32.const 2) (i32.const 3) (i32.const 0x400)
+ (i32.const 0x100) (i32.const 0x10) (i32.const 0x80) (i32.const 0x40)
+ (i32.const 0) (i32.const 0x200) (i32.const 0x1000) (i32.const 0x800)
+ (i32.const 0) (i32.const 0) (i32.const 0)))
- (type $flags (array i8))
+ (@string $open "open")
+
+ (func (export "unix_open") (export "caml_unix_open")
+ (param $vpath (ref eq)) (param $vflags (ref eq)) (param $perm (ref eq))
+ (result (ref eq))
+ (local $flags i32) (local $offset i64)
+ (local $path (tuple i32 i32 i32))
+ (local $res i32) (local $buffer i32)
+ (local.set $path
+ (call $unix_resolve_path (global.get $open) (local.get $vpath)))
+ (local.set $buffer (call $get_buffer))
+ (local.set $flags
+ (call $convert_flag_list
+ (global.get $unix_open_flags) (local.get $vflags)))
+ (local.set $res
+ (call $path_open
+ (tuple.extract 3 0 (local.get $path))
+ (i32.const 1) ;; symlink_follow
+ (tuple.extract 3 1 (local.get $path))
+ (tuple.extract 3 2 (local.get $path))
+ (i32.and (i32.shr_u (local.get $flags) (i32.const 4))
+ (i32.const 0xF))
+ (select
+ (i64.const 0x860007e)
+ (select (i64.const 0x860007c) (i64.const 0x820003e)
+ (i32.and (local.get $flags) (i32.const 2)))
+ (i32.eq (i32.and (local.get $flags) (i32.const 3)) (i32.const 3)))
+ (i64.const 0)
+ (i32.shr_u (local.get $flags) (i32.const 8))
+ (local.get $buffer)))
+ (call $free (tuple.extract 3 1 (local.get $path)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (global.get $open) (local.get $vpath))))
+ (ref.i31 (i32.load (local.get $buffer))))
+)
+(@else
;; 1 O_RDONLY
;; 2 O_WRONLY
;; 4 O_RDWR
@@ -771,6 +1829,7 @@
(call $caml_unix_error (pop externref) (ref.null eq))))
(call $initialize_fd_offset (local.get $fd) (local.get $offset))
(ref.i31 (local.get $fd)))
+))
(global $io_buffer (mut externref) (ref.null extern))
@@ -786,6 +1845,217 @@
(br_on_null $null (call $get_fd_offset_unchecked (local.get $fd)))))
(struct.new $fd_offset (i64.const 0) (i32.const 0)))
+(@if wasi
+(@then
+ (func (export "unix_write") (export "caml_unix_write")
+ (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq))
+ (param $vlen (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local $iovs i32) (local $iovs_len i32) (local $nwritten i32)
+ (local $fd i32) (local $s (ref $bytes))
+ (local $pos i32) (local $len i32) (local $numbytes i32)
+ (local $written i32) (local $n i32)
+ (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd))))
+ (local.set $s (ref.cast (ref $bytes) (local.get $vbuf)))
+ (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
+ (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $nwritten (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (i32.store (local.get $iovs) (local.get $buffer))
+ (local.set $iovs_len (i32.const 1))
+ (loop $loop
+ (if (i32.gt_u (local.get $len) (i32.const 0))
+ (then
+ (local.set $numbytes
+ (select (global.get $IO_BUFFER_SIZE) (local.get $len)
+ (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE))))
+ (call $blit_substring_to_memory
+ (local.get $buffer) (local.get $s) (local.get $pos)
+ (local.get $numbytes))
+ (i32.store offset=4 (local.get $iovs) (local.get $numbytes))
+ (local.set $res
+ (call $fd_write
+ (local.get $fd) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nwritten)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error (local.get $res) (@string "write")
+ (global.get $no_arg))))
+ (local.set $n (i32.load (local.get $nwritten)))
+ (local.set $written (i32.add (local.get $written) (local.get $n)))
+ (local.set $pos (i32.add (local.get $pos) (local.get $n)))
+ (local.set $len (i32.sub (local.get $len) (local.get $n)))
+ (br $loop))))
+ (ref.i31 (local.get $n)))
+
+ (func (export "unix_single_write") (export "caml_unix_single_write")
+ (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq))
+ (param $vlen (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local $iovs i32) (local $iovs_len i32) (local $nwritten i32)
+ (local $fd i32) (local $s (ref $bytes))
+ (local $pos i32) (local $len i32) (local $numbytes i32)
+ (local $written i32) (local $n i32)
+ (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd))))
+ (local.set $s (ref.cast (ref $bytes) (local.get $vbuf)))
+ (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
+ (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+ (if (i32.eqz (local.get $len))
+ (then (return (ref.i31 (i32.const 0)))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $nwritten (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (i32.store (local.get $iovs) (local.get $buffer))
+ (local.set $iovs_len (i32.const 1))
+ (local.set $numbytes
+ (select (global.get $IO_BUFFER_SIZE) (local.get $len)
+ (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE))))
+ (call $blit_substring_to_memory
+ (local.get $buffer) (local.get $s) (local.get $pos)
+ (local.get $numbytes))
+ (i32.store offset=4 (local.get $iovs) (local.get $numbytes))
+ (local.set $res
+ (call $fd_write
+ (local.get $fd) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nwritten)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error (local.get $res) (@string "write")
+ (global.get $no_arg))))
+ (ref.i31 (i32.load (local.get $nwritten))))
+
+ (func (export "unix_read") (export "caml_unix_read")
+ (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq))
+ (param $vlen (ref eq)) (result (ref eq))
+ (local $buffer i32) (local $res i32)
+ (local $iovs i32) (local $iovs_len i32) (local $nread i32)
+ (local $fd i32) (local $pos i32) (local $len i32) (local $n i32)
+ (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd))))
+ (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
+ (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+ (if (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE))
+ (then
+ (local.set $len (global.get $IO_BUFFER_SIZE))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $nread (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (i32.store (local.get $iovs) (local.get $buffer))
+ (i32.store offset=4 (local.get $iovs) (local.get $len))
+ (local.set $iovs_len (i32.const 1))
+ (local.set $res
+ (call $fd_read
+ (local.get $fd) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nread)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error (local.get $res) (@string "read")
+ (global.get $no_arg))))
+ (local.set $n (i32.load (local.get $nread)))
+ (call $blit_memory_to_substring (local.get $buffer)
+ (ref.cast (ref $bytes) (local.get $vbuf))
+ (local.get $pos) (local.get $n))
+ (ref.i31 (local.get $n)))
+
+ (type $data
+ (struct
+ (field $array (ref array))
+ (field $offset i32)
+ (field $len i32)))
+
+ (func (export "unix_write_bigarray") (export "caml_unix_write_bigarray")
+ (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq))
+ (param $vlen (ref eq)) (param $vsingle (ref eq)) (result (ref eq))
+ (local $fd i32) (local $data (ref $data)) (local $buf (ref $bytes))
+ (local $pos i32) (local $len i32) (local $n i32) (local $written i32)
+ (local $buffer i32) (local $nwritten i32) (local $iovs i32)
+ (local $iovs_len i32) (local $numbytes i32) (local $res i32)
+ (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd))))
+ (local.set $data
+ (ref.cast (ref $data)
+ (any.convert_extern (call $caml_ba_get_data (local.get $vbuf)))))
+ (local.set $buf
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $data))))
+ (local.set $pos
+ (i32.add (i31.get_u (ref.cast (ref i31) (local.get $vpos)))
+ (struct.get $data $offset (local.get $data))))
+ (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $nwritten (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (i32.store (local.get $iovs) (local.get $buffer))
+ (local.set $iovs_len (i32.const 1))
+ (loop $loop
+ (if (i32.gt_u (local.get $len) (i32.const 0))
+ (then
+ (local.set $numbytes
+ (select (global.get $IO_BUFFER_SIZE) (local.get $len)
+ (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE))))
+ (call $blit_substring_to_memory
+ (local.get $buffer) (local.get $buf) (local.get $pos)
+ (local.get $numbytes))
+ (i32.store offset=4 (local.get $iovs) (local.get $numbytes))
+ (local.set $res
+ (call $fd_write
+ (local.get $fd) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nwritten)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error (local.get $res) (@string "write")
+ (global.get $no_arg))))
+ (local.set $n (i32.load (local.get $nwritten)))
+ (local.set $written (i32.add (local.get $written) (local.get $n)))
+ (local.set $pos (i32.add (local.get $pos) (local.get $n)))
+ (local.set $len (i32.sub (local.get $len) (local.get $n)))
+ (br_if $loop
+ (ref.eq (local.get $vsingle) (ref.i31 (i32.const 0)))))))
+ (ref.i31 (local.get $written)))
+
+ (func (export "unix_read_bigarray") (export "caml_unix_read_bigarray")
+ (param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq))
+ (param $vlen (ref eq)) (result (ref eq))
+ (local $fd i32) (local $data (ref $data)) (local $buf (ref $bytes))
+ (local $pos i32) (local $len i32) (local $n i32)
+ (local $buffer i32) (local $nread i32) (local $iovs i32)
+ (local $iovs_len i32) (local $res i32)
+ (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get $vfd))))
+ (local.set $data
+ (ref.cast (ref $data)
+ (any.convert_extern (call $caml_ba_get_data (local.get $vbuf)))))
+ (local.set $buf
+ (ref.cast (ref $bytes) (struct.get $data $array (local.get $data))))
+ (local.set $pos
+ (i32.add (i31.get_u (ref.cast (ref i31) (local.get $vpos)))
+ (struct.get $data $offset (local.get $data))))
+ (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+ (if (i32.gt_u (local.get $len) (global.get $IO_BUFFER_SIZE))
+ (then
+ (local.set $len (global.get $IO_BUFFER_SIZE))))
+ (local.set $buffer (call $get_buffer))
+ (local.set $nread (local.get $buffer))
+ (local.set $iovs (i32.add (local.get $buffer) (i32.const 4)))
+ (local.set $buffer (i32.add (local.get $buffer) (i32.const 12)))
+ (i32.store (local.get $iovs) (local.get $buffer))
+ (i32.store offset=4 (local.get $iovs) (local.get $len))
+ (local.set $iovs_len (i32.const 1))
+ (local.set $res
+ (call $fd_read
+ (local.get $fd) (local.get $iovs) (local.get $iovs_len)
+ (local.get $nread)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error (local.get $res) (@string "read")
+ (global.get $no_arg))))
+ (local.set $n (i32.load (local.get $nread)))
+ (call $blit_memory_to_substring (local.get $buffer)
+ (local.get $buf) (local.get $pos) (local.get $n))
+ (ref.i31 (local.get $n)))
+)
+(@else
(func (export "unix_write") (export "caml_unix_write")
(param $vfd (ref eq)) (param $vbuf (ref eq)) (param $vpos (ref eq))
(param $vlen (ref eq)) (result (ref eq))
@@ -985,7 +2255,28 @@
(struct.set $fd_offset $offset (local.get $fd_offset)
(i64.add (local.get $offset) (i64.extend_i32_s (local.get $n))))
(ref.i31 (local.get $n)))
+))
+(@if wasi
+(@then
+ (func $lseek
+ (param $fd (ref eq)) (param $offset i64) (param $cmd (ref eq))
+ (result i64)
+ (local $res i32) (local $buffer i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $fd_seek
+ (i31.get_u (ref.cast (ref i31) (local.get $fd)))
+ (local.get $offset)
+ (i31.get_u (ref.cast (ref i31) (local.get $cmd)))
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "lseek") (global.get $no_arg))))
+ (i64.load (local.get $buffer)))
+)
+(@else
(func $lseek_exn (param $errno i32) (result (ref eq))
(array.new_fixed $block 5
(ref.i31 (i32.const 0))
@@ -1021,6 +2312,7 @@
(struct.set $fd_offset $offset (local.get $fd_offset) (local.get $offset))
(struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1))
(local.get $offset))
+))
(func (export "unix_lseek") (export "caml_unix_lseek")
(param $fd (ref eq)) (param $ofs (ref eq)) (param $cmd (ref eq))
@@ -1042,6 +2334,20 @@
(call $Int64_val (local.get $ofs))
(local.get $cmd))))
+(@if wasi
+(@then
+ (func (export "unix_fsync") (export "caml_unix_fsync")
+ (param $fd (ref eq)) (result (ref eq))
+ (local $res i32)
+ (local.set $res
+ (call $fd_sync (i31.get_u (ref.cast (ref i31) (local.get $fd)))))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "fsync") (global.get $no_arg))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_fsync") (export "caml_unix_fsync")
(param $fd (ref eq)) (result (ref eq))
(try
@@ -1050,6 +2356,7 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
(@string $out_channel_of_descr "out_channel_of_descr")
(@string $in_channel_of_descr "in_channel_of_descr")
@@ -1060,6 +2367,32 @@
(global.get $in_channel_of_descr)
(local.get $out)))
+(@if wasi
+(@then
+ (func $caml_unix_check_stream_semantics (param $fd (ref eq)) (param $out i32)
+ (local $s (ref $block)) (local $kind i32)
+ (local $buffer i32) (local $res i32) (local $file_type i32)
+ (local.set $buffer (call $get_buffer))
+ (local.set $res
+ (call $fd_filestat_get
+ (i31.get_u (ref.cast (ref i31) (local.get $fd)))
+ (local.get $buffer)))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res)
+ (call $channel_of_descr_name (local.get $out))
+ (global.get $no_arg))))
+ (local.set $kind (i32.load8_u offset=16 (local.get $buffer)))
+ (block $ok
+ (block $bad
+ (br_table $bad $bad $ok $bad $ok $bad $ok $bad (local.get $kind)))
+ (call $caml_unix_error
+ (i32.const 28) (; EINVAL ;)
+ (call $channel_of_descr_name (local.get $out))
+ (global.get $no_arg))))
+)
+(@else
(func $caml_unix_check_stream_semantics (param $fd (ref eq)) (param $out i32)
(local $s (ref $block)) (local $kind i32)
(local.set $s
@@ -1085,6 +2418,7 @@
(ref.i31 (i32.const 12)) ;; EINVAL
(call $channel_of_descr_name (local.get $out))
(global.get $no_arg)))))
+))
(func (export "unix_inchannel_of_filedescr")
(export "win_inchannel_of_filedescr")
@@ -1100,6 +2434,20 @@
(call $caml_unix_check_stream_semantics (local.get $fd) (i32.const 1))
(return_call $caml_ml_open_descriptor_out (local.get $fd)))
+(@if wasi
+(@then
+ (func (export "unix_close") (export "caml_unix_close")
+ (param $fd (ref eq)) (result (ref eq))
+ (local $res i32)
+ (local.set $res
+ (call $fd_close (i31.get_u (ref.cast (ref i31) (local.get $fd)))))
+ (if (local.get $res)
+ (then
+ (call $caml_unix_error
+ (local.get $res) (@string "close") (global.get $no_arg))))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(func (export "unix_close") (export "caml_unix_close")
(param $fd (ref eq)) (result (ref eq))
(call $release_fd_offset (i31.get_u (ref.cast (ref i31) (local.get $fd))))
@@ -1109,9 +2457,18 @@
(catch $javascript_exception
(call $caml_unix_error (pop externref) (ref.null eq))))
(ref.i31 (i32.const 0)))
+))
+(@if wasi
+(@then
+ (func (export "unix_isatty") (export "caml_unix_isatty")
+ (param (ref eq)) (result (ref eq))
+ (ref.i31 (i32.const 0)))
+)
+(@else
(export "unix_isatty" (func $isatty))
(export "caml_unix_isatty" (func $isatty))
+))
(func (export "unix_getuid") (export "caml_unix_getuid")
(export "unix_geteuid") (export "caml_unix_geteuid")
diff --git a/runtime/wasm/wasi_errors.wat b/runtime/wasm/wasi_errors.wat
new file mode 100644
index 0000000000..577fb410fa
--- /dev/null
+++ b/runtime/wasm/wasi_errors.wat
@@ -0,0 +1,86 @@
+(module
+(@if wasi
+(@then
+ (type $block (array (mut (ref eq))))
+ (type $bytes (array (mut i8)))
+ (global (export "error_messages") (ref $block)
+ (array.new_fixed $block 77
+ (@string "Success")
+ (@string "Argument list too long")
+ (@string "Permission denied")
+ (@string "Address in use")
+ (@string "Address not available")
+ (@string "Address family not supported")
+ (@string "Resource unavailable, or operation would block")
+ (@string "Connection already in progress")
+ (@string "Bad file descriptor")
+ (@string "Bad message")
+ (@string "Device or resource busy")
+ (@string "Operation canceled")
+ (@string "No child processes")
+ (@string "Connection aborted")
+ (@string "Connection refused")
+ (@string "Connection reset")
+ (@string "Resource deadlock would occur")
+ (@string "Destination address required")
+ (@string "Mathematics argument out of domain of function")
+ (@string "Reserved")
+ (@string "File exists")
+ (@string "Bad address")
+ (@string "File too large")
+ (@string "Host is unreachable")
+ (@string "Identifier removed")
+ (@string "Illegal byte sequence")
+ (@string "Operation in progress")
+ (@string "Interrupted function")
+ (@string "Invalid argument")
+ (@string "I/O error")
+ (@string "Socket is connected")
+ (@string "Is a directory")
+ (@string "Too many levels of symbolic links")
+ (@string "File descriptor value too large")
+ (@string "Too many links")
+ (@string "Message too large")
+ (@string "Reserved")
+ (@string "Filename too long")
+ (@string "Network is down")
+ (@string "Connection aborted by network")
+ (@string "Network unreachable")
+ (@string "Too many files open in system")
+ (@string "No buffer space available")
+ (@string "No such device")
+ (@string "No such file or directory")
+ (@string "Executable file format error")
+ (@string "No locks available")
+ (@string "Reserved")
+ (@string "Not enough space")
+ (@string "No message of the desired type")
+ (@string "Protocol not available")
+ (@string "No space left on device")
+ (@string "Function not supported")
+ (@string "The socket is not connected")
+ (@string "Not a directory or a symbolic link to a directory")
+ (@string "Directory not empty")
+ (@string "State not recoverable")
+ (@string "Not a socket")
+ (@string "Not supported, or operation not supported on socket")
+ (@string "Inappropriate I/O control operation")
+ (@string "No such device or address")
+ (@string "Value too large to be stored in data type")
+ (@string "Previous owner died")
+ (@string "Operation not permitted")
+ (@string "Broken pipe")
+ (@string "Protocol error")
+ (@string "Protocol not supported")
+ (@string "Protocol wrong type for socket")
+ (@string "Result too large")
+ (@string "Read-only file system")
+ (@string "Invalid seek")
+ (@string "No such process")
+ (@string "Reserved")
+ (@string "Connection timed out")
+ (@string "Text file busy")
+ (@string "Cross-device link")
+ (@string "Capabilities insufficient")))
+))
+)
diff --git a/runtime/wasm/wasi_memory.wat b/runtime/wasm/wasi_memory.wat
new file mode 100644
index 0000000000..0e737a46db
--- /dev/null
+++ b/runtime/wasm/wasi_memory.wat
@@ -0,0 +1,98 @@
+(module
+(@if wasi
+(@then
+ (import "libc" "memory" (memory 2))
+ (import "libc" "malloc" (func $malloc (param i32) (result i32)))
+ (import "libc" "free" (func $free (param i32)))
+ (import "io" "IO_BUFFER_SIZE" (global $IO_BUFFER_SIZE i32))
+ (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory))
+
+ (type $bytes (array (mut i8)))
+
+ (func (export "checked_malloc") (param $size i32) (result i32)
+ (local $p i32)
+ (local.set $p (call $malloc (local.get $size)))
+ (if (i32.eqz (local.get $p))
+ (then (call $caml_raise_out_of_memory)))
+ (local.get $p))
+
+ (func (export "blit_substring_to_memory")
+ (param $buf i32) (param $s (ref $bytes)) (param $ofs i32) (param $len i32)
+ (local $i i32)
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (i32.store8 (i32.add (local.get $buf) (local.get $i))
+ (array.get $bytes (local.get $s)
+ (i32.add (local.get $ofs) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+
+ (func $blit_string_to_memory (export "blit_string_to_memory")
+ (param $buf i32) (param $s (ref $bytes))
+ (local $i i32) (local $len i32)
+ (local.set $len (array.len (local.get $s)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (i32.store8 (i32.add (local.get $buf) (local.get $i))
+ (array.get $bytes (local.get $s) (local.get $i)))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+
+ (func (export "blit_memory_to_substring")
+ (param $buf i32) (param $s (ref $bytes)) (param $ofs i32) (param $len i32)
+ (local $i i32)
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $bytes (local.get $s)
+ (i32.add (local.get $ofs) (local.get $i))
+ (i32.load8_u (i32.add (local.get $buf) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop)))))
+
+ (func $blit_memory_to_string (export "blit_memory_to_string")
+ (param $buf i32) (param $len i32) (result (ref $bytes))
+ (local $s (ref $bytes))
+ (local $i i32)
+ (local.set $s (array.new $bytes (i32.const 0) (local.get $len)))
+ (loop $loop
+ (if (i32.lt_u (local.get $i) (local.get $len))
+ (then
+ (array.set $bytes (local.get $s) (local.get $i)
+ (i32.load8_u (i32.add (local.get $buf) (local.get $i))))
+ (local.set $i (i32.add (local.get $i) (i32.const 1)))
+ (br $loop))))
+ (local.get $s))
+
+ (func (export "write_string_to_memory")
+ (param $buf i32) (param $avail i32) (param $v (ref eq))
+ (result i32)
+ (local $s (ref $bytes)) (local $i i32) (local $len i32)
+ (local.set $s (ref.cast (ref $bytes) (local.get $v)))
+ (local.set $len (array.len (local.get $s)))
+ (if (i32.lt_u (local.get $avail) (i32.add (local.get $len) (i32.const 1)))
+ (then
+ (local.set $buf
+ (call $checked_malloc (i32.add (local.get $len) (i32.const 1))))))
+ (call $blit_string_to_memory (local.get $buf) (local.get $s))
+ (i32.store8 (i32.add (local.get $buf) (local.get $len)) (i32.const 0))
+ (local.get $buf))
+
+ (func (export "release_memory") (param $initial_buffer i32) (param $buf i32)
+ (if (i32.ne (local.get $initial_buffer) (local.get $buf))
+ (then
+ (call $free (local.get $buf)))))
+
+ (global $buffer (mut i32) (i32.const 0))
+
+ (func $get_buffer (export "get_buffer") (result i32)
+ (if (i32.eqz (global.get $buffer))
+ (then
+ (global.set $buffer
+ (call $checked_malloc
+ (i32.add (global.get $IO_BUFFER_SIZE) (i32.const 12))))))
+ (global.get $buffer))
+))
+)
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
index d725cea8d4..68d5328c04 100644
--- a/runtime/wasm/weak.wat
+++ b/runtime/wasm/weak.wat
@@ -21,6 +21,19 @@
(func $caml_obj_dup (param (ref eq)) (result (ref eq))))
(import "fail" "caml_invalid_argument"
(func $caml_invalid_argument (param $arg (ref eq))))
+
+(@if wasi
+(@then
+ (func $wrap (param (ref eq)) (result (ref eq))
+ (local.get 0))
+ (func $unwrap (param (ref eq)) (result (ref eq))
+ (local.get 0))
+ (func $weak_new (param $v (ref eq)) (result (ref eq))
+ (local.get $v))
+ (func $weak_deref (param $r (ref eq)) (result (ref eq))
+ (local.get $r))
+)
+(@else
(import "bindings" "weak_new"
(func $weak_new (param (ref eq)) (result anyref)))
(import "bindings" "weak_deref"
@@ -32,6 +45,8 @@
(func $map_set (param (ref any)) (param (ref eq)) (param (ref any))))
(import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
(import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+))
+
(type $block (array (mut (ref eq))))
(type $bytes (array (mut i8)))
(type $js (struct (field anyref)))
@@ -62,6 +77,8 @@
(block $released
(br_if $no_data
(ref.eq (local.get $d) (global.get $caml_ephe_none)))
+(@if (not wasi)
+(@then
(local.set $i (global.get $caml_ephe_key_offset))
(local.set $len (array.len (local.get $x)))
(local.set $m (ref.as_non_null (call $unwrap (local.get $d))))
@@ -82,6 +99,7 @@
(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))
(local.get $d))))
@@ -111,6 +129,8 @@
(local $m (ref any)) (local $m' (ref any))
(local $i i32)
(local.set $x (ref.cast (ref $block) (local.get $vx)))
+(@if (not wasi)
+(@then
(local.set $i (array.len (local.get $x)))
(local.set $m (local.get $data))
(loop $loop
@@ -135,6 +155,7 @@
(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)
(local.get $data))
(ref.i31 (i32.const 0)))
diff --git a/runtime/wasm/zstd.wat b/runtime/wasm/zstd.wat
index 54a984aaed..dc5bff2d92 100644
--- a/runtime/wasm/zstd.wat
+++ b/runtime/wasm/zstd.wat
@@ -16,7 +16,7 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(module
-(@if (>= ocaml_version (5 1 0))
+(@if (and (>= ocaml_version (5 1 0)) (not wasi))
(@then
(import "bindings" "ta_new" (func $ta_new (param i32) (result (ref extern))))
(import "bindings" "ta_blit_from_bytes"
@@ -58,5 +58,9 @@
(func (export "caml_zstd_initialize") (param (ref eq)) (result (ref eq))
(global.set $caml_intern_decompress_input (ref.func $decompress))
(ref.i31 (i32.const 1)))
+)
+(@else
+ (func (export "caml_zstd_initialize") (param (ref eq)) (result (ref eq))
+ (ref.i31 (i32.const 0)))
))
)
From f9b58d48e413774c90f8be3b1d34b4294cb0f762 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 19 Feb 2025 11:45:49 +0100
Subject: [PATCH 03/10] WASI: support for separate compilation
---
compiler/lib-wasm/generate.ml | 34 +++++
compiler/lib-wasm/generate.mli | 3 +
compiler/lib-wasm/link.ml | 226 ++++++++++++++++++++++++++------
compiler/lib-wasm/link.mli | 8 ++
compiler/lib-wasm/runtime.ml | 2 +-
compiler/lib-wasm/wasm_link.ml | 28 ++--
compiler/lib-wasm/wasm_link.mli | 3 +-
compiler/lib/build_info.ml | 7 +-
dune | 7 +-
9 files changed, 264 insertions(+), 54 deletions(-)
diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml
index 4e89bafc8f..6773e61d6d 100644
--- a/compiler/lib-wasm/generate.ml
+++ b/compiler/lib-wasm/generate.ml
@@ -1143,6 +1143,36 @@ module Generate (Target : Target_sig.S) = struct
:: context.other_fields;
name
+ let add_missing_primitives ~context l =
+ let failwith_desc = W.Fun { params = [ Value.value ]; result = [] } in
+ List.iter l ~f:(fun (exported_name, arity) ->
+ let name = Code.Var.fresh_n exported_name in
+ let locals, body =
+ function_body
+ ~context
+ ~param_names:[]
+ ~body:
+ (let* failwith =
+ register_import ~import_module:"env" ~name:"caml_failwith" failwith_desc
+ in
+ let* msg =
+ Constant.translate (String (exported_name ^ " not implemented"))
+ in
+ let* () = instr (CallInstr (failwith, [ msg ])) in
+ push Value.unit)
+ in
+ context.other_fields <-
+ W.Function
+ { name
+ ; exported_name = Some exported_name
+ ; typ = None
+ ; signature = func_type arity
+ ; param_names = []
+ ; locals
+ ; body
+ }
+ :: context.other_fields)
+
let entry_point context toplevel_fun entry_name =
let signature, param_names, body = entry_point ~toplevel_fun in
let locals, body = function_body ~context ~param_names ~body in
@@ -1300,6 +1330,10 @@ let add_start_function = G.add_start_function
let add_init_function = G.add_init_function
+let add_missing_primitives =
+ let module G = Generate (Gc_target) in
+ G.add_missing_primitives
+
let output ch ~context =
let t = Timer.make () in
let fields = G.output ~context in
diff --git a/compiler/lib-wasm/generate.mli b/compiler/lib-wasm/generate.mli
index 79408d8cb6..4ada928d41 100644
--- a/compiler/lib-wasm/generate.mli
+++ b/compiler/lib-wasm/generate.mli
@@ -33,6 +33,9 @@ val add_start_function : context:Code_generation.context -> Wasm_ast.var -> unit
val add_init_function : context:Code_generation.context -> to_link:string list -> unit
+val add_missing_primitives :
+ context:Code_generation.context -> (string * int) list -> unit
+
val output : out_channel -> context:Code_generation.context -> unit
val wasm_output : out_channel -> context:Code_generation.context -> unit
diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml
index f56bd9e500..c86ee2cc31 100644
--- a/compiler/lib-wasm/link.ml
+++ b/compiler/lib-wasm/link.ml
@@ -181,12 +181,13 @@ module Wasm_binary = struct
let reftype ch = reftype' (input_byte ch) ch
- let valtype ch =
- let i = read_uint ch in
+ let valtype' i ch =
match i with
- | 0x7b | 0x7c | 0x7d | 0x7e | 0x7f -> ()
+ | 0x7B | 0x7C | 0x7D | 0x7E | 0x7F -> ()
| _ -> reftype' i ch
+ let valtype ch = valtype' (read_uint ch) ch
+
let limits ch =
match input_byte ch with
| 0 -> ignore (read_uint ch)
@@ -201,32 +202,95 @@ module Wasm_binary = struct
reftype ch;
limits ch
+ type comptype =
+ | Func of { arity : int }
+ | Struct
+ | Array
+
+ let supertype ch =
+ match input_byte ch with
+ | 0 -> ()
+ | 1 -> ignore (read_uint ch)
+ | _ -> assert false
+
+ let storagetype ch =
+ let i = read_uint ch in
+ match i with
+ | 0x78 | 0x77 -> ()
+ | _ -> valtype' i ch
+
+ let fieldtype ch =
+ storagetype ch;
+ ignore (input_byte ch)
+
+ let comptype i ch =
+ match i with
+ | 0x5E ->
+ fieldtype ch;
+ Array
+ | 0x5F ->
+ ignore (vec fieldtype ch);
+ Struct
+ | 0x60 ->
+ let params = vec valtype ch in
+ let _ = vec valtype ch in
+ Func { arity = List.length params }
+ | c -> failwith (Printf.sprintf "Unknown comptype %d" c)
+
+ let subtype i ch =
+ match i with
+ | 0x50 ->
+ supertype ch;
+ comptype (input_byte ch) ch
+ | 0x4F ->
+ supertype ch;
+ comptype (input_byte ch) ch
+ | _ -> comptype i ch
+
+ let rectype ch =
+ match input_byte ch with
+ | 0x4E -> vec (fun ch -> subtype (input_byte ch) ch) ch
+ | i -> [ subtype i ch ]
+
+ type importdesc =
+ | Func of int
+ | Table
+ | Mem
+ | Global
+ | Tag
+
type import =
{ module_ : string
; name : string
+ ; desc : importdesc
}
let import ch =
let module_ = name ch in
let name = name ch in
let d = read_uint ch in
- let _ =
+ let desc =
match d with
- | 0 -> ignore (read_uint ch)
- | 1 -> tabletype ch
- | 2 -> memtype ch
+ | 0 -> Func (read_uint ch)
+ | 1 ->
+ tabletype ch;
+ Table
+ | 2 ->
+ memtype ch;
+ Mem
| 3 ->
let _typ = valtype ch in
let _mut = input_byte ch in
- ()
+ Global
| 4 ->
assert (read_uint ch = 0);
- ignore (read_uint ch)
+ ignore (read_uint ch);
+ Tag
| _ ->
Format.eprintf "Unknown import %x@." d;
assert false
in
- { module_; name }
+ { module_; name; desc }
let export ch =
let name = name ch in
@@ -256,6 +320,7 @@ module Wasm_binary = struct
type interface =
{ imports : import list
; exports : string list
+ ; types : comptype array
}
let read_interface ch =
@@ -263,7 +328,11 @@ module Wasm_binary = struct
match next_section ch with
| None -> i
| Some s ->
- if s.id = 2
+ if s.id = 1
+ then
+ find_sections
+ { i with types = Array.of_list (List.flatten (vec rectype ch.ch)) }
+ else if s.id = 2
then find_sections { i with imports = vec import ch.ch }
else if s.id = 7
then { i with exports = vec export ch.ch }
@@ -271,7 +340,7 @@ module Wasm_binary = struct
skip_section ch s;
find_sections i)
in
- find_sections { imports = []; exports = [] }
+ find_sections { imports = []; exports = []; types = [||] }
let append_source_map_section ~file ~url =
let ch = open_out_gen [ Open_wronly; Open_append; Open_binary ] 0o666 file in
@@ -405,6 +474,13 @@ let generate_start_function ~to_link ~out_file =
Generate.wasm_output ch ~context;
if times () then Format.eprintf " generate start: %a@." Timer.print t1
+let generate_missing_primitives ~missing_primitives ~out_file =
+ Filename.gen_file out_file
+ @@ fun ch ->
+ let context = Generate.start () in
+ Generate.add_missing_primitives ~context missing_primitives;
+ Generate.wasm_output ch ~context
+
let output_js js =
let js = Driver.simplify_js js in
let js = Driver.name_variables js in
@@ -642,17 +718,20 @@ let compute_dependencies ~files_to_link ~files =
let compute_missing_primitives (runtime_intf, intfs) =
let provided_primitives = StringSet.of_list runtime_intf.Wasm_binary.exports in
- StringSet.elements
+ StringMap.bindings
@@ List.fold_left
- ~f:(fun s { Wasm_binary.imports; _ } ->
+ ~f:(fun s { Wasm_binary.imports; types; _ } ->
List.fold_left
- ~f:(fun s { Wasm_binary.module_; name; _ } ->
- if String.equal module_ "env" && not (StringSet.mem name provided_primitives)
- then StringSet.add name s
- else s)
+ ~f:(fun s { Wasm_binary.module_; name; desc } ->
+ match module_, desc with
+ | "env", Func idx when not (StringSet.mem name provided_primitives) -> (
+ match types.(idx) with
+ | Func { arity } -> StringMap.add name arity s
+ | _ -> s)
+ | _ -> s)
~init:s
imports)
- ~init:StringSet.empty
+ ~init:StringMap.empty
intfs
let load_information files =
@@ -688,6 +767,72 @@ let gen_dir dir f =
remove_directory d_tmp;
raise exc
+let link_to_module ~to_link ~files_to_link ~files ~enable_source_maps:_ ~dir =
+ let process_file ~name ~module_name file =
+ Zip.with_open_in file
+ @@ fun z ->
+ let intf =
+ let ch, pos, len, _ = Zip.get_entry z ~name in
+ Wasm_binary.read_interface (Wasm_binary.from_channel ~name ch pos len)
+ in
+ ( { Wasm_link.module_name
+ ; file
+ ; code = Some (Zip.read_entry z ~name)
+ ; opt_source_map = None
+ }
+ , intf )
+ in
+ let runtime_file = fst (List.hd files) in
+ let z = Zip.open_in runtime_file in
+ let runtime, runtime_intf =
+ process_file ~name:"runtime.wasm" ~module_name:"env" runtime_file
+ in
+ let prelude =
+ { Wasm_link.module_name = "OCaml"
+ ; file = runtime_file
+ ; code = Some (Zip.read_entry z ~name:"prelude.wasm")
+ ; opt_source_map = None
+ }
+ in
+ Zip.close_in z;
+ let lst =
+ List.tl files
+ |> List.filter_map ~f:(fun (file, _) ->
+ if StringSet.mem file files_to_link
+ then Some (process_file ~name:"code.wasm" ~module_name:"OCaml" file)
+ else None)
+ in
+ let missing_primitives =
+ if Config.Flag.genprim ()
+ then compute_missing_primitives (runtime_intf, List.map ~f:snd lst)
+ else []
+ in
+ Fs.with_intermediate_file (Filename.temp_file "start" ".wasm")
+ @@ fun start_module ->
+ generate_start_function ~to_link ~out_file:start_module;
+ let start =
+ { Wasm_link.module_name = "OCaml"
+ ; file = start_module
+ ; code = None
+ ; opt_source_map = None
+ }
+ in
+ Fs.with_intermediate_file (Filename.temp_file "stubs" ".wasm")
+ @@ fun stubs_module ->
+ generate_missing_primitives ~missing_primitives ~out_file:stubs_module;
+ let missing_primitives =
+ { Wasm_link.module_name = "env"
+ ; file = stubs_module
+ ; code = None
+ ; opt_source_map = None
+ }
+ in
+ ignore
+ (Wasm_link.f
+ (runtime :: prelude :: missing_primitives :: start :: List.map ~f:fst lst)
+ ~filter_export:(fun nm -> String.equal nm "_start" || String.equal nm "memory")
+ ~output_file:(Filename.concat dir "code.wasm"))
+
let link ~output_file ~linkall ~enable_source_maps ~files =
if times () then Format.eprintf "linking@.";
let t = Timer.make () in
@@ -778,30 +923,35 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
if times () then Format.eprintf " finding what to link: %a@." Timer.print t1;
if times () then Format.eprintf " scan: %a@." Timer.print t;
let t = Timer.make () in
- let interfaces, wasm_dir, link_spec =
+ let missing_primitives, wasm_dir, link_spec =
let dir = Filename.chop_extension output_file ^ ".assets" in
gen_dir dir
@@ fun tmp_dir ->
Sys.mkdir tmp_dir 0o777;
- let start_module =
- "start-"
- ^ String.sub
- (Digest.to_hex (Digest.string (String.concat ~sep:"/" to_link)))
- ~pos:0
- ~len:8
- in
- generate_start_function
- ~to_link
- ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm"));
- let module_names, interfaces =
- link_to_directory ~files_to_link ~files ~enable_source_maps ~dir:tmp_dir
- in
- ( interfaces
- , dir
- , let to_link = compute_dependencies ~files_to_link ~files in
- List.combine module_names (None :: None :: to_link) @ [ start_module, None ] )
+ if not (Config.Flag.wasi ())
+ then (
+ let start_module =
+ "start-"
+ ^ String.sub
+ (Digest.to_hex (Digest.string (String.concat ~sep:"/" to_link)))
+ ~pos:0
+ ~len:8
+ in
+ let module_names, interfaces =
+ link_to_directory ~files_to_link ~files ~enable_source_maps ~dir:tmp_dir
+ in
+ let missing_primitives = compute_missing_primitives interfaces in
+ generate_start_function
+ ~to_link
+ ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm"));
+ ( List.map ~f:fst missing_primitives
+ , dir
+ , let to_link = compute_dependencies ~files_to_link ~files in
+ List.combine module_names (None :: None :: to_link) @ [ start_module, None ] ))
+ else (
+ link_to_module ~to_link ~files_to_link ~files ~enable_source_maps ~dir:tmp_dir;
+ [], dir, [ "code", None ])
in
- let missing_primitives = compute_missing_primitives interfaces in
if times () then Format.eprintf " copy wasm files: %a@." Timer.print t;
let t1 = Timer.make () in
let js_runtime =
diff --git a/compiler/lib-wasm/link.mli b/compiler/lib-wasm/link.mli
index b52681ee92..ec7675ead1 100644
--- a/compiler/lib-wasm/link.mli
+++ b/compiler/lib-wasm/link.mli
@@ -19,9 +19,17 @@
open Stdlib
module Wasm_binary : sig
+ type importdesc =
+ | Func of int
+ | Table
+ | Mem
+ | Global
+ | Tag
+
type import =
{ module_ : string
; name : string
+ ; desc : importdesc
}
val check : contents:string -> bool
diff --git a/compiler/lib-wasm/runtime.ml b/compiler/lib-wasm/runtime.ml
index f7f1df4c0d..0d6ad06459 100644
--- a/compiler/lib-wasm/runtime.ml
+++ b/compiler/lib-wasm/runtime.ml
@@ -31,7 +31,7 @@ let build ~allowed_imports ~link_options ~opt_options ~variables ~inputs ~output
then (
Format.eprintf "The runtime contains unknown imports:@.";
List.iter
- ~f:(fun { Link.Wasm_binary.module_; name } ->
+ ~f:(fun { Link.Wasm_binary.module_; name; _ } ->
Format.eprintf " %s %s@." module_ name)
missing_imports;
exit 2))
diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
index 5872f1f945..ff23599028 100644
--- a/compiler/lib-wasm/wasm_link.ml
+++ b/compiler/lib-wasm/wasm_link.ml
@@ -1884,7 +1884,7 @@ type input =
; opt_source_map : Source_map.Standard.t option
}
-let f files ~output_file =
+let f ?(filter_export = fun _ -> true) files ~output_file =
let files =
Array.map
~f:(fun { module_name; file; code; opt_source_map } ->
@@ -2138,20 +2138,28 @@ let f files ~output_file =
Array.iter ~f:Scan.clear_position_data positions;
(* 7: export *)
+ let exports =
+ Array.map
+ ~f:(fun intf ->
+ map_exportable_info
+ (fun _ exports -> List.filter ~f:(fun (nm, _) -> filter_export nm) exports)
+ intf.Read.exports)
+ intfs
+ in
let export_count =
Array.fold_left
- ~f:(fun count intf ->
+ ~f:(fun count exports ->
fold_exportable_info
(fun _ exports count -> List.length exports + count)
count
- intf.Read.exports)
+ exports)
~init:0
- intfs
+ exports
in
Write.uint buf export_count;
- let exports = Hashtbl.create 128 in
+ let export_tbl = Hashtbl.create 128 in
Array.iteri
- ~f:(fun i intf ->
+ ~f:(fun i exports ->
iter_exportable_info
(fun kind lst ->
let map =
@@ -2164,7 +2172,7 @@ let f files ~output_file =
in
List.iter
~f:(fun (name, idx) ->
- match Hashtbl.find exports name with
+ match Hashtbl.find export_tbl name with
| i' ->
failwith
(Printf.sprintf
@@ -2173,11 +2181,11 @@ let f files ~output_file =
files.(i').file
files.(i).file)
| exception Not_found ->
- Hashtbl.add exports name i;
+ Hashtbl.add export_tbl name i;
Write.export buf kind name map.(idx))
lst)
- intf.Read.exports)
- intfs;
+ exports)
+ exports;
add_section out_ch ~id:7 buf;
(* 8: start *)
diff --git a/compiler/lib-wasm/wasm_link.mli b/compiler/lib-wasm/wasm_link.mli
index 0c0ed0a582..4cbd769668 100644
--- a/compiler/lib-wasm/wasm_link.mli
+++ b/compiler/lib-wasm/wasm_link.mli
@@ -23,4 +23,5 @@ type input =
; opt_source_map : Source_map.Standard.t option
}
-val f : input list -> output_file:string -> Source_map.t
+val f :
+ ?filter_export:(string -> bool) -> input list -> output_file:string -> Source_map.t
diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml
index 4de9956edf..b5da01bbb4 100644
--- a/compiler/lib/build_info.ml
+++ b/compiler/lib/build_info.ml
@@ -68,6 +68,7 @@ let create kind =
| v -> Printf.sprintf "%s+%s" Compiler_version.s v
in
[ "use-js-string", string_of_bool (Config.Flag.use_js_string ())
+ ; "wasi", string_of_bool (Config.Flag.wasi ())
; "effects", string_of_effects_backend (Config.effects ())
; "version", version
; "kind", string_of_kind kind
@@ -139,9 +140,9 @@ let merge fname1 info1 fname2 info2 =
match k, v1, v2 with
| "kind", v1, v2 ->
if Option.equal String.equal v1 v2 then v1 else Some (string_of_kind `Unknown)
- | ("effects" | "use-js-string" | "version"), Some v1, Some v2
+ | ("effects" | "use-js-string" | "wasi" | "version"), Some v1, Some v2
when String.equal v1 v2 -> Some v1
- | (("effects" | "use-js-string" | "version") as key), v1, v2 ->
+ | (("effects" | "use-js-string" | "wasi" | "version") as key), v1, v2 ->
raise
(Incompatible_build_info { key; first = fname1, v1; second = fname2, v2 })
| _, Some v1, Some v2 when String.equal v1 v2 -> Some v1
@@ -156,7 +157,7 @@ let configure t =
StringMap.iter
(fun k v ->
match k with
- | "use-js-string" -> Config.Flag.set k (bool_of_string v)
+ | "use-js-string" | "wasi" -> Config.Flag.set k (bool_of_string v)
| "effects" -> Config.set_effects_backend (effects_backend_of_string v)
| _ -> ())
t
diff --git a/dune b/dune
index 150a7dacbd..269ff73035 100644
--- a/dune
+++ b/dune
@@ -32,9 +32,14 @@
(tools/node_wrapper.exe as node.exe)))
(wasi
(wasm_of_ocaml
+ (build_runtime_flags
+ (:standard
+ --enable
+ wasi
+ (:include wasi_extra_flags)))
(flags
(:standard --pretty --enable wasi))
- (compilation_mode whole_program))
+ (compilation_mode separate))
(binaries
(tools/node_wrapper.exe as node)
(tools/node_wrapper.exe as node.exe)))
From 93dadf8adb1b2d355a716bf47d41131f27546755 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 14 Feb 2025 10:40:26 +0100
Subject: [PATCH 04/10] Add flag trap-on-exception
To test with Wasm engines which do not support exceptions
---
compiler/bin-wasm_of_ocaml/compile.ml | 1 +
compiler/bin-wasm_of_ocaml/gen/gen.ml | 2 +-
compiler/lib-wasm/binaryen.ml | 7 +--
compiler/lib-wasm/wat_output.ml | 40 ++++++++++-------
compiler/lib-wasm/wat_preprocess.ml | 63 +++++++++++++++++++++++++++
compiler/lib/config.ml | 2 +
compiler/lib/config.mli | 2 +
7 files changed, 98 insertions(+), 19 deletions(-)
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 14df5cdb94..def4ad4d5a 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -94,6 +94,7 @@ let build_runtime ~runtime_file =
| `Cps -> "cps"
| `Double_translation -> assert false) )
; "wasi", Wat_preprocess.Bool (Config.Flag.wasi ())
+ ; "trap-on-exception", Wat_preprocess.Bool (Config.Flag.trap_on_exception ())
]
in
match
diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml
index 574e5f2c1d..8da7f7258e 100644
--- a/compiler/bin-wasm_of_ocaml/gen/gen.ml
+++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml
@@ -32,7 +32,7 @@ let check_js_file fname =
(* Keep the two variables below in sync with function build_runtime in
../compile.ml *)
-let default_flags = []
+let default_flags = [ "trap-on-exception", `B false ]
let interesting_runtimes =
[ [ "effects", `S "jspi"; "wasi", `B false ]
diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml
index 86e07bc492..241a373137 100644
--- a/compiler/lib-wasm/binaryen.ml
+++ b/compiler/lib-wasm/binaryen.ml
@@ -112,9 +112,9 @@ let dead_code_elimination
filter_unused_primitives primitives usage_file
let optimization_options =
- [| [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
- ; [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
- ; [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+ [| [ "-O2"; "--skip-pass=inlining-optimizing" ]
+ ; [ "-O2"; "--skip-pass=inlining-optimizing" ]
+ ; [ "-O3"; "--skip-pass=inlining-optimizing" ]
|]
let optimize
@@ -134,6 +134,7 @@ let optimize
command
("wasm-opt"
:: (common_options ()
+ @ (if Config.Flag.trap_on_exception () then [] else [ "--traps-never-happen" ])
@ Option.value ~default:optimization_options.(level - 1) options
@ [ Filename.quote input_file; "-o"; Filename.quote output_file ])
@ opt_flag "--input-source-map" opt_input_sourcemap
diff --git a/compiler/lib-wasm/wat_output.ml b/compiler/lib-wasm/wat_output.ml
index 6f6e0915a7..9af9457043 100644
--- a/compiler/lib-wasm/wat_output.ml
+++ b/compiler/lib-wasm/wat_output.ml
@@ -460,19 +460,23 @@ let expression_or_instructions ctx st in_function =
@ [ List (Atom "else" :: expression iff) ])
]
| Try (ty, body, catches) ->
- [ List
- (Atom "try"
- :: (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))
- ]
+ if Config.Flag.trap_on_exception ()
+ then [ List (Atom "block" :: (block_type st ty @ instructions body)) ]
+ else
+ [ List
+ (Atom "try"
+ :: (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))
+ ]
| ExternConvertAny e' -> [ List (Atom "extern.convert_any" :: expression e') ]
and instruction i =
match i with
@@ -516,8 +520,14 @@ let expression_or_instructions ctx st in_function =
| None -> []
| Some e -> expression e))
]
- | Throw (tag, e) -> [ List (Atom "throw" :: index st.tag_names tag :: expression e) ]
- | Rethrow i -> [ List [ Atom "rethrow"; Atom (string_of_int i) ] ]
+ | Throw (tag, e) ->
+ if Config.Flag.trap_on_exception ()
+ then [ List [ Atom "unreachable" ] ]
+ else [ List (Atom "throw" :: index st.tag_names tag :: expression e) ]
+ | Rethrow i ->
+ if Config.Flag.trap_on_exception ()
+ then [ List [ Atom "unreachable" ] ]
+ else [ List [ Atom "rethrow"; Atom (string_of_int i) ] ]
| CallInstr (f, l) ->
[ List
(Atom "call"
diff --git a/compiler/lib-wasm/wat_preprocess.ml b/compiler/lib-wasm/wat_preprocess.ml
index c3ef91b88a..b468a550a4 100644
--- a/compiler/lib-wasm/wat_preprocess.ml
+++ b/compiler/lib-wasm/wat_preprocess.ml
@@ -416,6 +416,69 @@ let rec rewrite_list st l = List.iter ~f:(rewrite st) l
and rewrite st elt =
match elt with
+ | { desc =
+ List
+ ({ desc = Atom "try"; _ }
+ :: { desc = List ({ desc = Atom "result"; _ } :: _)
+ ; loc = pos_before_result, pos_after_result
+ }
+ :: { desc = List ({ desc = Atom "do"; loc = _, pos_after_do } :: body)
+ ; loc = _, pos_after_body
+ }
+ :: _)
+ ; loc = pos, pos'
+ }
+ when variable_is_set st "trap-on-exception" ->
+ write st pos;
+ Buffer.add_string st.buf "(block";
+ skip st pos_before_result;
+ write st pos_after_result;
+ skip st pos_after_do;
+ rewrite_list st body;
+ write st pos_after_body;
+ skip st pos'
+ | { desc =
+ List
+ ({ desc = Atom "try"; _ }
+ :: { desc = List ({ desc = Atom "do"; loc = _, pos_after_do } :: body)
+ ; loc = _, pos_after_body
+ }
+ :: _)
+ ; loc = pos, pos'
+ }
+ when variable_is_set st "trap-on-exception" ->
+ write st pos;
+ Buffer.add_string st.buf "(block";
+ skip st pos_after_do;
+ rewrite_list st body;
+ write st pos_after_body;
+ skip st pos'
+ | { desc = List ({ desc = Atom "throw"; _ } :: _); loc = pos, pos' }
+ when variable_is_set st "trap-on-exception" ->
+ write st pos;
+ Buffer.add_string st.buf "(unreachable)";
+ skip st pos'
+ | { desc = List ({ desc = Atom "tag"; _ } :: _); loc = pos, pos' }
+ | { desc =
+ List
+ ({ desc = Atom "import"; _ }
+ :: _
+ :: _
+ :: { desc = List ({ desc = Atom "tag"; _ } :: _); _ }
+ :: _)
+ ; loc = pos, pos'
+ }
+ | { desc =
+ List
+ ({ desc = Atom "export"; _ }
+ :: _
+ :: { desc = List ({ desc = Atom "tag"; _ } :: _); _ }
+ :: _)
+ ; loc = pos, pos'
+ }
+ when variable_is_set st "trap-on-exception" ->
+ write st pos;
+ skip st pos'
| { desc =
List
[ { desc = Atom "@if"; _ }
diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml
index e9217aac3c..2ec1b9dd61 100644
--- a/compiler/lib/config.ml
+++ b/compiler/lib/config.ml
@@ -103,6 +103,8 @@ module Flag = struct
let es6 = o ~name:"es6" ~default:false
let wasi = o ~name:"wasi" ~default:false
+
+ let trap_on_exception = o ~name:"trap-on-exception" ~default:false
end
module Param = struct
diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli
index a4f7a5538f..a05274a2bd 100644
--- a/compiler/lib/config.mli
+++ b/compiler/lib/config.mli
@@ -78,6 +78,8 @@ module Flag : sig
val wasi : unit -> bool
+ val trap_on_exception : unit -> bool
+
val enable : string -> unit
val disable : string -> unit
From 2b37bcbdf3f0a9b5128b2f37479985371a1110d5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 14 Feb 2025 13:05:37 +0100
Subject: [PATCH 05/10] Node wrapper: support for using alternative Wasm
engines
---
tools/ci_setup.ml | 1 +
tools/dune | 11 ++++++++++-
tools/node_wrapper.ml | 44 ++++++++++++++++++++++++++++++++++++-------
3 files changed, 48 insertions(+), 8 deletions(-)
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index 4cb1867dea..94efd01e0c 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -64,6 +64,7 @@ let node_wrapper =
(name node_wrapper)
(libraries unix))|} )
; "node_wrapper/node_wrapper_per_profile.ml", {|let args = []|}
+ ; "node_wrapper/node_wrapper_per_engine.ml", {|let engine = "node"|}
; "node_wrapper/dune-project", "(lang dune 3.17)"
; "node_wrapper/node_wrapper.opam", ""
]
diff --git a/tools/dune b/tools/dune
index 5953c6bc08..e478bcbf98 100644
--- a/tools/dune
+++ b/tools/dune
@@ -1,8 +1,17 @@
(executable
(name node_wrapper)
- (modules node_wrapper)
+ (link_deps
+ (env_var WASM_ENGINE))
+ (modules node_wrapper node_wrapper_per_engine)
(libraries unix))
+(rule
+ (target node_wrapper_per_engine.ml)
+ (action
+ (with-stdout-to
+ %{target}
+ (run echo "let engine = \"%{env:WASM_ENGINE=node}\""))))
+
(executable
(name ci_setup)
(modules ci_setup)
diff --git a/tools/node_wrapper.ml b/tools/node_wrapper.ml
index 9d58203591..a967c00d26 100644
--- a/tools/node_wrapper.ml
+++ b/tools/node_wrapper.ml
@@ -1,6 +1,21 @@
+let wizard_args =
+ [ "-ext:stack-switching"; "-ext:legacy-eh"; "-stack-size=2M"; "--dir=."; "--dir=/tmp" ]
+
+let wasmtime_args =
+ [ (* "-C"; "collector=null"; *) "-W=all-proposals=y"; "--dir=."; "--dir=/tmp" ]
+
+let wasmedge_args =
+ [ "--enable-gc"
+ ; "--enable-exception-handling"
+ ; "--enable-tail-call"
+ ; "--dir=."
+ ; "--dir=/tmp"
+ ]
+
let extra_args_for_wasoo =
[ "--experimental-wasm-imported-strings"
; "--experimental-wasm-stack-switching"
+ ; "--experimental-wasm-exnref"
; "--stack-size=10000"
]
@@ -23,16 +38,31 @@ let env =
else e)
env
-let args =
+let environment_args () =
+ List.filter
+ (fun e -> not (String.contains e ','))
+ (Array.to_list (Array.map (fun e -> "--env=" ^ e) env))
+
+let wasm_file file =
+ Filename.concat (Filename.chop_extension file ^ ".assets") "code.wasm"
+
+let common_args file argv = environment_args () @ (wasm_file file :: List.tl argv)
+
+let exe, args =
match Array.to_list Sys.argv with
| exe :: argv ->
- let argv =
+ let exe', argv =
match argv with
- | file :: _ when Filename.check_suffix file ".wasm.js" ->
- extra_args_for_wasoo @ argv
- | _ -> extra_args_for_jsoo @ argv
+ | file :: _ when Filename.check_suffix file ".wasm.js" -> (
+ match Node_wrapper_per_engine.engine with
+ | "wizard" -> "wizeng.x86-linux", wizard_args @ common_args file argv
+ | "wizard-fast" -> "wizeng.x86-64-linux", wizard_args @ common_args file argv
+ | "wasmtime" -> "wasmtime", wasmtime_args @ common_args file argv
+ | "wasmedge" -> "wasmedge", wasmedge_args @ common_args file argv
+ | _ -> "node", extra_args_for_wasoo @ argv)
+ | _ -> "node", extra_args_for_jsoo @ argv
in
- Array.of_list (exe :: argv)
+ exe', Array.of_list (exe :: argv)
| [] -> assert false
let () =
@@ -45,4 +75,4 @@ let () =
| _, WEXITED n -> exit n
| _, WSIGNALED _ -> exit 9
| _, WSTOPPED _ -> exit 9
- else Unix.execvpe "node" args env
+ else Unix.execvpe exe args env
From 755bb00e3fc9250fa61af8f4d458ad697151eb3e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 14 Feb 2025 13:06:30 +0100
Subject: [PATCH 06/10] CI updates
---
.github/workflows/build-wasm_of_ocaml.yml | 60 ++++++++++++++++++++++-
dune | 13 ++++-
2 files changed, 70 insertions(+), 3 deletions(-)
diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 70f4c5ab10..adeb1180df 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -16,6 +16,8 @@ jobs:
matrix:
os:
- ubuntu-latest
+ os-name:
+ - Ubuntu
ocaml-compiler:
- "4.14"
- "5.0"
@@ -27,30 +29,50 @@ jobs:
- false
all_jane_street_tests:
- false
+ wasi:
+ - false
include:
- os: macos-latest
+ os-name: MacOS
ocaml-compiler: "5.3"
separate_compilation: true
jane_street_tests: false
all_jane_street_tests: false
+ wasi: false
- os: windows-latest
+ os-name: Windows
ocaml-compiler: "5.2"
separate_compilation: true
jane_street_tests: true
all_jane_street_tests: true
+ wasi: false
- os: ubuntu-latest
+ os-name: Ubuntu
ocaml-compiler: "5.2"
separate_compilation: true
jane_street_tests: true
all_jane_street_tests: true
+ wasi: false
- os: ubuntu-latest
+ os-name: Ubuntu
ocaml-compiler: "5.2"
separate_compilation: false
jane_street_tests: true
all_jane_street_tests: false
+ wasi: false
+ - os: ubuntu-latest
+ os-name: Ubuntu
+ ocaml-compiler: "5.3"
+ separate_compilation: true
+ jane_street_tests: false
+ all_jane_street_tests: false
+ wasi: true
runs-on: ${{ matrix.os }}
+ name:
+ ${{ matrix.wasi && 'WASI / ' || '' }}${{ (! matrix.separate_compilation) && 'Whole program / ' || ''}}${{ matrix.ocaml-compiler }} / ${{ matrix.os-name }}${{ matrix.all_jane_street_tests && ' / Jane Street tests' || ''}}
+
steps:
- name: Set git to use LF
if: ${{ matrix.os == 'windows-latest' && matrix.ocaml-compiler < 5.2 }}
@@ -77,6 +99,25 @@ jobs:
with:
node-version: latest
+ - name: Set-up Rust toolchain
+ if: matrix.wasi
+ uses: actions-rust-lang/setup-rust-toolchain@v1
+
+ - name: Checkout Wasmtime
+ if: matrix.wasi
+ uses: actions/checkout@v4
+ with:
+ repository: bytecodealliance/wasmtime
+ path: wasmtime
+ submodules: true
+
+ - name: Build Wasmtime
+ if: matrix.wasi
+ working-directory: ./wasmtime
+ run: |
+ cargo build
+ echo `pwd`/target/debug >> "$GITHUB_PATH"
+
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
with:
@@ -129,7 +170,7 @@ jobs:
opam install . -t
- name: Run tests
- if: ${{ matrix.separate_compilation }}
+ if: ${{ matrix.separate_compilation && ! matrix.wasi }}
working-directory: ./wasm_of_ocaml
run: opam exec -- dune build @runtest-wasm
@@ -138,11 +179,26 @@ jobs:
# See https://github.com/libuv/libuv/issues/3622
- name: Run tests with CPS effects
- if: ${{ matrix.ocaml-compiler >= '5.' && matrix.separate_compilation }}
+ if: ${{ matrix.ocaml-compiler >= '5.' && matrix.separate_compilation && ! matrix.wasi }}
continue-on-error: ${{ matrix.os == 'windows-latest' }}
working-directory: ./wasm_of_ocaml
run: opam exec -- dune build @runtest-wasm --profile with-effects
+ - name: Run tests (WASI runtime - node)
+ if: ${{ matrix.wasi }}
+ working-directory: ./wasm_of_ocaml
+ run: opam exec -- dune build @runtest-wasm --profile wasi
+
+ - name: Run tests (WASI runtime - wasmtime)
+ if: ${{ matrix.wasi }}
+ working-directory: ./wasm_of_ocaml
+ env:
+ WASM_ENGINE: wasmtime
+ WASI_FLAGS: --enable trap-on-exception
+ RUST_BACKTRACE: 0
+ continue-on-error: true
+ run: opam exec -- dune build @runtest-wasm --profile wasi
+
- name: Run Base tests
if: matrix.all_jane_street_tests
continue-on-error: ${{ matrix.os == 'windows-latest' }}
diff --git a/dune b/dune
index 269ff73035..21183b243c 100644
--- a/dune
+++ b/dune
@@ -38,7 +38,11 @@
wasi
(:include wasi_extra_flags)))
(flags
- (:standard --pretty --enable wasi))
+ (:standard
+ --pretty
+ --enable
+ wasi
+ (:include wasi_extra_flags)))
(compilation_mode separate))
(binaries
(tools/node_wrapper.exe as node)
@@ -68,6 +72,13 @@
%{dep:VERSION}
%{dep:tools/version/GIT-VERSION}))))
+(rule
+ (targets wasi_extra_flags)
+ (action
+ (with-stdout-to
+ %{targets}
+ (echo "(%{env:WASI_FLAGS=})"))))
+
(data_only_dirs _wikidoc doc-dev janestreet)
(vendored_dirs)
From 758e588f13ea9a9b81f970b27339a3d9bdb2d105 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 6 Feb 2025 19:07:05 +0100
Subject: [PATCH 07/10] CI: use Wizard engine as well
---
.github/workflows/build-wasm_of_ocaml.yml | 36 +++++++++++++++++++++++
1 file changed, 36 insertions(+)
diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index adeb1180df..0ea62aea44 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -118,6 +118,35 @@ jobs:
cargo build
echo `pwd`/target/debug >> "$GITHUB_PATH"
+ - name: Checkout Virgil
+ if: matrix.wasi
+ uses: actions/checkout@v4
+ with:
+ repository: titzer/virgil
+ path: virgil
+
+ - name: Build Virgil
+ if: matrix.wasi
+ working-directory: ./virgil
+ run: |
+ export PATH=$PATH:`pwd`/bin
+ echo `pwd`/bin >> "$GITHUB_PATH"
+ make
+
+ - name: Checkout Wizard engine
+ if: matrix.wasi
+ uses: actions/checkout@v4
+ with:
+ repository: titzer/wizard-engine
+ path: wizard-engine
+
+ - name: Build Wizard engine
+ if: matrix.wasi
+ working-directory: ./wizard-engine
+ run: |
+ make -j 4
+ echo `pwd`/bin >> "$GITHUB_PATH"
+
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
with:
@@ -189,6 +218,13 @@ jobs:
working-directory: ./wasm_of_ocaml
run: opam exec -- dune build @runtest-wasm --profile wasi
+ - name: Run tests (WASI runtime - Wizard engine)
+ if: ${{ matrix.wasi }}
+ working-directory: ./wasm_of_ocaml
+ env:
+ WASM_ENGINE: wizard-fast
+ run: opam exec -- dune build @runtest-wasm --profile wasi
+
- name: Run tests (WASI runtime - wasmtime)
if: ${{ matrix.wasi }}
working-directory: ./wasm_of_ocaml
From 436e9a4fdb11eee161d1e7c1b6486a8d3356c585 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 6 Feb 2025 18:59:36 +0100
Subject: [PATCH 08/10] CI: install a version on Binaryen with stack-switching
support
---
.github/actions/install-binaryen/action.yml | 90 +++++++++++++++++++++
.github/workflows/build-wasm_of_ocaml.yml | 6 +-
.github/workflows/build.yml | 6 +-
3 files changed, 96 insertions(+), 6 deletions(-)
create mode 100644 .github/actions/install-binaryen/action.yml
diff --git a/.github/actions/install-binaryen/action.yml b/.github/actions/install-binaryen/action.yml
new file mode 100644
index 0000000000..b3c3615521
--- /dev/null
+++ b/.github/actions/install-binaryen/action.yml
@@ -0,0 +1,90 @@
+name: Install Binaryen
+
+inputs:
+ repository:
+ description: 'Repository name with owner. For example, actions/checkout'
+ default: WebAssembly/binaryen
+ ref:
+ description: >
+ The branch, tag or SHA to checkout. When checking out the repository that
+ triggered a workflow, this defaults to the reference or SHA for that
+ event. Otherwise, uses the default branch.
+ default: latest
+ build:
+ description: Whether we should build from source
+ default: false
+runs:
+ using: composite
+ steps:
+ - name: Restore cached binaryen
+ if: ${{ inputs.build && inputs.build != 'false' }}
+ id: cache-binaryen
+ uses: actions/cache/restore@v4
+ with:
+ path: binaryen
+ key: ${{ runner.os }}-binaryen-${{ inputs.ref }}
+
+ - name: Checkout binaryen
+ if: ${{ inputs.build && inputs.build != 'false' && steps.cache-binaryen.outputs.cache-hit != 'true' }}
+ uses: actions/checkout@v4
+ with:
+ repository: ${{ inputs.repository }}
+ path: binaryen
+ submodules: true
+ ref: ${{ inputs.ref == 'latest' && 'main' || inputs.ref }}
+
+ - name: Install ninja (Linux)
+ if: ${{ inputs.build && inputs.build != 'false' && runner.os == 'Linux' && steps.cache-binaryen.outputs.cache-hit != 'true' }}
+ shell: bash
+ run: sudo apt-get install ninja-build
+
+ - name: Install ninja (MacOS)
+ if: ${{ inputs.build && inputs.build != 'false' && runner.os == 'macOS' && steps.cache-binaryen.outputs.cache-hit != 'true' }}
+ shell: bash
+ run: brew install ninja
+
+ - name: Build binaryen
+ if: ${{ inputs.build && inputs.build != 'false' && runner.os != 'Windows' && steps.cache-binaryen.outputs.cache-hit != 'true' }}
+ working-directory: ./binaryen
+ shell: bash
+ run: |
+ cmake -G Ninja .
+ ninja
+
+ - name: Install binaryen build dependencies (Windows)
+ if: ${{ inputs.build && inputs.build != 'false' && runner.os == 'Windows' && steps.cache-binaryen.outputs.cache-hit != 'true' }}
+ working-directory: ./binaryen
+ shell: bash
+ run: opam install conf-cmake conf-c++
+
+ - name: Build binaryen (Windows)
+ if: ${{ inputs.build && inputs.build != 'false' && runner.os == 'Windows' && steps.cache-binaryen.outputs.cache-hit != 'true' }}
+ working-directory: ./binaryen
+ shell: bash
+ run: |
+ opam exec -- cmake . -DBUILD_STATIC_LIB=ON -DBUILD_TESTS=off -DINSTALL_LIBS=off -DCMAKE_C_COMPILER=x86_64-w64-mingw32-gcc
+ make -j 4
+
+ - name: Cache binaryen
+ if: ${{ inputs.build && inputs.build != 'false' && steps.cache-binaryen.outputs.cache-hit != 'true' }}
+ uses: actions/cache/save@v4
+ with:
+ path: binaryen
+ key: ${{ runner.os }}-binaryen-${{ inputs.ref }}
+
+ - name: Set binaryen's path
+ if: ${{ inputs.build && inputs.build != 'false' && runner.os != 'Windows' }}
+ shell: bash
+ run: echo "$GITHUB_WORKSPACE/binaryen/bin" >> $GITHUB_PATH
+
+ - name: Copy binaryen's tools (Windows)
+ if: ${{ inputs.build && inputs.build != 'false' && runner.os == 'Windows' }}
+ shell: bash
+ run: cp $GITHUB_WORKSPACE/binaryen/bin/wasm-{merge,opt}.exe _opam/bin
+
+ - name: Download Binaryen
+ if: ${{ ! inputs.build || inputs.build == 'false' }}
+ uses: Aandreba/setup-binaryen@v1.0.0
+ with:
+ token: ${{ github.token }}
+ version: ${{ inputs.ref }}
diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 0ea62aea44..d9d2271cfa 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -152,10 +152,10 @@ jobs:
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
- - name: Set-up Binaryen
- uses: Aandreba/setup-binaryen@v1.0.0
+ - name: Install Binaryen
+ uses: ./wasm_of_ocaml/.github/actions/install-binaryen
with:
- token: ${{ github.token }}
+ build: true
- name: Pin faked binaryen-bin package
# It's faster to use a cached version
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 758928f661..7900183f6f 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -122,10 +122,10 @@ jobs:
- run: opam install conf-pkg-config conf-mingw-w64-g++-i686 conf-mingw-w64-g++-x86_64
if: runner.os == 'Windows'
- - name: Set-up Binaryen
- uses: Aandreba/setup-binaryen@v1.0.0
+ - name: Install Binaryen
+ uses: ./.github/actions/install-binaryen
with:
- token: ${{ github.token }}
+ build: true
- name: Install faked binaryen-bin package
# It's faster to use a cached version
From f101a7a2a9b69212c378a861eb2ad40522cef950 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 18 Feb 2025 17:35:25 +0100
Subject: [PATCH 09/10] Update Wasm linker to support stack switching
instructions
---
compiler/lib-wasm/link.ml | 19 ++++++++-
compiler/lib-wasm/wasm_link.ml | 78 ++++++++++++++++++++++++++++------
2 files changed, 83 insertions(+), 14 deletions(-)
diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml
index c86ee2cc31..d4a33f3481 100644
--- a/compiler/lib-wasm/link.ml
+++ b/compiler/lib-wasm/link.ml
@@ -173,7 +173,20 @@ module Wasm_binary = struct
let reftype' i ch =
match i with
- | 0x6a | 0x6b | 0x6c | 0x6d | 0x6e | 0x6f | 0x70 | 0x71 | 0x72 | 0x73 -> ()
+ | 0x68
+ | 0x69
+ | 0x6a
+ | 0x6b
+ | 0x6c
+ | 0x6d
+ | 0x6e
+ | 0x6f
+ | 0x70
+ | 0x71
+ | 0x72
+ | 0x73
+ | 0x74
+ | 0x75 -> ()
| 0x63 | 0x64 -> heaptype ch
| _ ->
Format.eprintf "Unknown reftype %x@." i;
@@ -206,6 +219,7 @@ module Wasm_binary = struct
| Func of { arity : int }
| Struct
| Array
+ | Cont
let supertype ch =
match input_byte ch with
@@ -225,6 +239,9 @@ module Wasm_binary = struct
let comptype i ch =
match i with
+ | 0x5D ->
+ ignore (read_sint ch);
+ Cont
| 0x5E ->
fieldtype ch;
Array
diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
index ff23599028..469ac3de9b 100644
--- a/compiler/lib-wasm/wasm_link.ml
+++ b/compiler/lib-wasm/wasm_link.ml
@@ -23,6 +23,10 @@ type heaptype =
| Nofunc
| Extern
| Noextern
+ | Exn
+ | Noexn
+ | Cont
+ | Nocont
| Any
| Eq
| I31
@@ -66,6 +70,7 @@ type comptype =
}
| Struct of fieldtype array
| Array of fieldtype
+ | Cont of int
type subtype =
{ final : bool
@@ -164,6 +169,8 @@ module Write = struct
let heaptype st ch typ =
match (typ : heaptype) with
+ | Nocont -> byte ch 0x75
+ | Noexn -> byte ch 0x74
| Nofunc -> byte ch 0x73
| Noextern -> byte ch 0x72
| None_ -> byte ch 0x71
@@ -174,6 +181,8 @@ module Write = struct
| I31 -> byte ch 0x6C
| Struct -> byte ch 0x6B
| Array -> byte ch 0x6A
+ | Exn -> byte ch 0x69
+ | Cont -> byte ch 0x68
| Type idx -> sint ch (typeidx st idx)
let reftype st ch { nullable; typ } =
@@ -219,6 +228,9 @@ module Write = struct
byte ch 1;
uint ch (typeidx st supertype));
match typ with
+ | Cont idx ->
+ byte ch 0x5D;
+ sint ch (typeidx st idx)
| Array field_type ->
byte ch 0x5E;
fieldtype st ch field_type
@@ -569,7 +581,9 @@ module Read = struct
let heaptype st ch =
let i = sint ch in
match i + 128 with
- | 0X73 -> Nofunc
+ | 0x75 -> Nocont
+ | 0x74 -> Noexn
+ | 0x73 -> Nofunc
| 0x72 -> Noextern
| 0x71 -> None_
| 0x70 -> Func
@@ -579,6 +593,8 @@ module Read = struct
| 0x6C -> I31
| 0x6B -> Struct
| 0x6A -> Array
+ | 0x69 -> Exn
+ | 0x68 -> Cont
| _ ->
if i < 0 then failwith (Printf.sprintf "Unknown heaptype %x@." i);
let i =
@@ -596,7 +612,9 @@ module Read = struct
let reftype' st i ch =
match i with
- | 0X73 -> nullable Nofunc
+ | 0x75 -> nullable Nocont
+ | 0x74 -> nullable Noexn
+ | 0x73 -> nullable Nofunc
| 0x72 -> nullable Noextern
| 0x71 -> nullable None_
| 0x70 -> nullable Func
@@ -606,6 +624,8 @@ module Read = struct
| 0x6C -> nullable I31
| 0x6B -> nullable Struct
| 0x6A -> nullable Array
+ | 0x69 -> nullable Exn
+ | 0x68 -> nullable Cont
| 0x63 -> nullable (heaptype st ch)
| 0x64 -> { nullable = false; typ = heaptype st ch }
| _ -> failwith (Printf.sprintf "Unknown reftype %x@." i)
@@ -652,6 +672,14 @@ module Read = struct
let comptype st i ch =
match i with
+ | 0x5D ->
+ let i = sint ch in
+ let i =
+ if i >= st.type_index_count
+ then lnot (i - st.type_index_count)
+ else st.type_mapping.(i)
+ in
+ Cont i
| 0x5E -> Array (fieldtype st ch)
| 0x5F -> Struct (vec (fieldtype st) ch)
| 0x60 ->
@@ -1258,6 +1286,13 @@ module Scan = struct
| 0xD1 (* ref.is_null *) | 0xD3 (* ref.eq *) | 0xD4 (* ref.as_non_null *) ->
pos + 1 |> instructions
| 0xD2 (* ref.func *) -> pos + 1 |> funcidx |> instructions
+ | 0xE0 (* cont.new *) -> pos + 1 |> typeidx |> instructions
+ | 0xE1 (* cont.bind *) -> pos + 1 |> typeidx |> typeidx |> instructions
+ | 0xE2 (* suspend *) -> pos + 1 |> tagidx |> instructions
+ | 0xE3 (* resume *) -> pos + 1 |> typeidx |> vector on_clause |> instructions
+ | 0xE4 (* resume_throw *) ->
+ pos + 1 |> typeidx |> tagidx |> vector on_clause |> instructions
+ | 0xE5 (* switch *) -> pos + 1 |> typeidx |> tagidx |> instructions
| 0xFB -> pos + 1 |> gc_instruction
| 0xFC -> (
if debug then Format.eprintf " %d@." (get (pos + 1));
@@ -1392,6 +1427,11 @@ module Scan = struct
| 0 (* catch *) | 1 (* catch_ref *) -> pos + 1 |> tagidx |> labelidx
| 2 (* catch_all *) | 3 (* catch_all_ref *) -> pos + 1 |> labelidx
| c -> failwith (Printf.sprintf "bad catch 0x02%d@." c)
+ and on_clause pos =
+ match get pos with
+ | 0 (* on *) -> pos + 1 |> tagidx |> labelidx
+ | 1 (* on .. switch *) -> pos + 1 |> tagidx
+ | c -> failwith (Printf.sprintf "bad on clause 0x02%d@." c)
and block_end pos =
if debug then Format.eprintf "0x%02X (@%d) block end@." (get pos) pos;
match get pos with
@@ -1544,30 +1584,43 @@ let rec subtype subtyping_info (i : int) i' =
| None -> false
| Some s -> subtype subtyping_info s i'
-let heap_subtype (subtyping_info : subtype array) (ty : heaptype) (ty' : heaptype) =
+let rec heap_subtype (subtyping_info : subtype array) (ty : heaptype) (ty' : heaptype) =
match ty, ty' with
- | (Func | Nofunc), Func
- | Nofunc, Nofunc
- | (Extern | Noextern), Extern
+ | Func, Func
+ | Extern, Extern
+ | Noextern, Noextern
+ | Exn, Exn
+ | Noexn, Noexn
+ | Cont, Cont
+ | Nocont, Nocont
| (Any | Eq | I31 | Struct | Array | None_ | Type _), Any
| (Eq | I31 | Struct | Array | None_ | Type _), Eq
- | (I31 | None_), I31
- | (Struct | None_), Struct
- | (Array | None_), Array
+ | I31, I31
+ | Struct, Struct
+ | Array, Array
| None_, None_ -> true
| Type i, Struct -> (
match subtyping_info.(i).typ with
| Struct _ -> true
- | Array _ | Func _ -> false)
+ | Array _ | Func _ | Cont _ -> false)
| Type i, Array -> (
match subtyping_info.(i).typ with
| Array _ -> true
- | Struct _ | Func _ -> false)
+ | Struct _ | Func _ | Cont _ -> false)
| Type i, Func -> (
match subtyping_info.(i).typ with
| Func _ -> true
- | Struct _ | Array _ -> false)
+ | Struct _ | Array _ | Cont _ -> false)
+ | Type i, Cont -> (
+ match subtyping_info.(i).typ with
+ | Cont _ -> true
+ | Struct _ | Array _ | Func _ -> false)
| Type i, Type i' -> subtype subtyping_info i i'
+ | Nofunc, _ -> heap_subtype subtyping_info ty' Func
+ | Noextern, _ -> heap_subtype subtyping_info ty' Extern
+ | Noexn, _ -> heap_subtype subtyping_info ty' Exn
+ | Nocont, _ -> heap_subtype subtyping_info ty' Cont
+ | None_, _ -> heap_subtype subtyping_info ty' Any
| _ -> false
let ref_subtype subtyping_info { nullable; typ } { nullable = nullable'; typ = typ' } =
@@ -2455,7 +2508,6 @@ let f ?(filter_export = fun _ -> true) files ~output_file =
(*
LATER
- testsuite : import/export matching, source maps, multiple start functions, ...
-- missing instructions ==> typed continuations (?)
- check features?
MAYBE
From 4bc068e85499e979b5d5b09f9f41eaade9b839c4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sun, 24 Mar 2024 12:57:09 +0100
Subject: [PATCH 10/10] Effects based on Stack Switching proposal
---
.github/workflows/build-wasm_of_ocaml.yml | 4 +-
compiler/lib-wasm/binaryen.ml | 1 +
compiler/tests-jsoo/lib-effects/dune | 8 +-
compiler/tests-ocaml/effect-syntax/dune | 8 +-
compiler/tests-ocaml/effects/dune | 8 +-
runtime/wasm/effect-native.wat | 213 ++++++++++++++++++++++
runtime/wasm/effect.wat | 4 +-
runtime/wasm/stdlib.wat | 10 +
8 files changed, 240 insertions(+), 16 deletions(-)
create mode 100644 runtime/wasm/effect-native.wat
diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index d9d2271cfa..db3892fe2e 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -214,7 +214,7 @@ jobs:
run: opam exec -- dune build @runtest-wasm --profile with-effects
- name: Run tests (WASI runtime - node)
- if: ${{ matrix.wasi }}
+ if: ${{ false }}
working-directory: ./wasm_of_ocaml
run: opam exec -- dune build @runtest-wasm --profile wasi
@@ -226,7 +226,7 @@ jobs:
run: opam exec -- dune build @runtest-wasm --profile wasi
- name: Run tests (WASI runtime - wasmtime)
- if: ${{ matrix.wasi }}
+ if: ${{ false }}
working-directory: ./wasm_of_ocaml
env:
WASM_ENGINE: wasmtime
diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml
index 241a373137..190aeab387 100644
--- a/compiler/lib-wasm/binaryen.ml
+++ b/compiler/lib-wasm/binaryen.ml
@@ -37,6 +37,7 @@ let common_options () =
; "--enable-nontrapping-float-to-int"
; "--enable-strings"
; "--enable-multimemory" (* To keep wasm-merge happy *)
+ ; "--enable-stack-switching"
]
in
if Config.Flag.pretty () then "-g" :: l else l
diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune
index 679ccb2f43..adad4af0e3 100644
--- a/compiler/tests-jsoo/lib-effects/dune
+++ b/compiler/tests-jsoo/lib-effects/dune
@@ -1,10 +1,10 @@
(env
(with-effects-double-translation)
(with-effects)
- (wasi
- (wasm_of_ocaml
- (flags
- (:standard --enable effects))))
+ ; (wasi
+ ; (wasm_of_ocaml
+ ; (flags
+ ; (:standard --enable effects))))
(_
(js_of_ocaml
(flags
diff --git a/compiler/tests-ocaml/effect-syntax/dune b/compiler/tests-ocaml/effect-syntax/dune
index 6b08c88e72..d7e7e2fa3b 100644
--- a/compiler/tests-ocaml/effect-syntax/dune
+++ b/compiler/tests-ocaml/effect-syntax/dune
@@ -1,10 +1,10 @@
(env
(with-effects-double-translation)
(with-effects)
- (wasi
- (wasm_of_ocaml
- (flags
- (:standard --enable=effects))))
+ ; (wasi
+ ; (wasm_of_ocaml
+ ; (flags
+ ; (:standard --enable=effects))))
(_
(js_of_ocaml
(flags
diff --git a/compiler/tests-ocaml/effects/dune b/compiler/tests-ocaml/effects/dune
index d832b983a7..bb7cc86051 100644
--- a/compiler/tests-ocaml/effects/dune
+++ b/compiler/tests-ocaml/effects/dune
@@ -1,10 +1,10 @@
(env
(with-effects-double-translation)
(with-effects)
- (wasi
- (wasm_of_ocaml
- (flags
- (:standard --enable=effects))))
+ ; (wasi
+ ; (wasm_of_ocaml
+ ; (flags
+ ; (:standard --enable=effects))))
(_
(js_of_ocaml
(flags
diff --git a/runtime/wasm/effect-native.wat b/runtime/wasm/effect-native.wat
new file mode 100644
index 0000000000..b5ecb5254a
--- /dev/null
+++ b/runtime/wasm/effect-native.wat
@@ -0,0 +1,213 @@
+(module
+(@if (and wasi (<> effects "cps"))
+(@then
+ (import "fail" "caml_raise_constant"
+ (func $caml_raise_constant (param (ref eq))))
+ (import "fail" "caml_raise_with_arg"
+ (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))))
+ (import "obj" "caml_fresh_oo_id"
+ (func $caml_fresh_oo_id (param (ref eq)) (result (ref eq))))
+ (import "obj" "cont_tag" (global $cont_tag i32))
+ (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))))
+ (import "fail" "javascript_exception"
+ (tag $javascript_exception (param externref)))
+ (import "jslib" "caml_wrap_exception"
+ (func $caml_wrap_exception (param externref) (result (ref eq))))
+ (import "stdlib" "caml_main_wrapper"
+ (global $caml_main_wrapper (mut (ref null $wrapper_func))))
+ (import "effect" "effect_allowed" (global $effect_allowed (mut i32)))
+
+ (type $block (array (mut (ref eq))))
+ (type $bytes (array (mut i8)))
+ (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+ (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
+ (type $function_3
+ (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+ (type $closure_3
+ (sub $closure
+ (struct (field (ref $function_1)) (field (ref $function_3)))))
+
+ ;; Effect types
+
+ (tag $effect (param (ref eq)) (result (ref eq) (ref eq)))
+
+ (type $cont_function (func (param (ref eq) (ref eq)) (result (ref eq))))
+
+ (type $cont (cont $cont_function))
+
+ (type $generic_fiber
+ (sub
+ (struct
+ (field $value (mut (ref eq)))
+ (field $exn (mut (ref eq)))
+ (field $effect (mut (ref eq))))))
+
+ (type $fiber
+ (sub final $generic_fiber
+ (struct
+ (field $value (mut (ref eq)))
+ (field $exn (mut (ref eq)))
+ (field $effect (mut (ref eq)))
+ (field $cont (mut (ref $cont))))))
+
+ ;; Unhandled effects
+
+ (@string $effect_unhandled "Effect.Unhandled")
+
+ (func $raise_unhandled
+ (param $eff (ref eq)) (param (ref eq)) (result (ref eq))
+ (block $null
+ (call $caml_raise_with_arg
+ (br_on_null $null
+ (call $caml_named_value (global.get $effect_unhandled)))
+ (local.get $eff)))
+ (call $caml_raise_constant
+ (array.new_fixed $block 3 (ref.i31 (i32.const 248))
+ (global.get $effect_unhandled)
+ (call $caml_fresh_oo_id (ref.i31 (i32.const 0)))))
+ (ref.i31 (i32.const 0)))
+
+ (global $raise_unhandled (ref $closure)
+ (struct.new $closure (ref.func $raise_unhandled)))
+
+ (type $func (func (result (ref eq))))
+ (type $wrapper_func (func (param (ref $func))))
+ (type $func_closure (struct (field (ref $func))))
+
+ (func $wrapper_cont
+ (param $f (ref eq)) (param (ref eq)) (result (ref eq))
+ (return_call_ref $func
+ (local.get $f)
+ (struct.get $func_closure 0
+ (ref.cast (ref $func_closure) (local.get $f)))))
+
+ (func $unhandled_effect_wrapper (param $start (ref $func))
+ (local $cont (ref $cont))
+ (local $f (ref eq)) (local $v (ref eq))
+ (local $resume_res (tuple (ref eq) (ref $cont)))
+ (local.set $cont (cont.new $cont (ref.func $wrapper_cont)))
+ (local.set $f (struct.new $func_closure (local.get $start)))
+ (local.set $v (ref.i31 (i32.const 0)))
+ (loop $loop
+ (local.set $resume_res
+ (block $handle_effect (result (ref eq) (ref $cont))
+ (resume $cont (on $effect $handle_effect)
+ (local.get $f) (local.get $v) (local.get $cont))
+ (return)))
+ (local.set $cont (tuple.extract 2 1 (local.get $resume_res)))
+ (local.set $v (tuple.extract 2 0 (local.get $resume_res)))
+ (local.set $f (global.get $raise_unhandled))
+ (br $loop)))
+
+ (func $init
+ (global.set $caml_main_wrapper (ref.func $unhandled_effect_wrapper)))
+
+ (start $init)
+
+ ;; Resume
+
+ (@string $already_resumed "Effect.Continuation_already_resumed")
+
+ (func $resume (export "%resume")
+ (param $vfiber (ref eq)) (param $f (ref eq)) (param $v (ref eq))
+ (param $tail (ref eq)) (result (ref eq))
+ (local $fiber (ref $fiber))
+ (local $res (ref eq))
+ (local $exn (ref eq))
+ (local $resume_res (tuple (ref eq) (ref $cont)))
+ (if (ref.eq (local.get $vfiber) (ref.i31 (i32.const 0)))
+ (then
+ (call $caml_raise_constant
+ (ref.as_non_null
+ (call $caml_named_value (global.get $already_resumed))))))
+ (local.set $fiber (ref.cast (ref $fiber) (local.get $vfiber)))
+ (local.set $exn
+ (block $handle_exception (result (ref eq))
+ (local.set $resume_res
+ (block $handle_effect (result (ref eq) (ref $cont))
+ (local.set $res
+ (try (result (ref eq))
+ (do
+ (resume $cont
+ (on $effect $handle_effect)
+ (local.get $f) (local.get $v)
+ (struct.get $fiber $cont (local.get $fiber))))
+(@if (not wasi)
+(@then
+ (catch $javascript_exception
+ (br $handle_exception
+ (call $caml_wrap_exception (pop externref))))
+))
+ (catch $ocaml_exception
+ (br $handle_exception (pop (ref eq))))))
+ ;; handle return
+ (return_call_ref $function_1 (local.get $res)
+ (local.tee $f
+ (struct.get $fiber $value (local.get $fiber)))
+ (struct.get $closure 0
+ (ref.cast (ref $closure) (local.get $f))))))
+ ;; handle effect
+ (struct.set $fiber $cont (local.get $fiber)
+ (tuple.extract 2 1 (local.get $resume_res)))
+ (return_call_ref $function_3
+ (tuple.extract 2 0 (local.get $resume_res))
+ (array.new_fixed $block 3 (ref.i31 (global.get $cont_tag))
+ (local.get $fiber)
+ (local.get $fiber))
+ (local.get $tail)
+ (local.tee $f
+ (struct.get $fiber $effect (local.get $fiber)))
+ (struct.get $closure_3 1
+ (ref.cast (ref $closure_3) (local.get $f))))))
+ ;; handle exception
+ (return_call_ref $function_1 (local.get $exn)
+ (local.tee $f
+ (struct.get $fiber $exn (local.get $fiber)))
+ (struct.get $closure 0 (ref.cast (ref $closure) (local.get $f)))))
+
+ ;; Perform
+
+ (func (export "%reperform")
+ (param $eff (ref eq)) (param $cont (ref eq)) (param $tail (ref eq))
+ (result (ref eq))
+ (local $res (tuple (ref eq) (ref eq)))
+ (local.set $res (suspend $effect (local.get $eff)))
+ (return_call $resume
+ (ref.as_non_null
+ (array.get $block
+ (ref.cast (ref $block) (local.get $cont))
+ (i32.const 1)))
+ (tuple.extract 2 0 (local.get $res))
+ (tuple.extract 2 1 (local.get $res))
+ (local.get $tail)))
+
+ (func (export "%perform") (param $eff (ref eq)) (result (ref eq))
+ (local $res (tuple (ref eq) (ref eq)))
+ (if (i32.eqz (global.get $effect_allowed))
+ (then
+ (return_call $raise_unhandled
+ (local.get $eff) (ref.i31 (i32.const 0)))))
+ (local.set $res (suspend $effect (local.get $eff)))
+ (return_call_ref $function_1 (tuple.extract 2 1 (local.get $res))
+ (tuple.extract 2 0 (local.get $res))
+ (struct.get $closure 0
+ (ref.cast (ref $closure) (tuple.extract 2 0 (local.get $res))))))
+
+ ;; Allocate a stack
+
+ (func $initial_cont
+ (param $f (ref eq)) (param $x (ref eq)) (result (ref eq))
+ (return_call_ref $function_1 (local.get $x)
+ (local.get $f)
+ (struct.get $closure 0 (ref.cast (ref $closure) (local.get $f)))))
+
+ (func (export "caml_alloc_stack")
+ (param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq))
+ (result (ref eq))
+ (struct.new $fiber
+ (local.get $hv) (local.get $hx) (local.get $hf)
+ (cont.new $cont (ref.func $initial_cont))))
+))
+)
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 717eed01b1..896cbe22ef 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -88,7 +88,7 @@
(global $raise_unhandled (ref $closure)
(struct.new $closure (ref.func $raise_unhandled)))
- (global $effect_allowed (mut i32) (i32.const 1))
+ (global $effect_allowed (export "effect_allowed") (mut i32) (i32.const 1))
(func $caml_continuation_use_noexc (export "caml_continuation_use_noexc")
(param (ref eq)) (result (ref eq))
@@ -139,7 +139,7 @@
(ref.i31 (global.get $cont_tag))))))
(i32.const 0))
-(@if (= effects "jspi")
+(@if (and (not wasi) (= effects "jspi"))
(@then
;; Apply a function f to a value v, both contained in a pair (f, v)
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index 7dc56f3634..51daffaa93 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -213,6 +213,11 @@
(call $caml_main (ref.func $reraise_exception)))
))
+ (type $wrapper_func (func (param (ref $func))))
+ (global $caml_main_wrapper (export "caml_main_wrapper")
+ (mut (ref null $wrapper_func))
+ (ref.null $wrapper_func))
+
(func $caml_main (export "caml_main") (param $start (ref func))
(local $exn (ref eq))
(local $msg (ref eq))
@@ -225,6 +230,11 @@
))
(try
(do
+ (block $fallback
+ (call_ref $wrapper_func
+ (ref.cast (ref $func) (local.get $start))
+ (br_on_null $fallback (global.get $caml_main_wrapper)))
+ (return))
(drop (call_ref $func (ref.cast (ref $func) (local.get $start)))))
(catch $ocaml_exit)
(catch $ocaml_exception