Skip to content

Commit bf0d38c

Browse files
ncik-robertsncik-roberts
committed
Merge remote-tracking branch 'origin/main' into nroberts-inline-record-field-mixed-blocks
2 parents 0ad99fd + ddc1ec9 commit bf0d38c

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

70 files changed

+3458
-507
lines changed

‎backend/cmm_helpers.ml

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1704,6 +1704,7 @@ let curry_function_sym function_kind arity result =
17041704
let bigarray_elt_size_in_bytes : Lambda.bigarray_kind -> int = function
17051705
| Pbigarray_unknown -> assert false
17061706
| Pbigarray_float32 -> 4
1707+
| Pbigarray_float32_t -> 4
17071708
| Pbigarray_float64 -> 8
17081709
| Pbigarray_sint8 -> 1
17091710
| Pbigarray_uint8 -> 1
@@ -1719,6 +1720,7 @@ let bigarray_elt_size_in_bytes : Lambda.bigarray_kind -> int = function
17191720
let bigarray_word_kind : Lambda.bigarray_kind -> memory_chunk = function
17201721
| Pbigarray_unknown -> assert false
17211722
| Pbigarray_float32 -> Single { reg = Float64 }
1723+
| Pbigarray_float32_t -> Single { reg = Float32 }
17221724
| Pbigarray_float64 -> Double
17231725
| Pbigarray_sint8 -> Byte_signed
17241726
| Pbigarray_uint8 -> Byte_unsigned
@@ -2173,6 +2175,15 @@ let unaligned_set_64 ptr idx newval dbg =
21732175
[add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8],
21742176
dbg ) ) ) )
21752177

2178+
let unaligned_load_f32 ptr idx dbg =
2179+
Cop (mk_load_mut (Single { reg = Float32 }), [add_int ptr idx dbg], dbg)
2180+
2181+
let unaligned_set_f32 ptr idx newval dbg =
2182+
Cop
2183+
( Cstore (Single { reg = Float32 }, Assignment),
2184+
[add_int ptr idx dbg; newval],
2185+
dbg )
2186+
21762187
let unaligned_load_128 ptr idx dbg =
21772188
assert (size_vec128 = 16);
21782189
Cop (mk_load_mut Onetwentyeight_unaligned, [add_int ptr idx dbg], dbg)
@@ -3882,6 +3893,8 @@ let infix_field_address ~dbg ptr n =
38823893

38833894
let cint i = Cmm.Cint i
38843895

3896+
let cint32 i = Cmm.Cint32 (Nativeint.of_int32 i)
3897+
38853898
let cfloat32 f = Cmm.Csingle f
38863899

38873900
let cfloat f = Cmm.Cdouble f

‎backend/cmm_helpers.mli

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -392,6 +392,11 @@ val unaligned_load_32 : expression -> expression -> Debuginfo.t -> expression
392392
val unaligned_set_32 :
393393
expression -> expression -> expression -> Debuginfo.t -> expression
394394

395+
val unaligned_load_f32 : expression -> expression -> Debuginfo.t -> expression
396+
397+
val unaligned_set_f32 :
398+
expression -> expression -> expression -> Debuginfo.t -> expression
399+
395400
val unaligned_load_64 : expression -> expression -> Debuginfo.t -> expression
396401

397402
val unaligned_set_64 :
@@ -876,6 +881,9 @@ val infix_field_address : dbg:Debuginfo.t -> expression -> int -> expression
876881
(** Static integer. *)
877882
val cint : nativeint -> data_item
878883

884+
(** Static 32-bit integer. *)
885+
val cint32 : int32 -> data_item
886+
879887
(** Static float32. *)
880888
val cfloat32 : float -> data_item
881889

‎chamelon/compat.jst.ml

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -19,13 +19,11 @@ let mkTexp_ident ?id:(ident_kind, uu = (Id_value, shared_many_use))
1919
type nonrec apply_arg = apply_arg
2020

2121
type texp_apply_identifier =
22-
apply_position * Locality.l * Zero_alloc_utils.Assume_info.t
22+
apply_position * Locality.l * Builtin_attributes.zero_alloc_assume option
2323

