mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 10:20:43 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_aggr.adb, [...]: Reorganize einfo/sem_aux, moving routines from einfo to sem_aux

Browse Source 
2009-04-09  Robert Dewar  <dewar@adacore.com>

	* sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, exp_atag.adb, layout.adb,
	sem_dist.adb, exp_ch7.adb, sem_ch5.adb, sem_type.adb, exp_imgv.adb,
	exp_util.adb, sem_aux.adb, sem_aux.ads, exp_attr.adb, exp_ch9.adb,
	sem_ch7.adb, inline.adb, fe.h, sem_ch9.adb, exp_code.adb, einfo.adb,
	einfo.ads, exp_pakd.adb, checks.adb, sem_ch12.adb, exp_smem.adb,
	tbuild.adb, freeze.adb, sem_util.adb, sem_res.adb, sem_attr.adb,
	exp_dbug.adb, sem_case.adb, exp_tss.adb, exp_ch4.adb, exp_ch6.adb,
	sem_smem.adb, sem_ch4.adb, sem_mech.adb, sem_ch6.adb, exp_disp.adb,
	sem_ch8.adb, exp_aggr.adb, sem_eval.adb, sem_cat.adb, exp_dist.adb,
	sem_ch13.adb, exp_strm.adb, lib-xref.adb, sem_disp.adb, exp_ch3.adb:
	Reorganize einfo/sem_aux, moving routines from einfo to sem_aux

From-SVN: r145820
This commit is contained in:
Robert Dewar 2009-04-09 10:27:10 +00:00 committed by Arnaud Charlet
parent f17889b313
commit a4100e5582
52 changed files with 926 additions and 881 deletions

14
gcc/ada/ChangeLog

@ -1,3 +1,17 @@
2009-04-09 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, exp_atag.adb, layout.adb,
sem_dist.adb, exp_ch7.adb, sem_ch5.adb, sem_type.adb, exp_imgv.adb,
exp_util.adb, sem_aux.adb, sem_aux.ads, exp_attr.adb, exp_ch9.adb,
sem_ch7.adb, inline.adb, fe.h, sem_ch9.adb, exp_code.adb, einfo.adb,
einfo.ads, exp_pakd.adb, checks.adb, sem_ch12.adb, exp_smem.adb,
tbuild.adb, freeze.adb, sem_util.adb, sem_res.adb, sem_attr.adb,
exp_dbug.adb, sem_case.adb, exp_tss.adb, exp_ch4.adb, exp_ch6.adb,
sem_smem.adb, sem_ch4.adb, sem_mech.adb, sem_ch6.adb, exp_disp.adb,
sem_ch8.adb, exp_aggr.adb, sem_eval.adb, sem_cat.adb, exp_dist.adb,
sem_ch13.adb, exp_strm.adb, lib-xref.adb, sem_disp.adb, exp_ch3.adb:
Reorganize einfo/sem_aux, moving routines from einfo to sem_aux
2009-04-09 Robert Dewar <dewar@adacore.com>
* exp_util.adb (Silly_Boolean_Array_Xor_Test): Simplify existing code.

1
gcc/ada/checks.adb

@ -43,6 +43,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;

702
gcc/ada/einfo.adb

