From: Eric Botcazou <[email protected]>
This extends the processing done for the Address aspect to other delayed
aspects. The External_Name aspect is also reclassified as a representation
aspect and the three representation aspects External_Name, Link_Name and
Linker_Section are moved from the Always_Delay to the Rep_Aspect category,
which makes it possible not to delay them in most cases with a small tweak.
gcc/ada/ChangeLog:
* aspects.ads (Is_Representation_Aspect): True for External_Name.
(Aspect_Delay): Use Rep_Aspect for External_Name, Link_Name and
Linker_Section.
* einfo.ads (Initialization_Statements): Document extended usage.
* exp_util.adb (Needs_Initialization_Statements): Return True for
all delayed aspects.
* freeze.adb (Check_Address_Clause): Do not move the initialization
expression here...
(Freeze_Object_Declaration): ...but here instead, as well as for all
delayed aspects. Remove test for pragma Linker_Section.
* sem_ch13.adb (Analyze_One_Aspect): Do not delay in the Rep_Aspect
case if the expression is a string literal.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/aspects.ads | 8 +--
gcc/ada/einfo.ads | 6 +--
gcc/ada/exp_util.adb | 2 +-
gcc/ada/freeze.adb | 119 +++++++++++++++++--------------------------
gcc/ada/sem_ch13.adb | 5 +-
5 files changed, 58 insertions(+), 82 deletions(-)
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index ebf09602ea5..100ab4d55a8 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -543,7 +543,7 @@ package Aspects is
Aspect_Exclusive_Functions => False,
Aspect_Extended_Access => True,
Aspect_External_Initialization => False,
- Aspect_External_Name => False,
+ Aspect_External_Name => True,
Aspect_External_Tag => False,
Aspect_Finalizable => False,
Aspect_First_Controlling_Parameter => False,
@@ -973,7 +973,6 @@ package Aspects is
Aspect_Dynamic_Predicate => Always_Delay,
Aspect_Elaborate_Body => Always_Delay,
Aspect_Exclusive_Functions => Always_Delay,
- Aspect_External_Name => Always_Delay,
Aspect_External_Tag => Always_Delay,
Aspect_Favor_Top_Level => Always_Delay,
Aspect_Finalizable => Always_Delay,
@@ -990,8 +989,6 @@ package Aspects is
Aspect_Invariant => Always_Delay,
Aspect_Iterable => Always_Delay,
Aspect_Iterator_Element => Always_Delay,
- Aspect_Link_Name => Always_Delay,
- Aspect_Linker_Section => Always_Delay,
Aspect_Lock_Free => Always_Delay,
Aspect_No_Inline => Always_Delay,
Aspect_No_Raise => Always_Delay,
@@ -1100,7 +1097,10 @@ package Aspects is
Aspect_Bit_Order => Rep_Aspect,
Aspect_Component_Size => Rep_Aspect,
Aspect_Extended_Access => Rep_Aspect,
+ Aspect_External_Name => Rep_Aspect,
Aspect_Full_Access_Only => Rep_Aspect,
+ Aspect_Link_Name => Rep_Aspect,
+ Aspect_Linker_Section => Rep_Aspect,
Aspect_Machine_Radix => Rep_Aspect,
Aspect_Object_Size => Rep_Aspect,
Aspect_Pack => Rep_Aspect,
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f929c26571d..1a8760c0dbb 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2274,9 +2274,9 @@ package Einfo is
-- source and initialized with an aggregate or a call expanded in place,
-- points to a compound statement containing the assignment(s). This is
-- used for a couple of purposes: 1) to defer the initialization to the
--- freeze point if an address aspect/clause is present for the object,
--- 2) to cancel the initialization of imported objects generated by
--- Initialize_Scalars or Normalize_Scalars before the pragma Import is
+-- freeze point if an address clause or a delayed aspect is present for
+-- the object, 2) to cancel initialization of imported objects generated
+-- by Initialize_Scalars or Normalize_Scalars before the pragma Import is
-- encountered for the object.
-- Inner_Instances
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index dd284e2a20d..e9a683f8255 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -11700,7 +11700,7 @@ package body Exp_Util is
-- See the documentation of Initialization_Statements in Einfo
return Comes_From_Source (Decl)
- and then (Has_Aspect (Obj_Id, Aspect_Address)
+ and then (Has_Delayed_Aspects (Obj_Id)
or else Present (Following_Address_Clause (Decl))
or else Init_Or_Norm_Scalars);
end Needs_Initialization_Statements;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index b2f1c3913a7..dae1d9afcde 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -98,8 +98,7 @@ package body Freeze is
procedure Check_Address_Clause (E : Entity_Id);
-- Apply legality checks to address clauses for object declarations,
- -- at the point the object is frozen. Also ensure any initialization is
- -- performed only after the object has been frozen.
+ -- at the point the object is frozen.
procedure Check_Component_Storage_Order
(Encl_Type : Entity_Id;
@@ -636,11 +635,9 @@ package body Freeze is
Addr : constant Node_Id := Address_Clause (E);
Typ : constant Entity_Id := Etype (E);
- Assign : Node_Id;
- Decl : Node_Id;
- Expr : Node_Id;
- Init : Node_Id;
- Lhs : Node_Id;
+ Decl : Node_Id;
+ Expr : Node_Id;
+ Init : Node_Id;
begin
if Present (Addr) then
@@ -744,47 +741,6 @@ package body Freeze is
end if;
end;
end if;
-
- -- Remove side effects from initial expression, except in the case of
- -- limited build-in-place calls and aggregates, which have their own
- -- expansion elsewhere. This exception is necessary to avoid copying
- -- limited objects.
-
- if Present (Init)
- and then not Is_Inherently_Limited_Type (Typ)
- then
- -- Capture initialization value at point of declaration, and make
- -- explicit assignment legal, because object may be a constant.
-
- Remove_Side_Effects (Init);
- Lhs := New_Occurrence_Of (E, Sloc (Decl));
- Set_Assignment_OK (Lhs);
-
- Assign :=
- Make_Assignment_Statement (Sloc (Decl),
- Name => Lhs,
- Expression => Init);
-
- Set_No_Initialization (Decl);
-
- -- If the initialization expression is an aggregate, we do not
- -- adjust after the assignment but, in either case, we do not
- -- finalize before since the object is now uninitialized. Note
- -- that Make_Tag_Ctrl_Assignment will also automatically insert
- -- the tag assignment in the tagged case.
-
- if Nkind (Unqualify (Init)) = N_Aggregate then
- Set_No_Ctrl_Actions (Assign);
- else
- Set_No_Finalize_Actions (Assign);
- end if;
-
- -- Move initialization to freeze actions, once the object has
- -- been frozen and the address clause alignment check has been
- -- performed.
-
- Append_Freeze_Action (E, Assign);
- end if;
end if;
end Check_Address_Clause;
@@ -4229,6 +4185,8 @@ package body Freeze is
-------------------------------
procedure Freeze_Object_Declaration (E : Entity_Id) is
+ Decl : constant Node_Id := Declaration_Node (E);
+
procedure Check_Large_Modular_Array (Typ : Entity_Id);
-- Check that the size of array type Typ can be computed without
-- overflow, and generates a Storage_Error otherwise. This is only
@@ -4307,11 +4265,11 @@ package body Freeze is
Make_Itype_Reference (Obj_Loc);
begin
Set_Itype (Ref_Node, Etype (E));
- Insert_Action (Declaration_Node (E), Ref_Node);
+ Insert_Action (Decl, Ref_Node);
end;
end if;
- Insert_Action (Declaration_Node (E),
+ Insert_Action (Decl,
Make_Raise_Storage_Error (Obj_Loc,
Condition =>
Make_Op_Ge (Obj_Loc,
@@ -4494,45 +4452,63 @@ package body Freeze is
-- checks to freeze time since pragma Import inhibits default
-- initialization and thus pragma Import affects these checks.
- Validate_Object_Declaration (Declaration_Node (E));
+ Validate_Object_Declaration (Decl);
- -- If there is an address clause, check that it is valid and if need
- -- be move initialization to the freeze node.
+ -- If there is an address clause, check that it is valid
Check_Address_Clause (E);
- -- Similar processing is needed for aspects that may affect object
- -- layout, like Address, if there is an initialization 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 the object has an address clause or a delayed aspect, remove
+ -- the side effects from initial expression, except in the case of
+ -- limited build-in-place calls and aggregates, which have their own
+ -- expansion elsewhere. This exception is necessary to avoid copying
+ -- limited objects.
- if Has_Delayed_Aspects (E)
- and then Expander_Active
- and then Is_Array_Type (Typ)
- and then Present (Expression (Declaration_Node (E)))
- and then No (Linker_Section_Pragma (E))
+ if Expander_Active
+ and then
+ (Present (Address_Clause (E)) or else Has_Delayed_Aspects (E))
+ and then Present (Expression (Decl))
+ and then not No_Initialization (Decl)
+ and then not Is_Inherently_Limited_Type (Typ)
then
declare
- Decl : constant Node_Id := Declaration_Node (E);
+ Init : constant Node_Id := Expression (Decl);
Lhs : constant Node_Id := New_Occurrence_Of (E, Loc);
+ Assign : Node_Id;
+
begin
-- Capture initialization value at point of declaration, and
-- make explicit assignment legal, because object may be a
-- constant.
- Remove_Side_Effects (Expression (Decl));
+ Remove_Side_Effects (Init);
Set_Assignment_OK (Lhs);
- -- Move initialization to freeze actions
-
- Append_Freeze_Action (E,
- Make_Assignment_Statement (Loc,
+ Assign :=
+ Make_Assignment_Statement (Sloc (Decl),
Name => Lhs,
- Expression => Expression (Decl)));
+ Expression => Init);
Set_No_Initialization (Decl);
+
+ -- If the initialization expression is an aggregate, we do not
+ -- adjust after the assignment but, in either case, we do not
+ -- finalize before since the object is now uninitialized. Note
+ -- that Make_Tag_Ctrl_Assignment will also automatically insert
+ -- the tag assignment in the tagged case.
+
+ if Nkind (Unqualify (Init)) = N_Aggregate then
+ Set_No_Ctrl_Actions (Assign);
+ else
+ Set_No_Finalize_Actions (Assign);
+ end if;
+
+ -- Move initialization to freeze actions, once the object has
+ -- been frozen and the address clause alignment check has been
+ -- performed.
+
+ Append_Freeze_Action (E, Assign);
end;
end if;
@@ -4574,8 +4550,7 @@ package body Freeze is
null;
elsif Has_Default_Initialization (E) then
- Check_Restriction
- (No_Default_Initialization, Declaration_Node (E));
+ Check_Restriction (No_Default_Initialization, Decl);
end if;
-- Ensure that a variable subject to pragma Thread_Local_Storage
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 2d13ecc2f98..1a3a16ac9ee 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2868,11 +2868,12 @@ package body Sem_Ch13 is
-- For non-Boolean aspects, if the expression has the form
-- of an integer literal, then do not delay, since we know
-- the value cannot change. This optimization catches most
- -- rep clause cases.
+ -- rep clause cases. Likewise for a string literal.
elsif A_Id not in Boolean_Aspects
and then Present (Expr)
- and then Nkind (Expr) = N_Integer_Literal
+ and then
+ Nkind (Expr) in N_Integer_Literal | N_String_Literal
then
Delay_Required := False;
--
2.43.0
