Skip to content

Commit ff8ff9b

Browse files
mshinwellmshinwell
authored
flambda-backend: Unboxed primitives for bigstring access (#2243)
1 parent e20ed87 commit ff8ff9b

File tree

5 files changed

+143
-53
lines changed

5 files changed

+143
-53
lines changed

‎lambda/lambda.ml

Lines changed: 35 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -244,14 +244,15 @@ type primitive =
244244
| Pbytes_set_128 of { unsafe : bool }
245245
(* load/set 16,32,64,128 bits from a
246246
(char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
247-
| Pbigstring_load_16 of bool
248-
| Pbigstring_load_32 of bool * alloc_mode
249-
| Pbigstring_load_64 of bool * alloc_mode
250-
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode }
251-
| Pbigstring_set_16 of bool
252-
| Pbigstring_set_32 of bool
253-
| Pbigstring_set_64 of bool
254-
| Pbigstring_set_128 of { aligned : bool; unsafe : bool }
247+
| Pbigstring_load_16 of { unsafe : bool }
248+
| Pbigstring_load_32 of { unsafe : bool; mode: alloc_mode; boxed : bool }
249+
| Pbigstring_load_64 of { unsafe : bool; mode: alloc_mode; boxed : bool }
250+
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode;
251+
boxed : bool }
252+
| Pbigstring_set_16 of { unsafe : bool }
253+
| Pbigstring_set_32 of { unsafe : bool; boxed : bool }
254+
| Pbigstring_set_64 of { unsafe : bool; boxed : bool }
255+
| Pbigstring_set_128 of { aligned : bool; unsafe : bool; boxed : bool }
255256
(* Compile time constants *)
256257
| Pctconst of compile_time_constant
257258
(* byte swap *)
@@ -766,8 +767,18 @@ let layout_unboxed_nativeint = Punboxed_int Pnativeint
766767
let layout_unboxed_int32 = Punboxed_int Pint32
767768
let layout_unboxed_int64 = Punboxed_int Pint64
768769
let layout_string = Pvalue Pgenval
770+
let layout_unboxed_int ubi = Punboxed_int ubi
769771
let layout_boxedint bi = Pvalue (Pboxedintval bi)
770772

773+
let layout_unboxed_vector (v : Primitive.boxed_vector) =
774+
match v with
775+
| Pvec128 Int8x16 -> Punboxed_vector (Pvec128 Int8x16)
776+
| Pvec128 Int16x8 -> Punboxed_vector (Pvec128 Int16x8)
777+
| Pvec128 Int32x4 -> Punboxed_vector (Pvec128 Int32x4)
778+
| Pvec128 Int64x2 -> Punboxed_vector (Pvec128 Int64x2)
779+
| Pvec128 Float32x4 -> Punboxed_vector (Pvec128 Float32x4)
780+
| Pvec128 Float64x2 -> Punboxed_vector (Pvec128 Float64x2)
781+
771782
let layout_boxed_vector : Primitive.boxed_vector -> layout = function
772783
| Pvec128 Int8x16 -> Pvalue (Pboxedvectorval (Pvec128 Int8x16))
773784
| Pvec128 Int16x8 -> Pvalue (Pboxedvectorval (Pvec128 Int16x8))
@@ -1579,8 +1590,12 @@ let primitive_may_allocate : primitive -> alloc_mode option = function
15791590
| Pget_header m -> Some m
15801591
| Pbytes_set_16 _ | Pbytes_set_32 _ | Pbytes_set_64 _ | Pbytes_set_128 _ -> None
15811592
| Pbigstring_load_16 _ -> None
1582-
| Pbigstring_load_32 (_,m) | Pbigstring_load_64 (_,m)
1583-
| Pbigstring_load_128 { mode = m; _ } -> Some m
1593+
| Pbigstring_load_32 { mode = m; boxed = true; _ }
1594+
| Pbigstring_load_64 { mode = m; boxed = true; _ }
1595+
| Pbigstring_load_128 { mode = m; boxed = true; _ } -> Some m
1596+
| Pbigstring_load_32 { boxed = false; _ }
1597+
| Pbigstring_load_64 { boxed = false; _ }
1598+
| Pbigstring_load_128 { boxed = false; _ } -> None
15841599
| Pbigstring_set_16 _ | Pbigstring_set_32 _
15851600
| Pbigstring_set_64 _ | Pbigstring_set_128 _ -> None
15861601
| Pctconst _ -> None
@@ -1695,12 +1710,19 @@ let primitive_result_layout (p : primitive) =
16951710
| Pbbswap (bi, _) | Pbox_int (bi, _) ->
16961711
layout_boxedint bi
16971712
| Punbox_int bi -> Punboxed_int bi
1698-
| Pstring_load_32 _ | Pbytes_load_32 _ | Pbigstring_load_32 _ ->
1713+
| Pstring_load_32 _ | Pbytes_load_32 _
1714+
| Pbigstring_load_32 { boxed = true; _ } ->
16991715
layout_boxedint Pint32
1700-
| Pstring_load_64 _ | Pbytes_load_64 _ | Pbigstring_load_64 _ ->
1716+
| Pstring_load_64 _ | Pbytes_load_64 _
1717+
| Pbigstring_load_64 { boxed = true; _ } ->
17011718
layout_boxedint Pint64
1702-
| Pstring_load_128 _ | Pbytes_load_128 _ | Pbigstring_load_128 _ ->
1719+
| Pstring_load_128 _ | Pbytes_load_128 _
1720+
| Pbigstring_load_128 { boxed = true; _ } ->
17031721
layout_boxed_vector (Pvec128 Int8x16)
1722+
| Pbigstring_load_32 { boxed = false; _ } -> layout_unboxed_int Pint32
1723+
| Pbigstring_load_64 { boxed = false; _ } -> layout_unboxed_int Pint64
1724+
| Pbigstring_load_128 { boxed = false; _ } ->
1725+
layout_unboxed_vector (Pvec128 Int8x16)
17041726
| Pbigarrayref (_, _, kind, _) ->
17051727
begin match kind with
17061728
| Pbigarray_unknown -> layout_any_value

‎lambda/lambda.mli

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -206,14 +206,15 @@ type primitive =
206206
| Pbytes_set_128 of { unsafe : bool }
207207
(* load/set 16,32,64,128 bits from a
208208
(char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
209-
| Pbigstring_load_16 of bool
210-
| Pbigstring_load_32 of bool * alloc_mode
211-
| Pbigstring_load_64 of bool * alloc_mode
212-
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode }
213-
| Pbigstring_set_16 of bool
214-
| Pbigstring_set_32 of bool
215-
| Pbigstring_set_64 of bool
216-
| Pbigstring_set_128 of { aligned : bool; unsafe : bool }
209+
| Pbigstring_load_16 of { unsafe : bool }
210+
| Pbigstring_load_32 of { unsafe : bool; mode: alloc_mode; boxed : bool }
211+
| Pbigstring_load_64 of { unsafe : bool; mode: alloc_mode; boxed : bool }
212+
| Pbigstring_load_128 of { aligned : bool; unsafe : bool; mode: alloc_mode;
213+
boxed : bool }
214+
| Pbigstring_set_16 of { unsafe : bool }
215+
| Pbigstring_set_32 of { unsafe : bool; boxed : bool }
216+
| Pbigstring_set_64 of { unsafe : bool; boxed : bool }
217+
| Pbigstring_set_128 of { aligned : bool; unsafe : bool; boxed : bool }
217218
(* Compile time constants *)
218219
| Pctconst of compile_time_constant
219220
(* byte swap *)

‎lambda/printlambda.ml

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -578,13 +578,13 @@ let primitive ppf = function
578578
fprintf ppf "bytes.unsafe_unaligned_set128"
579579
| Pbytes_set_128 {unsafe = false} ->
580580
fprintf ppf "bytes.unaligned_set128"
581-
| Pbigstring_load_16(unsafe) ->
581+
| Pbigstring_load_16 { unsafe } ->
582582
if unsafe then fprintf ppf "bigarray.array1.unsafe_get16"
583583
else fprintf ppf "bigarray.array1.get16"
584-
| Pbigstring_load_32(unsafe,m) ->
584+
| Pbigstring_load_32 { unsafe; mode = m } ->
585585
if unsafe then fprintf ppf "bigarray.array1.unsafe_get32%s" (alloc_kind m)
586586
else fprintf ppf "bigarray.array1.get32%s" (alloc_kind m)
587-
| Pbigstring_load_64(unsafe,m) ->
587+
| Pbigstring_load_64 { unsafe; mode = m } ->
588588
if unsafe then fprintf ppf "bigarray.array1.unsafe_get64%s" (alloc_kind m)
589589
else fprintf ppf "bigarray.array1.get64%s" (alloc_kind m)
590590
| Pbigstring_load_128 {unsafe = true; aligned = false; mode} ->
@@ -595,13 +595,13 @@ let primitive ppf = function
595595
fprintf ppf "bigarray.array1.unsafe_aligned_get128%s" (alloc_kind mode)
596596
| Pbigstring_load_128 {unsafe = false; aligned = true; mode} ->
597597
fprintf ppf "bigarray.array1.aligned_get128%s" (alloc_kind mode)
598-
| Pbigstring_set_16(unsafe) ->
598+
| Pbigstring_set_16 { unsafe } ->
599599
if unsafe then fprintf ppf "bigarray.array1.unsafe_set16"
600600
else fprintf ppf "bigarray.array1.set16"
601-
| Pbigstring_set_32(unsafe) ->
601+
| Pbigstring_set_32 { unsafe } ->
602602
if unsafe then fprintf ppf "bigarray.array1.unsafe_set32"
603603
else fprintf ppf "bigarray.array1.set32"
604-
| Pbigstring_set_64(unsafe) ->
604+
| Pbigstring_set_64 { unsafe } ->
605605
if unsafe then fprintf ppf "bigarray.array1.unsafe_set64"
606606
else fprintf ppf "bigarray.array1.set64"
607607
| Pbigstring_set_128 {unsafe = true; aligned = false} ->

‎lambda/translprim.ml

Lines changed: 83 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -401,34 +401,97 @@ let lookup_primitive loc poly pos p =
401401
Primitive ((Pbytes_set_128 {unsafe = false}), 3)
402402
| "%caml_bytes_setu128u" ->
403403
Primitive ((Pbytes_set_128 {unsafe = true}), 3)
404-
| "%caml_bigstring_get16" -> Primitive ((Pbigstring_load_16(false)), 2)
405-
| "%caml_bigstring_get16u" -> Primitive ((Pbigstring_load_16(true)), 2)
406-
| "%caml_bigstring_get32" -> Primitive ((Pbigstring_load_32(false, mode)), 2)
407-
| "%caml_bigstring_get32u" -> Primitive ((Pbigstring_load_32(true, mode)), 2)
408-
| "%caml_bigstring_get64" -> Primitive ((Pbigstring_load_64(false, mode)), 2)
409-
| "%caml_bigstring_get64u" -> Primitive ((Pbigstring_load_64(true, mode)), 2)
404+
| "%caml_bigstring_get16" ->
405+
Primitive ((Pbigstring_load_16 { unsafe = false }), 2)
406+
| "%caml_bigstring_get16u" ->
407+
Primitive ((Pbigstring_load_16 { unsafe = true }), 2)
408+
| "%caml_bigstring_get32" ->
409+
Primitive ((Pbigstring_load_32 { unsafe = false; mode; boxed = true }), 2)
410+
| "%caml_bigstring_get32u" ->
411+
Primitive ((Pbigstring_load_32 { unsafe = true; mode; boxed = true }), 2)
412+
| "%caml_bigstring_get64" ->
413+
Primitive ((Pbigstring_load_64 { unsafe = false; mode; boxed = true }), 2)
414+
| "%caml_bigstring_get64u" ->
415+
Primitive ((Pbigstring_load_64 { unsafe = true; mode; boxed = true }), 2)
410416
| "%caml_bigstring_getu128" ->
411-
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = false; mode}), 2)
417+
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = false; mode;
418+
boxed = true }), 2)
412419
| "%caml_bigstring_getu128u" ->
413-
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = true; mode}), 2)
420+
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = true; mode;
421+
boxed = true }), 2)
414422
| "%caml_bigstring_geta128" ->
415-
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = false; mode}), 2)
423+
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = false; mode;
424+
boxed = true }), 2)
416425
| "%caml_bigstring_geta128u" ->
417-
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = true; mode}), 2)
418-
| "%caml_bigstring_set16" -> Primitive ((Pbigstring_set_16(false)), 3)
419-
| "%caml_bigstring_set16u" -> Primitive ((Pbigstring_set_16(true)), 3)
420-
| "%caml_bigstring_set32" -> Primitive ((Pbigstring_set_32(false)), 3)
421-
| "%caml_bigstring_set32u" -> Primitive ((Pbigstring_set_32(true)), 3)
422-
| "%caml_bigstring_set64" -> Primitive ((Pbigstring_set_64(false)), 3)
423-
| "%caml_bigstring_set64u" -> Primitive ((Pbigstring_set_64(true)), 3)
426+
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = true; mode;
427+
boxed = true }), 2)
428+
| "%caml_bigstring_set16" ->
429+
Primitive ((Pbigstring_set_16 { unsafe = false }), 3)
430+
| "%caml_bigstring_set16u" ->
431+
Primitive ((Pbigstring_set_16 { unsafe = true }), 3)
432+
| "%caml_bigstring_set32" ->
433+
Primitive ((Pbigstring_set_32 { unsafe = false; boxed = true }), 3)
434+
| "%caml_bigstring_set32u" ->
435+
Primitive ((Pbigstring_set_32 { unsafe = true; boxed = true }), 3)
436+
| "%caml_bigstring_set64" ->
437+
Primitive ((Pbigstring_set_64 { unsafe = false; boxed = true }), 3)
438+
| "%caml_bigstring_set64u" ->
439+
Primitive ((Pbigstring_set_64 { unsafe = true; boxed = true }), 3)
424440
| "%caml_bigstring_setu128" ->
425-
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = false}), 3)
441+
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = false;
442+
boxed = true}), 3)
426443
| "%caml_bigstring_setu128u" ->
427-
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = true}), 3)
444+
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = true;
445+
boxed = true}), 3)
428446
| "%caml_bigstring_seta128" ->
429-
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = false}), 3)
447+
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = false;
448+
boxed = true}), 3)
430449
| "%caml_bigstring_seta128u" ->
431-
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = true}), 3)
450+
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = true;
451+
boxed = true}), 3)
452+
| "%caml_bigstring_get32#" ->
453+
Primitive ((Pbigstring_load_32 { unsafe = false; mode; boxed = false }),
454+
2)
455+
| "%caml_bigstring_get32u#" ->
456+
Primitive ((Pbigstring_load_32 { unsafe = true; mode; boxed = false }),
457+
2)
458+
| "%caml_bigstring_get64#" ->
459+
Primitive ((Pbigstring_load_64 { unsafe = false; mode; boxed = false }),
460+
2)
461+
| "%caml_bigstring_get64u#" ->
462+
Primitive ((Pbigstring_load_64 { unsafe = true; mode; boxed = false }), 2)
463+
| "%caml_bigstring_getu128#" ->
464+
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = false; mode;
465+
boxed = false }), 2)
466+
| "%caml_bigstring_getu128u#" ->
467+
Primitive ((Pbigstring_load_128 {aligned = false; unsafe = true; mode;
468+
boxed = false }), 2)
469+
| "%caml_bigstring_geta128#" ->
470+
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = false; mode;
471+
boxed = false }), 2)
472+
| "%caml_bigstring_geta128u#" ->
473+
Primitive ((Pbigstring_load_128 {aligned = true; unsafe = true; mode;
474+
boxed = false }), 2)
475+
| "%caml_bigstring_set32#" ->
476+
Primitive ((Pbigstring_set_32 { unsafe = false; boxed = false }), 3)
477+
| "%caml_bigstring_set32u#" ->
478+
Primitive ((Pbigstring_set_32 { unsafe = true; boxed = false }), 3)
479+
| "%caml_bigstring_set64#" ->
480+
Primitive ((Pbigstring_set_64 { unsafe = false; boxed = false }), 3)
481+
| "%caml_bigstring_set64u#" ->
482+
Primitive ((Pbigstring_set_64 { unsafe = true; boxed = false }), 3)
483+
| "%caml_bigstring_setu128#" ->
484+
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = false;
485+
boxed = false}), 3)
486+
| "%caml_bigstring_setu128u#" ->
487+
Primitive ((Pbigstring_set_128 {aligned = false; unsafe = true;
488+
boxed = false}), 3)
489+
| "%caml_bigstring_seta128#" ->
490+
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = false;
491+
boxed = false}), 3)
492+
| "%caml_bigstring_seta128u#" ->
493+
Primitive ((Pbigstring_set_128 {aligned = true; unsafe = true;
494+
boxed = false}), 3)
432495
| "%bswap16" -> Primitive (Pbswap16, 1)
433496
| "%bswap_int32" -> Primitive ((Pbbswap(Pint32, mode)), 1)
434497
| "%bswap_int64" -> Primitive ((Pbbswap(Pint64, mode)), 1)

