OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_aggr.adb, [...]: Change name Packed_Array_Type to Packed_Array_Impl_Type. 

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, layout.adb, sem_type.adb,
	exp_util.adb, exp_attr.adb, einfo.adb, einfo.ads, exp_pakd.adb,
	checks.adb, exp_pakd.ads, freeze.adb, sem_util.adb, exp_dbug.adb,
	exp_dbug.ads, exp_ch4.adb, sem_ch8.adb, exp_aggr.adb, sem_eval.adb,
	sem_ch13.adb: Change name Packed_Array_Type to Packed_Array_Impl_Type.

From-SVN: r212797
This commit is contained in:
Robert Dewar 2014-07-18 09:48:47 +00:00 committed by Arnaud Charlet
parent 5aa0548d68
commit 8ca597af97
22 changed files with 159 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2014-07-18 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, layout.adb, sem_type.adb,
exp_util.adb, exp_attr.adb, einfo.adb, einfo.ads, exp_pakd.adb,
checks.adb, exp_pakd.ads, freeze.adb, sem_util.adb, exp_dbug.adb,
exp_dbug.ads, exp_ch4.adb, sem_ch8.adb, exp_aggr.adb, sem_eval.adb,
sem_ch13.adb: Change name Packed_Array_Type to Packed_Array_Impl_Type.
2014-07-18 Robert Dewar <dewar@adacore.com>
* lib-writ.adb, makeutl.adb, ali.ads: Minor reformatting.

4
gcc/ada/checks.adb
View File

@ -5307,7 +5307,7 @@ package body Checks is
-- so they are also always valid (in particular, the unused bits can be
-- random rubbish without affecting the validity of the array value).
if not Is_Scalar_Type (Typ) or else Is_Packed_Array_Type (Typ) then
if not Is_Scalar_Type (Typ) or else Is_Packed_Array_Impl_Type (Typ) then
return True;
-- If no validity checking, then everything is considered valid
@ -6526,7 +6526,7 @@ package body Checks is
if Analyzed (PV)
and then Nkind (PV) = N_Indexed_Component
and then Present (Packed_Array_Type (Etype (Prefix (PV))))
and then Present (Packed_Array_Impl_Type (Etype (Prefix (PV))))
then
Set_Analyzed (PV, False);
end if;

24
gcc/ada/einfo.adb
View File

@ -211,7 +211,7 @@ package body Einfo is
-- Generic_Renamings Elist23
-- Inner_Instances Elist23
-- Limited_View Node23
-- Packed_Array_Type Node23
-- Packed_Array_Impl_Type Node23
-- Protection_Object Node23
-- Stored_Constraint Elist23
@ -415,7 +415,7 @@ package body Einfo is
-- Has_Aliased_Components Flag135
-- No_Strict_Aliasing Flag136
-- Is_Machine_Code_Subprogram Flag137
-- Is_Packed_Array_Type Flag138
-- Is_Packed_Array_Impl_Type Flag138
-- Has_Biased_Representation Flag139
-- Has_Complex_Representation Flag140
@ -2201,10 +2201,10 @@ package body Einfo is
return Flag51 (Implementation_Base_Type (Id));
end Is_Packed;
function Is_Packed_Array_Type (Id : E) return B is
function Is_Packed_Array_Impl_Type (Id : E) return B is
begin
return Flag138 (Id);
end Is_Packed_Array_Type;
end Is_Packed_Array_Impl_Type;
function Is_Potentially_Use_Visible (Id : E) return B is
begin
@ -2656,11 +2656,11 @@ package body Einfo is
return Node26 (Id);
end Package_Instantiation;
function Packed_Array_Type (Id : E) return E is
function Packed_Array_Impl_Type (Id : E) return E is
begin
pragma Assert (Is_Array_Type (Id));
return Node23 (Id);
end Packed_Array_Type;
end Packed_Array_Impl_Type;
function Parent_Subtype (Id : E) return E is
begin
@ -4946,10 +4946,10 @@ package body Einfo is
Set_Flag51 (Id, V);
end Set_Is_Packed;
procedure Set_Is_Packed_Array_Type (Id : E; V : B := True) is
procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True) is
begin
Set_Flag138 (Id, V);
end Set_Is_Packed_Array_Type;
end Set_Is_Packed_Array_Impl_Type;
procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
begin
@ -5414,11 +5414,11 @@ package body Einfo is
Set_Node26 (Id, V);
end Set_Package_Instantiation;
procedure Set_Packed_Array_Type (Id : E; V : E) is
procedure Set_Packed_Array_Impl_Type (Id : E; V : E) is
begin
pragma Assert (Is_Array_Type (Id));
Set_Node23 (Id, V);
end Set_Packed_Array_Type;
end Set_Packed_Array_Impl_Type;
procedure Set_Parent_Subtype (Id : E; V : E) is
begin
@ -8325,7 +8325,7 @@ package body Einfo is
W ("Is_Optional_Parameter", Flag134 (Id));
W ("Is_Package_Body_Entity", Flag160 (Id));
W ("Is_Packed", Flag51 (Id));
W ("Is_Packed_Array_Type", Flag138 (Id));
W ("Is_Packed_Array_Impl_Type", Flag138 (Id));
W ("Is_Potentially_Use_Visible", Flag9 (Id));
W ("Is_Predicate_Function", Flag255 (Id));
W ("Is_Predicate_Function_M", Flag256 (Id));
@ -9277,7 +9277,7 @@ package body Einfo is
Write_Str ("Inner_Instances");
when Array_Kind =>
Write_Str ("Packed_Array_Type");
Write_Str ("Packed_Array_Impl_Type");
when Entry_Kind =>
Write_Str ("Protection_Object");

