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,
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"
(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),
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.
-----------------
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);
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);
(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;
-------------------------------
Fields : Field_Sequence := No_Fields)
is
begin
- Create_Type (T, Parent, Fields);
+ Create_Type (T, Parent, Fields, Nmake_Assert => "");
end Create_Abstract_Node_Type;
-------------------------------
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;
-----------------------------
(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;
---------------------------------
Fields : Field_Sequence := No_Fields)
is
begin
- Create_Type (T, Parent, Fields);
+ Create_Type (T, Parent, Fields, Nmake_Assert => "");
end Create_Abstract_Entity_Type;
---------------------------------
Fields : Field_Sequence := No_Fields)
is
begin
- Create_Type (T, Parent, Fields);
+ Create_Type (T, Parent, Fields, Nmake_Assert => "");
end Create_Concrete_Entity_Type;
------------------
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);
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);
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);
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;
-- 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.)
-- includes two or more types.
Fields : Field_Vector;
+
+ Nmake_Assert : String_Access; -- only for concrete node types
end case;
end record;
-- 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.
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;
----------------
function Convert_To (Typ : Entity_Id; Expr : Node_Id) return Node_Id is
+ pragma Assert (Is_Type (Typ));
Result : Node_Id;
begin
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 --
------------------------
(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
-- 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);
-- 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);
-- 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;
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;
projects / thirdparty / gcc.git / commitdiff
