Skip to content

Unboxed primitives for bigstring access #2243

New issue

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

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

Already on GitHub? Sign in to your account

Merged
merged 6 commits into from
Feb 22, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 12 additions & 12 deletions middle_end/flambda2/from_lambda/lambda_to_flambda.ml
Original file line number Diff line number Diff line change
Expand Up @@ -580,13 +580,13 @@ let primitive_can_raise (prim : Lambda.primitive) =
| Pbytes_set_32 false
| Pbytes_set_64 false
| Pbytes_set_128 { unsafe = false; _ }
| Pbigstring_load_16 false
| Pbigstring_load_32 (false, _)
| Pbigstring_load_64 (false, _)
| Pbigstring_load_16 { unsafe = false }
| Pbigstring_load_32 { unsafe = false; mode = _; boxed = _ }
| Pbigstring_load_64 { unsafe = false; mode = _; boxed = _ }
| Pbigstring_load_128 { unsafe = false; _ }
| Pbigstring_set_16 false
| Pbigstring_set_32 false
| Pbigstring_set_64 false
| Pbigstring_set_16 { unsafe = false }
| Pbigstring_set_32 { unsafe = false; boxed = _ }
| Pbigstring_set_64 { unsafe = false; boxed = _ }
| Pbigstring_set_128 { unsafe = false; _ }
| Pdivbint { is_safe = Safe; _ }
| Pmodbint { is_safe = Safe; _ }
Expand Down Expand Up @@ -645,13 +645,13 @@ let primitive_can_raise (prim : Lambda.primitive) =
| Pbytes_set_32 true
| Pbytes_set_64 true
| Pbytes_set_128 { unsafe = true; _ }
| Pbigstring_load_16 true
| Pbigstring_load_32 (true, _)
| Pbigstring_load_64 (true, _)
| Pbigstring_load_16 { unsafe = true }
| Pbigstring_load_32 { unsafe = true; mode = _; boxed = _ }
| Pbigstring_load_64 { unsafe = true; mode = _; boxed = _ }
| Pbigstring_load_128 { unsafe = true; _ }
| Pbigstring_set_16 true
| Pbigstring_set_32 true
| Pbigstring_set_64 true
| Pbigstring_set_16 { unsafe = true }
| Pbigstring_set_32 { unsafe = true; boxed = _ }
| Pbigstring_set_64 { unsafe = true; boxed = _ }
| Pbigstring_set_128 { unsafe = true; _ }
| Pctconst _ | Pbswap16 | Pbbswap _ | Pint_as_pointer _ | Popaque _
| Pprobe_is_enabled _ | Pobj_dup | Pobj_magic _ | Pbox_float _ | Punbox_float
Expand Down
223 changes: 120 additions & 103 deletions middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

Large diffs are not rendered by default.

48 changes: 35 additions & 13 deletions ocaml/lambda/lambda.ml
Original file line number Diff line number Diff line change
Expand Up @@ -238,14 +238,15 @@ type primitive =
| Pbytes_set_128 of { unsafe : bool }
(* load/set 16,32,64,128 bits from a
(char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
| Pbigstring_load_16 of bool
| Pbigstring_load_32 of bool * alloc_mode
| Pbigstring_load_64 of bool * alloc_mode
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode }
| Pbigstring_set_16 of bool
| Pbigstring_set_32 of bool
| Pbigstring_set_64 of bool
| Pbigstring_set_128 of { aligned : bool; unsafe : bool }
| Pbigstring_load_16 of { unsafe : bool }
| Pbigstring_load_32 of { unsafe : bool; mode: alloc_mode; boxed : bool }
| Pbigstring_load_64 of { unsafe : bool; mode: alloc_mode; boxed : bool }
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode;
boxed : bool }
| Pbigstring_set_16 of { unsafe : bool }
| Pbigstring_set_32 of { unsafe : bool; boxed : bool }
| Pbigstring_set_64 of { unsafe : bool; boxed : bool }
| Pbigstring_set_128 of { aligned : bool; unsafe : bool; boxed : bool }
(* Compile time constants *)
| Pctconst of compile_time_constant
(* byte swap *)
Expand Down Expand Up @@ -745,8 +746,18 @@ let layout_unboxed_nativeint = Punboxed_int Pnativeint
let layout_unboxed_int32 = Punboxed_int Pint32
let layout_unboxed_int64 = Punboxed_int Pint64
let layout_string = Pvalue Pgenval
let layout_unboxed_int ubi = Punboxed_int ubi
let layout_boxedint bi = Pvalue (Pboxedintval bi)