‎middle_end/convert_primitives.ml

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -145,17 +145,17 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
145145
Pbytes_set (Thirty_two, convert_unsafety is_unsafe)
146146
| Pbytes_set_64 is_unsafe ->
147147
Pbytes_set (Sixty_four, convert_unsafety is_unsafe)
148-
| Pbigstring_load_16 is_unsafe ->
148+
| Pbigstring_load_16 { unsafe = is_unsafe } ->
149149
Pbigstring_load (Sixteen, convert_unsafety is_unsafe, Lambda.alloc_heap)
150-
| Pbigstring_load_32 (is_unsafe, m) ->
150+
| Pbigstring_load_32 { unsafe = is_unsafe; mode = m; boxed = true } ->
151151
Pbigstring_load (Thirty_two, convert_unsafety is_unsafe, m)
152-
| Pbigstring_load_64 (is_unsafe, m) ->
152+
| Pbigstring_load_64 { unsafe = is_unsafe; mode = m; boxed = true } ->
153153
Pbigstring_load (Sixty_four, convert_unsafety is_unsafe, m)
154-
| Pbigstring_set_16 is_unsafe ->
154+
| Pbigstring_set_16 { unsafe = is_unsafe } ->
155155
Pbigstring_set (Sixteen, convert_unsafety is_unsafe)
156-
| Pbigstring_set_32 is_unsafe ->
156+
| Pbigstring_set_32 { unsafe = is_unsafe; boxed = true } ->
157157
Pbigstring_set (Thirty_two, convert_unsafety is_unsafe)
158-
| Pbigstring_set_64 is_unsafe ->
158+
| Pbigstring_set_64 { unsafe = is_unsafe; boxed = true } ->
159159
Pbigstring_set (Sixty_four, convert_unsafety is_unsafe)
160160
| Pbigarraydim dim -> Pbigarraydim dim
161161
| Pbswap16 -> Pbswap16
@@ -194,6 +194,10 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
194194
| Pgetpredef _
195195
| Parray_to_iarray
196196
| Parray_of_iarray
197+
| Pbigstring_load_32 _
198+
| Pbigstring_set_32 _
199+
| Pbigstring_load_64 _
200+
| Pbigstring_set_64 _
197201
| Pbigstring_load_128 _
198202
| Pbigstring_set_128 _
199203
| Pstring_load_128 _

0 commit comments

Comments
 (0)