Skip to content

Commit 226d960

Browse files
vouillonvouillon
committed
WIP
1 parent 363c4b4 commit 226d960

File tree

3 files changed

+67
-69
lines changed

3 files changed

+67
-69
lines changed

‎compiler/lib-wasm/generate.ml‎

Lines changed: 42 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -115,10 +115,12 @@ module Generate (Target : Target_sig.S) = struct
115115
; "caml_bytes_set32", (`Mutator, [ Value; Value; Int32 ], Value)
116116
; "caml_bytes_set64", (`Mutator, [ Value; Value; Int64 ], Value)
117117
; "caml_lxm_next", (`Pure, [ Value ], Int64)
118-
; "caml_ba_uint8_get32", (`Mutator, [ Value; Value ], Int32)
119-
; "caml_ba_uint8_get64", (`Mutator, [ Value; Value ], Int64)
120-
; "caml_ba_uint8_set32", (`Mutator, [ Value; Value; Int32 ], Value)
121-
; "caml_ba_uint8_set64", (`Mutator, [ Value; Value; Int64 ], Value)
118+
; "caml_ba_uint8_get16", (`Mutator, [ Value; Int ], Int)
119+
; "caml_ba_uint8_get32", (`Mutator, [ Value; Int ], Int32)
120+
; "caml_ba_uint8_get64", (`Mutator, [ Value; Int ], Int64)
121+
; "caml_ba_uint8_set16", (`Mutator, [ Value; Int; Int ], Value)
122+
; "caml_ba_uint8_set32", (`Mutator, [ Value; Int; Int32 ], Value)
123+
; "caml_ba_uint8_set64", (`Mutator, [ Value; Int; Int64 ], Value)
122124
; "caml_nextafter_float", (`Pure, [ Float; Float ], Float)
123125
; "caml_classify_float", (`Pure, [ Float ], Value)
124126
; "caml_ldexp_float", (`Pure, [ Float; Value ], Float)
@@ -1033,36 +1035,45 @@ module Generate (Target : Target_sig.S) = struct
10331035
match p with
10341036
| Extern name when String.Hashtbl.mem internal_primitives name ->
10351037
snd (String.Hashtbl.find internal_primitives name) ctx context l
1038+
| Extern name when String.Hashtbl.mem specialized_primitives name ->
1039+
let ((_, arg_typ, res_typ) as typ) =
1040+
String.Hashtbl.find specialized_primitives name
1041+
in
1042+
let* f = register_import ~name (Fun (specialized_primitive_type typ)) in
1043+
let rec loop acc arg_typ l =
1044+
match arg_typ, l with
1045+
| [], [] -> box_value res_typ (return (W.Call (f, List.rev acc)))
1046+
| repr :: rem, x :: r ->
1047+
let* x =
1048+
unbox_value
1049+
repr
1050+
(transl_prim_arg
1051+
ctx
1052+
?typ:
1053+
(match repr with
1054+
| Int -> Some (Int Normalized)
1055+
| _ -> None)
1056+
x)
1057+
in
1058+
loop (x :: acc) rem r
1059+
| [], _ :: _ | _ :: _, [] -> assert false
1060+
in
1061+
loop [] arg_typ l
10361062
| _ -> (
10371063
let l = List.map ~f:(fun x -> transl_prim_arg ctx x) l in
10381064
match p, l with
1039-
| Extern name, l -> (
1040-
try
1041-
let ((_, arg_typ, res_typ) as typ) =
1042-
String.Hashtbl.find specialized_primitives name
1043-
in
1044-
let* f = register_import ~name (Fun (specialized_primitive_type typ)) in
1045-
let rec loop acc arg_typ l =
1046-
match arg_typ, l with
1047-
| [], [] -> box_value res_typ (return (W.Call (f, List.rev acc)))
1048-
| repr :: rem, x :: r ->
1049-
let* x = unbox_value repr x in
1050-
loop (x :: acc) rem r
1051-
| [], _ :: _ | _ :: _, [] -> assert false
1052-
in
1053-
loop [] arg_typ l
1054-
with Not_found ->
1055-
let* f =
1056-
register_import ~name (Fun (Type.primitive_type (List.length l)))
1057-
in
1058-
let rec loop acc l =
1059-
match l with
1060-
| [] -> return (W.Call (f, List.rev acc))
1061-
| x :: r ->
1062-
let* x = x in
1063-
loop (x :: acc) r
1064-
in
1065-
loop [] l)
1065+
| Extern name, l ->
1066+
let* f =
1067+
register_import ~name (Fun (Type.primitive_type (List.length l)))
1068+
in
1069+
let rec loop acc l =
1070+
match l with
1071+
| [] -> return (W.Call (f, List.rev acc))
1072+
| x :: r ->
1073+
let* x = x in
1074+
loop (x :: acc) r
1075+
in
1076+
loop [] l
10661077
| IsInt, [ x ] -> Value.is_int x
10671078
| Vectlength, [ x ] -> Memory.gen_array_length x
10681079
| (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->

‎compiler/lib-wasm/typing.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -314,6 +314,7 @@ let prim_type ~approx prim args =
314314
| "caml_bytes_get32" -> Number Int32
315315
| "caml_bytes_get64" -> Number Int64
316316
| "caml_lxm_next" -> Number Int64
317+
| "caml_ba_uint8_get16" -> Int Normalized
317318
| "caml_ba_uint8_get32" -> Number Int32
318319
| "caml_ba_uint8_get64" -> Number Int64
319320
| "caml_nextafter_float" -> Number Float

‎runtime/wasm/bigarray.wat‎

Lines changed: 24 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1923,117 +1923,103 @@
19231923
(return (i32.const 0)))
19241924

19251925
(func (export "caml_ba_uint8_get16")
1926-
(param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
1926+
(param $vba (ref eq)) (param $i i32) (result i32)
19271927
(local $ba (ref $bigarray))
19281928
(local $view (ref extern))
1929-
(local $p i32)
19301929
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19311930
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1932-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1933-
(if (i32.lt_s (local.get $p) (i32.const 0))
1931+
(if (i32.lt_s (local.get $i) (i32.const 0))
19341932
(then (call $caml_bound_error)))
1935-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
1933+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 1))
19361934
(array.get $int_array
19371935
(struct.get $bigarray $ba_dim (local.get $ba))
19381936
(i32.const 0)))
19391937
(then (call $caml_bound_error)))
1940-
(ref.i31
1941-
(call $dv_get_ui16 (local.get $view) (local.get $p) (i32.const 1))))
1938+
(call $dv_get_ui16 (local.get $view) (local.get $i) (i32.const 1)))
19421939