@ -5486,40 +5486,6 @@ package body Einfo is
return Rep_Clause (Id, Name_Alignment);
end Alignment_Clause;
----------------------
-- Ancestor_Subtype --
----------------------
function Ancestor_Subtype (Id : E) return E is
begin
-- If this is first subtype, or is a base type, then there is no
-- ancestor subtype, so we return Empty to indicate this fact.
if Is_First_Subtype (Id) or else Id = Base_Type (Id) then
return Empty;
end if;
declare
D : constant Node_Id := Declaration_Node (Id);
begin
-- If we have a subtype declaration, get the ancestor subtype
if Nkind (D) = N_Subtype_Declaration then
if Nkind (Subtype_Indication (D)) = N_Subtype_Indication then
return Entity (Subtype_Mark (Subtype_Indication (D)));
else
return Entity (Subtype_Indication (D));
end if;
-- If not, then no subtype indication is available
else
return Empty;
end if;
end;
end Ancestor_Subtype;
-------------------
-- Append_Entity --
-------------------
@ -5537,31 +5503,6 @@ package body Einfo is
Set_Last_Entity (Id => V, V => Id);
end Append_Entity;
--------------------
-- Available_View --
--------------------
function Available_View (Id : E) return E is
begin
if Is_Incomplete_Type (Id)
and then Present (Non_Limited_View (Id))
then
-- The non-limited view may itself be an incomplete type, in
-- which case get its full view.
return Get_Full_View (Non_Limited_View (Id));
elsif Is_Class_Wide_Type (Id)
and then Is_Incomplete_Type (Etype (Id))
and then Present (Non_Limited_View (Etype (Id)))
then
return Class_Wide_Type (Non_Limited_View (Etype (Id)));
else
return Id;
end if;
end Available_View;
---------------
-- Base_Type --
---------------
@ -5632,61 +5573,6 @@ package body Einfo is
end if;
end Component_Alignment;
--------------------
-- Constant_Value --
--------------------
function Constant_Value (Id : E) return N is
D : constant Node_Id := Declaration_Node (Id);
Full_D : Node_Id;
begin
-- If we have no declaration node, then return no constant value.
-- Not clear how this can happen, but it does sometimes ???
-- To investigate, remove this check and compile discrim_po.adb.
if No (D) then
return Empty;
-- Normal case where a declaration node is present
elsif Nkind (D) = N_Object_Renaming_Declaration then
return Renamed_Object (Id);
-- If this is a component declaration whose entity is constant, it
-- is a prival within a protected function. It does not have
-- a constant value.
elsif Nkind (D) = N_Component_Declaration then
return Empty;
-- If there is an expression, return it
elsif Present (Expression (D)) then
return (Expression (D));
-- For a constant, see if we have a full view
elsif Ekind (Id) = E_Constant
and then Present (Full_View (Id))
then
Full_D := Parent (Full_View (Id));
-- The full view may have been rewritten as an object renaming
if Nkind (Full_D) = N_Object_Renaming_Declaration then
return Name (Full_D);
else
return Expression (Full_D);
end if;
-- Otherwise we have no expression to return
else
return Empty;
end if;
end Constant_Value;
----------------------
-- Declaration_Node --
----------------------
@ -5744,49 +5630,6 @@ package body Einfo is
end if;
end Designated_Type;
-----------------------------
-- Enclosing_Dynamic_Scope --
-----------------------------
function Enclosing_Dynamic_Scope (Id : E) return E is
S : Entity_Id;
begin
-- The following test is an error defense against some syntax
-- errors that can leave scopes very messed up.
if Id = Standard_Standard then
return Id;
end if;
-- Normal case, search enclosing scopes
-- Note: the test for Present (S) should not be required, it is a
-- defence against an ill-formed tree.
S := Scope (Id);
loop
-- If we somehow got an empty value for Scope, the tree must be
-- malformed. Rather than blow up we return Standard in this case.
if No (S) then
return Standard_Standard;
-- Quit if we get to standard or a dynamic scope
elsif S = Standard_Standard
or else Is_Dynamic_Scope (S)
then
return S;
-- Otherwise keep climbing
else
S := Scope (S);
end if;
end loop;
end Enclosing_Dynamic_Scope;
----------------------
-- Entry_Index_Type --
----------------------
@ -5839,46 +5682,6 @@ package body Einfo is
return Comp_Id;
end First_Component_Or_Discriminant;
------------------------
-- First_Discriminant --
------------------------
function First_Discriminant (Id : E) return E is
Ent : Entity_Id;
begin
pragma Assert
(Has_Discriminants (Id)
or else Has_Unknown_Discriminants (Id));
Ent := First_Entity (Id);
-- The discriminants are not necessarily contiguous, because access
-- discriminants will generate itypes. They are not the first entities
-- either, because tag and controller record must be ahead of them.
if Chars (Ent) = Name_uTag then
Ent := Next_Entity (Ent);
end if;
if Chars (Ent) = Name_uController then
Ent := Next_Entity (Ent);
end if;
-- Skip all hidden stored discriminants if any
while Present (Ent) loop
exit when Ekind (Ent) = E_Discriminant
and then not Is_Completely_Hidden (Ent);
Ent := Next_Entity (Ent);
end loop;
pragma Assert (Ekind (Ent) = E_Discriminant);
return Ent;
end First_Discriminant;
------------------
-- First_Formal --
------------------
@ -5935,130 +5738,6 @@ package body Einfo is
end if;
end First_Formal_With_Extras;
-------------------------------
-- First_Stored_Discriminant --
-------------------------------
function First_Stored_Discriminant (Id : E) return E is
Ent : Entity_Id;
function Has_Completely_Hidden_Discriminant (Id : E) return Boolean;
-- Scans the Discriminants to see whether any are Completely_Hidden
-- (the mechanism for describing non-specified stored discriminants)
----------------------------------------
-- Has_Completely_Hidden_Discriminant --
----------------------------------------
function Has_Completely_Hidden_Discriminant (Id : E) return Boolean is
Ent : Entity_Id := Id;
begin
pragma Assert (Ekind (Id) = E_Discriminant);
while Present (Ent) and then Ekind (Ent) = E_Discriminant loop
if Is_Completely_Hidden (Ent) then
return True;
end if;
Ent := Next_Entity (Ent);
end loop;
return False;
end Has_Completely_Hidden_Discriminant;
-- Start of processing for First_Stored_Discriminant
begin
pragma Assert
(Has_Discriminants (Id)
or else Has_Unknown_Discriminants (Id));
Ent := First_Entity (Id);
if Chars (Ent) = Name_uTag then
Ent := Next_Entity (Ent);
end if;
if Chars (Ent) = Name_uController then
Ent := Next_Entity (Ent);
end if;
if Has_Completely_Hidden_Discriminant (Ent) then
while Present (Ent) loop
exit when Is_Completely_Hidden (Ent);
Ent := Next_Entity (Ent);
end loop;
end if;
pragma Assert (Ekind (Ent) = E_Discriminant);
return Ent;
end First_Stored_Discriminant;
-------------------
-- First_Subtype --
-------------------
function First_Subtype (Id : E) return E is
B : constant Entity_Id := Base_Type (Id);
F : constant Node_Id := Freeze_Node (B);
Ent : Entity_Id;
begin
-- If the base type has no freeze node, it is a type in standard,
-- and always acts as its own first subtype unless it is one of
-- the predefined integer types. If the type is formal, it is also
-- a first subtype, and its base type has no freeze node. On the other
-- hand, a subtype of a generic formal is not its own first_subtype.
-- Its base type, if anonymous, is attached to the formal type decl.
-- from which the first subtype is obtained.
if No (F) then
if B = Base_Type (Standard_Integer) then
return Standard_Integer;
elsif B = Base_Type (Standard_Long_Integer) then
return Standard_Long_Integer;
elsif B = Base_Type (Standard_Short_Short_Integer) then
return Standard_Short_Short_Integer;
elsif B = Base_Type (Standard_Short_Integer) then
return Standard_Short_Integer;
elsif B = Base_Type (Standard_Long_Long_Integer) then
return Standard_Long_Long_Integer;
elsif Is_Generic_Type (Id) then
if Present (Parent (B)) then
return Defining_Identifier (Parent (B));
else
return Defining_Identifier (Associated_Node_For_Itype (B));
end if;
else
return B;
end if;
-- Otherwise we check the freeze node, if it has a First_Subtype_Link
-- then we use that link, otherwise (happens with some Itypes), we use
-- the base type itself.
else
Ent := First_Subtype_Link (F);
if Present (Ent) then
return Ent;
else
return B;
end if;
end if;
end First_Subtype;
-------------------------------------
-- Get_Attribute_Definition_Clause --
-------------------------------------
@ -6329,104 +6008,6 @@ package body Einfo is
return Root_Type (Id) = Standard_Boolean;
end Is_Boolean_Type;
---------------------
-- Is_By_Copy_Type --
---------------------
function Is_By_Copy_Type (Id : E) return B is
begin
-- If Id is a private type whose full declaration has not been seen,
-- we assume for now that it is not a By_Copy type. Clearly this
-- attribute should not be used before the type is frozen, but it is
-- needed to build the associated record of a protected type. Another
-- place where some lookahead for a full view is needed ???
return
Is_Elementary_Type (Id)
or else (Is_Private_Type (Id)
and then Present (Underlying_Type (Id))
and then Is_Elementary_Type (Underlying_Type (Id)));
end Is_By_Copy_Type;
--------------------------
-- Is_By_Reference_Type --
--------------------------
-- This function knows too much semantics, it should be in sem_util ???
function Is_By_Reference_Type (Id : E) return B is
Btype : constant Entity_Id := Base_Type (Id);
begin
if Error_Posted (Id)
or else Error_Posted (Btype)
then
return False;
elsif Is_Private_Type (Btype) then
declare
Utyp : constant Entity_Id := Underlying_Type (Btype);
begin
if No (Utyp) then
return False;
else
return Is_By_Reference_Type (Utyp);
end if;
end;
elsif Is_Incomplete_Type (Btype) then
declare
Ftyp : constant Entity_Id := Full_View (Btype);
begin
if No (Ftyp) then
return False;
else
return Is_By_Reference_Type (Ftyp);
end if;
end;
elsif Is_Concurrent_Type (Btype) then
return True;
elsif Is_Record_Type (Btype) then
if Is_Limited_Record (Btype)
or else Is_Tagged_Type (Btype)
or else Is_Volatile (Btype)
then
return True;
else
declare
C : Entity_Id;
begin
C := First_Component (Btype);
while Present (C) loop
if Is_By_Reference_Type (Etype (C))
or else Is_Volatile (Etype (C))
then
return True;
end if;
C := Next_Component (C);
end loop;
end;
return False;
end if;
elsif Is_Array_Type (Btype) then
return
Is_Volatile (Btype)
or else Is_By_Reference_Type (Component_Type (Btype))
or else Is_Volatile (Component_Type (Btype))
or else Has_Volatile_Components (Btype);
else
return False;
end if;
end Is_By_Reference_Type;
------------------------
-- Is_Constant_Object --
------------------------
@ -6438,35 +6019,6 @@ package body Einfo is
K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
end Is_Constant_Object;
---------------------
-- Is_Derived_Type --
---------------------
function Is_Derived_Type (Id : E) return B is
Par : Node_Id;
begin
if Is_Type (Id)
and then Base_Type (Id) /= Root_Type (Id)
and then not Is_Class_Wide_Type (Id)
then
if not Is_Numeric_Type (Root_Type (Id)) then
return True;
else
Par := Parent (First_Subtype (Id));
return Present (Par)
and then Nkind (Par) = N_Full_Type_Declaration
and then Nkind (Type_Definition (Par)) =
N_Derived_Type_Definition;
end if;
else
return False;
end if;
end Is_Derived_Type;
--------------------
-- Is_Discriminal --
--------------------
@ -6526,175 +6078,6 @@ package body Einfo is
and then Is_Entity_Attribute_Name (Attribute_Name (N)));
end Is_Entity_Name;
---------------------------
-- Is_Indefinite_Subtype --
---------------------------
function Is_Indefinite_Subtype (Id : Entity_Id) return B is
K : constant Entity_Kind := Ekind (Id);
begin
if Is_Constrained (Id) then
return False;
elsif K in Array_Kind
or else K in Class_Wide_Kind
or else Has_Unknown_Discriminants (Id)
then
return True;
-- Known discriminants: indefinite if there are no default values
elsif K in Record_Kind
or else Is_Incomplete_Or_Private_Type (Id)
or else Is_Concurrent_Type (Id)
then
return (Has_Discriminants (Id)
and then No (Discriminant_Default_Value (First_Discriminant (Id))));
else
return False;
end if;
end Is_Indefinite_Subtype;
--------------------------------
-- Is_Inherently_Limited_Type --
--------------------------------
function Is_Inherently_Limited_Type (Id : E) return B is
Btype : constant Entity_Id := Base_Type (Id);
begin
if Is_Private_Type (Btype) then
declare
Utyp : constant Entity_Id := Underlying_Type (Btype);
begin
if No (Utyp) then
return False;
else
return Is_Inherently_Limited_Type (Utyp);
end if;
end;
elsif Is_Concurrent_Type (Btype) then
return True;
elsif Is_Record_Type (Btype) then
if Is_Limited_Record (Btype) then
return not Is_Interface (Btype)
or else Is_Protected_Interface (Btype)
or else Is_Synchronized_Interface (Btype)
or else Is_Task_Interface (Btype);
elsif Is_Class_Wide_Type (Btype) then
return Is_Inherently_Limited_Type (Root_Type (Btype));
else
declare
C : Entity_Id;
begin
C := First_Component (Btype);
while Present (C) loop
if Is_Inherently_Limited_Type (Etype (C)) then
return True;
end if;
C := Next_Component (C);
end loop;
end;
return False;
end if;
elsif Is_Array_Type (Btype) then
return Is_Inherently_Limited_Type (Component_Type (Btype));
else
return False;
end if;
end Is_Inherently_Limited_Type;
---------------------
-- Is_Limited_Type --
---------------------
function Is_Limited_Type (Id : E) return B is
Btype : constant E := Base_Type (Id);
Rtype : constant E := Root_Type (Btype);
begin
if not Is_Type (Id) then
return False;
elsif Ekind (Btype) = E_Limited_Private_Type
or else Is_Limited_Composite (Btype)
then
return True;
elsif Is_Concurrent_Type (Btype) then
return True;
-- The Is_Limited_Record flag normally indicates that the type is
-- limited. The exception is that a type does not inherit limitedness
-- from its interface ancestor. So the type may be derived from a
-- limited interface, but is not limited.
elsif Is_Limited_Record (Id)
and then not Is_Interface (Id)
then
return True;
-- Otherwise we will look around to see if there is some other reason
-- for it to be limited, except that if an error was posted on the
-- entity, then just assume it is non-limited, because it can cause
-- trouble to recurse into a murky erroneous entity!
elsif Error_Posted (Id) then
return False;
elsif Is_Record_Type (Btype) then
if Is_Limited_Interface (Id) then
return True;
-- AI-419: limitedness is not inherited from a limited interface
elsif Is_Limited_Record (Rtype) then
return not Is_Interface (Rtype)
or else Is_Protected_Interface (Rtype)
or else Is_Synchronized_Interface (Rtype)
or else Is_Task_Interface (Rtype);
elsif Is_Class_Wide_Type (Btype) then
return Is_Limited_Type (Rtype);
else
declare
C : E;
begin
C := First_Component (Btype);
while Present (C) loop
if Is_Limited_Type (Etype (C)) then
return True;
end if;
C := Next_Component (C);
end loop;
end;
return False;
end if;
elsif Is_Array_Type (Btype) then
return Is_Limited_Type (Component_Type (Btype));
else
return False;
end if;
end Is_Limited_Type;
-----------------------------------
-- Is_Package_Or_Generic_Package --
-----------------------------------
@ -6967,25 +6350,6 @@ package body Einfo is
end if;
end Number_Dimensions;
--------------------------
-- Number_Discriminants --
--------------------------
function Number_Discriminants (Id : E) return Pos is
N : Int;
Discr : Entity_Id;
begin
N := 0;
Discr := First_Discriminant (Id);
while Present (Discr) loop
N := N + 1;
Discr := Next_Discriminant (Discr);
end loop;
return N;
end Number_Discriminants;
--------------------
-- Number_Entries --
--------------------
@ -7264,72 +6628,6 @@ package body Einfo is
return Kind;
end Subtype_Kind;
-------------------------
-- First_Tag_Component --
-------------------------
function First_Tag_Component (Id : E) return E is
Comp : Entity_Id;
Typ : Entity_Id := Id;
begin
pragma Assert (Is_Tagged_Type (Typ));
if Is_Class_Wide_Type (Typ) then
Typ := Root_Type (Typ);
end if;
if Is_Private_Type (Typ) then
Typ := Underlying_Type (Typ);
-- If the underlying type is missing then the source program has
-- errors and there is nothing else to do (the full-type declaration
-- associated with the private type declaration is missing).
if No (Typ) then
return Empty;
end if;
end if;
Comp := First_Entity (Typ);
while Present (Comp) loop
if Is_Tag (Comp) then
return Comp;
end if;
Comp := Next_Entity (Comp);
end loop;
-- No tag component found
return Empty;
end First_Tag_Component;
------------------------
-- Next_Tag_Component --
------------------------
function Next_Tag_Component (Id : E) return E is
Comp : Entity_Id;
begin
pragma Assert (Is_Tag (Id));
Comp := Next_Entity (Id);
while Present (Comp) loop
if Is_Tag (Comp) then
pragma Assert (Chars (Comp) /= Name_uTag);
return Comp;
end if;
Comp := Next_Entity (Comp);
end loop;
-- No tag component found
return Empty;
end Next_Tag_Component;
---------------------
-- Type_High_Bound --
---------------------