44
gcc/ada/einfo.ads
View File

@ -2706,16 +2706,16 @@ package Einfo is
-- Is_Packed_Array (synth)
-- Applies to all entities, true if entity is for a packed array.
-- Is_Packed_Array_Type (Flag138)
-- Is_Packed_Array_Impl_Type (Flag138)
-- Defined in all entities. This flag is set on the entity for the type
-- used to implement a packed array (either a modular type, or a subtype
-- of Packed_Bytes{1,2,4} as appropriate). The flag is set if and only
-- if the type appears in the Packed_Array_Type field of some other type
-- if the type appears in the Packed_Array_Impl_Type field of some other
-- entity. It is used by the backend to activate the special processing
-- for such types (unchecked conversions that would not otherwise be
-- allowed are allowed for such types). If the Is_Packed_Array_Type flag
-- is set in an entity, then the Original_Array_Type field of this entity
-- points to the array type for which this is the packed array type.
-- allowed are allowed for such types). If Is_Packed_Array_Impl_Type is
-- set in an entity, then the Original_Array_Type field of this entity
-- points to the array type for which this is the Packed_Array_Impl_Type.
-- Is_Potentially_Use_Visible (Flag9)
-- Defined in all entities. Set if entity is potentially use visible,
@ -3402,8 +3402,8 @@ package Einfo is
-- subprogram type.
-- Original_Array_Type (Node21)
-- Defined in modular types and array types and subtypes. Set only
-- if the Is_Packed_Array_Type flag is set, indicating that the type
-- Defined in modular types and array types and subtypes. Set only if
-- the Is_Packed_Array_Impl_Type flag is set, indicating that the type
-- is the implementation type for a packed array, and in this case it
-- points to the original array type for which this is the packed
-- array implementation type.
@ -3452,7 +3452,7 @@ package Einfo is
-- it should be set in all cases, including package entities associated
-- with formal packages. ???
-- Packed_Array_Type (Node23)
-- Packed_Array_Impl_Type (Node23)
-- Defined in array types and subtypes, including the string literal
-- subtype case, if the corresponding type is packed (either bit packed
-- or packed to eliminate holes in non-contiguous enumeration type index
@ -3460,9 +3460,9 @@ package Einfo is
-- is either a modular type for short static arrays, or an array of
-- System.Unsigned. Note that in some situations (internal types, and
-- references to fields of variant records), it is not always possible
-- to construct this type in advance of its use. If Packed_Array_Type
-- is empty, then the necessary type is declared on the fly for each
-- reference to the array.
-- to construct this type in advance of its use. If this field is empty,
-- then the necessary type is declared on the fly for each reference to
-- the array.
-- Parameter_Mode (synthesized)
-- Applies to formal parameter entities. This is a synonym for Ekind,
@ -5098,7 +5098,7 @@ package Einfo is
-- Is_Limited_Record (Flag25)
-- Is_Obsolescent (Flag153)
-- Is_Package_Body_Entity (Flag160)
-- Is_Packed_Array_Type (Flag138)
-- Is_Packed_Array_Impl_Type (Flag138)
-- Is_Potentially_Use_Visible (Flag9)
-- Is_Preelaborated (Flag59)
-- Is_Primitive_Wrapper (Flag195)
@ -5309,7 +5309,7 @@ package Einfo is
-- Component_Type (Node20) (base type only)
-- Original_Array_Type (Node21)
-- Component_Size (Uint22) (base type only)
-- Packed_Array_Type (Node23)
-- Packed_Array_Impl_Type (Node23)
-- Related_Array_Object (Node25)
-- Component_Alignment (special) (base type only)
-- Has_Component_Size_Clause (Flag68) (base type only)
@ -6024,7 +6024,7 @@ package Einfo is
-- String_Literal_Low_Bound (Node15)
-- String_Literal_Length (Uint16)
-- First_Index (Node17) (always Empty)
-- Packed_Array_Type (Node23)
-- Packed_Array_Impl_Type (Node23)
-- (plus type attributes)
-- E_Subprogram_Body
@ -6625,7 +6625,7 @@ package Einfo is
function Is_Optional_Parameter (Id : E) return B;
function Is_Package_Body_Entity (Id : E) return B;
function Is_Packed (Id : E) return B;
function Is_Packed_Array_Type (Id : E) return B;
function Is_Packed_Array_Impl_Type (Id : E) return B;
function Is_Potentially_Use_Visible (Id : E) return B;
function Is_Predicate_Function (Id : E) return B;
function Is_Predicate_Function_M (Id : E) return B;
@ -6705,7 +6705,7 @@ package Einfo is
function Overridden_Operation (Id : E) return E;
function PPC_Wrapper (Id : E) return E;
function Package_Instantiation (Id : E) return N;
function Packed_Array_Type (Id : E) return E;
function Packed_Array_Impl_Type (Id : E) return E;
function Parent_Subtype (Id : E) return E;
function Part_Of_Constituents (Id : E) return L;
function Postcondition_Proc (Id : E) return E;
@ -7256,7 +7256,7 @@ package Einfo is
procedure Set_Is_Optional_Parameter (Id : E; V : B := True);
procedure Set_Is_Package_Body_Entity (Id : E; V : B := True);
procedure Set_Is_Packed (Id : E; V : B := True);
procedure Set_Is_Packed_Array_Type (Id : E; V : B := True);
procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True);
procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True);
procedure Set_Is_Predicate_Function (Id : E; V : B := True);
procedure Set_Is_Predicate_Function_M (Id : E; V : B := True);
@ -7336,7 +7336,7 @@ package Einfo is
procedure Set_Overridden_Operation (Id : E; V : E);
procedure Set_PPC_Wrapper (Id : E; V : E);
procedure Set_Package_Instantiation (Id : E; V : N);
procedure Set_Packed_Array_Type (Id : E; V : E);
procedure Set_Packed_Array_Impl_Type (Id : E; V : E);
procedure Set_Parent_Subtype (Id : E; V : E);
procedure Set_Part_Of_Constituents (Id : E; V : L);
procedure Set_Postcondition_Proc (Id : E; V : E);
@ -8026,7 +8026,7 @@ package Einfo is
pragma Inline (Is_Overloadable);
pragma Inline (Is_Package_Body_Entity);
pragma Inline (Is_Packed);
pragma Inline (Is_Packed_Array_Type);
pragma Inline (Is_Packed_Array_Impl_Type);
pragma Inline (Is_Potentially_Use_Visible);
pragma Inline (Is_Predicate_Function);
pragma Inline (Is_Predicate_Function_M);
@ -8116,7 +8116,7 @@ package Einfo is
pragma Inline (Overridden_Operation);
pragma Inline (PPC_Wrapper);
pragma Inline (Package_Instantiation);
pragma Inline (Packed_Array_Type);
pragma Inline (Packed_Array_Impl_Type);
pragma Inline (Parameter_Mode);
pragma Inline (Parent_Subtype);
pragma Inline (Part_Of_Constituents);
@ -8467,7 +8467,7 @@ package Einfo is
pragma Inline (Set_Is_Optional_Parameter);
pragma Inline (Set_Is_Package_Body_Entity);
pragma Inline (Set_Is_Packed);
pragma Inline (Set_Is_Packed_Array_Type);
pragma Inline (Set_Is_Packed_Array_Impl_Type);
pragma Inline (Set_Is_Potentially_Use_Visible);
pragma Inline (Set_Is_Predicate_Function);
pragma Inline (Set_Is_Predicate_Function_M);
@ -8547,7 +8547,7 @@ package Einfo is
pragma Inline (Set_Overridden_Operation);
pragma Inline (Set_PPC_Wrapper);
pragma Inline (Set_Package_Instantiation);
pragma Inline (Set_Packed_Array_Type);
pragma Inline (Set_Packed_Array_Impl_Type);
pragma Inline (Set_Parent_Subtype);
pragma Inline (Set_Part_Of_Constituents);
pragma Inline (Set_Postcondition_Proc);

