[Ada] Add flags for front-end (internal change only)

Arnaud Charlet charlet@adacore.com
Tue Jan 21 07:48:00 GMT 2014


This patch adds a new Flags array parallel to the Nodes array, and uses
it to provide four new flags Flag0,1,2,3 available in all nodes and
entities.

There is room for four more flags in every node, for use later

And also space for five extra bytes in every entity, should
we ever need it.

No test needed, since no external effect (tested internally by
switching four critical flags to use these new flag locations.
and making sure everything still works). The flags are not yet
in use.

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-01-21  Robert Dewar  <dewar@adacore.com>

	* gcc-interface/gigi.h: Get Flags array address.
	* gcc-interface/trans.c: Acquire Flags array address.
	* atree.adb: Add support for Flags array and Flag0,1,2,3.
	* atree.ads: Add support for Flags array and Flag0,1,2,3.
	* atree.h: Add support for Flags array and Flag0,1,2,3.
	* back_end.adb: Pass Flags array address to gigi.

-------------- next part --------------
Index: back_end.adb
===================================================================
--- back_end.adb	(revision 206804)
+++ back_end.adb	(working copy)
@@ -87,6 +87,7 @@
          max_gnat_node                 : Int;
          number_name                   : Nat;
          nodes_ptr                     : Address;
+         flags_ptr                     : Address;
 
          next_node_ptr                 : Address;
          prev_node_ptr                 : Address;
@@ -141,6 +142,7 @@
          max_gnat_node      => Int (Last_Node_Id - First_Node_Id + 1),
          number_name        => Name_Entries_Count,
          nodes_ptr          => Nodes_Address,
+         flags_ptr          => Flags_Address,
 
          next_node_ptr      => Next_Node_Address,
          prev_node_ptr      => Prev_Node_Address,
Index: atree.adb
===================================================================
--- atree.adb	(revision 206844)
+++ atree.adb	(working copy)
@@ -568,14 +568,17 @@
         and then Src = Nodes.Last
       then
          New_Id := Src;
+
       else
          --  We are allocating a new node, or extending a node
          --  other than Nodes.Last.
 
          if Present (Src) then
             Nodes.Append (Nodes.Table (Src));
+            Flags.Append (Flags.Table (Src));
          else
             Nodes.Append (Default_Node);
+            Flags.Append (Default_Flags);
          end if;
 
          New_Id := Nodes.Last;
@@ -596,10 +599,12 @@
          if Present (Src) and then Has_Extension (Src) then
             for J in 1 .. Num_Extension_Nodes loop
                Nodes.Append (Nodes.Table (Src + Node_Id (J)));
+               Flags.Append (Flags.Table (Src + Node_Id (J)));
             end loop;
          else
             for J in 1 .. Num_Extension_Nodes loop
                Nodes.Append (Default_Node_Extension);
+               Flags.Append (Default_Flags);
             end loop;
          end if;
       end if;
@@ -680,6 +685,8 @@
       Nodes.Table (N).Nkind             := New_Node_Kind;
       Nodes.Table (N).Error_Posted      := Save_Posted;
 
+      Flags.Table (N) := Default_Flags;
+
       if New_Node_Kind in N_Subexpr then
          Set_Paren_Count (N, Par_Count);
       end if;
@@ -718,6 +725,8 @@
       Nodes.Table (Destination).In_List := Save_In_List;
       Nodes.Table (Destination).Link    := Save_Link;
 
+      Flags.Table (Destination) := Flags.Table (Source);
+
       --  Specifically set Paren_Count to make sure auxiliary table entry
       --  gets correctly made if the parentheses count is at the max value.
 
@@ -725,7 +734,8 @@
          Set_Paren_Count (Destination, Paren_Count (Source));
       end if;
 
-      --  Deal with copying extension nodes if present
+      --  Deal with copying extension nodes if present. No need to copy flags
+      --  table entries, since they are always zero for extending components.
 
       if Has_Extension (Source) then
          pragma Assert (Has_Extension (Destination));
