Geek Gadgets 1

home *** CD-ROM | disk | FTP | other *** search

/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / elists.adb < prev next >

Wrap

Text File | 1996-09-28 | 12KB | 393 lines

------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- E L I S T S -- -- -- -- B o d y -- -- -- -- $Revision: 1.11 $ -- -- -- -- Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved -- -- -- -- The GNAT library is free software; you can redistribute it and/or modify -- -- it under terms of the GNU Library General Public License as published by -- -- the Free Software Foundation; either version 2, or (at your option) any -- -- later version. The GNAT library is distributed in the hope that it will -- -- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- -- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- -- Library General Public License for more details. You should have -- -- received a copy of the GNU Library General Public License along with -- -- the GNAT library; see the file COPYING.LIB. If not, write to the Free -- -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -- -- -- ------------------------------------------------------------------------------ -- 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; use 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_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_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; ------------------ -- 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; ----------------------- -- 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; -------------------- -- 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 return Elists.Table (List).First; end First_Elmt; ---------------- -- Initialize -- ---------------- procedure Initialize is begin Elists.Init; Elmts.Init; end Initialize; ------------------------ -- 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; ------------------- -- 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; -------- -- 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 return Elmts.Table (Elmt).Node; end Node; ---------------- -- Num_Elists -- ---------------- function Num_Elists return Nat is begin return Int (Elmts.Last) - Int (Elmts.First) + 1; end Num_Elists; ------------- -- 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_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;