You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
221 lines
7.9 KiB
221 lines
7.9 KiB
--- a/gcc/ada/exp_attr.adb 2018-11-16 20:23:21.775906196 +0100
|
|
+++ b/gcc/ada/exp_attr.adb 2018-11-16 20:25:57.418211404 +0100
|
|
@@ -3121,6 +3121,121 @@
|
|
Analyze_And_Resolve (N, Standard_String);
|
|
end External_Tag;
|
|
|
|
+ -----------------------
|
|
+ -- Finalization_Size --
|
|
+ -----------------------
|
|
+
|
|
+ when Attribute_Finalization_Size => Finalization_Size : declare
|
|
+ function Calculate_Header_Size return Node_Id;
|
|
+ -- Generate a runtime call to calculate the size of the hidden header
|
|
+ -- along with any added padding which would precede a heap-allocated
|
|
+ -- object of the prefix type.
|
|
+
|
|
+ ---------------------------
|
|
+ -- Calculate_Header_Size --
|
|
+ ---------------------------
|
|
+
|
|
+ function Calculate_Header_Size return Node_Id is
|
|
+ begin
|
|
+ -- Generate:
|
|
+ -- Universal_Integer
|
|
+ -- (Header_Size_With_Padding (Pref'Alignment))
|
|
+
|
|
+ return
|
|
+ Convert_To (Universal_Integer,
|
|
+ Make_Function_Call (Loc,
|
|
+ Name =>
|
|
+ New_Occurrence_Of (RTE (RE_Header_Size_With_Padding), Loc),
|
|
+
|
|
+ Parameter_Associations => New_List (
|
|
+ Make_Attribute_Reference (Loc,
|
|
+ Prefix => New_Copy_Tree (Pref),
|
|
+ Attribute_Name => Name_Alignment))));
|
|
+ end Calculate_Header_Size;
|
|
+
|
|
+ -- Local variables
|
|
+
|
|
+ Size : Entity_Id;
|
|
+
|
|
+ -- Start of Finalization_Size
|
|
+
|
|
+ begin
|
|
+ -- An object of a class-wide type first requires a runtime check to
|
|
+ -- determine whether it is actually controlled or not. Depending on
|
|
+ -- the outcome of this check, the Finalization_Size of the object
|
|
+ -- may be zero or some positive value.
|
|
+ --
|
|
+ -- In this scenario, Pref'Finalization_Size is expanded into
|
|
+ --
|
|
+ -- Size : Integer := 0;
|
|
+ --
|
|
+ -- if Needs_Finalization (Pref'Tag) then
|
|
+ -- Size :=
|
|
+ -- Universal_Integer
|
|
+ -- (Header_Size_With_Padding (Pref'Alignment));
|
|
+ -- end if;
|
|
+ --
|
|
+ -- and the attribute reference is replaced with a reference to Size.
|
|
+
|
|
+ if Is_Class_Wide_Type (Ptyp) then
|
|
+ Size := Make_Temporary (Loc, 'S');
|
|
+
|
|
+ Insert_Actions (N, New_List (
|
|
+
|
|
+ -- Generate:
|
|
+ -- Size : Integer := 0;
|
|
+
|
|
+ Make_Object_Declaration (Loc,
|
|
+ Defining_Identifier => Size,
|
|
+ Object_Definition =>
|
|
+ New_Occurrence_Of (Standard_Integer, Loc),
|
|
+ Expression => Make_Integer_Literal (Loc, 0)),
|
|
+
|
|
+ -- Generate:
|
|
+ -- if Needs_Finalization (Pref'Tag) then
|
|
+ -- Size :=
|
|
+ -- Universal_Integer
|
|
+ -- (Header_Size_With_Padding (Pref'Alignment));
|
|
+ -- end if;
|
|
+
|
|
+ Make_If_Statement (Loc,
|
|
+ Condition =>
|
|
+ Make_Function_Call (Loc,
|
|
+ Name =>
|
|
+ New_Occurrence_Of (RTE (RE_Needs_Finalization), Loc),
|
|
+
|
|
+ Parameter_Associations => New_List (
|
|
+ Make_Attribute_Reference (Loc,
|
|
+ Prefix => New_Copy_Tree (Pref),
|
|
+ Attribute_Name => Name_Tag))),
|
|
+
|
|
+ Then_Statements => New_List (
|
|
+ Make_Assignment_Statement (Loc,
|
|
+ Name => New_Occurrence_Of (Size, Loc),
|
|
+ Expression => Calculate_Header_Size)))));
|
|
+
|
|
+ Rewrite (N, New_Occurrence_Of (Size, Loc));
|
|
+
|
|
+ -- The prefix is known to be controlled at compile time. Calculate
|
|
+ -- Finalization_Size by calling function Header_Size_With_Padding.
|
|
+
|
|
+ elsif Needs_Finalization (Ptyp) then
|
|
+ Rewrite (N, Calculate_Header_Size);
|
|
+
|
|
+ -- The prefix is not an object with controlled parts, so its
|
|
+ -- Finalization_Size is zero.
|
|
+
|
|
+ else
|
|
+ Rewrite (N, Make_Integer_Literal (Loc, 0));
|
|
+ end if;
|
|
+
|
|
+ -- Due to cases where the entity type of the attribute is already
|
|
+ -- resolved the rewritten N must get re-resolved to its appropriate
|
|
+ -- type.
|
|
+
|
|
+ Analyze_And_Resolve (N, Typ);
|
|
+ end Finalization_Size;
|
|
+
|
|
-----------
|
|
-- First --
|
|
-----------
|
|
--- a/gcc/ada/snames.ads-tmpl 2016-05-16 11:29:28.000000000 +0200
|
|
--- b/gcc/ada/snames.ads-tmpl 2016-05-16 11:29:28.000000000 +0200
|
|
@@ -884,6 +884,7 @@
|
|
Name_Exponent : constant Name_Id := N + $;
|
|
Name_External_Tag : constant Name_Id := N + $;
|
|
Name_Fast_Math : constant Name_Id := N + $; -- GNAT
|
|
+ Name_Finalization_Size : constant Name_Id := N + $; -- GNAT
|
|
Name_First : constant Name_Id := N + $;
|
|
Name_First_Bit : constant Name_Id := N + $;
|
|
Name_First_Valid : constant Name_Id := N + $; -- Ada 12
|
|
@@ -1523,6 +1524,7 @@
|
|
Attribute_Exponent,
|
|
Attribute_External_Tag,
|
|
Attribute_Fast_Math,
|
|
+ Attribute_Finalization_Size,
|
|
Attribute_First,
|
|
Attribute_First_Bit,
|
|
Attribute_First_Valid,
|
|
--- a/gcc/ada/sem_attr.ads 2018-11-16 21:35:46.821279875 +0100
|
|
+++ b/gcc/ada/sem_attr.ads 2018-11-16 21:36:00.028057464 +0100
|
|
@@ -242,6 +242,16 @@
|
|
-- enumeration value. Constraint_Error is raised if no value of the
|
|
-- enumeration type corresponds to the given integer value.
|
|
|
|
+ -----------------------
|
|
+ -- Finalization_Size --
|
|
+ -----------------------
|
|
+
|
|
+ Attribute_Finalization_Size => True,
|
|
+ -- For every object or non-class-wide-type, Finalization_Size returns
|
|
+ -- the size of the hidden header used for finalization purposes as if
|
|
+ -- the object or type was allocated on the heap. The size of the header
|
|
+ -- does take into account any extra padding due to alignment issues.
|
|
+
|
|
-----------------
|
|
-- Fixed_Value --
|
|
-----------------
|
|
--- a/gcc/ada/sem_attr.adb 2018-11-16 21:35:49.698231429 +0100
|
|
+++ b/gcc/ada/sem_attr.adb 2018-11-16 21:36:00.028057464 +0100
|
|
@@ -3828,6 +3828,42 @@
|
|
Check_Standard_Prefix;
|
|
Rewrite (N, New_Occurrence_Of (Boolean_Literals (Fast_Math), Loc));
|
|
|
|
+ -----------------------
|
|
+ -- Finalization_Size --
|
|
+ -----------------------
|
|
+
|
|
+ when Attribute_Finalization_Size =>
|
|
+ Check_E0;
|
|
+
|
|
+ -- The prefix denotes an object
|
|
+
|
|
+ if Is_Object_Reference (P) then
|
|
+ Check_Object_Reference (P);
|
|
+
|
|
+ -- The prefix denotes a type
|
|
+
|
|
+ elsif Is_Entity_Name (P) and then Is_Type (Entity (P)) then
|
|
+ Check_Type;
|
|
+ Check_Not_Incomplete_Type;
|
|
+
|
|
+ -- Attribute 'Finalization_Size is not defined for class-wide
|
|
+ -- types because it is not possible to know statically whether
|
|
+ -- a definite type will have controlled components or not.
|
|
+
|
|
+ if Is_Class_Wide_Type (Etype (P)) then
|
|
+ Error_Attr_P
|
|
+ ("prefix of % attribute cannot denote a class-wide type");
|
|
+ end if;
|
|
+
|
|
+ -- The prefix denotes an illegal construct
|
|
+
|
|
+ else
|
|
+ Error_Attr_P
|
|
+ ("prefix of % attribute must be a definite type or an object");
|
|
+ end if;
|
|
+
|
|
+ Set_Etype (N, Universal_Integer);
|
|
+
|
|
-----------
|
|
-- First --
|
|
-----------
|
|
@@ -8264,6 +8300,13 @@
|
|
Fold_Uint (N,
|
|
Eval_Fat.Exponent (P_Base_Type, Expr_Value_R (E1)), Static);
|
|
|
|
+ -----------------------
|
|
+ -- Finalization_Size --
|
|
+ -----------------------
|
|
+
|
|
+ when Attribute_Finalization_Size =>
|
|
+ null;
|
|
+
|
|
-----------
|
|
-- First --
|
|
-----------
|