From 2df23f66e28fe9b4c9d533a650c9d65e20b4b1ba Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 11:42:56 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Eric Botcazou * exp_ch4.adb (Library_Level_Target): New function. (Expand_Concatenate): When optimization is enabled, also expand the operation out-of-line if the concatenation is present within the expression of the declaration of a library-level object and not only if it is the expression of the declaration. 2017-04-25 Bob Duff * freeze.adb (Freeze_Object_Declaration): Do not Remove_Side_Effects if there is a pragma Linker_Section, because in that case we want static initialization in the appropriate section. 2017-04-25 Gary Dismukes * exp_dbug.adb: Minor rewording and reformatting. 2017-04-25 Ed Schonberg * sem_attr.adb (Statically_Denotes_Object): New predicate, to handle the proposed changes to rules concerning potentially unevaluated expressions, to include selected components that do not depend on discriminants, and indexed components with static indices. * sem_util.adb (Is_Potentially_Unevaluated): Add check for predicate in quantified expression, and fix bugs in the handling of case expressions and membership test. (Analyze_Attribute_Old_Result): use new predicate. (Analyze_Attribute, case Loop_Entry): ditto. From-SVN: r247167 --- gcc/ada/ChangeLog | 32 +++++++++++++++++++++++++ gcc/ada/exp_ch4.adb | 55 +++++++++++++++++++++++++++++------------- gcc/ada/exp_dbug.adb | 14 +++++++---- gcc/ada/freeze.adb | 5 +++- gcc/ada/sem_attr.adb | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++- gcc/ada/sem_util.adb | 24 ++++++++++++++++--- 6 files changed, 171 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4e0d873..ac39123 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2017-04-25 Eric Botcazou + + * exp_ch4.adb (Library_Level_Target): New function. + (Expand_Concatenate): When optimization is enabled, also expand + the operation out-of-line if the concatenation is present within + the expression of the declaration of a library-level object and + not only if it is the expression of the declaration. + +2017-04-25 Bob Duff + + * freeze.adb (Freeze_Object_Declaration): Do + not Remove_Side_Effects if there is a pragma Linker_Section, + because in that case we want static initialization in the + appropriate section. + +2017-04-25 Gary Dismukes + + * exp_dbug.adb: Minor rewording and reformatting. + +2017-04-25 Ed Schonberg + + * sem_attr.adb (Statically_Denotes_Object): New predicate, to + handle the proposed changes to rules concerning potentially + unevaluated expressions, to include selected components that + do not depend on discriminants, and indexed components with + static indices. + * sem_util.adb (Is_Potentially_Unevaluated): Add check for + predicate in quantified expression, and fix bugs in the handling + of case expressions and membership test. + (Analyze_Attribute_Old_Result): use new predicate. + (Analyze_Attribute, case Loop_Entry): ditto. + 2017-04-25 Bob Duff * s-secsta.adb (SS_Info): Add a comment diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 3854567..1fdc50c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2767,6 +2767,10 @@ package body Exp_Ch4 is -- Set True during generation of the assignments of operands into -- result once an operand known to be non-null has been seen. + function Library_Level_Target return Boolean; + -- Return True if the concatenation is within the expression of the + -- declaration of a library-level object. + function Make_Artyp_Literal (Val : Nat) return Node_Id; -- This function makes an N_Integer_Literal node that is returned in -- analyzed form with the type set to Artyp. Importantly this literal @@ -2782,6 +2786,30 @@ package body Exp_Ch4 is function To_Ityp (X : Node_Id) return Node_Id; -- The inverse function (uses Val in the case of enumeration types) + -------------------------- + -- Library_Level_Target -- + -------------------------- + + function Library_Level_Target return Boolean is + P : Node_Id := Parent (Cnode); + + begin + while Present (P) loop + if Nkind (P) = N_Object_Declaration then + return Is_Library_Level_Entity (Defining_Identifier (P)); + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (P) then + return False; + end if; + + P := Parent (P); + end loop; + + return False; + end Library_Level_Target; + ------------------------ -- Make_Artyp_Literal -- ------------------------ @@ -2842,16 +2870,6 @@ package body Exp_Ch4 is -- Local Declarations - Lib_Level_Target : constant Boolean := - Nkind (Parent (Cnode)) = N_Object_Declaration - and then - Is_Library_Level_Entity (Defining_Identifier (Parent (Cnode))); - - -- If the concatenation declares a library level entity, we call the - -- built-in concatenation routines to prevent code bloat, regardless - -- of optimization level. This is space-efficient, and prevent linking - -- problems when units are compiled with different optimizations. - Opnd_Typ : Entity_Id; Ent : Entity_Id; Len : Uint; @@ -3372,22 +3390,27 @@ package body Exp_Ch4 is -- There are nine or fewer retained (non-null) operands - -- The optimization level is -O0 + -- The optimization level is -O0 or the debug flag gnatd.C is set, + -- and the debug flag gnatd.c is not set. -- The corresponding System.Concat_n.Str_Concat_n routine is -- available in the run time. - -- The debug flag gnatd.c is not set - -- If all these conditions are met then we generate a call to the -- relevant concatenation routine. The purpose of this is to avoid -- undesirable code bloat at -O0. + -- If the concatenation is within the declaration of a library-level + -- object, we call the built-in concatenation routines to prevent code + -- bloat, regardless of the optimization level. This is space efficient + -- and prevents linking problems when units are compiled with different + -- optimization levels. + if Atyp = Standard_String and then NN in 2 .. 9 - and then (Lib_Level_Target - or else ((Optimization_Level = 0 or else Debug_Flag_Dot_CC) - and then not Debug_Flag_Dot_C)) + and then (((Optimization_Level = 0 or else Debug_Flag_Dot_CC) + and then not Debug_Flag_Dot_C) + or else Library_Level_Target) then declare RR : constant array (Nat range 2 .. 9) of RE_Id := diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 3d0ccbd..e463c79 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -389,14 +389,15 @@ package body Exp_Dbug is Ren := Original_Node (Ren); case Nkind (Ren) is - when N_Identifier | N_Expanded_Name => - + when N_Expanded_Name + | N_Identifier + => if not Present (Renamed_Object (Entity (Ren))) then exit; end if; - -- This is a renaming of a renaming: traverse until the - -- final renaming to see if anything is packed on the way. + -- This is a renaming of a renaming: traverse until the final + -- renaming to see if anything is packed along the way. Ren := Renamed_Object (Entity (Ren)); @@ -443,11 +444,14 @@ package body Exp_Dbug is Ren := Prefix (Ren); when N_Slice => + -- Assuming X is an array: -- X (Y1 .. Y2) (Y3) + -- is equivalent to: -- X (Y3) - -- GDB cannot handle packed array slices, so avoid to describe + + -- GDB cannot handle packed array slices, so avoid describing -- the slice if we can avoid it. if not Last_Is_Indexed_Comp then diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 8451788..523040e 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3197,12 +3197,15 @@ package body Freeze is -- Similar processing is needed for aspects that may affect -- object layout, like Alignment, if there is an initialization - -- expression. + -- expression. We don't do this if there is a pragma Linker_Section, + -- because it would prevent the back end from statically initializing + -- the object; we don't want elaboration code in that case. if Has_Delayed_Aspects (E) and then Expander_Active and then Is_Array_Type (Etype (E)) and then Present (Expression (Parent (E))) + and then No (Linker_Section_Pragma (E)) then declare Decl : constant Node_Id := Parent (E); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 1d25da7..833cb8e 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -210,6 +210,15 @@ package body Sem_Attr is -- Standard_True, depending on the value of the parameter B. The -- result is marked as a static expression. + function Statically_Denotes_Object (N : Node_Id) return Boolean; + -- Predicate used to check the legality of the prefix to 'Loop_Entry and + -- 'Old, when the prefix is not an entity name. Current RM specfies that + -- the prefix must be a direct or expanded name, but it has been proposed + -- that the prefix be allowed to be a selected component that does not + -- depend on a discriminant, or an indexed component with static indices. + -- Current code for this predicate implements this more permissive + -- implementation. + ----------------------- -- Analyze_Attribute -- ----------------------- @@ -4501,6 +4510,7 @@ package body Sem_Attr is if Is_Entity_Name (P) or else Nkind (Parent (P)) = N_Object_Renaming_Declaration + or else Statically_Denotes_Object (P) then null; @@ -4999,7 +5009,9 @@ package body Sem_Attr is -- Ensure that the prefix of attribute 'Old is an entity when it -- is potentially unevaluated (6.1.1 (27/3)). - if Is_Potentially_Unevaluated (N) then + if Is_Potentially_Unevaluated (N) + and then not Statically_Denotes_Object (P) + then Uneval_Old_Msg; -- Detect a possible infinite recursion when the prefix denotes @@ -11808,6 +11820,59 @@ package body Sem_Attr is end if; end Set_Boolean_Result; + ------------------------------- + -- Statically_Denotes_Object -- + ------------------------------- + + function Statically_Denotes_Object (N : Node_Id) return Boolean is + Indx : Node_Id; + + begin + if Is_Entity_Name (N) then + return True; + + elsif Nkind (N) = N_Selected_Component + and then Statically_Denotes_Object (Prefix (N)) + and then Present (Entity (Selector_Name (N))) + then + declare + Sel_Id : constant Entity_Id := Entity (Selector_Name (N)); + Comp_Decl : constant Node_Id := Parent (Sel_Id); + + begin + if Depends_On_Discriminant (Sel_Id) then + return False; + + elsif Nkind (Parent (Parent (Comp_Decl))) = N_Variant then + return False; + + else + return True; + end if; + end; + + elsif Nkind (N) = N_Indexed_Component + and then Statically_Denotes_Object (Prefix (N)) + and then Is_Constrained (Etype (Prefix (N))) + then + Indx := First (Expressions (N)); + while Present (Indx) loop + if not Compile_Time_Known_Value (Indx) + or else Do_Range_Check (Indx) + then + return False; + end if; + + Next (Indx); + end loop; + + return True; + + else + return False; + end if; + end Statically_Denotes_Object; + -------------------------------- -- Stream_Attribute_Available -- -------------------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f9477ab..0db7f0f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14439,7 +14439,8 @@ package body Sem_Util is N_And_Then, N_Or_Else, N_In, - N_Not_In) + N_Not_In, + N_Quantified_Expression) loop Expr := Par; Par := Parent (Par); @@ -14448,7 +14449,10 @@ package body Sem_Util is -- expansion of an enclosing construct (such as another attribute) -- the predicate does not apply. - if Nkind (Par) not in N_Subexpr + if Nkind (Par) = N_Case_Expression_Alternative then + null; + + elsif Nkind (Par) not in N_Subexpr or else not Comes_From_Source (Par) then return False; @@ -14465,7 +14469,21 @@ package body Sem_Util is return Expr = Right_Opnd (Par); elsif Nkind_In (Par, N_In, N_Not_In) then - return Expr /= Left_Opnd (Par); + + -- If the membership includes several alternatives, only the first is + -- definitely evaluated. + + if Present (Alternatives (Par)) then + return Expr /= First (Alternatives (Par)); + + -- If this is a range membership both bounds are evaluated + + else + return False; + end if; + + elsif Nkind (Par) = N_Quantified_Expression then + return Expr = Condition (Par); else return False; -- 2.7.4