@@ -1094,6 +1104,7 @@
 
    procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id) is
       Temp_Ent : Node_Record;
+      Temp_Flg : Flags_Byte;
 
    begin
       pragma Assert (Has_Extension (E1)
@@ -1127,6 +1138,13 @@
       Nodes.Table (E1 + 5) := Nodes.Table (E2 + 5);
       Nodes.Table (E2 + 5) := Temp_Ent;
 
+      --  Exchange flag bytes for first component. No need to do the exchange
+      --  for the other components, since the flag bytes are always zero.
+
+      Temp_Flg := Flags.Table (E1);
+      Flags.Table (E1) := Flags.Table (E2);
+      Flags.Table (E2) := Temp_Flg;
+
       --  That exchange exchanged the parent pointers as well, which is what
       --  we want, but we need to patch up the defining identifier pointers
       --  in the parent nodes (the child pointers) to match this switch
@@ -1231,6 +1249,15 @@
       Fix_Parent (Field5 (Fix_Node));
    end Fix_Parents;
 
+   -------------------
+   -- Flags_Address --
+   -------------------
+
+   function Flags_Address return System.Address is
+   begin
+      return Flags.Table (First_Node_Id)'Address;
+   end Flags_Address;
+
    -----------------------------------
    -- Get_Comes_From_Source_Default --
    -----------------------------------
@@ -1270,6 +1297,7 @@
    begin
       Node_Count := 0;
       Atree_Private_Part.Nodes.Init;
+      Atree_Private_Part.Flags.Init;
       Orig_Nodes.Init;
       Paren_Counts.Init;
 
@@ -1320,8 +1348,10 @@
    procedure Lock is
    begin
       Nodes.Locked := True;
+      Flags.Locked := True;
       Orig_Nodes.Locked := True;
       Nodes.Release;
+      Flags.Release;
       Orig_Nodes.Release;
    end Lock;
 
@@ -2157,6 +2187,7 @@
    begin
       Tree_Read_Int (Node_Count);
       Nodes.Tree_Read;
+      Flags.Tree_Read;
       Orig_Nodes.Tree_Read;
       Paren_Counts.Tree_Read;
    end Tree_Read;
@@ -2169,6 +2200,7 @@
    begin
       Tree_Write_Int (Node_Count);
       Nodes.Tree_Write;
+      Flags.Tree_Write;
       Orig_Nodes.Tree_Write;
       Paren_Counts.Tree_Write;
    end Tree_Write;
@@ -3006,6 +3038,30 @@
          return From_Union (Nodes.Table (N + 3).Field8);
       end Ureal21;
 
+      function Flag0 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         return Flags.Table (N).Flag0;
+      end Flag0;
+
+      function Flag1 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         return Flags.Table (N).Flag1;
+      end Flag1;
+
+      function Flag2 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         return Flags.Table (N).Flag2;
+      end Flag2;
+
+      function Flag3 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         return Flags.Table (N).Flag3;
+      end Flag3;
+
       function Flag4 (N : Node_Id) return Boolean is
       begin
          pragma Assert (N <= Nodes.Last);
@@ -5563,6 +5619,30 @@
          Nodes.Table (N + 3).Field8 := To_Union (Val);
       end Set_Ureal21;
 
+      procedure Set_Flag0 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         Flags.Table (N).Flag0 := Val;
+      end Set_Flag0;
+
+      procedure Set_Flag1 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         Flags.Table (N).Flag1 := Val;
+      end Set_Flag1;
+
+      procedure Set_Flag2 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         Flags.Table (N).Flag2 := Val;
+      end Set_Flag2;
+
+      procedure Set_Flag3 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (N <= Nodes.Last);
+         Flags.Table (N).Flag3 := Val;
+      end Set_Flag3;
+
       procedure Set_Flag4 (N : Node_Id; Val : Boolean) is
       begin
          pragma Assert (N <= Nodes.Last);
@@ -7924,6 +8004,7 @@
    procedure Unlock is
    begin
       Nodes.Locked := False;
+      Flags.Locked := False;
       Orig_Nodes.Locked := False;
    end Unlock;
 
Index: atree.ads
===================================================================
--- atree.ads	(revision 206804)
+++ atree.ads	(working copy)
@@ -168,16 +168,20 @@
    --   it is useful to be able to do untyped traversals, and an internal
    --   package in Atree allows for direct untyped accesses in such cases.
 
-   --   Flag4         Fifteen Boolean flags (use depends on Nkind and
-   --   Flag5         Ekind, as described for FieldN). Again the access
-   --   Flag6         is usually via subprograms in Sinfo and Einfo which
-   --   Flag7         provide high-level synonyms for these flags, and
-   --   Flag8         contain debugging code that checks that the values
-   --   Flag9         in Nkind and Ekind are appropriate for the access.
+   --   Flag0         Nineteen Boolean flags (use depends on Nkind and
+   --   Flag1         Ekind, as described for FieldN). Again the access
+   --   Flag2         is usually via subprograms in Sinfo and Einfo which
+   --   Flag3         provide high-level synonyms for these flags, and
+   --   Flag4         contain debugging code that checks that the values
+   --   Flag5         in Nkind and Ekind are appropriate for the access.
+   --   Flag6
+   --   Flag7
+   --   Flag8
+   --   Flag9
    --   Flag10
-   --   Flag11        Note that Flag1-3 are missing from this list. For
-   --   Flag12        historical reasons, these flag names are unused.
-   --   Flag13
+   --   Flag11        Note that Flag0-3 are stored separately in the Flags
+   --   Flag12        table, but that's a detail of the implementation which
+   --   Flag13        is entirely hidden by the funcitonal interface.
    --   Flag14
    --   Flag15
    --   Flag16
@@ -220,6 +224,9 @@
    function Nodes_Address return System.Address;
    --  Return address of Nodes table (used in Back_End for Gigi call)
 
+   function Flags_Address return System.Address;
+   --  Return address of Flags table (used in Back_End for Gigi call)
+
    function Num_Nodes return Nat;
    --  Total number of nodes allocated, where an entity counts as a single
    --  node. This count is incremented every time a node or entity is
@@ -350,7 +357,7 @@
    -------------------------------------
 
    --  A subpackage Atree.Unchecked_Access provides routines for reading and
-   --  writing the fields defined above (Field1-35, Node1-35, Flag4-317 etc).
+   --  writing the fields defined above (Field1-35, Node1-35, Flag0-317 etc).
    --  These unchecked access routines can be used for untyped traversals.
    --  In addition they are used in the implementations of the Sinfo and
    --  Einfo packages. These packages both provide logical synonyms for
@@ -1341,6 +1348,18 @@
       function Ureal21 (N : Node_Id) return Ureal;
       pragma Inline (Ureal21);
 
+      function Flag0 (N : Node_Id) return Boolean;
+      pragma Inline (Flag0);
+
+      function Flag1 (N : Node_Id) return Boolean;
+      pragma Inline (Flag1);
+
+      function Flag2 (N : Node_Id) return Boolean;
+      pragma Inline (Flag2);
+
+      function Flag3 (N : Node_Id) return Boolean;
+      pragma Inline (Flag3);
+
       function Flag4 (N : Node_Id) return Boolean;
       pragma Inline (Flag4);
 
@@ -2624,6 +2643,18 @@
       procedure Set_Ureal21 (N : Node_Id; Val : Ureal);
       pragma Inline (Set_Ureal21);
 
+      procedure Set_Flag0 (N : Node_Id; Val : Boolean);
+      pragma Inline (Set_Flag0);
+
+      procedure Set_Flag1 (N : Node_Id; Val : Boolean);
+      pragma Inline (Set_Flag1);
+
+      procedure Set_Flag2 (N : Node_Id; Val : Boolean);
+      pragma Inline (Set_Flag2);
+
+      procedure Set_Flag3 (N : Node_Id; Val : Boolean);
+      pragma Inline (Set_Flag3);
+
       procedure Set_Flag4 (N : Node_Id; Val : Boolean);
       pragma Inline (Set_Flag4);
 
@@ -3621,12 +3652,12 @@
       -------------------------
 
       --  The nodes of the tree are stored in a table (i.e. an array). In the
-      --  case of extended nodes five consecutive components in the array are
+      --  case of extended nodes six consecutive components in the array are
       --  used. There are thus two formats for array components. One is used
       --  for non-extended nodes, and for the first component of extended
       --  nodes. The other is used for the extension parts (second, third,
-      --  fourth and fifth components) of an extended node. A variant record
-      --  structure is used to distinguish the two formats.
+      --  fourth, fifth, and sixth components) of an extended node. A variant
+      --  record structure is used to distinguish the two formats.
 
       type Node_Record (Is_Extension : Boolean := False) is record
 
