diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-04-09 10:27:10 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-04-09 10:27:10 +0000 |
| commit | d60c9ff7609bacfd60f686e1f3b935b0a67b793e (patch) | |
| tree | 61e8efa1dd19ecaf93ec8ce28f75848c145f7599 /gcc | |
| parent | bfd188a4e2828f54120df76e1339453a716d6d89 (diff) | |
| download | gcc-d60c9ff7609bacfd60f686e1f3b935b0a67b793e.tar.gz | |
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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145820 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
52 files changed, 926 insertions, 881 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fc35d44a530..42e1f1c9793 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,19 @@ 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. * atree.h: Add Elist26 diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index cb32cc2ef87..da6ca2e68c8 100644 --- a/gcc/ada/checks.adb +++ b/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; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index dcb6ada39b4..d4dad33e660 100644 --- a/gcc/ada/einfo.adb +++ b/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 -- --------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 3f5443f08e5..4de103e6e4c 100644 --- a/gcc/ada/einfo.ads +++ b/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; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 21a0fd83aea..6ea4ddc961f 100644 --- a/gcc/ada/exp_aggr.adb +++ b/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; diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb index 318614e598f..c94b319ecc0 100644 --- a/gcc/ada/exp_atag.adb +++ b/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; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 7f82cde78b1..d68bc5e107d 100644 --- a/gcc/ada/exp_attr.adb +++ b/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; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 7de774e014a..39ac9c95af3 100644 --- a/gcc/ada/exp_ch3.adb +++ b/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; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 33a4ce35cb6..ccd990eeb6a 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 16cb44fad2d..b20d5685ac1 100644 --- a/gcc/ada/exp_ch5.adb +++ b/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; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index ae5b8d547d1..19c90ad59fe 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 9b11ce7502f..334b99a48b5 100644 --- a/gcc/ada/exp_ch7.adb +++ b/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; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index de5877cc488..b0e81eb6490 100644 --- a/gcc/ada/exp_ch9.adb +++ b/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; diff --git a/gcc/ada/exp_code.adb b/gcc/ada/exp_code.adb index b57117c2010..e42bd6aa9dc 100644 --- a/gcc/ada/exp_code.adb +++ b/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; diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 0a48868b3e0..34ae7e2b652 100644 --- a/gcc/ada/exp_dbug.adb +++ b/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; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 66279a8a103..f5149735147 100644 --- a/gcc/ada/exp_disp.adb +++ b/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; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index b723ea1cc98..516a55f46fd 100644 --- a/gcc/ada/exp_dist.adb +++ b/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; diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index c04fb0f3a49..ed53ca0c111 100644 --- a/gcc/ada/exp_imgv.adb +++ b/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; diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index d66ed0f7519..ad22ec1f5c9 100644 --- a/gcc/ada/exp_pakd.adb +++ b/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; diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index 60d1385f15a..c685b7bb290 100644 --- a/gcc/ada/exp_smem.adb +++ b/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; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index d0b1b7f43a5..42c34a8487e 100644 --- a/gcc/ada/exp_strm.adb +++ b/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; diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index acddeb11abd..b350644c24e 100644 --- a/gcc/ada/exp_tss.adb +++ b/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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b61801cbaba..95c73d522d7 100644 --- a/gcc/ada/exp_util.adb +++ b/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; diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index e69f798db5d..44f41655f75 100644 --- a/gcc/ada/fe.h +++ b/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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index a26879af35f..9a76e040dd1 100644 --- a/gcc/ada/freeze.adb +++ b/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; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 4a9b1f61e05..33b4372ed6e 100644 --- a/gcc/ada/inline.adb +++ b/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; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index d4dcd3cb201..7c392209b8f 100644 --- a/gcc/ada/layout.adb +++ b/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; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 04c39a5085d..3e36d0c84ed 100644 --- a/gcc/ada/lib-xref.adb +++ b/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; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 13ab96c6c63..402b7384c9a 100644 --- a/gcc/ada/sem_aggr.adb +++ b/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; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 0871ce83d0b..7758f4b6654 100644 --- a/gcc/ada/sem_attr.adb +++ b/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; diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 58b5b5c0da7..4acfb1d48bd 100755 --- a/gcc/ada/sem_aux.adb +++ b/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 -- --------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index d9d74821ff1..53bad53faee 100755 --- a/gcc/ada/sem_aux.ads +++ b/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; diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 763144c296b..f226c348bde 100644 --- a/gcc/ada/sem_case.adb +++ b/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; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 76f5f5e1c4d..e24b456952f 100644 --- a/gcc/ada/sem_cat.adb +++ b/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; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index acacec591de..d5a8a2e5f8f 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index d9b626f8981..f5394dc172d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a67048bfa0e..e098924f523 100644 --- a/gcc/ada/sem_ch3.adb +++ b/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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 358541afa64..bd546fa845f 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 888ac0222ad..6ae5d7f4645 100644 --- a/gcc/ada/sem_ch5.adb +++ b/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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 0b2af3448a6..df625f82da4 100644 --- a/gcc/ada/sem_ch6.adb +++ b/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; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 46cd9383987..7b9edd48e28 100644 --- a/gcc/ada/sem_ch7.adb +++ b/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; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c7cda589446..c34b073c125 100644 --- a/gcc/ada/sem_ch8.adb +++ b/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; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 8a85b11e6ee..00ca88b1fe9 100644 --- a/gcc/ada/sem_ch9.adb +++ b/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; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index a8eb3df52e3..e7419a813d7 100644 --- a/gcc/ada/sem_disp.adb +++ b/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; diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 211bdddb49e..39db631e0d1 100644 --- a/gcc/ada/sem_dist.adb +++ b/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; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index b29417153ab..62772e39991 100644 --- a/gcc/ada/sem_eval.adb +++ b/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; diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index 87a0d054451..5f18176b8c2 100644 --- a/gcc/ada/sem_mech.adb +++ b/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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 21369ae725e..9ff9d80766e 100644 --- a/gcc/ada/sem_res.adb +++ b/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; diff --git a/gcc/ada/sem_smem.adb b/gcc/ada/sem_smem.adb index 59d52e14094..bca184ef658 100644 --- a/gcc/ada/sem_smem.adb +++ b/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 diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 3ca2e535478..815986456d8 100644 --- a/gcc/ada/sem_type.adb +++ b/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; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3f60ebcbedf..04187933fdc 100644 --- a/gcc/ada/sem_util.adb +++ b/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; diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 4f25eda7462..217c7f2d8f2 100644 --- a/gcc/ada/tbuild.adb +++ b/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; |