2424
let mkTexp_apply
2525
?id:(pos, mode, za =
26-
( Default,
27-
Locality.disallow_right Locality.legacy,
28-
Zero_alloc_utils.Assume_info.none )) (exp, args) =
26+
(Default, Locality.disallow_right Locality.legacy, None)) (exp, args) =
2927
let args =
3028
List.map (fun (label, x) -> (Typetexp.transl_label label None, x)) args
3129
in
@@ -92,7 +90,7 @@ type texp_function_identifier = {
9290
ret_sort : Jkind.sort;
9391
region : bool;
9492
ret_mode : Alloc.l;
95-
zero_alloc : Builtin_attributes.zero_alloc_attribute;
93+
zero_alloc : Zero_alloc.t;
9694
}
9795

9896
let texp_function_cases_identifier_defaults =
@@ -119,7 +117,7 @@ let texp_function_defaults =
119117
ret_sort = Jkind.Sort.value;
120118
ret_mode = Alloc.disallow_right Alloc.legacy;
121119
region = false;
122-
zero_alloc = Builtin_attributes.Default_zero_alloc;
120+
zero_alloc = Zero_alloc.default;
123121
}
124122

125123
let mkTexp_function ?(id = texp_function_defaults)
@@ -403,7 +401,7 @@ let mk_value_description ~val_type ~val_kind ~val_attributes =
403401
val_modalities = Mode.Modality.Value.id;
404402
val_attributes;
405403
val_uid = Uid.internal_not_actually_unique;
406-
val_zero_alloc = Default_zero_alloc;
404+
val_zero_alloc = Zero_alloc.default;
407405
}
408406

409407
let mkTtyp_any = Ttyp_var (None, None)

‎middle_end/flambda2/from_lambda/closure_conversion.ml

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -930,16 +930,18 @@ let close_primitive acc env ~let_bound_ids_with_kinds named
930930
| Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
931931
| Pasrbint _ | Pbintcomp _ | Punboxed_int_comp _ | Pbigarrayref _
932932
| Pbigarrayset _ | Pbigarraydim _ | Pstring_load_16 _ | Pstring_load_32 _
933-
| Pstring_load_64 _ | Pstring_load_128 _ | Pbytes_load_16 _
934-
| Pbytes_load_32 _ | Pbytes_load_64 _ | Pbytes_load_128 _
935-
| Pbytes_set_16 _ | Pbytes_set_32 _ | Pbytes_set_64 _ | Pbytes_set_128 _
936-
| Pbigstring_load_16 _ | Pbigstring_load_32 _ | Pbigstring_load_64 _
937-
| Pbigstring_load_128 _ | Pbigstring_set_16 _ | Pbigstring_set_32 _
938-
| Pbigstring_set_64 _ | Pbigstring_set_128 _ | Pfloatarray_load_128 _
939-
| Pfloat_array_load_128 _ | Pint_array_load_128 _
940-
| Punboxed_float_array_load_128 _ | Punboxed_int32_array_load_128 _
941-
| Punboxed_int64_array_load_128 _ | Punboxed_nativeint_array_load_128 _
942-
| Pfloatarray_set_128 _ | Pfloat_array_set_128 _ | Pint_array_set_128 _
933+
| Pstring_load_f32 _ | Pstring_load_64 _ | Pstring_load_128 _
934+
| Pbytes_load_16 _ | Pbytes_load_32 _ | Pbytes_load_f32 _
935+
| Pbytes_load_64 _ | Pbytes_load_128 _ | Pbytes_set_16 _ | Pbytes_set_32 _
936+
| Pbytes_set_f32 _ | Pbytes_set_64 _ | Pbytes_set_128 _
937+
| Pbigstring_load_16 _ | Pbigstring_load_32 _ | Pbigstring_load_f32 _
938+
| Pbigstring_load_64 _ | Pbigstring_load_128 _ | Pbigstring_set_16 _
939+
| Pbigstring_set_32 _ | Pbigstring_set_f32 _ | Pbigstring_set_64 _
940+
| Pbigstring_set_128 _ | Pfloatarray_load_128 _ | Pfloat_array_load_128 _
941+
| Pint_array_load_128 _ | Punboxed_float_array_load_128 _
942+
| Punboxed_int32_array_load_128 _ | Punboxed_int64_array_load_128 _
943+
| Punboxed_nativeint_array_load_128 _ | Pfloatarray_set_128 _
944+
| Pfloat_array_set_128 _ | Pint_array_set_128 _
943945
| Punboxed_float_array_set_128 _ | Punboxed_int32_array_set_128 _
944946
| Punboxed_int64_array_set_128 _ | Punboxed_nativeint_array_set_128 _
945947
| Pctconst _ | Pbswap16 | Pbbswap _ | Pint_as_pointer _ | Popaque _

