===================================================================
@@ -108,7 +108,6 @@
-- Esize Uint12
-- Next_Inlined_Subprogram Node12
- -- Corresponding_Equality Node13
-- Component_Clause Node13
-- Elaboration_Entity Node13
-- Extra_Accessibility Node13
@@ -232,7 +231,6 @@
-- Overridden_Operation Node26
-- Package_Instantiation Node26
-- Relative_Deadline_Variable Node26
- -- Static_Initialization Node26
-- Current_Use_Clause Node27
-- Related_Type Node27
@@ -244,7 +242,8 @@
-- Subprograms_For_Type Node29
- -- (unused) Node30
+ -- Corresponding_Equality Node30
+ -- Static_Initialization Node30
-- (unused) Node31
@@ -863,7 +862,7 @@
(Ekind (Id) = E_Function
and then not Comes_From_Source (Id)
and then Chars (Id) = Name_Op_Ne);
- return Node13 (Id);
+ return Node30 (Id);
end Corresponding_Equality;
function Corresponding_Protected_Entry (Id : E) return E is
@@ -2862,7 +2861,7 @@
begin
pragma Assert
(Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
- return Node26 (Id);
+ return Node30 (Id);
end Static_Initialization;
function Stored_Constraint (Id : E) return L is
@@ -3391,7 +3390,7 @@
(Ekind (Id) = E_Function
and then not Comes_From_Source (Id)
and then Chars (Id) = Name_Op_Ne);
- Set_Node13 (Id, V);
+ Set_Node30 (Id, V);
end Set_Corresponding_Equality;
procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
@@ -5469,7 +5468,7 @@
begin
pragma Assert
(Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
- Set_Node26 (Id, V);
+ Set_Node30 (Id, V);
end Set_Static_Initialization;
procedure Set_Stored_Constraint (Id : E; V : L) is
@@ -8221,19 +8220,8 @@
Write_Str ("Component_Clause");
when E_Function =>
- if not Comes_From_Source (Id)
- and then
- Chars (Id) = Name_Op_Ne
- then
- Write_Str ("Corresponding_Equality");
+ Write_Str ("Elaboration_Entity");
- elsif Comes_From_Source (Id) then
- Write_Str ("Elaboration_Entity");
-
- else
- Write_Str ("Field13??");
- end if;
-
when E_Procedure |
E_Package |
Generic_Unit_Kind =>
@@ -8879,13 +8867,7 @@
when E_Procedure |
E_Function =>
- if Ekind (Id) = E_Procedure
- and then not Is_Dispatching_Operation (Id)
- then
- Write_Str ("Static_Initialization");
- else
- Write_Str ("Overridden_Operation");
- end if;
+ Write_Str ("Overridden_Operation");
when others =>
Write_Str ("Field26??");
@@ -8942,6 +8924,10 @@
end case;
end Write_Field28_Name;
+ ------------------------
+ -- Write_Field29_Name --
+ ------------------------
+
procedure Write_Field29_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
@@ -8953,6 +8939,84 @@
end case;
end Write_Field29_Name;
+ ------------------------
+ -- Write_Field30_Name --
+ ------------------------
+
+ procedure Write_Field30_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when E_Function =>
+ Write_Str ("Corresponding_Equality");
+
+ when E_Procedure =>
+ Write_Str ("Static_Initialization");
+
+ when others =>
+ Write_Str ("Field30??");
+ end case;
+ end Write_Field30_Name;
+
+ ------------------------
+ -- Write_Field31_Name --
+ ------------------------
+
+ procedure Write_Field31_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field31??");
+ end case;
+ end Write_Field31_Name;
+
+ ------------------------
+ -- Write_Field32_Name --
+ ------------------------
+
+ procedure Write_Field32_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field32??");
+ end case;
+ end Write_Field32_Name;
+
+ ------------------------
+ -- Write_Field33_Name --
+ ------------------------
+
+ procedure Write_Field33_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field33??");
+ end case;
+ end Write_Field33_Name;
+
+ ------------------------
+ -- Write_Field34_Name --
+ ------------------------
+
+ procedure Write_Field34_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field34??");
+ end case;
+ end Write_Field34_Name;
+
+ ------------------------
+ -- Write_Field35_Name --
+ ------------------------
+
+ procedure Write_Field35_Name (Id : Entity_Id) is
+ begin
+ case Ekind (Id) is
+ when others =>
+ Write_Str ("Field35??");
+ end case;
+ end Write_Field35_Name;
+
-------------------------
-- Iterator Procedures --
-------------------------
===================================================================
@@ -659,7 +659,7 @@
-- used to constrain a discriminant of the parent type. Points to the
-- corresponding discriminant in the parent type. Otherwise it is Empty.
+-- Corresponding_Equality (Node30)
-- Defined in function entities for implicit inequality operators.
-- Denotes the explicit or derived equality operation that creates
-- the implicit inequality. Note that this field is not present in
@@ -3746,7 +3746,7 @@
-- all types declared in the package, and that a warning must be emitted
-- for those types to which static initialization is not available.
+-- Static_Initialization (Node30)
-- Defined in initialization procedures for types whose objects can be
-- initialized statically. The value of this attribute is a positional
-- aggregate whose components are compile-time static values. Used
@@ -5310,8 +5310,7 @@
-- Handler_Records (List10) (non-generic case only)
-- Protected_Body_Subprogram (Node11)
-- Next_Inlined_Subprogram (Node12)
- -- Corresponding_Equality (Node13) (implicit /= only)
- -- Elaboration_Entity (Node13) (all other cases)
+ -- Elaboration_Entity (Node13) (not implicit /=)
-- First_Optional_Parameter (Node14) (non-generic case only)
-- DT_Position (Uint15)
-- DTC_Entity (Node16)
@@ -5331,6 +5330,7 @@
-- Wrapped_Entity (Node27) (non-generic case only)
-- Extra_Formals (Node28)
-- Subprograms_For_Type (Node29)
+ -- Corresponding_Equality (Node30) (implicit /= only)
-- Body_Needed_For_SAL (Flag40)
-- Elaboration_Entity_Required (Flag174)
-- Default_Expressions_Processed (Flag108)
@@ -5596,10 +5596,10 @@
-- Protection_Object (Node23) (for concurrent kind)
-- Contract (Node24)
-- Interface_Alias (Node25)
- -- Static_Initialization (Node26) (init_proc only)
-- Overridden_Operation (Node26) (never for init proc)
-- Wrapped_Entity (Node27) (non-generic case only)
-- Extra_Formals (Node28)
+ -- Static_Initialization (Node30) (init_proc only)
-- Body_Needed_For_SAL (Flag40)
-- Delay_Cleanups (Flag114)
-- Discard_Names (Flag88)
@@ -7357,6 +7357,12 @@
procedure Write_Field27_Name (Id : Entity_Id);
procedure Write_Field28_Name (Id : Entity_Id);
procedure Write_Field29_Name (Id : Entity_Id);
+ procedure Write_Field30_Name (Id : Entity_Id);
+ procedure Write_Field31_Name (Id : Entity_Id);
+ procedure Write_Field32_Name (Id : Entity_Id);
+ procedure Write_Field33_Name (Id : Entity_Id);
+ procedure Write_Field34_Name (Id : Entity_Id);
+ procedure Write_Field35_Name (Id : Entity_Id);
-- These routines are used in Treepr to output a nice symbolic name for
-- the given field, depending on the Ekind. No blanks or end of lines are
-- output, just the characters of the field name.
===================================================================
@@ -522,7 +522,7 @@
-- entries in this table. Normal programs won't use it at all.
type Paren_Count_Entry is record
- Nod : Node_Id;
+ Nod : Node_Id;
-- The node to which this count applies
Count : Nat range 3 .. Nat'Last;
@@ -2520,6 +2520,12 @@
return Node_Id (Nodes.Table (N + 4).Field11);
end Node29;
+ function Node30 (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Node_Id (Nodes.Table (N + 5).Field6);
+ end Node30;
+
function List1 (N : Node_Id) return List_Id is
begin
pragma Assert (N <= Nodes.Last);
@@ -5219,6 +5225,12 @@
Nodes.Table (N + 4).Field11 := Union_Id (Val);
end Set_Node29;
+ procedure Set_Node30 (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 5).Field6 := Union_Id (Val);
+ end Set_Node30;
+
procedure Set_List1 (N : Node_Id; Val : List_Id) is
begin
pragma Assert (N <= Nodes.Last);
===================================================================
@@ -69,12 +69,13 @@
-- Size of Entities --
----------------------
- -- Currently entities are composed of 5 sequentially allocated 32-byte
+ -- Currently entities are composed of 6 sequentially allocated 32-byte
-- nodes, considered as a single record. The following definition gives
-- the number of extension nodes.
- Num_Extension_Nodes : Int := 4;
- -- This value is increased by one if debug flag -gnatd.N is set
+ Num_Extension_Nodes : Int := 5;
+ -- This value is increased by one if debug flag -gnatd.N is set. This is
+ -- for testing performance impact of adding a new extension node.
----------------------------------------
-- Definitions of Fields in Tree Node --
@@ -1167,6 +1168,9 @@
function Node29 (N : Node_Id) return Node_Id;
pragma Inline (Node29);
+ function Node30 (N : Node_Id) return Node_Id;
+ pragma Inline (Node30);
+
function List1 (N : Node_Id) return List_Id;
pragma Inline (List1);
@@ -2446,6 +2450,9 @@
procedure Set_Node29 (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Node29);
+ procedure Set_Node30 (N : Node_Id; Val : Node_Id);
+ pragma Inline (Set_Node30);
+
procedure Set_List1 (N : Node_Id; Val : List_Id);
pragma Inline (Set_List1);
===================================================================
@@ -687,6 +687,54 @@
Print_Eol;
end if;
+ if Field_Present (Field30 (Ent)) then
+ Print_Str (Prefix);
+ Write_Field30_Name (Ent);
+ Write_Str (" = ");
+ Print_Field (Field30 (Ent));
+ Print_Eol;
+ end if;
+
+ if Field_Present (Field31 (Ent)) then
+ Print_Str (Prefix);
+ Write_Field31_Name (Ent);
+ Write_Str (" = ");
+ Print_Field (Field31 (Ent));
+ Print_Eol;
+ end if;
+
+ if Field_Present (Field32 (Ent)) then
+ Print_Str (Prefix);
+ Write_Field32_Name (Ent);
+ Write_Str (" = ");
+ Print_Field (Field32 (Ent));
+ Print_Eol;
+ end if;
+
+ if Field_Present (Field33 (Ent)) then
+ Print_Str (Prefix);
+ Write_Field33_Name (Ent);
+ Write_Str (" = ");
+ Print_Field (Field33 (Ent));
+ Print_Eol;
+ end if;
+
+ if Field_Present (Field34 (Ent)) then
+ Print_Str (Prefix);
+ Write_Field34_Name (Ent);
+ Write_Str (" = ");
+ Print_Field (Field34 (Ent));
+ Print_Eol;
+ end if;
+
+ if Field_Present (Field35 (Ent)) then
+ Print_Str (Prefix);
+ Write_Field35_Name (Ent);
+ Write_Str (" = ");
+ Print_Field (Field35 (Ent));
+ Print_Eol;
+ end if;
+
Write_Entity_Flags (Ent, Prefix);
end Print_Entity_Info;
===================================================================
@@ -6,7 +6,7 @@
* *
* C Header File *
* *
- * Copyright (C) 1992-2011, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -387,6 +387,7 @@
#define Field27(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field9)
#define Field28(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field10)
#define Field29(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.field11)
+#define Field30(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field6)
#define Node1(N) Field1 (N)
#define Node2(N) Field2 (N)
@@ -417,6 +418,7 @@
#define Node27(N) Field27 (N)
#define Node28(N) Field28 (N)
#define Node29(N) Field29 (N)
+#define Node30(N) Field30 (N)
#define List1(N) Field1 (N)
#define List2(N) Field2 (N)