@@ -3680,7 +3711,8 @@
          Flag16 : Boolean;
          Flag17 : Boolean;
          Flag18 : Boolean;
-         --  The eighteen flags for a normal node
+         --  Flags 4-18 for a normal node. Note that Flags 0-3 are stored
+         --  separately in the Flags array.
 
          --  The above fields are used as follows in components 2-6 of
          --  an extended node entry.
@@ -3888,7 +3920,7 @@
          Field12           => Empty_List_Or_Node);
 
       --  The following defines the extendable array used for the nodes table
-      --  Nodes with extensions use five consecutive entries in the array
+      --  Nodes with extensions use six consecutive entries in the array
 
       package Nodes is new Table.Table (
         Table_Component_Type => Node_Record,
@@ -3898,6 +3930,37 @@
         Table_Increment      => Alloc.Nodes_Increment,
         Table_Name           => "Nodes");
 
+      --  The following is a parallel table to Nodes, which provides 8 more
+      --  bits of space that logically belong to the corresponding node. This
+      --  is currently used to implement Flags 0,1,2,3 for normal nodes, or
+      --  the first component of an extended node (four bits unused). Entries
+      --  for extending components are completely unused.
+
+      type Flags_Byte is record
+         Flag0  : Boolean;
+         Flag1  : Boolean;
+         Flag2  : Boolean;
+         Flag3  : Boolean;
+         Spare0 : Boolean;
+         Spare1 : Boolean;
+         Spare2 : Boolean;
+         Spare3 : Boolean;
+      end record;
+
+      for Flags_Byte'Size use 8;
+      pragma Pack (Flags_Byte);
+
+      Default_Flags : constant Flags_Byte := (others => False);
+      --  Default value used to initialize new entries
+
+      package Flags is new Table.Table (
+        Table_Component_Type => Flags_Byte,
+        Table_Index_Type     => Node_Id'Base,
+        Table_Low_Bound      => First_Node_Id,
+        Table_Initial        => Alloc.Nodes_Initial,
+        Table_Increment      => Alloc.Nodes_Increment,
+        Table_Name           => "Flags");
+
    end Atree_Private_Part;
 
 end Atree;
