diff options
| author | Tristan Gingold <tgingold@free.fr> | 2017-11-11 08:48:28 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2017-11-11 08:48:28 +0100 |
| commit | e8a21ffe5226aad4970bd1facd4a3464a4b436f1 (patch) | |
| tree | 6dabc27375bc31dbd435d50a98dc223fa4145ac2 /src | |
| parent | 9a90393e30827308ec6cd834963f5359158115a0 (diff) | |
| download | ghdl-e8a21ffe5226aad4970bd1facd4a3464a4b436f1.tar.gz ghdl-e8a21ffe5226aad4970bd1facd4a3464a4b436f1.tar.bz2 ghdl-e8a21ffe5226aad4970bd1facd4a3464a4b436f1.zip | |
Rework list implementation, use iterator.
Diffstat (limited to 'src')
29 files changed, 603 insertions, 392 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 9b45584d2..56487b863 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -594,6 +594,7 @@ package body Ghdlcomp is Files_List : Iir_List; File : Iir_Design_File; + It : List_Iterator; Next_Arg : Natural; Date : Date_Type; @@ -614,9 +615,9 @@ package body Ghdlcomp is end loop; Date := Get_Date (Libraries.Work_Library); - for I in Natural loop - File := Get_Nth_Element (Files_List, I); - exit when File = Null_Iir; + It := List_Iterate (Files_List); + while Is_Valid (It) loop + File := Get_Element (It); if File = Std_Package.Std_Standard_File then null; @@ -645,6 +646,8 @@ package body Ghdlcomp is -- Need to be written to disk. Set_Elab_Flag (Lib, True); end if; + + Next (It); end loop; -- Save modified libraries. @@ -730,6 +733,7 @@ package body Ghdlcomp is HT : constant Character := Ada.Characters.Latin_1.HT; Files_List : Iir_List; File : Iir_Design_File; + Files_It : List_Iterator; Lib : Iir_Library_Declaration; Dir_Id : Name_Id; @@ -820,9 +824,9 @@ package body Ghdlcomp is Put_Line ("# Targets to analyze libraries"); Put_Line ("init: force"); - for I in Natural loop - File := Get_Nth_Element (Files_List, I); - exit when File = Null_Iir; + Files_It := List_Iterate (Files_List); + while Is_Valid (Files_It) loop + File := Get_Element (Files_It); Dir_Id := Get_Design_File_Directory (File); if not Is_Makeable_File (File) then -- Builtin file. @@ -853,6 +857,7 @@ package body Ghdlcomp is Put (Image (Get_Design_File_Filename (File))); New_Line; end if; + Next (Files_It); end loop; New_Line; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 88c887418..ff3531c27 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -1274,6 +1274,7 @@ package body Ghdllocal is is El : Iir_Design_File; Depend_List : Iir_List; + Depend_It : List_Iterator; begin if Get_Elab_Flag (File) then return; @@ -1282,10 +1283,11 @@ package body Ghdllocal is Set_Elab_Flag (File, True); Depend_List := Get_File_Dependence_List (File); if Depend_List /= Null_Iir_List then - for I in Natural loop - El := Get_Nth_Element (Depend_List, I); - exit when El = Null_Iir; + Depend_It := List_Iterate (Depend_List); + while Is_Valid (Depend_It) loop + El := Get_Element (Depend_It); Build_Dependence_List (El, List); + Next (Depend_It); end loop; end if; Append_Element (List, File); @@ -1450,14 +1452,15 @@ package body Ghdllocal is Depends : constant Iir_List := Get_Dependence_List (Unit); Stamp : constant Time_Stamp_Id := Get_Analysis_Time_Stamp (File); + Depends_It : List_Iterator; El : Iir; Dep : Iir_Design_Unit; Dep_File : Iir_Design_File; begin if Depends /= Null_Iir_List then - for I in Natural loop - El := Get_Nth_Element (Depends, I); - exit when El = Null_Iir; + Depends_It := List_Iterate (Depends); + while Is_Valid (Depends_It) loop + El := Get_Element (Depends_It); Dep := Libraries.Find_Design_Unit (El); if Dep = Null_Iir then if Flag_Verbose then @@ -1483,6 +1486,7 @@ package body Ghdllocal is end if; return True; end if; + Next (Depends_It); end loop; end if; end; diff --git a/src/ghdldrv/ghdlxml.adb b/src/ghdldrv/ghdlxml.adb index 6bad81aad..9913aaf76 100644 --- a/src/ghdldrv/ghdlxml.adb +++ b/src/ghdldrv/ghdlxml.adb @@ -234,6 +234,7 @@ package body Ghdlxml is procedure Disp_Iir_List (Id : String; L : Iir_List; Ref : Boolean) is El : Iir; + It : List_Iterator; begin case L is when Null_Iir_List => @@ -249,14 +250,15 @@ package body Ghdlxml is Put_Attribute ("list-id", Strip (Iir_List'Image (L))); Put_Stag_End; - 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); if Ref then - Disp_Iir_Ref ("el", El); + Disp_Iir_Ref ("el", El); else Disp_Iir ("el", El); end if; + Next (It); end loop; Put_Etag (Id); diff --git a/src/libraries.adb b/src/libraries.adb index 966bec0bf..c61084db6 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -918,14 +918,15 @@ package body Libraries is Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit)); U_Ts : Time_Stamp_Id; El : Iir; + It : List_Iterator; begin if List = Null_Iir_List then return False; end if; - 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_Design_Unit then U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (El)); if Files_Map.Is_Gt (U_Ts, Du_Ts) then @@ -934,6 +935,7 @@ package body Libraries is return True; end if; end if; + Next (It); end loop; return False; @@ -942,6 +944,7 @@ package body Libraries is procedure Explain_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) is List : Iir_List; + It : List_Iterator; El : Iir; begin pragma Assert (Get_Date_State (Design_Unit) = Date_Analyze); @@ -954,13 +957,14 @@ package body Libraries is return; end if; - 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_Date (El) = Date_Obsolete then Error_Obsolete (Loc, "%n is obsoleted by %n", (+Design_Unit, +El)); return; end if; + Next (It); end loop; end Explain_Obsolete; @@ -970,6 +974,7 @@ package body Libraries is is Lib, File, Un : Iir; List : Iir_List; + It : List_Iterator; El : Iir; begin Set_Date (Unit, Date_Obsolete); @@ -987,21 +992,22 @@ package body Libraries is then pragma Assert (Get_Date_State (Un) = Date_Analyze); - 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_Design_Unit (El, Unit) then -- Keep direct reference (for speed-up). if Get_Kind (El) /= Iir_Kind_Design_Unit then Iirs_Utils.Free_Recursive (El); - Replace_Nth_Element (List, I, Unit); + Set_Element (It, Unit); end if; -- Recurse. Mark_Unit_Obsolete (Un); end if; + Next (It); end loop; end if; @@ -1016,15 +1022,10 @@ package body Libraries is procedure Free_Dependence_List (Design : Iir_Design_Unit) is List : Iir_List; - El : Iir; begin List := Get_Dependence_List (Design); if List /= Null_Iir_List then - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Iirs_Utils.Free_Recursive (El); - end loop; + Free_Recursive_List (List); Destroy_Iir_List (List); end if; end Free_Dependence_List; diff --git a/src/lists.adb b/src/lists.adb index 211865dba..37a5f74da 100644 --- a/src/lists.adb +++ b/src/lists.adb @@ -54,6 +54,11 @@ package body Lists is 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; @@ -207,4 +212,50 @@ package body Lists is Listt.Init; end Initialize; + function Iterate (List : List_Type) return Iterator is + begin + return Iterator'(List => List, + Len => Get_Nbr_Elements (List), + Idx => 0); + 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); + end if; + return Iterate (List); + end Iterate_Safe; + + function Is_Valid (It : Iterator) return Boolean is + begin + return It.Idx < It.Len; + 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; + end Next; + + function Get_Element (It : Iterator) return Node_Type is + begin + return Get_Nth_Element (It.List, It.Idx); + end Get_Element; + + procedure Set_Element (It : Iterator; El : Node_Type) is + begin + Replace_Nth_Element (It.List, It.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 c8ea274cf..9f5729e9b 100644 --- a/src/lists.ads +++ b/src/lists.ads @@ -61,46 +61,66 @@ package Lists is -- Set the number of elements in the list. -- Can be used only to shrink the list. -- procedure Set_Nbr_Elements (List: in Iir_List; N: Natural); - -- - -- Return the position of the last element. - -- Return -1 if the list is empty. - -- function Get_Last_Element_Position (List: in Iir_List) return Integer; - -- - -- Empty the list. - -- This is also set_nbr_elements (list, 0); - -- procedure Empty_List (List: in Iir_List); - -- - -- Alias a list. TARGET must be empty. - -- procedure Alias_List (Target: in out Iir; Source: in Iir); - procedure Append_Element (List: List_Type; Element: Node_Type); + -- Create a list. + function Create_List return List_Type; - -- Get the N th element in list, starting from 0. - -- Return the element or null_iir, if beyond bounds. - function Get_Nth_Element (List: List_Type; N: Natural) return Node_Type; + -- Destroy a list. + procedure Destroy_List (List : in out List_Type); + + -- Free all the lists and reset to initial state. + -- Must be used to free the memory used by the lists. + procedure Initialize; - function Get_First_Element (List: List_Type) return Node_Type; + -- Append ELEMENT to the list. + procedure Append_Element (List : List_Type; Element : Node_Type); - procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type); + -- Return the first element of the list. + function Get_First_Element (List : List_Type) return Node_Type; - procedure Add_Element (List: List_Type; El: Node_Type); + procedure Add_Element (List : List_Type; El : Node_Type); -- Return the number of elements in the list. -- This is also 1 + the position of the last element. function Get_Nbr_Elements (List: List_Type) return Natural; pragma Inline (Get_Nbr_Elements); + -- 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); - -- Create a list. - function Create_List return List_Type; + -- Iterator. The idiomatic way to iterate is: + -- It := Iterate (List); + -- while Is_Valid (It) loop + -- El := Get_Element (It); + -- ... + -- Next (It); + -- end loop; + type Iterator is private; - -- Destroy a list. - procedure Destroy_List (List : in out List_Type); + 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); - -- Free all the lists and reset to initial state. - -- Must be used to free the memory used by the lists. - procedure Initialize; + 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 Iterator is record + List : List_Type; + Len : Natural; + Idx : Natural; + end record; + + pragma Inline (Is_Valid); + pragma Inline (Next); + pragma Inline (Get_Element); end Lists; 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; |