blob: 6d1b8ca4b291b98f9a32708cd26502d1d4217893 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- E L I S T S --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2001 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;