Patchwork [Ada] Avoid duplexing of fields in entity nodes (internal change)

login
register
mail settings
Submitter Arnaud Charlet
Date Jan. 29, 2013, 2:01 p.m.
Message ID <20130129140134.GA21447@adacore.com>
Download mbox | patch
Permalink /patch/216543/
State New
Headers show

Comments

Arnaud Charlet - Jan. 29, 2013, 2:01 p.m.
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  <dewar@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.

Patch

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)