Rewrite list implementation

4 files changed, 115 insertions, 155 deletions

diff --git a/src/lists.adb b/src/lists.adb
index 37a5f74da..cccfb76db 100644
--- a/src/lists.adb
+++ b/src/lists.adb
@@ -15,18 +15,14 @@
 --  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 System;
 with Tables;
 
 package body Lists is
-   type Node_Array_Fat is array (Natural) of Node_Type;
-   type Node_Array_Fat_Acc is access Node_Array_Fat;
-
    type List_Record is record
-      Max : Natural;
+      First : Chunk_Index_Type;
+      Last : Chunk_Index_Type;
+      Chunk_Idx : Nat32;
       Nbr : Natural;
-      Next : List_Type;
-      Els : Node_Array_Fat_Acc;
    end record;
 
    package Listt is new Tables
@@ -35,227 +31,183 @@ package body Lists is
       Table_Low_Bound => 2,
       Table_Initial => 128);
 
-   --function Get_Max_Nbr_Elements (List : List_Type) return Natural;
-   --pragma Inline (Get_Max_Nbr_Elements);
+   package Chunkt is new Tables
+     (Table_Component_Type => Chunk_Type,
+      Table_Index_Type => Chunk_Index_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 128);
+
+   Chunk_Free_List : Chunk_Index_Type := No_Chunk_Index;
 
-   --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural);
-   --pragma Inline (Set_Max_Nbr_Elements);
+   procedure Free_Chunk (Idx : Chunk_Index_Type) is
+   begin
+      Chunkt.Table (Idx).Next := Chunk_Free_List;
+      Chunk_Free_List := Idx;
+   end Free_Chunk;
 
-   procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural);
-   pragma Inline (List_Set_Nbr_Elements);
+   function Get_Free_Chunk return Chunk_Index_Type
+   is
+      Res : Chunk_Index_Type;
+   begin
+      if Chunk_Free_List /= No_Chunk_Index then
+         Res := Chunk_Free_List;
+         Chunk_Free_List := Chunkt.Table (Res).Next;
+         return Res;
+      else
+         return Chunkt.Allocate;
+      end if;
+   end Get_Free_Chunk;
 
    function Get_Nbr_Elements (List: List_Type) return Natural is
    begin
       return Listt.Table (List).Nbr;
    end Get_Nbr_Elements;
 
-   procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural) is
-   begin
-      Listt.Table (List).Nbr := Nbr;
-   end List_Set_Nbr_Elements;
-
    function Is_Empty (List : List_Type) return Boolean is
    begin
       return Listt.Table (List).Nbr = 0;
    end Is_Empty;
 