168
gcc/ada/einfo.ads

@ -382,18 +382,6 @@ package Einfo is
-- definition clause with an (obsolescent) mod clause is converted
-- into an attribute definition clause for this purpose.
-- Ancestor_Subtype (synthesized)
-- Applies to all type and subtype entities. If the argument is a
-- subtype then it returns the subtype or type from which the subtype
-- was obtained, otherwise it returns Empty.
-- Available_View (synthesized)
-- Applies to types that have the With_Type flag set. Returns the
-- non-limited view of the type, if available, otherwise the type
-- itself. For class-wide types, there is no direct link in the tree,
-- so we have to retrieve the class-wide type of the non-limited view
-- of the Etype.
-- Associated_Formal_Package (Node12)
-- Present in packages that are the actuals of formal_packages. Points
-- to the entity in the declaration for the formal package.
@ -585,14 +573,6 @@ package Einfo is
-- Component_Type (Node20) [implementation base type only]
-- Present in array types and string types. References component type.
-- Constant_Value (synthesized)
-- Applies to variables, constants, named integers, and named reals.
-- Obtains the initialization expression for the entity. Will return
-- Empty for a deferred constant whose full view is not available
-- or in some other cases of internal entities, which cannot be treated
-- as constants from the point of view of constant folding. Empty is
-- also returned for variables with no initialization expression.
-- Corresponding_Concurrent_Type (Node18)
-- Present in record types that are constructed by the expander to
-- represent task and protected types (Is_Concurrent_Record_Type flag
@ -814,7 +794,7 @@ package Einfo is
-- Discriminant_Number (Uint15)
-- Present in discriminants. Gives the ranking of a discriminant in
-- the list of discriminants of the type, i.e. a sequential integer
-- index starting at 1 and ranging up to Number_Discriminants.
-- index starting at 1 and ranging up to number of discriminants.
-- Dispatch_Table_Wrappers (Elist26) [implementation base type only]
-- Present in library level record type entities if we are generating
@ -886,10 +866,6 @@ package Einfo is
-- code, then if there is no other elaboration code, obviously there
-- is no need to set the flag.
-- Enclosing_Dynamic_Scope (synthesized)
-- Applies to all entities. Returns the closest dynamic scope in which
-- the entity is declared or Standard_Standard for library-level entities
-- Enclosing_Scope (Node18)
-- Present in labels. Denotes the innermost enclosing construct that
-- contains the label. Identical to the scope of the label, except for
@ -1130,13 +1106,6 @@ package Einfo is
-- Similar to First_Component, but discriminants are not skipped, so will
-- find the first discriminant if discriminants are present.
-- First_Discriminant (synthesized)
-- Applies to types with discriminants. The discriminants are the first
-- entities declared in the type, so normally this is equivalent to
-- First_Entity. The exception arises for tagged types, where the tag
-- itself is prepended to the front of the entity chain, so the
-- First_Discriminant function steps past the tag if it is present.
-- First_Entity (Node17)
-- Present in all entities which act as scopes to which a list of
-- associated entities is attached (blocks, class subtypes and types,
@ -1229,40 +1198,6 @@ package Einfo is
-- Note in particular that size clauses are present only for this
-- purpose, and should only be accessed if Has_Size_Clause is set.
-- First_Stored_Discriminant (synthesized)
-- Applies to types with discriminants. Gives the first discriminant
-- stored in the object. In many cases, these are the same as the
-- normal visible discriminants for the type, but in the case of
-- renamed discriminants, this is not always the case.
--
-- For tagged types, and untagged types which are root types or
-- derived types but which do not rename discriminants in their
-- root type, the stored discriminants are the same as the actual
-- discriminants of the type, and hence this function is the same
-- as First_Discriminant.
--
-- For derived non-tagged types that rename discriminants in the root
-- type this is the first of the discriminants that occur in the
-- root type. To be precise, in this case stored discriminants are
-- entities attached to the entity chain of the derived type which
-- are a copy of the discriminants of the root type. Furthermore their
-- Is_Completely_Hidden flag is set since although they are actually
-- stored in the object, they are not in the set of discriminants that
-- is visble in the type.
--
-- For derived untagged types, stored discriminants are the real
-- discriminants from Gigi's standpoint, i.e. those that will be
-- stored in actual objects of the type.
-- First_Subtype (synthesized)
-- Applies to all types and subtypes. For types, yields the first subtype
-- of the type. For subtypes, yields the first subtype of the base type
-- of the subtype.
-- First_Tag_Component (synthesized)
-- Applies to tagged record types, returns the entity for the first
-- _Tag field in this record.
-- Freeze_Node (Node7)
-- Present in all entities. If there is an associated freeze node for
-- the entity, this field references this freeze node. If no freeze
@ -1939,14 +1874,6 @@ package Einfo is
-- Applies to all entities, true for boolean types and subtypes,
-- i.e. Standard.Boolean and all types ultimately derived from it.
-- Is_By_Copy_Type (synthesized)
-- Applies to all type entities. Returns true if the entity is
-- a by copy type (RM 6.2(3)).
-- Is_By_Reference_Type (synthesized)
-- Applies to all type entities. True if the type is required to
-- be passed by reference, as defined in (RM 6.2(4-9)).
-- Is_Called (Flag102)
-- Present in subprograms. Returns true if the subprogram is called
-- in the unit being compiled or in a unit in the context. Used for
@ -2043,10 +1970,6 @@ package Einfo is
-- Applies to all type entities, true for decimal fixed point
-- types and subtypes.
-- Is_Derived_Type (synthesized)
-- Applies to all entities. Determine if given entity is a derived type.
-- Always false if argument is not a type.
-- Is_Descendent_Of_Address (Flag223)
-- Present in all type and subtype entities. Indicates that a type is an
-- address type that is visibly a numeric type. Used for semantic checks
@ -2197,12 +2120,6 @@ package Einfo is
-- Is_Incomplete_Type (synthesized)
-- Applies to all entities, true for incomplete types and subtypes
-- Is_Indefinite_Subtype (synthesized)
-- Applies to all entities for types and subtypes. Determines if given
-- entity is an unconstrained array type or subtype, a discriminated
-- record type or subtype with no initial discriminant values or a
-- class wide type or subtype.
-- Is_Inlined (Flag11)
-- Present in all entities. Set for functions and procedures which are
-- to be inlined. For subprograms created during expansion, this flag
@ -2363,12 +2280,6 @@ package Einfo is
-- record is declared to be limited. Note that this flag is not set
-- simply because some components of the record are limited.
-- Is_Limited_Type (synthesized)
-- Applies to all entities. True if entity is a limited type (limited
-- private type, limited interface type, task type, protected type,
-- composite containing a limited component, or a subtype of any of
-- these types).
-- Is_Local_Anonymous_Access (Flag194)
-- Present in access types. Set for an anonymous access type to indicate
-- that the type is created for a record component with an access
@ -2613,15 +2524,6 @@ package Einfo is
-- renaming is handled by the front end, by macro substitution of
-- a copy of the (evaluated) name tree whereever the variable is used.
-- Is_Inherently_Limited_Type (synthesized)
-- Applies to all type entities. True if the type is "inherently"
-- limited (i.e. cannot become nonlimited). From the Ada 2005
-- RM-7.5(8.1/2), "a type with a part that is of a task, protected, or
-- explicitly limited record type". These are the types that are defined
-- as return-by-reference types in Ada 95 (see RM95-6.5(11-16)). In Ada
-- 2005, these are the types that require build-in-place for function
-- calls. Note that build-in-place is allowed for other types, too.
-- Is_Return_Object (Flag209)
-- Present in all object entities. True if the object is the return
-- object of an extended_return_statement; False otherwise.
@ -3044,10 +2946,6 @@ package Einfo is
-- Empty if applied to the last literal. This is actually a synonym
-- for Next, but its use is preferred in this context.
-- Next_Tag_Component (synthesized)
-- Applies to components of tagged record types. Given a _Tag field
-- of a record, returns the next _Tag field in this record.
-- Non_Binary_Modulus (Flag58) [base type only]
-- Present in all subtype and type entities. Set for modular integer
-- types if the modulus value is other than a power of 2.
@ -3110,10 +3008,6 @@ package Einfo is
-- Applies to array types and subtypes. Returns the number of dimensions
-- of the array type or subtype as a value of type Pos.
-- Number_Discriminants (synthesized)
-- Applies to all types with discriminants. Yields the number of
-- discriminants as a value of type Pos.
-- Number_Entries (synthesized)
-- Applies to concurrent types. Returns the number of entries that are
-- declared within the task or protected definition for the type.
@ -4642,11 +4536,8 @@ package Einfo is
-- Was_Hidden (Flag196)
-- Declaration_Node (synth)
-- Enclosing_Dynamic_Scope (synth)
-- Has_Foreign_Convention (synth)
-- Is_Derived_Type (synth)
-- Is_Dynamic_Scope (synth)
-- Is_Limited_Type (synth)
-- Is_Standard_Character_Type (synth)
-- Underlying_Type (synth)
-- all classification attributes (synth)
@ -4722,15 +4613,10 @@ package Einfo is
-- Universal_Aliasing (Flag216) (base type only)
-- Alignment_Clause (synth)
-- Ancestor_Subtype (synth)
-- Base_Type (synth)
-- First_Subtype (synth)
-- Has_Private_Ancestor (synth)
-- Implementation_Base_Type (synth)
-- Is_Access_Protected_Subprogram_Type (synth)
-- Is_By_Copy_Type (synth)
-- Is_By_Reference_Type (synth)
-- Is_Inherently_Limited_Type (synth)
-- Root_Type (synth)
-- Size_Clause (synth)
@ -4757,7 +4643,7 @@ package Einfo is
-- Storage_Size_Variable (Node15) (base type only)
-- Master_Id (Node17)
-- Directly_Designated_Type (Node20)
-- Associated_Storage_Pool (Node22) (base type only)
-- Associated_Storage_Pool (Node22) (root type only)
-- Associated_Final_Chain (Node23)
-- Has_Pragma_Controlled (Flag27) (base type only)
-- Has_Storage_Size_Clause (Flag23) (base type only)
@ -4827,8 +4713,7 @@ package Einfo is
-- Last_Entity (Node20)
-- First_Component (synth)
-- First_Component_Or_Discriminant (synth)
-- First_Discriminant (synth)
-- (plus type attributes)
-- (plus type attributes)
-- E_Component
-- Normalized_First_Bit (Uint8)
@ -4856,7 +4741,6 @@ package Einfo is
-- Is_Return_Object (Flag209)
-- Next_Component (synth)
-- Next_Component_Or_Discriminant (synth)
-- Next_Tag_Component (synth)
-- E_Constant
-- E_Loop_Parameter
@ -4889,7 +4773,6 @@ package Einfo is
-- Treat_As_Volatile (Flag41)
-- Address_Clause (synth)
-- Alignment_Clause (synth)
-- Constant_Value (synth)
-- Size_Clause (synth)
-- E_Decimal_Fixed_Point_Type
@ -4903,7 +4786,7 @@ package Einfo is
-- Machine_Radix_10 (Flag84)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- (plus type attributes)
-- (plus type attributes)
-- E_Discriminant
-- Normalized_First_Bit (Uint8)
@ -4974,7 +4857,7 @@ package Einfo is
-- Nonzero_Is_True (Flag162) (base type only)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- (plus type attributes)
-- (plus type attributes)
-- E_Exception
-- Esize (Uint12)
@ -4989,7 +4872,7 @@ package Einfo is
-- E_Exception_Type
-- Equivalent_Type (Node18)
-- (plus type attributes)
-- (plus type attributes)
-- E_Floating_Point_Type
-- E_Floating_Point_Subtype
@ -4997,7 +4880,7 @@ package Einfo is
-- Scalar_Range (Node20)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- (plus type attributes)
-- (plus type attributes)
-- E_Function
-- E_Generic_Function
@ -5073,7 +4956,7 @@ package Einfo is
-- Storage_Size_Variable (Node15) (base type only)
-- Master_Id (Node17)
-- Directly_Designated_Type (Node20)
-- Associated_Storage_Pool (Node22) (base type only)
-- Associated_Storage_Pool (Node22) (root type only)
-- Associated_Final_Chain (Node23)
-- (plus type attributes)
@ -5095,8 +4978,6 @@ package Einfo is
-- Private_Dependents (Elist18)
-- Discriminant_Constraint (Elist21)
-- Stored_Constraint (Elist23)
-- First_Discriminant (synth)
-- First_Stored_Discriminant (synth)
-- (plus type attributes)
-- E_In_Parameter
@ -5141,8 +5022,6 @@ package Einfo is
-- Private_View (Node22)
-- Stored_Constraint (Elist23)
-- Has_Completion (Flag26)
-- First_Discriminant (synth)
-- First_Stored_Discriminant (synth)
-- (plus type attributes)
-- E_Loop
@ -5162,10 +5041,8 @@ package Einfo is
-- (plus type attributes)
-- E_Named_Integer
-- Constant_Value (synth)
-- E_Named_Real
-- Constant_Value (synth)
-- E_Operator
-- First_Entity (Node17)
@ -5190,7 +5067,7 @@ package Einfo is
-- Has_Small_Clause (Flag67)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- (plus type attributes)
-- (plus type attributes)
-- E_Package
-- E_Generic_Package
@ -5260,8 +5137,6 @@ package Einfo is
-- Has_Completion (Flag26)
-- Is_Controlled (Flag42) (base type only)
-- Is_For_Access_Subtype (Flag118) (subtype only)
-- First_Discriminant (synth)
-- First_Stored_Discriminant (synth)
-- (plus type attributes)
-- E_Procedure
@ -5386,9 +5261,6 @@ package Einfo is
-- Reverse_Bit_Order (Flag164) (base type only)
-- First_Component (synth)
-- First_Component_Or_Discriminant (synth)
-- First_Discriminant (synth)
-- First_Stored_Discriminant (synth)
-- First_Tag_Component (synth)
-- (plus type attributes)
-- E_Record_Type_With_Private
@ -5416,9 +5288,6 @@ package Einfo is
-- Reverse_Bit_Order (Flag164) (base type only)
-- First_Component (synth)
-- First_Component_Or_Discriminant (synth)
-- First_Discriminant (synth)
-- First_Stored_Discriminant (synth)
-- First_Tag_Component (synth)
-- (plus type attributes)
-- E_Return_Statement
@ -5523,7 +5392,6 @@ package Einfo is
-- Treat_As_Volatile (Flag41)
-- Address_Clause (synth)
-- Alignment_Clause (synth)
-- Constant_Value (synth)
-- Size_Clause (synth)
-- E_Void
@ -6191,20 +6059,13 @@ package Einfo is
function Address_Clause (Id : E) return N;
function Alignment_Clause (Id : E) return N;
function Ancestor_Subtype (Id : E) return E;
function Available_View (Id : E) return E;
function Base_Type (Id : E) return E;
function Constant_Value (Id : E) return N;
function Declaration_Node (Id : E) return N;
function Designated_Type (Id : E) return E;
function Enclosing_Dynamic_Scope (Id : E) return E;
function First_Component (Id : E) return E;
function First_Component_Or_Discriminant (Id : E) return E;
function First_Discriminant (Id : E) return E;
function First_Formal (Id : E) return E;
function First_Formal_With_Extras (Id : E) return E;
function First_Stored_Discriminant (Id : E) return E;
function First_Subtype (Id : E) return E;
function Has_Attach_Handler (Id : E) return B;
function Has_Entries (Id : E) return B;
function Has_Foreign_Convention (Id : E) return B;
@ -6212,19 +6073,13 @@ package Einfo is
function Has_Private_Declaration (Id : E) return B;
function Implementation_Base_Type (Id : E) return E;
function Is_Boolean_Type (Id : E) return B;
function Is_By_Copy_Type (Id : E) return B;
function Is_By_Reference_Type (Id : E) return B;
function Is_Constant_Object (Id : E) return B;
function Is_Derived_Type (Id : E) return B;
function Is_Discriminal (Id : E) return B;
function Is_Dynamic_Scope (Id : E) return B;
function Is_Indefinite_Subtype (Id : E) return B;
function Is_Limited_Type (Id : E) return B;
function Is_Package_Or_Generic_Package (Id : E) return B;
function Is_Prival (Id : E) return B;
function Is_Protected_Component (Id : E) return B;
function Is_Protected_Record_Type (Id : E) return B;
function Is_Inherently_Limited_Type (Id : E) return B;
function Is_Standard_Character_Type (Id : E) return B;
function Is_String_Type (Id : E) return B;
function Is_Task_Record_Type (Id : E) return B;
@ -6237,16 +6092,13 @@ package Einfo is
function Next_Literal (Id : E) return E;
function Next_Stored_Discriminant (Id : E) return E;
function Number_Dimensions (Id : E) return Pos;
function Number_Discriminants (Id : E) return Pos;
function Number_Entries (Id : E) return Nat;
function Number_Formals (Id : E) return Pos;
function Parameter_Mode (Id : E) return Formal_Kind;
function Root_Type (Id : E) return E;
function Parameter_Mode (Id : E) return Formal_Kind;
function Scope_Depth_Set (Id : E) return B;
function Size_Clause (Id : E) return N;
function Stream_Size_Clause (Id : E) return N;
function First_Tag_Component (Id : E) return E;
function Next_Tag_Component (Id : E) return E;
function Type_High_Bound (Id : E) return N;
function Type_Low_Bound (Id : E) return N;
function Underlying_Type (Id : E) return E;

1
gcc/ada/exp_aggr.adb

@ -47,6 +47,7 @@ with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Ttypes; use Ttypes;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;

1
gcc/ada/exp_atag.adb

@ -31,6 +31,7 @@ with Nlists; use Nlists;
with Nmake; use Nmake;
with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Stand; use Stand;
with Snames; use Snames;

1
gcc/ada/exp_attr.adb

@ -53,6 +53,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;

1
gcc/ada/exp_ch3.adb

@ -49,6 +49,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Attr; use Sem_Attr;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;

1
gcc/ada/exp_ch4.adb

@ -50,6 +50,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;

1
gcc/ada/exp_ch5.adb

@ -46,6 +46,7 @@ with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;

1
gcc/ada/exp_ch6.adb

@ -54,6 +54,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch12; use Sem_Ch12;

1
gcc/ada/exp_ch7.adb

@ -49,6 +49,7 @@ with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;

1
gcc/ada/exp_ch9.adb

@ -48,6 +48,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch11; use Sem_Ch11;

3
gcc/ada/exp_code.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2008, 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- --
@ -33,6 +33,7 @@ with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem_Aux; use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;

1
gcc/ada/exp_dbug.adb

@ -31,6 +31,7 @@ with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Output; use Output;
with Sem_Aux; use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;

1
gcc/ada/exp_disp.adb

@ -46,6 +46,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;

1
gcc/ada/exp_dist.adb

@ -36,6 +36,7 @@ with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;

1
gcc/ada/exp_imgv.adb

@ -34,6 +34,7 @@ with Nmake; use Nmake;
with Nlists; use Nlists;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem_Aux; use Sem_Aux;
with Sem_Res; use Sem_Res;
with Sinfo; use Sinfo;
with Snames; use Snames;

1
gcc/ada/exp_pakd.adb

@ -36,6 +36,7 @@ with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;

1
gcc/ada/exp_smem.adb

@ -31,6 +31,7 @@ with Namet; use Namet;
with Nlists; use Nlists;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;

1
gcc/ada/exp_strm.adb

@ -30,6 +30,7 @@ with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;

1
gcc/ada/exp_tss.adb

@ -30,6 +30,7 @@ with Exp_Util; use Exp_Util;
with Lib; use Lib;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;

1
gcc/ada/exp_util.adb

@ -41,6 +41,7 @@ with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;

16
gcc/ada/fe.h

@ -179,6 +179,22 @@ extern void Check_No_Implicit_Heap_Alloc (Node_Id);
extern void Check_Elaboration_Code_Allowed (Node_Id);
extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id);
/* sem_aux: */
#define Ancestor_Subtype sem_aux__ancestor_subtype
#define First_Discriminant sem_aux__first_discriminant
#define First_Stored_Discriminant sem_aux__first_stored_discriminant
#define First_Subtype sem_aux__first_subtype
#define Is_By_Reference_Type sem_aux__is_by_reference_type
#define Is_Derived_Type sem_aux__is_derived_type
extern Entity_Id Ancestor_Subtype (Entity_Id);
extern Entity_Id First_Discriminant (Entity_Id);
extern Entity_Id First_Stored_Discriminant (Entity_Id);
extern Entity_Id First_Subtype (Entity_Id);
extern Boolean Is_By_Reference_Type (Entity_Id);
extern Boolean Is_Derived_Type (Entity_Id);
/* sem_elim: */
#define Eliminate_Error_Msg sem_elim__eliminate_error_msg

1
gcc/ada/freeze.adb

@ -44,6 +44,7 @@ with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;

1
gcc/ada/inline.adb

@ -35,6 +35,7 @@ with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem_Aux; use Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
with Sem_Ch12; use Sem_Ch12;

1
gcc/ada/layout.adb

@ -36,6 +36,7 @@ with Nmake; use Nmake;
with Opt; use Opt;
with Repinfo; use Repinfo;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;

1
gcc/ada/lib-xref.adb

@ -33,6 +33,7 @@ with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;

1
gcc/ada/sem_aggr.adb

@ -40,6 +40,7 @@ with Nmake; use Nmake;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch13; use Sem_Ch13;

1
gcc/ada/sem_attr.adb

@ -46,6 +46,7 @@ with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sdefault; use Sdefault;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;

713
gcc/ada/sem_aux.adb

@ -30,8 +30,382 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Einfo; use Einfo;
with Namet; use Namet;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
package body Sem_Aux is
----------------------
-- Ancestor_Subtype --
----------------------
function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id is
begin
-- If this is first subtype, or is a base type, then there is no
-- ancestor subtype, so we return Empty to indicate this fact.
if Is_First_Subtype (Typ) or else Typ = Base_Type (Typ) then
return Empty;
end if;
declare
D : constant Node_Id := Declaration_Node (Typ);
begin
-- If we have a subtype declaration, get the ancestor subtype
if Nkind (D) = N_Subtype_Declaration then
if Nkind (Subtype_Indication (D)) = N_Subtype_Indication then
return Entity (Subtype_Mark (Subtype_Indication (D)));
else
return Entity (Subtype_Indication (D));
end if;
-- If not, then no subtype indication is available
else
return Empty;
end if;
end;
end Ancestor_Subtype;
--------------------
-- Available_View --
--------------------
function Available_View (Typ : Entity_Id) return Entity_Id is
begin
if Is_Incomplete_Type (Typ)
and then Present (Non_Limited_View (Typ))
then
-- The non-limited view may itself be an incomplete type, in which
-- case get its full view.
return Get_Full_View (Non_Limited_View (Typ));
elsif Is_Class_Wide_Type (Typ)
and then Is_Incomplete_Type (Etype (Typ))
and then Present (Non_Limited_View (Etype (Typ)))
then
return Class_Wide_Type (Non_Limited_View (Etype (Typ)));
else
return Typ;
end if;
end Available_View;
--------------------
-- Constant_Value --
--------------------
function Constant_Value (Ent : Entity_Id) return Node_Id is
D : constant Node_Id := Declaration_Node (Ent);
Full_D : Node_Id;
begin
-- If we have no declaration node, then return no constant value.
-- Not clear how this can happen, but it does sometimes and this is
-- the safest approach.
if No (D) then
return Empty;
-- Normal case where a declaration node is present
elsif Nkind (D) = N_Object_Renaming_Declaration then
return Renamed_Object (Ent);
-- If this is a component declaration whose entity is constant, it
-- is a prival within a protected function. It does not have
-- a constant value.
elsif Nkind (D) = N_Component_Declaration then
return Empty;
-- If there is an expression, return it
elsif Present (Expression (D)) then
return (Expression (D));
-- For a constant, see if we have a full view
elsif Ekind (Ent) = E_Constant
and then Present (Full_View (Ent))
then
Full_D := Parent (Full_View (Ent));
-- The full view may have been rewritten as an object renaming
if Nkind (Full_D) = N_Object_Renaming_Declaration then
return Name (Full_D);
else
return Expression (Full_D);
end if;
-- Otherwise we have no expression to return
else
return Empty;
end if;
end Constant_Value;
-----------------------------
-- Enclosing_Dynamic_Scope --
-----------------------------
function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id is
S : Entity_Id;
begin
-- The following test is an error defense against some syntax
-- errors that can leave scopes very messed up.
if Ent = Standard_Standard then
return Ent;
end if;
-- Normal case, search enclosing scopes
-- Note: the test for Present (S) should not be required, it is a
-- defence against an ill-formed tree.
S := Scope (Ent);
loop
-- If we somehow got an empty value for Scope, the tree must be
-- malformed. Rather than blow up we return Standard in this case.
if No (S) then
return Standard_Standard;
-- Quit if we get to standard or a dynamic scope
elsif S = Standard_Standard
or else Is_Dynamic_Scope (S)
then
return S;
-- Otherwise keep climbing
else
S := Scope (S);
end if;
end loop;
end Enclosing_Dynamic_Scope;
------------------------
-- First_Discriminant --
------------------------
function First_Discriminant (Typ : Entity_Id) return Entity_Id is
Ent : Entity_Id;
begin
pragma Assert
(Has_Discriminants (Typ)
or else Has_Unknown_Discriminants (Typ));
Ent := First_Entity (Typ);
-- The discriminants are not necessarily contiguous, because access
-- discriminants will generate itypes. They are not the first entities
-- either, because tag and controller record must be ahead of them.
if Chars (Ent) = Name_uTag then
Ent := Next_Entity (Ent);
end if;
if Chars (Ent) = Name_uController then
Ent := Next_Entity (Ent);
end if;
-- Skip all hidden stored discriminants if any
while Present (Ent) loop
exit when Ekind (Ent) = E_Discriminant
and then not Is_Completely_Hidden (Ent);
Ent := Next_Entity (Ent);
end loop;
pragma Assert (Ekind (Ent) = E_Discriminant);
return Ent;
end First_Discriminant;
-------------------------------
-- First_Stored_Discriminant --
-------------------------------
function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id is
Ent : Entity_Id;
function Has_Completely_Hidden_Discriminant
(Typ : Entity_Id) return Boolean;
-- Scans the Discriminants to see whether any are Completely_Hidden
-- (the mechanism for describing non-specified stored discriminants)
----------------------------------------
-- Has_Completely_Hidden_Discriminant --
----------------------------------------
function Has_Completely_Hidden_Discriminant
(Typ : Entity_Id) return Boolean
is
Ent : Entity_Id;
begin
pragma Assert (Ekind (Typ) = E_Discriminant);
Ent := Typ;
while Present (Ent) and then Ekind (Ent) = E_Discriminant loop
if Is_Completely_Hidden (Ent) then
return True;
end if;
Ent := Next_Entity (Ent);
end loop;
return False;
end Has_Completely_Hidden_Discriminant;
-- Start of processing for First_Stored_Discriminant
begin
pragma Assert
(Has_Discriminants (Typ)
or else Has_Unknown_Discriminants (Typ));
Ent := First_Entity (Typ);
if Chars (Ent) = Name_uTag then
Ent := Next_Entity (Ent);
end if;
if Chars (Ent) = Name_uController then
Ent := Next_Entity (Ent);
end if;
if Has_Completely_Hidden_Discriminant (Ent) then
while Present (Ent) loop
exit when Is_Completely_Hidden (Ent);
Ent := Next_Entity (Ent);
end loop;
end if;
pragma Assert (Ekind (Ent) = E_Discriminant);
return Ent;
end First_Stored_Discriminant;
-------------------
-- First_Subtype --
-------------------
function First_Subtype (Typ : Entity_Id) return Entity_Id is
B : constant Entity_Id := Base_Type (Typ);
F : constant Node_Id := Freeze_Node (B);
Ent : Entity_Id;
begin
-- If the base type has no freeze node, it is a type in standard,
-- and always acts as its own first subtype unless it is one of
-- the predefined integer types. If the type is formal, it is also
-- a first subtype, and its base type has no freeze node. On the other
-- hand, a subtype of a generic formal is not its own first_subtype.
-- Its base type, if anonymous, is attached to the formal type decl.
-- from which the first subtype is obtained.
if No (F) then
if B = Base_Type (Standard_Integer) then
return Standard_Integer;
elsif B = Base_Type (Standard_Long_Integer) then
return Standard_Long_Integer;
elsif B = Base_Type (Standard_Short_Short_Integer) then
return Standard_Short_Short_Integer;
elsif B = Base_Type (Standard_Short_Integer) then
return Standard_Short_Integer;
elsif B = Base_Type (Standard_Long_Long_Integer) then
return Standard_Long_Long_Integer;
elsif Is_Generic_Type (Typ) then
if Present (Parent (B)) then
return Defining_Identifier (Parent (B));
else
return Defining_Identifier (Associated_Node_For_Itype (B));
end if;
else
return B;
end if;
-- Otherwise we check the freeze node, if it has a First_Subtype_Link
-- then we use that link, otherwise (happens with some Itypes), we use
-- the base type itself.
else
Ent := First_Subtype_Link (F);
if Present (Ent) then
return Ent;
else
return B;
end if;
end if;
end First_Subtype;
-------------------------
-- First_Tag_Component --
-------------------------
function First_Tag_Component (Typ : Entity_Id) return Entity_Id is
Comp : Entity_Id;
Ctyp : Entity_Id;
begin
Ctyp := Typ;
pragma Assert (Is_Tagged_Type (Ctyp));
if Is_Class_Wide_Type (Ctyp) then
Ctyp := Root_Type (Ctyp);
end if;
if Is_Private_Type (Ctyp) then
Ctyp := Underlying_Type (Ctyp);
-- If the underlying type is missing then the source program has
-- errors and there is nothing else to do (the full-type declaration
-- associated with the private type declaration is missing).
if No (Ctyp) then
return Empty;
end if;
end if;
Comp := First_Entity (Ctyp);
while Present (Comp) loop
if Is_Tag (Comp) then
return Comp;
end if;
Comp := Next_Entity (Comp);
end loop;
-- No tag component found
return Empty;
end First_Tag_Component;
----------------
-- Initialize --
----------------
@ -41,6 +415,345 @@ package body Sem_Aux is
Obsolescent_Warnings.Init;
end Initialize;
---------------------
-- Is_By_Copy_Type --
---------------------
function Is_By_Copy_Type (Ent : Entity_Id) return Boolean is
begin
-- If Id is a private type whose full declaration has not been seen,
-- we assume for now that it is not a By_Copy type. Clearly this
-- attribute should not be used before the type is frozen, but it is
-- needed to build the associated record of a protected type. Another
-- place where some lookahead for a full view is needed ???
return
Is_Elementary_Type (Ent)
or else (Is_Private_Type (Ent)
and then Present (Underlying_Type (Ent))
and then Is_Elementary_Type (Underlying_Type (Ent)));
end Is_By_Copy_Type;
--------------------------
-- Is_By_Reference_Type --
--------------------------
function Is_By_Reference_Type (Ent : Entity_Id) return Boolean is
Btype : constant Entity_Id := Base_Type (Ent);
begin
if Error_Posted (Ent)
or else Error_Posted (Btype)
then
return False;
elsif Is_Private_Type (Btype) then
declare
Utyp : constant Entity_Id := Underlying_Type (Btype);
begin
if No (Utyp) then
return False;
else
return Is_By_Reference_Type (Utyp);
end if;
end;
elsif Is_Incomplete_Type (Btype) then
declare
Ftyp : constant Entity_Id := Full_View (Btype);
begin
if No (Ftyp) then
return False;
else
return Is_By_Reference_Type (Ftyp);
end if;
end;
elsif Is_Concurrent_Type (Btype) then
return True;
elsif Is_Record_Type (Btype) then
if Is_Limited_Record (Btype)
or else Is_Tagged_Type (Btype)
or else Is_Volatile (Btype)
then
return True;
else
declare
C : Entity_Id;
begin
C := First_Component (Btype);
while Present (C) loop
if Is_By_Reference_Type (Etype (C))
or else Is_Volatile (Etype (C))
then
return True;
end if;
C := Next_Component (C);
end loop;
end;
return False;
end if;
elsif Is_Array_Type (Btype) then
return
Is_Volatile (Btype)
or else Is_By_Reference_Type (Component_Type (Btype))
or else Is_Volatile (Component_Type (Btype))
or else Has_Volatile_Components (Btype);
else
return False;
end if;
end Is_By_Reference_Type;
---------------------
-- Is_Derived_Type --
---------------------
function Is_Derived_Type (Ent : E) return B is
Par : Node_Id;
begin
if Is_Type (Ent)
and then Base_Type (Ent) /= Root_Type (Ent)
and then not Is_Class_Wide_Type (Ent)
then
if not Is_Numeric_Type (Root_Type (Ent)) then
return True;
else
Par := Parent (First_Subtype (Ent));
return Present (Par)
and then Nkind (Par) = N_Full_Type_Declaration
and then Nkind (Type_Definition (Par)) =
N_Derived_Type_Definition;
end if;
else
return False;
end if;
end Is_Derived_Type;
---------------------------
-- Is_Indefinite_Subtype --
---------------------------
function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean is
K : constant Entity_Kind := Ekind (Ent);
begin
if Is_Constrained (Ent) then
return False;
elsif K in Array_Kind
or else K in Class_Wide_Kind
or else Has_Unknown_Discriminants (Ent)
then
return True;
-- Known discriminants: indefinite if there are no default values
elsif K in Record_Kind
or else Is_Incomplete_Or_Private_Type (Ent)
or else Is_Concurrent_Type (Ent)
then
return (Has_Discriminants (Ent)
and then
No (Discriminant_Default_Value (First_Discriminant (Ent))));
else
return False;
end if;
end Is_Indefinite_Subtype;
--------------------------------
-- Is_Inherently_Limited_Type --
--------------------------------
function Is_Inherently_Limited_Type (Ent : Entity_Id) return Boolean is
Btype : constant Entity_Id := Base_Type (Ent);
begin
if Is_Private_Type (Btype) then
declare
Utyp : constant Entity_Id := Underlying_Type (Btype);
begin
if No (Utyp) then
return False;
else
return Is_Inherently_Limited_Type (Utyp);
end if;
end;
elsif Is_Concurrent_Type (Btype) then
return True;
elsif Is_Record_Type (Btype) then
if Is_Limited_Record (Btype) then
return not Is_Interface (Btype)
or else Is_Protected_Interface (Btype)
or else Is_Synchronized_Interface (Btype)
or else Is_Task_Interface (Btype);
elsif Is_Class_Wide_Type (Btype) then
return Is_Inherently_Limited_Type (Root_Type (Btype));
else
declare
C : Entity_Id;
begin
C := First_Component (Btype);
while Present (C) loop
if Is_Inherently_Limited_Type (Etype (C)) then
return True;
end if;
C := Next_Component (C);
end loop;
end;
return False;
end if;
elsif Is_Array_Type (Btype) then
return Is_Inherently_Limited_Type (Component_Type (Btype));
else
return False;
end if;
end Is_Inherently_Limited_Type;
---------------------
-- Is_Limited_Type --
---------------------
function Is_Limited_Type (Ent : Entity_Id) return Boolean is
Btype : constant E := Base_Type (Ent);
Rtype : constant E := Root_Type (Btype);
begin
if not Is_Type (Ent) then
return False;
elsif Ekind (Btype) = E_Limited_Private_Type
or else Is_Limited_Composite (Btype)
then
return True;
elsif Is_Concurrent_Type (Btype) then
return True;
-- The Is_Limited_Record flag normally indicates that the type is
-- limited. The exception is that a type does not inherit limitedness
-- from its interface ancestor. So the type may be derived from a
-- limited interface, but is not limited.
elsif Is_Limited_Record (Ent)
and then not Is_Interface (Ent)
then
return True;
-- Otherwise we will look around to see if there is some other reason
-- for it to be limited, except that if an error was posted on the
-- entity, then just assume it is non-limited, because it can cause
-- trouble to recurse into a murky erroneous entity!
elsif Error_Posted (Ent) then
return False;
elsif Is_Record_Type (Btype) then
if Is_Limited_Interface (Ent) then
return True;
-- AI-419: limitedness is not inherited from a limited interface
elsif Is_Limited_Record (Rtype) then
return not Is_Interface (Rtype)
or else Is_Protected_Interface (Rtype)
or else Is_Synchronized_Interface (Rtype)
or else Is_Task_Interface (Rtype);
elsif Is_Class_Wide_Type (Btype) then
return Is_Limited_Type (Rtype);
else
declare
C : E;
begin
C := First_Component (Btype);
while Present (C) loop
if Is_Limited_Type (Etype (C)) then
return True;
end if;
C := Next_Component (C);
end loop;
end;
return False;
end if;
elsif Is_Array_Type (Btype) then
return Is_Limited_Type (Component_Type (Btype));
else
return False;
end if;
end Is_Limited_Type;
------------------------
-- Next_Tag_Component --
------------------------
function Next_Tag_Component (Tag : Entity_Id) return Entity_Id is
Comp : Entity_Id;
begin
pragma Assert (Is_Tag (Tag));
Comp := Next_Entity (Tag);
while Present (Comp) loop
if Is_Tag (Comp) then
pragma Assert (Chars (Comp) /= Name_uTag);
return Comp;
end if;
Comp := Next_Entity (Comp);
end loop;
-- No tag component found
return Empty;
end Next_Tag_Component;
--------------------------
-- Number_Discriminants --
--------------------------
function Number_Discriminants (Typ : Entity_Id) return Pos is
N : Int;
Discr : Entity_Id;
begin
N := 0;
Discr := First_Discriminant (Typ);
while Present (Discr) loop
N := N + 1;
Discr := Next_Discriminant (Discr);
end loop;
return N;
end Number_Discriminants;
---------------
-- Tree_Read --
---------------

131
gcc/ada/sem_aux.ads

@ -33,13 +33,14 @@
-- Package containing utility procedures used throughout the compiler,
-- and also by ASIS so dependencies are limited to ASIS included packages.
-- Note: contents are minimal for now, the intent is to move stuff from
-- Sem_Util that meets the ASIS dependency requirements, and also stuff
-- from Einfo, where Einfo had excessive semantic knowledge of the tree.
-- Historical note. Many of the routines here were originally in Einfo, but
-- Einfo is supposed to be a relatively low level package dealing with the
-- content of entities in the tree, so this package is used for routines that
-- require more than minimal semantic knowldge.
with Alloc; use Alloc;
with Alloc; use Alloc;
with Table;
with Types; use Types;
with Types; use Types;
package Sem_Aux is
@ -66,21 +67,125 @@ package Sem_Aux is
Table_Increment => Alloc.Obsolescent_Warnings_Increment,
Table_Name => "Obsolescent_Warnings");
-----------------
-- Subprograms --
-----------------
procedure Initialize;
-- Called at the start of compilation of each new main source file to
-- initialize the allocation of the Obsolescent_Warnings table. Note that
-- Initialize must not be called if Tree_Read is used.
procedure Tree_Read;
-- Initializes internal tables from current tree file using the relevant
-- Table.Tree_Read routines.
-- Initializes Obsolescent_Warnings table from current tree file using the
-- relevant Table.Tree_Read routine.
procedure Tree_Write;
-- Writes out internal tables to current tree file using the relevant
-- Table.Tree_Write routines.
-- Writes out Obsolescent_Warnings table to current tree file using the
-- relevant Table.Tree_Write routine.
-----------------
-- Subprograms --
-----------------
function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id;
-- The argument Id is a type or subtype entity. If the argument is a
-- subtype then it returns the subtype or type from which the subtype was
-- obtained, otherwise it returns Empty.
function Available_View (Typ : Entity_Id) return Entity_Id;
-- Typ is typically a type that has the With_Type flag set. Returns the
-- non-limited view of the type, if available, otherwise the type itself.
-- For class-wide types, there is no direct link in the tree, so we have
-- to retrieve the class-wide type of the non-limited view of the Etype.
-- Returns the argument unchanged if it is not one of these cases.
function Constant_Value (Ent : Entity_Id) return Node_Id;
-- Id is a variable, constant, named integer, or named real entity. This
-- call obtains the initialization expression for the entity. Will return
-- Empty for for a deferred constant whose full view is not available or
-- in some other cases of internal entities, which cannot be treated as
-- constants from the point of view of constant folding. Empty is also
-- returned for variables with no initialization expression.
function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id;
-- For any entity, Ent, returns the closest dynamic scope in which the
-- entity is declared or Standard_Standard for library-level entities
function First_Discriminant (Typ : Entity_Id) return Entity_Id;
-- Typ is a type with discriminants. The discriminants are the first
-- entities declared in the type, so normally this is equivalent to
-- First_Entity. The exception arises for tagged types, where the tag
-- itself is prepended to the front of the entity chain, so the
-- First_Discriminant function steps past the tag if it is present.
function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id;
-- Typ is a type with discriminants. Gives the first discriminant stored
-- in an object of this type. In many cases, these are the same as the
-- normal visible discriminants for the type, but in the case of renamed
-- discriminants, this is not always the case.
--
-- For tagged types, and untagged types which are root types or derived
-- types but which do not rename discriminants in their root type, the
-- stored discriminants are the same as the actual discriminants of the
-- type, and hence this function is the same as First_Discriminant.
--
-- For derived non-tagged types that rename discriminants in the root type
-- this is the first of the discriminants that occur in the root type. To
-- be precise, in this case stored discriminants are entities attached to
-- the entity chain of the derived type which are a copy of the
-- discriminants of the root type. Furthermore their Is_Completely_Hidden
-- flag is set since although they are actually stored in the object, they
-- are not in the set of discriminants that is visble in the type.
--
-- For derived untagged types, the set of stored discriminants are the real
-- discriminants from Gigi's standpoint, i.e. those that will be stored in
-- actual objects of the type.
function First_Subtype (Typ : Entity_Id) return Entity_Id;
-- Applies to all types and subtypes. For types, yields the first subtype
-- of the type. For subtypes, yields the first subtype of the base type of
-- the subtype.
function First_Tag_Component (Typ : Entity_Id) return Entity_Id;
-- Typ must be a tagged record type. This function returns the Entity for
-- the first _Tag field in the record type.
function Is_By_Copy_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by copy, as defined in (RM 6.2(3)).
function Is_By_Reference_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by reference, as defined in (RM 6.2(4-9)).
function Is_Derived_Type (Ent : Entity_Id) return Boolean;
-- Determines if the given entity Ent is a derived type. Result is always
-- false if argument is not a type.
function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Determines if given entity is an unconstrained array
-- type or subtype, a discriminated record type or subtype with no initial
-- discriminant values or a class wide type or subtype and returns True if
-- so. False for other type entities, or any entities that are not types.
function Is_Inherently_Limited_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. True for a type that is "inherently" limited (i.e.
-- cannot become nonlimited). From the Ada 2005 RM-7.5(8.1/2), "a type with
-- a part that is of a task, protected, or explicitly limited record type".
-- These are the types that are defined as return-by-reference types in Ada
-- 95 (see RM95-6.5(11-16)). In Ada 2005, these are the types that require
-- build-in-place for function calls. Note that build-in-place is allowed
-- for other types, too.
function Is_Limited_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns true if Ent is a limited type (limited
-- private type, limited interface type, task type, protected type,
-- composite containing a limited component, or a subtype of any of
-- these types).
function Next_Tag_Component (Tag : Entity_Id) return Entity_Id;
-- Tag must be an entity representing a _Tag field of a tagged record.
-- The result returned is the next _Tag field in this record, or Empty
-- if this is the last such field.
function Number_Discriminants (Typ : Entity_Id) return Pos;
-- Typ is a type with discriminants, yields number of discriminants in type
end Sem_Aux;