Index: atree.h
===================================================================
--- atree.h	(revision 206804)
+++ atree.h	(working copy)
@@ -359,6 +359,21 @@
 #define Parent atree__parent
 extern Node_Id Parent (Node_Id);
 
+/* The auxiliary flags array which is allocated in parallel to Nodes */
+
+struct Flags
+{
+    Boolean      Flag0  : 1;
+    Boolean      Flag1  : 1;
+    Boolean      Flag2  : 1;
+    Boolean      Flag3  : 1;
+    Boolean      Spare0 : 1;
+    Boolean      Spare1 : 1;
+    Boolean      Spare2 : 1;
+    Boolean      Spare3 : 1;
+};
+extern struct Flags *Flags_Ptr;
+
 /* Overloaded Functions:
 
    These functions are overloaded in the original Ada source, but there is
@@ -531,6 +546,11 @@
 #define Convention(N) \
     (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.convention)
 
+#define Flag0(N)      (Flags_Ptr[(N) - First_Node_Id].Flag0)
+#define Flag1(N)      (Flags_Ptr[(N) - First_Node_Id].Flag1)
+#define Flag2(N)      (Flags_Ptr[(N) - First_Node_Id].Flag2)
+#define Flag3(N)      (Flags_Ptr[(N) - First_Node_Id].Flag3)
+
 #define Flag4(N)      (Nodes_Ptr[(N) - First_Node_Id].U.K.flag4)
 #define Flag5(N)      (Nodes_Ptr[(N) - First_Node_Id].U.K.flag5)
 #define Flag6(N)      (Nodes_Ptr[(N) - First_Node_Id].U.K.flag6)
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h	(revision 206804)
+++ gcc-interface/gigi.h	(working copy)
@@ -238,10 +238,14 @@
 
 /* This is the main program of the back-end.  It sets up all the table
    structures and then generates code.  */
