URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [elists.adb] - Blame information for rev 720

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               E L I S T S                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2010, 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 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.                                     --
--                                                                          --
-- 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.      --
--                                                                          --
------------------------------------------------------------------------------
 
--  WARNING: There is a C version of this package. Any changes to this
--  source file must be properly reflected in the C header a-elists.h.
 
with Alloc;
with Debug;  use Debug;
with Output; use Output;
with Table;
 
package body Elists is
 
   -------------------------------------
   -- Implementation of Element Lists --
   -------------------------------------
 
   --  Element lists are composed of three types of entities. The element
   --  list header, which references the first and last elements of the
   --  list, the elements themselves which are singly linked and also
   --  reference the nodes on the list, and finally the nodes themselves.
   --  The following diagram shows how an element list is represented:
 
   --       +----------------------------------------------------+
   --       |  +------------------------------------------+      |
   --       |  |                                          |      |
   --       V  |                                          V      |
   --    +-----|--+    +-------+    +-------+         +-------+  |
   --    |  Elmt  |    |  1st  |    |  2nd  |         |  Last |  |
   --    |  List  |--->|  Elmt |--->|  Elmt  ---...-->|  Elmt ---+
   --    | Header |    |   |   |    |   |   |         |   |   |
   --    +--------+    +---|---+    +---|---+         +---|---+
   --                      |            |                 |
   --                      V            V                 V
   --                  +-------+    +-------+         +-------+
   --                  |       |    |       |         |       |
   --                  | Node1 |    | Node2 |         | Node3 |
   --                  |       |    |       |         |       |
   --                  +-------+    +-------+         +-------+
 
   --  The list header is an entry in the Elists table. The values used for
   --  the type Elist_Id are subscripts into this table. The First_Elmt field
   --  (Lfield1) points to the first element on the list, or to No_Elmt in the
   --  case of an empty list. Similarly the Last_Elmt field (Lfield2) points to
   --  the last element on the list or to No_Elmt in the case of an empty list.
 
   --  The elements themselves are entries in the Elmts table. The Next field
   --  of each entry points to the next element, or to the Elist header if this
   --  is the last item in the list. The Node field points to the node which
   --  is referenced by the corresponding list entry.
 
   -------------------------
   -- Element List Tables --
   -------------------------
 
   type Elist_Header is record
      First : Elmt_Id;
      Last  : Elmt_Id;
   end record;
 
   package Elists is new Table.Table (
     Table_Component_Type => Elist_Header,
     Table_Index_Type     => Elist_Id'Base,
     Table_Low_Bound      => First_Elist_Id,
     Table_Initial        => Alloc.Elists_Initial,
     Table_Increment      => Alloc.Elists_Increment,
     Table_Name           => "Elists");
 
   type Elmt_Item is record
      Node : Node_Or_Entity_Id;
      Next : Union_Id;
   end record;
 
   package Elmts is new Table.Table (
     Table_Component_Type => Elmt_Item,
     Table_Index_Type     => Elmt_Id'Base,
     Table_Low_Bound      => First_Elmt_Id,
     Table_Initial        => Alloc.Elmts_Initial,
     Table_Increment      => Alloc.Elmts_Increment,
     Table_Name           => "Elmts");
 
   -----------------
   -- Append_Elmt --
   -----------------
 
   procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
      L : constant Elmt_Id := Elists.Table (To).Last;
 
   begin
      Elmts.Increment_Last;
      Elmts.Table (Elmts.Last).Node := N;
      Elmts.Table (Elmts.Last).Next := Union_Id (To);
 
      if L = No_Elmt then
         Elists.Table (To).First := Elmts.Last;
      else
         Elmts.Table (L).Next := Union_Id (Elmts.Last);
      end if;
 
      Elists.Table (To).Last  := Elmts.Last;
 
      if Debug_Flag_N then
         Write_Str ("Append new element Elmt_Id = ");
         Write_Int (Int (Elmts.Last));
         Write_Str (" to list Elist_Id = ");
         Write_Int (Int (To));
         Write_Str (" referencing Node_Or_Entity_Id = ");
         Write_Int (Int (N));
         Write_Eol;
      end if;
   end Append_Elmt;
 
   ------------------------
   -- Append_Unique_Elmt --
   ------------------------
 
   procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
      Elmt : Elmt_Id;
   begin
      Elmt := First_Elmt (To);
      loop
         if No (Elmt) then
            Append_Elmt (N, To);
            return;
         elsif Node (Elmt) = N then
            return;
         else
            Next_Elmt (Elmt);
         end if;
      end loop;
   end Append_Unique_Elmt;
 
   --------------------
   -- Elists_Address --
   --------------------
 
   function Elists_Address return System.Address is
   begin
      return Elists.Table (First_Elist_Id)'Address;
   end Elists_Address;
 
   -------------------
   -- Elmts_Address --
   -------------------
 
   function Elmts_Address return System.Address is
   begin
      return Elmts.Table (First_Elmt_Id)'Address;
   end Elmts_Address;
 
   ----------------
   -- First_Elmt --
   ----------------
 
   function First_Elmt (List : Elist_Id) return Elmt_Id is
   begin
      pragma Assert (List > Elist_Low_Bound);
      return Elists.Table (List).First;
   end First_Elmt;
 
   ----------------
   -- Initialize --
   ----------------
 
   procedure Initialize is
   begin
      Elists.Init;
      Elmts.Init;
   end Initialize;
 
   -----------------------
   -- Insert_Elmt_After --
   -----------------------
 
   procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is
      Nxt : constant Union_Id := Elmts.Table (Elmt).Next;
 
   begin
      pragma Assert (Elmt /= No_Elmt);
 
      Elmts.Increment_Last;
      Elmts.Table (Elmts.Last).Node := N;
      Elmts.Table (Elmts.Last).Next := Nxt;
 
      Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);
 
      if Nxt in Elist_Range then
         Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last;
      end if;
   end Insert_Elmt_After;
 
   ------------------------
   -- Is_Empty_Elmt_List --
   ------------------------
 
   function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is
   begin
      return Elists.Table (List).First = No_Elmt;
   end Is_Empty_Elmt_List;
 
   -------------------
   -- Last_Elist_Id --
   -------------------
 
   function Last_Elist_Id return Elist_Id is
   begin
      return Elists.Last;
   end Last_Elist_Id;
 
   ---------------
   -- Last_Elmt --
   ---------------
 
   function Last_Elmt (List : Elist_Id) return Elmt_Id is
   begin
      return Elists.Table (List).Last;
   end Last_Elmt;
 
   ------------------
   -- Last_Elmt_Id --
   ------------------
 
   function Last_Elmt_Id return Elmt_Id is
   begin
      return Elmts.Last;
   end Last_Elmt_Id;
 
   ----------
   -- Lock --
   ----------
 
   procedure Lock is
   begin
      Elists.Locked := True;
      Elmts.Locked := True;
      Elists.Release;
      Elmts.Release;
   end Lock;
 
   -------------------
   -- New_Elmt_List --
   -------------------
 
   function New_Elmt_List return Elist_Id is
   begin
      Elists.Increment_Last;
      Elists.Table (Elists.Last).First := No_Elmt;
      Elists.Table (Elists.Last).Last  := No_Elmt;
 
      if Debug_Flag_N then
         Write_Str ("Allocate new element list, returned ID = ");
         Write_Int (Int (Elists.Last));
         Write_Eol;
      end if;
 
      return Elists.Last;
   end New_Elmt_List;
 
   ---------------
   -- Next_Elmt --
   ---------------
 
   function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is
      N : constant Union_Id := Elmts.Table (Elmt).Next;
 
   begin
      if N in Elist_Range then
         return No_Elmt;
      else
         return Elmt_Id (N);
      end if;
   end Next_Elmt;
 
   procedure Next_Elmt (Elmt : in out Elmt_Id) is
   begin
      Elmt := Next_Elmt (Elmt);
   end Next_Elmt;
 
   --------
   -- No --
   --------
 
   function No (List : Elist_Id) return Boolean is
   begin
      return List = No_Elist;
   end No;
 
   function No (Elmt : Elmt_Id) return Boolean is
   begin
      return Elmt = No_Elmt;
   end No;
 
   ----------
   -- Node --
   ----------
 
   function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is
   begin
      if Elmt = No_Elmt then
         return Empty;
      else
         return Elmts.Table (Elmt).Node;
      end if;
   end Node;
 
   ----------------
   -- Num_Elists --
   ----------------
 
   function Num_Elists return Nat is
   begin
      return Int (Elmts.Last) - Int (Elmts.First) + 1;
   end Num_Elists;
 
   ------------------
   -- Prepend_Elmt --
   ------------------
 
   procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
      F : constant Elmt_Id := Elists.Table (To).First;
 
   begin
      Elmts.Increment_Last;
      Elmts.Table (Elmts.Last).Node := N;
 
      if F = No_Elmt then
         Elists.Table (To).Last := Elmts.Last;
         Elmts.Table (Elmts.Last).Next := Union_Id (To);
      else
         Elmts.Table (Elmts.Last).Next := Union_Id (F);
      end if;
 
      Elists.Table (To).First  := Elmts.Last;
   end Prepend_Elmt;
 
   -------------
   -- Present --
   -------------
 
   function Present (List : Elist_Id) return Boolean is
   begin
      return List /= No_Elist;
   end Present;
 
   function Present (Elmt : Elmt_Id) return Boolean is
   begin
      return Elmt /= No_Elmt;
   end Present;
 
   -----------------
   -- Remove_Elmt --
   -----------------
 
   procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is
      Nxt : Elmt_Id;
      Prv : Elmt_Id;
 
   begin
      Nxt := Elists.Table (List).First;
 
      --  Case of removing only element in the list
 
      if Elmts.Table (Nxt).Next in Elist_Range then
         pragma Assert (Nxt = Elmt);
 
         Elists.Table (List).First := No_Elmt;
         Elists.Table (List).Last  := No_Elmt;
 
      --  Case of removing the first element in the list
 
      elsif Nxt = Elmt then
         Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next);
 
      --  Case of removing second or later element in the list
 
      else
         loop
            Prv := Nxt;
            Nxt := Elmt_Id (Elmts.Table (Prv).Next);
            exit when Nxt = Elmt
              or else Elmts.Table (Nxt).Next in Elist_Range;
         end loop;
 
         pragma Assert (Nxt = Elmt);
 
         Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;
 
         if Elmts.Table (Prv).Next in Elist_Range then
            Elists.Table (List).Last := Prv;
         end if;
      end if;
   end Remove_Elmt;
 
   ----------------------
   -- Remove_Last_Elmt --
   ----------------------
 
   procedure Remove_Last_Elmt (List : Elist_Id) is
      Nxt : Elmt_Id;
      Prv : Elmt_Id;
 
   begin
      Nxt := Elists.Table (List).First;
 
      --  Case of removing only element in the list
 
      if Elmts.Table (Nxt).Next in Elist_Range then
         Elists.Table (List).First := No_Elmt;
         Elists.Table (List).Last  := No_Elmt;
 
      --  Case of at least two elements in list
 
      else
         loop
            Prv := Nxt;
            Nxt := Elmt_Id (Elmts.Table (Prv).Next);
            exit when Elmts.Table (Nxt).Next in Elist_Range;
         end loop;
 
         Elmts.Table (Prv).Next   := Elmts.Table (Nxt).Next;
         Elists.Table (List).Last := Prv;
      end if;
   end Remove_Last_Elmt;
 
   ------------------
   -- Replace_Elmt --
   ------------------
 
   procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is
   begin
      Elmts.Table (Elmt).Node := New_Node;
   end Replace_Elmt;
 
   ---------------
   -- Tree_Read --
   ---------------
 
   procedure Tree_Read is
   begin
      Elists.Tree_Read;
      Elmts.Tree_Read;
   end Tree_Read;
 
   ----------------
   -- Tree_Write --
   ----------------
 
   procedure Tree_Write is
   begin
      Elists.Tree_Write;
      Elmts.Tree_Write;
   end Tree_Write;
 
   ------------
   -- Unlock --
   ------------
 
   procedure Unlock is
   begin
      Elists.Locked := False;
      Elmts.Locked := False;
   end Unlock;
 
