This patch removes some unnecessary unchecked conversions from the
generated code. This makes the .dg output more readable in some
cases, especially those involving finalization.
Also misc cleanups.
This patch does not change calls to Make_Unchecked_Type_Conversion to
Unchecked_Convert_To, but we might want to do that in the future.
I had initially wanted to add an assertion to Nmake to make sure we
don't create an unchecked conversion of an unchecked conversion.
However, that's not possible in the case of bitfields, so we don't
do that. But the mechanisms for adding assertions to Nmake is
implemented as part of this change. It is not currently used,
but will probably be useful in the future.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* tbuild.adb (Convert_To): Add assert, along with a comment.
(Make_DT_Access): Remove this function, which is not used. It
was incorrect anyway (the call to New_Occurrence_Of should not
be there).
(Unchecked_Convert_To): Add assert. The previous version's test
for unchecked conversion to the same type was redundant and
could never be true, because the previous 'if' already checked
for ANY expression of the same type. Remove that, and replace
with a test for unchecked conversion to a related type.
Otherwise, we somethings get things like
"finalize(some_type!(some_type!(x)))" in the generated code,
where x is already of type some_type, but we're converting it to
the private type and then to the full type or vice versa (so the
types aren't equal, so the previous 'if' doesn't catch it).
Avoid updating the Parent. This is not necessary; the Parent
will be updated if/when the node is attached to the tree.
* tbuild.ads: Fix comments. No need to say "this is safe" when
we just explained that a few lines earlier. Remove
Make_DT_Access.
* sinfo.ads: Add comments.
* exp_ch7.adb (Make_Finalize_Address_Stmts): Minor comment fix.
* gen_il-gen.adb, gen_il-gen.ads, gen_il-gen-gen_nodes.adb,
gen_il-internals.ads: Implement a feature where you can put:
Nmake_Assert => "expr" where expr is a boolean expression in a
call to Create_Concrete_Node_Type. It is added in a pragma
Assert in the Nmake.Make_... function for that type.diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -9344,7 +9344,7 @@ package body Exp_Ch7 is
Dope_Id : Entity_Id;
begin
- -- Ensure that Ptr_Typ a thin pointer, generate:
+ -- Ensure that Ptr_Typ is a thin pointer; generate:
-- for Ptr_Typ'Size use System.Address'Size;
Append_To (Decls,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -31,7 +31,8 @@ procedure Gen_IL.Gen.Gen_Nodes is
renames Create_Abstract_Node_Type;
procedure Cc -- Short for "ConCrete"
(T : Concrete_Node; Parent : Abstract_Type;
- Fields : Field_Sequence := No_Fields)
+ Fields : Field_Sequence := No_Fields;
+ Nmake_Assert : String := "")
renames Create_Concrete_Node_Type;
function Sy -- Short for "Syntactic"
@@ -562,7 +563,12 @@ begin -- Gen_IL.Gen.Gen_Nodes
(Sy (Subtype_Mark, Node_Id, Default_Empty),
Sy (Expression, Node_Id, Default_Empty),
Sm (Kill_Range_Check, Flag),
- Sm (No_Truncation, Flag)));
+ Sm (No_Truncation, Flag)),
+ Nmake_Assert => "True or else Nkind (Expression) /= N_Unchecked_Type_Conversion");
+-- Nmake_Assert => "Nkind (Expression) /= N_Unchecked_Type_Conversion");
+ -- Assert that we don't have unchecked conversions of unchecked
+ -- conversions; if Expression might be an unchecked conversion,
+ -- then Tbuild.Unchecked_Convert_To should be used.
Cc (N_Subtype_Indication, N_Has_Etype,
(Sy (Subtype_Mark, Node_Id, Default_Empty),
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -47,9 +47,10 @@ package body Gen_IL.Gen is
All_Entities : constant Type_Vector := To_Vector (Entity_Kind, Length => 1);
procedure Create_Type
- (T : Node_Or_Entity_Type;
- Parent : Opt_Abstract_Type;
- Fields : Field_Sequence);
+ (T : Node_Or_Entity_Type;
+ Parent : Opt_Abstract_Type;
+ Fields : Field_Sequence;
+ Nmake_Assert : String);
-- Called by the Create_..._Type procedures exported by this package to
-- create an entry in the Types_Table.
@@ -107,9 +108,10 @@ package body Gen_IL.Gen is
-----------------
procedure Create_Type
- (T : Node_Or_Entity_Type;
- Parent : Opt_Abstract_Type;
- Fields : Field_Sequence)
+ (T : Node_Or_Entity_Type;
+ Parent : Opt_Abstract_Type;
+ Fields : Field_Sequence;
+ Nmake_Assert : String)
is
begin
Check_Type (T);
@@ -132,7 +134,8 @@ package body Gen_IL.Gen is
new Type_Info'
(Is_Union => False, Parent => Parent,
Children | Concrete_Descendants => Type_Vectors.Empty_Vector,
- First | Last | Fields => <>); -- filled in later
+ First | Last | Fields => <>, -- filled in later
+ Nmake_Assert => new String'(Nmake_Assert));
if Parent /= No_Type then
Append (Type_Table (Parent).Children, T);
@@ -215,7 +218,7 @@ package body Gen_IL.Gen is
(T : Abstract_Node;
Fields : Field_Sequence := No_Fields) is
begin
- Create_Type (T, Parent => No_Type, Fields => Fields);
+ Create_Type (T, Parent => No_Type, Fields => Fields, Nmake_Assert => "");
end Create_Root_Node_Type;
-------------------------------
@@ -227,7 +230,7 @@ package body Gen_IL.Gen is
Fields : Field_Sequence := No_Fields)
is
begin
- Create_Type (T, Parent, Fields);
+ Create_Type (T, Parent, Fields, Nmake_Assert => "");
end Create_Abstract_Node_Type;
-------------------------------
@@ -236,10 +239,11 @@ package body Gen_IL.Gen is
procedure Create_Concrete_Node_Type
(T : Concrete_Node; Parent : Abstract_Type;
- Fields : Field_Sequence := No_Fields)
+ Fields : Field_Sequence := No_Fields;
+ Nmake_Assert : String := "")
is
begin
- Create_Type (T, Parent, Fields);
+ Create_Type (T, Parent, Fields, Nmake_Assert);
end Create_Concrete_Node_Type;
-----------------------------
@@ -250,7 +254,7 @@ package body Gen_IL.Gen is
(T : Abstract_Entity;
Fields : Field_Sequence := No_Fields) is
begin
- Create_Type (T, Parent => No_Type, Fields => Fields);
+ Create_Type (T, Parent => No_Type, Fields => Fields, Nmake_Assert => "");
end Create_Root_Entity_Type;
---------------------------------
@@ -262,7 +266,7 @@ package body Gen_IL.Gen is
Fields : Field_Sequence := No_Fields)
is
begin
- Create_Type (T, Parent, Fields);
+ Create_Type (T, Parent, Fields, Nmake_Assert => "");
end Create_Abstract_Entity_Type;
---------------------------------
@@ -274,7 +278,7 @@ package body Gen_IL.Gen is
Fields : Field_Sequence := No_Fields)
is
begin
- Create_Type (T, Parent, Fields);
+ Create_Type (T, Parent, Fields, Nmake_Assert => "");
end Create_Concrete_Entity_Type;
------------------
@@ -352,7 +356,7 @@ package body Gen_IL.Gen is
Image (Field);
end if;
- if Pre /= Field_Table (Field).Pre.all then
+ if Pre_Set /= Field_Table (Field).Pre_Set.all then
raise Illegal with
"mismatched extra setter-only preconditions for " &
Image (Field);
@@ -2561,6 +2565,11 @@ package body Gen_IL.Gen is
end;
end if;
+ if Type_Table (T).Nmake_Assert.all /= "" then
+ Put (S, "pragma Assert (" &
+ Type_Table (T).Nmake_Assert.all & ");" & LF);
+ end if;
+
Put (S, "return N;" & LF);
Decrease_Indent (S, 3);
@@ -2628,6 +2637,7 @@ package body Gen_IL.Gen is
Increase_Indent (B, 3);
Put (B, "-- This package is automatically generated." & LF & LF);
+ Put (B, "pragma Style_Checks (""M200"");" & LF);
Put_Make_Bodies (B, Node_Kind);
diff --git a/gcc/ada/gen_il-gen.ads b/gcc/ada/gen_il-gen.ads
--- a/gcc/ada/gen_il-gen.ads
+++ b/gcc/ada/gen_il-gen.ads
@@ -102,9 +102,12 @@ package Gen_IL.Gen is
procedure Create_Concrete_Node_Type
(T : Concrete_Node; Parent : Abstract_Type;
- Fields : Field_Sequence := No_Fields);
+ Fields : Field_Sequence := No_Fields;
+ Nmake_Assert : String := "");
-- Create a concrete node type. Every node is an instance of a concrete
- -- node type.
+ -- node type. Nmake_Assert is an assertion to put in the Make_... function
+ -- in the generated Nmake package. It should be a String that represents a
+ -- Boolean expression.
procedure Create_Root_Entity_Type
(T : Abstract_Entity;
@@ -151,13 +154,14 @@ package Gen_IL.Gen is
-- only for syntactic fields. Flag fields of syntactic nodes always have a
-- default value, which is False unless specified as Default_True. Pre is
-- an additional precondition for the field getter and setter, in addition
- -- to the precondition that asserts that the type has that field. Pre_Get
- -- and Pre_Set are similar to Pre, but for the getter or setter only,
- -- respectively.
+ -- to the precondition that asserts that the type has that field. It should
+ -- be a String that represents a Boolean expression. Pre_Get and Pre_Set
+ -- are similar to Pre, but for the getter or setter only, respectively.
--
-- If multiple calls to these occur for the same Field but different types,
- -- the Field_Type and Pre must match. Default_Value should match for
- -- syntactic fields. See the declaration of Type_Only_Enum for Type_Only.
+ -- the Field_Type, Pre, Pre_Get, and Pre_Set must match. Default_Value
+ -- should match for syntactic fields. See the declaration of Type_Only_Enum
+ -- for Type_Only.
--
-- (The matching Default_Value requirement is a simplification from the
-- earlier hand-written version.)
diff --git a/gcc/ada/gen_il-internals.ads b/gcc/ada/gen_il-internals.ads
--- a/gcc/ada/gen_il-internals.ads
+++ b/gcc/ada/gen_il-internals.ads
@@ -104,6 +104,8 @@ package Gen_IL.Internals is
-- includes two or more types.
Fields : Field_Vector;
+
+ Nmake_Assert : String_Access; -- only for concrete node types
end case;
end record;
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -8420,8 +8420,11 @@ package Sinfo is
-- An unchecked type conversion node represents the semantic action
-- corresponding to a call to an instantiation of Unchecked_Conversion.
-- It is generated as a result of actual use of Unchecked_Conversion
- -- and also the expander generates unchecked type conversion nodes
- -- directly for expansion of complex semantic actions.
+ -- and also by the expander.
+
+ -- Unchecked type conversion nodes should normally be created by calling
+ -- Tbuild.Unchecked_Convert_To, rather than by directly calling
+ -- Nmake.Make_Unchecked_Type_Conversion.
-- Note: an unchecked type conversion is a variable as far as the
-- semantics are concerned, which is convenient for the expander.
diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -29,14 +29,12 @@ with Csets; use Csets;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
-with Elists; use Elists;
with Lib; use Lib;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
-with Sem_Aux; use Sem_Aux;
with Sinfo.Utils; use Sinfo.Utils;
with Sem_Util; use Sem_Util;
with Snames; use Snames;
@@ -117,6 +115,7 @@ package body Tbuild is
----------------
function Convert_To (Typ : Entity_Id; Expr : Node_Id) return Node_Id is
+ pragma Assert (Is_Type (Typ));
Result : Node_Id;
begin
@@ -185,32 +184,6 @@ package body Tbuild is
return N;
end Make_Byte_Aligned_Attribute_Reference;
- --------------------
- -- Make_DT_Access --
- --------------------
-
- function Make_DT_Access
- (Loc : Source_Ptr;
- Rec : Node_Id;
- Typ : Entity_Id) return Node_Id
- is
- Full_Type : Entity_Id := Typ;
-
- begin
- if Is_Private_Type (Typ) then
- Full_Type := Underlying_Type (Typ);
- end if;
-
- return
- Unchecked_Convert_To (
- New_Occurrence_Of
- (Etype (Node (First_Elmt (Access_Disp_Table (Full_Type)))), Loc),
- Make_Selected_Component (Loc,
- Prefix => New_Copy (Rec),
- Selector_Name =>
- New_Occurrence_Of (First_Tag_Component (Full_Type), Loc)));
- end Make_DT_Access;
-
------------------------
-- Make_Float_Literal --
------------------------
@@ -906,26 +879,34 @@ package body Tbuild is
(Typ : Entity_Id;
Expr : Node_Id) return Node_Id
is
+ pragma Assert (Ekind (Typ) in E_Void | Type_Kind);
+ -- We don't really want to allow E_Void here, but existing code passes
+ -- it.
+
Loc : constant Source_Ptr := Sloc (Expr);
Result : Node_Id;
- Expr_Parent : Node_Id;
begin
-- If the expression is already of the correct type, then nothing
- -- to do, except for relocating the node in case this is required.
+ -- to do, except for relocating the node
if Present (Etype (Expr))
- and then (Base_Type (Etype (Expr)) = Typ
- or else Etype (Expr) = Typ)
+ and then (Base_Type (Etype (Expr)) = Typ or else Etype (Expr) = Typ)
then
return Relocate_Node (Expr);
- -- Case where the expression is itself an unchecked conversion to
- -- the same type, and we can thus eliminate the outer conversion.
+ -- Case where the expression is already an unchecked conversion. We
+ -- replace the type being converted to, to avoid creating an unchecked
+ -- conversion of an unchecked conversion. Extra unchecked conversions
+ -- make the .dg output less readable. We can't do this in cases
+ -- involving bitfields, because the sizes might not match. The
+ -- Is_Composite_Type checks avoid such cases.
elsif Nkind (Expr) = N_Unchecked_Type_Conversion
- and then Entity (Subtype_Mark (Expr)) = Typ
+ and then Is_Composite_Type (Etype (Expr))
+ and then Is_Composite_Type (Typ)
then
+ Set_Subtype_Mark (Expr, New_Occurrence_Of (Typ, Loc));
Result := Relocate_Node (Expr);
elsif Nkind (Expr) = N_Null
@@ -938,18 +919,10 @@ package body Tbuild is
-- All other cases
else
- -- Capture the parent of the expression before relocating it and
- -- creating the conversion, so the conversion's parent can be set
- -- to the original parent below.
-
- Expr_Parent := Parent (Expr);
-
Result :=
Make_Unchecked_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (Expr));
-
- Set_Parent (Result, Expr_Parent);
end if;
Set_Etype (Result, Typ);
diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads
--- a/gcc/ada/tbuild.ads
+++ b/gcc/ada/tbuild.ads
@@ -41,19 +41,16 @@ package Tbuild is
-- except that it will be analyzed and resolved with checks off.
function Convert_To (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
- -- Returns an expression that represents the result of a checked convert
- -- of expression Exp to type T. If the base type of Exp is T, then no
- -- conversion is required, and Exp is returned unchanged. Otherwise an
- -- N_Type_Conversion node is constructed to convert the expression.
- -- If an N_Type_Conversion node is required, Relocate_Node is used on
- -- Exp. This means that it is safe to replace a node by a Convert_To
- -- of itself to some other type.
+ -- Returns an expression that is a type conversion of expression Expr to
+ -- type Typ. If the type of Expr is Typ, then no conversion is required.
+ -- Otherwise an N_Type_Conversion node is constructed to convert the
+ -- expression. Relocate_Node is applied to Expr, so that it is safe to
+ -- replace a node by a Convert_To of itself to some other type.
procedure Convert_To_And_Rewrite (Typ : Entity_Id; Expr : Node_Id);
pragma Inline (Convert_To_And_Rewrite);
-- Like the function, except that there is an extra step of calling
-- Rewrite on the Expr node and replacing it with the converted result.
- -- As noted above, this is safe, because Relocate_Node is called.
procedure Discard_Node (N : Node_Or_Entity_Id);
pragma Inline (Discard_Node);
@@ -78,11 +75,6 @@ package Tbuild is
-- Must_Be_Byte_Aligned is set in the attribute reference node. The
-- Attribute_Name must be Name_Address or Name_Unrestricted_Access.
- function Make_DT_Access
- (Loc : Source_Ptr; Rec : Node_Id; Typ : Entity_Id) return Node_Id;
- -- Create an access to the Dispatch Table by using the Tag field of a
- -- tagged record : Acc_Dt (Rec.tag).all
-
function Make_Float_Literal
(Loc : Source_Ptr;
Radix : Uint;
@@ -319,13 +311,12 @@ package Tbuild is
function New_Occurrence_Of
(Def_Id : Entity_Id;
Loc : Source_Ptr) return Node_Id;
- -- New_Occurrence_Of creates an N_Identifier node which is an occurrence
- -- of the defining identifier which is passed as its argument. The Entity
- -- and Etype of the result are set from the given defining identifier as
- -- follows: Entity is simply a copy of Def_Id. Etype is a copy of Def_Id
- -- for types, and a copy of the Etype of Def_Id for other entities. Note
- -- that Is_Static_Expression is set if this call creates an occurrence of
- -- an enumeration literal.
+ -- New_Occurrence_Of creates an N_Identifier node that is an occurrence of
+ -- the defining identifier Def_Id. The Entity and Etype of the result are
+ -- set from the given defining identifier as follows: Entity is a copy of
+ -- Def_Id. Etype is a copy of Def_Id for types, and a copy of the Etype of
+ -- Def_Id for other entities. Note that Is_Static_Expression is set if this
+ -- call creates an occurrence of an enumeration literal.
function New_Suffixed_Name
(Related_Id : Name_Id;