-   --function Get_Max_Nbr_Elements (List : List_Type) return Natural is
-   --begin
-   --   return Listt.Table (List).Max;
-   --end Get_Max_Nbr_Elements;
-
-   --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural) is
-   --begin
-   --   Listt.Table (List).Max := Max;
-   --end Set_Max_Nbr_Elements;
-
-   function Get_Nth_Element (List: List_Type; N: Natural)
-     return Node_Type
-   is
-   begin
-      if N >= Listt.Table (List).Nbr then
-         return Null_Node;
-      end if;
-      return Listt.Table (List).Els (N);
-   end Get_Nth_Element;
-
-   -- Replace an element selected by position.
-   procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type)
-   is
-   begin
-      if N >= Listt.Table (List).Nbr then
-         raise Program_Error;
-      end if;
-      Listt.Table (List).Els (N) := El;
-   end Replace_Nth_Element;
-
-   -- Be sure an element can be added to LIST.
-   -- It doesn't change the number of elements.
-   procedure List_Grow (List: List_Type)
-   is
-      L : List_Record renames Listt.Table (List);
-
-      --  Be careful: size in bytes.
-      function Alloc (Size : Natural) return Node_Array_Fat_Acc;
-      pragma Import (C, Alloc, "malloc");
-
-      function Realloc (Ptr : Node_Array_Fat_Acc; Size : Natural)
-        return Node_Array_Fat_Acc;
-      pragma Import (C, Realloc, "realloc");
-
-      Tmp : Node_Array_Fat_Acc;
-      N : Natural;
-   begin
-      if L.Nbr < L.Max then
-         return;
-      end if;
-      if L.Max = 0 then
-         N := 8;
-         Tmp := Alloc (N * Node_Type'Size / System.Storage_Unit);
-      else
-         N := L.Max * 2;
-         Tmp := Realloc (L.Els, N * Node_Type'Size / System.Storage_Unit);
-      end if;
-      L.Els := Tmp;
-      L.Max := N;
-   end List_Grow;
-
    procedure Append_Element (List: List_Type; Element: Node_Type)
    is
       L : List_Record renames Listt.Table (List);
+      C : Chunk_Index_Type;
    begin
-      if L.Nbr >= L.Max then
-         List_Grow (List);
+      L.Chunk_Idx := L.Chunk_Idx + 1;
+      if L.Chunk_Idx < Chunk_Len then
+         Chunkt.Table (L.Last).Els (L.Chunk_Idx) := Element;
+      else
+         C := Get_Free_Chunk;
+         Chunkt.Table (C).Next := No_Chunk_Index;
+         Chunkt.Table (C).Els (0) := Element;
+         L.Chunk_Idx := 0;
+         if L.Nbr = 0 then
+            L.First := C;
+         else
+            Chunkt.Table (L.Last).Next := C;
+         end if;
+         L.Last := C;
       end if;
-      L.Els (L.Nbr) := Element;
       L.Nbr := L.Nbr + 1;
    end Append_Element;
 
-   -- Return the last element of the list, or null.
-   -- Return the first element of the list, or null.
-   function Get_First_Element (List: List_Type) return Node_Type is
+   function Get_First_Element (List: List_Type) return Node_Type
+   is
+      L : List_Record renames Listt.Table (List);
    begin
-      if Listt.Table (List).Nbr = 0 then
-         return Null_Node;
-      else
-         return Listt.Table (List).Els (0);
-      end if;
+      pragma Assert (L.Nbr > 0);
+      return Chunkt.Table (L.First).Els (0);
    end Get_First_Element;
 
    -- Add (append) an element only if it was not already present in the list.
    procedure Add_Element (List: List_Type; El: Node_Type)
    is
-      Nbr : constant Natural := Get_Nbr_Elements (List);
+      It : Iterator;
    begin
-      for I in 0 .. Nbr - 1 loop
-         if Listt.Table (List).Els (I) = El then
+      It := Iterate (List);
+      while Is_Valid (It) loop
+         if Get_Element (It) = El then
             return;
          end if;
+         Next (It);
       end loop;
 
       Append_Element (List, El);
    end Add_Element;
 
-   procedure Set_Nbr_Elements (List: List_Type; N: Natural) is
-   begin
-      if N > Get_Nbr_Elements (List) then
-         raise Program_Error;
-      end if;
-      List_Set_Nbr_Elements (List, N);
-   end Set_Nbr_Elements;
-
    --  Chain of unused lists.
-   Free_Chain : List_Type := Null_List;
+   List_Free_Chain : List_Type := Null_List;
 
    function Create_List return List_Type
    is
       Res : List_Type;
    begin
-      if Free_Chain = Null_List then
+      if List_Free_Chain = Null_List then
          Listt.Increment_Last;
          Res := Listt.Last;
       else
-         Res := Free_Chain;
-         Free_Chain := Listt.Table (Res).Next;
+         Res := List_Free_Chain;
+         List_Free_Chain := List_Type (Listt.Table (Res).Chunk_Idx);
       end if;
-      Listt.Table (Res) := List_Record'(Max => 0, Nbr => 0,
-                                        Next => Null_List, Els => null);
+      Listt.Table (Res) := List_Record'(First => No_Chunk_Index,
+                                        Last => No_Chunk_Index,
+                                        Chunk_Idx => Chunk_Len,
+                                        Nbr => 0);
       return Res;
    end Create_List;
 
-   procedure Free (Ptr : Node_Array_Fat_Acc);
-   pragma Import (C, Free, "free");
-
    procedure Destroy_List (List : in out List_Type)
    is
+      C, Next_C : Chunk_Index_Type;
    begin
       if List = Null_List then
          return;
       end if;
-      if Listt.Table (List).Max > 0 then
-         Free (Listt.Table (List).Els);
-         Listt.Table (List).Els := null;
-      end if;
-      Listt.Table (List).Next := Free_Chain;
-      Free_Chain := List;
+
+      C := Listt.Table (List).First;
+      while C /= No_Chunk_Index loop
+         Next_C := Chunkt.Table (C).Next;
+         Free_Chunk (C);
+         C := Next_C;
+      end loop;
+
+      Listt.Table (List).Chunk_Idx := Nat32 (List_Free_Chain);
+      List_Free_Chain := List;
+
       List := Null_List;
    end Destroy_List;
 
    procedure Initialize is
    begin
-      for I in Listt.First .. Listt.Last loop
-         if Listt.Table (I).Els /= null then
-            Free (Listt.Table (I).Els);
-         end if;
-      end loop;
       Listt.Free;
       Listt.Init;
+      Chunkt.Free;
+      Chunkt.Init;
+      List_Free_Chain := Null_List;
+      Chunk_Free_List := No_Chunk_Index;
    end Initialize;
 
-   function Iterate (List : List_Type) return Iterator is
+   function Iterate (List : List_Type) return Iterator
+   is
+      L : List_Record renames Listt.Table (List);
    begin
-      return Iterator'(List => List,
-                       Len => Get_Nbr_Elements (List),
-                       Idx => 0);
+      return Iterator'(Chunk => L.First,
+                       Chunk_Idx => 0,
+                       Remains => L.Nbr);
    end Iterate;
 
    function Iterate_Safe (List : List_Type) return Iterator is
    begin
       if List = Null_List then
