------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- E L I S T S -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2004 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- -- -- 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. -- -- -- -- 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. -- -- -- -- 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, 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_Id; Next : Union_Id; end record; package Elmts is new Table.Table ( Table_Component_Type => Elmt_Item, Table_Index_Type => Elmt_Id, Table_Low_Bound => First_Elmt_Id, Table_Initial => Alloc.Elmts_Initial, Table_Increment => Alloc.Elmts_Increment, Table_Name => "Elmts"); ----------------- -- Append_Elmt -- ----------------- procedure Append_Elmt (Node : Node_Id; To : Elist_Id) is L : constant Elmt_Id := Elists.Table (To).Last; begin Elmts.Increment_Last; Elmts.Table (Elmts.Last).Node := Node; 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_Id = "); Write_Int (Int (Node)); Write_Eol; end if; end Append_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 (Node : Node_Id; Elmt : Elmt_Id) is N : constant Union_Id := Elmts.Table (Elmt).Next; begin pragma Assert (Elmt /= No_Elmt); Elmts.Increment_Last; Elmts.Table (Elmts.Last).Node := Node; Elmts.Table (Elmts.Last).Next := N; Elmts.Table (Elmt).Next := Union_Id (Elmts.Last); if N in Elist_Range then Elists.Table (Elist_Id (N)).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_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 (Node : Node_Id; To : Elist_Id) is F : constant Elmt_Id := Elists.Table (To).First; begin Elmts.Increment_Last; Elmts.Table (Elmts.Last).Node := Node; 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_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; end Elists;