aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.4.3/gcc/ada/elists.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.4.3/gcc/ada/elists.adb')
-rw-r--r--gcc-4.4.3/gcc/ada/elists.adb493
1 files changed, 0 insertions, 493 deletions
diff --git a/gcc-4.4.3/gcc/ada/elists.adb b/gcc-4.4.3/gcc/ada/elists.adb
deleted file mode 100644
index c520b679c..000000000
--- a/gcc-4.4.3/gcc/ada/elists.adb
+++ /dev/null
@@ -1,493 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- E L I S T S --
--- --
--- B o d y --
--- --
--- 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 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;