From e9a1f853ce6d8d000cbd017336ec54f60fb19db2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Wed, 18 Dec 2024 18:55:49 +0100 Subject: [PATCH] WIP --- dune | 8 +- runtime/wasm/bigstring.wat | 6 +- runtime/wasm/effect.wat | 2 +- runtime/wasm/fs.wat | 1 - runtime/wasm/hash.wat | 15 ++ runtime/wasm/jslib.wat | 53 +++++-- runtime/wasm/jsstring.wat | 48 +++++- runtime/wasm/lexing.wat | 77 +++++++++- runtime/wasm/printexc.wat | 21 ++- runtime/wasm/stdlib.wat | 8 +- runtime/wasm/str.wat | 199 +++++++++++++++--------- runtime/wasm/string.wat | 302 ++++++++++++++++++++++--------------- runtime/wasm/sys.wat | 15 +- 13 files changed, 522 insertions(+), 233 deletions(-) diff --git a/dune b/dune index c68dad2d65..1b27881d77 100644 --- a/dune +++ b/dune @@ -4,7 +4,13 @@ (:standard -w +a-4-40-41-42-44-48-58-66-70)) (binaries (tools/node_wrapper.exe as node) - (tools/node_wrapper.exe as node.exe))) + (tools/node_wrapper.exe as node.exe)) + (wasm_of_ocaml + (compilation_mode separate) + (flags + (:standard --disable use-js-string)) + (build_runtime_flags + (:standard)))) (with-effects (js_of_ocaml (compilation_mode separate) diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index 14eca92e51..d0056d92a6 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -75,9 +75,9 @@ (struct.get $string 0 (ref.cast (ref $string) (local.get $s))))) ) (#else - (func $string_get (param $s (ref bytes)) (param $i i32)) (result i32) - (array.get $bytes (local.get $s) (local.get $i)) - (func $string_val (param $s (ref eq)) (result $bytes) + (func $string_get (param $s (ref $bytes)) (param $i i32) (result i32) + (array.get $bytes (local.get $s) (local.get $i))) + (func $string_val (param $s (ref eq)) (result (ref $bytes)) (ref.cast (ref $bytes) (local.get $s))) )) diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat index 0b2bb6b8ee..022fdd118c 100644 --- a/runtime/wasm/effect.wat +++ b/runtime/wasm/effect.wat @@ -24,7 +24,7 @@ (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 $bytes)) (result (ref null eq)))) + (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))) diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat index 2639d83cd7..1a0756d3dd 100644 --- a/runtime/wasm/fs.wat +++ b/runtime/wasm/fs.wat @@ -16,7 +16,6 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "jslib" "log_str" (func $log_str (param (ref $bytes)))) (import "bindings" "getcwd" (func $getcwd (result anyref))) (import "bindings" "chdir" (func $chdir (param anyref))) (import "bindings" "mkdir" (func $mkdir (param anyref) (param i32))) diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat index 5a7458196e..9132f7f684 100644 --- a/runtime/wasm/hash.wat +++ b/runtime/wasm/hash.wat @@ -318,6 +318,8 @@ (ref.i31 (i32.and (call $caml_hash_mix_final (local.get $h)) (i32.const 0x3FFFFFFF)))) +(#if use-js-string +(#then (func (export "caml_string_hash") (param (ref eq)) (param (ref eq)) (result (ref eq)) (local $h i32) @@ -329,3 +331,16 @@ (ref.cast (ref $string) (local.get 1)))) (i32.const 0x3FFFFFFF)))) ) +(#else + (func (export "caml_string_hash") + (param (ref eq)) (param (ref eq)) (result (ref eq)) + (local $h i32) + (ref.i31 + (i32.and + (call $caml_hash_mix_final + (call $caml_hash_mix_bytes + (i31.get_s (ref.cast (ref i31) (local.get 0))) + (ref.cast (ref $bytes) (local.get 1)))) + (i32.const 0x3FFFFFFF)))) +)) +) diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat index ab3bec93cf..40b18bf793 100644 --- a/runtime/wasm/jslib.wat +++ b/runtime/wasm/jslib.wat @@ -77,7 +77,7 @@ (import "fail" "caml_failwith_tag" (func $caml_failwith_tag (result (ref eq)))) (import "stdlib" "caml_named_value" - (func $caml_named_value (param (ref $bytes)) (result (ref null eq)))) + (func $caml_named_value (param (ref eq)) (result (ref null eq)))) (import "obj" "caml_callback_1" (func $caml_callback_1 (param (ref eq)) (param (ref eq)) (result (ref eq)))) @@ -95,6 +95,8 @@ (func $string_of_jsstring (param (ref eq)) (result (ref eq)))) (import "jsstring" "jsbytes_of_bytes" (func $jsbytes_of_bytes (param (ref $bytes)) (result anyref))) + (import "jsstring" "bytes_of_jsbytes" + (func $bytes_of_jsbytes (param anyref) (result (ref $bytes)))) (import "int32" "caml_copy_int32" (func $caml_copy_int32 (param i32) (result (ref eq)))) (import "int32" "Int32_val" @@ -469,14 +471,20 @@ (#else (func $caml_jsstring_of_string (export "caml_jsstring_of_string") (param (ref eq)) (result (ref eq)) - (local $s (ref $string)) - (local.set $s (ref.cast (ref $string) (local.get 0))) + (local $s (ref $bytes)) + (local.set $s (ref.cast (ref $bytes) (local.get 0))) (return (struct.new $js (call $jsstring_of_bytes (local.get $s))))) )) -;;ZZZZZZZZZZZZZZZZZZZ - (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string") + +(#if use-js-string +(#then + (func (export "caml_jsbytes_of_string") (param (ref eq)) (result (ref eq)) (local.get 0)) +) +(#else + (export "caml_jsbytes_of_string" (func $caml_jsbytes_of_bytes)) +)) (func $caml_jsbytes_of_bytes (param (ref eq)) (result (ref eq)) @@ -484,19 +492,32 @@ (local.set $s (ref.cast (ref $bytes) (local.get 0))) (return (struct.new $js (call $jsbytes_of_bytes (local.get $s))))) +(#if use-js-string +(#then (export "caml_js_to_string" (func $string_of_jsstring)) (export "caml_string_of_jsstring" (func $string_of_jsstring)) (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq)) (return_call $string_of_jsstring (local.get 0))) - - (func (export "caml_bytes_of_jsstring") +) +(#else + (export "caml_js_to_string" (func $caml_string_of_jsstring)) + (func $caml_string_of_jsstring (export "caml_string_of_jsstring") (param $s (ref eq)) (result (ref eq)) (return_call $bytes_of_jsstring (struct.get $js 0 (ref.cast (ref $js) (local.get $s))))) +)) +(#if use-js-string +(#then (func (export "caml_string_of_jsbytes") (param $s (ref eq)) (result (ref eq)) (local.get 0)) +) +(#else + (func (export "caml_string_of_jsbytes") (param $s (ref eq)) (result (ref eq)) + (return_call $bytes_of_jsbytes + (struct.get $js 0 (ref.cast (ref $js) (local.get $s))))) +)) (func (export "caml_list_to_js_array") (param (ref eq)) (result (ref eq)) @@ -570,12 +591,12 @@ (call $wrap (local.get $exn))))) (array.new_fixed $block 3 (ref.i31 (i32.const 0)) (call $caml_failwith_tag) - (call $string_of_jsstring + (call $caml_string_of_jsstring (call $wrap (call $meth_call (local.get $exn) (call $unwrap - (call $jsstring_of_string + (call $caml_jsstring_of_string (array.new_data $bytes $toString (i32.const 0) (i32.const 8)))) (any.convert_extern (call $new_array (i32.const 0)))))))) @@ -609,11 +630,15 @@ (array.get $block (local.get $exn) (i32.const 2))))))) (call $wrap (ref.null any))) - (func (export "log_str") (param $s (ref $bytes)) - (call $log_js - (call $unwrap (call $jsstring_of_string (local.get $s))))) - (func (export "caml_jsoo_flags_use_js_string") (param (ref eq)) (result (ref eq)) - (ref.i31 (i32.const 1))) ;; ZZZ + (ref.i31 +(#if use-js-string +(#then + (i32.const 1) +) +(#else + (i32.const 0) +)) + )) ;; ZZZ ) diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat index 9ff09027cd..6195e144b4 100644 --- a/runtime/wasm/jsstring.wat +++ b/runtime/wasm/jsstring.wat @@ -148,7 +148,8 @@ (return_call $jsstring_of_subbytes (local.get $s) (i32.const 0) (array.len (local.get $s)))) - (func (export "bytes_of_jsstring") (param $s anyref) (result (ref $bytes)) + (func $bytes_of_jsstring (export "bytes_of_jsstring") + (param $s anyref) (result (ref $bytes)) (if (global.get $text_converters_available) (then (return_call $encodeStringToUTF8Array @@ -240,6 +241,51 @@ (br $fill)))) (return_call $jsstring_of_bytes (local.get $s'))) + (func (export "bytes_of_jsbytes") (param $s anyref) (result (ref $bytes)) + (local $l i32) (local $i i32) (local $n i32) (local $c i32) + (local $s' (ref $bytes)) (local $s'' (ref $bytes)) + (local.set $s' (call $bytes_of_jsstring (local.get $s))) + (local.set $l (array.len (local.get $s'))) + (local.set $i (i32.const 0)) + (local.set $n (i32.const 0)) + (loop $count + (if (i32.lt_u (local.get $i) (local.get $l)) + (then + (if (i32.ge_u (array.get_u $bytes (local.get $s') (local.get $i)) + (i32.const 0xC0)) + (then (local.set $n (i32.add (local.get $n) (i32.const 1))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $count)))) + (if (i32.eqz (local.get $n)) (then (return (local.get $s')))) + (local.set $s'' + (array.new $bytes (i32.const 0) + (i32.sub (local.get $i) (local.get $n)))) + (local.set $i (i32.const 0)) + (local.set $n (i32.const 0)) + (loop $fill + (if (i32.lt_u (local.get $i) (local.get $l)) + (then + (local.set $c + (array.get_u $bytes (local.get $s') (local.get $i))) + (if (i32.lt_u (local.get $c) (i32.const 0xC0)) + (then + (array.set $bytes + (local.get $s'') (local.get $n) (local.get $c)) + (local.set $i (i32.add (local.get $i) (i32.const 1)))) + (else + (array.set $bytes (local.get $s'') + (local.get $n) + (i32.sub + (i32.add + (i32.shl (local.get $c) (i32.const 6)) + (array.get_u $bytes (local.get $s') + (i32.add (local.get $i) (i32.const 1)))) + (i32.const 0x3080))) + (local.set $i (i32.add (local.get $i) (i32.const 2))))) + (local.set $n (i32.add (local.get $n) (i32.const 1))) + (br $fill)))) + (local.get $s'')) + ;; Fallback implementation of string conversion functions (memory (export "caml_buffer") 1) diff --git a/runtime/wasm/lexing.wat b/runtime/wasm/lexing.wat index 159fd96518..07fc578bb3 100644 --- a/runtime/wasm/lexing.wat +++ b/runtime/wasm/lexing.wat @@ -17,20 +17,38 @@ (module (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq)))) - (import "wasm:js-string" "length" - (func $string_length (param externref) (result i32))) - (import "wasm:js-string" "charCodeAt" - (func $string_get (param externref i32) (result i32))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (type $string (struct (field anyref))) +(#if use-js-string +(#then + (import "wasm:js-string" "charCodeAt" + (func $string_get (param externref i32) (result i32))) + (func $string_val (param $s (ref eq)) (result externref) (extern.convert_any (struct.get $string 0 (ref.cast (ref $string) (local.get $s))))) +) +(#else + (func $string_get (param $s (ref $bytes)) (param $i i32) (result i32) + (array.get $bytes (local.get $s) (local.get $i))) + (func $string_val (param $s (ref eq)) (result (ref $bytes)) + (ref.cast (ref $bytes) (local.get $s))) +)) - (func $get (param $s externref) (param $i i32) (result i32) + (func $get + (param $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) + (param $i i32) (result i32) (local.set $i (i32.add (local.get $i) (local.get $i))) (i32.extend16_s (i32.or (call $string_get (local.get $s) (local.get $i)) @@ -72,12 +90,23 @@ (local $buffer (ref $bytes)) (local $vpos (ref eq)) (local $action (ref eq)) (local $pos i32) (local $base i32) (local $backtrk i32) +(#if use-js-string +(#then (local $lex_base externref) (local $lex_backtrk externref) (local $lex_check externref) (local $lex_check_code externref) (local $lex_trans externref) (local $lex_default externref) +) +(#else + (local $lex_base (ref $bytes)) + (local $lex_backtrk (ref $bytes)) + (local $lex_check (ref $bytes)) + (local $lex_check_code (ref $bytes)) + (local $lex_trans (ref $bytes)) + (local $lex_default (ref $bytes)) +)) (local.set $tbl (ref.cast (ref $block) (local.get $vtbl))) (local.set $lexbuf (ref.cast (ref $block) (local.get $vlexbuf))) (local.set $state @@ -192,7 +221,16 @@ (br $loop))) (func $run_mem - (param $s externref) (param $i i32) (param $lexbuf (ref $block)) + (param $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) + (param $i i32) (param $lexbuf (ref $block)) (param $curr_pos (ref eq)) (local $dst i32) (local $src i32) (local $mem (ref $block)) @@ -218,7 +256,16 @@ (br $loop))) (func $run_tag - (param $s externref) (param $i i32) (param $lexbuf (ref $block)) + (param $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) + (param $i i32) (param $lexbuf (ref $block)) (return_call $run_mem (local.get $s) (local.get $i) (local.get $lexbuf) (ref.i31 (i32.const -1)))) @@ -234,6 +281,8 @@ (local $vpos (ref eq)) (local $action (ref eq)) (local $pos i32) (local $base i32) (local $backtrk i32) (local $pc_off i32) (local $base_code i32) +(#if use-js-string +(#then (local $lex_code externref) (local $lex_base externref) (local $lex_base_code externref) @@ -245,6 +294,20 @@ (local $lex_trans_code externref) (local $lex_default externref) (local $lex_default_code externref) +) +(#else + (local $lex_code (ref $bytes)) + (local $lex_base (ref $bytes)) + (local $lex_base_code (ref $bytes)) + (local $lex_backtrk (ref $bytes)) + (local $lex_backtrk_code (ref $bytes)) + (local $lex_check (ref $bytes)) + (local $lex_check_code (ref $bytes)) + (local $lex_trans (ref $bytes)) + (local $lex_trans_code (ref $bytes)) + (local $lex_default (ref $bytes)) + (local $lex_default_code (ref $bytes)) +)) (local.set $tbl (ref.cast (ref $block) (local.get $vtbl))) (local.set $lexbuf (ref.cast (ref $block) (local.get $vlexbuf))) (local.set $state diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat index 0288ea9f7e..5896466c25 100644 --- a/runtime/wasm/printexc.wat +++ b/runtime/wasm/printexc.wat @@ -16,7 +16,6 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref))) (import "fail" "caml_is_special_exception" (func $caml_is_special_exception (param (ref eq)) (result i32))) (import "ints" "caml_format_int" @@ -30,6 +29,8 @@ (func $caml_blit_string (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq)))) + (import "jsstring" "jsstring_test" + (func $jsstring_test (param anyref) (result i32))) (type $block (array (mut (ref eq)))) (type $string (struct (field anyref))) @@ -69,6 +70,21 @@ (struct.set $buffer 0 (local.get $buf) (i32.add (local.get $pos) (local.get $len)))) +(#if use-js-string +(#then + (func $is_string (param $v (ref eq)) (result i32) + (drop (block $not_string (result (ref eq)) + (return_call $jsstring_test + (struct.get $string + (br_on_cast_fail $not_string (ref eq) (ref $string) + (local.get $v)))))) + (i32.const 0)) +) +(#else + (func $is_string (param $v (ref eq)) (result i32) + (ref.test (ref $bytes) (local.get $v))) +)) + (func (export "caml_format_exception") (param (ref eq)) (result (ref eq)) (local $exn (ref $block)) (local $buf (ref $buffer)) @@ -129,8 +145,7 @@ (array.new_fixed $bytes 2 (i32.const 37) (i32.const 100))) ;; %d (ref.cast (ref i31) (local.get $v))))) - (else (if (ref.test (ref $string) (local.get $v)) - ;;ZZZ fix test + (else (if (call $is_string (local.get $v)) (then (call $add_char (local.get $buf) (i32.const 34)) ;; '\"' diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat index 214806141e..ad654eda2c 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -53,7 +53,7 @@ (type $assoc (struct - (field (ref $string)) + (field (ref eq)) (field (mut (ref eq))) (field (mut (ref null $assoc))))) @@ -82,7 +82,7 @@ (br $loop)))) (func $caml_named_value (export "caml_named_value") - (param $v (ref $bytes)) (result (ref null eq)) + (param $v (ref eq)) (result (ref null eq)) (local $s (ref eq)) (local.set $s (call $caml_string_of_bytes (local.get $v))) (block $not_found @@ -122,9 +122,7 @@ (return (ref.i31 (i32.const 0)))) (array.set $assoc_array (global.get $named_value_table) (local.get $h) - (struct.new $assoc - (ref.cast (ref $string) (local.get 0)) - (local.get 1) (local.get $r))) + (struct.new $assoc (local.get 0) (local.get 1) (local.get $r))) (ref.i31 (i32.const 0))) ;; Used only for testing (tests-jsoo/bin), but inconvenient to pull out diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat index b1eebf6007..f721de0992 100644 --- a/runtime/wasm/str.wat +++ b/runtime/wasm/str.wat @@ -19,10 +19,6 @@ (import "fail" "caml_invalid_argument" (func $caml_invalid_argument (param (ref eq)))) (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq)))) - (import "wasm:js-string" "length" - (func $string_length (param externref) (result i32))) - (import "wasm:js-string" "charCodeAt" - (func $string_get (param externref i32) (result i32))) (import "string" "caml_string_of_bytes" (func $caml_string_of_bytes (param (ref eq)) (result (ref eq)))) (import "string" "caml_blit_string" @@ -30,6 +26,27 @@ (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq)))) + +(#if use-js-string +(#then + (import "wasm:js-string" "length" + (func $string_length (param externref) (result i32))) + (import "wasm:js-string" "charCodeAt" + (func $string_get (param externref i32) (result i32))) + + (func $string_val (param $s (ref eq)) (result externref) + (extern.convert_any + (struct.get $string 0 (ref.cast (ref $string) (local.get $s))))) +) +(#else + (func $string_length (param $s (ref $bytes)) (result i32) + (array.len (local.get $s))) + (func $string_get (param $s (ref $bytes)) (param $i i32) (result i32) + (array.get $bytes (local.get $s) (local.get $i))) + (func $string_val (param $s (ref eq)) (result (ref $bytes)) + (ref.cast (ref $bytes) (local.get $s))) +)) + (type $bytes (array (mut i8))) (type $string (struct (field anyref))) (type $block (array (mut (ref eq)))) @@ -78,7 +95,17 @@ (i32.shr_u (local.get $c) (i32.const 3))) (i32.and (local.get $c) (i32.const 7))))) - (func $in_bitset (param $s externref) (param $c i32) (result i32) + (func $in_bitset + (param $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) + (param $c i32) (result i32) (i32.and (i32.const 1) (i32.shr_u (call $string_get (local.get $s) @@ -86,16 +113,34 @@ (i32.and (local.get $c) (i32.const 7))))) (func $re_match - (param $vre (ref eq)) (param $s externref) (param $pos i32) - (param $accept_partial_match i32) (result (ref eq)) + (param $vre (ref eq)) + (param $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) + (param $pos i32) (param $accept_partial_match i32) (result (ref eq)) (local $res (ref $block)) - (local $s' externref) (local $set externref) +(#if use-js-string +(#then + (local $s' externref) + (local $set externref) + (local $normtable externref) +) +(#else + (local $s' (ref $bytes)) + (local $set (ref $bytes)) + (local $normtable (ref $bytes)) +)) (local $len i32) (local $instr i32) (local $arg i32) (local $i i32) (local $j i32) (local $l i32) (local $re (ref $block)) (local $prog (ref $block)) (local $cpool (ref $block)) - (local $normtable externref) (local $numgroups i32) (local $numregisters i32) (local $group_start (ref $int_array)) @@ -114,10 +159,7 @@ (ref.cast (ref $block) (array.get $block (local.get $re) (i32.const 2)))) (local.set $normtable - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) - (array.get $block (local.get $re) (i32.const 3)))))) + (call $string_val (array.get $block (local.get $re) (i32.const 3)))) (local.set $numgroups (i31.get_s (ref.cast (ref i31) @@ -202,12 +244,10 @@ (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8))) (local.set $s' - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) - (array.get $block (local.get $cpool) - (i32.add (local.get $arg) - (i32.const 1))))))) + (call $string_val + (array.get $block (local.get $cpool) + (i32.add (local.get $arg) + (i32.const 1))))) (local.set $i (i32.const 0)) (local.set $l (call $string_length (local.get $s'))) (loop $loop @@ -232,12 +272,10 @@ (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8))) (local.set $s' - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) - (array.get $block (local.get $cpool) - (i32.add (local.get $arg) - (i32.const 1))))))) + (call $string_val + (array.get $block (local.get $cpool) + (i32.add (local.get $arg) + (i32.const 1))))) (local.set $i (i32.const 0)) (local.set $l (call $string_length (local.get $s'))) (loop $loop @@ -268,12 +306,10 @@ (br_if $backtrack (i32.eqz (call $in_bitset - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) - (array.get $block (local.get $cpool) - (i32.add (local.get $arg) - (i32.const 1)))))) + (call $string_val + (array.get $block (local.get $cpool) + (i32.add (local.get $arg) + (i32.const 1)))) (call $string_get (local.get $s) (local.get $pos))))) (local.set $pos @@ -384,12 +420,10 @@ (if (i32.lt_u (local.get $pos) (local.get $len)) (then (if (call $in_bitset - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) - (array.get $block (local.get $cpool) - (i32.add (local.get $arg) - (i32.const 1)))))) + (call $string_val + (array.get $block (local.get $cpool) + (i32.add (local.get $arg) + (i32.const 1)))) (call $string_get (local.get $s) (local.get $pos))) (then @@ -399,11 +433,9 @@ ;; SIMPLESTAR (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8))) (local.set $set - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) - (array.get $block (local.get $cpool) - (i32.add (local.get $arg) (i32.const 1))))))) + (call $string_val + (array.get $block (local.get $cpool) + (i32.add (local.get $arg) (i32.const 1))))) (loop $loop (if (i32.lt_u (local.get $pos) (local.get $len)) (then @@ -419,11 +451,9 @@ (br_if $prefix_match (i32.eq (local.get $pos) (local.get $len))) (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8))) (local.set $set - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) - (array.get $block (local.get $cpool) - (i32.add (local.get $arg) (i32.const 1))))))) + (call $string_val + (array.get $block (local.get $cpool) + (i32.add (local.get $arg) (i32.const 1))))) (br_if $backtrack (i32.eqz (call $in_bitset (local.get $set) @@ -541,13 +571,18 @@ (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) (result (ref eq)) ;; ZZZ startchars - (local $s externref) + (local $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) (local $pos i32) (local $len i32) (local $res (ref eq)) - (local.set $s - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $vs))))) + (local.set $s (call $string_val (local.get $vs))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (call $string_length (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) @@ -572,13 +607,18 @@ (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) (result (ref eq)) ;; ZZZ startchars - (local $s externref) + (local $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) (local $pos i32) (local $len i32) (local $res (ref eq)) - (local.set $s - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $vs))))) + (local.set $s (call $string_val (local.get $vs))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (call $string_length (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) @@ -603,13 +643,18 @@ (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) (result (ref eq)) ;; ZZZ startchars - (local $s externref) + (local $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) (local $pos i32) (local $len i32) (local $res (ref eq)) - (local.set $s - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $vs))))) + (local.set $s (call $string_val (local.get $vs))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (call $string_length (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) @@ -631,13 +676,18 @@ (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) (result (ref eq)) ;; ZZZ startchars - (local $s externref) + (local $s +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) (local $pos i32) (local $len i32) (local $res (ref eq)) - (local.set $s - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $vs))))) + (local.set $s (call $string_val (local.get $vs))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (call $string_length (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) @@ -659,15 +709,20 @@ (func (export "re_replacement_text") (param $vrepl (ref eq)) (param $vgroups (ref eq)) (param $orig (ref eq)) (result (ref eq)) - (local $repl externref) + (local $repl +(#if use-js-string +(#then + externref +) +(#else + (ref $bytes) +)) + ) (local $groups (ref $block)) (local $res (ref $bytes)) (local $i i32) (local $j i32) (local $l i32) (local $len i32) (local $c i32) (local $start i32) (local $end i32) - (local.set $repl - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $vrepl))))) + (local.set $repl (call $string_val (local.get $vrepl))) (local.set $l (call $string_length (local.get $repl))) (local.set $groups (ref.cast (ref $block) (local.get $vgroups))) (loop $loop diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat index 5c9e53da08..5eb1d18db5 100644 --- a/runtime/wasm/string.wat +++ b/runtime/wasm/string.wat @@ -35,6 +35,8 @@ (type $bytes (array (mut i8))) (type $string (struct (field anyref))) +(#if use-js-string +(#then (func $caml_string_equal (export "caml_string_equal") (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) (ref.i31 @@ -46,6 +48,85 @@ (struct.get $string 0 (ref.cast (ref $string) (local.get $p2))))))) + (func (export "caml_string_notequal") + (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) + (return + (ref.i31 (i32.eqz (i31.get_u (ref.cast (ref i31) + (call $caml_string_equal (local.get $p1) (local.get $p2)))))))) + + (func (export "caml_string_compare") + (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) + (ref.i31 + (call $string_compare + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p1)))) + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p2))))))) + + (func (export "caml_string_lessequal") + (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) + (ref.i31 + (i32.le_s + (call $string_compare + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p1)))) + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p2))))) + (i32.const 0)))) + + (func (export "caml_string_lessthan") + (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) + (ref.i31 + (i32.lt_s + (call $string_compare + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p1)))) + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p2))))) + (i32.const 0)))) + + (func (export "caml_string_greaterequal") + (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) + (ref.i31 + (i32.ge_s + (call $string_compare + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p1)))) + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p2))))) + (i32.const 0)))) + + (func (export "caml_string_greaterthan") + (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) + (ref.i31 + (i32.gt_s + (call $string_compare + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p1)))) + (extern.convert_any + (struct.get $string 0 + (ref.cast (ref $string) (local.get $p2))))) + (i32.const 0)))) +) +(#else + (export "caml_string_equal" (func $caml_bytes_equal)) + (export "caml_string_notequal" (func $caml_bytes_notequal)) + (export "caml_string_compare" (func $caml_bytes_compare)) + (export "caml_string_lessequal" (func $caml_bytes_lessequal)) + (export "caml_string_lessthan" (func $caml_bytes_lessthan)) + (export "caml_string_greaterequal" (func $caml_bytes_greaterequal)) + (export "caml_string_greaterthan" (func $caml_bytes_greaterthan)) +)) + (func $caml_bytes_equal (export "caml_bytes_equal") (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) (local $s1 (ref $bytes)) (local $s2 (ref $bytes)) @@ -68,18 +149,12 @@ (br $loop)))) (ref.i31 (i32.const 1))) - (func (export "caml_bytes_notequal") + (func $caml_bytes_notequal (export "caml_bytes_notequal") (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) (return (ref.i31 (i32.eqz (i31.get_u (ref.cast (ref i31) (call $caml_bytes_equal (local.get $p1) (local.get $p2)))))))) - (func (export "caml_string_notequal") - (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) - (return - (ref.i31 (i32.eqz (i31.get_u (ref.cast (ref i31) - (call $caml_string_equal (local.get $p1) (local.get $p2)))))))) - (func $bytes_compare (param $p1 (ref eq)) (param $p2 (ref eq)) (result i32) (local $s1 (ref $bytes)) (local $s2 (ref $bytes)) @@ -113,93 +188,32 @@ (then (return (i32.const 1)))) (i32.const 0)) - (func (export "caml_bytes_compare") + (func $caml_bytes_compare (export "caml_bytes_compare") (param (ref eq)) (param (ref eq)) (result (ref eq)) (ref.i31 (call $bytes_compare (local.get 0) (local.get 1)))) - (func (export "caml_string_compare") - (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) - (ref.i31 - (call $string_compare - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p1)))) - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p2))))))) - - (func (export "caml_bytes_lessequal") + (func $caml_bytes_lessequal (export "caml_bytes_lessequal") (param (ref eq)) (param (ref eq)) (result (ref eq)) (ref.i31 (i32.le_s (call $bytes_compare (local.get 0) (local.get 1)) (i32.const 0)))) - (func (export "caml_string_lessequal") - (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) - (ref.i31 - (i32.le_s - (call $string_compare - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p1)))) - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p2))))) - (i32.const 0)))) - - (func (export "caml_bytes_lessthan") + (func $caml_bytes_lessthan (export "caml_bytes_lessthan") (param (ref eq)) (param (ref eq)) (result (ref eq)) (ref.i31 (i32.lt_s (call $bytes_compare (local.get 0) (local.get 1)) (i32.const 0)))) - (func (export "caml_string_lessthan") - (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) - (ref.i31 - (i32.lt_s - (call $string_compare - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p1)))) - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p2))))) - (i32.const 0)))) - - (func (export "caml_bytes_greaterequal") + (func $caml_bytes_greaterequal (export "caml_bytes_greaterequal") (param (ref eq)) (param (ref eq)) (result (ref eq)) (ref.i31 (i32.ge_s (call $bytes_compare (local.get 0) (local.get 1)) (i32.const 0)))) - (func (export "caml_string_greaterequal") - (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) - (ref.i31 - (i32.ge_s - (call $string_compare - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p1)))) - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p2))))) - (i32.const 0)))) - - (func (export "caml_bytes_greaterthan") + (func $caml_bytes_greaterthan (export "caml_bytes_greaterthan") (param (ref eq)) (param (ref eq)) (result (ref eq)) (ref.i31 (i32.gt_s (call $bytes_compare (local.get 0) (local.get 1)) (i32.const 0)))) - (func (export "caml_string_greaterthan") - (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq)) - (ref.i31 - (i32.gt_s - (call $string_compare - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p1)))) - (extern.convert_any - (struct.get $string 0 - (ref.cast (ref $string) (local.get $p2))))) - (i32.const 0)))) - +(#if use-js-string +(#then (func (export "caml_bytes_of_string") (param $v (ref eq)) (result (ref eq)) (local $s externref) (local $b (ref $bytes)) (local $l i32) (local $i i32) (local.set $s @@ -222,6 +236,13 @@ (return (struct.new $string (call $jsbytes_of_bytes (ref.cast (ref $bytes) (local.get $b)))))) +) +(#else + (export "caml_bytes_of_string" (func $caml_string_of_bytes)) + (func $caml_string_of_bytes (export "caml_string_of_bytes") + (param $v (ref eq)) (result (ref eq)) + (local.get $v)) +)) (data $string_create "Bytes.create") @@ -236,6 +257,8 @@ (i32.const 0) (i32.const 12))))) (array.new $bytes (i32.const 0) (local.get $l))) +(#if use-js-string +(#then (func $blit_string (param $s anyref) (param $i1 i32) (param $b (ref $bytes)) (param $i2 i32) @@ -266,8 +289,12 @@ (i31.get_s (ref.cast (ref i31) (local.get $i2))) (i31.get_s (ref.cast (ref i31) (local.get $n)))) (ref.i31 (i32.const 0))) +) +(#else + (export "caml_blit_string" (func $caml_blit_bytes)) +)) - (func (export "caml_blit_bytes") + (func $caml_blit_bytes (export "caml_blit_bytes") (param $v1 (ref eq)) (param $i1 (ref eq)) (param $v2 (ref eq)) (param $i2 (ref eq)) (param $n (ref eq)) (result (ref eq)) @@ -289,6 +316,8 @@ (i31.get_u (ref.cast (ref i31) (local.get $len)))) (ref.i31 (i32.const 0))) +(#if use-js-string +(#then (func (export "caml_string_get16") (param $v (ref eq)) (param $i (ref eq)) (result (ref eq)) (local $s externref) (local $p i32) @@ -308,22 +337,6 @@ (i32.add (local.get $p) (i32.const 1))) (i32.const 8))))) - (func (export "caml_bytes_get16") - (param $v (ref eq)) (param $i (ref eq)) (result (ref eq)) - (local $s (ref $bytes)) (local $p i32) - (local.set $s (ref.cast (ref $bytes) (local.get $v))) - (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) - (if (i32.lt_s (local.get $p) (i32.const 0)) - (then (call $caml_bound_error))) - (if (i32.ge_u (i32.add (local.get $p) (i32.const 1)) - (array.len (local.get $s))) - (then (call $caml_bound_error))) - (ref.i31 (i32.or - (array.get_u $bytes (local.get $s) (local.get $p)) - (i32.shl (array.get_u $bytes (local.get $s) - (i32.add (local.get $p) (i32.const 1))) - (i32.const 8))))) - (func (export "caml_string_get32") (param $v (ref eq)) (param $i (ref eq)) (result i32) (local $s externref) (local $p i32) @@ -351,30 +364,6 @@ (i32.add (local.get $p) (i32.const 3))) (i32.const 24))))) - (func (export "caml_bytes_get32") - (param $v (ref eq)) (param $i (ref eq)) (result i32) - (local $s (ref $bytes)) (local $p i32) - (local.set $s (ref.cast (ref $bytes) (local.get $v))) - (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) - (if (i32.lt_s (local.get $p) (i32.const 0)) - (then (call $caml_bound_error))) - (if (i32.ge_u (i32.add (local.get $p) (i32.const 3)) - (array.len (local.get $s))) - (then (call $caml_bound_error))) - (i32.or - (i32.or - (array.get_u $bytes (local.get $s) (local.get $p)) - (i32.shl (array.get_u $bytes (local.get $s) - (i32.add (local.get $p) (i32.const 1))) - (i32.const 8))) - (i32.or - (i32.shl (array.get_u $bytes (local.get $s) - (i32.add (local.get $p) (i32.const 2))) - (i32.const 16)) - (i32.shl (array.get_u $bytes (local.get $s) - (i32.add (local.get $p) (i32.const 3))) - (i32.const 24))))) - (func (export "caml_string_get64") (param $v (ref eq)) (param $i (ref eq)) (result i64) (local $s externref) (local $p i32) @@ -425,8 +414,54 @@ (call $string_get (local.get $s) (i32.add (local.get $p) (i32.const 7)))) (i64.const 56)))))) +) +(#else + (export "caml_string_get16" (func $caml_bytes_get16)) + (export "caml_string_get32" (func $caml_bytes_get32)) + (export "caml_string_get64" (func $caml_bytes_get64)) +)) - (func (export "caml_bytes_get64") + (func $caml_bytes_get16 (export "caml_bytes_get16") + (param $v (ref eq)) (param $i (ref eq)) (result (ref eq)) + (local $s (ref $bytes)) (local $p i32) + (local.set $s (ref.cast (ref $bytes) (local.get $v))) + (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) + (if (i32.lt_s (local.get $p) (i32.const 0)) + (then (call $caml_bound_error))) + (if (i32.ge_u (i32.add (local.get $p) (i32.const 1)) + (array.len (local.get $s))) + (then (call $caml_bound_error))) + (ref.i31 (i32.or + (array.get_u $bytes (local.get $s) (local.get $p)) + (i32.shl (array.get_u $bytes (local.get $s) + (i32.add (local.get $p) (i32.const 1))) + (i32.const 8))))) + + (func $caml_bytes_get32 (export "caml_bytes_get32") + (param $v (ref eq)) (param $i (ref eq)) (result i32) + (local $s (ref $bytes)) (local $p i32) + (local.set $s (ref.cast (ref $bytes) (local.get $v))) + (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) + (if (i32.lt_s (local.get $p) (i32.const 0)) + (then (call $caml_bound_error))) + (if (i32.ge_u (i32.add (local.get $p) (i32.const 3)) + (array.len (local.get $s))) + (then (call $caml_bound_error))) + (i32.or + (i32.or + (array.get_u $bytes (local.get $s) (local.get $p)) + (i32.shl (array.get_u $bytes (local.get $s) + (i32.add (local.get $p) (i32.const 1))) + (i32.const 8))) + (i32.or + (i32.shl (array.get_u $bytes (local.get $s) + (i32.add (local.get $p) (i32.const 2))) + (i32.const 16)) + (i32.shl (array.get_u $bytes (local.get $s) + (i32.add (local.get $p) (i32.const 3))) + (i32.const 24))))) + + (func $caml_bytes_get64 (export "caml_bytes_get64") (param $v (ref eq)) (param $i (ref eq)) (result i64) (local $s (ref $bytes)) (local $p i32) (local.set $s (ref.cast (ref $bytes) (local.get $v))) @@ -548,6 +583,8 @@ (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 56)))) (ref.i31 (i32.const 0))) +(#if use-js-string +(#then (func (export "caml_string_concat") (param $s1 (ref eq)) (param $s2 (ref eq)) (result (ref eq)) (return @@ -560,11 +597,40 @@ (extern.convert_any (struct.get $string 0 (ref.cast (ref $string) (local.get $s2))))))))) +) +(#else + (func (export "caml_string_concat") + (param $vs1 (ref eq)) (param $vs2 (ref eq)) (result (ref eq)) + (local $s1 (ref $bytes)) (local $s2 (ref $bytes)) + (local $s (ref $bytes)) + (local $l1 i32) (local $l2 i32) + (local.set $s1 (ref.cast (ref $bytes) (local.get $vs1))) + (local.set $s2 (ref.cast (ref $bytes) (local.get $vs2))) + (local.set $l1 (array.len (local.get $s1))) + (local.set $l2 (array.len (local.get $s2))) + (local.set $s + (array.new $bytes (i32.const 0) + (i32.add (local.get $l1) (local.get $l2)))) + (array.copy $bytes $bytes + (local.get $s) (i32.const 0) (local.get $s1) (i32.const 0) + (local.get $l1)) + (array.copy $bytes $bytes + (local.get $s) (local.get $l1) (local.get $s2) (i32.const 0) + (local.get $l2)) + (local.get $s)) +)) - +(#if use-js-string +(#then (func (export "caml_string_length") (param $s (ref eq)) (result i32) (return_call $string_length (extern.convert_any (struct.get $string 0 (ref.cast (ref $string) (local.get $s)))))) ) +(#else + (func (export "caml_string_length") (param $s (ref eq)) (result i32) + (array.len (ref.cast (ref $bytes) (local.get $s)))) +)) + +) diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat index 72ff0c87c9..9de9a6f48e 100644 --- a/runtime/wasm/sys.wat +++ b/runtime/wasm/sys.wat @@ -27,8 +27,6 @@ (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq)))) (import "jslib" "caml_string_of_jsstring" (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq)))) - (import "jslib" "caml_bytes_of_jsstring" - (func $caml_bytes_of_jsstring (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 "jslib" "caml_js_meth_call" @@ -51,6 +49,8 @@ (func $jsstring_test (param anyref) (result i32))) (import "string" "caml_string_of_bytes" (func $caml_string_of_bytes (param (ref eq)) (result (ref eq)))) + (import "string" "caml_bytes_of_string" + (func $caml_bytes_of_string (param (ref eq)) (result (ref eq)))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) @@ -195,9 +195,10 @@ (func $caml_handle_sys_error (export "caml_handle_sys_error") (param $exn externref) (call $caml_raise_sys_error - (call $caml_bytes_of_jsstring - (call $caml_js_meth_call - (call $wrap (any.convert_extern (local.get $exn))) - (array.new_data $bytes $toString (i32.const 0) (i32.const 8)) - (array.new_fixed $block 1 (ref.i31 (i32.const 0))))))) + (call $caml_bytes_of_string + (call $caml_string_of_jsstring + (call $caml_js_meth_call + (call $wrap (any.convert_extern (local.get $exn))) + (array.new_data $bytes $toString (i32.const 0) (i32.const 8)) + (array.new_fixed $block 1 (ref.i31 (i32.const 0)))))))) )