19
gcc/ada/exp_aggr.adb
View File

@ -1607,7 +1607,7 @@ package body Exp_Aggr is
if Present (Typ)
and then Is_Bit_Packed_Array (Typ)
and then Is_Modular_Integer_Type (Packed_Array_Type (Typ))
and then Is_Modular_Integer_Type (Packed_Array_Impl_Type (Typ))
then
Append_To (New_Code,
Make_Assignment_Statement (Loc,
@ -6317,14 +6317,14 @@ package body Exp_Aggr is
end if;
-- If two-dimensional, check whether it can be folded, and transformed
-- into a one-dimensional aggregate for the Packed_Array_Type of the
-- original type.
-- into a one-dimensional aggregate for the Packed_Array_Impl_Type of
-- the original type.
if Number_Dimensions (Typ) = 2 then
return Two_Dim_Packed_Array_Handled (N);
end if;
if not Is_Modular_Integer_Type (Packed_Array_Type (Typ)) then
if not Is_Modular_Integer_Type (Packed_Array_Impl_Type (Typ)) then
return False;
end if;
@ -6523,7 +6523,7 @@ package body Exp_Aggr is
Unchecked_Convert_To (Typ,
Make_Qualified_Expression (Loc,
Subtype_Mark =>
New_Occurrence_Of (Packed_Array_Type (Typ), Loc),
New_Occurrence_Of (Packed_Array_Impl_Type (Typ), Loc),
Expression => Lit)));
Analyze_And_Resolve (N, Typ);
@ -6705,10 +6705,11 @@ package body Exp_Aggr is
function Two_Dim_Packed_Array_Handled (N : Node_Id) return Boolean is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Ctyp : constant Entity_Id := Component_Type (Typ);
Comp_Size : constant Int := UI_To_Int (Component_Size (Typ));
Packed_Array : constant Entity_Id := Packed_Array_Type (Base_Type (Typ));
Typ : constant Entity_Id := Etype (N);
Ctyp : constant Entity_Id := Component_Type (Typ);
Comp_Size : constant Int := UI_To_Int (Component_Size (Typ));
Packed_Array : constant Entity_Id :=
Packed_Array_Impl_Type (Base_Type (Typ));
One_Comp : Node_Id;
-- Expression in original aggregate

16
gcc/ada/exp_attr.adb
View File

@ -2863,7 +2863,7 @@ package body Exp_Attr is
when Attribute_First =>
-- If the prefix type is a constrained packed array type which
-- already has a Packed_Array_Type representation defined, then
-- already has a Packed_Array_Impl_Type representation defined, then
-- replace this attribute with a direct reference to 'First of the
-- appropriate index subtype (since otherwise the back end will try
-- to give us the value of 'First for this implementation type).
@ -3526,7 +3526,7 @@ package body Exp_Attr is
when Attribute_Last =>
-- If the prefix type is a constrained packed array type which
-- already has a Packed_Array_Type representation defined, then
-- already has a Packed_Array_Impl_Type representation defined, then
-- replace this attribute with a direct reference to 'Last of the
-- appropriate index subtype (since otherwise the back end will try
-- to give us the value of 'Last for this implementation type).
@ -3676,11 +3676,11 @@ package body Exp_Attr is
return;
-- If the prefix type is a constrained packed array type which
-- already has a Packed_Array_Type representation defined, then
-- replace this attribute with a direct reference to 'Range_Length
-- of the appropriate index subtype (since otherwise the back end
-- will try to give us the value of 'Length for this
-- implementation type).
-- already has a Packed_Array_Impl_Type representation defined,
-- then replace this attribute with a reference to 'Range_Length
-- of the appropriate index subtype (since otherwise the
-- back end will try to give us the value of 'Length for
-- this implementation type).s
elsif Is_Constrained (Ptyp) then
Rewrite (N,
@ -7663,7 +7663,7 @@ package body Exp_Attr is
return Is_Array_Type (Arr)
and then Is_Constrained (Arr)
and then Present (Packed_Array_Type (Arr));
and then Present (Packed_Array_Impl_Type (Arr));
end Is_Constrained_Packed_Array;
----------------------------------------

6
gcc/ada/exp_ch4.adb
View File

@ -6189,9 +6189,9 @@ package body Exp_Ch4 is
return;
end if;
-- For a reference to a component of a bit packed array, we have to
-- convert it to a reference to the corresponding Packed_Array_Type.
-- We only want to do this for simple references, and not for:
-- For a reference to a component of a bit packed array, we convert it
-- to a reference to the corresponding Packed_Array_Impl_Type. We only
-- want to do this for simple references, and not for:
-- Left side of assignment, or prefix of left side of assignment, or
-- prefix of the prefix, to handle packed arrays of packed arrays,

8
gcc/ada/exp_ch5.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -503,9 +503,9 @@ package body Exp_Ch5 is
Des_Type : Entity_Id;
begin
if Present (Packed_Array_Type (Typ))
and then Is_Array_Type (Packed_Array_Type (Typ))
and then not Is_Constrained (Packed_Array_Type (Typ))
if Present (Packed_Array_Impl_Type (Typ))
and then Is_Array_Type (Packed_Array_Impl_Type (Typ))
and then not Is_Constrained (Packed_Array_Impl_Type (Typ))
then
return True;

8
gcc/ada/exp_dbug.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -958,10 +958,10 @@ package body Exp_Dbug is
end Get_Secondary_DT_External_Name;
---------------------------------
-- Make_Packed_Array_Type_Name --
-- Make_Packed_Array_Impl_Type_Name --
---------------------------------
function Make_Packed_Array_Type_Name
function Make_Packed_Array_Impl_Type_Name
(Typ : Entity_Id;
Csize : Uint)
return Name_Id
@ -971,7 +971,7 @@ package body Exp_Dbug is
Add_Str_To_Name_Buffer ("___XP");
Add_Uint_To_Buffer (Csize);
return Name_Find;
end Make_Packed_Array_Type_Name;
end Make_Packed_Array_Impl_Type_Name;
-----------------------------------
-- Output_Homonym_Numbers_Suffix --

4
gcc/ada/exp_dbug.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -1206,7 +1206,7 @@ package Exp_Dbug is
-- Subprograms for Handling Packed Array Type Names --
------------------------------------------------------
function Make_Packed_Array_Type_Name
function Make_Packed_Array_Impl_Type_Name
(Typ : Entity_Id;
Csize : Uint)
return Name_Id;

44
gcc/ada/exp_pakd.adb
View File

@ -519,7 +519,7 @@ package body Exp_Pakd is
--
-- Atyp is the constrained array type (the actual subtype has been
-- computed if necessary to obtain the constraints, but this is still
-- the original array type, not the Packed_Array_Type value).
-- the original array type, not the Packed_Array_Impl_Type value).
--
-- Obj is the object which is to be indexed. It is always of type Atyp.
--
@ -767,7 +767,7 @@ package body Exp_Pakd is
begin
Convert_To_Actual_Subtype (Aexp);
Act_ST := Underlying_Type (Etype (Aexp));
Create_Packed_Array_Type (Act_ST);
Create_Packed_Array_Impl_Type (Act_ST);
-- Just replace the etype with the packed array type. This works because
-- the expression will not be further analyzed, and Gigi considers the
@ -784,7 +784,7 @@ package body Exp_Pakd is
-- more complex packed expressions in actuals is confused. Probably the
-- problem only remains for actuals in calls.
Set_Etype (Aexp, Packed_Array_Type (Act_ST));
Set_Etype (Aexp, Packed_Array_Impl_Type (Act_ST));
if Is_Entity_Name (Aexp)
or else
@ -797,10 +797,10 @@ package body Exp_Pakd is
end Convert_To_PAT_Type;
------------------------------
-- Create_Packed_Array_Type --
-- Create_Packed_Array_Impl_Type --
------------------------------
procedure Create_Packed_Array_Type (Typ : Entity_Id) is
procedure Create_Packed_Array_Impl_Type (Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
Ctyp : constant Entity_Id := Component_Type (Typ);
Csize : constant Uint := Component_Size (Typ);
@ -865,7 +865,7 @@ package body Exp_Pakd is
end if;
Set_Is_Itype (PAT, True);
Set_Packed_Array_Type (Typ, PAT);
Set_Packed_Array_Impl_Type (Typ, PAT);
Analyze (Decl, Suppress => All_Checks);
if Pushed_Scope then
@ -891,7 +891,7 @@ package body Exp_Pakd is
Init_Alignment (PAT);
Set_Parent (PAT, Empty);
Set_Associated_Node_For_Itype (PAT, Typ);
Set_Is_Packed_Array_Type (PAT, True);
Set_Is_Packed_Array_Impl_Type (PAT, True);
Set_Original_Array_Type (PAT, Typ);
-- For a non-bit-packed array, propagate reverse storage order
@ -942,12 +942,12 @@ package body Exp_Pakd is
end if;
end Set_PB_Type;
-- Start of processing for Create_Packed_Array_Type
-- Start of processing for Create_Packed_Array_Impl_Type
begin
-- If we already have a packed array type, nothing to do
if Present (Packed_Array_Type (Typ)) then
if Present (Packed_Array_Impl_Type (Typ)) then
return;
end if;
@ -963,9 +963,9 @@ package body Exp_Pakd is
if Present (Ancest)
and then Is_Array_Type (Ancest)
and then Is_Constrained (Ancest)
and then Present (Packed_Array_Type (Ancest))
and then Present (Packed_Array_Impl_Type (Ancest))
then
Set_Packed_Array_Type (Typ, Packed_Array_Type (Ancest));
Set_Packed_Array_Impl_Type (Typ, Packed_Array_Impl_Type (Ancest));
return;
end if;
end if;
@ -1015,7 +1015,7 @@ package body Exp_Pakd is
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), 'P'));
Set_Packed_Array_Type (Typ, PAT);
Set_Packed_Array_Impl_Type (Typ, PAT);
declare
Indexes : constant List_Id := New_List;
@ -1114,7 +1114,7 @@ package body Exp_Pakd is
-- Set type as packed array type and install it
Set_Is_Packed_Array_Type (PAT);
Set_Is_Packed_Array_Impl_Type (PAT);
Install_PAT;
return;
@ -1124,9 +1124,9 @@ package body Exp_Pakd is
elsif not Is_Constrained (Typ) then
PAT :=
Make_Defining_Identifier (Loc,
Chars => Make_Packed_Array_Type_Name (Typ, Csize));
Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
Set_Packed_Array_Type (Typ, PAT);
Set_Packed_Array_Impl_Type (Typ, PAT);
Set_PB_Type;
Decl :=
@ -1148,9 +1148,9 @@ package body Exp_Pakd is
else
PAT :=
Make_Defining_Identifier (Loc,
Chars => Make_Packed_Array_Type_Name (Typ, Csize));
Chars => Make_Packed_Array_Impl_Type_Name (Typ, Csize));
Set_Packed_Array_Type (Typ, PAT);
Set_Packed_Array_Impl_Type (Typ, PAT);
-- Build an expression for the length of the array in bits.
-- This is the product of the length of each of the dimensions
@ -1350,7 +1350,7 @@ package body Exp_Pakd is
Set_Must_Be_On_Byte_Boundary (Typ);
end if;
end if;
end Create_Packed_Array_Type;
end Create_Packed_Array_Impl_Type;
-----------------------------------
-- Expand_Bit_Packed_Element_Set --
@ -1424,7 +1424,7 @@ package body Exp_Pakd is
Obj := Relocate_Node (Prefix (Lhs));
Convert_To_Actual_Subtype (Obj);
Atyp := Etype (Obj);
PAT := Packed_Array_Type (Atyp);
PAT := Packed_Array_Impl_Type (Atyp);
Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (Atyp));
@ -2048,7 +2048,7 @@ package body Exp_Pakd is
Obj := Relocate_Node (Prefix (N));
Convert_To_Actual_Subtype (Obj);
Atyp := Etype (Obj);
PAT := Packed_Array_Type (Atyp);
PAT := Packed_Array_Impl_Type (Atyp);
Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (Atyp));
@ -2696,7 +2696,7 @@ package body Exp_Pakd is
-- with its actual subtype. This actual subtype will have a packed array
-- type with appropriate bounds.
if not Is_Constrained (Packed_Array_Type (Etype (Pfx))) then
if not Is_Constrained (Packed_Array_Impl_Type (Etype (Pfx))) then
Convert_To_Actual_Subtype (Pfx);
end if;
@ -2725,7 +2725,7 @@ package body Exp_Pakd is
Rewrite (N,
Make_Indexed_Component (Sloc (N),
Prefix =>
Unchecked_Convert_To (Packed_Array_Type (Etype (Pfx)), Pfx),
Unchecked_Convert_To (Packed_Array_Impl_Type (Etype (Pfx)), Pfx),
Expressions => Exprs));
Analyze_And_Resolve (N, Typ);