end Elists;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [elists.adb] - Blame information for rev 720

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT COMPILER COMPONENTS --`
4			`-- --`
5			`-- E L I S T S --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
13			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
14			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
15			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
16			`-- or FITNESS FOR A PARTICULAR PURPOSE. --`
17			`-- --`
18			`-- As a special exception under Section 7 of GPL version 3, you are granted --`
19			`-- additional permissions described in the GCC Runtime Library Exception, --`
20			`-- version 3.1, as published by the Free Software Foundation. --`
21			`-- --`
22			`-- You should have received a copy of the GNU General Public License and --`
23			`-- a copy of the GCC Runtime Library Exception along with this program; --`
24			`-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --`
25			`-- <http://www.gnu.org/licenses/>. --`
26			`-- --`
27			`-- GNAT was originally developed by the GNAT team at New York University. --`
28			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
29			`-- --`
30			`------------------------------------------------------------------------------`
31
32			`-- WARNING: There is a C version of this package. Any changes to this`
33			`-- source file must be properly reflected in the C header a-elists.h.`
34
35			`with Alloc;`
36			`with Debug; use Debug;`
37			`with Output; use Output;`
38			`with Table;`
39
40			`package body Elists is`
41
42			`-------------------------------------`
43			`-- Implementation of Element Lists --`
44			`-------------------------------------`
45
46			`-- Element lists are composed of three types of entities. The element`
47			`-- list header, which references the first and last elements of the`
48			`-- list, the elements themselves which are singly linked and also`
49			`-- reference the nodes on the list, and finally the nodes themselves.`
50			`-- The following diagram shows how an element list is represented:`
51
52			`-- +----------------------------------------------------+`
53			`-- \| +------------------------------------------+ \|`
54			`-- \| \| \| \|`
55			`-- V \| V \|`
56			`-- +-----\|--+ +-------+ +-------+ +-------+ \|`
57			`-- \| Elmt \| \| 1st \| \| 2nd \| \| Last \| \|`
58			`-- \| List \|--->\| Elmt \|--->\| Elmt ---...-->\| Elmt ---+`
59			`-- \| Header \| \| \| \| \| \| \| \| \| \|`
60			`-- +--------+ +---\|---+ +---\|---+ +---\|---+`
61			`-- \| \| \|`
62			`-- V V V`
63			`-- +-------+ +-------+ +-------+`
64			`-- \| \| \| \| \| \|`
65			`-- \| Node1 \| \| Node2 \| \| Node3 \|`
66			`-- \| \| \| \| \| \|`
67			`-- +-------+ +-------+ +-------+`
68
69			`-- The list header is an entry in the Elists table. The values used for`
70			`-- the type Elist_Id are subscripts into this table. The First_Elmt field`
71			`-- (Lfield1) points to the first element on the list, or to No_Elmt in the`
72			`-- case of an empty list. Similarly the Last_Elmt field (Lfield2) points to`
73			`-- the last element on the list or to No_Elmt in the case of an empty list.`
74
75			`-- The elements themselves are entries in the Elmts table. The Next field`
76			`-- of each entry points to the next element, or to the Elist header if this`
77			`-- is the last item in the list. The Node field points to the node which`
78			`-- is referenced by the corresponding list entry.`
79
80			`-------------------------`
81			`-- Element List Tables --`
82			`-------------------------`
83
84			`type Elist_Header is record`
85			`First : Elmt_Id;`
86			`Last : Elmt_Id;`
87			`end record;`
88
89			`package Elists is new Table.Table (`
90			`Table_Component_Type => Elist_Header,`
91			`Table_Index_Type => Elist_Id'Base,`
92			`Table_Low_Bound => First_Elist_Id,`
93			`Table_Initial => Alloc.Elists_Initial,`
94			`Table_Increment => Alloc.Elists_Increment,`
95			`Table_Name => "Elists");`
96
97			`type Elmt_Item is record`
98			`Node : Node_Or_Entity_Id;`
99			`Next : Union_Id;`
100			`end record;`
101
102			`package Elmts is new Table.Table (`
103			`Table_Component_Type => Elmt_Item,`
104			`Table_Index_Type => Elmt_Id'Base,`
105			`Table_Low_Bound => First_Elmt_Id,`
106			`Table_Initial => Alloc.Elmts_Initial,`
107			`Table_Increment => Alloc.Elmts_Increment,`
108			`Table_Name => "Elmts");`
109
110			`-----------------`
111			`-- Append_Elmt --`
112			`-----------------`
113
114			`procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is`
115			`L : constant Elmt_Id := Elists.Table (To).Last;`
116
117			`begin`
118			`Elmts.Increment_Last;`
119			`Elmts.Table (Elmts.Last).Node := N;`
120			`Elmts.Table (Elmts.Last).Next := Union_Id (To);`
121
122			`if L = No_Elmt then`
123			`Elists.Table (To).First := Elmts.Last;`
124			`else`
125			`Elmts.Table (L).Next := Union_Id (Elmts.Last);`
126			`end if;`
127
128			`Elists.Table (To).Last := Elmts.Last;`
129
130			`if Debug_Flag_N then`
131			`Write_Str ("Append new element Elmt_Id = ");`
132			`Write_Int (Int (Elmts.Last));`
133			`Write_Str (" to list Elist_Id = ");`
134			`Write_Int (Int (To));`
135			`Write_Str (" referencing Node_Or_Entity_Id = ");`
136			`Write_Int (Int (N));`
137			`Write_Eol;`
138			`end if;`
139			`end Append_Elmt;`
140
141			`------------------------`
142			`-- Append_Unique_Elmt --`
143			`------------------------`
144
145			`procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is`
146			`Elmt : Elmt_Id;`
147			`begin`
148			`Elmt := First_Elmt (To);`
149			`loop`
150			`if No (Elmt) then`
151			`Append_Elmt (N, To);`
152			`return;`
153			`elsif Node (Elmt) = N then`
154			`return;`
155			`else`
156			`Next_Elmt (Elmt);`
157			`end if;`
158			`end loop;`
159			`end Append_Unique_Elmt;`
160
161			`--------------------`
162			`-- Elists_Address --`
163			`--------------------`
164
165			`function Elists_Address return System.Address is`
166			`begin`
167			`return Elists.Table (First_Elist_Id)'Address;`
168			`end Elists_Address;`
169
170			`-------------------`
171			`-- Elmts_Address --`
172			`-------------------`
173
174			`function Elmts_Address return System.Address is`
175			`begin`
176			`return Elmts.Table (First_Elmt_Id)'Address;`
177			`end Elmts_Address;`
178
179			`----------------`
180			`-- First_Elmt --`
181			`----------------`
182
183			`function First_Elmt (List : Elist_Id) return Elmt_Id is`
184			`begin`
185			`pragma Assert (List > Elist_Low_Bound);`
186			`return Elists.Table (List).First;`
187			`end First_Elmt;`
188
189			`----------------`
190			`-- Initialize --`
191			`----------------`
192
193			`procedure Initialize is`
194			`begin`
195			`Elists.Init;`
196			`Elmts.Init;`
197			`end Initialize;`
198
199			`-----------------------`
200			`-- Insert_Elmt_After --`
201			`-----------------------`
202
203			`procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is`
204			`Nxt : constant Union_Id := Elmts.Table (Elmt).Next;`
205
206			`begin`
207			`pragma Assert (Elmt /= No_Elmt);`
208
209			`Elmts.Increment_Last;`
210			`Elmts.Table (Elmts.Last).Node := N;`
211			`Elmts.Table (Elmts.Last).Next := Nxt;`
212
213			`Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);`
214
215			`if Nxt in Elist_Range then`
216			`Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last;`
217			`end if;`
218			`end Insert_Elmt_After;`
219
220			`------------------------`
221			`-- Is_Empty_Elmt_List --`
222			`------------------------`
223
224			`function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is`
225			`begin`
226			`return Elists.Table (List).First = No_Elmt;`
227			`end Is_Empty_Elmt_List;`
228
229			`-------------------`
230			`-- Last_Elist_Id --`
231			`-------------------`
232
233			`function Last_Elist_Id return Elist_Id is`
234			`begin`
235			`return Elists.Last;`
236			`end Last_Elist_Id;`
237
238			`---------------`
239			`-- Last_Elmt --`
240			`---------------`
241
242			`function Last_Elmt (List : Elist_Id) return Elmt_Id is`
243			`begin`
244			`return Elists.Table (List).Last;`
245			`end Last_Elmt;`
246
247			`------------------`
248			`-- Last_Elmt_Id --`
249			`------------------`
250
251			`function Last_Elmt_Id return Elmt_Id is`
252			`begin`
253			`return Elmts.Last;`
254			`end Last_Elmt_Id;`
255
256			`----------`
257			`-- Lock --`
258			`----------`
259
260			`procedure Lock is`
261			`begin`
262			`Elists.Locked := True;`
263			`Elmts.Locked := True;`
264			`Elists.Release;`
265			`Elmts.Release;`
266			`end Lock;`
267
268			`-------------------`
269			`-- New_Elmt_List --`
270			`-------------------`
271
272			`function New_Elmt_List return Elist_Id is`
273			`begin`
274			`Elists.Increment_Last;`
275			`Elists.Table (Elists.Last).First := No_Elmt;`
276			`Elists.Table (Elists.Last).Last := No_Elmt;`
277
278			`if Debug_Flag_N then`
279			`Write_Str ("Allocate new element list, returned ID = ");`
280			`Write_Int (Int (Elists.Last));`
281			`Write_Eol;`
282			`end if;`
283
284			`return Elists.Last;`
285			`end New_Elmt_List;`
286
287			`---------------`
288			`-- Next_Elmt --`
289			`---------------`
290
291			`function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is`
292			`N : constant Union_Id := Elmts.Table (Elmt).Next;`
293
294			`begin`
295			`if N in Elist_Range then`
296			`return No_Elmt;`
297			`else`
298			`return Elmt_Id (N);`
299			`end if;`
300			`end Next_Elmt;`
301
302			`procedure Next_Elmt (Elmt : in out Elmt_Id) is`
303			`begin`
304			`Elmt := Next_Elmt (Elmt);`
305			`end Next_Elmt;`
306
307			`--------`
308			`-- No --`
309			`--------`
310
311			`function No (List : Elist_Id) return Boolean is`
312			`begin`
313			`return List = No_Elist;`
314			`end No;`
315
316			`function No (Elmt : Elmt_Id) return Boolean is`
317			`begin`
318			`return Elmt = No_Elmt;`
319			`end No;`
320
321			`----------`
322			`-- Node --`
323			`----------`
324
325			`function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is`
326			`begin`
327			`if Elmt = No_Elmt then`
328			`return Empty;`
329			`else`
330			`return Elmts.Table (Elmt).Node;`
331			`end if;`
332			`end Node;`
333
334			`----------------`
335			`-- Num_Elists --`
336			`----------------`
337
338			`function Num_Elists return Nat is`
339			`begin`
340			`return Int (Elmts.Last) - Int (Elmts.First) + 1;`
341			`end Num_Elists;`
342
343			`------------------`
344			`-- Prepend_Elmt --`
345			`------------------`
346
347			`procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is`
348			`F : constant Elmt_Id := Elists.Table (To).First;`
349
350			`begin`
351			`Elmts.Increment_Last;`
352			`Elmts.Table (Elmts.Last).Node := N;`
353
354			`if F = No_Elmt then`
355			`Elists.Table (To).Last := Elmts.Last;`
356			`Elmts.Table (Elmts.Last).Next := Union_Id (To);`
357			`else`
358			`Elmts.Table (Elmts.Last).Next := Union_Id (F);`
359			`end if;`
360
361			`Elists.Table (To).First := Elmts.Last;`
362			`end Prepend_Elmt;`
363
364			`-------------`
365			`-- Present --`
366			`-------------`
367
368			`function Present (List : Elist_Id) return Boolean is`
369			`begin`
370			`return List /= No_Elist;`
371			`end Present;`
372
373			`function Present (Elmt : Elmt_Id) return Boolean is`
374			`begin`
375			`return Elmt /= No_Elmt;`
376			`end Present;`
377
378			`-----------------`
379			`-- Remove_Elmt --`
380			`-----------------`
381
382			`procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is`
383			`Nxt : Elmt_Id;`
384			`Prv : Elmt_Id;`
385
386			`begin`
387			`Nxt := Elists.Table (List).First;`
388
389			`-- Case of removing only element in the list`
390
391			`if Elmts.Table (Nxt).Next in Elist_Range then`
392			`pragma Assert (Nxt = Elmt);`
393
394			`Elists.Table (List).First := No_Elmt;`
395			`Elists.Table (List).Last := No_Elmt;`
396
397			`-- Case of removing the first element in the list`
398
399			`elsif Nxt = Elmt then`
400			`Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next);`
401
402			`-- Case of removing second or later element in the list`
403
404			`else`
405			`loop`
406			`Prv := Nxt;`
407			`Nxt := Elmt_Id (Elmts.Table (Prv).Next);`
408			`exit when Nxt = Elmt`
409			`or else Elmts.Table (Nxt).Next in Elist_Range;`
410			`end loop;`
411
412			`pragma Assert (Nxt = Elmt);`
413
414			`Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;`
415
416			`if Elmts.Table (Prv).Next in Elist_Range then`
417			`Elists.Table (List).Last := Prv;`
418			`end if;`
419			`end if;`
420			`end Remove_Elmt;`
421
422			`----------------------`
423			`-- Remove_Last_Elmt --`
424			`----------------------`
425
426			`procedure Remove_Last_Elmt (List : Elist_Id) is`
427			`Nxt : Elmt_Id;`
428			`Prv : Elmt_Id;`
429
430			`begin`
431			`Nxt := Elists.Table (List).First;`
432
433			`-- Case of removing only element in the list`
434
435			`if Elmts.Table (Nxt).Next in Elist_Range then`
436			`Elists.Table (List).First := No_Elmt;`
437			`Elists.Table (List).Last := No_Elmt;`
438
439			`-- Case of at least two elements in list`
440
441			`else`
442			`loop`
443			`Prv := Nxt;`
444			`Nxt := Elmt_Id (Elmts.Table (Prv).Next);`
445			`exit when Elmts.Table (Nxt).Next in Elist_Range;`
446			`end loop;`
447
448			`Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;`
449			`Elists.Table (List).Last := Prv;`
450			`end if;`
451			`end Remove_Last_Elmt;`
452
453			`------------------`
454			`-- Replace_Elmt --`
455			`------------------`
456
457			`procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is`
458			`begin`
459			`Elmts.Table (Elmt).Node := New_Node;`
460			`end Replace_Elmt;`
461
462			`---------------`
463			`-- Tree_Read --`
464			`---------------`
465
466			`procedure Tree_Read is`
467			`begin`
468			`Elists.Tree_Read;`
469			`Elmts.Tree_Read;`
470			`end Tree_Read;`
471
472			`----------------`
473			`-- Tree_Write --`
474			`----------------`
475
476			`procedure Tree_Write is`
477			`begin`
478			`Elists.Tree_Write;`
479			`Elmts.Tree_Write;`
480			`end Tree_Write;`
481
482			`------------`
483			`-- Unlock --`
484			`------------`
485
486			`procedure Unlock is`
487			`begin`
488			`Elists.Locked := False;`
489			`Elmts.Locked := False;`
490			`end Unlock;`
491
492			`end Elists;`