aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2024-03-10 15:51:21 +0100
committerMarc Poulhiès <poulhies@adacore.com>2024-05-17 10:21:03 +0200
commit485d595d22c7800eb214034c9b58211ab232dbbf (patch)
treee403ca89655a38b7505f73e6874b2b7fb5dee4f8
parentd2a118197c767ccbd3905c14ff2ebe82bd0fe9ed (diff)
downloadgcc-485d595d22c7800eb214034c9b58211ab232dbbf.zip
gcc-485d595d22c7800eb214034c9b58211ab232dbbf.tar.gz
gcc-485d595d22c7800eb214034c9b58211ab232dbbf.tar.bz2
ada: Couple of adjustments coming from aliasing considerations
The first adjustment is to the expansion of implementation types for array types with peculiar index types, for which the aliased property set on the component of the original type must be copied; the implicit base type also needs to be properly marked if the implementation type is constrained. The second adjustment is to selected types in the runtime, which need to be marked with pragma Universal_Aliasing because of their special usage. gcc/ada/ * exp_pakd.adb (Create_Packed_Array_Impl_Type): For non-bit-packed array types, propagate the aliased property of the component. (Install_PAT): Set fields on the implicit base type of an array. * libgnat/a-stream.ads (private part): Add pragma Universal_Aliasing for Stream_Element. * libgnat/g-alleve.ads: Add pragma Universal_Aliasing for all the vector types. * libgnat/g-alleve__hard.ads: Likewise.
-rw-r--r--gcc/ada/exp_pakd.adb12
-rw-r--r--gcc/ada/libgnat/a-stream.ads3
-rw-r--r--gcc/ada/libgnat/g-alleve.ads54
-rw-r--r--gcc/ada/libgnat/g-alleve__hard.ads11
4 files changed, 71 insertions, 9 deletions
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index 3f26c35..59dfe5d 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -598,6 +598,14 @@ package body Exp_Pakd is
Set_Associated_Node_For_Itype (PAT, Typ);
Set_Original_Array_Type (PAT, Typ);
+ -- In the case of a constrained array type, also set fields on the
+ -- implicit base type built during the analysis of its declaration.
+
+ if Ekind (PAT) = E_Array_Subtype then
+ Set_Is_Packed_Array_Impl_Type (Etype (PAT), True);
+ Set_Original_Array_Type (Etype (PAT), Base_Type (Typ));
+ end if;
+
-- Propagate representation aspects
Set_Is_Atomic (PAT, Is_Atomic (Typ));
@@ -818,7 +826,7 @@ package body Exp_Pakd is
Subtype_Marks => Indexes,
Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present => False,
+ Aliased_Present => Has_Aliased_Components (Typ),
Subtype_Indication =>
New_Occurrence_Of (Ctyp, Loc)));
@@ -828,7 +836,7 @@ package body Exp_Pakd is
Discrete_Subtype_Definitions => Indexes,
Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present => False,
+ Aliased_Present => Has_Aliased_Components (Typ),
Subtype_Indication =>
New_Occurrence_Of (Ctyp, Loc)));
end if;
diff --git a/gcc/ada/libgnat/a-stream.ads b/gcc/ada/libgnat/a-stream.ads
index 0a0cabc..dcb5a9a 100644
--- a/gcc/ada/libgnat/a-stream.ads
+++ b/gcc/ada/libgnat/a-stream.ads
@@ -84,4 +84,7 @@ private
for Stream_Element_Array'Read use Read_SEA;
for Stream_Element_Array'Write use Write_SEA;
+ pragma Universal_Aliasing (Stream_Element);
+ -- This type is used to stream any other type
+
end Ada.Streams;
diff --git a/gcc/ada/libgnat/g-alleve.ads b/gcc/ada/libgnat/g-alleve.ads
index 0f3ec36..4e22a3e 100644
--- a/gcc/ada/libgnat/g-alleve.ads
+++ b/gcc/ada/libgnat/g-alleve.ads
@@ -313,22 +313,62 @@ private
---------------------------------------
-- We simply use the natural array definitions corresponding to each
- -- user-level vector type.
+ -- user-level vector type. We need to put pragma Universal_Aliasing
+ -- on these types because the common operations are implemented by
+ -- means of Unchecked_Conversion betwwen different representations.
- type LL_VUI is new VUI_View;
- type LL_VSI is new VSI_View;
- type LL_VBI is new VBI_View;
+ --------------------------
+ -- char Core Components --
+ --------------------------
+
+ type LL_VUC is new VUC_View;
+ pragma Universal_Aliasing (LL_VUC);
+
+ type LL_VSC is new VSC_View;
+ pragma Universal_Aliasing (LL_VSC);
+
+ type LL_VBC is new VBC_View;
+ pragma Universal_Aliasing (LL_VBC);
+
+ ---------------------------
+ -- short Core Components --
+ ---------------------------
type LL_VUS is new VUS_View;
+ pragma Universal_Aliasing (LL_VUS);
+
type LL_VSS is new VSS_View;
+ pragma Universal_Aliasing (LL_VSS);
+
type LL_VBS is new VBS_View;
+ pragma Universal_Aliasing (LL_VBS);
- type LL_VUC is new VUC_View;
- type LL_VSC is new VSC_View;
- type LL_VBC is new VBC_View;
+ -------------------------
+ -- int Core Components --
+ -------------------------
+
+ type LL_VUI is new VUI_View;
+ pragma Universal_Aliasing (LL_VUI);
+
+ type LL_VSI is new VSI_View;
+ pragma Universal_Aliasing (LL_VSI);
+
+ type LL_VBI is new VBI_View;
+ pragma Universal_Aliasing (LL_VBI);
+
+ ---------------------------
+ -- Float Core Components --
+ ---------------------------
type LL_VF is new VF_View;
+ pragma Universal_Aliasing (LL_VF);
+
+ ---------------------------
+ -- pixel Core Components --
+ ---------------------------
+
type LL_VP is new VP_View;
+ pragma Universal_Aliasing (LL_VP);
------------------------------------
-- Low level functional interface --
diff --git a/gcc/ada/libgnat/g-alleve__hard.ads b/gcc/ada/libgnat/g-alleve__hard.ads
index 5a311c7..88a73b3 100644
--- a/gcc/ada/libgnat/g-alleve__hard.ads
+++ b/gcc/ada/libgnat/g-alleve__hard.ads
@@ -326,16 +326,19 @@ private
type LL_VUC is array (1 .. 16) of unsigned_char;
for LL_VUC'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VUC, "vector_type");
+ pragma Universal_Aliasing (LL_VUC);
pragma Suppress (All_Checks, LL_VUC);
type LL_VSC is array (1 .. 16) of signed_char;
for LL_VSC'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VSC, "vector_type");
+ pragma Universal_Aliasing (LL_VSC);
pragma Suppress (All_Checks, LL_VSC);
type LL_VBC is array (1 .. 16) of unsigned_char;
for LL_VBC'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VBC, "vector_type");
+ pragma Universal_Aliasing (LL_VBC);
pragma Suppress (All_Checks, LL_VBC);
---------------------------
@@ -345,16 +348,19 @@ private
type LL_VUS is array (1 .. 8) of unsigned_short;
for LL_VUS'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VUS, "vector_type");
+ pragma Universal_Aliasing (LL_VUS);
pragma Suppress (All_Checks, LL_VUS);
type LL_VSS is array (1 .. 8) of signed_short;
for LL_VSS'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VSS, "vector_type");
+ pragma Universal_Aliasing (LL_VSS);
pragma Suppress (All_Checks, LL_VSS);
type LL_VBS is array (1 .. 8) of unsigned_short;
for LL_VBS'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VBS, "vector_type");
+ pragma Universal_Aliasing (LL_VBS);
pragma Suppress (All_Checks, LL_VBS);
-------------------------
@@ -364,16 +370,19 @@ private
type LL_VUI is array (1 .. 4) of unsigned_int;
for LL_VUI'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VUI, "vector_type");
+ pragma Universal_Aliasing (LL_VUI);
pragma Suppress (All_Checks, LL_VUI);
type LL_VSI is array (1 .. 4) of signed_int;
for LL_VSI'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VSI, "vector_type");
+ pragma Universal_Aliasing (LL_VSI);
pragma Suppress (All_Checks, LL_VSI);
type LL_VBI is array (1 .. 4) of unsigned_int;
for LL_VBI'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VBI, "vector_type");
+ pragma Universal_Aliasing (LL_VBI);
pragma Suppress (All_Checks, LL_VBI);
---------------------------
@@ -383,6 +392,7 @@ private
type LL_VF is array (1 .. 4) of Float;
for LL_VF'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VF, "vector_type");
+ pragma Universal_Aliasing (LL_VF);
pragma Suppress (All_Checks, LL_VF);
---------------------------
@@ -392,6 +402,7 @@ private
type LL_VP is array (1 .. 8) of pixel;
for LL_VP'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VP, "vector_type");
+ pragma Universal_Aliasing (LL_VP);
pragma Suppress (All_Checks, LL_VP);
------------------------------------