-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, 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. --
-- Turn off subprogram ordering check for this package
-- WARNING: There is a C version of this package. Any changes to this source
--- file must be properly reflected in the C header a-atree.h (for inlined
--- bodies) and the C file a-atree.c (for remaining non-inlined bodies).
+-- file must be properly reflected in the file atree.h which is a C header
+-- file containing equivalent definitions for use by gigi.
with Debug; use Debug;
-with Namet; use Namet;
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
+ ---------------
+ -- Debugging --
+ ---------------
+
+ -- Suppose you find that node 12345 is messed up. You might want to find
+ -- the code that created that node. There are two ways to do this:
+
+ -- One way is to set a conditional breakpoint on New_Node_Debugging_Output
+ -- (nickname "nnd"):
+ -- break nnd if n = 12345
+ -- and run gnat1 again from the beginning.
+
+ -- The other way is to set a breakpoint near the beginning (e.g. on
+ -- gnat1drv), and run. Then set Watch_Node (nickname "ww") to 12345 in gdb:
+ -- ww := 12345
+ -- and set a breakpoint on New_Node_Breakpoint (nickname "nn"). Continue.
+
+ -- Either way, gnat1 will stop when node 12345 is created
+
+ -- The second method is faster
+
+ 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
+ -- 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.
+
+ procedure nn;
+ pragma Export (Ada, nn);
+ procedure New_Node_Breakpoint renames nn;
+ -- This doesn't do anything interesting; it's just for setting breakpoint
+ -- on as explained above.
+
+ procedure nnd (N : Node_Id);
+ pragma Export (Ada, nnd);
+ procedure New_Node_Debugging_Output (N : Node_Id) renames nnd;
+ -- For debugging. If debugging is turned on, New_Node and New_Entity call
+ -- this. If debug flag N is turned on, this prints out the new node.
+ --
+ -- If Node = Watch_Node, this prints out the new node and calls
+ -- New_Node_Breakpoint. Otherwise, does nothing.
+
+ -----------------------------
+ -- Local Objects and Types --
+ -----------------------------
+
Node_Count : Nat;
-- Count allocated nodes for Num_Nodes function
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_Word4_Ptr is new
Unchecked_Conversion (Union_Id_Ptr, Flag_Word4_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);
+ -- 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;
+ 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);
--------------------------------------------------
-- Implementation of Tree Substitution Routines --
package Orig_Nodes is new Table.Table (
Table_Component_Type => Node_Id,
- Table_Index_Type => Node_Id,
+ Table_Index_Type => Node_Id'Base,
Table_Low_Bound => First_Node_Id,
Table_Initial => Alloc.Orig_Nodes_Initial,
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.
+ --------------------------
+ -- Paren_Count Handling --
+ --------------------------
- NCT_Hash_Tables_Used : Boolean := False;
- -- Set to True if hash tables are in use
+ -- As noted in the spec, the paren count in a sub-expression node has
+ -- four possible values 0,1,2, and 3. The value 3 really means 3 or more,
+ -- and we use an auxiliary serially scanned table to record the actual
+ -- count. A serial search is fine, only pathological programs will use
+ -- entries in this table. Normal programs won't use it at all.
- NCT_Table_Entries : Nat;
- -- Count entries in table to see if threshhold is reached
+ type Paren_Count_Entry is record
+ Nod : Node_Id;
+ -- The node to which this count applies
- 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.
+ Count : Nat range 3 .. Nat'Last;
+ -- The count of parentheses, which will be in the indicated range
+ end record;
- subtype NCT_Header_Num is Int range 0 .. 511;
- -- Defines range of headers in hash tables (512 headers)
+ package Paren_Counts is new Table.Table (
+ Table_Component_Type => Paren_Count_Entry,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 0,
+ Table_Initial => 10,
+ Table_Increment => 200,
+ Table_Name => "Paren_Counts");
-----------------------
-- 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;
Node_Count := Node_Count + 1;
end if;
+ -- Specifically copy Paren_Count to deal with creating new table entry
+ -- if the parentheses count is at the maximum possible value already.
+
+ if Present (Src) and then Nkind (Src) in N_Subexpr then
+ Set_Paren_Count (New_Id, Paren_Count (Src));
+ end if;
+
+ -- Set extension nodes if required
+
if With_Extension then
Nodes.Append (Ext1);
Nodes.Append (Ext2);
function Analyzed (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
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 --
-----------------
Save_Link : constant Union_Id := Nodes.Table (N).Link;
Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source;
Save_Posted : constant Boolean := Nodes.Table (N).Error_Posted;
- Par_Count : Paren_Count_Type := 0;
+ Par_Count : Nat := 0;
begin
if Nkind (N) in N_Subexpr then
function Comes_From_Source (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Comes_From_Source;
end Comes_From_Source;
Nodes.Table (Destination).In_List := Save_In_List;
Nodes.Table (Destination).Link := Save_Link;
+ -- Specifically set Paren_Count to make sure auxiliary table entry
+ -- gets correctly made if the parentheses count is at the max value.
+
+ if Nkind (Destination) in N_Subexpr then
+ Set_Paren_Count (Destination, Paren_Count (Source));
+ end if;
+
+ -- Deal with copying extension nodes if present
+
if Has_Extension (Source) then
pragma Assert (Has_Extension (Destination));
Nodes.Table (Destination + 1) := Nodes.Table (Source + 1);
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 --
-----------
function Error_Posted (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Error_Posted;
end 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;
-----------------------------------
Node_Count := 0;
Atree_Private_Part.Nodes.Init;
Orig_Nodes.Init;
+ Paren_Counts.Init;
-- Allocate Empty node
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;
--------------------------
-- 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 --
- -------------------
-
- 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;
-
- ---------------
- -- NCT_Assoc --
- ---------------
-
- -- 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).
-
- 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."=");
-
- ---------------------
- -- NCT_Itype_Assoc --
- ---------------------
-
- -- 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
- 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.
-
- 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.
-
- procedure Build_NCT_Hash_Tables;
- -- Builds hash tables (number of elements >= threshold value)
-
- function Copy_Elist_With_Replacement
- (Old_Elist : Elist_Id) return Elist_Id;
- -- Called during second phase to copy element list doing replacements.
-
- 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.
-
- function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
- -- Called during second phase to copy list doing replacements.
-
- function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id;
- -- Called during second phase to copy node doing replacements
-
- procedure Visit_Elist (E : Elist_Id);
- -- Called during first phase to visit all elements of an Elist
-
- 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).
-
- 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.
-
- procedure Visit_List (L : List_Id);
- -- Called during first phase to visit all elements of a List
-
- procedure Visit_Node (N : Node_Or_Entity_Id);
- -- Called during first phase to visit a node and all its subtrees
-
- -----------
- -- Assoc --
- -----------
-
- function Assoc (N : Node_Or_Entity_Id) return Node_Id is
- E : Elmt_Id;
- Ent : Entity_Id;
-
- begin
- if not Has_Extension (N) or else No (Actual_Map) then
- return N;
-
- elsif NCT_Hash_Tables_Used then
- Ent := NCT_Assoc.Get (Entity_Id (N));
-
- if Present (Ent) then
- return Ent;
- else
- return N;
- end if;
-
- -- No hash table used, do serial search
-
- 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;
- end if;
-
- 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);
- Next_Elmt (Elmt);
- NCT_Assoc.Set (Ent, Node (Elmt));
- Next_Elmt (Elmt);
-
- if Is_Type (Ent) then
- declare
- Anode : constant Entity_Id :=
- Associated_Node_For_Itype (Ent);
-
- begin
- if Present (Anode) then
- NCT_Itype_Assoc.Set (Anode, Node (Elmt));
- end if;
- end;
- end if;
- 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;
-
- 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).
-
- ---------------------------------
- -- 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;
-
- -- 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);
- 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 --
----------------
is
Ent : Entity_Id;
- procedure New_Entity_Debugging_Output;
- pragma Inline (New_Entity_Debugging_Output);
- -- Debugging routine for debug flag N
-
- ---------------------------------
- -- New_Entity_Debugging_Output --
- ---------------------------------
-
- procedure New_Entity_Debugging_Output is
- begin
- if Debug_Flag_N then
- Write_Str ("Allocate entity, Id = ");
- Write_Int (Int (Ent));
- Write_Str (" ");
- Write_Location (New_Sloc);
- Write_Str (" ");
- Write_Str (Node_Kind'Image (New_Node_Kind));
- Write_Eol;
- end if;
- end New_Entity_Debugging_Output;
-
- -- Start of processing for New_Entity
-
begin
pragma Assert (New_Node_Kind in N_Entity);
Nodes.Table (Ent).Nkind := New_Node_Kind;
Nodes.Table (Ent).Sloc := New_Sloc;
- pragma Debug (New_Entity_Debugging_Output);
+ pragma Debug (New_Node_Debugging_Output (Ent));
return Ent;
end New_Entity;
is
Nod : Node_Id;
- procedure New_Node_Debugging_Output;
- pragma Inline (New_Node_Debugging_Output);
- -- Debugging routine for debug flag N
-
- --------------------------
- -- New_Debugging_Output --
- --------------------------
-
- procedure New_Node_Debugging_Output is
- begin
- if Debug_Flag_N then
- Write_Str ("Allocate node, Id = ");
- Write_Int (Int (Nod));
- Write_Str (" ");
- Write_Location (New_Sloc);
- Write_Str (" ");
- Write_Str (Node_Kind'Image (New_Node_Kind));
- Write_Eol;
- end if;
- end New_Node_Debugging_Output;
-
- -- Start of processing for New_Node
-
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);
+ 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 a error location for the bomb.
+ -- 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;
return Nod;
end New_Node;
+ -------------------------
+ -- New_Node_Breakpoint --
+ -------------------------
+
+ procedure nn is -- New_Node_Breakpoint
+ 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;
+
+ 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 --
-----------
return Nodes.Table (N).Nkind;
end Nkind;
+ --------------
+ -- Nkind_In --
+ --------------
+
+ function Nkind_In
+ (N : Node_Id;
+ V1 : Node_Kind;
+ V2 : Node_Kind) return Boolean
+ is
+ begin
+ 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
+ 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
+ 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 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 --
--------
-- Paren_Count --
-----------------
- function Paren_Count (N : Node_Id) return Paren_Count_Type is
- C : Paren_Count_Type := 0;
+ function Paren_Count (N : Node_Id) return Nat is
+ C : Nat := 0;
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
if Nodes.Table (N).Pflag1 then
C := C + 1;
C := C + 2;
end if;
- return C;
+ -- Value of 0,1,2 returned as is
+
+ if C <= 2 then
+ return C;
+
+ -- Value of 3 means we search the table, and we must find an entry
+
+ else
+ for J in Paren_Counts.First .. Paren_Counts.Last loop
+ if N = Paren_Counts.Table (J).Nod then
+ return Paren_Counts.Table (J).Count;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end if;
end Paren_Count;
------------
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
-- 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
-- to Rewrite if there were an intention to save the original node.
Orig_Nodes.Table (Old_Node) := Old_Node;
-
- -- Finally delete the source, since it is now copied
-
- Delete_Node (New_Node);
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
- Old_Paren_Count : Paren_Count_Type;
+ Old_Paren_Count : Nat;
Old_Must_Not_Freeze : Boolean;
-- These fields are preserved in the new node only if the new node
-- and the old node are both subexpression nodes.
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);
end Rewrite;
------------------
procedure Set_Comes_From_Source (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Comes_From_Source := Val;
end Set_Comes_From_Source;
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 --
---------------
-- Set_Paren_Count --
---------------------
- procedure Set_Paren_Count (N : Node_Id; Val : Paren_Count_Type) is
+ procedure Set_Paren_Count (N : Node_Id; Val : Nat) is
begin
pragma Assert (Nkind (N) in N_Subexpr);
- Nodes.Table (N).Pflag1 := (Val mod 2 /= 0);
- Nodes.Table (N).Pflag2 := (Val >= 2);
+
+ -- Value of 0,1,2 stored as is
+
+ if Val <= 2 then
+ Nodes.Table (N).Pflag1 := (Val mod 2 /= 0);
+ Nodes.Table (N).Pflag2 := (Val = 2);
+
+ -- Value of 3 or greater stores 3 in node and makes table entry
+
+ else
+ Nodes.Table (N).Pflag1 := True;
+ Nodes.Table (N).Pflag2 := True;
+
+ for J in Paren_Counts.First .. Paren_Counts.Last loop
+ if N = Paren_Counts.Table (J).Nod then
+ Paren_Counts.Table (J).Count := Val;
+ return;
+ end if;
+ end loop;
+
+ Paren_Counts.Append ((Nod => N, Count => Val));
+ end if;
end 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 (Fld : Union_Id) return Traverse_Result;
- -- Fld is one of the fields of Node. If the field points to a
- -- 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 with no processing.
+ function Traverse_Field
+ (Nod : Node_Id;
+ Fld : Union_Id;
+ 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
+ -- with no processing. FN is the number of the field (1 .. 5).
--------------------
-- Traverse_Field --
--------------------
- function Traverse_Field (Fld : Union_Id) return Traverse_Result is
+ function Traverse_Field
+ (Nod : Node_Id;
+ Fld : Union_Id;
+ FN : Field_Num) return Traverse_Final_Result
+ is
begin
if Fld = Union_Id (Empty) then
return OK;
-- Traverse descendent that is syntactic subtree node
- if Parent (Node_Id (Fld)) = Node
- or else Original_Node (Parent (Node_Id (Fld))) = Node
- then
+ if Is_Syntactic_Field (Nkind (Nod), FN) then
return Traverse_Func (Node_Id (Fld));
-- Node that is not a syntactic subtree
-- Traverse descendent that is a syntactic subtree list
- if Parent (List_Id (Fld)) = Node
- or else Original_Node (Parent (List_Id (Fld))) = Node
- then
+ if Is_Syntactic_Field (Nkind (Nod), FN) then
declare
Elmt : Node_Id := First (List_Id (Fld));
begin
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;
return OK;
when OK =>
- if Traverse_Field (Union_Id (Field1 (Node))) = Abandon
- or else
- Traverse_Field (Union_Id (Field2 (Node))) = Abandon
- or else
- Traverse_Field (Union_Id (Field3 (Node))) = Abandon
- or else
- Traverse_Field (Union_Id (Field4 (Node))) = Abandon
- or else
- Traverse_Field (Union_Id (Field5 (Node))) = Abandon
- then
- return Abandon;
-
- else
- return OK;
- end if;
+ null;
when OK_Orig =>
- declare
- Onode : constant Node_Id := Original_Node (Node);
-
- begin
- if Traverse_Field (Union_Id (Field1 (Onode))) = Abandon
- or else
- Traverse_Field (Union_Id (Field2 (Onode))) = Abandon
- or else
- Traverse_Field (Union_Id (Field3 (Onode))) = Abandon
- or else
- Traverse_Field (Union_Id (Field4 (Onode))) = Abandon
- or else
- Traverse_Field (Union_Id (Field5 (Onode))) = Abandon
- then
- return Abandon;
-
- else
- return OK_Orig;
- end if;
- end;
+ 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;
+
+ 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);
Tree_Read_Int (Node_Count);
Nodes.Tree_Read;
Orig_Nodes.Tree_Read;
+ Paren_Counts.Tree_Read;
end Tree_Read;
----------------
Tree_Write_Int (Node_Count);
Nodes.Tree_Write;
Orig_Nodes.Tree_Write;
+ Paren_Counts.Tree_Write;
end Tree_Write;
------------------------------
function Field1 (N : Node_Id) return Union_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Field1;
end Field1;
function Field2 (N : Node_Id) return Union_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Field2;
end Field2;
function Field3 (N : Node_Id) return Union_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Field3;
end Field3;
function Field4 (N : Node_Id) return Union_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Field4;
end Field4;
function Field5 (N : Node_Id) return Union_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Field5;
end Field5;
return Nodes.Table (N + 4).Field9;
end Field27;
+ function Field28 (N : Node_Id) return Union_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Field10;
+ end Field28;
+
function Node1 (N : Node_Id) return Node_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Node_Id (Nodes.Table (N).Field1);
end Node1;
function Node2 (N : Node_Id) return Node_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Node_Id (Nodes.Table (N).Field2);
end Node2;
function Node3 (N : Node_Id) return Node_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Node_Id (Nodes.Table (N).Field3);
end Node3;
function Node4 (N : Node_Id) return Node_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Node_Id (Nodes.Table (N).Field4);
end Node4;
function Node5 (N : Node_Id) return Node_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Node_Id (Nodes.Table (N).Field5);
end Node5;
return Node_Id (Nodes.Table (N + 4).Field9);
end Node27;
+ function Node28 (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Node_Id (Nodes.Table (N + 4).Field10);
+ end Node28;
+
function List1 (N : Node_Id) return List_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return List_Id (Nodes.Table (N).Field1);
end List1;
function List2 (N : Node_Id) return List_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return List_Id (Nodes.Table (N).Field2);
end List2;
function List3 (N : Node_Id) return List_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return List_Id (Nodes.Table (N).Field3);
end List3;
function List4 (N : Node_Id) return List_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return List_Id (Nodes.Table (N).Field4);
end List4;
function List5 (N : Node_Id) return List_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return List_Id (Nodes.Table (N).Field5);
end List5;
return List_Id (Nodes.Table (N + 2).Field7);
end List14;
+ function Elist1 (N : Node_Id) return Elist_Id is
+ pragma Assert (N <= Nodes.Last);
+ Value : constant Union_Id := Nodes.Table (N).Field1;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist1;
+
function Elist2 (N : Node_Id) return Elist_Id is
+ pragma Assert (N <= Nodes.Last);
+ Value : constant Union_Id := Nodes.Table (N).Field2;
begin
- return Elist_Id (Nodes.Table (N).Field2);
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist2;
function Elist3 (N : Node_Id) return Elist_Id is
+ pragma Assert (N <= Nodes.Last);
+ Value : constant Union_Id := Nodes.Table (N).Field3;
begin
- return Elist_Id (Nodes.Table (N).Field3);
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist3;
function Elist4 (N : Node_Id) return Elist_Id is
+ pragma Assert (N <= Nodes.Last);
+ Value : constant Union_Id := Nodes.Table (N).Field4;
begin
- return Elist_Id (Nodes.Table (N).Field4);
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist4;
function Elist8 (N : Node_Id) return Elist_Id is
- begin
pragma Assert (Nkind (N) in N_Entity);
- return Elist_Id (Nodes.Table (N + 1).Field8);
+ Value : constant Union_Id := Nodes.Table (N + 1).Field8;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist8;
function Elist13 (N : Node_Id) return Elist_Id is
- begin
pragma Assert (Nkind (N) in N_Entity);
- return Elist_Id (Nodes.Table (N + 2).Field6);
+ Value : constant Union_Id := Nodes.Table (N + 2).Field6;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist13;
function Elist15 (N : Node_Id) return Elist_Id is
- begin
pragma Assert (Nkind (N) in N_Entity);
- return Elist_Id (Nodes.Table (N + 2).Field8);
+ Value : constant Union_Id := Nodes.Table (N + 2).Field8;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist15;
function Elist16 (N : Node_Id) return Elist_Id is
+ pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 2).Field9;
-
begin
- pragma Assert (Nkind (N) in N_Entity);
if Value = 0 then
return No_Elist;
else
- return Elist_Id (Nodes.Table (N + 2).Field9);
+ return Elist_Id (Value);
end if;
end Elist16;
function Elist18 (N : Node_Id) return Elist_Id is
- begin
pragma Assert (Nkind (N) in N_Entity);
- return Elist_Id (Nodes.Table (N + 2).Field11);
+ Value : constant Union_Id := Nodes.Table (N + 2).Field11;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist18;
function Elist21 (N : Node_Id) return Elist_Id is
- begin
pragma Assert (Nkind (N) in N_Entity);
- return Elist_Id (Nodes.Table (N + 3).Field8);
+ Value : constant Union_Id := Nodes.Table (N + 3).Field8;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist21;
function Elist23 (N : Node_Id) return Elist_Id is
- begin
pragma Assert (Nkind (N) in N_Entity);
- return Elist_Id (Nodes.Table (N + 3).Field10);
+ Value : constant Union_Id := Nodes.Table (N + 3).Field10;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
end Elist23;
- function Elist24 (N : Node_Id) return Elist_Id is
+ 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;
begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist25;
+
+ function Elist26 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
- return Elist_Id (Nodes.Table (N + 4).Field6);
- end Elist24;
+ 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 in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Name_Id (Nodes.Table (N).Field1);
end Name1;
function Name2 (N : Node_Id) return Name_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Name_Id (Nodes.Table (N).Field2);
end Name2;
function Str3 (N : Node_Id) return String_Id is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return String_Id (Nodes.Table (N).Field3);
end Str3;
function Uint2 (N : Node_Id) return Uint is
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
U : constant Union_Id := Nodes.Table (N).Field2;
begin
if U = 0 then
end Uint2;
function Uint3 (N : Node_Id) return Uint is
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
U : constant Union_Id := Nodes.Table (N).Field3;
begin
if U = 0 then
end Uint3;
function Uint4 (N : Node_Id) return Uint is
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
U : constant Union_Id := Nodes.Table (N).Field4;
begin
if U = 0 then
end Uint4;
function Uint5 (N : Node_Id) return Uint is
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
U : constant Union_Id := Nodes.Table (N).Field5;
begin
if U = 0 then
function Uint8 (N : Node_Id) return Uint is
pragma Assert (Nkind (N) in N_Entity);
U : constant Union_Id := Nodes.Table (N + 1).Field8;
-
begin
if U = 0 then
return Uint_0;
function Ureal3 (N : Node_Id) return Ureal is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return From_Union (Nodes.Table (N).Field3);
end Ureal3;
function Flag4 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag4;
end Flag4;
function Flag5 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag5;
end Flag5;
function Flag6 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag6;
end Flag6;
function Flag7 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag7;
end Flag7;
function Flag8 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag8;
end Flag8;
function Flag9 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag9;
end Flag9;
function Flag10 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag10;
end Flag10;
function Flag11 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag11;
end Flag11;
function Flag12 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag12;
end Flag12;
function Flag13 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag13;
end Flag13;
function Flag14 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag14;
end Flag14;
function Flag15 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag15;
end Flag15;
function Flag16 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag16;
end Flag16;
function Flag17 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag17;
end Flag17;
function Flag18 (N : Node_Id) return Boolean is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
return Nodes.Table (N).Flag18;
end Flag18;
return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag184;
end Flag184;
- function Flag185 (N : Node_Id) return Boolean is
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ end Flag216;
+
+ function Flag217 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag185;
- end Flag185;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag217;
+ end Flag217;
- function Flag186 (N : Node_Id) return Boolean is
+ function Flag218 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag186;
- end Flag186;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag218;
+ end Flag218;
- function Flag187 (N : Node_Id) return Boolean is
+ function Flag219 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag187;
- end Flag187;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag219;
+ end Flag219;
- function Flag188 (N : Node_Id) return Boolean is
+ function Flag220 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag188;
- end Flag188;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag220;
+ end Flag220;
- function Flag189 (N : Node_Id) return Boolean is
+ function Flag221 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag189;
- end Flag189;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag221;
+ end Flag221;
- function Flag190 (N : Node_Id) return Boolean is
+ function Flag222 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag190;
- end Flag190;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag222;
+ end Flag222;
- function Flag191 (N : Node_Id) return Boolean is
+ function Flag223 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag191;
- end Flag191;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag223;
+ end Flag223;
- function Flag192 (N : Node_Id) return Boolean is
+ function Flag224 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag192;
- end Flag192;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag224;
+ end Flag224;
- function Flag193 (N : Node_Id) return Boolean is
+ function Flag225 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag193;
- end Flag193;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag225;
+ end Flag225;
- function Flag194 (N : Node_Id) return Boolean is
+ function Flag226 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag194;
- end Flag194;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag226;
+ end Flag226;
- function Flag195 (N : Node_Id) return Boolean is
+ function Flag227 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag195;
- end Flag195;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag227;
+ end Flag227;
- function Flag196 (N : Node_Id) return Boolean is
+ function Flag228 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag196;
- end Flag196;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag228;
+ end Flag228;
- function Flag197 (N : Node_Id) return Boolean is
+ function Flag229 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag197;
- end Flag197;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag229;
+ end Flag229;
- function Flag198 (N : Node_Id) return Boolean is
+ function Flag230 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag198;
- end Flag198;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag230;
+ end Flag230;
- function Flag199 (N : Node_Id) return Boolean is
+ function Flag231 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag199;
- end Flag199;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag231;
+ end Flag231;
- function Flag200 (N : Node_Id) return Boolean is
+ function Flag232 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag200;
- end Flag200;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag232;
+ end Flag232;
- function Flag201 (N : Node_Id) return Boolean is
+ function Flag233 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag201;
- end Flag201;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag233;
+ end Flag233;
- function Flag202 (N : Node_Id) return Boolean is
+ function Flag234 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag202;
- end Flag202;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag234;
+ end Flag234;
- function Flag203 (N : Node_Id) return Boolean is
+ function Flag235 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag203;
- end Flag203;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag235;
+ end Flag235;
- function Flag204 (N : Node_Id) return Boolean is
+ function Flag236 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag204;
- end Flag204;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag236;
+ end Flag236;
- function Flag205 (N : Node_Id) return Boolean is
+ function Flag237 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag205;
- end Flag205;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag237;
+ end Flag237;
- function Flag206 (N : Node_Id) return Boolean is
+ function Flag238 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag206;
- end Flag206;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag238;
+ end Flag238;
- function Flag207 (N : Node_Id) return Boolean is
+ function Flag239 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag207;
- end Flag207;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag239;
+ end Flag239;
- function Flag208 (N : Node_Id) return Boolean is
+ function Flag240 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag208;
- end Flag208;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag240;
+ end Flag240;
- function Flag209 (N : Node_Id) return Boolean is
+ function Flag241 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag209;
- end Flag209;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag241;
+ end Flag241;
- function Flag210 (N : Node_Id) return Boolean is
+ function Flag242 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag210;
- end Flag210;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag242;
+ end Flag242;
- function Flag211 (N : Node_Id) return Boolean is
+ function Flag243 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag211;
- end Flag211;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag243;
+ end Flag243;
- function Flag212 (N : Node_Id) return Boolean is
+ function Flag244 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag212;
- end Flag212;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag244;
+ end Flag244;
- function Flag213 (N : Node_Id) return Boolean is
+ function Flag245 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag213;
- end Flag213;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag245;
+ end Flag245;
- function Flag214 (N : Node_Id) return Boolean is
+ function Flag246 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag214;
- end Flag214;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag246;
+ end Flag246;
- function Flag215 (N : Node_Id) return Boolean is
+ function Flag247 (N : Node_Id) return Boolean is
begin
pragma Assert (Nkind (N) in N_Entity);
- return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag215;
- end Flag215;
+ return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag247;
+ end Flag247;
procedure Set_Nkind (N : Node_Id; Val : Node_Kind) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Nkind := Val;
end Set_Nkind;
procedure Set_Field1 (N : Node_Id; Val : Union_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field1 := Val;
end Set_Field1;
procedure Set_Field2 (N : Node_Id; Val : Union_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field2 := Val;
end Set_Field2;
procedure Set_Field3 (N : Node_Id; Val : Union_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field3 := Val;
end Set_Field3;
procedure Set_Field4 (N : Node_Id; Val : Union_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field4 := Val;
end Set_Field4;
procedure Set_Field5 (N : Node_Id; Val : Union_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field5 := Val;
end Set_Field5;
Nodes.Table (N + 4).Field9 := Val;
end Set_Field27;
+ procedure Set_Field28 (N : Node_Id; Val : Union_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field10 := Val;
+ end Set_Field28;
+
procedure Set_Node1 (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field1 := Union_Id (Val);
end Set_Node1;
procedure Set_Node2 (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field2 := Union_Id (Val);
end Set_Node2;
procedure Set_Node3 (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field3 := Union_Id (Val);
end Set_Node3;
procedure Set_Node4 (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field4 := Union_Id (Val);
end Set_Node4;
procedure Set_Node5 (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field5 := Union_Id (Val);
end Set_Node5;
Nodes.Table (N + 4).Field9 := Union_Id (Val);
end Set_Node27;
+ procedure Set_Node28 (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field10 := Union_Id (Val);
+ end Set_Node28;
+
procedure Set_List1 (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field1 := Union_Id (Val);
end Set_List1;
procedure Set_List2 (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field2 := Union_Id (Val);
end Set_List2;
procedure Set_List3 (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field3 := Union_Id (Val);
end Set_List3;
procedure Set_List4 (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field4 := Union_Id (Val);
end Set_List4;
procedure Set_List5 (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field5 := Union_Id (Val);
end Set_List5;
Nodes.Table (N + 2).Field7 := Union_Id (Val);
end Set_List14;
+ procedure Set_Elist1 (N : Node_Id; Val : Elist_Id) is
+ begin
+ Nodes.Table (N).Field1 := Union_Id (Val);
+ end Set_Elist1;
+
procedure Set_Elist2 (N : Node_Id; Val : Elist_Id) is
begin
Nodes.Table (N).Field2 := Union_Id (Val);
Nodes.Table (N + 3).Field10 := Union_Id (Val);
end Set_Elist23;
- procedure Set_Elist24 (N : Node_Id; Val : Elist_Id) is
+ procedure Set_Elist25 (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;
+ 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 in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field1 := Union_Id (Val);
end Set_Name1;
procedure Set_Name2 (N : Node_Id; Val : Name_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field2 := Union_Id (Val);
end Set_Name2;
procedure Set_Str3 (N : Node_Id; Val : String_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field3 := Union_Id (Val);
end Set_Str3;
procedure Set_Uint2 (N : Node_Id; Val : Uint) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field2 := To_Union (Val);
end Set_Uint2;
procedure Set_Uint3 (N : Node_Id; Val : Uint) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field3 := To_Union (Val);
end Set_Uint3;
procedure Set_Uint4 (N : Node_Id; Val : Uint) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field4 := To_Union (Val);
end Set_Uint4;
procedure Set_Uint5 (N : Node_Id; Val : Uint) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field5 := To_Union (Val);
end Set_Uint5;
procedure Set_Ureal3 (N : Node_Id; Val : Ureal) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Field3 := To_Union (Val);
end Set_Ureal3;
procedure Set_Flag4 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag4 := Val;
end Set_Flag4;
procedure Set_Flag5 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag5 := Val;
end Set_Flag5;
procedure Set_Flag6 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag6 := Val;
end Set_Flag6;
procedure Set_Flag7 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag7 := Val;
end Set_Flag7;
procedure Set_Flag8 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag8 := Val;
end Set_Flag8;
procedure Set_Flag9 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag9 := Val;
end Set_Flag9;
procedure Set_Flag10 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag10 := Val;
end Set_Flag10;
procedure Set_Flag11 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag11 := Val;
end Set_Flag11;
procedure Set_Flag12 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag12 := Val;
end Set_Flag12;
procedure Set_Flag13 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag13 := Val;
end Set_Flag13;
procedure Set_Flag14 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag14 := Val;
end Set_Flag14;
procedure Set_Flag15 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag15 := Val;
end Set_Flag15;
procedure Set_Flag16 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag16 := Val;
end Set_Flag16;
procedure Set_Flag17 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag17 := Val;
end Set_Flag17;
procedure Set_Flag18 (N : Node_Id; Val : Boolean) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
Nodes.Table (N).Flag18 := Val;
end Set_Flag18;
(Nodes.Table (N + 4).Field11'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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ end Set_Flag230;
+
+ procedure Set_Flag231 (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)).Flag231 := Val;
+ end Set_Flag231;
+
+ procedure Set_Flag232 (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)).Flag232 := Val;
+ end Set_Flag232;
+
+ procedure Set_Flag233 (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)).Flag233 := Val;
+ end Set_Flag233;
+
+ procedure Set_Flag234 (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)).Flag234 := Val;
+ end Set_Flag234;
+
+ procedure Set_Flag235 (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)).Flag235 := Val;
+ end Set_Flag235;
+
+ procedure Set_Flag236 (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)).Flag236 := Val;
+ end Set_Flag236;
+
+ procedure Set_Flag237 (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)).Flag237 := Val;
+ end Set_Flag237;
+
+ procedure Set_Flag238 (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)).Flag238 := Val;
+ end Set_Flag238;
+
+ procedure Set_Flag239 (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)).Flag239 := Val;
+ end Set_Flag239;
+
+ procedure Set_Flag240 (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)).Flag240 := Val;
+ end Set_Flag240;
+
+ procedure Set_Flag241 (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)).Flag241 := Val;
+ end Set_Flag241;
+
+ procedure Set_Flag242 (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)).Flag242 := Val;
+ end Set_Flag242;
+
+ procedure Set_Flag243 (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)).Flag243 := Val;
+ end Set_Flag243;
+
+ procedure Set_Flag244 (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)).Flag244 := Val;
+ end Set_Flag244;
+
+ procedure Set_Flag245 (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)).Flag245 := Val;
+ end Set_Flag245;
+
+ procedure Set_Flag246 (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)).Flag246 := Val;
+ end Set_Flag246;
+
+ procedure Set_Flag247 (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)).Flag247 := Val;
+ end Set_Flag247;
+
procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
- if Val > Error then Set_Parent (Val, N); end if;
+ pragma Assert (N <= Nodes.Last);
+
+ if Val > Error then
+ Set_Parent (N => Val, Val => N);
+ end if;
+
Set_Node1 (N, Val);
end Set_Node1_With_Parent;
procedure Set_Node2_With_Parent (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
- if Val > Error then Set_Parent (Val, N); end if;
+ pragma Assert (N <= Nodes.Last);
+
+ if Val > Error then
+ Set_Parent (N => Val, Val => N);
+ end if;
+
Set_Node2 (N, Val);
end Set_Node2_With_Parent;
procedure Set_Node3_With_Parent (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
- if Val > Error then Set_Parent (Val, N); end if;
+ pragma Assert (N <= Nodes.Last);
+
+ if Val > Error then
+ Set_Parent (N => Val, Val => N);
+ end if;
+
Set_Node3 (N, Val);
end Set_Node3_With_Parent;
procedure Set_Node4_With_Parent (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
- if Val > Error then Set_Parent (Val, N); end if;
+ pragma Assert (N <= Nodes.Last);
+
+ if Val > Error then
+ Set_Parent (N => Val, Val => N);
+ end if;
+
Set_Node4 (N, Val);
end Set_Node4_With_Parent;
procedure Set_Node5_With_Parent (N : Node_Id; Val : Node_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
- if Val > Error then Set_Parent (Val, N); end if;
+ pragma Assert (N <= Nodes.Last);
+
+ if Val > Error then
+ Set_Parent (N => Val, Val => N);
+ end if;
+
Set_Node5 (N, Val);
end Set_Node5_With_Parent;
procedure Set_List1_With_Parent (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
if Val /= No_List and then Val /= Error_List then
Set_Parent (Val, N);
end if;
procedure Set_List2_With_Parent (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
if Val /= No_List and then Val /= Error_List then
Set_Parent (Val, N);
end if;
procedure Set_List3_With_Parent (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
if Val /= No_List and then Val /= Error_List then
Set_Parent (Val, N);
end if;
procedure Set_List4_With_Parent (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
if Val /= No_List and then Val /= Error_List then
Set_Parent (Val, N);
end if;
procedure Set_List5_With_Parent (N : Node_Id; Val : List_Id) is
begin
- pragma Assert (N in Nodes.First .. Nodes.Last);
+ pragma Assert (N <= Nodes.Last);
if Val /= No_List and then Val /= Error_List then
Set_Parent (Val, N);
end if;
end Unchecked_Access;
+ ------------
+ -- Unlock --
+ ------------
+
+ procedure Unlock is
+ begin
+ Nodes.Locked := False;
+ Orig_Nodes.Locked := False;
+ end Unlock;
+
end Atree;