From f526c1f41a2f5a8a5f70ee33f82d9e6b84117142 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 9 May 2019 08:03:29 +0200 Subject: flists is now a generic package, add vhdl-flists --- src/flists.adb | 160 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 160 insertions(+) create mode 100644 src/flists.adb (limited to 'src/flists.adb') diff --git a/src/flists.adb b/src/flists.adb new file mode 100644 index 000000000..9759163bb --- /dev/null +++ b/src/flists.adb @@ -0,0 +1,160 @@ +-- 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 Int32; + + -- 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 => El_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 (0 .. 16) := (others => Null_Flist); + + -- Get the chain for a free flist for large length. 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 + Res : Flist_Type; + Prev : Flist_Type; + Next : Flist_Type; + begin + if Len >= Free_Flists'Last then + -- Large length. + Res := Free_Flists (Free_Flists'Last); + Prev := Null_Flist; + while Res /= Null_Flist and then 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) := El_Type (Next); + end if; + end if; + else + -- Small length. The Len field contains the next free list. + Res := Free_Flists (Len); + if Res /= Null_Flist then + Free_Flists (Len) := Flist_Type (Flistt.Table (Res).Len); + Flistt.Table (Res).Len := Nat32 (Len); + elsif Len = 0 then + -- Quick case for len = 0. + Res := Flistt.Allocate (1); + Flistt.Table (Res) := (Els => 0, Len => 0); + return 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 => 0); + 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; + + Els.Table (Flistt.Table (Flist).Els) := El_Type (Prev); + else + Prev := Free_Flists (Len); + Free_Flists (Len) := Flist; + + Flistt.Table (Flist).Len := Nat32 (Prev); + end if; + + Flist := Null_Flist; + end Destroy_Flist; + + function Flast (Flist : Flist_Type) return Integer is + begin + return Integer (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 El_Type + is + E : Entry_Type renames Flistt.Table (Flist); + begin + pragma Assert (N < Natural (E.Len)); + return Els.Table (E.Els + El_Index_Type (N)); + end Get_Nth_Element; + + procedure Set_Nth_Element (Flist : Flist_Type; N : Natural; V : El_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; -- cgit v1.2.3