aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl/flists.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl/flists.adb')
-rw-r--r--src/vhdl/flists.adb153
1 files changed, 153 insertions, 0 deletions
diff --git a/src/vhdl/flists.adb b/src/vhdl/flists.adb
new file mode 100644
index 000000000..481dc9bfd
--- /dev/null
+++ b/src/vhdl/flists.adb
@@ -0,0 +1,153 @@
+-- Fixed-length lists.
+-- Copyright (C) 2017 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL 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 General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GHDL; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with Tables;
+
+package body Flists is
+ -- Index of elements.
+ type El_Index_Type is new Nat32;
+
+ -- Describe an flist.
+ type Entry_Type is record
+ -- Index of the first element (in the element table).
+ Els : El_Index_Type;
+
+ -- Length of the list.
+ Len : Nat32;
+ end record;
+
+ -- Flists descriptors.
+ package Flistt is new Tables
+ (Table_Component_Type => Entry_Type,
+ Table_Index_Type => Flist_Type,
+ Table_Low_Bound => 4,
+ Table_Initial => 32);
+
+ -- Table of all elements.
+ package Els is new Tables
+ (Table_Component_Type => Node_Type,
+ Table_Index_Type => El_Index_Type,
+ Table_Low_Bound => 0,
+ Table_Initial => 128);
+
+ type Flist_Array is array (Natural range <>) of Flist_Type;
+
+ -- Linked list of free flist. For length less than the last index, the
+ -- index corresponds to the length. All free lists whose length is equal
+ -- or greater than the last index are grouped to the last index.
+ Free_Flists : Flist_Array (1 .. 16) := (others => Null_Flist);
+
+ -- Get the chain for a free flist. It is stored at the first element of
+ -- the list.
+ function Free_Next (Flist : Flist_Type) return Flist_Type is
+ begin
+ return Flist_Type (Els.Table (Flistt.Table (Flist).Els));
+ end Free_Next;
+
+ function Create_Flist (Len : Natural) return Flist_Type
+ is
+ pragma Assert (Len > 0);
+ Res : Flist_Type;
+ Prev : Flist_Type;
+ Next : Flist_Type;
+ begin
+ if Len >= Free_Flists'Last then
+ Res := Free_Flists (Free_Flists'Last);
+ Prev := Null_Flist;
+ while Res /= Null_Flist and Length (Res) /= Len loop
+ Prev := Res;
+ Res := Free_Next (Res);
+ end loop;
+ if Res /= Null_Flist then
+ Next := Free_Next (Res);
+ if Prev = Null_Flist then
+ Free_Flists (Free_Flists'Last) := Next;
+ else
+ Els.Table (Flistt.Table (Prev).Els) := Node_Type (Next);
+ end if;
+ end if;
+ else
+ Res := Free_Flists (Len);
+ if Res /= Null_Flist then
+ Free_Flists (Len) := Free_Next (Res);
+ end if;
+ end if;
+
+ if Res = Null_Flist then
+ Res := Flistt.Allocate (1);
+ Flistt.Table (Res) := (Els => Els.Allocate (Len),
+ Len => Nat32 (Len));
+ end if;
+
+ -- Clear the list.
+ declare
+ Idx : constant El_Index_Type := Flistt.Table (Res).Els;
+ begin
+ Els.Table (Idx .. Idx + El_Index_Type (Len) - 1) :=
+ (others => Null_Node);
+ end;
+
+ return Res;
+ end Create_Flist;
+
+ procedure Destroy_Flist (Flist : in out Flist_Type)
+ is
+ Len : constant Natural := Length (Flist);
+ Prev : Flist_Type;
+ begin
+ -- Prepend to the array of free flists.
+ if Len >= Free_Flists'Last then
+ Prev := Free_Flists (Free_Flists'Last);
+ Free_Flists (Free_Flists'Last) := Flist;
+ else
+ Prev := Free_Flists (Len);
+ Free_Flists (Len) := Flist;
+ end if;
+
+ Els.Table (Flistt.Table (Flist).Els) := Node_Type (Prev);
+ Flist := Null_Flist;
+ end Destroy_Flist;
+
+ function Flast (Flist : Flist_Type) return Natural is
+ begin
+ return Natural (Flistt.Table (Flist).Len - 1);
+ end Flast;
+
+ function Length (Flist : Flist_Type) return Natural is
+ begin
+ return Natural (Flistt.Table (Flist).Len);
+ end Length;
+
+ function Get_Nth_Element (Flist : Flist_Type; N : Natural) return Node_Type
+ is
+ E : Entry_Type renames Flistt.Table (Flist);
+ begin
+ if N >= Natural (E.Len) then
+ return Null_Node;
+ end if;
+ return Els.Table (E.Els + El_Index_Type (N));
+ end Get_Nth_Element;
+
+ procedure Set_Nth_Element (Flist : Flist_Type; N : Natural; V : Node_Type)
+ is
+ E : Entry_Type renames Flistt.Table (Flist);
+ begin
+ pragma Assert (N < Natural (E.Len));
+ Els.Table (E.Els + El_Index_Type (N)) := V;
+ end Set_Nth_Element;
+end Flists;