From 2b14f3259ebca3c074008e5f8704b006eea1a1da Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Tue, 22 Jun 2010 13:32:54 +0000 Subject: 2010-06-22 Javier Miranda * sem_prag.adb, sem_util.adb, sem_util.ads, sem_attr.adb, exp_ch6.adb, exp_disp.adb, sem_eval.adb, exp_dist.adb lib-xref.adb: Code cleanup, this patch replaces duplication of code that traverses the chain of aliased primitives by a call to routine Ultimate_Alias that provides this functionality. git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@161184 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 8 +++++++ gcc/ada/exp_ch6.adb | 4 +--- gcc/ada/exp_disp.adb | 59 +++++++++------------------------------------ gcc/ada/exp_dist.adb | 10 ++------ gcc/ada/lib-xref.adb | 14 +++-------- gcc/ada/sem_attr.adb | 6 +---- gcc/ada/sem_eval.adb | 5 +--- gcc/ada/sem_prag.adb | 4 +--- gcc/ada/sem_util.adb | 2 +- gcc/ada/sem_util.ads | 68 ++++++++++++++++++++++++++-------------------------- 10 files changed, 63 insertions(+), 117 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cf49abfa38e..6adafcc7981 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2010-06-22 Javier Miranda + + * sem_prag.adb, sem_util.adb, sem_util.ads, sem_attr.adb, exp_ch6.adb, + exp_disp.adb, sem_eval.adb, exp_dist.adb lib-xref.adb: Code cleanup, + this patch replaces duplication of code that traverses the chain of + aliased primitives by a call to routine Ultimate_Alias that + provides this functionality. + 2010-06-22 Arnaud Charlet * fmap.adb, opt.ads, osint.adb, osint.ads, output.ads, scng.adb, diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index b8659aa07f2..351d18e2bb0 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2668,9 +2668,7 @@ package body Exp_Ch6 is if Present (Inherited_From_Formal (Subp)) then Parent_Subp := Inherited_From_Formal (Subp); else - while Present (Alias (Parent_Subp)) loop - Parent_Subp := Alias (Parent_Subp); - end loop; + Parent_Subp := Ultimate_Alias (Parent_Subp); end if; -- The below setting of Entity is suspect, see F109-018 discussion??? diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index e6dc68c5207..c05b057edc3 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1843,23 +1843,10 @@ package body Exp_Disp is function Is_Predefined_Dispatching_Alias (Prim : Entity_Id) return Boolean is - E : Entity_Id; - begin - if not Is_Predefined_Dispatching_Operation (Prim) + return not Is_Predefined_Dispatching_Operation (Prim) and then Present (Alias (Prim)) - then - E := Prim; - while Present (Alias (E)) loop - E := Alias (E); - end loop; - - if Is_Predefined_Dispatching_Operation (E) then - return True; - end if; - end if; - - return False; + and then Is_Predefined_Dispatching_Operation (Ultimate_Alias (Prim)); end Is_Predefined_Dispatching_Alias; --------------------------------------- @@ -3703,11 +3690,8 @@ package body Exp_Disp is Alias (Prim); else - while Present (Alias (Prim)) loop - Prim := Alias (Prim); - end loop; - - Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code); + Expand_Interface_Thunk + (Ultimate_Alias (Prim), Thunk_Id, Thunk_Code); if Present (Thunk_Id) then Append_To (Result, Thunk_Code); @@ -3874,12 +3858,7 @@ package body Exp_Disp is (Interface_Alias (Prim)) = Iface then Prim_Alias := Interface_Alias (Prim); - - E := Prim; - while Present (Alias (E)) loop - E := Alias (E); - end loop; - + E := Ultimate_Alias (Prim); Pos := UI_To_Int (DT_Position (Prim_Alias)); if Present (Prim_Table (Pos)) then @@ -4933,9 +4912,7 @@ package body Exp_Disp is Prim := Node (Prim_Elmt); if Chars (Prim) = Name_uSize then - while Present (Alias (Prim)) loop - Prim := Alias (Prim); - end loop; + Prim := Ultimate_Alias (Prim); if Is_Abstract_Subprogram (Prim) then Append_To (TSD_Aggr_List, @@ -5396,11 +5373,7 @@ package body Exp_Disp is and then not Present (Prim_Table (UI_To_Int (DT_Position (Prim)))) then - E := Prim; - while Present (Alias (E)) loop - E := Alias (E); - end loop; - + E := Ultimate_Alias (Prim); pragma Assert (not Is_Abstract_Subprogram (E)); Prim_Table (UI_To_Int (DT_Position (Prim))) := E; end if; @@ -6121,10 +6094,7 @@ package body Exp_Disp is -- Retrieve the root of the alias chain - Prim_Als := Prim; - while Present (Alias (Prim_Als)) loop - Prim_Als := Alias (Prim_Als); - end loop; + Prim_Als := Ultimate_Alias (Prim); -- In the case of an entry wrapper, set the entry index @@ -6656,10 +6626,7 @@ package body Exp_Disp is begin -- Retrieve the original primitive operation - Prim_Op := Prim; - while Present (Alias (Prim_Op)) loop - Prim_Op := Alias (Prim_Op); - end loop; + Prim_Op := Ultimate_Alias (Prim); if Ekind (Typ) = E_Record_Type and then Present (Corresponding_Concurrent_Type (Typ)) @@ -7179,12 +7146,8 @@ package body Exp_Disp is Set_DT_Position (Prim, Default_Prim_Op_Position (Prim)); elsif Is_Predefined_Dispatching_Alias (Prim) then - E := Alias (Prim); - while Present (Alias (E)) loop - E := Alias (E); - end loop; - - Set_DT_Position (Prim, Default_Prim_Op_Position (E)); + Set_DT_Position (Prim, + Default_Prim_Op_Position (Ultimate_Alias (Prim))); -- Overriding primitives of ancestor abstract interfaces diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 8b9dabd00bd..5817d7ac73e 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -1346,13 +1346,7 @@ package body Exp_Dist is -- primitive may have been inherited, go back the alias chain -- until the real primitive has been found. - Current_Primitive_Alias := Current_Primitive; - while Present (Alias (Current_Primitive_Alias)) loop - pragma Assert - (Current_Primitive_Alias - /= Alias (Current_Primitive_Alias)); - Current_Primitive_Alias := Alias (Current_Primitive_Alias); - end loop; + Current_Primitive_Alias := Ultimate_Alias (Current_Primitive); -- Copy the spec from the original declaration for the purpose -- of declaring an overriding subprogram: we need to replace diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index e0050c02036..5283023a856 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -214,7 +214,6 @@ package body Lib.Xref is Base_T : Entity_Id; Prim : Elmt_Id; Prim_List : Elist_Id; - Ent : Entity_Id; begin -- Handle subtypes of synchronized types @@ -262,12 +261,8 @@ package body Lib.Xref is -- reference purposes (it is the original for which we want the xref -- and for which the comes_from_source test must be performed). - Ent := Node (Prim); - while Present (Alias (Ent)) loop - Ent := Alias (Ent); - end loop; - - Generate_Reference (Typ, Ent, 'p', Set_Ref => False); + Generate_Reference + (Typ, Ultimate_Alias (Node (Prim)), 'p', Set_Ref => False); Next_Elmt (Prim); end loop; end Generate_Prim_Op_References; @@ -1704,10 +1699,7 @@ package body Lib.Xref is -- through several levels of derivation, so find the -- ultimate (source) ancestor. - Op := Alias (Old_E); - while Present (Alias (Op)) loop - Op := Alias (Op); - end loop; + Op := Ultimate_Alias (Old_E); -- Normal case of no alias present diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 9d1589afa01..2efd558f99d 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3545,13 +3545,9 @@ package body Sem_Attr is ---------------------- procedure Must_Be_Imported (Proc_Ent : Entity_Id) is - Pent : Entity_Id := Proc_Ent; + Pent : constant Entity_Id := Ultimate_Alias (Proc_Ent); begin - while Present (Alias (Pent)) loop - Pent := Alias (Pent); - end loop; - -- Ignore check if procedure not frozen yet (we will get -- another chance when the default parameter is reanalyzed) diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index d2aeae9d13e..84bb34a66f2 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -1674,10 +1674,7 @@ package body Sem_Eval is and then Present (Alias (Entity (Name (N)))) and then Is_Enumeration_Type (Base_Type (Typ)) then - Lit := Alias (Entity (Name (N))); - while Present (Alias (Lit)) loop - Lit := Alias (Lit); - end loop; + Lit := Ultimate_Alias (Entity (Name (N))); if Ekind (Lit) = E_Enumeration_Literal then if Base_Type (Etype (Lit)) /= Base_Type (Typ) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 81dc1d1c321..0fb0adeeddd 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3956,9 +3956,7 @@ package body Sem_Prag is -- entity (if declared in the same unit) is inlined. if Is_Subprogram (Subp) then - while Present (Alias (Inner_Subp)) loop - Inner_Subp := Alias (Inner_Subp); - end loop; + Inner_Subp := Ultimate_Alias (Inner_Subp); if In_Same_Source_Unit (Subp, Inner_Subp) then Set_Inline_Flags (Inner_Subp); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9e0dece40c0..c8a98b88f45 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11128,13 +11128,13 @@ package body Sem_Util is -------------------- -- Ultimate_Alias -- -------------------- - -- To do: add occurrences calling this new subprogram function Ultimate_Alias (Prim : Entity_Id) return Entity_Id is E : Entity_Id := Prim; begin while Present (Alias (E)) loop + pragma Assert (Alias (E) /= E); E := Alias (E); end loop; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 2720b4e1232..8da6b52223e 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -216,6 +216,7 @@ package Sem_Util is -- for stubbed subprograms. function Current_Entity (N : Node_Id) return Entity_Id; + pragma Inline (Current_Entity); -- Find the currently visible definition for a given identifier, that is to -- say the first entry in the visibility chain for the Chars of N. @@ -464,6 +465,7 @@ package Sem_Util is -- Decl_Node into the name buffer. function Get_Name_Entity_Id (Id : Name_Id) return Entity_Id; + pragma Inline (Get_Name_Entity_Id); -- An entity value is associated with each name in the name table. The -- Get_Name_Entity_Id function fetches the Entity_Id of this entity, -- which is the innermost visible entity with the given name. See the @@ -696,9 +698,10 @@ package Sem_Util is -- it is of protected, synchronized or task kind. function Is_False (U : Uint) return Boolean; - -- The argument is a Uint value which is the Boolean'Pos value of a - -- Boolean operand (i.e. is either 0 for False, or 1 for True). This - -- function simply tests if it is False (i.e. zero) + pragma Inline (Is_False); + -- The argument is a Uint value which is the Boolean'Pos value of a Boolean + -- operand (i.e. is either 0 for False, or 1 for True). This function tests + -- if it is False (i.e. zero). function Is_Fixed_Model_Number (U : Ureal; T : Entity_Id) return Boolean; -- Returns True iff the number U is a model number of the fixed- @@ -734,11 +737,11 @@ package Sem_Util is -- variable and constant objects return True (compare Is_Variable). function Is_OK_Variable_For_Out_Formal (AV : Node_Id) return Boolean; - -- Used to test if AV is an acceptable formal for an OUT or IN OUT - -- formal. Note that the Is_Variable function is not quite the right - -- test because this is a case in which conversions whose expression - -- is a variable (in the Is_Variable sense) with a non-tagged type - -- target are considered view conversions and hence variables. + -- Used to test if AV is an acceptable formal for an OUT or IN OUT formal. + -- Note that the Is_Variable function is not quite the right test because + -- this is a case in which conversions whose expression is a variable (in + -- the Is_Variable sense) with a non-tagged type target are considered view + -- conversions and hence variables. function Is_Partially_Initialized_Type (Typ : Entity_Id) return Boolean; -- Typ is a type entity. This function returns true if this type is partly @@ -782,6 +785,7 @@ package Sem_Util is -- normally such nodes represent a direct name. function Is_Statement (N : Node_Id) return Boolean; + pragma Inline (Is_Statement); -- Check if the node N is a statement node. Note that this includes -- the case of procedure call statements (unlike the direct use of -- the N_Statement_Other_Than_Procedure_Call subtype from Sinfo). @@ -791,14 +795,15 @@ package Sem_Util is -- Returns True if E is a synchronized tagged type (AARM 3.9.4 (6/2)) function Is_Transfer (N : Node_Id) return Boolean; - -- Returns True if the node N is a statement which is known to cause - -- an unconditional transfer of control at runtime, i.e. the following + -- Returns True if the node N is a statement which is known to cause an + -- unconditional transfer of control at runtime, i.e. the following -- statement definitely will not be executed. function Is_True (U : Uint) return Boolean; - -- The argument is a Uint value which is the Boolean'Pos value of a - -- Boolean operand (i.e. is either 0 for False, or 1 for True). This - -- function simply tests if it is True (i.e. non-zero) + pragma Inline (Is_True); + -- The argument is a Uint value which is the Boolean'Pos value of a Boolean + -- operand (i.e. is either 0 for False, or 1 for True). This function tests + -- if it is True (i.e. non-zero). function Is_Universal_Numeric_Type (T : Entity_Id) return Boolean; pragma Inline (Is_Universal_Numeric_Type); @@ -1004,7 +1009,8 @@ package Sem_Util is procedure Next_Actual (Actual_Id : in out Node_Id); pragma Inline (Next_Actual); - -- Next_Actual (N) is equivalent to N := Next_Actual (N) + -- Next_Actual (N) is equivalent to N := Next_Actual (N). Note that we + -- inline this procedural form, but not the functional form that follows. function Next_Actual (Actual_Id : Node_Id) return Node_Id; -- Find next actual parameter in declaration order. As described for @@ -1172,6 +1178,7 @@ package Sem_Util is -- foreign convention, then we set Can_Use_Internal_Rep to False on E. procedure Set_Current_Entity (E : Entity_Id); + pragma Inline (Set_Current_Entity); -- Establish the entity E as the currently visible definition of its -- associated name (i.e. the Node_Id associated with its name) @@ -1189,6 +1196,7 @@ package Sem_Util is -- can check identifier spelling style. procedure Set_Name_Entity_Id (Id : Name_Id; Val : Entity_Id); + pragma Inline (Set_Name_Entity_Id); -- Sets the Entity_Id value associated with the given name, which is the -- Id of the innermost visible entity with the given name. See the body -- of package Sem_Ch8 for further details on the handling of visibility. @@ -1219,6 +1227,7 @@ package Sem_Util is -- Set the flag Is_Transient of the current scope procedure Set_Size_Info (T1, T2 : Entity_Id); + pragma Inline (Set_Size_Info); -- Copies the Esize field and Has_Biased_Representation flag from sub(type) -- entity T2 to (sub)type entity T1. Also copies the Is_Unsigned_Type flag -- in the fixed-point and discrete cases, and also copies the alignment @@ -1252,8 +1261,9 @@ package Sem_Util is -- Return the accessibility level of Typ function Ultimate_Alias (Prim : Entity_Id) return Entity_Id; - -- Return the last entity in the chain of aliased entities of Prim. - -- If Prim has no alias return Prim. + pragma Inline (Ultimate_Alias); + -- Return the last entity in the chain of aliased entities of Prim. If Prim + -- has no alias return Prim. function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id; -- Unit_Id is the simple name of a program unit, this function returns the @@ -1266,28 +1276,18 @@ package Sem_Util is -- Yields Universal_Integer or Universal_Real if this is a candidate function Unqualify (Expr : Node_Id) return Node_Id; - -- Removes any qualifications from Expr. For example, for T1'(T2'(X)), - -- this returns X. If Expr is not a qualified expression, returns Expr. + pragma Inline (Unqualify); + -- Removes any qualifications from Expr. For example, for T1'(T2'(X)), this + -- returns X. If Expr is not a qualified expression, returns Expr. function Within_Init_Proc return Boolean; -- Determines if Current_Scope is within an init proc procedure Wrong_Type (Expr : Node_Id; Expected_Type : Entity_Id); - -- Output error message for incorrectly typed expression. Expr is the - -- node for the incorrectly typed construct (Etype (Expr) is the type - -- found), and Expected_Type is the entity for the expected type. Note - -- that Expr does not have to be a subexpression, anything with an - -- Etype field may be used. - -private - pragma Inline (Current_Entity); - pragma Inline (Get_Name_Entity_Id); - pragma Inline (Is_False); - pragma Inline (Is_Statement); - pragma Inline (Is_True); - pragma Inline (Set_Current_Entity); - pragma Inline (Set_Name_Entity_Id); - pragma Inline (Set_Size_Info); - pragma Inline (Unqualify); + -- Output error message for incorrectly typed expression. Expr is the node + -- for the incorrectly typed construct (Etype (Expr) is the type found), + -- and Expected_Type is the entity for the expected type. Note that Expr + -- does not have to be a subexpression, anything with an Etype field may + -- be used. end Sem_Util; -- cgit v1.2.3