-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- file must be properly reflected in the file atree.h which is a C header
-- file containing equivalent definitions for use by gigi.
+with Aspects; use Aspects;
with Debug; use Debug;
with Nlists; use Nlists;
-with Elists; use Elists;
with Output; use Output;
with Sinput; use Sinput;
with Tree_IO; use Tree_IO;
-with GNAT.HTable; use GNAT.HTable;
-
package body Atree is
+ Reporting_Proc : Report_Proc := null;
+ -- Record argument to last call to Set_Reporting_Proc
+
---------------
-- Debugging --
---------------
-- Either way, gnat1 will stop when node 12345 is created
- -- The second method is faster
+ -- The second method is much faster
+
+ -- Similarly, rr and rrd allow breaking on rewriting of a given node
ww : Node_Id'Base := Node_Id'First - 1;
pragma Export (Ada, ww); -- trick the optimizer
Watch_Node : Node_Id'Base renames ww;
- -- Node to "watch"; that is, whenever a node is created, we check if it is
- -- equal to Watch_Node, and if so, call New_Node_Breakpoint. You have
+ -- Node to "watch"; that is, whenever a node is created, we check if it
+ -- is equal to Watch_Node, and if so, call New_Node_Breakpoint. You have
-- presumably set a breakpoint on New_Node_Breakpoint. Note that the
-- initial value of Node_Id'First - 1 ensures that by default, no node
-- will be equal to Watch_Node.
-- If Node = Watch_Node, this prints out the new node and calls
-- New_Node_Breakpoint. Otherwise, does nothing.
+ procedure rr;
+ pragma Export (Ada, rr);
+ procedure Rewrite_Breakpoint renames rr;
+ -- This doesn't do anything interesting; it's just for setting breakpoint
+ -- on as explained above.
+
+ procedure rrd (Old_Node, New_Node : Node_Id);
+ pragma Export (Ada, rrd);
+ procedure Rewrite_Debugging_Output
+ (Old_Node, New_Node : Node_Id) renames rrd;
+ -- For debugging. If debugging is turned on, Rewrite calls this. If debug
+ -- flag N is turned on, this prints out the new node.
+ --
+ -- If Old_Node = Watch_Node, this prints out the old and new nodes and
+ -- calls Rewrite_Breakpoint. Otherwise, does nothing.
+
+ procedure Node_Debug_Output (Op : String; N : Node_Id);
+ -- Common code for nnd and rrd, writes Op followed by information about N
+
-----------------------------
-- Local Objects and Types --
-----------------------------
use Atree_Private_Part;
-- We are also allowed to see our private data structures!
- function E_To_N is new Unchecked_Conversion (Entity_Kind, Node_Kind);
- function N_To_E is new Unchecked_Conversion (Node_Kind, Entity_Kind);
-- Functions used to store Entity_Kind value in Nkind field
-- The following declarations are used to store flags 65-72 in the
function To_Flag_Byte_Ptr is new
Unchecked_Conversion (Node_Kind_Ptr, Flag_Byte_Ptr);
+ -- The following declarations are used to store flags 239-246 in the
+ -- Nkind field of the fourth component of an extended (entity) node.
+
+ type Flag_Byte2 is record
+ Flag239 : Boolean;
+ Flag240 : Boolean;
+ Flag241 : Boolean;
+ Flag242 : Boolean;
+ Flag243 : Boolean;
+ Flag244 : Boolean;
+ Flag245 : Boolean;
+ Flag246 : Boolean;
+ end record;
+
+ pragma Pack (Flag_Byte2);
+ for Flag_Byte2'Size use 8;
+
+ type Flag_Byte2_Ptr is access all Flag_Byte2;
+
+ function To_Flag_Byte2 is new
+ Unchecked_Conversion (Node_Kind, Flag_Byte2);
+
+ function To_Flag_Byte2_Ptr is new
+ Unchecked_Conversion (Node_Kind_Ptr, Flag_Byte2_Ptr);
+
+ -- The following declarations are used to store flags 247-254 in the
+ -- Nkind field of the fifth component of an extended (entity) node.
+
+ type Flag_Byte3 is record
+ Flag247 : Boolean;
+ Flag248 : Boolean;
+ Flag249 : Boolean;
+ Flag250 : Boolean;
+ Flag251 : Boolean;
+ Flag252 : Boolean;
+ Flag253 : Boolean;
+ Flag254 : Boolean;
+ end record;
+
+ pragma Pack (Flag_Byte3);
+ for Flag_Byte3'Size use 8;
+
+ type Flag_Byte3_Ptr is access all Flag_Byte3;
+
+ function To_Flag_Byte3 is new
+ Unchecked_Conversion (Node_Kind, Flag_Byte3);
+
+ function To_Flag_Byte3_Ptr is new
+ Unchecked_Conversion (Node_Kind_Ptr, Flag_Byte3_Ptr);
+
-- The following declarations are used to store flags 73-96 and the
-- Convention field in the Field12 field of the third component of an
-- extended (Entity) node.
Unchecked_Conversion (Union_Id_Ptr, Flag_Word3_Ptr);
-- The following declarations are used to store flags 184-215 in the
- -- Field11 field of the fifth component of an extended (entity) node.
+ -- Field12 field of the fifth component of an extended (entity) node.
type Flag_Word4 is record
Flag184 : Boolean;
function To_Flag_Word4_Ptr is new
Unchecked_Conversion (Union_Id_Ptr, Flag_Word4_Ptr);
- -- The following declarations are used to store flags 216-247 in the
- -- Field12 field of the fifth component of an extended (entity) node.
-
- type Flag_Word5 is record
- Flag216 : Boolean;
- Flag217 : Boolean;
- Flag218 : Boolean;
- Flag219 : Boolean;
- Flag220 : Boolean;
- Flag221 : Boolean;
- Flag222 : Boolean;
- Flag223 : Boolean;
-
- Flag224 : Boolean;
- Flag225 : Boolean;
- Flag226 : Boolean;
- Flag227 : Boolean;
- Flag228 : Boolean;
- Flag229 : Boolean;
- Flag230 : Boolean;
-
- -- Note: flags 231-247 not in use yet
-
- Flag231 : Boolean;
-
- Flag232 : Boolean;
- Flag233 : Boolean;
- Flag234 : Boolean;
- Flag235 : Boolean;
- Flag236 : Boolean;
- Flag237 : Boolean;
- Flag238 : Boolean;
- Flag239 : Boolean;
-
- Flag240 : Boolean;
- Flag241 : Boolean;
- Flag242 : Boolean;
- Flag243 : Boolean;
- Flag244 : Boolean;
- Flag245 : Boolean;
- Flag246 : Boolean;
- Flag247 : Boolean;
- end record;
-
- pragma Pack (Flag_Word5);
- for Flag_Word5'Size use 32;
- for Flag_Word5'Alignment use 4;
-
- type Flag_Word5_Ptr is access all Flag_Word5;
-
- function To_Flag_Word5 is new
- Unchecked_Conversion (Union_Id, Flag_Word5);
-
- function To_Flag_Word5_Ptr is new
- Unchecked_Conversion (Union_Id_Ptr, Flag_Word5_Ptr);
-
- -- Default value used to initialize default nodes. Note that some of the
- -- fields get overwritten, and in particular, Nkind always gets reset.
-
- Default_Node : Node_Record := (
- Is_Extension => False,
- Pflag1 => False,
- Pflag2 => False,
- In_List => False,
- Unused_1 => False,
- Rewrite_Ins => False,
- Analyzed => False,
- Comes_From_Source => False, -- modified by Set_Comes_From_Source_Default
- Error_Posted => False,
- Flag4 => False,
-
- Flag5 => False,
- Flag6 => False,
- Flag7 => False,
- Flag8 => False,
- Flag9 => False,
- Flag10 => False,
- Flag11 => False,
- Flag12 => False,
-
- Flag13 => False,
- Flag14 => False,
- Flag15 => False,
- Flag16 => False,
- Flag17 => False,
- Flag18 => False,
-
- Nkind => N_Unused_At_Start,
-
- Sloc => No_Location,
- Link => Empty_List_Or_Node,
- Field1 => Empty_List_Or_Node,
- Field2 => Empty_List_Or_Node,
- Field3 => Empty_List_Or_Node,
- Field4 => Empty_List_Or_Node,
- Field5 => Empty_List_Or_Node);
-
- -- Default value used to initialize node extensions (i.e. the second
- -- and third and fourth components of an extended node). Note we are
- -- cheating a bit here when it comes to Node12, which really holds
- -- flags an (for the third component), the convention. But it works
- -- because Empty, False, Convention_Ada, all happen to be all zero bits.
-
- Default_Node_Extension : constant Node_Record := (
- Is_Extension => True,
- Pflag1 => False,
- Pflag2 => False,
- In_List => False,
- Unused_1 => False,
- Rewrite_Ins => False,
- Analyzed => False,
- Comes_From_Source => False,
- Error_Posted => False,
- Flag4 => False,
-
- Flag5 => False,
- Flag6 => False,
- Flag7 => False,
- Flag8 => False,
- Flag9 => False,
- Flag10 => False,
- Flag11 => False,
- Flag12 => False,
-
- Flag13 => False,
- Flag14 => False,
- Flag15 => False,
- Flag16 => False,
- Flag17 => False,
- Flag18 => False,
-
- Nkind => E_To_N (E_Void),
-
- Field6 => Empty_List_Or_Node,
- Field7 => Empty_List_Or_Node,
- Field8 => Empty_List_Or_Node,
- Field9 => Empty_List_Or_Node,
- Field10 => Empty_List_Or_Node,
- Field11 => Empty_List_Or_Node,
- Field12 => Empty_List_Or_Node);
-
--------------------------------------------------
-- Implementation of Tree Substitution Routines --
--------------------------------------------------
Table_Increment => Alloc.Orig_Nodes_Increment,
Table_Name => "Orig_Nodes");
- ----------------------------------------
- -- Global_Variables for New_Copy_Tree --
- ----------------------------------------
-
- -- These global variables are used by New_Copy_Tree. See description
- -- of the body of this subprogram for details. Global variables can be
- -- safely used by New_Copy_Tree, since there is no case of a recursive
- -- call from the processing inside New_Copy_Tree.
-
- NCT_Hash_Threshhold : constant := 20;
- -- If there are more than this number of pairs of entries in the
- -- map, then Hash_Tables_Used will be set, and the hash tables will
- -- be initialized and used for the searches.
-
- NCT_Hash_Tables_Used : Boolean := False;
- -- Set to True if hash tables are in use
-
- NCT_Table_Entries : Nat;
- -- Count entries in table to see if threshhold is reached
-
- NCT_Hash_Table_Setup : Boolean := False;
- -- Set to True if hash table contains data. We set this True if we
- -- setup the hash table with data, and leave it set permanently
- -- from then on, this is a signal that second and subsequent users
- -- of the hash table must clear the old entries before reuse.
-
- subtype NCT_Header_Num is Int range 0 .. 511;
- -- Defines range of headers in hash tables (512 headers)
-
--------------------------
-- Paren_Count Handling --
--------------------------
-- Local Subprograms --
-----------------------
- procedure Fix_Parents (Old_Node, New_Node : Node_Id);
- -- Fixup parent pointers for the syntactic children of New_Node after
- -- a copy, setting them to New_Node when they pointed to Old_Node.
+ procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id);
+ -- Fixup parent pointers for the syntactic children of Fix_Node after
+ -- a copy, setting them to Fix_Node when they pointed to Ref_Node.
function Allocate_Initialize_Node
(Src : Node_Id;
(Src : Node_Id;
With_Extension : Boolean) return Node_Id
is
- New_Id : Node_Id := Src;
- Nod : Node_Record := Default_Node;
- Ext1 : Node_Record := Default_Node_Extension;
- Ext2 : Node_Record := Default_Node_Extension;
- Ext3 : Node_Record := Default_Node_Extension;
- Ext4 : Node_Record := Default_Node_Extension;
+ New_Id : Node_Id;
begin
- if Present (Src) then
- Nod := Nodes.Table (Src);
-
- if Has_Extension (Src) then
- Ext1 := Nodes.Table (Src + 1);
- Ext2 := Nodes.Table (Src + 2);
- Ext3 := Nodes.Table (Src + 3);
- Ext4 := Nodes.Table (Src + 4);
- end if;
- end if;
-
- if not (Present (Src)
- and then not Has_Extension (Src)
- and then With_Extension
- and then Src = Nodes.Last)
+ if Present (Src)
+ and then not Has_Extension (Src)
+ and then With_Extension
+ and then Src = Nodes.Last
then
+ New_Id := Src;
+ else
-- We are allocating a new node, or extending a node
-- other than Nodes.Last.
- Nodes.Append (Nod);
+ if Present (Src) then
+ Nodes.Append (Nodes.Table (Src));
+ else
+ Nodes.Append (Default_Node);
+ end if;
+
New_Id := Nodes.Last;
Orig_Nodes.Append (New_Id);
Node_Count := Node_Count + 1;
-- Set extension nodes if required
if With_Extension then
- Nodes.Append (Ext1);
- Nodes.Append (Ext2);
- Nodes.Append (Ext3);
- Nodes.Append (Ext4);
+ if Present (Src) and then Has_Extension (Src) then
+ for J in 1 .. 4 loop
+ Nodes.Append (Nodes.Table (Src + Node_Id (J)));
+ end loop;
+ else
+ for J in 1 .. 4 loop
+ Nodes.Append (Default_Node_Extension);
+ end loop;
+ end if;
end if;
Orig_Nodes.Set_Last (Nodes.Last);
Allocate_List_Tables (Nodes.Last);
+
+ -- Invoke the reporting procedure (if available)
+
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => New_Id, Source => Src);
+ end if;
+
return New_Id;
end Allocate_Initialize_Node;
return Nodes.Table (N).Analyzed;
end Analyzed;
+ --------------------------
+ -- Basic_Set_Convention --
+ --------------------------
+
+ procedure Basic_Set_Convention (E : Entity_Id; Val : Convention_Id) is
+ begin
+ pragma Assert (Nkind (E) in N_Entity);
+ To_Flag_Word_Ptr
+ (Union_Id_Ptr'
+ (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention := Val;
+ end Basic_Set_Convention;
+
-----------------
-- Change_Node --
-----------------
end Copy_Node;
------------------------
+ -- Copy_Separate_List --
+ ------------------------
+
+ function Copy_Separate_List (Source : List_Id) return List_Id is
+ Result : constant List_Id := New_List;
+ Nod : Node_Id;
+
+ begin
+ Nod := First (Source);
+ while Present (Nod) loop
+ Append (Copy_Separate_Tree (Nod), Result);
+ Next (Nod);
+ end loop;
+
+ return Result;
+ end Copy_Separate_List;
+
+ ------------------------
-- Copy_Separate_Tree --
------------------------
Set_Field4 (New_Id, Possible_Copy (Field4 (New_Id)));
Set_Field5 (New_Id, Possible_Copy (Field5 (New_Id)));
- -- Set Entity field to Empty
- -- Why is this done??? and why is it always right to do it???
+ -- Set Entity field to Empty to ensure that no entity references
+ -- are shared between the two, if the source is already analyzed.
if Nkind (New_Id) in N_Has_Entity
or else Nkind (New_Id) = N_Freeze_Entity
end if;
end Copy_Separate_Tree;
- -----------------
- -- Delete_Node --
- -----------------
-
- procedure Delete_Node (Node : Node_Id) is
- begin
- pragma Assert (not Nodes.Table (Node).In_List);
-
- if Debug_Flag_N then
- Write_Str ("Delete node ");
- Write_Int (Int (Node));
- Write_Eol;
- end if;
-
- Nodes.Table (Node) := Default_Node;
- Nodes.Table (Node).Nkind := N_Unused_At_Start;
- Node_Count := Node_Count - 1;
-
- -- Note: for now, we are not bothering to reuse deleted nodes
-
- end Delete_Node;
-
- -----------------
- -- Delete_Tree --
- -----------------
-
- procedure Delete_Tree (Node : Node_Id) is
-
- procedure Delete_Field (F : Union_Id);
- -- Delete item pointed to by field F if it is a syntactic element
-
- procedure Delete_List (L : List_Id);
- -- Delete all elements on the given list
-
- ------------------
- -- Delete_Field --
- ------------------
-
- procedure Delete_Field (F : Union_Id) is
- begin
- if F = Union_Id (Empty) then
- return;
-
- elsif F in Node_Range
- and then Parent (Node_Id (F)) = Node
- then
- Delete_Tree (Node_Id (F));
-
- elsif F in List_Range
- and then Parent (List_Id (F)) = Node
- then
- Delete_List (List_Id (F));
-
- -- No need to test Elist case, there are no syntactic Elists
-
- else
- return;
- end if;
- end Delete_Field;
-
- -----------------
- -- Delete_List --
- -----------------
-
- procedure Delete_List (L : List_Id) is
- begin
- while Is_Non_Empty_List (L) loop
- Delete_Tree (Remove_Head (L));
- end loop;
- end Delete_List;
-
- -- Start of processing for Delete_Tree
-
- begin
- -- Delete descendents
-
- Delete_Field (Field1 (Node));
- Delete_Field (Field2 (Node));
- Delete_Field (Field3 (Node));
- Delete_Field (Field4 (Node));
- Delete_Field (Field5 (Node));
- end Delete_Tree;
-
-----------
-- Ekind --
-----------
return N_To_E (Nodes.Table (E + 1).Nkind);
end Ekind;
+ --------------
+ -- Ekind_In --
+ --------------
+
+ function Ekind_In
+ (T : Entity_Kind;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2;
+ end Ekind_In;
+
+ function Ekind_In
+ (T : Entity_Kind;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3;
+ end Ekind_In;
+
+ function Ekind_In
+ (T : Entity_Kind;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind;
+ V4 : Entity_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4;
+ end Ekind_In;
+
+ function Ekind_In
+ (T : Entity_Kind;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind;
+ V4 : Entity_Kind;
+ V5 : Entity_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4 or else
+ T = V5;
+ end Ekind_In;
+
+ function Ekind_In
+ (T : Entity_Kind;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind;
+ V4 : Entity_Kind;
+ V5 : Entity_Kind;
+ V6 : Entity_Kind) return Boolean
+ is
+ begin
+ return T = V1 or else
+ T = V2 or else
+ T = V3 or else
+ T = V4 or else
+ T = V5 or else
+ T = V6;
+ end Ekind_In;
+
+ function Ekind_In
+ (E : Entity_Id;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind) return Boolean
+ is
+ begin
+ return Ekind_In (Ekind (E), V1, V2);
+ end Ekind_In;
+
+ function Ekind_In
+ (E : Entity_Id;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind) return Boolean
+ is
+ begin
+ return Ekind_In (Ekind (E), V1, V2, V3);
+ end Ekind_In;
+
+ function Ekind_In
+ (E : Entity_Id;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind;
+ V4 : Entity_Kind) return Boolean
+ is
+ begin
+ return Ekind_In (Ekind (E), V1, V2, V3, V4);
+ end Ekind_In;
+
+ function Ekind_In
+ (E : Entity_Id;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind;
+ V4 : Entity_Kind;
+ V5 : Entity_Kind) return Boolean
+ is
+ begin
+ return Ekind_In (Ekind (E), V1, V2, V3, V4, V5);
+ end Ekind_In;
+
+ function Ekind_In
+ (E : Entity_Id;
+ V1 : Entity_Kind;
+ V2 : Entity_Kind;
+ V3 : Entity_Kind;
+ V4 : Entity_Kind;
+ V5 : Entity_Kind;
+ V6 : Entity_Kind) return Boolean
+ is
+ begin
+ return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6);
+ end Ekind_In;
+
+ ------------------------
+ -- Set_Reporting_Proc --
+ ------------------------
+
+ procedure Set_Reporting_Proc (P : Report_Proc) is
+ begin
+ pragma Assert (Reporting_Proc = null);
+ Reporting_Proc := P;
+ end Set_Reporting_Proc;
+
------------------
-- Error_Posted --
------------------
-- Fix_Parents --
-----------------
- procedure Fix_Parents (Old_Node, New_Node : Node_Id) is
+ procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id) is
- procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id);
- -- Fixup one parent pointer. Field is checked to see if it
- -- points to a node, list, or element list that has a parent that
- -- points to Old_Node. If so, the parent is reset to point to New_Node.
+ procedure Fix_Parent (Field : Union_Id);
+ -- Fixup one parent pointer. Field is checked to see if it points to
+ -- a node, list, or element list that has a parent that points to
+ -- Ref_Node. If so, the parent is reset to point to Fix_Node.
----------------
-- Fix_Parent --
----------------
- procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id) is
+ procedure Fix_Parent (Field : Union_Id) is
begin
-- Fix parent of node that is referenced by Field. Note that we must
-- exclude the case where the node is a member of a list, because in
if Field in Node_Range
and then Present (Node_Id (Field))
and then not Nodes.Table (Node_Id (Field)).In_List
- and then Parent (Node_Id (Field)) = Old_Node
+ and then Parent (Node_Id (Field)) = Ref_Node
then
- Set_Parent (Node_Id (Field), New_Node);
+ Set_Parent (Node_Id (Field), Fix_Node);
-- Fix parent of list that is referenced by Field
elsif Field in List_Range
and then Present (List_Id (Field))
- and then Parent (List_Id (Field)) = Old_Node
+ and then Parent (List_Id (Field)) = Ref_Node
then
- Set_Parent (List_Id (Field), New_Node);
+ Set_Parent (List_Id (Field), Fix_Node);
end if;
end Fix_Parent;
-- Start of processing for Fix_Parents
begin
- Fix_Parent (Field1 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field2 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field3 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field4 (New_Node), Old_Node, New_Node);
- Fix_Parent (Field5 (New_Node), Old_Node, New_Node);
+ Fix_Parent (Field1 (Fix_Node));
+ Fix_Parent (Field2 (Fix_Node));
+ Fix_Parent (Field3 (Fix_Node));
+ Fix_Parent (Field4 (Fix_Node));
+ Fix_Parent (Field5 (Fix_Node));
end Fix_Parents;
-----------------------------------
return Default_Node.Comes_From_Source;
end Get_Comes_From_Source_Default;
+ -----------------
+ -- Has_Aspects --
+ -----------------
+
+ function Has_Aspects (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ return Nodes.Table (N).Has_Aspects;
+ end Has_Aspects;
+
-------------------
-- Has_Extension --
-------------------
Dummy := New_Node (N_Error, No_Location);
Set_Name1 (Error, Error_Name);
Set_Error_Posted (Error, True);
-
- -- Set global variables for New_Copy_Tree
-
- NCT_Hash_Tables_Used := False;
- NCT_Table_Entries := 0;
- NCT_Hash_Table_Setup := False;
end Initialize;
--------------------------
begin
if Source > Empty_Or_Error then
-
New_Id := Allocate_Initialize_Node (Source, Has_Extension (Source));
Nodes.Table (New_Id).Link := Empty_List_Or_Node;
Nodes.Table (New_Id).In_List := False;
- -- If the original is marked as a rewrite insertion, then unmark
- -- the copy, since we inserted the original, not the copy.
+ -- If the original is marked as a rewrite insertion, then unmark the
+ -- copy, since we inserted the original, not the copy.
Nodes.Table (New_Id).Rewrite_Ins := False;
pragma Debug (New_Node_Debugging_Output (New_Id));
- end if;
-
- return New_Id;
- end New_Copy;
-
- -------------------
- -- New_Copy_Tree --
- -------------------
-
- -- Our approach here requires a two pass traversal of the tree. The
- -- first pass visits all nodes that eventually will be copied looking
- -- for defining Itypes. If any defining Itypes are found, then they are
- -- copied, and an entry is added to the replacement map. In the second
- -- phase, the tree is copied, using the replacement map to replace any
- -- Itype references within the copied tree.
-
- -- The following hash tables are used if the Map supplied has more
- -- than hash threshhold entries to speed up access to the map. If
- -- there are fewer entries, then the map is searched sequentially
- -- (because setting up a hash table for only a few entries takes
- -- more time than it saves.
-
- function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
- -- Hash function used for hash operations
- -------------------
- -- New_Copy_Hash --
- -------------------
+ -- Clear Is_Overloaded since we cannot have semantic interpretations
+ -- of this new node.
- function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
- begin
- return Nat (E) mod (NCT_Header_Num'Last + 1);
- end New_Copy_Hash;
+ if Nkind (Source) in N_Subexpr then
+ Set_Is_Overloaded (New_Id, False);
+ end if;
- ---------------
- -- NCT_Assoc --
- ---------------
+ -- Always clear Has_Aspects, the caller must take care of copying
+ -- aspects if this is required for the particular situation.
- -- The hash table NCT_Assoc associates old entities in the table
- -- with their corresponding new entities (i.e. the pairs of entries
- -- presented in the original Map argument are Key-Element pairs).
+ Set_Has_Aspects (New_Id, False);
+ end if;
- package NCT_Assoc is new Simple_HTable (
- Header_Num => NCT_Header_Num,
- Element => Entity_Id,
- No_Element => Empty,
- Key => Entity_Id,
- Hash => New_Copy_Hash,
- Equal => Types."=");
+ return New_Id;
+ end New_Copy;
- ---------------------
- -- NCT_Itype_Assoc --
- ---------------------
+ ----------------
+ -- New_Entity --
+ ----------------
- -- The hash table NCT_Itype_Assoc contains entries only for those
- -- old nodes which have a non-empty Associated_Node_For_Itype set.
- -- The key is the associated node, and the element is the new node
- -- itself (NOT the associated node for the new node).
-
- package NCT_Itype_Assoc is new Simple_HTable (
- Header_Num => NCT_Header_Num,
- Element => Entity_Id,
- No_Element => Empty,
- Key => Entity_Id,
- Hash => New_Copy_Hash,
- Equal => Types."=");
-
- -- Start of processing for New_Copy_Tree function
-
- function New_Copy_Tree
- (Source : Node_Id;
- Map : Elist_Id := No_Elist;
- New_Sloc : Source_Ptr := No_Location;
- New_Scope : Entity_Id := Empty) return Node_Id
+ function New_Entity
+ (New_Node_Kind : Node_Kind;
+ New_Sloc : Source_Ptr) return Entity_Id
is
- Actual_Map : Elist_Id := Map;
- -- This is the actual map for the copy. It is initialized with the
- -- given elements, and then enlarged as required for Itypes that are
- -- copied during the first phase of the copy operation. The visit
- -- procedures add elements to this map as Itypes are encountered.
- -- The reason we cannot use Map directly, is that it may well be
- -- (and normally is) initialized to No_Elist, and if we have mapped
- -- entities, we have to reset it to point to a real Elist.
+ Ent : Entity_Id;
- function Assoc (N : Node_Or_Entity_Id) return Node_Id;
- -- Called during second phase to map entities into their corresponding
- -- copies using Actual_Map. If the argument is not an entity, or is not
- -- in Actual_Map, then it is returned unchanged.
+ begin
+ pragma Assert (New_Node_Kind in N_Entity);
- procedure Build_NCT_Hash_Tables;
- -- Builds hash tables (number of elements >= threshold value)
+ Ent := Allocate_Initialize_Node (Empty, With_Extension => True);
- function Copy_Elist_With_Replacement
- (Old_Elist : Elist_Id) return Elist_Id;
- -- Called during second phase to copy element list doing replacements
+ -- If this is a node with a real location and we are generating
+ -- source nodes, then reset Current_Error_Node. This is useful
+ -- if we bomb during parsing to get a error location for the bomb.
- procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
- -- Called during the second phase to process a copied Itype. The actual
- -- copy happened during the first phase (so that we could make the entry
- -- in the mapping), but we still have to deal with the descendents of
- -- the copied Itype and copy them where necessary.
+ if Default_Node.Comes_From_Source and then New_Sloc > No_Location then
+ Current_Error_Node := Ent;
+ end if;
- function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
- -- Called during second phase to copy list doing replacements
+ Nodes.Table (Ent).Nkind := New_Node_Kind;
+ Nodes.Table (Ent).Sloc := New_Sloc;
+ pragma Debug (New_Node_Debugging_Output (Ent));
- function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id;
- -- Called during second phase to copy node doing replacements
+ return Ent;
+ end New_Entity;
- procedure Visit_Elist (E : Elist_Id);
- -- Called during first phase to visit all elements of an Elist
+ --------------
+ -- New_Node --
+ --------------
- procedure Visit_Field (F : Union_Id; N : Node_Id);
- -- Visit a single field, recursing to call Visit_Node or Visit_List
- -- if the field is a syntactic descendent of the current node (i.e.
- -- its parent is Node N).
+ function New_Node
+ (New_Node_Kind : Node_Kind;
+ New_Sloc : Source_Ptr) return Node_Id
+ is
+ Nod : Node_Id;
- procedure Visit_Itype (Old_Itype : Entity_Id);
- -- Called during first phase to visit subsidiary fields of a defining
- -- Itype, and also create a copy and make an entry in the replacement
- -- map for the new copy.
+ begin
+ pragma Assert (New_Node_Kind not in N_Entity);
+ Nod := Allocate_Initialize_Node (Empty, With_Extension => False);
+ Nodes.Table (Nod).Nkind := New_Node_Kind;
+ Nodes.Table (Nod).Sloc := New_Sloc;
+ pragma Debug (New_Node_Debugging_Output (Nod));
- procedure Visit_List (L : List_Id);
- -- Called during first phase to visit all elements of a List
+ -- If this is a node with a real location and we are generating source
+ -- nodes, then reset Current_Error_Node. This is useful if we bomb
+ -- during parsing to get an error location for the bomb.
- procedure Visit_Node (N : Node_Or_Entity_Id);
- -- Called during first phase to visit a node and all its subtrees
+ if Default_Node.Comes_From_Source and then New_Sloc > No_Location then
+ Current_Error_Node := Nod;
+ end if;
- -----------
- -- Assoc --
- -----------
+ return Nod;
+ end New_Node;
- function Assoc (N : Node_Or_Entity_Id) return Node_Id is
- E : Elmt_Id;
- Ent : Entity_Id;
+ -------------------------
+ -- New_Node_Breakpoint --
+ -------------------------
- begin
- if not Has_Extension (N) or else No (Actual_Map) then
- return N;
+ procedure nn is
+ begin
+ Write_Str ("Watched node ");
+ Write_Int (Int (Watch_Node));
+ Write_Str (" created");
+ Write_Eol;
+ end nn;
- elsif NCT_Hash_Tables_Used then
- Ent := NCT_Assoc.Get (Entity_Id (N));
+ -------------------------------
+ -- New_Node_Debugging_Output --
+ -------------------------------
- if Present (Ent) then
- return Ent;
- else
- return N;
- end if;
+ procedure nnd (N : Node_Id) is
+ Node_Is_Watched : constant Boolean := N = Watch_Node;
- -- No hash table used, do serial search
+ begin
+ if Debug_Flag_N or else Node_Is_Watched then
+ Node_Debug_Output ("Allocate", N);
- else
- E := First_Elmt (Actual_Map);
- while Present (E) loop
- if Node (E) = N then
- return Node (Next_Elmt (E));
- else
- E := Next_Elmt (Next_Elmt (E));
- end if;
- end loop;
+ if Node_Is_Watched then
+ New_Node_Breakpoint;
end if;
+ end if;
+ end nnd;
- return N;
- end Assoc;
-
- ---------------------------
- -- Build_NCT_Hash_Tables --
- ---------------------------
-
- procedure Build_NCT_Hash_Tables is
- Elmt : Elmt_Id;
- Ent : Entity_Id;
- begin
- if NCT_Hash_Table_Setup then
- NCT_Assoc.Reset;
- NCT_Itype_Assoc.Reset;
- end if;
-
- Elmt := First_Elmt (Actual_Map);
- while Present (Elmt) loop
- Ent := Node (Elmt);
-
- -- Get new entity, and associate old and new
-
- Next_Elmt (Elmt);
- NCT_Assoc.Set (Ent, Node (Elmt));
-
- if Is_Type (Ent) then
- declare
- Anode : constant Entity_Id :=
- Associated_Node_For_Itype (Ent);
-
- begin
- if Present (Anode) then
-
- -- Enter a link between the associated node of the
- -- old Itype and the new Itype, for updating later
- -- when node is copied.
-
- NCT_Itype_Assoc.Set (Anode, Node (Elmt));
- end if;
- end;
- end if;
-
- Next_Elmt (Elmt);
- end loop;
-
- NCT_Hash_Tables_Used := True;
- NCT_Hash_Table_Setup := True;
- end Build_NCT_Hash_Tables;
-
- ---------------------------------
- -- Copy_Elist_With_Replacement --
- ---------------------------------
-
- function Copy_Elist_With_Replacement
- (Old_Elist : Elist_Id) return Elist_Id
- is
- M : Elmt_Id;
- New_Elist : Elist_Id;
-
- begin
- if No (Old_Elist) then
- return No_Elist;
-
- else
- New_Elist := New_Elmt_List;
-
- M := First_Elmt (Old_Elist);
- while Present (M) loop
- Append_Elmt (Copy_Node_With_Replacement (Node (M)), New_Elist);
- Next_Elmt (M);
- end loop;
- end if;
-
- return New_Elist;
- end Copy_Elist_With_Replacement;
-
- ---------------------------------
- -- Copy_Itype_With_Replacement --
- ---------------------------------
-
- -- This routine exactly parallels its phase one analog Visit_Itype,
- -- and like that routine, knows far too many semantic details about
- -- the descendents of Itypes and whether they need copying or not.
-
- procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id) is
- begin
- -- Translate Next_Entity, Scope and Etype fields, in case they
- -- reference entities that have been mapped into copies.
-
- Set_Next_Entity (New_Itype, Assoc (Next_Entity (New_Itype)));
- Set_Etype (New_Itype, Assoc (Etype (New_Itype)));
-
- if Present (New_Scope) then
- Set_Scope (New_Itype, New_Scope);
- else
- Set_Scope (New_Itype, Assoc (Scope (New_Itype)));
- end if;
-
- -- Copy referenced fields
-
- if Is_Discrete_Type (New_Itype) then
- Set_Scalar_Range (New_Itype,
- Copy_Node_With_Replacement (Scalar_Range (New_Itype)));
-
- elsif Has_Discriminants (Base_Type (New_Itype)) then
- Set_Discriminant_Constraint (New_Itype,
- Copy_Elist_With_Replacement
- (Discriminant_Constraint (New_Itype)));
-
- elsif Is_Array_Type (New_Itype) then
- if Present (First_Index (New_Itype)) then
- Set_First_Index (New_Itype,
- First (Copy_List_With_Replacement
- (List_Containing (First_Index (New_Itype)))));
- end if;
-
- if Is_Packed (New_Itype) then
- Set_Packed_Array_Type (New_Itype,
- Copy_Node_With_Replacement
- (Packed_Array_Type (New_Itype)));
- end if;
- end if;
- end Copy_Itype_With_Replacement;
-
- --------------------------------
- -- Copy_List_With_Replacement --
- --------------------------------
-
- function Copy_List_With_Replacement
- (Old_List : List_Id) return List_Id
- is
- New_List : List_Id;
- E : Node_Id;
-
- begin
- if Old_List = No_List then
- return No_List;
-
- else
- New_List := Empty_List;
-
- E := First (Old_List);
- while Present (E) loop
- Append (Copy_Node_With_Replacement (E), New_List);
- Next (E);
- end loop;
-
- return New_List;
- end if;
- end Copy_List_With_Replacement;
-
- --------------------------------
- -- Copy_Node_With_Replacement --
- --------------------------------
-
- function Copy_Node_With_Replacement
- (Old_Node : Node_Id) return Node_Id
- is
- New_Node : Node_Id;
-
- procedure Adjust_Named_Associations
- (Old_Node : Node_Id;
- New_Node : Node_Id);
- -- If a call node has named associations, these are chained through
- -- the First_Named_Actual, Next_Named_Actual links. These must be
- -- propagated separately to the new parameter list, because these
- -- are not syntactic fields.
-
- function Copy_Field_With_Replacement
- (Field : Union_Id) return Union_Id;
- -- Given Field, which is a field of Old_Node, return a copy of it
- -- if it is a syntactic field (i.e. its parent is Node), setting
- -- the parent of the copy to poit to New_Node. Otherwise returns
- -- the field (possibly mapped if it is an entity).
-
- -------------------------------
- -- Adjust_Named_Associations --
- -------------------------------
-
- procedure Adjust_Named_Associations
- (Old_Node : Node_Id;
- New_Node : Node_Id)
- is
- Old_E : Node_Id;
- New_E : Node_Id;
-
- Old_Next : Node_Id;
- New_Next : Node_Id;
-
- begin
- Old_E := First (Parameter_Associations (Old_Node));
- New_E := First (Parameter_Associations (New_Node));
- while Present (Old_E) loop
- if Nkind (Old_E) = N_Parameter_Association
- and then Present (Next_Named_Actual (Old_E))
- then
- if First_Named_Actual (Old_Node)
- = Explicit_Actual_Parameter (Old_E)
- then
- Set_First_Named_Actual
- (New_Node, Explicit_Actual_Parameter (New_E));
- end if;
-
- -- Now scan parameter list from the beginning,to locate
- -- next named actual, which can be out of order.
-
- Old_Next := First (Parameter_Associations (Old_Node));
- New_Next := First (Parameter_Associations (New_Node));
-
- while Nkind (Old_Next) /= N_Parameter_Association
- or else Explicit_Actual_Parameter (Old_Next)
- /= Next_Named_Actual (Old_E)
- loop
- Next (Old_Next);
- Next (New_Next);
- end loop;
-
- Set_Next_Named_Actual
- (New_E, Explicit_Actual_Parameter (New_Next));
- end if;
-
- Next (Old_E);
- Next (New_E);
- end loop;
- end Adjust_Named_Associations;
-
- ---------------------------------
- -- Copy_Field_With_Replacement --
- ---------------------------------
-
- function Copy_Field_With_Replacement
- (Field : Union_Id) return Union_Id
- is
- begin
- if Field = Union_Id (Empty) then
- return Field;
-
- elsif Field in Node_Range then
- declare
- Old_N : constant Node_Id := Node_Id (Field);
- New_N : Node_Id;
-
- begin
- -- If syntactic field, as indicated by the parent pointer
- -- being set, then copy the referenced node recursively.
-
- if Parent (Old_N) = Old_Node then
- New_N := Copy_Node_With_Replacement (Old_N);
-
- if New_N /= Old_N then
- Set_Parent (New_N, New_Node);
- end if;
-
- -- For semantic fields, update possible entity reference
- -- from the replacement map.
-
- else
- New_N := Assoc (Old_N);
- end if;
-
- return Union_Id (New_N);
- end;
-
- elsif Field in List_Range then
- declare
- Old_L : constant List_Id := List_Id (Field);
- New_L : List_Id;
-
- begin
- -- If syntactic field, as indicated by the parent pointer,
- -- then recursively copy the entire referenced list.
-
- if Parent (Old_L) = Old_Node then
- New_L := Copy_List_With_Replacement (Old_L);
- Set_Parent (New_L, New_Node);
-
- -- For semantic list, just returned unchanged
-
- else
- New_L := Old_L;
- end if;
-
- return Union_Id (New_L);
- end;
-
- -- Anything other than a list or a node is returned unchanged
-
- else
- return Field;
- end if;
- end Copy_Field_With_Replacement;
-
- -- Start of processing for Copy_Node_With_Replacement
-
- begin
- if Old_Node <= Empty_Or_Error then
- return Old_Node;
-
- elsif Has_Extension (Old_Node) then
- return Assoc (Old_Node);
-
- else
- New_Node := New_Copy (Old_Node);
-
- -- If the node we are copying is the associated node of a
- -- previously copied Itype, then adjust the associated node
- -- of the copy of that Itype accordingly.
-
- if Present (Actual_Map) then
- declare
- E : Elmt_Id;
- Ent : Entity_Id;
-
- begin
- -- Case of hash table used
-
- if NCT_Hash_Tables_Used then
- Ent := NCT_Itype_Assoc.Get (Old_Node);
-
- if Present (Ent) then
- Set_Associated_Node_For_Itype (Ent, New_Node);
- end if;
-
- -- Case of no hash table used
-
- else
- E := First_Elmt (Actual_Map);
- while Present (E) loop
- if Is_Itype (Node (E))
- and then
- Old_Node = Associated_Node_For_Itype (Node (E))
- then
- Set_Associated_Node_For_Itype
- (Node (Next_Elmt (E)), New_Node);
- end if;
-
- E := Next_Elmt (Next_Elmt (E));
- end loop;
- end if;
- end;
- end if;
-
- -- Recursively copy descendents
-
- Set_Field1
- (New_Node, Copy_Field_With_Replacement (Field1 (New_Node)));
- Set_Field2
- (New_Node, Copy_Field_With_Replacement (Field2 (New_Node)));
- Set_Field3
- (New_Node, Copy_Field_With_Replacement (Field3 (New_Node)));
- Set_Field4
- (New_Node, Copy_Field_With_Replacement (Field4 (New_Node)));
- Set_Field5
- (New_Node, Copy_Field_With_Replacement (Field5 (New_Node)));
-
- -- Adjust Sloc of new node if necessary
-
- if New_Sloc /= No_Location then
- Set_Sloc (New_Node, New_Sloc);
-
- -- If we adjust the Sloc, then we are essentially making
- -- a completely new node, so the Comes_From_Source flag
- -- should be reset to the proper default value.
-
- Nodes.Table (New_Node).Comes_From_Source :=
- Default_Node.Comes_From_Source;
- end if;
-
- -- If the node is call and has named associations,
- -- set the corresponding links in the copy.
-
- if (Nkind (Old_Node) = N_Function_Call
- or else Nkind (Old_Node) = N_Entry_Call_Statement
- or else
- Nkind (Old_Node) = N_Procedure_Call_Statement)
- and then Present (First_Named_Actual (Old_Node))
- then
- Adjust_Named_Associations (Old_Node, New_Node);
- end if;
-
- -- Reset First_Real_Statement for Handled_Sequence_Of_Statements.
- -- The replacement mechanism applies to entities, and is not used
- -- here. Eventually we may need a more general graph-copying
- -- routine. For now, do a sequential search to find desired node.
-
- if Nkind (Old_Node) = N_Handled_Sequence_Of_Statements
- and then Present (First_Real_Statement (Old_Node))
- then
- declare
- Old_F : constant Node_Id := First_Real_Statement (Old_Node);
- N1, N2 : Node_Id;
-
- begin
- N1 := First (Statements (Old_Node));
- N2 := First (Statements (New_Node));
-
- while N1 /= Old_F loop
- Next (N1);
- Next (N2);
- end loop;
-
- Set_First_Real_Statement (New_Node, N2);
- end;
- end if;
- end if;
-
- -- All done, return copied node
-
- return New_Node;
- end Copy_Node_With_Replacement;
-
- -----------------
- -- Visit_Elist --
- -----------------
-
- procedure Visit_Elist (E : Elist_Id) is
- Elmt : Elmt_Id;
- begin
- if Present (E) then
- Elmt := First_Elmt (E);
-
- while Elmt /= No_Elmt loop
- Visit_Node (Node (Elmt));
- Next_Elmt (Elmt);
- end loop;
- end if;
- end Visit_Elist;
-
- -----------------
- -- Visit_Field --
- -----------------
-
- procedure Visit_Field (F : Union_Id; N : Node_Id) is
- begin
- if F = Union_Id (Empty) then
- return;
-
- elsif F in Node_Range then
-
- -- Copy node if it is syntactic, i.e. its parent pointer is
- -- set to point to the field that referenced it (certain
- -- Itypes will also meet this criterion, which is fine, since
- -- these are clearly Itypes that do need to be copied, since
- -- we are copying their parent.)
-
- if Parent (Node_Id (F)) = N then
- Visit_Node (Node_Id (F));
- return;
-
- -- Another case, if we are pointing to an Itype, then we want
- -- to copy it if its associated node is somewhere in the tree
- -- being copied.
-
- -- Note: the exclusion of self-referential copies is just an
- -- optimization, since the search of the already copied list
- -- would catch it, but it is a common case (Etype pointing
- -- to itself for an Itype that is a base type).
-
- elsif Has_Extension (Node_Id (F))
- and then Is_Itype (Entity_Id (F))
- and then Node_Id (F) /= N
- then
- declare
- P : Node_Id;
-
- begin
- P := Associated_Node_For_Itype (Node_Id (F));
- while Present (P) loop
- if P = Source then
- Visit_Node (Node_Id (F));
- return;
- else
- P := Parent (P);
- end if;
- end loop;
-
- -- An Itype whose parent is not being copied definitely
- -- should NOT be copied, since it does not belong in any
- -- sense to the copied subtree.
-
- return;
- end;
- end if;
-
- elsif F in List_Range
- and then Parent (List_Id (F)) = N
- then
- Visit_List (List_Id (F));
- return;
- end if;
- end Visit_Field;
-
- -----------------
- -- Visit_Itype --
- -----------------
-
- -- Note: we are relying on far too much semantic knowledge in this
- -- routine, it really should just do a blind replacement of all
- -- fields, or at least a more blind replacement. For example, we
- -- do not deal with corresponding record types, and that works
- -- because we have no Itypes of task types, but nowhere is there
- -- a guarantee that this will always be the case. ???
-
- procedure Visit_Itype (Old_Itype : Entity_Id) is
- New_Itype : Entity_Id;
- E : Elmt_Id;
- Ent : Entity_Id;
-
- begin
- -- Itypes that describe the designated type of access to subprograms
- -- have the structure of subprogram declarations, with signatures,
- -- etc. Either we duplicate the signatures completely, or choose to
- -- share such itypes, which is fine because their elaboration will
- -- have no side effects. In any case, this is additional semantic
- -- information that seems awkward to have in atree.
-
- if Ekind (Old_Itype) = E_Subprogram_Type then
- return;
- end if;
-
- New_Itype := New_Copy (Old_Itype);
-
- -- The new Itype has all the attributes of the old one, and
- -- we just copy the contents of the entity. However, the back-end
- -- needs different names for debugging purposes, so we create a
- -- new internal name by appending the letter 'c' (copy) to the
- -- name of the original.
-
- Get_Name_String (Chars (Old_Itype));
- Add_Char_To_Name_Buffer ('c');
- Set_Chars (New_Itype, Name_Enter);
-
- -- If our associated node is an entity that has already been copied,
- -- then set the associated node of the copy to point to the right
- -- copy. If we have copied an Itype that is itself the associated
- -- node of some previously copied Itype, then we set the right
- -- pointer in the other direction.
-
- if Present (Actual_Map) then
-
- -- Case of hash tables used
-
- if NCT_Hash_Tables_Used then
-
- Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype));
-
- if Present (Ent) then
- Set_Associated_Node_For_Itype (New_Itype, Ent);
- end if;
-
- Ent := NCT_Itype_Assoc.Get (Old_Itype);
- if Present (Ent) then
- Set_Associated_Node_For_Itype (Ent, New_Itype);
-
- -- If the hash table has no association for this Itype and
- -- its associated node, enter one now.
-
- else
- NCT_Itype_Assoc.Set
- (Associated_Node_For_Itype (Old_Itype), New_Itype);
- end if;
-
- -- Case of hash tables not used
-
- else
- E := First_Elmt (Actual_Map);
- while Present (E) loop
- if Associated_Node_For_Itype (Old_Itype) = Node (E) then
- Set_Associated_Node_For_Itype
- (New_Itype, Node (Next_Elmt (E)));
- end if;
-
- if Is_Type (Node (E))
- and then
- Old_Itype = Associated_Node_For_Itype (Node (E))
- then
- Set_Associated_Node_For_Itype
- (Node (Next_Elmt (E)), New_Itype);
- end if;
-
- E := Next_Elmt (Next_Elmt (E));
- end loop;
- end if;
- end if;
-
- if Present (Freeze_Node (New_Itype)) then
- Set_Is_Frozen (New_Itype, False);
- Set_Freeze_Node (New_Itype, Empty);
- end if;
-
- -- Add new association to map
-
- if No (Actual_Map) then
- Actual_Map := New_Elmt_List;
- end if;
-
- Append_Elmt (Old_Itype, Actual_Map);
- Append_Elmt (New_Itype, Actual_Map);
-
- if NCT_Hash_Tables_Used then
- NCT_Assoc.Set (Old_Itype, New_Itype);
-
- else
- NCT_Table_Entries := NCT_Table_Entries + 1;
-
- if NCT_Table_Entries > NCT_Hash_Threshhold then
- Build_NCT_Hash_Tables;
- end if;
- end if;
-
- -- If a record subtype is simply copied, the entity list will be
- -- shared. Thus cloned_Subtype must be set to indicate the sharing.
-
- if Ekind (Old_Itype) = E_Record_Subtype
- or else Ekind (Old_Itype) = E_Class_Wide_Subtype
- then
- Set_Cloned_Subtype (New_Itype, Old_Itype);
- end if;
-
- -- Visit descendents that eventually get copied
-
- Visit_Field (Union_Id (Etype (Old_Itype)), Old_Itype);
-
- if Is_Discrete_Type (Old_Itype) then
- Visit_Field (Union_Id (Scalar_Range (Old_Itype)), Old_Itype);
-
- elsif Has_Discriminants (Base_Type (Old_Itype)) then
- -- ??? This should involve call to Visit_Field
- Visit_Elist (Discriminant_Constraint (Old_Itype));
-
- elsif Is_Array_Type (Old_Itype) then
- if Present (First_Index (Old_Itype)) then
- Visit_Field (Union_Id (List_Containing
- (First_Index (Old_Itype))),
- Old_Itype);
- end if;
-
- if Is_Packed (Old_Itype) then
- Visit_Field (Union_Id (Packed_Array_Type (Old_Itype)),
- Old_Itype);
- end if;
- end if;
- end Visit_Itype;
-
- ----------------
- -- Visit_List --
- ----------------
-
- procedure Visit_List (L : List_Id) is
- N : Node_Id;
- begin
- if L /= No_List then
- N := First (L);
-
- while Present (N) loop
- Visit_Node (N);
- Next (N);
- end loop;
- end if;
- end Visit_List;
-
- ----------------
- -- Visit_Node --
- ----------------
-
- procedure Visit_Node (N : Node_Or_Entity_Id) is
-
- -- Start of processing for Visit_Node
-
- begin
- -- Handle case of an Itype, which must be copied
-
- if Has_Extension (N)
- and then Is_Itype (N)
- then
- -- Nothing to do if already in the list. This can happen with an
- -- Itype entity that appears more than once in the tree.
- -- Note that we do not want to visit descendents in this case.
-
- -- Test for already in list when hash table is used
-
- if NCT_Hash_Tables_Used then
- if Present (NCT_Assoc.Get (Entity_Id (N))) then
- return;
- end if;
-
- -- Test for already in list when hash table not used
-
- else
- declare
- E : Elmt_Id;
- begin
- if Present (Actual_Map) then
- E := First_Elmt (Actual_Map);
- while Present (E) loop
- if Node (E) = N then
- return;
- else
- E := Next_Elmt (Next_Elmt (E));
- end if;
- end loop;
- end if;
- end;
- end if;
-
- Visit_Itype (N);
- end if;
-
- -- Visit descendents
-
- Visit_Field (Field1 (N), N);
- Visit_Field (Field2 (N), N);
- Visit_Field (Field3 (N), N);
- Visit_Field (Field4 (N), N);
- Visit_Field (Field5 (N), N);
- end Visit_Node;
-
- -- Start of processing for New_Copy_Tree
-
- begin
- Actual_Map := Map;
-
- -- See if we should use hash table
-
- if No (Actual_Map) then
- NCT_Hash_Tables_Used := False;
-
- else
- declare
- Elmt : Elmt_Id;
-
- begin
- NCT_Table_Entries := 0;
-
- Elmt := First_Elmt (Actual_Map);
- while Present (Elmt) loop
- NCT_Table_Entries := NCT_Table_Entries + 1;
- Next_Elmt (Elmt);
- Next_Elmt (Elmt);
- end loop;
-
- if NCT_Table_Entries > NCT_Hash_Threshhold then
- Build_NCT_Hash_Tables;
- else
- NCT_Hash_Tables_Used := False;
- end if;
- end;
- end if;
-
- -- Hash table set up if required, now start phase one by visiting
- -- top node (we will recursively visit the descendents).
-
- Visit_Node (Source);
-
- -- Now the second phase of the copy can start. First we process
- -- all the mapped entities, copying their descendents.
-
- if Present (Actual_Map) then
- declare
- Elmt : Elmt_Id;
- New_Itype : Entity_Id;
- begin
- Elmt := First_Elmt (Actual_Map);
- while Present (Elmt) loop
- Next_Elmt (Elmt);
- New_Itype := Node (Elmt);
- Copy_Itype_With_Replacement (New_Itype);
- Next_Elmt (Elmt);
- end loop;
- end;
- end if;
-
- -- Now we can copy the actual tree
-
- return Copy_Node_With_Replacement (Source);
- end New_Copy_Tree;
-
- ----------------
- -- New_Entity --
- ----------------
-
- function New_Entity
- (New_Node_Kind : Node_Kind;
- New_Sloc : Source_Ptr) return Entity_Id
- is
- Ent : Entity_Id;
+ -----------
+ -- Nkind --
+ -----------
+ function Nkind (N : Node_Id) return Node_Kind is
begin
- pragma Assert (New_Node_Kind in N_Entity);
-
- Ent := Allocate_Initialize_Node (Empty, With_Extension => True);
-
- -- If this is a node with a real location and we are generating
- -- source nodes, then reset Current_Error_Node. This is useful
- -- if we bomb during parsing to get a error location for the bomb.
-
- if Default_Node.Comes_From_Source and then New_Sloc > No_Location then
- Current_Error_Node := Ent;
- end if;
-
- Nodes.Table (Ent).Nkind := New_Node_Kind;
- Nodes.Table (Ent).Sloc := New_Sloc;
- pragma Debug (New_Node_Debugging_Output (Ent));
-
- return Ent;
- end New_Entity;
+ return Nodes.Table (N).Nkind;
+ end Nkind;
--------------
- -- New_Node --
+ -- Nkind_In --
--------------
- function New_Node
- (New_Node_Kind : Node_Kind;
- New_Sloc : Source_Ptr) return Node_Id
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind) return Boolean
is
- Nod : Node_Id;
-
begin
- pragma Assert (New_Node_Kind not in N_Entity);
- Nod := Allocate_Initialize_Node (Empty, With_Extension => False);
- Nodes.Table (Nod).Nkind := New_Node_Kind;
- Nodes.Table (Nod).Sloc := New_Sloc;
- pragma Debug (New_Node_Debugging_Output (Nod));
-
- -- If this is a node with a real location and we are generating source
- -- nodes, then reset Current_Error_Node. This is useful if we bomb
- -- during parsing to get an error location for the bomb.
-
- if Default_Node.Comes_From_Source and then New_Sloc > No_Location then
- Current_Error_Node := Nod;
- end if;
-
- return Nod;
- end New_Node;
-
- -------------------------
- -- New_Node_Breakpoint --
- -------------------------
-
- procedure nn is -- New_Node_Breakpoint
+ return Nkind_In (Nkind (N), V1, V2);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind) return Boolean
+ is
begin
- Write_Str ("Watched node ");
- Write_Int (Int (Watch_Node));
- Write_Str (" created");
- Write_Eol;
- end nn;
-
- -------------------------------
- -- New_Node_Debugging_Output --
- -------------------------------
-
- procedure nnd (N : Node_Id) is -- New_Node_Debugging_Output
- Node_Is_Watched : constant Boolean := N = Watch_Node;
-
+ return Nkind_In (Nkind (N), V1, V2, V3);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind) return Boolean
+ is
begin
- if Debug_Flag_N or else Node_Is_Watched then
- Write_Str ("Allocate ");
-
- if Nkind (N) in N_Entity then
- Write_Str ("entity");
- else
- Write_Str ("node");
- end if;
-
- Write_Str (", Id = ");
- Write_Int (Int (N));
- Write_Str (" ");
- Write_Location (Sloc (N));
- Write_Str (" ");
- Write_Str (Node_Kind'Image (Nkind (N)));
- Write_Eol;
-
- if Node_Is_Watched then
- New_Node_Breakpoint;
- end if;
- end if;
- end nnd;
-
- -----------
- -- Nkind --
- -----------
-
- function Nkind (N : Node_Id) return Node_Kind is
+ return Nkind_In (Nkind (N), V1, V2, V3, V4);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind) return Boolean
+ is
begin
- return Nodes.Table (N).Nkind;
- end Nkind;
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind;
+ V8 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8);
+ end Nkind_In;
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind;
+ V3 : Node_Kind;
+ V4 : Node_Kind;
+ V5 : Node_Kind;
+ V6 : Node_Kind;
+ V7 : Node_Kind;
+ V8 : Node_Kind;
+ V9 : Node_Kind) return Boolean
+ is
+ begin
+ return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8, V9);
+ end Nkind_In;
--------
-- No --
return N = Empty;
end No;
+ -----------------------
+ -- Node_Debug_Output --
+ -----------------------
+
+ procedure Node_Debug_Output (Op : String; N : Node_Id) is
+ begin
+ Write_Str (Op);
+
+ if Nkind (N) in N_Entity then
+ Write_Str (" entity");
+ else
+ Write_Str (" node");
+ end if;
+
+ Write_Str (" Id = ");
+ Write_Int (Int (N));
+ Write_Str (" ");
+ Write_Location (Sloc (N));
+ Write_Str (" ");
+ Write_Str (Node_Kind'Image (Nkind (N)));
+ Write_Eol;
+ end Node_Debug_Output;
+
-------------------
-- Nodes_Address --
-------------------
end if;
New_Node := New_Copy (Source);
- Fix_Parents (Source, New_Node);
+ Fix_Parents (Ref_Node => Source, Fix_Node => New_Node);
-- We now set the parent of the new node to be the same as the
-- parent of the source. Almost always this parent will be
-------------
procedure Replace (Old_Node, New_Node : Node_Id) is
- Old_Post : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
- Old_CFS : constant Boolean := Nodes.Table (Old_Node).Comes_From_Source;
+ Old_Post : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
+ Old_HasA : constant Boolean := Nodes.Table (Old_Node).Has_Aspects;
+ Old_CFS : constant Boolean := Nodes.Table (Old_Node).Comes_From_Source;
begin
pragma Assert
(not Has_Extension (Old_Node)
- and not Has_Extension (New_Node)
- and not Nodes.Table (New_Node).In_List);
+ and not Has_Extension (New_Node)
+ and not Nodes.Table (New_Node).In_List);
- -- Do copy, preserving link and in list status and comes from source
+ -- Do copy, preserving link and in list status and required flags
Copy_Node (Source => New_Node, Destination => Old_Node);
Nodes.Table (Old_Node).Comes_From_Source := Old_CFS;
Nodes.Table (Old_Node).Error_Posted := Old_Post;
+ Nodes.Table (Old_Node).Has_Aspects := Old_HasA;
-- Fix parents of substituted node, since it has changed identity
- Fix_Parents (New_Node, Old_Node);
+ Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
-- Since we are doing a replace, we assume that the original node
-- is intended to become the new replaced node. The call would be
Orig_Nodes.Table (Old_Node) := Old_Node;
- -- Finally delete the source, since it is now copied
+ -- Invoke the reporting procedure (if available)
- Delete_Node (New_Node);
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => Old_Node, Source => New_Node);
+ end if;
end Replace;
-------------
procedure Rewrite (Old_Node, New_Node : Node_Id) is
Old_Error_P : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
- -- This fields is always preserved in the new node
+ -- This field is always preserved in the new node
+
+ Old_Has_Aspects : constant Boolean := Nodes.Table (Old_Node).Has_Aspects;
+ -- This field is always preserved in the new node
Old_Paren_Count : Nat;
Old_Must_Not_Freeze : Boolean;
begin
pragma Assert
(not Has_Extension (Old_Node)
- and not Has_Extension (New_Node)
- and not Nodes.Table (New_Node).In_List);
+ and not Has_Extension (New_Node)
+ and not Nodes.Table (New_Node).In_List);
+ pragma Debug (Rewrite_Debugging_Output (Old_Node, New_Node));
if Nkind (Old_Node) in N_Subexpr then
Old_Paren_Count := Paren_Count (Old_Node);
Old_Must_Not_Freeze := Must_Not_Freeze (Old_Node);
else
- Old_Paren_Count := 0;
+ Old_Paren_Count := 0;
Old_Must_Not_Freeze := False;
end if;
Sav_Node := New_Copy (Old_Node);
Orig_Nodes.Table (Sav_Node) := Sav_Node;
Orig_Nodes.Table (Old_Node) := Sav_Node;
+
+ -- Both the old and new copies of the node will share the same list
+ -- of aspect specifications if aspect specifications are present.
+
+ if Has_Aspects (Sav_Node) then
+ Set_Has_Aspects (Sav_Node, False);
+ Set_Aspect_Specifications
+ (Sav_Node, Aspect_Specifications (Old_Node));
+ end if;
end if;
-- Copy substitute node into place, preserving old fields as required
Copy_Node (Source => New_Node, Destination => Old_Node);
Nodes.Table (Old_Node).Error_Posted := Old_Error_P;
+ Nodes.Table (Old_Node).Has_Aspects := Old_Has_Aspects;
if Nkind (New_Node) in N_Subexpr then
Set_Paren_Count (Old_Node, Old_Paren_Count);
Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze);
end if;
- Fix_Parents (New_Node, Old_Node);
+ Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
+
+ -- Invoke the reporting procedure (if available)
+
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => Old_Node, Source => New_Node);
+ end if;
end Rewrite;
+ -------------------------
+ -- Rewrite_Breakpoint --
+ -------------------------
+
+ procedure rr is
+ begin
+ Write_Str ("Watched node ");
+ Write_Int (Int (Watch_Node));
+ Write_Str (" rewritten");
+ Write_Eol;
+ end rr;
+
+ ------------------------------
+ -- Rewrite_Debugging_Output --
+ ------------------------------
+
+ procedure rrd (Old_Node, New_Node : Node_Id) is
+ Node_Is_Watched : constant Boolean := Old_Node = Watch_Node;
+
+ begin
+ if Debug_Flag_N or else Node_Is_Watched then
+ Node_Debug_Output ("Rewrite", Old_Node);
+ Node_Debug_Output ("into", New_Node);
+
+ if Node_Is_Watched then
+ Rewrite_Breakpoint;
+ end if;
+ end if;
+ end rrd;
+
------------------
-- Set_Analyzed --
------------------
Default_Node.Comes_From_Source := Default;
end Set_Comes_From_Source_Default;
- --------------------
- -- Set_Convention --
- --------------------
-
- procedure Set_Convention (E : Entity_Id; Val : Convention_Id) is
- begin
- pragma Assert (Nkind (E) in N_Entity);
- To_Flag_Word_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention :=
- Val;
- end Set_Convention;
-
---------------
-- Set_Ekind --
---------------
end Set_Error_Posted;
---------------------
+ -- Set_Has_Aspects --
+ ---------------------
+
+ procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (N <= Nodes.Last);
+ Nodes.Table (N).Has_Aspects := Val;
+ end Set_Has_Aspects;
+
+ -----------------------
+ -- Set_Original_Node --
+ -----------------------
+
+ procedure Set_Original_Node (N : Node_Id; Val : Node_Id) is
+ begin
+ Orig_Nodes.Table (N) := Val;
+ end Set_Original_Node;
+
+ ---------------------
-- Set_Paren_Count --
---------------------
-- Traverse_Func --
-------------------
- function Traverse_Func (Node : Node_Id) return Traverse_Result is
+ function Traverse_Func (Node : Node_Id) return Traverse_Final_Result is
function Traverse_Field
(Nod : Node_Id;
Fld : Union_Id;
- FN : Field_Num) return Traverse_Result;
+ FN : Field_Num) return Traverse_Final_Result;
-- Fld is one of the fields of Nod. If the field points to syntactic
-- node or list, then this node or list is traversed, and the result is
-- the result of this traversal. Otherwise a value of True is returned
function Traverse_Field
(Nod : Node_Id;
Fld : Union_Id;
- FN : Field_Num) return Traverse_Result
+ FN : Field_Num) return Traverse_Final_Result
is
begin
if Fld = Union_Id (Empty) then
end if;
end Traverse_Field;
+ Cur_Node : Node_Id := Node;
+
-- Start of processing for Traverse_Func
begin
- case Process (Node) is
+ -- We walk Field2 last, and if it is a node, we eliminate the tail
+ -- recursion by jumping back to this label. This is because Field2 is
+ -- where the Left_Opnd field of N_Op_Concat is stored, and in practice
+ -- concatenations are sometimes deeply nested, as in X1&X2&...&XN. This
+ -- trick prevents us from running out of memory in that case. We don't
+ -- bother eliminating the tail recursion if Field2 is a list.
+
+ <<Tail_Recurse>>
+
+ case Process (Cur_Node) is
when Abandon =>
return Abandon;
when Skip =>
return OK;
- when OK =>
- if Traverse_Field (Node, Union_Id (Field1 (Node)), 1) = Abandon
- or else
- Traverse_Field (Node, Union_Id (Field2 (Node)), 2) = Abandon
- or else
- Traverse_Field (Node, Union_Id (Field3 (Node)), 3) = Abandon
- or else
- Traverse_Field (Node, Union_Id (Field4 (Node)), 4) = Abandon
- or else
- Traverse_Field (Node, Union_Id (Field5 (Node)), 5) = Abandon
- then
- return Abandon;
- else
- return OK;
- end if;
+ when OK =>
+ null;
+
+ when OK_Orig =>
+ Cur_Node := Original_Node (Cur_Node);
+ end case;
+
+ if Traverse_Field (Cur_Node, Field1 (Cur_Node), 1) = Abandon
+ or else -- skip Field2 here
+ Traverse_Field (Cur_Node, Field3 (Cur_Node), 3) = Abandon
+ or else
+ Traverse_Field (Cur_Node, Field4 (Cur_Node), 4) = Abandon
+ or else
+ Traverse_Field (Cur_Node, Field5 (Cur_Node), 5) = Abandon
+ then
+ return Abandon;
+ end if;
+
+ if Field2 (Cur_Node) not in Node_Range then
+ return Traverse_Field (Cur_Node, Field2 (Cur_Node), 2);
+
+ elsif Is_Syntactic_Field (Nkind (Cur_Node), 2)
+ and then Field2 (Cur_Node) /= Empty_List_Or_Node
+ then
+ -- Here is the tail recursion step, we reset Cur_Node and jump back
+ -- to the start of the procedure, which has the same semantic effect
+ -- as a call.
+
+ Cur_Node := Node_Id (Field2 (Cur_Node));
+ goto Tail_Recurse;
+ end if;
- when OK_Orig =>
- declare
- Onod : constant Node_Id := Original_Node (Node);
- begin
- if Traverse_Field (Onod, Union_Id (Field1 (Onod)), 1) = Abandon
- or else
- Traverse_Field (Onod, Union_Id (Field2 (Onod)), 2) = Abandon
- or else
- Traverse_Field (Onod, Union_Id (Field3 (Onod)), 3) = Abandon
- or else
- Traverse_Field (Onod, Union_Id (Field4 (Onod)), 4) = Abandon
- or else
- Traverse_Field (Onod, Union_Id (Field5 (Onod)), 5) = Abandon
- then
- return Abandon;
- else
- return OK_Orig;
- end if;
- end;
- end case;
+ return OK;
end Traverse_Func;
-------------------
procedure Traverse_Proc (Node : Node_Id) is
function Traverse is new Traverse_Func (Process);
- Discard : Traverse_Result;
+ Discard : Traverse_Final_Result;
pragma Warnings (Off, Discard);
begin
Discard := Traverse (Node);
return Nodes.Table (N + 4).Field10;
end Field28;
+ function Field29 (N : Node_Id) return Union_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Field11;
+ end Field29;
+
function Node1 (N : Node_Id) return Node_Id is
begin
pragma Assert (N <= Nodes.Last);
return Node_Id (Nodes.Table (N + 4).Field10);
end Node28;
+ function Node29 (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Node_Id (Nodes.Table (N + 4).Field11);
+ end Node29;
+
function List1 (N : Node_Id) return List_Id is
begin
pragma Assert (N <= Nodes.Last);
return List_Id (Nodes.Table (N + 2).Field7);
end List14;
+ function List25 (N : Node_Id) return List_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return List_Id (Nodes.Table (N + 4).Field7);
+ end List25;
+
function Elist1 (N : Node_Id) return Elist_Id is
pragma Assert (N <= Nodes.Last);
Value : constant Union_Id := Nodes.Table (N).Field1;
end if;
end Elist4;
+ function Elist5 (N : Node_Id) return Elist_Id is
+ pragma Assert (N <= Nodes.Last);
+ Value : constant Union_Id := Nodes.Table (N).Field5;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist5;
+
function Elist8 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 1).Field8;
end if;
end Elist8;
+ function Elist10 (N : Node_Id) return Elist_Id is
+ pragma Assert (Nkind (N) in N_Entity);
+ Value : constant Union_Id := Nodes.Table (N + 1).Field10;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist10;
+
function Elist13 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 2).Field6;
end if;
end Elist23;
+ function Elist24 (N : Node_Id) return Elist_Id is
+ pragma Assert (Nkind (N) in N_Entity);
+ Value : constant Union_Id := Nodes.Table (N + 4).Field6;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist24;
+
function Elist25 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 4).Field7;
end if;
end Elist25;
+ function Elist26 (N : Node_Id) return Elist_Id is
+ pragma Assert (Nkind (N) in N_Entity);
+ Value : constant Union_Id := Nodes.Table (N + 4).Field8;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist26;
+
function Name1 (N : Node_Id) return Name_Id is
begin
pragma Assert (N <= Nodes.Last);
function Flag20 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return Nodes.Table (N + 1).Unused_1;
+ return Nodes.Table (N + 1).Has_Aspects;
end Flag20;
function Flag21 (N : Node_Id) return Boolean is
function Flag41 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return Nodes.Table (N + 2).Unused_1;
+ return Nodes.Table (N + 2).Has_Aspects;
end Flag41;
function Flag42 (N : Node_Id) return Boolean is
function Flag130 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return Nodes.Table (N + 3).Unused_1;
+ return Nodes.Table (N + 3).Has_Aspects;
end Flag130;
function Flag131 (N : Node_Id) return Boolean is
function Flag184 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag184;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag184;
end Flag184;
function Flag185 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag185;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag185;
end Flag185;
function Flag186 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag186;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag186;
end Flag186;
function Flag187 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag187;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag187;
end Flag187;
function Flag188 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag188;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag188;
end Flag188;
function Flag189 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag189;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag189;
end Flag189;
function Flag190 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag190;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag190;
end Flag190;
function Flag191 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag191;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag191;
end Flag191;
function Flag192 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag192;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag192;
end Flag192;
function Flag193 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag193;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag193;
end Flag193;
function Flag194 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag194;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag194;
end Flag194;
function Flag195 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag195;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag195;
end Flag195;
function Flag196 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag196;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag196;
end Flag196;
function Flag197 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag197;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag197;
end Flag197;
function Flag198 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag198;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag198;
end Flag198;
function Flag199 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag199;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag199;
end Flag199;
function Flag200 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag200;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag200;
end Flag200;
function Flag201 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag201;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag201;
end Flag201;
function Flag202 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag202;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag202;
end Flag202;
function Flag203 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag203;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag203;
end Flag203;
function Flag204 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag204;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag204;
end Flag204;
function Flag205 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag205;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag205;
end Flag205;
function Flag206 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag206;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag206;
end Flag206;
function Flag207 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag207;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag207;
end Flag207;
function Flag208 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag208;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag208;
end Flag208;
function Flag209 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag209;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag209;
end Flag209;
function Flag210 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag210;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag210;
end Flag210;
function Flag211 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag211;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag211;
end Flag211;
function Flag212 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag212;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag212;
end Flag212;
function Flag213 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag213;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag213;
end Flag213;
function Flag214 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag214;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag214;
end Flag214;
function Flag215 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag215;
+ return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag215;
end Flag215;
function Flag216 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag216;
+ return Nodes.Table (N + 4).In_List;
end Flag216;
function Flag217 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag217;
+ return Nodes.Table (N + 4).Has_Aspects;
end Flag217;
function Flag218 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag218;
+ return Nodes.Table (N + 4).Rewrite_Ins;
end Flag218;
function Flag219 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag219;
+ return Nodes.Table (N + 4).Analyzed;
end Flag219;
function Flag220 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag220;
+ return Nodes.Table (N + 4).Comes_From_Source;
end Flag220;
function Flag221 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag221;
+ return Nodes.Table (N + 4).Error_Posted;
end Flag221;
function Flag222 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag222;
+ return Nodes.Table (N + 4).Flag4;
end Flag222;
function Flag223 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag223;
+ return Nodes.Table (N + 4).Flag5;
end Flag223;
function Flag224 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag224;
+ return Nodes.Table (N + 4).Flag6;
end Flag224;
function Flag225 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag225;
+ return Nodes.Table (N + 4).Flag7;
end Flag225;
function Flag226 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag226;
+ return Nodes.Table (N + 4).Flag8;
end Flag226;
function Flag227 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag227;
+ return Nodes.Table (N + 4).Flag9;
end Flag227;
function Flag228 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag228;
+ return Nodes.Table (N + 4).Flag10;
end Flag228;
function Flag229 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag229;
+ return Nodes.Table (N + 4).Flag11;
end Flag229;
function Flag230 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag230;
+ return Nodes.Table (N + 4).Flag12;
end Flag230;
+ function Flag231 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Flag13;
+ end Flag231;
+
+ function Flag232 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Flag14;
+ end Flag232;
+
+ function Flag233 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Flag15;
+ end Flag233;
+
+ function Flag234 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Flag16;
+ end Flag234;
+
+ function Flag235 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Flag17;
+ end Flag235;
+
+ function Flag236 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Flag18;
+ end Flag236;
+
+ function Flag237 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Pflag1;
+ end Flag237;
+
+ function Flag238 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Pflag2;
+ end Flag238;
+
+ function Flag239 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag239;
+ end Flag239;
+
+ function Flag240 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag240;
+ end Flag240;
+
+ function Flag241 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag241;
+ end Flag241;
+
+ function Flag242 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag242;
+ end Flag242;
+
+ function Flag243 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag243;
+ end Flag243;
+
+ function Flag244 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag244;
+ end Flag244;
+
+ function Flag245 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag245;
+ end Flag245;
+
+ function Flag246 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag246;
+ end Flag246;
+
+ function Flag247 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag247;
+ end Flag247;
+
+ function Flag248 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag248;
+ end Flag248;
+
+ function Flag249 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag249;
+ end Flag249;
+
+ function Flag250 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag250;
+ end Flag250;
+
+ function Flag251 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag251;
+ end Flag251;
+
+ function Flag252 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag252;
+ end Flag252;
+
+ function Flag253 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag253;
+ end Flag253;
+
+ function Flag254 (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag254;
+ end Flag254;
+
procedure Set_Nkind (N : Node_Id; Val : Node_Kind) is
begin
pragma Assert (N <= Nodes.Last);
Nodes.Table (N + 4).Field10 := Val;
end Set_Field28;
+ procedure Set_Field29 (N : Node_Id; Val : Union_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field11 := Val;
+ end Set_Field29;
+
procedure Set_Node1 (N : Node_Id; Val : Node_Id) is
begin
pragma Assert (N <= Nodes.Last);
Nodes.Table (N + 4).Field10 := Union_Id (Val);
end Set_Node28;
+ procedure Set_Node29 (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field11 := Union_Id (Val);
+ end Set_Node29;
+
procedure Set_List1 (N : Node_Id; Val : List_Id) is
begin
pragma Assert (N <= Nodes.Last);
Nodes.Table (N + 2).Field7 := Union_Id (Val);
end Set_List14;
+ procedure Set_List25 (N : Node_Id; Val : List_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field7 := Union_Id (Val);
+ end Set_List25;
+
procedure Set_Elist1 (N : Node_Id; Val : Elist_Id) is
begin
Nodes.Table (N).Field1 := Union_Id (Val);
Nodes.Table (N).Field4 := Union_Id (Val);
end Set_Elist4;
+ procedure Set_Elist5 (N : Node_Id; Val : Elist_Id) is
+ begin
+ Nodes.Table (N).Field5 := Union_Id (Val);
+ end Set_Elist5;
+
procedure Set_Elist8 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 1).Field8 := Union_Id (Val);
end Set_Elist8;
+ procedure Set_Elist10 (N : Node_Id; Val : Elist_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 1).Field10 := Union_Id (Val);
+ end Set_Elist10;
+
procedure Set_Elist13 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 3).Field10 := Union_Id (Val);
end Set_Elist23;
+ procedure Set_Elist24 (N : Node_Id; Val : Elist_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field6 := Union_Id (Val);
+ end Set_Elist24;
+
procedure Set_Elist25 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 4).Field7 := Union_Id (Val);
end Set_Elist25;
+ procedure Set_Elist26 (N : Node_Id; Val : Elist_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field8 := Union_Id (Val);
+ end Set_Elist26;
+
procedure Set_Name1 (N : Node_Id; Val : Name_Id) is
begin
pragma Assert (N <= Nodes.Last);
procedure Set_Flag20 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 1).Unused_1 := Val;
+ Nodes.Table (N + 1).Has_Aspects := Val;
end Set_Flag20;
procedure Set_Flag21 (N : Node_Id; Val : Boolean) is
procedure Set_Flag41 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 2).Unused_1 := Val;
+ Nodes.Table (N + 2).Has_Aspects := Val;
end Set_Flag41;
procedure Set_Flag42 (N : Node_Id; Val : Boolean) is
procedure Set_Flag130 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 3).Unused_1 := Val;
+ Nodes.Table (N + 3).Has_Aspects := Val;
end Set_Flag130;
procedure Set_Flag131 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag184 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag184 := Val;
end Set_Flag184;
procedure Set_Flag185 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag185 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag185 := Val;
end Set_Flag185;
procedure Set_Flag186 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag186 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag186 := Val;
end Set_Flag186;
procedure Set_Flag187 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag187 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag187 := Val;
end Set_Flag187;
procedure Set_Flag188 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag188 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag188 := Val;
end Set_Flag188;
procedure Set_Flag189 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag189 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag189 := Val;
end Set_Flag189;
procedure Set_Flag190 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag190 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag190 := Val;
end Set_Flag190;
procedure Set_Flag191 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag191 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag191 := Val;
end Set_Flag191;
procedure Set_Flag192 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag192 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag192 := Val;
end Set_Flag192;
procedure Set_Flag193 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag193 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag193 := Val;
end Set_Flag193;
procedure Set_Flag194 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag194 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag194 := Val;
end Set_Flag194;
procedure Set_Flag195 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag195 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag195 := Val;
end Set_Flag195;
procedure Set_Flag196 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag196 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag196 := Val;
end Set_Flag196;
procedure Set_Flag197 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag197 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag197 := Val;
end Set_Flag197;
procedure Set_Flag198 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag198 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag198 := Val;
end Set_Flag198;
procedure Set_Flag199 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag199 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag199 := Val;
end Set_Flag199;
procedure Set_Flag200 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag200 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag200 := Val;
end Set_Flag200;
procedure Set_Flag201 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag201 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag201 := Val;
end Set_Flag201;
procedure Set_Flag202 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag202 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag202 := Val;
end Set_Flag202;
procedure Set_Flag203 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag203 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag203 := Val;
end Set_Flag203;
procedure Set_Flag204 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag204 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag204 := Val;
end Set_Flag204;
procedure Set_Flag205 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag205 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag205 := Val;
end Set_Flag205;
procedure Set_Flag206 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag206 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag206 := Val;
end Set_Flag206;
procedure Set_Flag207 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag207 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag207 := Val;
end Set_Flag207;
procedure Set_Flag208 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag208 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag208 := Val;
end Set_Flag208;
procedure Set_Flag209 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag209 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag209 := Val;
end Set_Flag209;
procedure Set_Flag210 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag210 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag210 := Val;
end Set_Flag210;
procedure Set_Flag211 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag211 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag211 := Val;
end Set_Flag211;
procedure Set_Flag212 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag212 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag212 := Val;
end Set_Flag212;
procedure Set_Flag213 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag213 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag213 := Val;
end Set_Flag213;
procedure Set_Flag214 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag214 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag214 := Val;
end Set_Flag214;
procedure Set_Flag215 (N : Node_Id; Val : Boolean) is
pragma Assert (Nkind (N) in N_Entity);
To_Flag_Word4_Ptr
(Union_Id_Ptr'
- (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag215 := Val;
+ (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag215 := Val;
end Set_Flag215;
procedure Set_Flag216 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag216 := Val;
+ Nodes.Table (N + 4).In_List := Val;
end Set_Flag216;
procedure Set_Flag217 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag217 := Val;
+ Nodes.Table (N + 4).Has_Aspects := Val;
end Set_Flag217;
procedure Set_Flag218 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag218 := Val;
+ Nodes.Table (N + 4).Rewrite_Ins := Val;
end Set_Flag218;
procedure Set_Flag219 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag219 := Val;
+ Nodes.Table (N + 4).Analyzed := Val;
end Set_Flag219;
procedure Set_Flag220 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag220 := Val;
+ Nodes.Table (N + 4).Comes_From_Source := Val;
end Set_Flag220;
procedure Set_Flag221 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag221 := Val;
+ Nodes.Table (N + 4).Error_Posted := Val;
end Set_Flag221;
procedure Set_Flag222 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag222 := Val;
+ Nodes.Table (N + 4).Flag4 := Val;
end Set_Flag222;
procedure Set_Flag223 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag223 := Val;
+ Nodes.Table (N + 4).Flag5 := Val;
end Set_Flag223;
procedure Set_Flag224 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag224 := Val;
+ Nodes.Table (N + 4).Flag6 := Val;
end Set_Flag224;
procedure Set_Flag225 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag225 := Val;
+ Nodes.Table (N + 4).Flag7 := Val;
end Set_Flag225;
procedure Set_Flag226 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag226 := Val;
+ Nodes.Table (N + 4).Flag8 := Val;
end Set_Flag226;
procedure Set_Flag227 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag227 := Val;
+ Nodes.Table (N + 4).Flag9 := Val;
end Set_Flag227;
procedure Set_Flag228 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag228 := Val;
+ Nodes.Table (N + 4).Flag10 := Val;
end Set_Flag228;
procedure Set_Flag229 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag229 := Val;
+ Nodes.Table (N + 4).Flag11 := Val;
end Set_Flag229;
procedure Set_Flag230 (N : Node_Id; Val : Boolean) is
begin
pragma Assert (Nkind (N) in N_Entity);
- To_Flag_Word5_Ptr
- (Union_Id_Ptr'
- (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag230 := Val;
+ Nodes.Table (N + 4).Flag12 := Val;
end Set_Flag230;
+ procedure Set_Flag231 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Flag13 := Val;
+ end Set_Flag231;
+
+ procedure Set_Flag232 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Flag14 := Val;
+ end Set_Flag232;
+
+ procedure Set_Flag233 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Flag15 := Val;
+ end Set_Flag233;
+
+ procedure Set_Flag234 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Flag16 := Val;
+ end Set_Flag234;
+
+ procedure Set_Flag235 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Flag17 := Val;
+ end Set_Flag235;
+
+ procedure Set_Flag236 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Flag18 := Val;
+ end Set_Flag236;
+
+ procedure Set_Flag237 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Pflag1 := Val;
+ end Set_Flag237;
+
+ procedure Set_Flag238 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Pflag2 := Val;
+ end Set_Flag238;
+
+ procedure Set_Flag239 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag239 := Val;
+ end Set_Flag239;
+
+ procedure Set_Flag240 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag240 := Val;
+ end Set_Flag240;
+
+ procedure Set_Flag241 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag241 := Val;
+ end Set_Flag241;
+
+ procedure Set_Flag242 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag242 := Val;
+ end Set_Flag242;
+
+ procedure Set_Flag243 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag243 := Val;
+ end Set_Flag243;
+
+ procedure Set_Flag244 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag244 := Val;
+ end Set_Flag244;
+
+ procedure Set_Flag245 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag245 := Val;
+ end Set_Flag245;
+
+ procedure Set_Flag246 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte2_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag246 := Val;
+ end Set_Flag246;
+
+ procedure Set_Flag247 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag247 := Val;
+ end Set_Flag247;
+
+ procedure Set_Flag248 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag248 := Val;
+ end Set_Flag248;
+
+ procedure Set_Flag249 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag249 := Val;
+ end Set_Flag249;
+
+ procedure Set_Flag250 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag250 := Val;
+ end Set_Flag250;
+
+ procedure Set_Flag251 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag251 := Val;
+ end Set_Flag251;
+
+ procedure Set_Flag252 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag252 := Val;
+ end Set_Flag252;
+
+ procedure Set_Flag253 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag253 := Val;
+ end Set_Flag253;
+
+ procedure Set_Flag254 (N : Node_Id; Val : Boolean) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ To_Flag_Byte3_Ptr
+ (Node_Kind_Ptr'
+ (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag254 := Val;
+ end Set_Flag254;
+
procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id) is
begin
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node1 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node2 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node3 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node4 (N, Val);
pragma Assert (N <= Nodes.Last);
if Val > Error then
- Set_Parent (Val, N);
+ Set_Parent (N => Val, Val => N);
end if;
Set_Node5 (N, Val);
OSDN Git Service
