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 <de...@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.
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;
