diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index b8c5eadf24..59cc22cd7f 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -24,42 +24,6 @@ (func $ta_kind (param (ref extern)) (result i32))) (import "bindings" "ta_length" (func $ta_length (param (ref extern)) (result i32))) - (import "bindings" "ta_get_f64" - (func $ta_get_f64 (param (ref extern)) (param i32) (result f64))) - (import "bindings" "ta_get_f32" - (func $ta_get_f32 (param (ref extern)) (param i32) (result f64))) - (import "bindings" "ta_get_i32" - (func $ta_get_i32 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_get_i16" - (func $ta_get_i16 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_get_ui16" - (func $ta_get_ui16 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_get_i8" - (func $ta_get_i8 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_get_ui8" - (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_get32_ui8" - (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_get16_ui8" - (func $ta_get16_ui8 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_set_f64" - (func $ta_set_f64 (param (ref extern)) (param i32) (param f64))) - (import "bindings" "ta_set_f32" - (func $ta_set_f32 (param (ref extern)) (param i32) (param f64))) - (import "bindings" "ta_set_i32" - (func $ta_set_i32 (param (ref extern)) (param i32) (param i32))) - (import "bindings" "ta_set_i16" - (func $ta_set_i16 (param (ref extern)) (param i32) (param (ref i31)))) - (import "bindings" "ta_set_ui16" - (func $ta_set_ui16 (param (ref extern)) (param i32) (param (ref i31)))) - (import "bindings" "ta_set_i8" - (func $ta_set_i8 (param (ref extern)) (param i32) (param (ref i31)))) - (import "bindings" "ta_set_ui8" - (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31)))) - (import "bindings" "ta_set16_ui8" - (func $ta_set16_ui8 (param (ref extern)) (param i32) (param (ref i31)))) - (import "bindings" "ta_set32_ui8" - (func $ta_set32_ui8 (param (ref extern)) (param i32) (param i32))) (import "bindings" "ta_fill" (func $ta_fill_int (param (ref extern)) (param i32))) (import "bindings" "ta_fill" @@ -77,6 +41,37 @@ (func $ta_blit_to_bytes (param (ref extern)) (param i32) (param (ref $bytes)) (param i32) (param i32))) + (import "bindings" "dv_make" + (func $dv_make (param (ref extern)) (result (ref extern)))) + (import "bindings" "dv_get_f64" + (func $dv_get_f64 (param externref i32 i32) (result f64))) + (import "bindings" "dv_get_f32" + (func $dv_get_f32 (param externref i32 i32) (result f32))) + (import "bindings" "dv_get_i64" + (func $dv_get_i64 (param externref i32 i32) (result i64))) + (import "bindings" "dv_get_i32" + (func $dv_get_i32 (param externref i32 i32) (result i32))) + (import "bindings" "dv_get_i16" + (func $dv_get_i16 (param externref i32 i32) (result i32))) + (import "bindings" "dv_get_ui16" + (func $dv_get_ui16 (param externref i32 i32) (result i32))) + (import "bindings" "dv_get_i8" + (func $dv_get_i8 (param externref i32) (result i32))) + (import "bindings" "dv_get_ui8" + (func $dv_get_ui8 (param externref i32) (result i32))) + (import "bindings" "dv_set_f64" + (func $dv_set_f64 (param externref i32 f64 i32))) + (import "bindings" "dv_set_f32" + (func $dv_set_f32 (param externref i32 f32 i32))) + (import "bindings" "dv_set_i64" + (func $dv_set_i64 (param externref i32 i64 i32))) + (import "bindings" "dv_set_i32" + (func $dv_set_i32 (param externref i32 i32 i32))) + (import "bindings" "dv_set_i16" + (func $dv_set_i16 (param externref i32 i32 i32))) + (import "bindings" "dv_set_i8" + (func $dv_set_i8 (param externref i32 i32))) + (import "bindings" "littleEndian" (global $littleEndian i32)) (import "fail" "caml_bound_error" (func $caml_bound_error)) (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory)) (import "fail" "caml_invalid_argument" @@ -171,6 +166,7 @@ (struct (field (ref $custom_operations)) (field $ba_data (mut (ref extern))) ;; data + (field $ba_view (mut (ref extern))) ;; view (field $ba_dim (ref $int_array)) ;; size in each dimension (field $ba_num_dims i8) ;; number of dimensions (field $ba_kind i8) ;; kind @@ -233,116 +229,72 @@ (local $b (ref $bigarray)) (local $h i32) (local $len i32) (local $i i32) (local $w i32) (local $data (ref extern)) + (local $view (ref extern)) (local.set $b (ref.cast (ref $bigarray) (local.get 0))) (local.set $data (struct.get $bigarray $ba_data (local.get $b))) + (local.set $view (struct.get $bigarray $ba_view (local.get $b))) (local.set $len (call $ta_length (local.get $data))) (block $float64 (block $float32 (block $int8 - (block $uint8 - (block $int16 - (block $uint16 - (block $int32 - (block $int64 - (block $float16 - (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 - $int32 $int64 $int32 $int32 - $float32 $float64 $uint8 $float16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; float16 - (if (i32.gt_u (local.get $len) (i32.const 128)) - (then (local.set $len (i32.const 128)))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $h - (call $caml_hash_mix_float16 (local.get $h) - (call $ta_get_ui16 - (local.get $data) (local.get $i)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (return (local.get $h))) - ;; int64 - (if (i32.gt_u (local.get $len) (i32.const 64)) - (then (local.set $len (i32.const 64)))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $h - (call $caml_hash_mix_int64 (local.get $h) - (i64.or - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) - (local.get $i))) - (i64.shl - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)))) - (i64.const 32))))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) - (br $loop)))) - (return (local.get $h))) - ;; int32 - (if (i32.gt_u (local.get $len) (i32.const 64)) - (then (local.set $len (i32.const 64)))) + (block $int16 + (block $int32 + (block $int64 + (block $float16 + (br_table $float32 $float64 $int8 $int8 $int16 $int16 + $int32 $int64 $int32 $int32 + $float32 $float64 $int8 $float16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h - (call $caml_hash_mix_int (local.get $h) - (call $ta_get_i32 (local.get $data) (local.get $i)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $caml_hash_mix_float16 (local.get $h) + (call $dv_get_ui16 + (local.get $view) + (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (local.get $h))) - ;; uint16 - (if (i32.gt_u (local.get $len) (i32.const 128)) - (then (local.set $len (i32.const 128)))) + ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) (loop $loop - (if (i32.le_u (i32.add (local.get $i) (i32.const 2)) - (local.get $len)) + (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h - (call $caml_hash_mix_int - (local.get $h) - (i32.or - (call $ta_get_ui16 (local.get $data) (local.get $i)) - (i32.shl (call $ta_get_ui16 (local.get $data) - (i32.add (local.get $i) (i32.const 1))) - (i32.const 16))))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $caml_hash_mix_int64 (local.get $h) + (call $dv_get_i64 + (local.get $view) + (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) - (if (i32.and (local.get $len) (i32.const 1)) - (then - (local.set $h - (call $caml_hash_mix_int (local.get $h) - (call $ta_get_ui16 (local.get $data) (local.get $i)))))) (return (local.get $h))) - ;; int16 - (if (i32.gt_u (local.get $len) (i32.const 128)) - (then (local.set $len (i32.const 128)))) + ;; int32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) (loop $loop - (if (i32.le_u (i32.add (local.get $i) (i32.const 2)) - (local.get $len)) + (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h - (call $caml_hash_mix_int - (local.get $h) - (i32.or - (i32.and (i32.const 0xFFFF) - (call $ta_get_i16 (local.get $data) - (local.get $i))) - (i32.shl (call $ta_get_i16 (local.get $data) - (i32.add (local.get $i) (i32.const 1))) - (i32.const 16))))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $caml_hash_mix_int (local.get $h) + (call $dv_get_i32 + (local.get $view) + (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) - (if (i32.and (local.get $len) (i32.const 1)) - (then - (local.set $h - (call $caml_hash_mix_int (local.get $h) - (call $ta_get_i16 (local.get $data) (local.get $i)))))) (return (local.get $h))) - ;; uint8 + ;; int16 / uint16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (if (i32.gt_u (local.get $len) (i32.const 256)) (then (local.set $len (i32.const 256)))) (loop $loop @@ -352,32 +304,29 @@ (local.set $h (call $caml_hash_mix_int (local.get $h) - (call $ta_get32_ui8 (local.get $data) (local.get $i)))) + (i32.or + (call $dv_get_ui16 + (local.get $view) + (local.get $i) + (global.get $littleEndian)) + (i32.shl + (call $dv_get_ui16 + (local.get $view) + (i32.add (local.get $i) (i32.const 2)) + (global.get $littleEndian)) + (i32.const 16))))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) - (local.set $w (i32.const 0)) - (block $0_bytes - (block $1_byte - (block $2_bytes - (block $3_bytes - (br_table $0_bytes $1_byte $2_bytes $3_bytes - (i32.and (local.get $len) (i32.const 3)))) - (local.set $w - (i32.shl (call $ta_get_ui8 (local.get $data) - (i32.add (local.get $i) (i32.const 2))) - (i32.const 16)))) - (local.set $w - (i32.or (local.get $w) - (i32.shl (call $ta_get_ui8 (local.get $data) - (i32.add (local.get $i) (i32.const 1))) - (i32.const 8))))) - (local.set $w - (i32.or (local.get $w) - (call $ta_get_ui8 (local.get $data) (local.get $i)))) - (local.set $h - (call $caml_hash_mix_int (local.get $h) (local.get $w)))) + (if (i32.and (local.get $len) (i32.const 2)) + (then + (local.set $h + (call $caml_hash_mix_int (local.get $h) + (call $dv_get_ui16 + (local.get $view) + (local.get $i) + (global.get $littleEndian)))))) (return (local.get $h))) - ;; int8 + ;; int8 / uint8 (if (i32.gt_u (local.get $len) (i32.const 256)) (then (local.set $len (i32.const 256)))) (loop $loop @@ -386,24 +335,8 @@ (local.set $h (call $caml_hash_mix_int (local.get $h) - (i32.or - (i32.or - (i32.and (i32.const 0xFF) - (call $ta_get_i8 (local.get $data) (local.get $i))) - (i32.shl - (i32.and (i32.const 0xFF) - (call $ta_get_i8 (local.get $data) - (i32.add (local.get $i) (i32.const 1)))) - (i32.const 8))) - (i32.or - (i32.shl - (i32.and (i32.const 0xFF) - (call $ta_get_i8 (local.get $data) - (i32.add (local.get $i) (i32.const 2)))) - (i32.const 16)) - (i32.shl (call $ta_get_i8 (local.get $data) - (i32.add (local.get $i) (i32.const 3))) - (i32.const 24)))))) + (call $dv_get_i32 + (local.get $view) (local.get $i) (i32.const 1)))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (local.set $w (i32.const 0)) @@ -414,43 +347,46 @@ (br_table $0_bytes $1_byte $2_bytes $3_bytes (i32.and (local.get $len) (i32.const 3)))) (local.set $w - (i32.shl (call $ta_get_i8 (local.get $data) + (i32.shl (call $dv_get_ui8 (local.get $view) (i32.add (local.get $i) (i32.const 2))) (i32.const 16)))) (local.set $w (i32.or (local.get $w) - (i32.shl (call $ta_get_i8 (local.get $data) + (i32.shl (call $dv_get_ui8 (local.get $view) (i32.add (local.get $i) (i32.const 1))) (i32.const 8))))) (local.set $w (i32.or (local.get $w) - (call $ta_get_i8 (local.get $data) (local.get $i)))) + (call $dv_get_i8 (local.get $view) (local.get $i)))) (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (return (local.get $h))) ;; float32 - (if (i32.gt_u (local.get $len) (i32.const 64)) - (then (local.set $len (i32.const 64)))) + (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h (call $caml_hash_mix_float (local.get $h) - (f32.demote_f64 - (call $ta_get_f32 (local.get $data) (local.get $i))))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_get_f32 (local.get $view) (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (return (local.get $h))) ;; float64 - (if (i32.gt_u (local.get $len) (i32.const 32)) - (then (local.set $len (i32.const 32)))) + (local.set $len (i32.shl (local.get $len) (i32.const 3))) + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h (call $caml_hash_mix_double (local.get $h) - (call $ta_get_f64 (local.get $data) (local.get $i)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_get_f64 (local.get $view) (local.get $i) + (global.get $littleEndian)))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (return (local.get $h))) @@ -459,6 +395,7 @@ (local $b (ref $bigarray)) (local $num_dims i32) (local $dim (ref $int_array)) (local $data (ref extern)) + (local $view (ref extern)) (local $i i32) (local $len i32) (local.set $b (ref.cast (ref $bigarray) (local.get $v))) (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $b))) @@ -486,115 +423,73 @@ (br $loop)))) (block $done (local.set $data (struct.get $bigarray $ba_data (local.get $b))) + (local.set $view (struct.get $bigarray $ba_view (local.get $b))) (local.set $len (call $ta_length (local.get $data))) (local.set $i (i32.const 0)) (block $float64 - (block $float32 - (block $int8 - (block $uint8 - (block $int16 - (block $uint16 - (block $int32 - (block $int - (block $int64 - (block $float16 - (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 - $int32 $int64 $int $int - $float32 $float64 $uint8 $float16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; float16 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_2 (local.get $s) - (call $ta_get_ui16 - (local.get $data) (local.get $i))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; int64 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_8 (local.get $s) - (i64.or - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) - (local.get $i))) - (i64.shl - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)))) - (i64.const 32)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) - (br $loop)))) - (br $done)) - ;; int - (call $caml_serialize_int_1 (local.get $s) (i32.const 0))) - ;; int32 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_4 (local.get $s) - (call $ta_get_i32 (local.get $data) (local.get $i))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; uint16 + (block $int8 + (block $int16 + (block $int32 + (block $int + (block $int64 + (br_table $int32 $float64 $int8 $int8 $int16 $int16 + $int32 $int64 $int $int + $int32 $float64 $int8 $int16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_2 (local.get $s) - (call $ta_get_ui16 (local.get $data) (local.get $i))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $caml_serialize_int_8 (local.get $s) + (call $dv_get_i64 (local.get $view) + (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (br $done)) - ;; int16 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_2 (local.get $s) - (call $ta_get_i16 (local.get $data) (local.get $i))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; uint8 + ;; int + (call $caml_serialize_int_1 (local.get $s) (i32.const 0))) + ;; int32 / float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_1 (local.get $s) - (call $ta_get_ui8 (local.get $data) (local.get $i))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $caml_serialize_int_4 (local.get $s) + (call $dv_get_i32 (local.get $view) (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (br $done)) - ;; int8 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_1 (local.get $s) - (call $ta_get_i8 (local.get $data) (local.get $i))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; float32 + ;; int16 / uint16 / float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_2 (local.get $s) + (call $dv_get_i16 (local.get $view) (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) + (br $loop)))) + (br $done)) + ;; int8 / uint8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_4 (local.get $s) - (i32.reinterpret_f32 - (f32.demote_f64 - (call $ta_get_f32 (local.get $data) (local.get $i))))) + (call $caml_serialize_int_1 (local.get $s) + (call $dv_get_i8 (local.get $view) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) ;; float64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (call $caml_serialize_int_8 (local.get $s) - (i64.reinterpret_f64 - (call $ta_get_f64 (local.get $data) (local.get $i)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_get_i64 (local.get $view) (local.get $i) + (global.get $littleEndian))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop))))) (tuple.make 2 (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4)) @@ -609,6 +504,7 @@ (local $num_dims i32) (local $dim (ref $int_array)) (local $flags i32) (local $kind i32) (local $data (ref extern)) + (local $view (ref extern)) (local $i i32) (local $len i32) (local $l i64) (local.set $num_dims (call $caml_deserialize_int_4 (local.get $s))) @@ -630,125 +526,86 @@ (local.get $len)) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) + (local.set $data + (call $caml_ba_create_buffer (local.get $kind) + (call $caml_ba_get_size (local.get $dim)))) + (local.set $view (call $dv_make (local.get $data))) (local.set $b (struct.new $bigarray (global.get $bigarray_ops) - (call $caml_ba_create_buffer (local.get $kind) - (call $caml_ba_get_size (local.get $dim))) + (local.get $data) + (local.get $view) (local.get $dim) (local.get $num_dims) (local.get $kind) (i32.shr_u (local.get $flags) (i32.const 8)))) (block $done - (local.set $data (struct.get $bigarray $ba_data (local.get $b))) (local.set $len (call $ta_length (local.get $data))) (local.set $i (i32.const 0)) (block $float64 - (block $float32 - (block $int8 - (block $uint8 - (block $int16 - (block $uint16 - (block $int32 - (block $int - (block $int64 - (block $float16 - (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 - $int32 $int64 $int $int - $float32 $float64 $uint8 $float16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; float16 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $ta_set_ui16 (local.get $data) (local.get $i) - (ref.i31 - (call $caml_deserialize_uint_2 (local.get $s)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; int64 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $l - (call $caml_deserialize_int_8 (local.get $s))) - (call $ta_set_i32 (local.get $data) (local.get $i) - (i32.wrap_i64 (local.get $l))) - (call $ta_set_i32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)) - (i32.wrap_i64 - (i64.shr_u (local.get $l) (i64.const 32)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) - (br $loop)))) - (br $done)) - ;; int - (if (call $caml_deserialize_uint_1 (local.get $s)) - (then (call $caml_failwith (global.get $intern_overflow))))) - ;; int32 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $ta_set_i32 (local.get $data) (local.get $i) - (call $caml_deserialize_int_4 (local.get $s))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; uint16 + (block $int8 + (block $int16 + (block $int32 + (block $int + (block $int64 + (br_table $int32 $float64 $int8 $int8 $int16 $int16 + $int32 $int64 $int $int + $int32 $float64 $int8 $int16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_ui16 (local.get $data) (local.get $i) - (ref.i31 (call $caml_deserialize_uint_2 (local.get $s)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_set_i64 (local.get $view) (local.get $i) + (call $caml_deserialize_int_8 (local.get $s)) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (br $done)) - ;; int16 - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $ta_set_i16 (local.get $data) (local.get $i) - (ref.i31 (call $caml_deserialize_sint_2 (local.get $s)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (br $done)) - ;; uint8 + ;; int + (if (call $caml_deserialize_uint_1 (local.get $s)) + (then (call $caml_failwith (global.get $intern_overflow))))) + ;; int32 / float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_ui8 (local.get $data) (local.get $i) - (ref.i31 (call $caml_deserialize_uint_1 (local.get $s)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_set_i32 (local.get $view) (local.get $i) + (call $caml_deserialize_int_4 (local.get $s)) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (br $done)) - ;; int8 + ;; int16 / uint16 / float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_i8 (local.get $data) (local.get $i) - (ref.i31 (call $caml_deserialize_sint_1 (local.get $s)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_set_i16 (local.get $view) (local.get $i) + (call $caml_deserialize_sint_2 (local.get $s)) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (br $done)) - ;; float32 + ;; int8 / uint8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_f32 (local.get $data) (local.get $i) - (f64.promote_f32 - (f32.reinterpret_i32 - (call $caml_deserialize_int_4 (local.get $s))))) + (call $dv_set_i8 (local.get $view) (local.get $i) + (call $caml_deserialize_sint_1 (local.get $s))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) ;; float64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_f64 (local.get $data) (local.get $i) - (f64.reinterpret_i64 - (call $caml_deserialize_int_8 (local.get $s)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (call $dv_set_i64 (local.get $view) (local.get $i) + (call $caml_deserialize_int_8 (local.get $s)) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop))))) (tuple.make 2 (local.get $b) @@ -800,7 +657,7 @@ (param $vkind (ref eq)) (param $layout (ref eq)) (param $d (ref eq)) (result (ref eq)) (local $vdim (ref $block)) - (local $dim (ref $int_array)) + (local $data (ref extern)) (local $dim (ref $int_array)) (local $kind i32) (local $num_dims i32) (local $i i32) (local $n i32) (local.set $kind (i31.get_s (ref.cast (ref i31) (local.get $vkind)))) (local.set $vdim (ref.cast (ref $block) (local.get $d))) @@ -826,10 +683,13 @@ (local.get $dim) (local.get $i) (local.get $n)) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) + (local.set $data + (call $caml_ba_create_buffer (local.get $kind) + (call $caml_ba_get_size (local.get $dim)))) (struct.new $bigarray (global.get $bigarray_ops) - (call $caml_ba_create_buffer (local.get $kind) - (call $caml_ba_get_size (local.get $dim))) + (local.get $data) + (call $dv_make (local.get $data)) (local.get $dim) (local.get $num_dims) (local.get $kind) @@ -856,6 +716,7 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $data) + (call $dv_make (local.get $data)) (array.new_fixed $int_array 1 (local.get $len)) (i32.const 1) (local.get $kind) @@ -869,8 +730,8 @@ (func $caml_ba_get_at_offset (param $ba (ref $bigarray)) (param $i i32) (result (ref eq)) - (local $data (ref extern)) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local $view (ref extern)) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (block $float32 (block $float64 (block $int8 @@ -892,153 +753,173 @@ (return (struct.new $float (call $float16_to_double - (call $ta_get_ui16 - (local.get $data) (local.get $i)))))) + (call $dv_get_ui16 + (local.get $view) + (i32.shl (local.get $i) (i32.const 1)) + (global.get $littleEndian)))))) ;; complex64 - (local.set $i (i32.shl (local.get $i) (i32.const 1))) + (local.set $i (i32.shl (local.get $i) (i32.const 4))) (return (array.new_fixed $float_array 2 - (call $ta_get_f64 (local.get $data) (local.get $i)) - (call $ta_get_f64 (local.get $data) - (i32.add (local.get $i) (i32.const 1)))))) + (call $dv_get_f64 (local.get $view) (local.get $i) + (global.get $littleEndian)) + (call $dv_get_f64 (local.get $view) + (i32.add (local.get $i) (i32.const 8)) + (global.get $littleEndian))))) ;; complex32 - (local.set $i (i32.shl (local.get $i) (i32.const 1))) + (local.set $i (i32.shl (local.get $i) (i32.const 3))) (return (array.new_fixed $float_array 2 - (call $ta_get_f32 (local.get $data) (local.get $i)) - (call $ta_get_f32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)))))) + (f64.promote_f32 + (call $dv_get_f32 (local.get $view) (local.get $i) + (global.get $littleEndian))) + (f64.promote_f32 + (call $dv_get_f32 (local.get $view) + (i32.add (local.get $i) (i32.const 4)) + (global.get $littleEndian)))))) ;; nativeint (return_call $caml_copy_nativeint - (call $ta_get_i32 (local.get $data) (local.get $i)))) + (call $dv_get_i32 + (local.get $view) (i32.shl (local.get $i) (i32.const 2)) + (global.get $littleEndian)))) ;; int (return (ref.i31 - (call $ta_get_i32 (local.get $data) (local.get $i))))) + (call $dv_get_i32 + (local.get $view) (i32.shl (local.get $i) (i32.const 2)) + (global.get $littleEndian))))) ;; int64 - (local.set $i (i32.shl (local.get $i) (i32.const 1))) (return_call $caml_copy_int64 - (i64.or - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (local.get $i))) - (i64.shl - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)))) - (i64.const 32))))) + (call $dv_get_i64 + (local.get $view) (i32.shl (local.get $i) (i32.const 3)) + (global.get $littleEndian)))) ;; int32 (return_call $caml_copy_int32 - (call $ta_get_i32 (local.get $data) (local.get $i)))) + (call $dv_get_i32 + (local.get $view) (i32.shl (local.get $i) (i32.const 2)) + (global.get $littleEndian)))) ;; uint16 - (return (ref.i31 - (call $ta_get_ui16 (local.get $data) (local.get $i))))) + (return + (ref.i31 + (call $dv_get_ui16 + (local.get $view) (i32.shl (local.get $i) (i32.const 1)) + (global.get $littleEndian))))) ;; int16 - (return (ref.i31 - (call $ta_get_i16 (local.get $data) (local.get $i))))) + (return + (ref.i31 + (call $dv_get_i16 + (local.get $view) (i32.shl (local.get $i) (i32.const 1)) + (global.get $littleEndian))))) ;; uint8 (return (ref.i31 - (call $ta_get_ui8 (local.get $data) (local.get $i))))) + (call $dv_get_ui8 (local.get $view) (local.get $i))))) ;; int8 (return (ref.i31 - (call $ta_get_i8 (local.get $data) (local.get $i))))) + (call $dv_get_i8 (local.get $view) (local.get $i))))) ;; float64 - (return (struct.new $float - (call $ta_get_f64 (local.get $data) (local.get $i))))) + (return + (struct.new $float + (call $dv_get_f64 + (local.get $view) (i32.shl (local.get $i) (i32.const 3)) + (global.get $littleEndian))))) ;; float32 - (return (struct.new $float - (call $ta_get_f32 (local.get $data) (local.get $i))))) + (return + (struct.new $float + (f64.promote_f32 + (call $dv_get_f32 + (local.get $view) (i32.shl (local.get $i) (i32.const 2)) + (global.get $littleEndian)))))) (func $caml_ba_set_at_offset (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq)) - (local $data (ref extern)) + (local $view (ref extern)) (local $b (ref $float_array)) (local $l i64) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (block $float32 (block $float64 (block $int8 - (block $uint8 - (block $int16 - (block $uint16 + (block $int16 + (block $int64 + (block $int (block $int32 - (block $int64 - (block $int - (block $nativeint - (block $complex32 - (block $complex64 - (block $float16 - (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 - $int32 $int64 $int $nativeint - $complex32 $complex64 $uint8 $float16 - (struct.get $bigarray $ba_kind (local.get $ba)))) - ;; float16 - (call $ta_set_ui16 (local.get $data) (local.get $i) - (ref.i31 - (call $double_to_float16 - (struct.get $float 0 - (ref.cast (ref $float) (local.get $v)))))) - (return)) - ;; complex64 - (local.set $i (i32.shl (local.get $i) (i32.const 1))) - (local.set $b (ref.cast (ref $float_array) (local.get $v))) - (call $ta_set_f64 (local.get $data) (local.get $i) - (array.get $float_array (local.get $b) (i32.const 0))) - (call $ta_set_f64 (local.get $data) - (i32.add (local.get $i) (i32.const 1)) - (array.get $float_array (local.get $b) (i32.const 1))) - (return)) - ;; complex32 - (local.set $i (i32.shl (local.get $i) (i32.const 1))) - (local.set $b (ref.cast (ref $float_array) (local.get $v))) - (call $ta_set_f32 (local.get $data) (local.get $i) - (array.get $float_array (local.get $b) (i32.const 0))) - (call $ta_set_f32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)) - (array.get $float_array (local.get $b) (i32.const 1))) - (return)) - ;; nativeint - (call $ta_set_i32 (local.get $data) (local.get $i) - (call $Int32_val (local.get $v))) + (block $complex32 + (block $complex64 + (block $float16 + (br_table $float32 $float64 $int8 $int8 $int16 $int16 + $int32 $int64 $int $int32 + $complex32 $complex64 $int8 $float16 + (struct.get $bigarray $ba_kind (local.get $ba)))) + ;; float16 + (call $dv_set_i16 + (local.get $view) (i32.shl (local.get $i) (i32.const 1)) + (call $double_to_float16 + (struct.get $float 0 + (ref.cast (ref $float) (local.get $v)))) + (global.get $littleEndian)) (return)) - ;; int - (call $ta_set_i32 (local.get $data) (local.get $i) - (i31.get_s (ref.cast (ref i31) (local.get $v)))) + ;; complex64 + (local.set $i (i32.shl (local.get $i) (i32.const 4))) + (local.set $b (ref.cast (ref $float_array) (local.get $v))) + (call $dv_set_f64 (local.get $view) (local.get $i) + (array.get $float_array (local.get $b) (i32.const 0)) + (global.get $littleEndian)) + (call $dv_set_f64 (local.get $view) + (i32.add (local.get $i) (i32.const 8)) + (array.get $float_array (local.get $b) (i32.const 1)) + (global.get $littleEndian)) (return)) - ;; int64 - (local.set $i (i32.shl (local.get $i) (i32.const 1))) - (local.set $l (call $Int64_val (local.get $v))) - (call $ta_set_i32 (local.get $data) (local.get $i) - (i32.wrap_i64 (local.get $l))) - (call $ta_set_i32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)) - (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32)))) + ;; complex32 + (local.set $i (i32.shl (local.get $i) (i32.const 3))) + (local.set $b (ref.cast (ref $float_array) (local.get $v))) + (call $dv_set_f32 (local.get $view) (local.get $i) + (f32.demote_f64 + (array.get $float_array (local.get $b) (i32.const 0))) + (global.get $littleEndian)) + (call $dv_set_f32 (local.get $view) + (i32.add (local.get $i) (i32.const 4)) + (f32.demote_f64 + (array.get $float_array (local.get $b) (i32.const 1))) + (global.get $littleEndian)) (return)) - ;; int32 - (call $ta_set_i32 (local.get $data) (local.get $i) - (call $Int32_val (local.get $v))) + ;; int32 / nativeint + (call $dv_set_i32 + (local.get $view) (i32.shl (local.get $i) (i32.const 2)) + (call $Int32_val (local.get $v)) + (global.get $littleEndian)) (return)) - ;; uint16 - (call $ta_set_ui16 (local.get $data) (local.get $i) - (ref.cast (ref i31) (local.get $v))) + ;; int + (call $dv_set_i32 + (local.get $view) (i32.shl (local.get $i) (i32.const 2)) + (i31.get_s (ref.cast (ref i31) (local.get $v))) + (global.get $littleEndian)) (return)) - ;; int16 - (call $ta_set_i16 (local.get $data) (local.get $i) - (ref.cast (ref i31) (local.get $v))) + ;; int64 + (local.set $l (call $Int64_val (local.get $v))) + (call $dv_set_i64 + (local.get $view) (i32.shl (local.get $i) (i32.const 3)) + (call $Int64_val (local.get $v)) + (global.get $littleEndian)) (return)) - ;; uint8 - (call $ta_set_ui8 (local.get $data) (local.get $i) - (ref.cast (ref i31) (local.get $v))) + ;; int16/ uint16 + (call $dv_set_i16 + (local.get $view) (i32.shl (local.get $i) (i32.const 1)) + (i31.get_s (ref.cast (ref i31) (local.get $v))) + (global.get $littleEndian)) (return)) - ;; int8 - (call $ta_set_i8 (local.get $data) (local.get $i) - (ref.cast (ref i31) (local.get $v))) + ;; int8 / uint8 + (call $dv_set_i8 (local.get $view) (local.get $i) + (i31.get_s (ref.cast (ref i31) (local.get $v)))) (return)) ;; float64 - (call $ta_set_f64 (local.get $data) (local.get $i) - (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) + (call $dv_set_f64 (local.get $view) (i32.shl (local.get $i) (i32.const 3)) + (struct.get $float 0 (ref.cast (ref $float) (local.get $v))) + (global.get $littleEndian)) (return)) ;; float32 - (call $ta_set_f32 (local.get $data) (local.get $i) - (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) + (call $dv_set_f32 (local.get $view) (i32.shl (local.get $i) (i32.const 2)) + (f32.demote_f64 + (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) + (global.get $littleEndian)) (return)) (@string $Bigarray_dim "Bigarray.dim") @@ -1067,7 +948,7 @@ (if (struct.get $bigarray $ba_layout (local.get $ba)) (then (local.set $i (i32.sub (local.get $i) (i32.const 1))))) (if (i32.ge_u (local.get $i) - (array.get $int_array (struct.get $bigarray 2 (local.get $ba)) + (array.get $int_array (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i))) @@ -1473,6 +1354,7 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $sub_data) + (call $dv_make (local.get $sub_data)) (local.get $sub_dim) (array.len (local.get $sub_dim)) (struct.get $bigarray $ba_kind (local.get $b)) @@ -1548,6 +1430,7 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $new_data) + (call $dv_make (local.get $new_data)) (local.get $new_dim) (local.get $num_dims) (struct.get $bigarray $ba_kind (local.get $ba)) @@ -1557,9 +1440,10 @@ (param $vba (ref eq)) (param $v (ref eq)) (result (ref eq)) (local $ba (ref $bigarray)) (local $data (ref extern)) + (local $view (ref extern)) (local $l i64) (local $i i32) (local $len i32) (local $i1 i32) (local $i2 i32) - (local $f1 f64) (local $f2 f64) + (local $f1 f64) (local $f2 f64) (local $f1' f32) (local $f2' f32) (local $b (ref $float_array)) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) @@ -1579,7 +1463,9 @@ (struct.get $float 0 (ref.cast (ref $float) (local.get $v))))) (return (ref.i31 (i32.const 0)))) ;; complex64 - (local.set $len (call $ta_length (local.get $data))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $len + (i32.shl (call $ta_length (local.get $data)) (i32.const 3))) (local.set $b (ref.cast (ref $float_array) (local.get $v))) (local.set $f1 (array.get $float_array (local.get $b) (i32.const 0))) @@ -1588,45 +1474,53 @@ (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_f64 (local.get $data) (local.get $i) - (local.get $f1)) - (call $ta_set_f64 (local.get $data) - (i32.add (local.get $i) (i32.const 1)) - (local.get $f2)) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $dv_set_f64 (local.get $view) (local.get $i) + (local.get $f1) + (global.get $littleEndian)) + (call $dv_set_f64 (local.get $view) + (i32.add (local.get $i) (i32.const 8)) + (local.get $f2) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 16))) (br $loop)))) (return (ref.i31 (i32.const 0)))) ;; complex32 - (local.set $len (call $ta_length (local.get $data))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $len + (i32.shl (call $ta_length (local.get $data)) (i32.const 2))) (local.set $b (ref.cast (ref $float_array) (local.get $v))) - (local.set $f1 (array.get $float_array (local.get $b) (i32.const 0))) - (local.set $f2 (array.get $float_array (local.get $b) (i32.const 1))) + (local.set $f1' + (f32.demote_f64 + (array.get $float_array (local.get $b) (i32.const 0)))) + (local.set $f2' + (f32.demote_f64 + (array.get $float_array (local.get $b) (i32.const 1)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_f32 (local.get $data) (local.get $i) - (local.get $f1)) - (call $ta_set_f32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)) - (local.get $f2)) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $dv_set_f32 (local.get $view) (local.get $i) + (local.get $f1') + (global.get $littleEndian)) + (call $dv_set_f32 (local.get $view) + (i32.add (local.get $i) (i32.const 4)) + (local.get $f2') + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (return (ref.i31 (i32.const 0)))) ;; int64 - (local.set $len (call $ta_length (local.get $data))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $len + ;; we currently use an Int32Array, so multiply by just 4 + (i32.shl (call $ta_length (local.get $data)) (i32.const 2))) (local.set $l (call $Int64_val (local.get $v))) - (local.set $i1 (i32.wrap_i64 (local.get $l))) - (local.set $i2 - (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $ta_set_i32 (local.get $data) (local.get $i) - (local.get $i1)) - (call $ta_set_i32 (local.get $data) - (i32.add (local.get $i) (i32.const 1)) - (local.get $i2)) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $dv_set_i64 (local.get $view) (local.get $i) + (local.get $l) + (global.get $littleEndian)) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (return (ref.i31 (i32.const 0)))) ;; int32 @@ -1718,6 +1612,7 @@ (struct.new $bigarray (global.get $bigarray_ops) (struct.get $bigarray $ba_data (local.get $b)) + (struct.get $bigarray $ba_view (local.get $b)) (local.get $dim) (local.get $num_dims) (struct.get $bigarray $ba_kind (local.get $b)) @@ -1753,6 +1648,7 @@ (struct.new $bigarray (global.get $bigarray_ops) (struct.get $bigarray $ba_data (local.get $b)) + (struct.get $bigarray $ba_view (local.get $b)) (local.get $new_dim) (local.get $num_dims) (struct.get $bigarray $ba_kind (local.get $b)) @@ -1779,8 +1675,10 @@ (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32) (local $b1 (ref $bigarray)) (local $b2 (ref $bigarray)) (local $i1 i32) (local $i2 i32) (local $i i32) (local $len i32) - (local $f1 f64) (local $f2 f64) + (local $l1 i64) (local $l2 i64) + (local $f1 f64) (local $f2 f64) (local $f1' f32) (local $f2' f32) (local $d1 (ref extern)) (local $d2 (ref extern)) + (local $view1 (ref extern)) (local $view2 (ref extern)) (local.set $b1 (ref.cast (ref $bigarray) (local.get $v1))) (local.set $b2 (ref.cast (ref $bigarray) (local.get $v2))) (if (i32.ne (struct.get $bigarray $ba_layout (local.get $b2)) @@ -1821,7 +1719,9 @@ (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (local.set $d1 (struct.get $bigarray $ba_data (local.get $b1))) + (local.set $view1 (struct.get $bigarray $ba_view (local.get $b1))) (local.set $d2 (struct.get $bigarray $ba_data (local.get $b2))) + (local.set $view2 (struct.get $bigarray $ba_view (local.get $b2))) (local.set $len (call $ta_length (local.get $d1))) (local.set $i (i32.const 0)) (block $float32 @@ -1838,15 +1738,18 @@ $float32 $float64 $uint8 $float16 (struct.get $bigarray $ba_kind (local.get $b1)))) ;; float16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $f1 (call $float16_to_double - (call $ta_get_ui16 (local.get $d1) (local.get $i)))) + (call $dv_get_ui16 (local.get $view1) (local.get $i) + (global.get $littleEndian)))) (local.set $f2 (call $float16_to_double - (call $ta_get_ui16 (local.get $d2) (local.get $i)))) + (call $dv_get_ui16 (local.get $view2) (local.get $i) + (global.get $littleEndian)))) (if (f64.lt (local.get $f1) (local.get $f2)) (then (return (i32.const -1)))) (if (f64.gt (local.get $f1) (local.get $f2)) @@ -1859,77 +1762,81 @@ (then (return (i32.const 1)))) (if (f64.eq (local.get $f2) (local.get $f2)) (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (i32.const 0))) ;; int64 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $i1 - (call $ta_get_i32 (local.get $d1) - (i32.add (local.get $i) (i32.const 1)))) - (local.set $i2 - (call $ta_get_i32 (local.get $d2) - (i32.add (local.get $i) (i32.const 1)))) - (if (i32.lt_s (local.get $i1) (local.get $i2)) - (then (return (i32.const -1)))) - (if (i32.gt_s (local.get $i1) (local.get $i2)) - (then (return (i32.const 1)))) - (local.set $i1 - (call $ta_get_i32 (local.get $d1) (local.get $i))) - (local.set $i2 - (call $ta_get_i32 (local.get $d2) (local.get $i))) - (if (i32.lt_u (local.get $i1) (local.get $i2)) + (local.set $l1 + (call $dv_get_i64 (local.get $view1) + (local.get $i) + (global.get $littleEndian))) + (local.set $l2 + (call $dv_get_i64 (local.get $view2) + (local.get $i) + (global.get $littleEndian))) + (if (i64.lt_s (local.get $l1) (local.get $l2)) (then (return (i32.const -1)))) - (if (i32.gt_u (local.get $i1) (local.get $i2)) + (if (i64.gt_s (local.get $l1) (local.get $l2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (return (i32.const 0))) ;; int32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $ta_get_i32 (local.get $d1) (local.get $i))) + (call $dv_get_i32 (local.get $view1) (local.get $i) + (global.get $littleEndian))) (local.set $i2 - (call $ta_get_i32 (local.get $d2) (local.get $i))) + (call $dv_get_i32 (local.get $view2) (local.get $i) + (global.get $littleEndian))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (return (i32.const 0))) ;; uint16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $ta_get_ui16 (local.get $d1) (local.get $i))) + (call $dv_get_ui16 (local.get $view1) (local.get $i) + (global.get $littleEndian))) (local.set $i2 - (call $ta_get_ui16 (local.get $d2) (local.get $i))) + (call $dv_get_ui16 (local.get $view2) (local.get $i) + (global.get $littleEndian))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (i32.const 0))) ;; int16 + (local.set $len (i32.shl (local.get $len) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $ta_get_i16 (local.get $d1) (local.get $i))) + (call $dv_get_i16 (local.get $view1) (local.get $i) + (global.get $littleEndian))) (local.set $i2 - (call $ta_get_i16 (local.get $d2) (local.get $i))) + (call $dv_get_i16 (local.get $view2) (local.get $i) + (global.get $littleEndian))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (i32.const 0))) ;; uint8 @@ -1937,9 +1844,9 @@ (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $ta_get_ui8 (local.get $d1) (local.get $i))) + (call $dv_get_ui8 (local.get $view1) (local.get $i))) (local.set $i2 - (call $ta_get_ui8 (local.get $d2) (local.get $i))) + (call $dv_get_ui8 (local.get $view2) (local.get $i))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) @@ -1952,9 +1859,9 @@ (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $ta_get_i8 (local.get $d1) (local.get $i))) + (call $dv_get_i8 (local.get $view1) (local.get $i))) (local.set $i2 - (call $ta_get_i8 (local.get $d2) (local.get $i))) + (call $dv_get_i8 (local.get $view2) (local.get $i))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) @@ -1963,13 +1870,16 @@ (br $loop)))) (return (i32.const 0))) ;; float64 + (local.set $len (i32.shl (local.get $len) (i32.const 3))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $f1 - (call $ta_get_f64 (local.get $d1) (local.get $i))) + (call $dv_get_f64 (local.get $view1) (local.get $i) + (global.get $littleEndian))) (local.set $f2 - (call $ta_get_f64 (local.get $d2) (local.get $i))) + (call $dv_get_f64 (local.get $view2) (local.get $i) + (global.get $littleEndian))) (if (f64.lt (local.get $f1) (local.get $f2)) (then (return (i32.const -1)))) (if (f64.gt (local.get $f1) (local.get $f2)) @@ -1982,40 +1892,43 @@ (then (return (i32.const 1)))) (if (f64.eq (local.get $f2) (local.get $f2)) (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (local.set $i (i32.add (local.get $i) (i32.const 8))) (br $loop)))) (return (i32.const 0))) ;; float32 + (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $f1 - (call $ta_get_f32 (local.get $d1) (local.get $i))) - (local.set $f2 - (call $ta_get_f32 (local.get $d2) (local.get $i))) - (if (f64.lt (local.get $f1) (local.get $f2)) + (local.set $f1' + (call $dv_get_f32 (local.get $view1) (local.get $i) + (global.get $littleEndian))) + (local.set $f2' + (call $dv_get_f32 (local.get $view2) (local.get $i) + (global.get $littleEndian))) + (if (f32.lt (local.get $f1') (local.get $f2')) (then (return (i32.const -1)))) - (if (f64.gt (local.get $f1) (local.get $f2)) + (if (f32.gt (local.get $f1') (local.get $f2')) (then (return (i32.const 1)))) - (if (f64.ne (local.get $f1) (local.get $f2)) + (if (f32.ne (local.get $f1') (local.get $f2')) (then (if (i32.eqz (local.get $total)) (then (return (global.get $unordered)))) - (if (f64.eq (local.get $f1) (local.get $f1)) + (if (f32.eq (local.get $f1') (local.get $f1')) (then (return (i32.const 1)))) - (if (f64.eq (local.get $f2) (local.get $f2)) + (if (f32.eq (local.get $f2') (local.get $f2')) (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (return (i32.const 0))) (func (export "caml_ba_uint8_get16") (param $vba (ref eq)) (param $i (ref eq)) (result (ref eq)) (local $ba (ref $bigarray)) - (local $data (ref extern)) + (local $view (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2024,15 +1937,16 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (ref.i31 (call $ta_get16_ui8 (local.get $data) (local.get $p)))) + (ref.i31 + (call $dv_get_ui16 (local.get $view) (local.get $p) (i32.const 1)))) (func (export "caml_ba_uint8_get32") (param $vba (ref eq)) (param $i (ref eq)) (result i32) (local $ba (ref $bigarray)) - (local $data (ref extern)) + (local $view (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2041,15 +1955,15 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (return_call $ta_get32_ui8 (local.get $data) (local.get $p))) + (return_call $dv_get_i32 (local.get $view) (local.get $p) (i32.const 1))) (func (export "caml_ba_uint8_get64") (param $vba (ref eq)) (param $i (ref eq)) (result i64) (local $ba (ref $bigarray)) - (local $data (ref extern)) + (local $view (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2058,24 +1972,19 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (i64.or - (i64.extend_i32_u - (call $ta_get32_ui8 (local.get $data) (local.get $p))) - (i64.shl (i64.extend_i32_u - (call $ta_get32_ui8 (local.get $data) - (i32.add (local.get $p) (i32.const 4)))) - (i64.const 32)))) + (call $dv_get_i64 + (local.get $view) (local.get $p) (i32.const 1))) (func (export "caml_ba_uint8_set16") (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq)) (result (ref eq)) (local $ba (ref $bigarray)) - (local $data (ref extern)) - (local $p i32) (local $d (ref i31)) + (local $view (ref extern)) + (local $p i32) (local $d i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) - (local.set $d (ref.cast (ref i31) (local.get $v))) + (local.set $d (i31.get_s (ref.cast (ref i31) (local.get $v)))) (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)) @@ -2083,17 +1992,18 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $ta_set16_ui8 (local.get $data) (local.get $p) (local.get $d)) + (call $dv_set_i16 + (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) (ref.i31 (i32.const 0))) (func (export "caml_ba_uint8_set32") (param $vba (ref eq)) (param $i (ref eq)) (param $d i32) (result (ref eq)) (local $ba (ref $bigarray)) - (local $data (ref extern)) + (local $view (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2102,17 +2012,18 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $ta_set32_ui8 (local.get $data) (local.get $p) (local.get $d)) + (call $dv_set_i32 + (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) (ref.i31 (i32.const 0))) (func (export "caml_ba_uint8_set64") (param $vba (ref eq)) (param $i (ref eq)) (param $d i64) (result (ref eq)) (local $ba (ref $bigarray)) - (local $data (ref extern)) + (local $view (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) + (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2121,11 +2032,8 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $ta_set32_ui8 (local.get $data) (local.get $p) - (i32.wrap_i64 (local.get $d))) - (call $ta_set32_ui8 (local.get $data) - (i32.add (local.get $p) (i32.const 4)) - (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))) + (call $dv_set_i64 + (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) (ref.i31 (i32.const 0))) (export "caml_bytes_of_uint8_array" (func $caml_string_of_uint8_array)) @@ -2170,6 +2078,9 @@ (func (export "caml_ba_get_data") (param (ref eq)) (result (ref extern)) (struct.get $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0)))) + (func (export "caml_ba_get_view") (param (ref eq)) (result (ref extern)) + (struct.get $bigarray $ba_view (ref.cast (ref $bigarray) (local.get 0)))) + (func (export "caml_ba_set_data") (param (ref eq)) (param (ref extern)) (struct.set $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0)) (local.get 1))) @@ -2184,6 +2095,7 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $data) + (call $dv_make (local.get $data)) (local.get $dim) (local.get $num_dims) (local.get $kind) diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index 1d9afd2ae9..1cf4428dcb 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -31,14 +31,16 @@ (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)))) + (import "bigarray" "caml_ba_get_view" + (func $caml_ba_get_view (param (ref eq)) (result (ref extern)))) (import "bindings" "ta_create" (func $ta_create (param i32) (param anyref) (result anyref))) - (import "bindings" "ta_get_ui8" - (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_get32_ui8" - (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32))) - (import "bindings" "ta_set_ui8" - (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31)))) + (import "bindings" "dv_get_i32" + (func $dv_get_i32 (param externref i32 i32) (result i32))) + (import "bindings" "dv_get_ui8" + (func $dv_get_ui8 (param externref i32) (result i32))) + (import "bindings" "dv_set_i8" + (func $dv_set_i8 (param externref i32 i32))) (import "bindings" "ta_subarray" (func $ta_subarray (param (ref extern)) (param i32) (param i32) (result (ref extern)))) @@ -64,8 +66,10 @@ (func (export "caml_hash_mix_bigstring") (param $h i32) (param $b (ref eq)) (result i32) (local $data (ref extern)) + (local $view (ref extern)) (local $len i32) (local $i i32) (local $w i32) (local.set $data (call $caml_ba_get_data (local.get $b))) + (local.set $view (call $caml_ba_get_view (local.get $b))) (local.set $len (call $ta_length (local.get $data))) (loop $loop (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len)) @@ -73,7 +77,8 @@ (local.set $h (call $caml_hash_mix_int (local.get $h) - (call $ta_get32_ui8 (local.get $data) (local.get $i)))) + (call $dv_get_i32 (local.get $view) (local.get $i) + (i32.const 1)))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (local.set $w (i32.const 0)) @@ -84,17 +89,17 @@ (br_table $0_bytes $1_byte $2_bytes $3_bytes (i32.and (local.get $len) (i32.const 3)))) (local.set $w - (i32.shl (call $ta_get_ui8 (local.get $data) + (i32.shl (call $dv_get_ui8 (local.get $view) (i32.add (local.get $i) (i32.const 2))) (i32.const 16)))) (local.set $w (i32.or (local.get $w) - (i32.shl (call $ta_get_ui8 (local.get $data) + (i32.shl (call $dv_get_ui8 (local.get $view) (i32.add (local.get $i) (i32.const 1))) (i32.const 8))))) (local.set $w (i32.or (local.get $w) - (call $ta_get_ui8 (local.get $data) (local.get $i)))) + (call $dv_get_ui8 (local.get $view) (local.get $i)))) (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (i32.xor (local.get $h) (local.get $len))) @@ -130,21 +135,20 @@ (param $vlen (ref eq)) (result (ref eq)) (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32) (local $c1 i32) (local $c2 i32) - (local $d1 (ref extern)) - (local $d2 (ref extern)) - (local.set $d1 (call $caml_ba_get_data (local.get $s1))) + (local $v1 (ref extern)) (local $v2 (ref extern)) + (local.set $v1 (call $caml_ba_get_view (local.get $s1))) (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1)))) - (local.set $d2 (call $caml_ba_get_data (local.get $s2))) + (local.set $v2 (call $caml_ba_get_view (local.get $s2))) (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2)))) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $c1 - (call $ta_get_ui8 (local.get $d1) + (call $dv_get_ui8 (local.get $v1) (i32.add (local.get $pos1) (local.get $i)))) (local.set $c2 - (call $ta_get_ui8 (local.get $d2) + (call $dv_get_ui8 (local.get $v2) (i32.add (local.get $pos2) (local.get $i)))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br_if $loop (i32.eq (local.get $c1) (local.get $c2))) @@ -159,9 +163,9 @@ (param $vlen (ref eq)) (result (ref eq)) (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32) (local $c1 i32) (local $c2 i32) - (local $d1 (ref extern)) + (local $v1 (ref extern)) (local $s2 (ref $bytes)) - (local.set $d1 (call $caml_ba_get_data (local.get $s1))) + (local.set $v1 (call $caml_ba_get_view (local.get $s1))) (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1)))) (local.set $s2 (ref.cast (ref $bytes) (local.get $vs2))) (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2)))) @@ -170,7 +174,7 @@ (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $c1 - (call $ta_get_ui8 (local.get $d1) + (call $dv_get_ui8 (local.get $v1) (i32.add (local.get $pos1) (local.get $i)))) (local.set $c2 (array.get_u $bytes (local.get $s2) @@ -186,16 +190,16 @@ (param $s (ref eq)) (param $vc (ref eq)) (param $vpos (ref eq)) (param $vlen (ref eq)) (result (ref eq)) (local $pos i32) (local $len i32) (local $c i32) - (local $d (ref extern)) + (local $v (ref extern)) (local.set $c (i31.get_s (ref.cast (ref i31) (local.get $vc)))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) - (local.set $d (call $caml_ba_get_data (local.get $s))) + (local.set $v (call $caml_ba_get_view (local.get $s))) (loop $loop (if (i32.gt_s (local.get $len) (i32.const 0)) (then (if (i32.eq (local.get $c) - (call $ta_get_ui8 (local.get $d) (local.get $pos))) + (call $dv_get_ui8 (local.get $v) (local.get $pos))) (then (return (ref.i31 (local.get $pos))))) (local.set $len (i32.sub (local.get $len) (i32.const 1))) @@ -207,18 +211,18 @@ (param $s (ref eq)) (param $vc (ref eq)) (param $vpos (ref eq)) (param $vlen (ref eq)) (result (ref eq)) (local $pos i32) (local $len i32) (local $c i32) (local $cur i32) - (local $d (ref extern)) + (local $v (ref extern)) (local.set $c (i31.get_s (ref.cast (ref i31) (local.get $vc)))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) - (local.set $d (call $caml_ba_get_data (local.get $s))) + (local.set $v (call $caml_ba_get_view (local.get $s))) (local.set $cur (i32.sub (i32.add (local.get $pos) (local.get $len)) (i32.const 1))) (loop $loop (if (i32.ge_s (local.get $cur) (local.get $pos)) (then (if (i32.eq (local.get $c) - (call $ta_get_ui8 (local.get $d) (local.get $cur))) + (call $dv_get_ui8 (local.get $v) (local.get $cur))) (then (return (ref.i31 (local.get $cur))))) (local.set $cur (i32.sub (local.get $cur) (i32.const 1))) diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat index deff2a6d40..dd6ec0ea5d 100644 --- a/runtime/wasm/io.wat +++ b/runtime/wasm/io.wat @@ -53,10 +53,6 @@ (import "bindings" "ta_new" (func $ta_new (param i32) (result (ref extern)))) (import "bindings" "ta_copy" (func $ta_copy (param (ref extern)) (param i32) (param i32) (param i32))) - (import "bindings" "ta_set_ui8" - (func $ta_set_ui8 (param (ref extern)) (param i32) (param i32))) ;; ZZZ ?? - (import "bindings" "ta_get_ui8" - (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32))) (import "bindings" "ta_blit_from_bytes" (func $ta_blit_from_bytes (param (ref $bytes)) (param i32) (param (ref extern)) (param i32) @@ -70,6 +66,12 @@ (param (ref extern)) (param i32) (param i32) (result (ref extern)))) (import "bindings" "ta_set" (func $ta_set (param (ref extern)) (param (ref extern)) (param i32))) + (import "bindings" "dv_make" + (func $dv_make (param (ref extern)) (result (ref extern)))) + (import "bindings" "dv_get_ui8" + (func $dv_get_ui8 (param externref i32) (result i32))) + (import "bindings" "dv_set_i8" + (func $dv_set_i8 (param externref i32 i32))) (import "custom" "custom_compare_id" (func $custom_compare_id (param (ref eq)) (param (ref eq)) (param i32) (result i32))) @@ -145,6 +147,7 @@ (field i64) (field $fd (mut i32)) (field $buffer (mut (ref extern))) + (field $buffer_view (mut (ref extern))) (field $curr (mut i32)) (field $max (mut i32)) (field $size (mut i32)) @@ -270,11 +273,14 @@ (func (export "caml_ml_open_descriptor_in") (param $fd (ref eq)) (result (ref eq)) + (local $buffer (ref extern)) + (local.set $buffer (call $ta_new (global.get $IO_BUFFER_SIZE))) (struct.new $channel (global.get $channel_ops) (call $custom_next_id) (i31.get_u (ref.cast (ref i31) (local.get $fd))) - (call $ta_new (global.get $IO_BUFFER_SIZE)) + (local.get $buffer) + (call $dv_make (local.get $buffer)) (i32.const 0) (i32.const 0) (global.get $IO_BUFFER_SIZE) @@ -286,12 +292,15 @@ (func (export "caml_ml_open_descriptor_out") (param $fd (ref eq)) (result (ref eq)) (local $res (ref eq)) + (local $buffer (ref extern)) + (local.set $buffer (call $ta_new (global.get $IO_BUFFER_SIZE))) (local.set $res (struct.new $channel (global.get $channel_ops) (call $custom_next_id) (i31.get_u (ref.cast (ref i31) (local.get $fd))) - (call $ta_new (global.get $IO_BUFFER_SIZE)) + (local.get $buffer) + (call $dv_make (local.get $buffer)) (i32.const 0) (i32.const -1) (global.get $IO_BUFFER_SIZE) @@ -382,8 +391,8 @@ (func $caml_refill (param $ch (ref $channel)) (result i32) (local $n i32) - (local $buf (ref extern)) - (local.set $buf (struct.get $channel $buffer (local.get $ch))) + (local $view (ref extern)) + (local.set $view (struct.get $channel $buffer_view (local.get $ch))) (local.set $n (call $caml_do_read (local.get $ch) (i32.const 0) (struct.get $channel $size (local.get $ch)))) @@ -391,7 +400,7 @@ (then (call $caml_raise_end_of_file))) (struct.set $channel $max (local.get $ch) (local.get $n)) (struct.set $channel $curr (local.get $ch) (i32.const 1)) - (return (call $ta_get_ui8 (local.get $buf) (i32.const 0)))) + (return (call $dv_get_ui8 (local.get $view) (i32.const 0)))) (func $caml_getblock (export "caml_getblock") (param $vch (ref eq)) (param $s (ref $bytes)) @@ -535,8 +544,8 @@ (then (return_call $caml_refill (local.get $ch)))) (struct.set $channel $curr (local.get $ch) (i32.add (local.get $curr) (i32.const 1))) - (return_call $ta_get_ui8 - (struct.get $channel $buffer (local.get $ch)) + (return_call $dv_get_ui8 + (struct.get $channel $buffer_view (local.get $ch)) (local.get $curr))) (func (export "caml_ml_input_char") @@ -729,7 +738,8 @@ (i32.add (struct.get $channel $max (local.get $ch)) (local.get $n))))) (if (i32.eq (i32.const 10) ;; '\n' - (call $ta_get_ui8 (struct.get $channel $buffer (local.get $ch)) + (call $dv_get_ui8 + (struct.get $channel $buffer_view (local.get $ch)) (local.get $p))) (then (return @@ -903,7 +913,7 @@ (then (drop (call $caml_flush_partial (local.get $ch))))) (local.set $curr (struct.get $channel $curr (local.get $ch))) - (call $ta_set_ui8 (struct.get $channel $buffer (local.get $ch)) + (call $dv_set_i8 (struct.get $channel $buffer_view (local.get $ch)) (local.get $curr) (local.get $c)) (struct.set $channel $curr (local.get $ch) (i32.add (local.get $curr) (i32.const 1)))) diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat index 4918eaa0bf..4be35de7ed 100644 --- a/runtime/wasm/prng.wat +++ b/runtime/wasm/prng.wat @@ -16,50 +16,31 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (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)))) + (import "bindings" "dv_get_i64" + (func $dv_get_i64 (param externref i32 i32) (result i64))) + (import "bindings" "dv_set_i64" + (func $dv_set_i64 (param externref i32 i64 i32))) + (import "bigarray" "caml_ba_get_view" + (func $caml_ba_get_view (param (ref eq)) (result (ref extern)))) + (import "bindings" "littleEndian" (global $littleEndian i32)) (func (export "caml_lxm_next") (param $v (ref eq)) (result i64) - (local $data (ref extern)) + (local $view (ref extern)) (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64) (local $z i64) - (local.set $data (call $caml_ba_get_data (local.get $v))) + (local.set $view (call $caml_ba_get_view (local.get $v))) (local.set $a - (i64.or - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 0))) - (i64.shl - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 1))) - (i64.const 32)))) + (call $dv_get_i64 (local.get $view) (i32.const 0) + (global.get $littleEndian))) (local.set $s - (i64.or - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 2))) - (i64.shl - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 3))) - (i64.const 32)))) + (call $dv_get_i64 (local.get $view) (i32.const 8) + (global.get $littleEndian))) (local.set $q0 - (i64.or - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 4))) - (i64.shl - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 5))) - (i64.const 32)))) + (call $dv_get_i64 (local.get $view) (i32.const 16) + (global.get $littleEndian))) (local.set $q1 - (i64.or - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 6))) - (i64.shl - (i64.extend_i32_u - (call $ta_get_i32 (local.get $data) (i32.const 7))) - (i64.const 32)))) + (call $dv_get_i64 (local.get $view) (i32.const 24) + (global.get $littleEndian))) (local.set $z (i64.add (local.get $s) (local.get $q0))) (local.set $z (i64.mul (i64.xor (local.get $z) @@ -74,22 +55,16 @@ (local.set $s (i64.add (i64.mul (local.get $s) (i64.const 0xd1342543de82ef95)) (local.get $a))) - (call $ta_set_i32 (local.get $data) (i32.const 2) - (i32.wrap_i64 (local.get $s))) - (call $ta_set_i32 (local.get $data) (i32.const 3) - (i32.wrap_i64 (i64.shr_u (local.get $s) (i64.const 32)))) + (call $dv_set_i64 (local.get $view) (i32.const 8) (local.get $s) + (global.get $littleEndian)) (local.set $q1 (i64.xor (local.get $q1) (local.get $q0))) (local.set $q0 (i64.rotl (local.get $q0) (i64.const 24))) (local.set $q0 (i64.xor (i64.xor (local.get $q0) (local.get $q1)) (i64.shl (local.get $q1) (i64.const 16)))) (local.set $q1 (i64.rotl (local.get $q1) (i64.const 37))) - (call $ta_set_i32 (local.get $data) (i32.const 4) - (i32.wrap_i64 (local.get $q0))) - (call $ta_set_i32 (local.get $data) (i32.const 5) - (i32.wrap_i64 (i64.shr_u (local.get $q0) (i64.const 32)))) - (call $ta_set_i32 (local.get $data) (i32.const 6) - (i32.wrap_i64 (local.get $q1))) - (call $ta_set_i32 (local.get $data) (i32.const 7) - (i32.wrap_i64 (i64.shr_u (local.get $q1) (i64.const 32)))) + (call $dv_set_i64 (local.get $view) (i32.const 16) (local.get $q0) + (global.get $littleEndian)) + (call $dv_set_i64 (local.get $view) (i32.const 24) (local.get $q1) + (global.get $littleEndian)) (return (local.get $z))) ) diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js index bc946b5c7a..01e9b70eff 100644 --- a/runtime/wasm/runtime.js +++ b/runtime/wasm/runtime.js @@ -192,6 +192,9 @@ const on_windows = isNode && globalThis.process.platform === "win32"; + const call = Function.prototype.call; + const DV = DataView.prototype; + const bindings = { jstag: WebAssembly.JSTag || @@ -244,33 +247,7 @@ : a, ta_kind: (a) => typed_arrays.findIndex((c) => a instanceof c), ta_length: (a) => a.length, - ta_get_f64: (a, i) => a[i], - ta_get_f32: (a, i) => a[i], ta_get_i32: (a, i) => a[i], - ta_get_i16: (a, i) => a[i], - ta_get_ui16: (a, i) => a[i], - ta_get_i8: (a, i) => a[i], - ta_get_ui8: (a, i) => a[i], - ta_get16_ui8: (a, i) => a[i] | (a[i + 1] << 8), - ta_get32_ui8: (a, i) => - a[i] | (a[i + 1] << 8) | (a[i + 2] << 16) | (a[i + 3] << 24), - ta_set_f64: (a, i, v) => (a[i] = v), - ta_set_f32: (a, i, v) => (a[i] = v), - ta_set_i32: (a, i, v) => (a[i] = v), - ta_set_i16: (a, i, v) => (a[i] = v), - ta_set_ui16: (a, i, v) => (a[i] = v), - ta_set_i8: (a, i, v) => (a[i] = v), - ta_set_ui8: (a, i, v) => (a[i] = v), - ta_set16_ui8: (a, i, v) => { - a[i] = v; - a[i + 1] = v >> 8; - }, - ta_set32_ui8: (a, i, v) => { - a[i] = v; - a[i + 1] = v >> 8; - a[i + 2] = v >> 16; - a[i + 3] = v >> 24; - }, ta_fill: (a, v) => a.fill(v), ta_blit: (s, d) => d.set(s), ta_subarray: (a, i, j) => a.subarray(i, j), @@ -285,6 +262,22 @@ ta_blit_to_bytes: (a, p1, s, p2, l) => { for (let i = 0; i < l; i++) bytes_set(s, p2 + i, a[p1 + i]); }, + dv_make:(a) => new DataView(a.buffer, a.byteOffset, a.byteLength), + dv_get_f64: call.bind(DV.getFloat64), + dv_get_f32: call.bind(DV.getFloat32), + dv_get_i64: call.bind(DV.getBigInt64), + dv_get_i32: call.bind(DV.getInt32), + dv_get_i16: call.bind(DV.getInt16), + dv_get_ui16: call.bind(DV.getUint16), + dv_get_i8: call.bind(DV.getInt8), + dv_get_ui8: call.bind(DV.getUint8), + dv_set_f64: call.bind(DV.setFloat64), + dv_set_f32: call.bind(DV.setFloat32), + dv_set_i64: call.bind(DV.setBigInt64), + dv_set_i32: call.bind(DV.setInt32), + dv_set_i16: call.bind(DV.setInt16), + dv_set_i8: call.bind(DV.setInt8), + littleEndian:new Uint8Array(new Uint32Array([1]).buffer)[0], wrap_callback: (f) => function (...args) { if (args.length === 0) {