-         return Iterator'(List => Null_List,
-                          Len => 0,
-                          Idx => 0);
+         return Iterator'(Chunk => No_Chunk_Index,
+                          Chunk_Idx => 0,
+                          Remains => 0);
       end if;
       return Iterate (List);
    end Iterate_Safe;
 
    function Is_Valid (It : Iterator) return Boolean is
    begin
-      return It.Idx < It.Len;
+      return It.Remains > 0;
    end Is_Valid;
 
-   function Is_First (It : Iterator) return Boolean is
-   begin
-      return It.Idx = 0;
-   end Is_First;
-
    procedure Next (It : in out Iterator) is
    begin
-      It.Idx := It.Idx + 1;
+      It.Chunk_Idx := It.Chunk_Idx + 1;
+      if It.Chunk_Idx = Chunk_Len then
+         It.Chunk := Chunkt.Table (It.Chunk).Next;
+         It.Chunk_Idx := 0;
+      end if;
+      It.Remains := It.Remains - 1;
    end Next;
 
    function Get_Element (It : Iterator) return Node_Type is
    begin
-      return Get_Nth_Element (It.List, It.Idx);
+      return Chunkt.Table (It.Chunk).Els (It.Chunk_Idx);
    end Get_Element;
 
    procedure Set_Element (It : Iterator; El : Node_Type) is
    begin
-      Replace_Nth_Element (It.List, It.Idx, El);
+      Chunkt.Table (It.Chunk).Els (It.Chunk_Idx) := El;
    end Set_Element;
-
-   procedure Truncate (It : Iterator) is
-   begin
-      Set_Nbr_Elements (It.List, It.Idx);
-   end Truncate;
 end Lists;
diff --git a/src/lists.ads b/src/lists.ads
index 9f5729e9b..07e319d9f 100644
--- a/src/lists.ads
+++ b/src/lists.ads
@@ -88,10 +88,6 @@ package Lists is
    --  True if LIST is empty.
    function Is_Empty (List : List_Type) return Boolean;
 
-   -- Set the number of elements in the list.
-   -- Can be used only to shrink the list.
-   procedure Set_Nbr_Elements (List: List_Type; N: Natural);
-
    --  Iterator.  The idiomatic way to iterate is:
    --  It := Iterate (List);
    --  while Is_Valid (It) loop
@@ -103,21 +99,31 @@ package Lists is
 
    function Iterate (List : List_Type) return Iterator;
    function Is_Valid (It : Iterator) return Boolean;
-   function Is_First (It : Iterator) return Boolean;
    procedure Next (It : in out Iterator);
    function Get_Element (It : Iterator) return Node_Type;
    procedure Set_Element (It : Iterator; El : Node_Type);
 
-   procedure Truncate (It : Iterator);
-
    --  Like Iterate, but if LIST is Null_List, it returns an iterator that is
    --  never valid.
    function Iterate_Safe (List : List_Type) return Iterator;
 private
+   type Chunk_Index_Type is new Int32;
+   No_Chunk_Index : constant Chunk_Index_Type := 0;
+
+   Chunk_Len : constant := 7;
+
+   type Node_Type_Array is
+     array (Nat32 range 0 .. Chunk_Len - 1) of Node_Type;
+
+   type Chunk_Type is record
+      Next : Chunk_Index_Type;
+      Els : Node_Type_Array;
+   end record;
+
    type Iterator is record
-      List : List_Type;
-      Len : Natural;
-      Idx : Natural;
+      Chunk : Chunk_Index_Type;
+      Chunk_Idx : Nat32;
+      Remains : Natural;
    end record;
 
    pragma Inline (Is_Valid);
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index 744e1f9a2..c35dcfd50 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -794,6 +794,7 @@ package body Disp_Vhdl is
    is
       El : Iir;
       It : List_Iterator;
+      Is_First : Boolean;
    begin
       case List is
          when Null_Iir_List =>
@@ -802,10 +803,13 @@ package body Disp_Vhdl is
             Put ("all");
          when others =>
             It := List_Iterate (List);
+            Is_First := True;
             while Is_Valid (It) loop
                El := Get_Element (It);
-               if not Is_First (It) then
+               if not Is_First then
                   Put (", ");
+               else
+                  Is_First := False;
                end if;
                Disp_Expression (El);
                Next (It);
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 4d18f3f88..6b5de4661 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -5396,8 +5396,6 @@ package Iirs is
      renames Lists.Iterate_Safe;
    function Is_Valid (It : List_Iterator) return Boolean
      renames Lists.Is_Valid;
-   function Is_First (It : List_Iterator) return Boolean
-     renames Lists.Is_First;
    procedure Next (It : in out List_Iterator)
      renames Lists.Next;
    function Get_Element (It : List_Iterator) return Iir