14
gcc/ada/exp_pakd.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -34,8 +34,8 @@ package Exp_Pakd is
-------------------------------------
-- When a packed array (sub)type is frozen, we create a corresponding
-- type that will be used to hold the bits of the packed value, and
-- store the entity for this type in the Packed_Array_Type field of the
-- type that will be used to hold the bits of the packed value, and store
-- the entity for this type in the Packed_Array_Impl_Type field of the
-- E_Array_Type or E_Array_Subtype entity for the packed array.
-- This packed array type has the name xxxPn, where xxx is the name
@ -207,11 +207,11 @@ package Exp_Pakd is
-- Subprograms --
-----------------
procedure Create_Packed_Array_Type (Typ : Entity_Id);
procedure Create_Packed_Array_Impl_Type (Typ : Entity_Id);
-- Typ is a array type or subtype to which pragma Pack applies. If the
-- Packed_Array_Type field of Typ is already set, then the call has no
-- effect, otherwise a suitable type or subtype is created and stored
-- in the Packed_Array_Type field of Typ. This created type is an Itype
-- Packed_Array_Impl_Type field of Typ is already set, then the call has
-- no effect, otherwise a suitable type or subtype is created and stored in
-- the Packed_Array_Impl_Type field of Typ. This created type is an Itype
-- so that Gigi will simply elaborate and freeze the type on first use
-- (which is typically the definition of the corresponding array type).
--

