aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2017-11-11 08:48:28 +0100
committerTristan Gingold <tgingold@free.fr>2017-11-11 08:48:28 +0100
commite8a21ffe5226aad4970bd1facd4a3464a4b436f1 (patch)
tree6dabc27375bc31dbd435d50a98dc223fa4145ac2 /src/vhdl
parent9a90393e30827308ec6cd834963f5359158115a0 (diff)
downloadghdl-e8a21ffe5226aad4970bd1facd4a3464a4b436f1.tar.gz
ghdl-e8a21ffe5226aad4970bd1facd4a3464a4b436f1.tar.bz2
ghdl-e8a21ffe5226aad4970bd1facd4a3464a4b436f1.zip
Rework list implementation, use iterator.
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/canon.adb18
-rw-r--r--src/vhdl/configuration.adb8
-rw-r--r--src/vhdl/disp_tree.adb22
-rw-r--r--src/vhdl/disp_vhdl.adb37
-rw-r--r--src/vhdl/errorout.adb12
-rw-r--r--src/vhdl/iirs.ads43
-rw-r--r--src/vhdl/iirs_utils.adb25
-rw-r--r--src/vhdl/iirs_utils.ads3
-rw-r--r--src/vhdl/nodes_gc.adb27
-rw-r--r--src/vhdl/sem.adb141
-rw-r--r--src/vhdl/sem_assocs.adb31
-rw-r--r--src/vhdl/sem_decls.adb10
-rw-r--r--src/vhdl/sem_expr.adb162
-rw-r--r--src/vhdl/sem_inst.adb36
-rw-r--r--src/vhdl/sem_names.adb120
-rw-r--r--src/vhdl/sem_scopes.adb10
-rw-r--r--src/vhdl/sem_stmts.adb11
-rw-r--r--src/vhdl/sem_types.adb8
-rw-r--r--src/vhdl/translate/trans-chap12.adb8
-rw-r--r--src/vhdl/translate/trans-chap2.adb22
-rw-r--r--src/vhdl/translate/trans-chap9.adb15
-rw-r--r--src/vhdl/translate/trans-helpers2.adb11
-rw-r--r--src/vhdl/translate/trans_analyzes.adb18
23 files changed, 463 insertions, 335 deletions
diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index cad0398e9..15295b439 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -240,12 +240,12 @@ package body Canon is
when Iir_Kind_Psl_Endpoint_Declaration =>
declare
List : constant Iir_List := Get_PSL_Clock_Sensitivity (Expr);
- El : Iir;
+ It : List_Iterator;
begin
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
- Add_Element (Sensitivity_List, El);
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ Add_Element (Sensitivity_List, Get_Element (It));
+ Next (It);
end loop;
end;
@@ -504,6 +504,7 @@ package body Canon is
(Callees_List : Iir_List; Sensitivity_List : Iir_List)
is
Callee : Iir;
+ It : List_Iterator;
Bod : Iir;
begin
-- LRM08 11.3
@@ -516,9 +517,9 @@ package body Canon is
if Callees_List = Null_Iir_List then
return;
end if;
- for I in Natural loop
- Callee := Get_Nth_Element (Callees_List, I);
- exit when Callee = Null_Iir;
+ It := List_Iterate (Callees_List);
+ while Is_Valid (It) loop
+ Callee := Get_Element (It);
if not Get_Seen_Flag (Callee) then
Set_Seen_Flag (Callee, True);
case Get_All_Sensitized_State (Callee) is
@@ -541,6 +542,7 @@ package body Canon is
raise Internal_Error;
end case;
end if;
+ Next (It);
end loop;
end Canon_Extract_Sensitivity_From_Callees;
diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb
index f02c17d25..1d32b9c1f 100644
--- a/src/vhdl/configuration.adb
+++ b/src/vhdl/configuration.adb
@@ -40,6 +40,7 @@ package body Configuration is
procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir)
is
List : Iir_List;
+ It : List_Iterator;
El : Iir;
Lib_Unit : Iir;
File : Iir_Design_File;
@@ -111,9 +112,9 @@ package body Configuration is
-- Note: a design unit may be referenced but unused.
-- (eg: component specification which does not apply).
List := Get_Dependence_List (Unit);
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
El := Libraries.Find_Design_Unit (El);
if El /= Null_Iir then
Lib_Unit := Get_Library_Unit (El);
@@ -129,6 +130,7 @@ package body Configuration is
end case;
end if;
end if;
+ Next (It);
end loop;
-- Lib_Unit may have changed.
diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb
index 111e9dee4..9abc1dc33 100644
--- a/src/vhdl/disp_tree.adb
+++ b/src/vhdl/disp_tree.adb
@@ -67,7 +67,7 @@ package body Disp_Tree is
procedure Disp_Iir_List
(Tree_List : Iir_List; Tab : Natural; Depth : Natural)
is
- El: Iir;
+ It : List_Iterator;
begin
case Tree_List is
when Null_Iir_List =>
@@ -76,11 +76,11 @@ package body Disp_Tree is
Put_Line ("list-all");
when others =>
New_Line;
- for I in Natural loop
- El := Get_Nth_Element (Tree_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Tree_List);
+ while Is_Valid (It) loop
Put_Indent (Tab);
- Disp_Iir (El, Tab + 1, Depth);
+ Disp_Iir (Get_Element (It), Tab + 1, Depth);
+ Next (It);
end loop;
end case;
end Disp_Iir_List;
@@ -131,9 +131,9 @@ package body Disp_Tree is
end Disp_Tree_Flat_Chain;
pragma Unreferenced (Disp_Tree_Flat_Chain);
- procedure Disp_Tree_List_Flat (Tree_List: Iir_List; Tab: Natural)
+ procedure Disp_Tree_List_Flat (Tree_List : Iir_List; Tab : Natural)
is
- El: Iir;
+ It : List_Iterator;
begin
case Tree_List is
when Null_Iir_List =>
@@ -143,10 +143,10 @@ package body Disp_Tree is
Put_Indent (Tab);
Put_Line (" list-all");
when others =>
- for I in Natural loop
- El := Get_Nth_Element (Tree_List, I);
- exit when El = Null_Iir;
- Disp_Iir (El, Tab, 0);
+ It := List_Iterate (Tree_List);
+ while Is_Valid (It) loop
+ Disp_Iir (Get_Element (It), Tab, 0);
+ Next (It);
end loop;
end case;
end Disp_Tree_List_Flat;
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index 9e14648cd..744e1f9a2 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -790,24 +790,27 @@ package body Disp_Vhdl is
Disp_End (Def, "record");
end Disp_Record_Type_Definition;
- procedure Disp_Designator_List (List: Iir_List) is
- El: Iir;
+ procedure Disp_Designator_List (List: Iir_List)
+ is
+ El : Iir;
+ It : List_Iterator;
begin
- if List = Null_Iir_List then
- return;
- elsif List = Iir_List_All then
- Put ("all");
- return;
- end if;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
- if I > 0 then
- Put (", ");
- end if;
- Disp_Expression (El);
- --Disp_Text_Literal (El);
- end loop;
+ case List is
+ when Null_Iir_List =>
+ null;
+ when Iir_List_All =>
+ Put ("all");
+ when others =>
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
+ if not Is_First (It) then
+ Put (", ");
+ end if;
+ Disp_Expression (El);
+ Next (It);
+ end loop;
+ end case;
end Disp_Designator_List;
-- Display the full definition of a type, ie the sequence that can create
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 96ee810f1..26b588280 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -1510,27 +1510,29 @@ package body Errorout is
elsif Get_Kind (A_Type) = Iir_Kind_Overload_List then
declare
use Ada.Strings.Unbounded;
+ List : constant Iir_List := Get_Overload_List (A_Type);
+ Nbr : constant Natural := Get_Nbr_Elements (List);
Res : Unbounded_String;
- List : Iir_List;
El : Iir;
- Nbr : Natural;
+ It : List_Iterator;
begin
- List := Get_Overload_List (A_Type);
- Nbr := Get_Nbr_Elements (List);
if Nbr = 0 then
return "unknown";
elsif Nbr = 1 then
return Disp_Type_Name (Get_First_Element (List));
else
Append (Res, "one of ");
+ It := List_Iterate (List);
for I in 0 .. Nbr - 1 loop
- El := Get_Nth_Element (List, I);
+ pragma Assert (Is_Valid (It));
+ El := Get_Element (It);
Append (Res, Disp_Type_Name (El));
if I < Nbr - 2 then
Append (Res, ", ");
elsif I = Nbr - 2 then
Append (Res, " or ");
end if;
+ Next (It);
end loop;
return To_String (Res);
end if;
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index f40b64eb8..4d18f3f88 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -5349,15 +5349,9 @@ package Iirs is
--Iir_Kind_Disconnection_Specification
Iir_Kind_Configuration_Specification;
- -------------------------------------
- -- Types and subtypes declarations --
- -------------------------------------
+ -- Nodes and lists.
- -- Level 1 base class.
subtype Iir is Nodes.Node_Type;
- subtype Iir_List is Lists.List_Type;
- Null_Iir_List : constant Iir_List := Lists.Null_List;
- Iir_List_All : constant Iir_List := Lists.List_All;
Null_Iir : constant Iir := Nodes.Null_Node;
@@ -5369,19 +5363,20 @@ package Iirs is
function Is_Valid (Node : Iir) return Boolean;
pragma Inline (Is_Valid);
- function Is_Null_List (Node : Iir_List) return Boolean;
- pragma Inline (Is_Null_List);
-
function "=" (L, R : Iir) return Boolean renames Nodes."=";
function Get_Last_Node return Iir renames Nodes.Get_Last_Node;
+ subtype Iir_List is Lists.List_Type;
+ Null_Iir_List : constant Iir_List := Lists.Null_List;
+ Iir_List_All : constant Iir_List := Lists.List_All;
+
+ subtype List_Iterator is Lists.Iterator;
+ function Is_Null_List (Node : Iir_List) return Boolean;
+ pragma Inline (Is_Null_List);
+
function Create_Iir_List return Iir_List
renames Lists.Create_List;
- function Get_Nth_Element (L : Iir_List; N : Natural) return Iir
- renames Lists.Get_Nth_Element;
- procedure Replace_Nth_Element (L : Iir_List; N : Natural; El : Iir)
- renames Lists.Replace_Nth_Element;
procedure Append_Element (L : Iir_List; E : Iir)
renames Lists.Append_Element;
procedure Add_Element (L : Iir_List; E : Iir)
@@ -5390,10 +5385,26 @@ package Iirs is
renames Lists.Destroy_List;
function Get_Nbr_Elements (L : Iir_List) return Natural
renames Lists.Get_Nbr_Elements;
- procedure Set_Nbr_Elements (L : Iir_List; Nbr : Natural)
- renames Lists.Set_Nbr_Elements;
function Get_First_Element (L : Iir_List) return Iir
renames Lists.Get_First_Element;
+ function Is_Empty (L : Iir_List) return Boolean
+ renames Lists.Is_Empty;
+
+ function List_Iterate (List : Iir_List) return List_Iterator
+ renames Lists.Iterate;
+ function List_Iterate_Safe (List : Iir_List) return List_Iterator
+ 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
+ renames Lists.Get_Element;
+ procedure Set_Element (It : List_Iterator; El : Iir)
+ renames Lists.Set_Element;
+
function "=" (L, R : Iir_List) return Boolean renames Lists."=";
subtype Iir_Flist is Flists.Flist_Type;
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index d96be7600..a14f0523c 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -60,13 +60,18 @@ package body Iirs_Utils is
function List_To_Flist (L : Iir_List) return Iir_Flist
is
Len : constant Natural := Get_Nbr_Elements (L);
+ It : List_Iterator;
Temp_L : Iir_List;
Res : Iir_Flist;
begin
Res := Create_Iir_Flist (Len);
+ It := List_Iterate (L);
for I in 0 .. Len - 1 loop
- Set_Nth_Element (Res, I, Get_Nth_Element (L, I));
+ pragma Assert (Is_Valid (It));
+ Set_Nth_Element (Res, I, Get_Element (It));
+ Next (It);
end loop;
+ pragma Assert (not Is_Valid (It));
Temp_L := L;
Destroy_Iir_List (Temp_L);
@@ -838,12 +843,12 @@ package body Iirs_Utils is
procedure Free_Recursive_List (List : Iir_List)
is
- El : Iir;
+ It : List_Iterator;
begin
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
- Free_Recursive (El);
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ Free_Recursive (Get_Element (It));
+ Next (It);
end loop;
end Free_Recursive_List;
@@ -959,18 +964,20 @@ package body Iirs_Utils is
procedure Clear_Seen_Flag (Top : Iir)
is
Callees_List : Iir_Callees_List;
+ It : List_Iterator;
El: Iir;
begin
if Get_Seen_Flag (Top) then
Set_Seen_Flag (Top, False);
Callees_List := Get_Callees_List (Get_Callees_List_Holder (Top));
if Callees_List /= Null_Iir_List then
- for I in Natural loop
- El := Get_Nth_Element (Callees_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Callees_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Get_Seen_Flag (El) = False then
Clear_Seen_Flag (El);
end if;
+ Next (It);
end loop;
end if;
end if;
diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads
index f741b4066..1aabea149 100644
--- a/src/vhdl/iirs_utils.ads
+++ b/src/vhdl/iirs_utils.ads
@@ -137,6 +137,9 @@ package Iirs_Utils is
-- Free NODE and its sub-nodes.
procedure Free_Recursive (Node : Iir; Free_List : Boolean := False);
+ -- Free nodes in LIST.
+ procedure Free_Recursive_List (List : Iir_List);
+
-- Name of FUNC.
function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions)
return String;
diff --git a/src/vhdl/nodes_gc.adb b/src/vhdl/nodes_gc.adb
index 89da35c4e..b4c11149f 100644
--- a/src/vhdl/nodes_gc.adb
+++ b/src/vhdl/nodes_gc.adb
@@ -62,17 +62,17 @@ package body Nodes_GC is
procedure Mark_Iir_List (N : Iir_List)
is
- El : Iir;
+ It : List_Iterator;
begin
case N is
when Null_Iir_List
| Iir_List_All =>
null;
when others =>
- for I in Natural loop
- El := Get_Nth_Element (N, I);
- exit when El = Null_Iir;
- Mark_Iir (El);
+ It := List_Iterate (N);
+ while Is_Valid (It) loop
+ Mark_Iir (Get_Element (It));
+ Next (It);
end loop;
end case;
end Mark_Iir_List;
@@ -80,18 +80,20 @@ package body Nodes_GC is
procedure Mark_Iir_List_Ref (N : Iir_List; F : Fields_Enum)
is
El : Iir;
+ It : List_Iterator;
begin
case N is
when Null_Iir_List
| Iir_List_All =>
null;
when others =>
- for I in Natural loop
- El := Get_Nth_Element (N, I);
- exit when El = Null_Iir;
+ It := List_Iterate (N);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if not Markers (El) then
Report_Early_Reference (El, F);
end if;
+ Next (It);
end loop;
end case;
end Mark_Iir_List_Ref;
@@ -312,6 +314,7 @@ package body Nodes_GC is
procedure Mark_Unit (Unit : Iir)
is
List : Iir_List;
+ It : List_Iterator;
El : Iir;
begin
pragma Assert (Get_Kind (Unit) = Iir_Kind_Design_Unit);
@@ -331,10 +334,9 @@ package body Nodes_GC is
-- First mark dependences
List := Get_Dependence_List (Unit);
if List /= Null_Iir_List then
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
-
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
case Get_Kind (El) is
when Iir_Kind_Design_Unit =>
Mark_Unit (El);
@@ -366,6 +368,7 @@ package body Nodes_GC is
when others =>
Error_Kind ("mark_unit", El);
end case;
+ Next (It);
end loop;
end if;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 41b85a299..0893120e2 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -2077,39 +2077,38 @@ package body Sem is
-- Update wait state if the state of all callees is known.
if Get_Wait_State (Spec) = Unknown then
declare
- Callees : Iir_List;
+ Callees : constant Iir_List := Get_Callees_List (Subprg);
+ Callees_It : List_Iterator;
Callee : Iir;
State : Tri_State_Type;
begin
- Callees := Get_Callees_List (Subprg);
-- Per default, has no wait.
Set_Wait_State (Spec, False);
- if Callees /= Null_Iir_List then
- for I in Natural loop
- Callee := Get_Nth_Element (Callees, I);
- exit when Callee = Null_Iir;
- case Get_Kind (Callee) is
- when Iir_Kind_Function_Declaration =>
- null;
- when Iir_Kind_Procedure_Declaration =>
- State := Get_Wait_State (Callee);
- case State is
- when False =>
- null;
- when Unknown =>
- -- Yet unknown, but can be TRUE.
- Set_Wait_State (Spec, Unknown);
- when True =>
- -- Can this happen ?
- raise Internal_Error;
- --Set_Wait_State (Spec, True);
- --exit;
- end case;
- when others =>
- Error_Kind ("sem_subprogram_body(2)", Callee);
- end case;
- end loop;
- end if;
+ Callees_It := List_Iterate_Safe (Callees);
+ while Is_Valid (Callees_It) loop
+ Callee := Get_Element (Callees_It);
+ case Get_Kind (Callee) is
+ when Iir_Kind_Function_Declaration =>
+ null;
+ when Iir_Kind_Procedure_Declaration =>
+ State := Get_Wait_State (Callee);
+ case State is
+ when False =>
+ null;
+ when Unknown =>
+ -- Yet unknown, but can be TRUE.
+ Set_Wait_State (Spec, Unknown);
+ when True =>
+ -- Can this happen ?
+ raise Internal_Error;
+ --Set_Wait_State (Spec, True);
+ --exit;
+ end case;
+ when others =>
+ Error_Kind ("sem_subprogram_body(2)", Callee);
+ end case;
+ Next (Callees_It);
+ end loop;
end;
end if;
@@ -2162,6 +2161,7 @@ package body Sem is
Callees_List : Iir_List;
Callees_List_Holder : Iir;
+ Callees_It : List_Iterator;
Callee : Iir;
Callee_Orig : Iir;
Callee_Bod : Iir;
@@ -2171,7 +2171,7 @@ package body Sem is
Depth : Iir_Int32;
Depth_Callee : Iir_Int32;
Has_Wait_Errors : Boolean := False;
- Npos : Natural;
+ New_List : Iir_List;
Res, Res1 : Update_Pure_Status;
begin
case Get_Kind (Subprg) is
@@ -2240,10 +2240,10 @@ package body Sem is
-- First loop: check without recursion.
-- Second loop: recurse if necessary.
for J in 0 .. 1 loop
- Npos := 0;
- for I in Natural loop
- Callee := Get_Nth_Element (Callees_List, I);
- exit when Callee = Null_Iir;
+ New_List := Create_Iir_List;
+ Callees_It := List_Iterate (Callees_List);
+ while Is_Valid (Callees_It) loop
+ Callee := Get_Element (Callees_It);
-- Note:
-- Pure functions should not be in the list.
@@ -2368,15 +2368,16 @@ package body Sem is
(Get_All_Sensitized_State (Callee) = Unknown
or else Get_All_Sensitized_State (Callee) = Read_Signal))
then
- Replace_Nth_Element (Callees_List, Npos, Callee);
- Npos := Npos + 1;
+ Append_Element (New_List, Callee);
end if;
+ Next (Callees_It);
end loop;
-- End of callee loop.
- if Npos = 0 then
+ if Is_Empty (New_List) then
Destroy_Iir_List (Callees_List);
Callees_List := Null_Iir_List;
+ Destroy_Iir_List (New_List);
if Kind = K_Procedure then
if Get_Purity_State (Subprg) = Unknown then
Set_Purity_State (Subprg, Maybe_Impure);
@@ -2393,11 +2394,12 @@ package body Sem is
Res := Update_Pure_Done;
exit;
else
- Set_Nbr_Elements (Callees_List, Npos);
+ Destroy_Iir_List (Callees_List);
+ Callees_List := New_List;
end if;
end loop;
- Set_Callees_List (Callees_List_Holder, Callees_List);
+ Set_Callees_List (Callees_List_Holder, New_List);
return Res;
end Update_And_Check_Pure_Wait;
@@ -2438,22 +2440,22 @@ package body Sem is
procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit;
Emit_Warnings : Boolean)
is
- List : Iir_List := Get_Analysis_Checks_List (Unit);
+ List : Iir_List;
El : Iir;
- Npos : Natural;
+ It : List_Iterator;
Keep : Boolean;
- Callees : Iir_List;
- Callee : Iir;
+ New_List : Iir_List;
begin
+ List := Get_Analysis_Checks_List (Unit);
if List = Null_Iir_List then
-- Return now if there is nothing to check.
return;
end if;
- Npos := 0;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ New_List := Create_Iir_List;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Keep := False;
case Get_Kind (El) is
when Iir_Kind_Function_Declaration =>
@@ -2461,21 +2463,24 @@ package body Sem is
if not Root_Update_And_Check_Pure_Wait (El) then
Keep := True;
if Emit_Warnings then
- Callees := Get_Callees_List (El);
- pragma Assert (Callees /= Null_Iir_List);
- Warning_Msg_Sem
- (Warnid_Delayed_Checks, +El,
- "can't assert that all calls in %n"
- & " are pure or have not wait;"
- & " will be checked at elaboration",
- +El, Cont => True);
- Callee := Get_Nth_Element (Callees, 0);
- -- FIXME: could improve this message by displaying the
- -- chain of calls until the first subprograms in
- -- unknown state.
- Warning_Msg_Sem
- (Warnid_Delayed_Checks, +Callee,
- "(first such call is to %n)", +Callee);
+ declare
+ Callees : constant Iir_List := Get_Callees_List (El);
+ pragma Assert (Callees /= Null_Iir_List);
+ Callee : constant Iir := Get_First_Element (Callees);
+ begin
+ Warning_Msg_Sem
+ (Warnid_Delayed_Checks, +El,
+ "can't assert that all calls in %n"
+ & " are pure or have not wait;"
+ & " will be checked at elaboration",
+ +El, Cont => True);
+ -- FIXME: could improve this message by displaying
+ -- the chain of calls until the first subprograms in
+ -- unknown state.
+ Warning_Msg_Sem
+ (Warnid_Delayed_Checks, +Callee,
+ "(first such call is to %n)", +Callee);
+ end;
end if;
end if;
when Iir_Kind_Sensitized_Process_Statement =>
@@ -2492,16 +2497,16 @@ package body Sem is
Error_Kind ("sem_analysis_checks_list", El);
end case;
if Keep then
- Replace_Nth_Element (List, Npos, El);
- Npos := Npos + 1;
+ Append_Element (New_List, El);
end if;
+ Next (It);
end loop;
- if Npos = 0 then
- Destroy_Iir_List (List);
- Set_Analysis_Checks_List (Unit, Null_Iir_List);
- else
- Set_Nbr_Elements (List, Npos);
+ if Is_Empty (New_List) then
+ Destroy_Iir_List (New_List);
+ New_List := Null_Iir_List; -- OK, redundant but clearer.
end if;
+ Destroy_Iir_List (List);
+ Set_Analysis_Checks_List (Unit, New_List);
end Sem_Analysis_Checks_List;
-- Return true if package declaration DECL needs a body.
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index fc7ca955f..13b9f1aea 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -1271,6 +1271,7 @@ package body Sem_Assocs is
(Conv : Iir; Res_Type : Iir; Param_Type : Iir; Loc : Iir) return Iir
is
List : Iir_List;
+ It : List_Iterator;
Res_Base_Type : Iir;
Param_Base_Type : Iir;
El : Iir;
@@ -1285,9 +1286,9 @@ package body Sem_Assocs is
if Is_Overload_List (Conv) then
List := Get_Overload_List (Conv);
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Is_Valid_Conversion (El, Res_Base_Type, Param_Base_Type) then
if Res /= Null_Iir then
raise Internal_Error;
@@ -1295,6 +1296,7 @@ package body Sem_Assocs is
Free_Iir (Conv);
Res := El;
end if;
+ Next (It);
end loop;
else
if Is_Valid_Conversion (Conv, Res_Base_Type, Param_Base_Type) then
@@ -1705,14 +1707,15 @@ package body Sem_Assocs is
declare
Nbr_Errors : Natural;
List : Iir_List;
+ It : List_Iterator;
El, R : Iir;
begin
Nbr_Errors := 0;
R := Null_Iir;
List := Get_Overload_List (Res);
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Has_Interface_Subprogram_Profile (Inter, El) then
if Is_Null (R) then
R := El;
@@ -1731,6 +1734,7 @@ package body Sem_Assocs is
Nbr_Errors := Nbr_Errors + 1;
end if;
end if;
+ Next (It);
end loop;
if Is_Null (R) then
Error_Msg_Sem
@@ -1738,11 +1742,12 @@ package body Sem_Assocs is
if True then
Error_Msg_Sem
(+Assoc, " these names were incompatible:");
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Error_Msg_Sem
(+Assoc, " %n declared at %l", (+El, +El));
+ Next (It);
end loop;
end if;
return;
@@ -2256,19 +2261,21 @@ package body Sem_Assocs is
if Is_Overload_List (Inter) then
declare
List : constant Iir_List := Get_Overload_List (Inter);
+ It : List_Iterator;
Filtered_Inter : Iir;
El : Iir;
begin
Filtered_Inter := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Get_Kind (El) in Iir_Kinds_Interface_Declaration
and then
Get_Parent (El) = Get_Parent (Interface_Chain)
then
Add_Result (Filtered_Inter, El);
end if;
+ Next (It);
end loop;
Free_Overload_List (Inter);
Inter := Filtered_Inter;
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 387aceeb6..56d2a796d 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -2329,6 +2329,8 @@ package body Sem_Decls is
Res : Iir;
El : Iir;
Error : Boolean;
+ Ov_List : Iir_List;
+ Ov_It : List_Iterator;
begin
-- Sem signature.
if List /= Null_Iir_Flist then
@@ -2355,9 +2357,10 @@ package body Sem_Decls is
Res := Null_Iir;
Error := False;
if Is_Overload_List (Name) then
- for I in Natural loop
- El := Get_Nth_Element (Get_Overload_List (Name), I);
- exit when El = Null_Iir;
+ Ov_List := Get_Overload_List (Name);
+ Ov_It := List_Iterate (Ov_List);
+ while Is_Valid (Ov_It) loop
+ El := Get_Element (Ov_It);
if Signature_Match (El, Sig) then
if Res = Null_Iir then
Res := El;
@@ -2373,6 +2376,7 @@ package body Sem_Decls is
Error_Msg_Sem (+El, "found: %n", +El);
end if;
end if;
+ Next (Ov_It);
end loop;
-- Free the overload list (with a workaround as only variables can
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 34bc6e5ca..5ae8653c3 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -172,6 +172,7 @@ package body Sem_Expr is
is
El : Iir;
Right_List : Iir_List;
+ It : List_Iterator;
Level : Compatibility_Level;
begin
pragma Assert (not Is_Overload_List (Left_Type));
@@ -179,14 +180,15 @@ package body Sem_Expr is
if Is_Overload_List (Right_Types) then
Right_List := Get_Overload_List (Right_Types);
Level := Not_Compatible;
- for I in Natural loop
- El := Get_Nth_Element (Right_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Right_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Level := Compatibility_Level'Max
(Level, Are_Types_Compatible (Left_Type, El));
if Level = Fully_Compatible then
return Fully_Compatible;
end if;
+ Next (It);
end loop;
return Level;
else
@@ -432,6 +434,7 @@ package body Sem_Expr is
return Iir
is
Type_List_List : Iir_List;
+ It : List_Iterator;
El: Iir;
Com : Iir;
Res : Iir;
@@ -442,9 +445,9 @@ package body Sem_Expr is
else
Type_List_List := Get_Overload_List (Type_List);
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (Type_List_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Type_List_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Com := Get_Common_Basetype (Get_Base_Type (El),
Get_Base_Type (A_Type));
if Com /= Null_Iir then
@@ -455,6 +458,7 @@ package body Sem_Expr is
return Null_Iir;
end if;
end if;
+ Next (It);
end loop;
return Res;
end if;
@@ -466,6 +470,7 @@ package body Sem_Expr is
function Search_Compatible_Type (List1, List2 : Iir) return Iir
is
List1_List : Iir_List;
+ It : List_Iterator;
Res : Iir;
El : Iir;
Tmp : Iir;
@@ -473,9 +478,9 @@ package body Sem_Expr is
if Is_Overload_List (List1) then
List1_List := Get_Overload_List (List1);
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List1_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List1_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Tmp := Search_Overloaded_Type (List2, El);
if Tmp /= Null_Iir then
if Res = Null_Iir then
@@ -485,6 +490,7 @@ package body Sem_Expr is
return Null_Iir;
end if;
end if;
+ Next (It);
end loop;
return Res;
else
@@ -1198,27 +1204,28 @@ package body Sem_Expr is
(Expr : Iir; A_Type : Iir; Is_Func_Call : Boolean) return Iir
is
Imp : Iir;
- Nbr_Inter: Natural;
A_Func: Iir;
Imp_List: Iir_List;
+ New_List : Iir_List;
Assoc_Chain: Iir;
Inter_Chain : Iir;
Res_Type: Iir_List;
+ Imp_It : List_Iterator;
Inter: Iir;
Match : Compatibility_Level;
Match_Max : Compatibility_Level;
begin
-- Sem_Name has gathered all the possible names for the prefix of this
-- call. Reduce this list to only names that match the types.
- Nbr_Inter := 0;
Imp := Get_Implementation (Expr);
Imp_List := Get_Overload_List (Imp);
Assoc_Chain := Get_Parameter_Association_Chain (Expr);
Match_Max := Via_Conversion;
- for I in Natural loop
- A_Func := Get_Nth_Element (Imp_List, I);
- exit when A_Func = Null_Iir;
+ New_List := Create_Iir_List;
+ Imp_It := List_Iterate (Imp_List);
+ while Is_Valid (Imp_It) loop
+ A_Func := Get_Element (Imp_It);
case Get_Kind (A_Func) is
when Iir_Kinds_Functions_And_Literals =>
@@ -1249,22 +1256,25 @@ package body Sem_Expr is
-- compatible, and this one is fully compatible, discard
-- previous and future Via_Conversion interpretations.
if Match > Match_Max then
- Nbr_Inter := 0;
+ Destroy_Iir_List (New_List);
+ New_List := Create_Iir_List;
Match_Max := Match;
end if;
- Replace_Nth_Element (Imp_List, Nbr_Inter, A_Func);
- Nbr_Inter := Nbr_Inter + 1;
+ Append_Element (New_List, A_Func);
end if;
end if;
<< Continue >> null;
+ Next (Imp_It);
end loop;
- Set_Nbr_Elements (Imp_List, Nbr_Inter);
+ Destroy_Iir_List (Imp_List);
+ Imp_List := New_List;
+ Set_Overload_List (Imp, Imp_List);
-- Set_Implementation (Expr, Inter_List);
-- A set of possible functions to call is in INTER_LIST.
-- Create a set of possible return type in RES_TYPE.
- case Nbr_Inter is
+ case Get_Nbr_Elements (Imp_List) is
when 0 =>
-- FIXME: display subprogram name.
Error_Msg_Sem
@@ -1301,10 +1311,11 @@ package body Sem_Expr is
-- Create the list of types for the result.
Res_Type := Create_Iir_List;
- for I in 0 .. Nbr_Inter - 1 loop
+ Imp_It := List_Iterate (Imp_List);
+ while Is_Valid (Imp_It) loop
Add_Element
- (Res_Type,
- Get_Return_Type (Get_Nth_Element (Imp_List, I)));
+ (Res_Type, Get_Return_Type (Get_Element (Imp_It)));
+ Next (Imp_It);
end loop;
if Get_Nbr_Elements (Res_Type) = 1 then
@@ -1336,6 +1347,8 @@ package body Sem_Expr is
Inter: Iir;
Assoc_Chain : Iir;
Match : Compatibility_Level;
+ Overload_List : Iir_List;
+ Overload_It : List_Iterator;
begin
if Is_Func then
Res_Type := Get_Type (Expr);
@@ -1412,21 +1425,23 @@ package body Sem_Expr is
if Is_Overload_List (Inter_List) then
-- INTER_LIST is a list of possible declaration to call.
-- Find one, based on the return type A_TYPE.
- for I in Natural loop
- Inter := Get_Nth_Element (Get_Overload_List (Inter_List), I);
- exit when Inter = Null_Iir;
+ Overload_List := Get_Overload_List (Inter_List);
+ Overload_It := List_Iterate (Overload_List);
+ while Is_Valid (Overload_It) loop
+ Inter := Get_Element (Overload_It);
if Are_Basetypes_Compatible
(A_Type, Get_Base_Type (Get_Return_Type (Inter)))
/= Not_Compatible
then
if Res /= Null_Iir then
Error_Overload (Expr);
- Disp_Overload_List (Get_Overload_List (Inter_List), Expr);
+ Disp_Overload_List (Overload_List, Expr);
return Null_Iir;
else
Res := Inter;
end if;
end if;
+ Next (Overload_It);
end loop;
else
if Are_Basetypes_Compatible
@@ -1565,6 +1580,7 @@ package body Sem_Expr is
-- attributes, like: s'length = 0
function Get_Non_Implicit_Subprogram (List : Iir_List) return Iir
is
+ It : List_Iterator;
El : Iir;
Res : Iir;
Ref_Type : Iir;
@@ -1573,9 +1589,9 @@ package body Sem_Expr is
-- 1. All the possible functions must return boolean.
-- 2. There is only one implicit function for universal or real.
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
-- Only comparison operators need this special handling.
if Get_Base_Type (Get_Return_Type (El)) /= Boolean_Type_Definition
@@ -1593,6 +1609,7 @@ package body Sem_Expr is
Res := El;
end if;
end if;
+ Next (It);
end loop;
return Res;
end Get_Non_Implicit_Subprogram;
@@ -1605,14 +1622,19 @@ package body Sem_Expr is
is
Sub1 : Iir;
Sub2 : Iir;
+ It : List_Iterator;
Res : Iir;
begin
if Get_Nbr_Elements (List) /= 2 then
return Null_Iir;
end if;
- Sub1 := Get_Nth_Element (List, 0);
- Sub2 := Get_Nth_Element (List, 1);
+ It := List_Iterate (List);
+ Sub1 := Get_Element (It);
+ Next (It);
+ Sub2 := Get_Element (It);
+ Next (It);
+ pragma Assert (not Is_Valid (It));
-- One must be an implicit declaration, the other must be an explicit
-- declaration.
@@ -1661,6 +1683,7 @@ package body Sem_Expr is
Overload : Iir;
Res_Type_List : Iir;
Full_Compat : Iir;
+ It : List_Iterator;
-- LEFT and RIGHT must be set.
function Set_Uniq_Interpretation (Decl : Iir) return Iir
@@ -1766,7 +1789,7 @@ package body Sem_Expr is
--
-- GHDL: If DECL has already been seen, then skip it.
if Get_Seen_Flag (Decl) then
- goto Next;
+ goto Continue;
end if;
-- Check return type.
@@ -1774,7 +1797,7 @@ package body Sem_Expr is
and then (Are_Types_Compatible (Res_Type, Get_Return_Type (Decl))
= Not_Compatible)
then
- goto Next;
+ goto Continue;
end if;
Interface_Chain := Get_Interface_Declaration_Chain (Decl);
@@ -1790,21 +1813,21 @@ package body Sem_Expr is
-- GHDL: So even in presence of default expression in a parameter,
-- a unary operation has to match with a binary operator.
if Iir_Chains.Get_Chain_Length (Interface_Chain) /= Arity then
- goto Next;
+ goto Continue;
end if;
-- Check operands.
if Is_Expr_Compatible (Get_Type (Interface_Chain), Left)
= Not_Compatible
then
- goto Next;
+ goto Continue;
end if;
if Arity = 2 then
if Is_Expr_Compatible (Get_Type (Get_Chain (Interface_Chain)),
Right)
= Not_Compatible
then
- goto Next;
+ goto Continue;
end if;
end if;
@@ -1812,15 +1835,15 @@ package body Sem_Expr is
Set_Seen_Flag (Decl, True);
Append_Element (Overload_List, Decl);
- << Next >> null;
+ << Continue >> null;
Interpretation := Get_Next_Interpretation (Interpretation);
end loop;
-- Clear seen_flags.
- for I in Natural loop
- Decl := Get_Nth_Element (Overload_List, I);
- exit when Decl = Null_Iir;
- Set_Seen_Flag (Decl, False);
+ It := List_Iterate (Overload_List);
+ while Is_Valid (It) loop
+ Set_Seen_Flag (Get_Element (It), False);
+ Next (It);
end loop;
-- The list of possible implementations was computed.
@@ -1892,9 +1915,9 @@ package body Sem_Expr is
Overload := Get_Implementation (Expr);
Overload_List := Get_Overload_List (Overload);
Full_Compat := Null_Iir;
- for I in Natural loop
- Decl := Get_Nth_Element (Overload_List, I);
- exit when Decl = Null_Iir;
+ It := List_Iterate (Overload_List);
+ while Is_Valid (It) loop
+ Decl := Get_Element (It);
-- FIXME: wrong: compatibilty with return type and args.
if Are_Types_Compatible (Get_Return_Type (Decl), Res_Type)
/= Not_Compatible
@@ -1906,6 +1929,7 @@ package body Sem_Expr is
Full_Compat := Decl;
end if;
end if;
+ Next (It);
end loop;
Free_Iir (Overload);
Overload := Get_Type (Expr);
@@ -4252,6 +4276,7 @@ package body Sem_Expr is
return Iir
is
Types_List_List : Iir_List;
+ It : List_Iterator;
El: Iir;
Com : Iir;
Res : Iir;
@@ -4261,13 +4286,14 @@ package body Sem_Expr is
else
Types_List_List := Get_Overload_List (Types_List);
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (Types_List_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Types_List_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Com := Compatible_Types_Intersect_Single (El, A_Type);
if Com /= Null_Iir then
Add_Result (Res, Com);
end if;
+ Next (It);
end loop;
return Res;
end if;
@@ -4276,6 +4302,7 @@ package body Sem_Expr is
function Compatible_Types_Intersect (List1, List2 : Iir) return Iir
is
List1_List : Iir_List;
+ It1 : List_Iterator;
Res : Iir;
El : Iir;
Tmp : Iir;
@@ -4287,13 +4314,14 @@ package body Sem_Expr is
if Is_Overload_List (List1) then
List1_List := Get_Overload_List (List1);
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List1_List, I);
- exit when El = Null_Iir;
+ It1 := List_Iterate (List1_List);
+ while Is_Valid (It1) loop
+ El := Get_Element (It1);
Tmp := Compatible_Types_Intersect_Single_List (El, List2);
if Tmp /= Null_Iir then
Add_Result (Res, Tmp);
end if;
+ Next (It1);
end loop;
return Res;
else
@@ -4551,16 +4579,18 @@ package body Sem_Expr is
elsif Is_Overload_List (Get_Type (Res)) then
declare
List : constant Iir_List := Get_Overload_List (Get_Type (Res));
+ It : List_Iterator;
Res_Type : Iir;
Atype : Iir;
begin
Res_Type := Null_Iir;
- for I in Natural loop
- Atype := Get_Nth_Element (List, I);
- exit when Atype = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ Atype := Get_Element (It);
if Is_Aggregate_Type (Atype) then
Add_Result (Res_Type, Atype);
end if;
+ Next (It);
end loop;
if Res_Type = Null_Iir then
@@ -4589,6 +4619,7 @@ package body Sem_Expr is
El : Iir;
Res : Iir;
List : Iir_List;
+ It : List_Iterator;
begin
Expr1 := Sem_Expression_Ov (Expr, Null_Iir);
if Expr1 = Null_Iir then
@@ -4606,9 +4637,9 @@ package body Sem_Expr is
List := Get_Overload_List (Expr_Type);
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if El = Universal_Integer_Type_Definition
or El = Convertible_Integer_Type_Definition
or El = Universal_Real_Type_Definition
@@ -4622,6 +4653,7 @@ package body Sem_Expr is
return Null_Iir;
end if;
end if;
+ Next (It);
end loop;
if Res = Null_Iir then
Error_Overload (Expr1);
@@ -4638,6 +4670,7 @@ package body Sem_Expr is
El : Iir;
Res : Iir;
List : Iir_List;
+ It : List_Iterator;
begin
Expr1 := Sem_Expression_Ov (Expr, Null_Iir);
if Expr1 = Null_Iir then
@@ -4668,9 +4701,9 @@ package body Sem_Expr is
-- of a discrete type or a one-dimensional character array type.
List := Get_Overload_List (Expr_Type);
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Get_Kind (El) in Iir_Kinds_Discrete_Type_Definition
or else Is_One_Dimensional_Array_Type (El)
then
@@ -4682,6 +4715,7 @@ package body Sem_Expr is
return Null_Iir;
end if;
end if;
+ Next (It);
end loop;
if Res = Null_Iir then
Error_Overload (Expr1);
@@ -4747,22 +4781,24 @@ package body Sem_Expr is
else
-- Many interpretations.
declare
- El : Iir;
Res_List : constant Iir_List :=
Get_Overload_List (Get_Type (Res));
+ It : List_Iterator;
+ El : Iir;
Nbr_Booleans : Natural;
begin
Nbr_Booleans := 0;
-- Extract boolean interpretations.
- for I in Natural loop
- El := Get_Nth_Element (Res_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Res_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Are_Types_Compatible (El, Boolean_Type_Definition)
/= Not_Compatible
then
Nbr_Booleans := Nbr_Booleans + 1;
end if;
+ Next (It);
end loop;
if Nbr_Booleans >= 1 then
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index 30785dbb3..9599da8d2 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -168,6 +168,7 @@ package body Sem_Inst is
return Iir_List
is
Res : Iir_List;
+ It : List_Iterator;
El : Iir;
begin
case L is
@@ -176,10 +177,11 @@ package body Sem_Inst is
return L;
when others =>
Res := Create_Iir_List;
- for I in Natural loop
- El := Get_Nth_Element (L, I);
- exit when El = Null_Iir;
+ It := List_Iterate (L);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Append_Element (Res, Instantiate_Iir (El, Is_Ref));
+ Next (It);
end loop;
return Res;
end case;
@@ -752,6 +754,7 @@ package body Sem_Inst is
is
El : Iir;
El_Inst : Iir;
+ It, It_Inst : List_Iterator;
begin
case N is
when Null_Iir_List
@@ -759,15 +762,19 @@ package body Sem_Inst is
pragma Assert (Inst = N);
return;
when others =>
- for I in Natural loop
- El := Get_Nth_Element (N, I);
- El_Inst := Get_Nth_Element (Inst, I);
- exit when El = Null_Iir;
- pragma Assert (El_Inst /= Null_Iir);
+ It := List_Iterate (N);
+ It_Inst := List_Iterate (Inst);
+ while Is_Valid (It) loop
+ pragma Assert (Is_Valid (It_Inst));
+ El := Get_Element (It);
+ El_Inst := Get_Element (It_Inst);
Set_Instance_On_Iir (El, El_Inst);
+
+ Next (It);
+ Next (It_Inst);
end loop;
- pragma Assert (El_Inst = Null_Iir);
+ pragma Assert (not Is_Valid (It_Inst));
end case;
end Set_Instance_On_Iir_List;
@@ -1120,18 +1127,17 @@ package body Sem_Inst is
procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir)
is
- El : Iir;
+ It : List_Iterator;
begin
case L is
when Null_Iir_List
| Iir_List_All =>
return;
when others =>
- for I in Natural loop
- El := Get_Nth_Element (L, I);
- exit when El = Null_Iir;
-
- Substitute_On_Iir (El, E, Rep);
+ It := List_Iterate (L);
+ while Is_Valid (It) loop
+ Substitute_On_Iir (Get_Element (It), E, Rep);
+ Next (It);
end loop;
end case;
end Substitute_On_Iir_List;
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 98b7e01bb..a863c3118 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -59,11 +59,12 @@ package body Sem_Names is
procedure Disp_Overload_List (List : Iir_List; Loc : Iir)
is
El : Iir;
+ It : List_Iterator;
begin
Error_Msg_Sem (+Loc, "possible interpretations are:", Cont => True);
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
case Get_Kind (El) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
@@ -74,6 +75,7 @@ package body Sem_Names is
when others =>
Error_Msg_Sem (+El, "%n", +El);
end case;
+ Next (It);
end loop;
end Disp_Overload_List;
@@ -150,12 +152,13 @@ package body Sem_Names is
is
Res_List : Iir_List;
Decl : Iir;
+ It : List_Iterator;
begin
-- Create the list of possible return types.
Res_List := Create_Iir_List;
- for I in Natural loop
- Decl := Get_Nth_Element (List, I);
- exit when Decl = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ Decl := Get_Element (It);
case Get_Kind (Decl) is
when Iir_Kind_Function_Declaration =>
Add_Element (Res_List, Get_Return_Type (Decl));
@@ -168,6 +171,7 @@ package body Sem_Names is
when others =>
Error_Kind ("create_list_of_types", Decl);
end case;
+ Next (It);
end loop;
return Simplify_Overload_List (Res_List);
end Create_List_Of_Types;
@@ -202,15 +206,16 @@ package body Sem_Names is
is
pragma Assert (Is_Overload_List (Res));
List : constant Iir_List := Get_Overload_List (Res);
+ It : List_Iterator;
Call : Iir;
El : Iir;
Imp : Iir;
Inter : Iir;
begin
Call := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Get_Kind (El) = Iir_Kind_Function_Call then
Imp := Get_Implementation (El);
Inter := Get_Interface_Declaration_Chain (Imp);
@@ -233,6 +238,7 @@ package body Sem_Names is
else
return Null_Iir;
end if;
+ Next (It);
end loop;
return Call;
@@ -248,6 +254,7 @@ package body Sem_Names is
El : Iir;
List_List : Iir_List;
Res_List : Iir_List;
+ It : List_Iterator;
begin
if Res = Null_Iir then
Res := List;
@@ -263,10 +270,10 @@ package body Sem_Names is
end if;
List_List := Get_Overload_List (List);
Res_List := Get_Overload_List (Res);
- for I in Natural loop
- El := Get_Nth_Element (List_List, I);
- exit when El = Null_Iir;
- Append_Element (Res_List, El);
+ It := List_Iterate (List_List);
+ while Is_Valid (It) loop
+ Append_Element (Res_List, Get_Element (It));
+ Next (It);
end loop;
Free_Iir (List);
end if;
@@ -302,6 +309,7 @@ package body Sem_Names is
El : Iir;
List_List : Iir_List;
+ It : List_Iterator;
begin
if List = Null_Iir then
return;
@@ -311,12 +319,13 @@ package body Sem_Names is
end if;
else
List_List := Get_Overload_List (List);
- for I in Natural loop
- El := Get_Nth_Element (List_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if El /= Keep then
Sem_Name_Free (El);
end if;
+ Next (It);
end loop;
Free_Iir (List);
end if;
@@ -1804,6 +1813,7 @@ package body Sem_Names is
Interpretation: Name_Interpretation_Type;
Res: Iir;
Res_List : Iir_List;
+ Res_It : List_Iterator;
N : Natural;
begin
Interpretation := Get_Interpretation (Id);
@@ -1874,9 +1884,10 @@ package body Sem_Names is
-- FIXME: there can be only one element (a function and its alias!).
-- Clear SEEN_FLAG.
- for I in 0 .. N - 1 loop
- Res := Get_Nth_Element (Res_List, I);
- Set_Seen_Flag (Res, False);
+ Res_It := List_Iterate (Res_List);
+ while Is_Valid (Res_It) loop
+ Set_Seen_Flag (Get_Element (Res_It), False);
+ Next (Res_It);
end loop;
Res := Create_Overload_List (Res_List);
@@ -2071,13 +2082,14 @@ package body Sem_Names is
-- of the prefix as a function call are considered.
declare
Prefix_List : Iir_List;
+ It : List_Iterator;
El : Iir;
begin
-- So, first try as expanded name.
Prefix_List := Get_Overload_List (Prefix);
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Prefix_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
case Get_Kind (El) is
when Iir_Kind_Function_Call =>
-- Not an expanded name.
@@ -2085,13 +2097,14 @@ package body Sem_Names is
when others =>
Sem_As_Expanded_Name (El);
end case;
+ Next (It);
end loop;
-- If no expanded name are found, try as selected element.
if Res = Null_Iir then
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Prefix_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
case Get_Kind (El) is
when Iir_Kind_Procedure_Declaration =>
-- A procedure cannot be the prefix of a selected
@@ -2100,6 +2113,7 @@ package body Sem_Names is
when others =>
Sem_As_Selected_Element (El);
end case;
+ Next (It);
end loop;
end if;
end;
@@ -2625,12 +2639,14 @@ package body Sem_Names is
declare
El : Iir;
Prefix_List : Iir_List;
+ It : List_Iterator;
begin
Prefix_List := Get_Overload_List (Prefix);
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (Prefix_List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Sem_Parenthesis_Function (El);
+ Next (It);
end loop;
-- Some prefixes may have been removed, replace with the
-- rebuilt prefix list.
@@ -2783,14 +2799,13 @@ package body Sem_Names is
case Get_Kind (Prefix) is
when Iir_Kind_Overload_List =>
declare
- Prefix_List : Iir_List;
- El : Iir;
+ Prefix_List : constant Iir_List := Get_Overload_List (Prefix);
+ It : List_Iterator;
begin
- Prefix_List := Get_Overload_List (Prefix);
- for I in Natural loop
- El := Get_Nth_Element (Prefix_List, I);
- exit when El = Null_Iir;
- Sem_As_Selected_By_All_Name (El);
+ It := List_Iterate (Prefix_List);
+ while Is_Valid (It) loop
+ Sem_As_Selected_By_All_Name (Get_Element (It));
+ Next (It);
end loop;
end;
when Iir_Kinds_Object_Declaration
@@ -3828,40 +3843,43 @@ package body Sem_Names is
function Remove_Procedures_From_List (Expr : Iir) return Iir
is
El : Iir;
- P : Natural;
List : Iir_List;
+ It : List_Iterator;
+ New_List : Iir_List;
begin
if not Is_Overload_List (Expr) then
return Expr;
end if;
List := Get_Overload_List (Expr);
- P := 0;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ New_List := Create_Iir_List;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
case Get_Kind (El) is
when Iir_Kind_Procedure_Declaration =>
null;
when Iir_Kind_Function_Declaration =>
if Maybe_Function_Call (El) then
- Replace_Nth_Element (List, P, El);
- P := P + 1;
+ Append_Element (New_List, El);
end if;
when others =>
- Replace_Nth_Element (List, P, El);
- P := P + 1;
+ Append_Element (New_List, El);
end case;
+ Next (It);
end loop;
- case P is
+ case Get_Nbr_Elements (New_List) is
when 0 =>
Free_Iir (Expr);
+ Destroy_Iir_List (New_List);
return Null_Iir;
when 1 =>
- El := Get_First_Element (List);
Free_Iir (Expr);
+ El := Get_First_Element (New_List);
+ Destroy_Iir_List (New_List);
return El;
when others =>
- Set_Nbr_Elements (List, P);
+ Set_Overload_List (Expr, New_List);
+ Destroy_Iir_List (List);
return Expr;
end case;
end Remove_Procedures_From_List;
@@ -3887,6 +3905,7 @@ package body Sem_Names is
Res_Type : Iir;
Expr : Iir;
Expr_List : Iir_List;
+ Expr_It : List_Iterator;
Res : Iir;
Res1 : Iir;
El : Iir;
@@ -3930,15 +3949,16 @@ package body Sem_Names is
if A_Type /= Null_Iir then
-- Find the name returning A_TYPE.
Res := Null_Iir;
- for I in Natural loop
- El := Get_Nth_Element (Expr_List, I);
- exit when El = Null_Iir;
+ Expr_It := List_Iterate (Expr_List);
+ while Is_Valid (Expr_It) loop
+ El := Get_Element (Expr_It);
if Are_Basetypes_Compatible (Get_Base_Type (Get_Type (El)),
A_Type)
/= Not_Compatible
then
Add_Result (Res, El);
end if;
+ Next (Expr_It);
end loop;
if Res = Null_Iir then
-- Specific error message for a non-visible enumeration
diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb
index 4db8ffdf3..30d33d8fc 100644
--- a/src/vhdl/sem_scopes.adb
+++ b/src/vhdl/sem_scopes.adb
@@ -1136,15 +1136,17 @@ package body Sem_Scopes is
procedure Iterator_Decl_List (Decl_List : Iir_List; Arg : Arg_Type)
is
- Decl: Iir;
+ Decl : Iir;
+ It : List_Iterator;
begin
if Decl_List = Null_Iir_List then
return;
end if;
- for I in Natural loop
- Decl := Get_Nth_Element (Decl_List, I);
- exit when Decl = Null_Iir;
+ It := List_Iterate (Decl_List);
+ while Is_Valid (It) loop
+ Decl := Get_Element (It);
Handle_Decl (Decl, Arg);
+ Next (It);
end loop;
end Iterator_Decl_List;
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index ff6537a55..f80a28cde 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -1124,6 +1124,7 @@ package body Sem_Stmts is
procedure Sem_Sensitivity_List (List: Iir_List)
is
El: Iir;
+ It : List_Iterator;
Res: Iir;
Prefix : Iir;
begin
@@ -1131,10 +1132,10 @@ package body Sem_Stmts is
return;
end if;
- for I in Natural loop
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
-- El is an iir_identifier.
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ El := Get_Element (It);
Sem_Name (El);
@@ -1175,8 +1176,10 @@ package body Sem_Stmts is
(+El, "sensitivity element %n must be a static name", +Res);
end if;
- Replace_Nth_Element (List, I, Res);
+ Set_Element (It, Res);
end if;
+
+ Next (It);
end loop;
end Sem_Sensitivity_List;
diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb
index a931d7409..aed9942cf 100644
--- a/src/vhdl/sem_types.adb
+++ b/src/vhdl/sem_types.adb
@@ -1299,6 +1299,7 @@ package body Sem_Types is
Res: Iir;
El : Iir;
List : Iir_List;
+ It : List_Iterator;
Has_Error : Boolean;
Name1 : Iir;
begin
@@ -1314,9 +1315,9 @@ package body Sem_Types is
if Is_Overload_List (Func) then
List := Get_Overload_List (Func);
Has_Error := False;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Is_A_Resolution_Function (El, Atype) then
if Res /= Null_Iir then
if not Has_Error then
@@ -1333,6 +1334,7 @@ package body Sem_Types is
Res := El;
end if;
end if;
+ Next (It);
end loop;
Free_Overload_List (Func);
if Has_Error then
diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb
index 28883babb..920271fa0 100644
--- a/src/vhdl/translate/trans-chap12.adb
+++ b/src/vhdl/translate/trans-chap12.adb
@@ -436,6 +436,7 @@ package body Trans.Chap12 is
Dep_List : Iir_List;
Dep : Iir;
Dep_Unit : Iir_Design_Unit;
+ Dep_It : List_Iterator;
Lib_Unit : Iir;
begin
-- Load the unit in memory to compute the dependence list.
@@ -475,15 +476,16 @@ package body Trans.Chap12 is
end case;
Dep_List := Get_Dependence_List (Unit);
- for I in Natural loop
- Dep := Get_Nth_Element (Dep_List, I);
- exit when Dep = Null_Iir;
+ Dep_It := List_Iterate (Dep_List);
+ while Is_Valid (Dep_It) loop
+ Dep := Get_Element (Dep_It);
Dep_Unit := Libraries.Find_Design_Unit (Dep);
if Dep_Unit = Null_Iir then
Error_Msg_Elab ("could not find design unit %n", +Dep);
elsif not Get_Elab_Flag (Dep_Unit) then
Add_Unit_Dependences (Dep_Unit);
end if;
+ Next (Dep_It);
end loop;
end Add_Unit_Dependences;
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index c3260008f..41913c452 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -1118,17 +1118,17 @@ package body Trans.Chap2 is
procedure Instantiate_Iir_List_Info (L : Iir_List)
is
- El : Iir;
+ It : List_Iterator;
begin
case L is
when Null_Iir_List
| Iir_List_All =>
return;
when others =>
- for I in Natural loop
- El := Get_Nth_Element (L, I);
- exit when El = Null_Iir;
- Instantiate_Iir_Info (El);
+ It := List_Iterate (L);
+ while Is_Valid (It) loop
+ Instantiate_Iir_Info (Get_Element (It));
+ Next (It);
end loop;
end case;
end Instantiate_Iir_List_Info;
@@ -1704,15 +1704,14 @@ package body Trans.Chap2 is
procedure Elab_Dependence (Design_Unit: Iir_Design_Unit)
is
- Depend_List : Iir_Design_Unit_List;
+ Depend_List : constant Iir_List := Get_Dependence_List (Design_Unit);
+ It : List_Iterator;
Design : Iir;
Library_Unit: Iir;
begin
- Depend_List := Get_Dependence_List (Design_Unit);
-
- for I in Natural loop
- Design := Get_Nth_Element (Depend_List, I);
- exit when Design = Null_Iir;
+ It := List_Iterate (Depend_List);
+ while Is_Valid (It) loop
+ Design := Get_Element (It);
if Get_Kind (Design) = Iir_Kind_Design_Unit then
Library_Unit := Get_Library_Unit (Design);
case Get_Kind (Library_Unit) is
@@ -1737,6 +1736,7 @@ package body Trans.Chap2 is
Error_Kind ("elab_dependence", Library_Unit);
end case;
end if;
+ Next (It);
end loop;
end Elab_Dependence;
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index 0b2d3dc2a..3948bbe0b 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -241,6 +241,7 @@ package body Trans.Chap9 is
Info : Ortho_Info_Acc;
Drivers : Iir_List;
+ It : List_Iterator;
Nbr_Drivers : Natural;
Sig : Iir;
begin
@@ -273,8 +274,10 @@ package body Trans.Chap9 is
Nbr_Drivers := Get_Nbr_Elements (Drivers);
Info.Process_Drivers := new Direct_Driver_Arr (1 .. Nbr_Drivers);
+ It := List_Iterate (Drivers);
for I in 1 .. Nbr_Drivers loop
- Sig := Get_Nth_Element (Drivers, I - 1);
+ pragma Assert (Is_Valid (It));
+ Sig := Get_Element (It);
Info.Process_Drivers (I) := (Sig => Sig, Var => Null_Var);
Sig := Get_Object_Prefix (Sig);
pragma Assert
@@ -288,7 +291,9 @@ package body Trans.Chap9 is
-- Do not create driver severals times.
Set_After_Drivers_Flag (Sig, True);
end if;
+ Next (It);
end loop;
+ pragma Assert (not Is_Valid (It));
Trans_Analyzes.Free_Drivers_List (Drivers);
end if;
Pop_Instance_Factory (Info.Process_Scope'Access);
@@ -1112,16 +1117,18 @@ package body Trans.Chap9 is
procedure Destroy_Types_In_List (L : Iir_List)
is
El : Iir;
+ It : List_Iterator;
begin
case L is
when Null_Iir_List
| Iir_List_All =>
return;
when others =>
- for I in Natural loop
- El := Get_Nth_Element (L, I);
- exit when El = Null_Iir;
+ It := List_Iterate (L);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Destroy_Types (El);
+ Next (It);
end loop;
end case;
end Destroy_Types_In_List;
diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb
index c1aab8e5f..d332711ac 100644
--- a/src/vhdl/translate/trans-helpers2.adb
+++ b/src/vhdl/translate/trans-helpers2.adb
@@ -211,19 +211,18 @@ package body Trans.Helpers2 is
procedure Register_Signal_List (List : Iir_List; Proc : O_Dnode)
is
+ It : List_Iterator;
El : Iir;
Sig : Mnode;
begin
- if List = Null_Iir_List then
- return;
- end if;
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate_Safe (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
Open_Temp;
Sig := Chap6.Translate_Name (El, Mode_Signal);
Register_Signal (Sig, Get_Type (El), Proc);
Close_Temp;
+ Next (It);
end loop;
end Register_Signal_List;
diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb
index 32b9fac65..09c822d2f 100644
--- a/src/vhdl/translate/trans_analyzes.adb
+++ b/src/vhdl/translate/trans_analyzes.adb
@@ -217,12 +217,12 @@ package body Trans_Analyzes is
procedure Free_Drivers_List (List : in out Iir_List)
is
- El : Iir;
+ It : List_Iterator;
begin
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
- Set_After_Drivers_Flag (Get_Object_Prefix (El), False);
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ Set_After_Drivers_Flag (Get_Object_Prefix (Get_Element (It)), False);
+ Next (It);
end loop;
Destroy_Iir_List (List);
end Free_Drivers_List;
@@ -232,14 +232,15 @@ package body Trans_Analyzes is
use Ada.Text_IO;
use Errorout;
El : Iir;
+ It : List_Iterator;
begin
Report_Msg (Msgid_Note, Semantic, +Proc,
"List of drivers for %n:", (1 => +Proc));
Report_Msg (Msgid_Note, Semantic, +Proc,
" (declared at %l)", (1 => +Proc));
- for I in Natural loop
- El := Get_Nth_Element (List, I);
- exit when El = Null_Iir;
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ El := Get_Element (It);
if Get_After_Drivers_Flag (Get_Object_Prefix (El)) then
Put ("* ");
else
@@ -247,6 +248,7 @@ package body Trans_Analyzes is
end if;
Disp_Vhdl.Disp_Vhdl (El);
New_Line;
+ Next (It);
end loop;
end Dump_Drivers;