+2017-04-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * 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 <duff@adacore.com>
+
+ * 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 <dismukes@adacore.com>
+
+ * exp_dbug.adb: Minor rewording and reformatting.
+
+2017-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <duff@adacore.com>
* s-secsta.adb (SS_Info): Add a comment
-- 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
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 --
------------------------
-- 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;
-- 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 :=
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));
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
-- 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);
-- 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 --
-----------------------
if Is_Entity_Name (P)
or else Nkind (Parent (P)) = N_Object_Renaming_Declaration
+ or else Statically_Denotes_Object (P)
then
null;
-- 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
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 --
--------------------------------
N_And_Then,
N_Or_Else,
N_In,
- N_Not_In)
+ N_Not_In,
+ N_Quantified_Expression)
loop
Expr := Par;
Par := Parent (Par);
-- 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;
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;
projects / thirdparty / gcc.git / commitdiff