‎middle_end/flambda2/from_lambda/lambda_to_flambda.ml

Lines changed: 47 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -291,6 +291,7 @@ let transform_primitive env (prim : L.primitive) args loc =
291291
Primitive
292292
(L.Pnot, [L.Lprim (Punboxed_float_comp (bf, CFge), args, loc)], loc)
293293
| Pbigarrayref (_unsafe, num_dimensions, kind, layout), args -> (
294+
(* CR mshinwell: factor out with the [Pbigarrayset] case *)
294295
match
295296
P.Bigarray_kind.from_lambda kind, P.Bigarray_layout.from_lambda layout
296297
with
@@ -299,7 +300,19 @@ let transform_primitive env (prim : L.primitive) args loc =
299300
if 1 <= num_dimensions && num_dimensions <= 3
300301
then
301302
let arity = 1 + num_dimensions in
302-
let name = "caml_ba_get_" ^ string_of_int num_dimensions in
303+
let is_float32_t =
304+
match kind with
305+
| Pbigarray_float32_t -> "float32_"
306+
| Pbigarray_unknown | Pbigarray_float32 | Pbigarray_float64
307+
| Pbigarray_sint8 | Pbigarray_uint8 | Pbigarray_sint16
308+
| Pbigarray_uint16 | Pbigarray_int32 | Pbigarray_int64
309+
| Pbigarray_caml_int | Pbigarray_native_int | Pbigarray_complex32
310+
| Pbigarray_complex64 ->
311+
""
312+
in
313+
let name =
314+
"caml_ba_" ^ is_float32_t ^ "get_" ^ string_of_int num_dimensions
315+
in
303316
let desc = Lambda.simple_prim_on_values ~name ~arity ~alloc:true in
304317
Primitive (L.Pccall desc, args, loc)
305318
else
@@ -316,7 +329,19 @@ let transform_primitive env (prim : L.primitive) args loc =
316329
if 1 <= num_dimensions && num_dimensions <= 3
317330
then
318331
let arity = 2 + num_dimensions in
319-
let name = "caml_ba_set_" ^ string_of_int num_dimensions in
332+
let is_float32_t =
333+
match kind with
334+
| Pbigarray_float32_t -> "float32_"
335+
| Pbigarray_unknown | Pbigarray_float32 | Pbigarray_float64
336+
| Pbigarray_sint8 | Pbigarray_uint8 | Pbigarray_sint16
337+
| Pbigarray_uint16 | Pbigarray_int32 | Pbigarray_int64
338+
| Pbigarray_caml_int | Pbigarray_native_int | Pbigarray_complex32
339+
| Pbigarray_complex64 ->
340+
""
341+
in
342+
let name =
343+
"caml_ba_" ^ is_float32_t ^ "set_" ^ string_of_int num_dimensions
344+
in
320345
let desc = Lambda.simple_prim_on_values ~name ~arity ~alloc:true in
321346
Primitive (L.Pccall desc, args, loc)
322347
else
@@ -589,22 +614,27 @@ let primitive_can_raise (prim : Lambda.primitive) =
589614
| Pstringrefs | Pbytesrefs | Pbytessets
590615
| Pstring_load_16 false
591616
| Pstring_load_32 (false, _)
617+
| Pstring_load_f32 (false, _)
592618
| Pstring_load_64 (false, _)
593619
| Pstring_load_128 { unsafe = false; _ }
594620
| Pbytes_load_16 false
595621
| Pbytes_load_32 (false, _)
622+
| Pbytes_load_f32 (false, _)
596623
| Pbytes_load_64 (false, _)
597624
| Pbytes_load_128 { unsafe = false; _ }
598625
| Pbytes_set_16 false
599626
| Pbytes_set_32 false
627+
| Pbytes_set_f32 false
600628
| Pbytes_set_64 false
601629
| Pbytes_set_128 { unsafe = false; _ }
602630
| Pbigstring_load_16 { unsafe = false }
603631
| Pbigstring_load_32 { unsafe = false; mode = _; boxed = _ }
632+
| Pbigstring_load_f32 { unsafe = false; mode = _; boxed = _ }
604633
| Pbigstring_load_64 { unsafe = false; mode = _; boxed = _ }
605634
| Pbigstring_load_128 { unsafe = false; _ }
606635
| Pbigstring_set_16 { unsafe = false }
607636
| Pbigstring_set_32 { unsafe = false; boxed = _ }
637+
| Pbigstring_set_f32 { unsafe = false; boxed = _ }
608638
| Pbigstring_set_64 { unsafe = false; boxed = _ }
609639
| Pbigstring_set_128 { unsafe = false; _ }
610640
| Pfloatarray_load_128 { unsafe = false; _ }
@@ -662,37 +692,44 @@ let primitive_can_raise (prim : Lambda.primitive) =
662692
| Pbigarrayref
663693
( true,
664694
_,
665-
( Pbigarray_float32 | Pbigarray_float64 | Pbigarray_sint8
666-
| Pbigarray_uint8 | Pbigarray_sint16 | Pbigarray_uint16
667-
| Pbigarray_int32 | Pbigarray_int64 | Pbigarray_caml_int
668-
| Pbigarray_native_int | Pbigarray_complex32 | Pbigarray_complex64 ),
695+
( Pbigarray_float32 | Pbigarray_float32_t | Pbigarray_float64
696+
| Pbigarray_sint8 | Pbigarray_uint8 | Pbigarray_sint16
697+
| Pbigarray_uint16 | Pbigarray_int32 | Pbigarray_int64
698+
| Pbigarray_caml_int | Pbigarray_native_int | Pbigarray_complex32
699+
| Pbigarray_complex64 ),
669700
_ )
670701
| Pbigarrayset
671702
( true,
672703
_,
673-
( Pbigarray_float32 | Pbigarray_float64 | Pbigarray_sint8
674-
| Pbigarray_uint8 | Pbigarray_sint16 | Pbigarray_uint16
675-
| Pbigarray_int32 | Pbigarray_int64 | Pbigarray_caml_int
676-
| Pbigarray_native_int | Pbigarray_complex32 | Pbigarray_complex64 ),
704+
( Pbigarray_float32 | Pbigarray_float32_t | Pbigarray_float64
705+
| Pbigarray_sint8 | Pbigarray_uint8 | Pbigarray_sint16
706+
| Pbigarray_uint16 | Pbigarray_int32 | Pbigarray_int64
707+
| Pbigarray_caml_int | Pbigarray_native_int | Pbigarray_complex32
708+
| Pbigarray_complex64 ),
677709
(Pbigarray_c_layout | Pbigarray_fortran_layout) )
678710
| Pstring_load_16 true
679711
| Pstring_load_32 (true, _)
712+
| Pstring_load_f32 (true, _)
680713
| Pstring_load_64 (true, _)
681714
| Pstring_load_128 { unsafe = true; _ }
682715
| Pbytes_load_16 true
683716
| Pbytes_load_32 (true, _)
717+
| Pbytes_load_f32 (true, _)
684718
| Pbytes_load_64 (true, _)
685719
| Pbytes_load_128 { unsafe = true; _ }
686720
| Pbytes_set_16 true
687721
| Pbytes_set_32 true
722+
| Pbytes_set_f32 true
688723
| Pbytes_set_64 true
689724
| Pbytes_set_128 { unsafe = true; _ }
690725
| Pbigstring_load_16 { unsafe = true }
691726
| Pbigstring_load_32 { unsafe = true; mode = _; boxed = _ }
727+
| Pbigstring_load_f32 { unsafe = true; mode = _; boxed = _ }
692728
| Pbigstring_load_64 { unsafe = true; mode = _; boxed = _ }
693729
| Pbigstring_load_128 { unsafe = true; _ }
694730
| Pbigstring_set_16 { unsafe = true }
695731
| Pbigstring_set_32 { unsafe = true; boxed = _ }
732+
| Pbigstring_set_f32 { unsafe = true; boxed = _ }
696733
| Pbigstring_set_64 { unsafe = true; boxed = _ }
697734
| Pbigstring_set_128 { unsafe = true; _ }
698735
| Pfloatarray_load_128 { unsafe = true; _ }

0 commit comments

Comments
 (0)