Skip to content

Commit be57ed6

Browse files
antalszmshinwell
antalsz
and
mshinwell
authored
flambda-backend: Local immutable arrays (#1420)
Co-authored-by: Mark Shinwell <[email protected]>
1 parent 3a5d06a commit be57ed6

37 files changed

+2507
-346
lines changed

‎asmcomp/cmm_helpers.ml

Lines changed: 70 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -790,23 +790,29 @@ let int_array_ref arr ofs dbg =
790790
let unboxed_float_array_ref arr ofs dbg =
791791
Cop(Cload (Double, Mutable),
792792
[array_indexing log2_size_float arr ofs dbg], dbg)
793-
let float_array_ref arr ofs dbg =
794-
box_float dbg Lambda.alloc_heap (unboxed_float_array_ref arr ofs dbg)
793+
let float_array_ref mode arr ofs dbg =
794+
box_float dbg mode (unboxed_float_array_ref arr ofs dbg)
795795

796-
let addr_array_set arr ofs newval dbg =
796+
let addr_array_set_heap arr ofs newval dbg =
797797
Cop(Cextcall("caml_modify", typ_void, [], false),
798798
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
799+
800+
let addr_array_set_local arr ofs newval dbg =
801+
Cop(Cextcall("caml_modify_local", typ_void, [], false),
802+
[arr; untag_int ofs dbg; newval], dbg)
803+
804+
let addr_array_set (mode : Lambda.modify_mode) arr ofs newval dbg =
805+
match mode with
806+
| Modify_heap -> addr_array_set_heap arr ofs newval dbg
807+
| Modify_maybe_stack -> addr_array_set_local arr ofs newval dbg
808+
(* int and float arrays can be written to uniformly regardless of their mode *)
799809
let int_array_set arr ofs newval dbg =
800810
Cop(Cstore (Word_int, Assignment),
801811
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
802812
let float_array_set arr ofs newval dbg =
803813
Cop(Cstore (Double, Assignment),
804814
[array_indexing log2_size_float arr ofs dbg; newval], dbg)
805815

806-
let addr_array_set_local arr ofs newval dbg =
807-
Cop(Cextcall("caml_modify_local", typ_void, [], false),
808-
[arr; untag_int ofs dbg; newval], dbg)
809-
810816
let addr_array_initialize arr ofs newval dbg =
811817
Cop(Cextcall("caml_initialize", typ_void, [], false),
812818
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
@@ -2748,28 +2754,28 @@ let bigstring_load size unsafe mode arg1 arg2 dbg =
27482754
idx
27492755
(unaligned_load size ba_data idx dbg)))))
27502756

2751-
let arrayref_unsafe kind arg1 arg2 dbg =
2752-
match (kind : Lambda.array_kind) with
2753-
| Pgenarray ->
2757+
let arrayref_unsafe rkind arg1 arg2 dbg =
2758+
match (rkind : Lambda.array_ref_kind) with
2759+
| Pgenarray_ref mode ->
27542760
bind "index" arg2 (fun idx ->
27552761
bind "arr" arg1 (fun arr ->
27562762
Cifthenelse(is_addr_array_ptr arr dbg,
27572763
dbg,
27582764
addr_array_ref arr idx dbg,
27592765
dbg,
2760-
float_array_ref arr idx dbg,
2766+
float_array_ref mode arr idx dbg,
27612767
dbg, Any)))
2762-
| Paddrarray ->
2768+
| Paddrarray_ref ->
27632769
addr_array_ref arg1 arg2 dbg
2764-
| Pintarray ->
2770+
| Pintarray_ref ->
27652771
(* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *)
27662772
int_array_ref arg1 arg2 dbg
2767-
| Pfloatarray ->
2768-
float_array_ref arg1 arg2 dbg
2773+
| Pfloatarray_ref mode ->
2774+
float_array_ref mode arg1 arg2 dbg
27692775

