aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lists.adb236
-rw-r--r--src/lists.ads26
-rw-r--r--src/vhdl/disp_vhdl.adb6
-rw-r--r--src/vhdl/iirs.ads2
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
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-15 12:07:55 +0000