let layout_unboxed_vector (v : Primitive.boxed_vector) =
match v with
| Pvec128 Int8x16 -> Punboxed_vector (Pvec128 Int8x16)
| Pvec128 Int16x8 -> Punboxed_vector (Pvec128 Int16x8)
| Pvec128 Int32x4 -> Punboxed_vector (Pvec128 Int32x4)
| Pvec128 Int64x2 -> Punboxed_vector (Pvec128 Int64x2)
| Pvec128 Float32x4 -> Punboxed_vector (Pvec128 Float32x4)
| Pvec128 Float64x2 -> Punboxed_vector (Pvec128 Float64x2)

let layout_boxed_vector : Primitive.boxed_vector -> layout = function
| Pvec128 Int8x16 -> Pvalue (Pboxedvectorval (Pvec128 Int8x16))
| Pvec128 Int16x8 -> Pvalue (Pboxedvectorval (Pvec128 Int16x8))
Expand Down Expand Up @@ -1557,8 +1568,12 @@ let primitive_may_allocate : primitive -> alloc_mode option = function
| Pget_header m -> Some m
| Pbytes_set_16 _ | Pbytes_set_32 _ | Pbytes_set_64 _ | Pbytes_set_128 _ -> None
| Pbigstring_load_16 _ -> None
| Pbigstring_load_32 (_,m) | Pbigstring_load_64 (_,m)
| Pbigstring_load_128 { mode = m; _ } -> Some m
| Pbigstring_load_32 { mode = m; boxed = true; _ }
| Pbigstring_load_64 { mode = m; boxed = true; _ }
| Pbigstring_load_128 { mode = m; boxed = true; _ } -> Some m
| Pbigstring_load_32 { boxed = false; _ }
| Pbigstring_load_64 { boxed = false; _ }
| Pbigstring_load_128 { boxed = false; _ } -> None
| Pbigstring_set_16 _ | Pbigstring_set_32 _
| Pbigstring_set_64 _ | Pbigstring_set_128 _ -> None
| Pctconst _ -> None
Expand Down Expand Up @@ -1669,12 +1684,19 @@ let primitive_result_layout (p : primitive) =
| Pbbswap (bi, _) | Pbox_int (bi, _) ->
layout_boxedint bi
| Punbox_int bi -> Punboxed_int bi
| Pstring_load_32 _ | Pbytes_load_32 _ | Pbigstring_load_32 _ ->
| Pstring_load_32 _ | Pbytes_load_32 _
| Pbigstring_load_32 { boxed = true; _ } ->
layout_boxedint Pint32
| Pstring_load_64 _ | Pbytes_load_64 _ | Pbigstring_load_64 _ ->
| Pstring_load_64 _ | Pbytes_load_64 _
| Pbigstring_load_64 { boxed = true; _ } ->
layout_boxedint Pint64
| Pstring_load_128 _ | Pbytes_load_128 _ | Pbigstring_load_128 _ ->
| Pstring_load_128 _ | Pbytes_load_128 _
| Pbigstring_load_128 { boxed = true; _ } ->
layout_boxed_vector (Pvec128 Int8x16)
| Pbigstring_load_32 { boxed = false; _ } -> layout_unboxed_int Pint32
| Pbigstring_load_64 { boxed = false; _ } -> layout_unboxed_int Pint64
| Pbigstring_load_128 { boxed = false; _ } ->
layout_unboxed_vector (Pvec128 Int8x16)
| Pbigarrayref (_, _, kind, _) ->
begin match kind with
| Pbigarray_unknown -> layout_any_value
Expand Down
17 changes: 9 additions & 8 deletions ocaml/lambda/lambda.mli
Original file line number Diff line number Diff line change
Expand Up @@ -200,14 +200,15 @@ type primitive =
| Pbytes_set_128 of { unsafe : bool }
(* load/set 16,32,64,128 bits from a
(char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
| Pbigstring_load_16 of bool
| Pbigstring_load_32 of bool * alloc_mode
| Pbigstring_load_64 of bool * alloc_mode
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode }
| Pbigstring_set_16 of bool
| Pbigstring_set_32 of bool
| Pbigstring_set_64 of bool
| Pbigstring_set_128 of { aligned : bool; unsafe : bool }
| Pbigstring_load_16 of { unsafe : bool }
| Pbigstring_load_32 of { unsafe : bool; mode: alloc_mode; boxed : bool }
| Pbigstring_load_64 of { unsafe : bool; mode: alloc_mode; boxed : bool }
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode;
boxed : bool }
| Pbigstring_set_16 of { unsafe : bool }
| Pbigstring_set_32 of { unsafe : bool; boxed : bool }
| Pbigstring_set_64 of { unsafe : bool; boxed : bool }
| Pbigstring_set_128 of { aligned : bool; unsafe : bool; boxed : bool }
(* Compile time constants *)
| Pctconst of compile_time_constant
(* byte swap *)
Expand Down
12 changes: 6 additions & 6 deletions ocaml/lambda/printlambda.ml
Original file line number Diff line number Diff line change
Expand Up @@ -550,13 +550,13 @@ let primitive ppf = function
fprintf ppf "bytes.unsafe_unaligned_set128"
| Pbytes_set_128 {unsafe = false} ->
fprintf ppf "bytes.unaligned_set128"
| Pbigstring_load_16(unsafe) ->
| Pbigstring_load_16 { unsafe } ->
if unsafe then fprintf ppf "bigarray.array1.unsafe_get16"
else fprintf ppf "bigarray.array1.get16"
| Pbigstring_load_32(unsafe,m) ->
| Pbigstring_load_32 { unsafe; mode = m } ->
if unsafe then fprintf ppf "bigarray.array1.unsafe_get32%s" (alloc_kind m)
else fprintf ppf "bigarray.array1.get32%s" (alloc_kind m)
| Pbigstring_load_64(unsafe,m) ->
| Pbigstring_load_64 { unsafe; mode = m } ->
if unsafe then fprintf ppf "bigarray.array1.unsafe_get64%s" (alloc_kind m)
else fprintf ppf "bigarray.array1.get64%s" (alloc_kind m)
| Pbigstring_load_128 {unsafe = true; aligned = false; mode} ->
Expand All @@ -567,13 +567,13 @@ let primitive ppf = function
fprintf ppf "bigarray.array1.unsafe_aligned_get128%s" (alloc_kind mode)
| Pbigstring_load_128 {unsafe = false; aligned = true; mode} ->
fprintf ppf "bigarray.array1.aligned_get128%s" (alloc_kind mode)
| Pbigstring_set_16(unsafe) ->
| Pbigstring_set_16 { unsafe } ->
if unsafe then fprintf ppf "bigarray.array1.unsafe_set16"
else fprintf ppf "bigarray.array1.set16"
| Pbigstring_set_32(unsafe) ->
| Pbigstring_set_32 { unsafe } ->
if unsafe then fprintf ppf "bigarray.array1.unsafe_set32"
else fprintf ppf "bigarray.array1.set32"
| Pbigstring_set_64(unsafe) ->
| Pbigstring_set_64 { unsafe } ->
if unsafe then fprintf ppf "bigarray.array1.unsafe_set64"
else fprintf ppf "bigarray.array1.set64"
| Pbigstring_set_128 {unsafe = true; aligned = false} ->
Expand Down
103 changes: 83 additions & 20 deletions ocaml/lambda/translprim.ml
Original file line number Diff line number Diff line change
Expand Up @@ -399,34 +399,97 @@ let lookup_primitive loc poly pos p =
Primitive ((Pbytes_set_128 {unsafe = false}), 3)
| "%caml_bytes_setu128u" ->
Primitive ((Pbytes_set_128 {unsafe = true}), 3)
| "%caml_bigstring_get16" -> Primitive ((Pbigstring_load_16(false)), 2)
| "%caml_bigstring_get16u" -> Primitive ((Pbigstring_load_16(true)), 2)
| "%caml_bigstring_get32" -> Primitive ((Pbigstring_load_32(false, mode)), 2)
| "%caml_bigstring_get32u" -> Primitive ((Pbigstring_load_32(true, mode)), 2)
| "%caml_bigstring_get64" -> Primitive ((Pbigstring_load_64(false, mode)), 2)
| "%caml_bigstring_get64u" -> Primitive ((Pbigstring_load_64(true, mode)), 2)
| "%caml_bigstring_get16" ->
Primitive ((Pbigstring_load_16 { unsafe = false }), 2)
| "%caml_bigstring_get16u" ->
Primitive ((Pbigstring_load_16 { unsafe = true }), 2)
| "%caml_bigstring_get32" ->
Primitive ((Pbigstring_load_32 { unsafe = false; mode; boxed = true }), 2)
| "%caml_bigstring_get32u" ->
Primitive ((Pbigstring_load_32 { unsafe = true; mode; boxed = true }), 2)
| "%caml_bigstring_get64" ->
Primitive ((Pbigstring_load_64 { unsafe = false; mode; boxed = true }), 2)
| "%caml_bigstring_get64u" ->
Primitive ((Pbigstring_load_64 { unsafe = true; mode; boxed = true }), 2)
| "%caml_bigstring_getu128" ->
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = false; mode}), 2)
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = false; mode;
boxed = true }), 2)
| "%caml_bigstring_getu128u" ->
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = true; mode}), 2)
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = true; mode;
boxed = true }), 2)
| "%caml_bigstring_geta128" ->
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = false; mode}), 2)
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = false; mode;
boxed = true }), 2)
| "%caml_bigstring_geta128u" ->
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = true; mode}), 2)
| "%caml_bigstring_set16" -> Primitive ((Pbigstring_set_16(false)), 3)
| "%caml_bigstring_set16u" -> Primitive ((Pbigstring_set_16(true)), 3)
| "%caml_bigstring_set32" -> Primitive ((Pbigstring_set_32(false)), 3)
| "%caml_bigstring_set32u" -> Primitive ((Pbigstring_set_32(true)), 3)
| "%caml_bigstring_set64" -> Primitive ((Pbigstring_set_64(false)), 3)
| "%caml_bigstring_set64u" -> Primitive ((Pbigstring_set_64(true)), 3)
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = true; mode;
boxed = true }), 2)
| "%caml_bigstring_set16" ->
Primitive ((Pbigstring_set_16 { unsafe = false }), 3)
| "%caml_bigstring_set16u" ->
Primitive ((Pbigstring_set_16 { unsafe = true }), 3)
| "%caml_bigstring_set32" ->
Primitive ((Pbigstring_set_32 { unsafe = false; boxed = true }), 3)
| "%caml_bigstring_set32u" ->
Primitive ((Pbigstring_set_32 { unsafe = true; boxed = true }), 3)
| "%caml_bigstring_set64" ->
Primitive ((Pbigstring_set_64 { unsafe = false; boxed = true }), 3)
| "%caml_bigstring_set64u" ->
Primitive ((Pbigstring_set_64 { unsafe = true; boxed = true }), 3)
| "%caml_bigstring_setu128" ->
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = false}), 3)
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = false;
boxed = true}), 3)
| "%caml_bigstring_setu128u" ->
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = true}), 3)
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = true;
boxed = true}), 3)
| "%caml_bigstring_seta128" ->
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = false}), 3)
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = false;
boxed = true}), 3)
| "%caml_bigstring_seta128u" ->
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = true}), 3)
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = true;
boxed = true}), 3)
| "%caml_bigstring_get32#" ->
Primitive ((Pbigstring_load_32 { unsafe = false; mode; boxed = false }),
2)
| "%caml_bigstring_get32u#" ->
Primitive ((Pbigstring_load_32 { unsafe = true; mode; boxed = false }),
2)
| "%caml_bigstring_get64#" ->
Primitive ((Pbigstring_load_64 { unsafe = false; mode; boxed = false }),
2)
| "%caml_bigstring_get64u#" ->
Primitive ((Pbigstring_load_64 { unsafe = true; mode; boxed = false }), 2)
| "%caml_bigstring_getu128#" ->
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = false; mode;
boxed = false }), 2)
| "%caml_bigstring_getu128u#" ->
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = true; mode;
boxed = false }), 2)
| "%caml_bigstring_geta128#" ->
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = false; mode;
boxed = false }), 2)
| "%caml_bigstring_geta128u#" ->
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = true; mode;
boxed = false }), 2)
| "%caml_bigstring_set32#" ->
Primitive ((Pbigstring_set_32 { unsafe = false; boxed = false }), 3)
| "%caml_bigstring_set32u#" ->
Primitive ((Pbigstring_set_32 { unsafe = true; boxed = false }), 3)
| "%caml_bigstring_set64#" ->
Primitive ((Pbigstring_set_64 { unsafe = false; boxed = false }), 3)
| "%caml_bigstring_set64u#" ->
Primitive ((Pbigstring_set_64 { unsafe = true; boxed = false }), 3)
| "%caml_bigstring_setu128#" ->
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = false;
boxed = false}), 3)
| "%caml_bigstring_setu128u#" ->
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = true;
boxed = false}), 3)
| "%caml_bigstring_seta128#" ->
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = false;
boxed = false}), 3)
| "%caml_bigstring_seta128u#" ->
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = true;
boxed = false}), 3)
| "%bswap16" -> Primitive (Pbswap16, 1)
| "%bswap_int32" -> Primitive ((Pbbswap(Pint32, mode)), 1)
| "%bswap_int64" -> Primitive ((Pbbswap(Pint64, mode)), 1)
Expand Down
16 changes: 10 additions & 6 deletions ocaml/middle_end/convert_primitives.ml
Original file line number Diff line number Diff line change
Expand Up @@ -145,17 +145,17 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
Pbytes_set (Thirty_two, convert_unsafety is_unsafe)
| Pbytes_set_64 is_unsafe ->
Pbytes_set (Sixty_four, convert_unsafety is_unsafe)
| Pbigstring_load_16 is_unsafe ->
| Pbigstring_load_16 { unsafe = is_unsafe } ->
Pbigstring_load (Sixteen, convert_unsafety is_unsafe, Lambda.alloc_heap)
| Pbigstring_load_32 (is_unsafe, m) ->
| Pbigstring_load_32 { unsafe = is_unsafe; mode = m; boxed = true } ->
Pbigstring_load (Thirty_two, convert_unsafety is_unsafe, m)
| Pbigstring_load_64 (is_unsafe, m) ->
| Pbigstring_load_64 { unsafe = is_unsafe; mode = m; boxed = true } ->
Pbigstring_load (Sixty_four, convert_unsafety is_unsafe, m)
| Pbigstring_set_16 is_unsafe ->
| Pbigstring_set_16 { unsafe = is_unsafe } ->
Pbigstring_set (Sixteen, convert_unsafety is_unsafe)
| Pbigstring_set_32 is_unsafe ->
| Pbigstring_set_32 { unsafe = is_unsafe; boxed = true } ->
Pbigstring_set (Thirty_two, convert_unsafety is_unsafe)
| Pbigstring_set_64 is_unsafe ->
| Pbigstring_set_64 { unsafe = is_unsafe; boxed = true } ->
Pbigstring_set (Sixty_four, convert_unsafety is_unsafe)
| Pbigarraydim dim -> Pbigarraydim dim
| Pbswap16 -> Pbswap16
Expand Down Expand Up @@ -194,6 +194,10 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
| Pgetpredef _
| Parray_to_iarray
| Parray_of_iarray
| Pbigstring_load_32 _
| Pbigstring_set_32 _
| Pbigstring_load_64 _
| Pbigstring_set_64 _
| Pbigstring_load_128 _
| Pbigstring_set_128 _
| Pstring_load_128 _
Expand Down