2
gcc/ada/sem_case.adb

@ -31,6 +31,8 @@ with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;

1
gcc/ada/sem_cat.adb

@ -35,6 +35,7 @@ with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;

1
gcc/ada/sem_ch12.adb

@ -43,6 +43,7 @@ with Rident; use Rident;
with Restrict; use Restrict;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;

1
gcc/ada/sem_ch13.adb

@ -39,6 +39,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;

1
gcc/ada/sem_ch3.adb

@ -49,6 +49,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;

1
gcc/ada/sem_ch4.adb

@ -42,6 +42,7 @@ with Output; use Output;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;

1
gcc/ada/sem_ch5.adb

@ -38,6 +38,7 @@ with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;

1
gcc/ada/sem_ch6.adb

@ -49,6 +49,7 @@ with Opt; use Opt;
with Output; use Output;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch4; use Sem_Ch4;

1
gcc/ada/sem_ch7.adb

@ -44,6 +44,7 @@ with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;

1
gcc/ada/sem_ch8.adb

@ -46,6 +46,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch4; use Sem_Ch4;

1
gcc/ada/sem_ch9.adb

@ -40,6 +40,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch5; use Sem_Ch5;
with Sem_Ch6; use Sem_Ch6;

1
gcc/ada/sem_disp.adb

