OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [elists.adb] - Blame information for rev 283

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

Line No. Rev Author Line
1 281 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-2009, 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
 
393
         pragma Assert (Nxt = Elmt);
394
 
395
         Elists.Table (List).First := No_Elmt;
396
         Elists.Table (List).Last  := No_Elmt;
397
 
398
      --  Case of removing the first element in the list
399
 
400
      elsif Nxt = Elmt then
401
         Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next);
402
 
403
      --  Case of removing second or later element in the list
404
 
405
      else
406
         loop
407
            Prv := Nxt;
408
            Nxt := Elmt_Id (Elmts.Table (Prv).Next);
409
            exit when Nxt = Elmt
410
              or else Elmts.Table (Nxt).Next in Elist_Range;
411
         end loop;
412
 
413
         pragma Assert (Nxt = Elmt);
414
 
415
         Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;
416
 
417
         if Elmts.Table (Prv).Next in Elist_Range then
418
            Elists.Table (List).Last := Prv;
419
         end if;
420
      end if;
421
   end Remove_Elmt;
422
 
423
   ----------------------
424
   -- Remove_Last_Elmt --
425
   ----------------------
426
 
427
   procedure Remove_Last_Elmt (List : Elist_Id) is
428
      Nxt : Elmt_Id;
429
      Prv : Elmt_Id;
430
 
431
   begin
432
      Nxt := Elists.Table (List).First;
433
 
434
      --  Case of removing only element in the list
435
 
436
      if Elmts.Table (Nxt).Next in Elist_Range then
437
         Elists.Table (List).First := No_Elmt;
438
         Elists.Table (List).Last  := No_Elmt;
439
 
440
      --  Case of at least two elements in list
441
 
442
      else
443
         loop
444
            Prv := Nxt;
445
            Nxt := Elmt_Id (Elmts.Table (Prv).Next);
446
            exit when Elmts.Table (Nxt).Next in Elist_Range;
447
         end loop;
448
 
449
         Elmts.Table (Prv).Next   := Elmts.Table (Nxt).Next;
450
         Elists.Table (List).Last := Prv;
451
      end if;
452
   end Remove_Last_Elmt;
453
 
454
   ------------------
455
   -- Replace_Elmt --
456
   ------------------
457
 
458
   procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is
459
   begin
460
      Elmts.Table (Elmt).Node := New_Node;
461
   end Replace_Elmt;
462
 
463
   ---------------
464
   -- Tree_Read --
465
   ---------------
466
 
467
   procedure Tree_Read is
468
   begin
469
      Elists.Tree_Read;
470
      Elmts.Tree_Read;
471
   end Tree_Read;
472
 
473
   ----------------
474
   -- Tree_Write --
475
   ----------------
476
 
477
   procedure Tree_Write is
478
   begin
479
      Elists.Tree_Write;
480
      Elmts.Tree_Write;
481
   end Tree_Write;
482
 
483
   ------------
484
   -- Unlock --
485
   ------------
486
 
487
   procedure Unlock is
488
   begin
489
      Elists.Locked := False;
490
      Elmts.Locked := False;
491
   end Unlock;
492
 
493
end Elists;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.