14
gcc/ada/exp_util.adb
View File

@ -6272,8 +6272,10 @@ package body Exp_Util is
elsif Esize (Typ) /= 0 and then Esize (Typ) <= 256 then
return False;
elsif Is_Array_Type (Typ) and then Present (Packed_Array_Type (Typ)) then
return May_Generate_Large_Temp (Packed_Array_Type (Typ));
elsif Is_Array_Type (Typ)
and then Present (Packed_Array_Impl_Type (Typ))
then
return May_Generate_Large_Temp (Packed_Array_Impl_Type (Typ));
-- We could do more here to find other small types ???
@ -6403,7 +6405,7 @@ package body Exp_Util is
or else Is_Access_Type (Typ)
or else
(Is_Bit_Packed_Array (Typ)
and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
and then Is_Modular_Integer_Type (Packed_Array_Impl_Type (Typ)))
then
return False;
@ -7283,7 +7285,7 @@ package body Exp_Util is
begin
return Is_Scalar_Type (UT)
or else (Is_Bit_Packed_Array (UT)
and then Is_Scalar_Type (Packed_Array_Type (UT)));
and then Is_Scalar_Type (Packed_Array_Impl_Type (UT)));
end Represented_As_Scalar;
------------------------------
@ -7713,8 +7715,8 @@ package body Exp_Util is
-- Conversions to and from packed array types are always ignored and
-- hence are safe.
elsif Is_Packed_Array_Type (Otyp)
or else Is_Packed_Array_Type (Ityp)
elsif Is_Packed_Array_Impl_Type (Otyp)
or else Is_Packed_Array_Impl_Type (Ityp)
then
return True;
end if;