@ -40,6 +40,7 @@ with Output; use Output;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch6; use Sem_Ch6;
with Sem_Eval; use Sem_Eval;
with Sem_Type; use Sem_Type;

1
gcc/ada/sem_dist.adb

@ -35,6 +35,7 @@ with Namet; use Namet;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;

1
gcc/ada/sem_eval.adb

@ -37,6 +37,7 @@ with Nmake; use Nmake;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;

1
gcc/ada/sem_mech.adb

@ -29,6 +29,7 @@ with Errout; use Errout;
with Namet; use Namet;
with Nlists; use Nlists;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;

1
gcc/ada/sem_res.adb

@ -50,6 +50,7 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Aggr; use Sem_Aggr;
with Sem_Attr; use Sem_Attr;
with Sem_Cat; use Sem_Cat;

15
gcc/ada/sem_smem.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2008, 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- --
@ -23,12 +23,13 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Einfo; use Einfo;
with Errout; use Errout;
with Namet; use Namet;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Atree; use Atree;
with Einfo; use Einfo;
with Errout; use Errout;
with Namet; use Namet;
with Sem_Aux; use Sem_Aux;
with Sinfo; use Sinfo;
with Snames; use Snames;
package body Sem_Smem is

1
gcc/ada/sem_type.adb

@ -35,6 +35,7 @@ with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch12; use Sem_Ch12;

1
gcc/ada/sem_util.adb

@ -43,6 +43,7 @@ with Rtsfind; use Rtsfind;
with Scans; use Scans;
with Scn; use Scn;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Attr; use Sem_Attr;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;

1
gcc/ada/tbuild.adb

@ -32,6 +32,7 @@ with Nmake; use Nmake;
with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem_Aux; use Sem_Aux;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;