19431940
(func (export "caml_ba_uint8_get32")
1944-
(param $vba (ref eq)) (param $i (ref eq)) (result i32)
1941+
(param $vba (ref eq)) (param $i i32) (result i32)
19451942
(local $ba (ref $bigarray))
19461943
(local $view (ref extern))
1947-
(local $p i32)
19481944
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19491945
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1950-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1951-
(if (i32.lt_s (local.get $p) (i32.const 0))
1946+
(if (i32.lt_s (local.get $i) (i32.const 0))
19521947
(then (call $caml_bound_error)))
1953-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
1948+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 3))
19541949
(array.get $int_array
19551950
(struct.get $bigarray $ba_dim (local.get $ba))
19561951
(i32.const 0)))
19571952
(then (call $caml_bound_error)))
1958-
(return_call $dv_get_i32 (local.get $view) (local.get $p) (i32.const 1)))
1953+
(return_call $dv_get_i32 (local.get $view) (local.get $i) (i32.const 1)))
19591954

19601955
(func (export "caml_ba_uint8_get64")
1961-
(param $vba (ref eq)) (param $i (ref eq)) (result i64)
1956+
(param $vba (ref eq)) (param $i i32) (result i64)
19621957
(local $ba (ref $bigarray))
19631958
(local $view (ref extern))
1964-
(local $p i32)
19651959
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19661960
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1967-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1968-
(if (i32.lt_s (local.get $p) (i32.const 0))
1961+
(if (i32.lt_s (local.get $i) (i32.const 0))
19691962
(then (call $caml_bound_error)))
1970-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
1963+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 7))
19711964
(array.get $int_array
19721965
(struct.get $bigarray $ba_dim (local.get $ba))
19731966
(i32.const 0)))
19741967
(then (call $caml_bound_error)))
19751968
(call $dv_get_i64
1976-
(local.get $view) (local.get $p) (i32.const 1)))
1969+
(local.get $view) (local.get $i) (i32.const 1)))
19771970