2770-
let arrayref_safe kind arg1 arg2 dbg =
2771-
match (kind : Lambda.array_kind) with
2772-
| Pgenarray ->
2776+
let arrayref_safe rkind arg1 arg2 dbg =
2777+
match (rkind : Lambda.array_ref_kind) with
2778+
| Pgenarray_ref mode ->
27732779
bind "index" arg2 (fun idx ->
27742780
bind "arr" arg1 (fun arr ->
27752781
bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
@@ -2780,7 +2786,7 @@ let arrayref_safe kind arg1 arg2 dbg =
27802786
dbg,
27812787
addr_array_ref arr idx dbg,
27822788
dbg,
2783-
float_array_ref arr idx dbg,
2789+
float_array_ref mode arr idx dbg,
27842790
dbg, Any))
27852791
else
27862792
Cifthenelse(is_addr_array_hdr hdr dbg,
@@ -2791,42 +2797,42 @@ let arrayref_safe kind arg1 arg2 dbg =
27912797
dbg,
27922798
Csequence(
27932799
make_checkbound dbg [float_array_length_shifted hdr dbg; idx],
2794-
float_array_ref arr idx dbg),
2800+
float_array_ref mode arr idx dbg),
27952801
dbg, Any))))
2796-
| Paddrarray ->
2797-
bind "index" arg2 (fun idx ->
2798-
bind "arr" arg1 (fun arr ->
2799-
Csequence(
2800-
make_checkbound dbg [
2801-
addr_array_length_shifted
2802-
(get_header_without_profinfo arr dbg) dbg; idx],
2803-
addr_array_ref arr idx dbg)))
2804-
| Pintarray ->
2805-
bind "index" arg2 (fun idx ->
2806-
bind "arr" arg1 (fun arr ->
2807-
Csequence(
2808-
make_checkbound dbg [
2809-
addr_array_length_shifted
2810-
(get_header_without_profinfo arr dbg) dbg; idx],
2811-
int_array_ref arr idx dbg)))
2812-
| Pfloatarray ->
2813-
box_float dbg Lambda.alloc_heap (
2814-
bind "index" arg2 (fun idx ->
2815-
bind "arr" arg1 (fun arr ->
2816-
Csequence(
2817-
make_checkbound dbg [
2818-
float_array_length_shifted
2819-
(get_header_without_profinfo arr dbg) dbg;
2820-
idx],
2821-
unboxed_float_array_ref arr idx dbg))))
2802+
| Paddrarray_ref ->
2803+
bind "index" arg2 (fun idx ->
2804+
bind "arr" arg1 (fun arr ->
2805+
Csequence(
2806+
make_checkbound dbg [
2807+
addr_array_length_shifted
2808+
(get_header_without_profinfo arr dbg) dbg; idx],
2809+
addr_array_ref arr idx dbg)))
2810+
| Pintarray_ref ->
2811+
bind "index" arg2 (fun idx ->
2812+
bind "arr" arg1 (fun arr ->
2813+
Csequence(
2814+
make_checkbound dbg [
2815+
addr_array_length_shifted
2816+
(get_header_without_profinfo arr dbg) dbg; idx],
2817+
int_array_ref arr idx dbg)))
2818+
| Pfloatarray_ref mode ->
2819+
box_float dbg mode (
2820+
bind "index" arg2 (fun idx ->
2821+
bind "arr" arg1 (fun arr ->
2822+
Csequence(
2823+
make_checkbound dbg [
2824+
float_array_length_shifted
2825+
(get_header_without_profinfo arr dbg) dbg;
2826+
idx],
2827+
unboxed_float_array_ref arr idx dbg))))
28222828

28232829
type ternary_primitive =
28242830
expression -> expression -> expression -> Debuginfo.t -> expression
28252831

28262832
let setfield_computed ptr init arg1 arg2 arg3 dbg =
28272833
match assignment_kind ptr init with
28282834
| Caml_modify ->
2829-
return_unit dbg (addr_array_set arg1 arg2 arg3 dbg)
2835+
return_unit dbg (addr_array_set_heap arg1 arg2 arg3 dbg)
28302836
| Caml_modify_local ->
28312837
return_unit dbg (addr_array_set_local arg1 arg2 arg3 dbg)
28322838
| Caml_initialize ->
@@ -2850,30 +2856,30 @@ let bytesset_safe arg1 arg2 arg3 dbg =
28502856
[add_int str idx dbg; newval],
28512857
dbg))))))
28522858