-extern void gigi (Node_Id gnat_root, int max_gnat_node,
+extern void gigi (Node_Id gnat_root,
+	          int max_gnat_node,
                   int number_name ATTRIBUTE_UNUSED,
-                  struct Node *nodes_ptr, Node_Id *next_node_ptr,
-                  Node_Id *prev_node_ptr, struct Elist_Header *elists_ptr,
+		  struct Node *nodes_ptr,
+		  struct Flags *Flags_Ptr,
+		  Node_Id *next_node_ptr,
+		  Node_Id *prev_node_ptr,
+		  struct Elist_Header *elists_ptr,
                   struct Elmt_Item *elmts_ptr,
                   struct String_Entry *strings_ptr,
                   Char_Code *strings_chars_ptr,
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 206804)
+++ gcc-interface/trans.c	(working copy)
@@ -90,6 +90,7 @@
 
 /* Pointers to front-end tables accessed through macros.  */
 struct Node *Nodes_Ptr;
+struct Flags *Flags_Ptr;
 Node_Id *Next_Node_Ptr;
 Node_Id *Prev_Node_Ptr;
 struct Elist_Header *Elists_Ptr;
@@ -273,15 +274,26 @@
    structures and then generates code.  */
 
 void
-gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
-      struct Node *nodes_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr,
-      struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
-      struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
-      struct List_Header *list_headers_ptr, Nat number_file,
+gigi (Node_Id gnat_root,
+      int max_gnat_node,
+      int number_name ATTRIBUTE_UNUSED,
+      struct Node *nodes_ptr,
+      struct Flags *flags_ptr,
+      Node_Id *next_node_ptr,
+      Node_Id *prev_node_ptr,
+      struct Elist_Header *elists_ptr,
+      struct Elmt_Item *elmts_ptr,
+      struct String_Entry *strings_ptr,
+      Char_Code *string_chars_ptr,
+      struct List_Header *list_headers_ptr,
+      Nat number_file,
       struct File_Info_Type *file_info_ptr,
-      Entity_Id standard_boolean, Entity_Id standard_integer,
-      Entity_Id standard_character, Entity_Id standard_long_long_float,
-      Entity_Id standard_exception_type, Int gigi_operating_mode)
+      Entity_Id standard_boolean,
+      Entity_Id standard_integer,
+      Entity_Id standard_character,
+      Entity_Id standard_long_long_float,
+      Entity_Id standard_exception_type,
+      Int gigi_operating_mode)
 {
   Node_Id gnat_iter;
   Entity_Id gnat_literal;
@@ -293,6 +305,7 @@
   max_gnat_nodes = max_gnat_node;
 
   Nodes_Ptr = nodes_ptr;
+  Flags_Ptr = flags_ptr;
   Next_Node_Ptr = next_node_ptr;
   Prev_Node_Ptr = prev_node_ptr;
   Elists_Ptr = elists_ptr;


More information about the Gcc-patches mailing list