25
gcc/ada/freeze.adb
View File

@ -918,7 +918,7 @@ package body Freeze is
-- directly, where all the information is at hand ???
if Is_Array_Type (Etype (Comp))
and then Present (Packed_Array_Type (Etype (Comp)))
and then Present (Packed_Array_Impl_Type (Etype (Comp)))
then
declare
Ocomp : constant Entity_Id :=
@ -975,9 +975,10 @@ package body Freeze is
if Is_Elementary_Type (Ctyp)
or else (Is_Array_Type (Ctyp)
and then Present (Packed_Array_Type (Ctyp))
and then Present
(Packed_Array_Impl_Type (Ctyp))
and then Is_Modular_Integer_Type
(Packed_Array_Type (Ctyp)))
(Packed_Array_Impl_Type (Ctyp)))
then
-- Packed size unknown if we have an atomic type
-- or a by reference type, since the back end
@ -2523,27 +2524,27 @@ package body Freeze is
if Is_Packed (Arr)
and then Ekind (Arr) /= E_String_Literal_Subtype
then
Create_Packed_Array_Type (Arr);
Freeze_And_Append (Packed_Array_Type (Arr), N, Result);
Create_Packed_Array_Impl_Type (Arr);
Freeze_And_Append (Packed_Array_Impl_Type (Arr), N, Result);
-- Size information of packed array type is copied to the array
-- type, since this is really the representation. But do not
-- override explicit existing size values. If the ancestor subtype
-- is constrained the packed_array_type will be inherited from it,
-- but the size may have been provided already, and must not be
-- overridden either.
-- is constrained the Packed_Array_Impl_Type will be inherited
-- from it, but the size may have been provided already, and
-- must not be overridden either.
if not Has_Size_Clause (Arr)
and then
(No (Ancestor_Subtype (Arr))
or else not Has_Size_Clause (Ancestor_Subtype (Arr)))
then
Set_Esize (Arr, Esize (Packed_Array_Type (Arr)));
Set_RM_Size (Arr, RM_Size (Packed_Array_Type (Arr)));
Set_Esize (Arr, Esize (Packed_Array_Impl_Type (Arr)));
Set_RM_Size (Arr, RM_Size (Packed_Array_Impl_Type (Arr)));
end if;
if not Has_Alignment_Clause (Arr) then
Set_Alignment (Arr, Alignment (Packed_Array_Type (Arr)));
Set_Alignment (Arr, Alignment (Packed_Array_Impl_Type (Arr)));
end if;
end if;
@ -7321,7 +7322,7 @@ package body Freeze is
then
exit;
elsif Is_Array_Type (Etype (Comp))
and then Present (Packed_Array_Type (Etype (Comp)))
and then Present (Packed_Array_Impl_Type (Etype (Comp)))
then
Error_Msg_NE
("\packed array component& " &

12
gcc/ada/layout.adb
View File

@ -1724,7 +1724,7 @@ package body Layout is
elsif Is_Array_Type (Ctyp)
and then Is_Bit_Packed_Array (Ctyp)
and then Is_Modular_Integer_Type (Packed_Array_Type (Ctyp))
and then Is_Modular_Integer_Type (Packed_Array_Impl_Type (Ctyp))
then
Forc := False;
@ -2624,9 +2624,11 @@ package body Layout is
-- array type if a packed array type has been created and the fields
-- are not currently set.
if Is_Array_Type (E) and then Present (Packed_Array_Type (E)) then
if Is_Array_Type (E)
and then Present (Packed_Array_Impl_Type (E))
then
declare
PAT : constant Entity_Id := Packed_Array_Type (E);
PAT : constant Entity_Id := Packed_Array_Impl_Type (E);
begin
if Unknown_Esize (E) then
@ -3169,7 +3171,9 @@ package body Layout is
-- front end layout, because otherwise this is always handled in the
-- backend.
if Is_Packed_Array_Type (E) and then not Frontend_Layout_On_Target then
if Is_Packed_Array_Impl_Type (E)
and then not Frontend_Layout_On_Target
then
return;
-- If there is an alignment clause, then we respect it

2
gcc/ada/sem_aggr.adb
View File

@ -610,7 +610,7 @@ package body Sem_Aggr is
and then Size_Known_At_Compile_Time (Component_Type (Typ)));
-- We always need a freeze node for a packed array subtype, so that we
-- can build the Packed_Array_Type corresponding to the subtype. If
-- can build the Packed_Array_Impl_Type corresponding to the subtype. If
-- expansion is disabled, the packed array subtype is not built, and we
-- must not generate a freeze node for the type, or else it will appear
-- incomplete to gigi.

