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 ++++++++++++++++++++++++++++++++++++++++++++++ src/flists.ads | 52 +++++++++++++++ src/vhdl/flists.adb | 161 ----------------------------------------------- src/vhdl/flists.ads | 51 --------------- src/vhdl/vhdl-flists.ads | 21 +++++++ src/vhdl/vhdl-nodes.ads | 2 +- 6 files changed, 234 insertions(+), 213 deletions(-) create mode 100644 src/flists.adb create mode 100644 src/flists.ads delete mode 100644 src/vhdl/flists.adb delete mode 100644 src/vhdl/flists.ads create mode 100644 src/vhdl/vhdl-flists.ads (limited to 'src') 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; diff --git a/src/flists.ads b/src/flists.ads new file mode 100644 index 000000000..a2b28e3c5 --- /dev/null +++ b/src/flists.ads @@ -0,0 +1,52 @@ +-- 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 Types; use Types; + +generic + type El_Type is range <>; +package Flists is + type Flist_Type is new Int32; + for Flist_Type'Size use 32; + + -- Non-existing flist. + Null_Flist : constant Flist_Type := 0; + + -- Predefined special flist that could be used as a marker. + Flist_Others : constant Flist_Type := 1; + Flist_All : constant Flist_Type := 2; + + -- Create a new flist of length LEN. All the elements are initialized to + -- Null_Node. + function Create_Flist (Len : Natural) return Flist_Type; + + -- Deallocate FLIST. Set to Null_Flist. + procedure Destroy_Flist (Flist : in out Flist_Type); + + -- First and last index of FLIST. Could be used to iterate. + Ffirst : constant Natural := 0; + function Flast (Flist : Flist_Type) return Integer; + + -- Return the length of FLIST. + function Length (Flist : Flist_Type) return Natural; + + -- Get the N-th element of FLIST. First element has index 0. + function Get_Nth_Element (Flist : Flist_Type; N : Natural) return El_Type; + + -- Set the N-th element of FLIST to V. + procedure Set_Nth_Element (Flist : Flist_Type; N : Natural; V : El_Type); +end Flists; diff --git a/src/vhdl/flists.adb b/src/vhdl/flists.adb deleted file mode 100644 index 4c8067542..000000000 --- a/src/vhdl/flists.adb +++ /dev/null @@ -1,161 +0,0 @@ --- 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 => 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 (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) := Node_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 => 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; - - Els.Table (Flistt.Table (Flist).Els) := Node_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 Node_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 : 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; diff --git a/src/vhdl/flists.ads b/src/vhdl/flists.ads deleted file mode 100644 index 3d43c0f74..000000000 --- a/src/vhdl/flists.ads +++ /dev/null @@ -1,51 +0,0 @@ --- 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 Types; use Types; -with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv; - -package Flists is - type Flist_Type is new Int32; - for Flist_Type'Size use 32; - - -- Non-existing flist. - Null_Flist : constant Flist_Type := 0; - - -- Predefined special flist that could be used as a marker. - Flist_Others : constant Flist_Type := 1; - Flist_All : constant Flist_Type := 2; - - -- Create a new flist of length LEN. All the elements are initialized to - -- Null_Node. - function Create_Flist (Len : Natural) return Flist_Type; - - -- Deallocate FLIST. Set to Null_Flist. - procedure Destroy_Flist (Flist : in out Flist_Type); - - -- First and last index of FLIST. Could be used to iterate. - Ffirst : constant Natural := 0; - function Flast (Flist : Flist_Type) return Integer; - - -- Return the length of FLIST. - function Length (Flist : Flist_Type) return Natural; - - -- Get the N-th element of FLIST. First element has index 0. - function Get_Nth_Element (Flist : Flist_Type; N : Natural) return Node_Type; - - -- Set the N-th element of FLIST to V. - procedure Set_Nth_Element (Flist : Flist_Type; N : Natural; V : Node_Type); -end Flists; diff --git a/src/vhdl/vhdl-flists.ads b/src/vhdl/vhdl-flists.ads new file mode 100644 index 000000000..ae92345ad --- /dev/null +++ b/src/vhdl/vhdl-flists.ads @@ -0,0 +1,21 @@ +-- Fixed-length lists. +-- Copyright (C) 2019 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 Vhdl.Types; +with Flists; + +package Vhdl.Flists is new Standard.Flists (El_Type => Vhdl.Types.Node); diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index 7ffa117d6..80c0c80e3 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -20,7 +20,7 @@ with Types; use Types; with Vhdl.Tokens; use Vhdl.Tokens; with Vhdl.Nodes_Priv; with Lists; -with Flists; +with Vhdl.Flists; package Vhdl.Nodes is -- This package defines the semantic tree and functions to handle it. -- cgit v1.2.3