19781971
(func (export "caml_ba_uint8_set16")
1979-
(param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
1972+
(param $vba (ref eq)) (param $i i32) (param $d i32)
19801973
(result (ref eq))
19811974
(local $ba (ref $bigarray))
19821975
(local $view (ref extern))
1983-
(local $p i32) (local $d i32)
19841976
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19851977
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1986-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1987-
(local.set $d (i31.get_s (ref.cast (ref i31) (local.get $v))))
1988-
(if (i32.lt_s (local.get $p) (i32.const 0))
1978+
(if (i32.lt_s (local.get $i) (i32.const 0))
19891979
(then (call $caml_bound_error)))
1990-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
1980+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 1))
19911981
(array.get $int_array
19921982
(struct.get $bigarray $ba_dim (local.get $ba))
19931983
(i32.const 0)))
19941984
(then (call $caml_bound_error)))
19951985
(call $dv_set_i16
1996-
(local.get $view) (local.get $p) (local.get $d) (i32.const 1))
1986+
(local.get $view) (local.get $i) (local.get $d) (i32.const 1))
19971987
(ref.i31 (i32.const 0)))
19981988

19991989
(func (export "caml_ba_uint8_set32")
2000-
(param $vba (ref eq)) (param $i (ref eq)) (param $d i32)
1990+
(param $vba (ref eq)) (param $i i32) (param $d i32)
20011991
(result (ref eq))
20021992
(local $ba (ref $bigarray))
20031993
(local $view (ref extern))
2004-
(local $p i32)
20051994
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
20061995
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
2007-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
2008-
(if (i32.lt_s (local.get $p) (i32.const 0))
1996+
(if (i32.lt_s (local.get $i) (i32.const 0))
20091997
(then (call $caml_bound_error)))
2010-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
1998+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 3))
20111999
(array.get $int_array
20122000
(struct.get $bigarray $ba_dim (local.get $ba))
20132001
(i32.const 0)))
20142002
(then (call $caml_bound_error)))
20152003
(call $dv_set_i32
2016-
(local.get $view) (local.get $p) (local.get $d) (i32.const 1))
2004+
(local.get $view) (local.get $i) (local.get $d) (i32.const 1))
20172005
(ref.i31 (i32.const 0)))
20182006

20192007
(func (export "caml_ba_uint8_set64")
2020-
(param $vba (ref eq)) (param $i (ref eq)) (param $d i64)
2008+
(param $vba (ref eq)) (param $i i32) (param $d i64)
20212009
(result (ref eq))
20222010
(local $ba (ref $bigarray))
20232011
(local $view (ref extern))
2024-
(local $p i32)
20252012
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
20262013
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
2027-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
2028-
(if (i32.lt_s (local.get $p) (i32.const 0))
2014+
(if (i32.lt_s (local.get $i) (i32.const 0))
20292015
(then (call $caml_bound_error)))
2030-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
2016+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 7))
20312017
(array.get $int_array
20322018
(struct.get $bigarray $ba_dim (local.get $ba))
20332019
(i32.const 0)))
20342020
(then (call $caml_bound_error)))
20352021
(call $dv_set_i64
2036-
(local.get $view) (local.get $p) (local.get $d) (i32.const 1))
2022+
(local.get $view) (local.get $i) (local.get $d) (i32.const 1))
20372023
(ref.i31 (i32.const 0)))
20382024

20392025
(export "caml_bytes_of_uint8_array" (func $caml_string_of_uint8_array))

0 commit comments

Comments
 (0)