3
gcc/ada/sem_ch13.adb
View File

@ -890,7 +890,8 @@ package body Sem_Ch13 is
if Is_Bit_Packed_Array (P) then
Set_Is_Bit_Packed_Array (Base_Type (E));
Set_Packed_Array_Type (E, Packed_Array_Type (P));
Set_Packed_Array_Impl_Type
(E, Packed_Array_Impl_Type (P));
end if;
end if;

20
gcc/ada/sem_ch3.adb
View File

@ -5165,7 +5165,7 @@ package body Sem_Ch3 is
Set_Component_Type (Implicit_Base, Element_Type);
Set_Has_Task (Implicit_Base, Has_Task (Element_Type));
Set_Component_Size (Implicit_Base, Uint_0);
Set_Packed_Array_Type (Implicit_Base, Empty);
Set_Packed_Array_Impl_Type (Implicit_Base, Empty);
Set_Has_Controlled_Component
(Implicit_Base, Has_Controlled_Component
(Element_Type)
@ -5198,7 +5198,7 @@ package body Sem_Ch3 is
-- Common attributes for both cases
Set_Component_Type (Base_Type (T), Element_Type);
Set_Packed_Array_Type (T, Empty);
Set_Packed_Array_Impl_Type (T, Empty);
if Aliased_Present (Component_Definition (Def)) then
Check_SPARK_Restriction
@ -5269,7 +5269,9 @@ package body Sem_Ch3 is
-- types created for packed entities do not need such, they are
-- compatible with the user-defined type.
if Number_Dimensions (T) = 1 and then not Is_Packed_Array_Type (T) then
if Number_Dimensions (T) = 1
and then not Is_Packed_Array_Impl_Type (T)
then
New_Concatenation_Op (T);
end if;
@ -11473,13 +11475,13 @@ package body Sem_Ch3 is
Set_Is_Private_Composite (Def_Id, Is_Private_Composite (T));
Set_Is_Limited_Composite (Def_Id, Is_Limited_Composite (T));
-- A subtype does not inherit the packed_array_type of is parent. We
-- need to initialize the attribute because if Def_Id is previously
-- A subtype does not inherit the Packed_Array_Impl_Type of is parent.
-- We need to initialize the attribute because if Def_Id is previously
-- analyzed through a limited_with clause, it will have the attributes
-- of an incomplete type, one of which is an Elist that overlaps the
-- Packed_Array_Type field.
-- Packed_Array_Impl_Type field.
Set_Packed_Array_Type (Def_Id, Empty);
Set_Packed_Array_Impl_Type (Def_Id, Empty);
-- Build a freeze node if parent still needs one. Also make sure that
-- the Depends_On_Private status is set because the subtype will need
@ -11913,7 +11915,7 @@ package body Sem_Ch3 is
and then Is_Packed (Compon_Type)
and then Is_Frozen (Current_Scope)
then
Create_Packed_Array_Type (Array_Comp);
Create_Packed_Array_Impl_Type (Array_Comp);
end if;
return Array_Comp;
@ -12775,7 +12777,7 @@ package body Sem_Ch3 is
Set_Convention (T1, Convention (T2));
Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2));
Set_Is_Private_Composite (T1, Is_Private_Composite (T2));
Set_Packed_Array_Type (T1, Packed_Array_Type (T2));
Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2));
end Copy_Array_Subtype_Attributes;
-----------------------------------

