This patch uses the newly available fields in an extended entity
node to avoid some nasty cases of field duplexing, which we try
to avoid. Internal change only, no functional effect, no test.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-01-29 Robert Dewar <de...@adacore.com>
* atree.ads, atree.adb (Node30): New function.
(Set_Node30): New procedure.
(Num_Extension_Nodes): Change to 5 (activate new fields/flags).
* atree.h: Add macros for Field30 and Node30.
* einfo.ads, einfo.adb: Move some fields to avoid duplexing.
* treepr.adb (Print_Entity_Information): Print fields 30-35.
Index: einfo.adb
===================================================================
--- einfo.adb (revision 195533)
+++ einfo.adb (working copy)
@@ -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 --
-------------------------
Index: einfo.ads
===================================================================
--- einfo.ads (revision 195533)
+++ einfo.ads (working copy)
@@ -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 (Node13)
+-- 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 (Node26)
+-- 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.
Index: atree.adb
===================================================================
--- atree.adb (revision 195533)
+++ atree.adb (working copy)
@@ -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);
Index: atree.ads
===================================================================
--- atree.ads (revision 195533)
+++ atree.ads (working copy)
@@ -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);
Index: treepr.adb
===================================================================
--- treepr.adb (revision 195533)
+++ treepr.adb (working copy)
@@ -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;
Index: atree.h
===================================================================
--- atree.h (revision 195533)
+++ atree.h (working copy)
@@ -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)