2853-
let arrayset_unsafe kind arg1 arg2 arg3 dbg =
2854-
return_unit dbg (match (kind: Lambda.array_kind) with
2855-
| Pgenarray ->
2859+
let arrayset_unsafe skind arg1 arg2 arg3 dbg =
2860+
return_unit dbg (match (skind: Lambda.array_set_kind) with
2861+
| Pgenarray_set mode ->
28562862
bind "newval" arg3 (fun newval ->
28572863
bind "index" arg2 (fun index ->
28582864
bind "arr" arg1 (fun arr ->
28592865
Cifthenelse(is_addr_array_ptr arr dbg,
28602866
dbg,
2861-
addr_array_set arr index newval dbg,
2867+
addr_array_set mode arr index newval dbg,
28622868
dbg,
28632869
float_array_set arr index (unbox_float dbg newval)
28642870
dbg,
28652871
dbg, Any))))
2866-
| Paddrarray ->
2867-
addr_array_set arg1 arg2 arg3 dbg
2868-
| Pintarray ->
2872+
| Paddrarray_set mode ->
2873+
addr_array_set mode arg1 arg2 arg3 dbg
2874+
| Pintarray_set ->
28692875
int_array_set arg1 arg2 arg3 dbg
2870-
| Pfloatarray ->
2876+
| Pfloatarray_set ->
28712877
float_array_set arg1 arg2 arg3 dbg
28722878
)
28732879

2874-
let arrayset_safe kind arg1 arg2 arg3 dbg =
2875-
return_unit dbg (match (kind: Lambda.array_kind) with
2876-
| Pgenarray ->
2880+
let arrayset_safe skind arg1 arg2 arg3 dbg =
2881+
return_unit dbg (match (skind: Lambda.array_set_kind) with
2882+
| Pgenarray_set mode ->
28772883
bind "newval" arg3 (fun newval ->
28782884
bind "index" arg2 (fun idx ->
28792885
bind "arr" arg1 (fun arr ->
@@ -2883,7 +2889,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
28832889
make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
28842890
Cifthenelse(is_addr_array_hdr hdr dbg,
28852891
dbg,
2886-
addr_array_set arr idx newval dbg,
2892+
addr_array_set mode arr idx newval dbg,
28872893
dbg,
28882894
float_array_set arr idx
28892895
(unbox_float dbg newval)
@@ -2895,14 +2901,14 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
28952901
dbg,
28962902
Csequence(
28972903
make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
2898-
addr_array_set arr idx newval dbg),
2904+
addr_array_set mode arr idx newval dbg),
28992905
dbg,
29002906
Csequence(
29012907
make_checkbound dbg [float_array_length_shifted hdr dbg; idx],
29022908
float_array_set arr idx
29032909
(unbox_float dbg newval) dbg),
29042910
dbg, Any)))))
2905-
| Paddrarray ->
2911+
| Paddrarray_set mode ->
29062912
bind "newval" arg3 (fun newval ->
29072913
bind "index" arg2 (fun idx ->
29082914
bind "arr" arg1 (fun arr ->
@@ -2911,8 +2917,8 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
29112917
addr_array_length_shifted
29122918
(get_header_without_profinfo arr dbg) dbg;
29132919
idx],
2914-
addr_array_set arr idx newval dbg))))
2915-
| Pintarray ->
2920+
addr_array_set mode arr idx newval dbg))))
2921+
| Pintarray_set ->
29162922
bind "newval" arg3 (fun newval ->
29172923
bind "index" arg2 (fun idx ->
29182924
bind "arr" arg1 (fun arr ->
@@ -2922,7 +2928,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
29222928
(get_header_without_profinfo arr dbg) dbg;
29232929
idx],
29242930
int_array_set arr idx newval dbg))))
2925-
| Pfloatarray ->
2931+
| Pfloatarray_set ->
29262932
bind_load "newval" arg3 (fun newval ->
29272933
bind "index" arg2 (fun idx ->
29282934
bind "arr" arg1 (fun arr ->

‎asmcomp/cmm_helpers.mli

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -265,11 +265,15 @@ val addr_array_ref : expression -> expression -> Debuginfo.t -> expression
265265
val int_array_ref : expression -> expression -> Debuginfo.t -> expression
266266
val unboxed_float_array_ref :
267267
expression -> expression -> Debuginfo.t -> expression
268-
val float_array_ref : expression -> expression -> Debuginfo.t -> expression
269-
val addr_array_set :
268+
val float_array_ref :
269+
Lambda.alloc_mode -> expression -> expression -> Debuginfo.t -> expression
270+
val addr_array_set_heap :
270271
expression -> expression -> expression -> Debuginfo.t -> expression
271272
val addr_array_set_local :
272273
expression -> expression -> expression -> Debuginfo.t -> expression
274+
val addr_array_set :
275+
Lambda.modify_mode -> expression -> expression -> expression -> Debuginfo.t ->
276+
expression
273277
val int_array_set :
274278
expression -> expression -> expression -> Debuginfo.t -> expression
275279
val float_array_set :
@@ -555,9 +559,9 @@ val bigstring_load :
555559

556560
(** Arrays *)
557561

558-
(** Array access. Args: array, index *)
559-
val arrayref_unsafe : Lambda.array_kind -> binary_primitive
560-
val arrayref_safe : Lambda.array_kind -> binary_primitive
562+
(** Array access. Args: array, index *)
563+
val arrayref_unsafe : Lambda.array_ref_kind -> binary_primitive
564+
val arrayref_safe : Lambda.array_ref_kind -> binary_primitive
561565

562566
type ternary_primitive =
563567
expression -> expression -> expression -> Debuginfo.t -> expression
@@ -578,8 +582,8 @@ val bytesset_safe : ternary_primitive
578582
_unboxed_ float. Otherwise, it is expected to be a regular caml value,
579583
including in the case where the array contains floats.
580584
Args: array, index, value *)
581-
val arrayset_unsafe : Lambda.array_kind -> ternary_primitive
582-
val arrayset_safe : Lambda.array_kind -> ternary_primitive
585+
val arrayset_unsafe : Lambda.array_set_kind -> ternary_primitive
586+
val arrayset_safe : Lambda.array_set_kind -> ternary_primitive
583587

584588
(** Set a chunk of data in the given bytes or bigstring structure.
585589
See also [string_load] and [bigstring_load].

‎asmcomp/cmmgen.ml

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1067,10 +1067,10 @@ and transl_prim_2 env p arg1 arg2 dbg =
10671067
bigstring_load size unsafe mode (transl env arg1) (transl env arg2) dbg
10681068

10691069
(* Array operations *)
1070-
| Parrayrefu kind ->
1071-
arrayref_unsafe kind (transl env arg1) (transl env arg2) dbg
1072-
| Parrayrefs kind ->
1073-
arrayref_safe kind (transl env arg1) (transl env arg2) dbg
1070+
| Parrayrefu rkind ->
1071+
arrayref_unsafe rkind (transl env arg1) (transl env arg2) dbg
1072+
| Parrayrefs rkind ->
1073+
arrayref_safe rkind (transl env arg1) (transl env arg2) dbg
10741074

10751075
(* Boxed integers *)
10761076
| Paddbint (bi, mode) ->
@@ -1155,20 +1155,20 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg =
11551155
(transl env arg1) (transl env arg2) (transl env arg3) dbg
11561156

11571157
(* Array operations *)
1158-
| Parraysetu kind ->
1158+
| Parraysetu skind ->
11591159
let newval =
1160-
match kind with
1161-
| Pfloatarray -> transl_unbox_float dbg env arg3
1160+
match skind with
1161+
| Pfloatarray_set -> transl_unbox_float dbg env arg3
11621162
| _ -> transl env arg3
11631163
in
1164-
arrayset_unsafe kind (transl env arg1) (transl env arg2) newval dbg
1165-
| Parraysets kind ->
1164+
arrayset_unsafe skind (transl env arg1) (transl env arg2) newval dbg
1165+
| Parraysets skind ->
11661166
let newval =
1167-
match kind with
1168-
| Pfloatarray -> transl_unbox_float dbg env arg3
1167+
match skind with
1168+
| Pfloatarray_set -> transl_unbox_float dbg env arg3
11691169
| _ -> transl env arg3
11701170
in
1171-
arrayset_safe kind (transl env arg1) (transl env arg2) newval dbg
1171+
arrayset_safe skind (transl env arg1) (transl env arg2) newval dbg
11721172

11731173
| Pbytes_set(size, unsafe) ->
11741174
bytes_set size unsafe (transl env arg1) (transl env arg2)

‎boot/ocamlc

2.62 KB
Binary file not shown.

‎boot/ocamllex

183 Bytes
Binary file not shown.

‎bytecomp/bytegen.ml

Lines changed: 17 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -454,18 +454,23 @@ let comp_primitive p args =
454454
| Pbytes_load_32(_) -> Kccall("caml_bytes_get32", 2)
455455
| Pbytes_load_64(_) -> Kccall("caml_bytes_get64", 2)
456456
| Parraylength _ -> Kvectlength
457-
| Parrayrefs Pgenarray -> Kccall("caml_array_get", 2)
458-
| Parrayrefs Pfloatarray -> Kccall("caml_floatarray_get", 2)
459-
| Parrayrefs _ -> Kccall("caml_array_get_addr", 2)
460-
| Parraysets Pgenarray -> Kccall("caml_array_set", 3)
461-
| Parraysets Pfloatarray -> Kccall("caml_floatarray_set", 3)
462-
| Parraysets _ -> Kccall("caml_array_set_addr", 3)
463-
| Parrayrefu Pgenarray -> Kccall("caml_array_unsafe_get", 2)
464-
| Parrayrefu Pfloatarray -> Kccall("caml_floatarray_unsafe_get", 2)
465-
| Parrayrefu _ -> Kgetvectitem
466-
| Parraysetu Pgenarray -> Kccall("caml_array_unsafe_set", 3)
467-
| Parraysetu Pfloatarray -> Kccall("caml_floatarray_unsafe_set", 3)
468-
| Parraysetu _ -> Ksetvectitem
457+
(* In bytecode, nothing is ever actually stack-allocated, so we ignore the
458+
array modes (allocation for [Parrayref{s,u}], modification for
459+
[Parrayset{s,u}]). *)
460+
| Parrayrefs (Pgenarray_ref _) -> Kccall("caml_array_get", 2)
461+
| Parrayrefs (Pfloatarray_ref _) -> Kccall("caml_floatarray_get", 2)
462+
| Parrayrefs (Paddrarray_ref | Pintarray_ref) ->
463+
Kccall("caml_array_get_addr", 2)
464+
| Parraysets (Pgenarray_set _) -> Kccall("caml_array_set", 3)
465+
| Parraysets Pfloatarray_set -> Kccall("caml_floatarray_set", 3)
466+
| Parraysets (Paddrarray_set _ | Pintarray_set) ->
467+
Kccall("caml_array_set_addr", 3)
468+
| Parrayrefu (Pgenarray_ref _) -> Kccall("caml_array_unsafe_get", 2)
469+
| Parrayrefu (Pfloatarray_ref _) -> Kccall("caml_floatarray_unsafe_get", 2)
470+
| Parrayrefu (Paddrarray_ref | Pintarray_ref) -> Kgetvectitem
471+
| Parraysetu (Pgenarray_set _) -> Kccall("caml_array_unsafe_set", 3)
472+
| Parraysetu Pfloatarray_set -> Kccall("caml_floatarray_unsafe_set", 3)
473+
| Parraysetu (Paddrarray_set _ | Pintarray_set) -> Ksetvectitem
469474
| Pctconst c ->
470475
let const_name = match c with
471476
| Big_endian -> "big_endian"

0 commit comments

Comments
 (0)