2
gcc/ada/sem_ch8.adb
View File

@ -4767,7 +4767,7 @@ package body Sem_Ch8 is
if Is_Array_Type (Entyp)
and then Is_Packed (Entyp)
and then Present (Etype (N))
and then Etype (N) = Packed_Array_Type (Entyp)
and then Etype (N) = Packed_Array_Impl_Type (Entyp)
then
null;

6
gcc/ada/sem_eval.adb
View File

@ -780,7 +780,7 @@ package body Sem_Eval is
-- We do not attempt comparisons for packed arrays arrays represented as
-- modular types, where the semantics of comparison is quite different.
elsif Is_Packed_Array_Type (Ltyp)
elsif Is_Packed_Array_Impl_Type (Ltyp)
and then Is_Modular_Integer_Type (Ltyp)
then
return Unknown;
@ -1317,7 +1317,7 @@ package body Sem_Eval is
-- We might want to try to evaluate these at compile time one
-- day, but we do not make that attempt now.
if Is_Packed_Array_Type (Etype (Op)) then
if Is_Packed_Array_Impl_Type (Etype (Op)) then
return False;
end if;
@ -4620,7 +4620,7 @@ package body Sem_Eval is
then
if Nkind (Parent (N)) = N_Defining_Identifier
and then Is_Array_Type (Parent (N))
and then Present (Packed_Array_Type (Parent (N)))
and then Present (Packed_Array_Impl_Type (Parent (N)))
and then Present (First_Rep_Item (Parent (N)))
then
Error_Msg_N

6
gcc/ada/sem_type.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -1140,7 +1140,7 @@ package body Sem_Type is
elsif Is_Array_Type (T2)
and then Is_Packed (T2)
and then T1 = Packed_Array_Type (T2)
and then T1 = Packed_Array_Impl_Type (T2)
then
return True;
@ -1148,7 +1148,7 @@ package body Sem_Type is
elsif Is_Array_Type (T1)
and then Is_Packed (T1)
and then T2 = Packed_Array_Type (T1)
and then T2 = Packed_Array_Impl_Type (T1)
then
return True;

10
gcc/ada/sem_util.adb
View File

@ -13167,9 +13167,9 @@ package body Sem_Util is
end if;
if Is_Packed (New_Itype) then
Set_Packed_Array_Type (New_Itype,
Set_Packed_Array_Impl_Type (New_Itype,
Copy_Node_With_Replacement
(Packed_Array_Type (New_Itype)));
(Packed_Array_Impl_Type (New_Itype)));
end if;
end if;
end Copy_Itype_With_Replacement;
@ -13675,7 +13675,7 @@ package body Sem_Util is
end if;
if Is_Packed (Old_Itype) then
Visit_Field (Union_Id (Packed_Array_Type (Old_Itype)),
Visit_Field (Union_Id (Packed_Array_Impl_Type (Old_Itype)),
Old_Itype);
end if;
end if;
@ -16057,10 +16057,10 @@ package body Sem_Util is
-- also need it for the former if we need it for the latter.
if Is_Packed (T) then
Set_Debug_Info_Needed_If_Not_Set (Packed_Array_Type (T));
Set_Debug_Info_Needed_If_Not_Set (Packed_Array_Impl_Type (T));
end if;
if Is_Packed_Array_Type (T) then
if Is_Packed_Array_Impl_Type (T) then
Set_Debug_Info_Needed_If_Not_Set (Original_Array_Type (T));
end if;