diff options
| author | Tristan Gingold <tgingold@free.fr> | 2017-11-06 20:20:52 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2017-11-06 20:20:52 +0100 |
| commit | 1984d2adb083153f03eb7775d956445772ca484f (patch) | |
| tree | 92939d572fd44940755e30d3963101c0a797f9e7 /src/vhdl | |
| parent | f9dd14670a2b17575bc879f82030faaaabdbbea6 (diff) | |
| download | ghdl-1984d2adb083153f03eb7775d956445772ca484f.tar.gz ghdl-1984d2adb083153f03eb7775d956445772ca484f.tar.bz2 ghdl-1984d2adb083153f03eb7775d956445772ca484f.zip | |
Use Flist for array indexes.
Diffstat (limited to 'src/vhdl')
32 files changed, 545 insertions, 319 deletions
diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index 5ae507c5f..ed920f89a 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -108,7 +108,6 @@ package body Canon is (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is El : Iir; - List: Iir_List; begin if Get_Expr_Staticness (Expr) /= None then return; @@ -162,12 +161,15 @@ package body Canon is Canon_Extract_Sensitivity (Get_Prefix (Expr), Sensitivity_List, Is_Target); - List := Get_Index_List (Expr); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Canon_Extract_Sensitivity (El, Sensitivity_List, False); - end loop; + declare + Flist : constant Iir_Flist := Get_Index_List (Expr); + El : Iir; + begin + for I in Flist_First .. Flist_Last (Flist) loop + El := Get_Nth_Element (Flist, I); + Canon_Extract_Sensitivity (El, Sensitivity_List, False); + end loop; + end; end if; when Iir_Kind_Function_Call => @@ -643,10 +645,7 @@ package body Canon is end Canon_Aggregate_Expression; -- canon on expressions, mainly for function calls. - procedure Canon_Expression (Expr: Iir) - is - El : Iir; - List: Iir_List; + procedure Canon_Expression (Expr: Iir) is begin if Expr = Null_Iir then return; @@ -669,12 +668,15 @@ package body Canon is when Iir_Kind_Indexed_Name => Canon_Expression (Get_Prefix (Expr)); - List := Get_Index_List (Expr); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Canon_Expression (El); - end loop; + declare + Flist : constant Iir_Flist := Get_Index_List (Expr); + El : Iir; + begin + for I in Flist_First .. Flist_Last (Flist) loop + El := Get_Nth_Element (Flist, I); + Canon_Expression (El); + end loop; + end; when Iir_Kind_Selected_Element => Canon_Expression (Get_Prefix (Expr)); @@ -2634,12 +2636,11 @@ package body Canon is case Get_Kind (Def) is when Iir_Kind_Array_Subtype_Definition => declare - Indexes : constant Iir_List := Get_Index_Subtype_List (Def); + Indexes : constant Iir_Flist := Get_Index_Subtype_List (Def); Index : Iir; begin - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes) loop Index := Get_Index_Type (Indexes, I); - exit when Index = Null_Iir; Canon_Subtype_Indication_If_Anonymous (Index); end loop; end; @@ -3056,7 +3057,7 @@ package body Canon is Set_Parent (Res, Conf); Blk_Spec := Create_Iir (Iir_Kind_Indexed_Name); Location_Copy (Blk_Spec, Res); - Set_Index_List (Blk_Spec, Iir_List_Others); + Set_Index_List (Blk_Spec, Iir_Flist_Others); Set_Base_Name (Blk_Spec, El); Set_Prefix (Blk_Spec, Build_Simple_Name (Bod, Res)); Set_Block_Specification (Res, Blk_Spec); diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index ae627ca2d..9e425731f 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -709,7 +709,7 @@ package body Configuration is return False; end if; declare - Indexes : constant Iir_List := + Indexes : constant Iir_Flist := Get_Index_Subtype_List (Gen_Type); begin if Get_Nbr_Elements (Indexes) /= 1 then diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb index 9af60f01b..97fde1910 100644 --- a/src/vhdl/disp_tree.adb +++ b/src/vhdl/disp_tree.adb @@ -86,6 +86,27 @@ package body Disp_Tree is end if; end Disp_Iir_List; + procedure Disp_Iir_Flist + (Tree_Flist : Iir_Flist; Tab : Natural; Depth : Natural) + is + El: Iir; + begin + if Tree_Flist = Null_Iir_Flist then + Put_Line ("null-flist"); + elsif Tree_Flist = Iir_Flist_All then + Put_Line ("flist-all"); + elsif Tree_Flist = Iir_Flist_Others then + Put_Line ("flist-others"); + else + New_Line; + for I in Flist_First .. Flist_Last (Tree_Flist) loop + El := Get_Nth_Element (Tree_Flist, I); + Put_Indent (Tab); + Disp_Iir (El, Tab + 1, Depth); + end loop; + end if; + end Disp_Iir_Flist; + procedure Disp_Chain (Tree_Chain: Iir; Indent: Natural; Depth : Natural) is El: Iir; @@ -462,6 +483,24 @@ package body Disp_Tree is raise Internal_Error; end case; Disp_Iir_List (Get_Iir_List (N, F), Sub_Indent, Ndepth); + when Type_Iir_Flist => + case Get_Field_Attribute (F) is + when Attr_None => + Ndepth := Depth - 1; + when Attr_Of_Ref => + Ndepth := 0; + when Attr_Ref => + Ndepth := 0; + when Attr_Of_Maybe_Ref => + if Get_Is_Ref (N) then + Ndepth := 0; + else + Ndepth := Depth - 1; + end if; + when others => + raise Internal_Error; + end case; + Disp_Iir_Flist (Get_Iir_Flist (N, F), Sub_Indent, Ndepth); when Type_PSL_NFA => Disp_PSL_NFA (Get_PSL_NFA (N, F), Sub_Indent); when Type_String8_Id => diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index 80013702e..4dac2402f 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -887,13 +887,12 @@ package body Disp_Vhdl is when Iir_Kind_Array_Type_Definition => declare St : constant Iir := Get_Subtype_Definition (Decl); - Indexes : constant Iir_List := Get_Index_Subtype_List (St); + Indexes : constant Iir_Flist := Get_Index_Subtype_List (St); Index : Iir; begin Put ("array ("); - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes) loop Index := Get_Nth_Element (Indexes, I); - exit when Index = Null_Iir; if I /= 0 then Put (", "); end if; @@ -2525,15 +2524,14 @@ package body Disp_Vhdl is procedure Disp_Indexed_Name (Indexed: Iir) is - List : Iir_List; + List : Iir_Flist; El: Iir; begin Disp_Expression (Get_Prefix (Indexed)); Put (" ("); List := Get_Index_List (Indexed); - for I in Natural loop + for I in Flist_First .. Flist_Last (List) loop El := Get_Nth_Element (List, I); - exit when El = Null_Iir; if I /= 0 then Put (", "); end if; @@ -3389,14 +3387,14 @@ package body Disp_Vhdl is Disp_Name_Of (Spec); when Iir_Kind_Indexed_Name => declare - Index_List : constant Iir_List := Get_Index_List (Spec); + Index_List : constant Iir_Flist := Get_Index_List (Spec); begin Disp_Name_Of (Get_Prefix (Spec)); Put (" ("); - if Index_List = Iir_List_Others then + if Index_List = Iir_Flist_Others then Put ("others"); else - Disp_Expression (Get_First_Element (Index_List)); + Disp_Expression (Get_Nth_Element (Index_List, 0)); end if; Put (")"); end; diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index 214deb5ca..3e6cdc7f4 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -422,7 +422,7 @@ package body Evaluation is Res : Iir_Array_Subtype_Definition; begin Res := Create_Array_Subtype (Base_Type, Get_Location (Loc)); - Append_Element (Get_Index_Subtype_List (Res), Index_Type); + Set_Nth_Element (Get_Index_Subtype_List (Res), 0, Index_Type); Set_Type_Staticness (Res, Min (Get_Type_Staticness (Res), Get_Type_Staticness (Index_Type))); Set_Constraint_State (Res, Fully_Constrained); @@ -2255,9 +2255,10 @@ package body Evaluation is function Eval_Indexed_Aggregate (Prefix : Iir; Expr : Iir) return Iir is - Indexes : constant Iir_List := Get_Index_List (Expr); + Indexes : constant Iir_Flist := Get_Index_List (Expr); Prefix_Type : constant Iir := Get_Type (Prefix); - Indexes_Type : constant Iir_List := Get_Index_Subtype_List (Prefix_Type); + Indexes_Type : constant Iir_Flist := + Get_Index_Subtype_List (Prefix_Type); Idx : Iir; Assoc : Iir; Assoc_Expr : Iir; @@ -2268,7 +2269,7 @@ package body Evaluation is begin Aggr := Prefix; - for Dim in 0 .. Get_Nbr_Elements (Indexes) - 1 loop + for Dim in Flist_First .. Flist_Last (Indexes) loop Idx := Get_Nth_Element (Indexes, Dim); -- Find Idx in choices. @@ -2318,7 +2319,7 @@ package body Evaluation is Index_Type : constant Iir := Get_Index_Type (Str_Type, 0); Index_Range : constant Iir := Eval_Static_Range (Index_Type); - Indexes : constant Iir_List := Get_Index_List (Expr); + Indexes : constant Iir_Flist := Get_Index_List (Expr); Id : constant String8_Id := Get_String8_Id (Str); @@ -2339,7 +2340,7 @@ package body Evaluation is Index_Type : constant Iir := Get_Index_Type (Aggr_Type, 0); Index_Range : constant Iir := Eval_Static_Range (Index_Type); - Indexes : constant Iir_List := Get_Index_List (Expr); + Indexes : constant Iir_Flist := Get_Index_List (Expr); Idx : Iir; Pos : Iir_Index32; @@ -2361,20 +2362,19 @@ package body Evaluation is declare Prefix_Type : constant Iir := Get_Type (Prefix); - Indexes_Type : constant Iir_List := + Indexes_Type : constant Iir_Flist := Get_Index_Subtype_List (Prefix_Type); - Indexes_List : constant Iir_List := Get_Index_List (Expr); + Indexes_List : constant Iir_Flist := Get_Index_List (Expr); Prefix_Index : Iir; Index : Iir; begin - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes_Type) loop Prefix_Index := Get_Nth_Element (Indexes_Type, I); - exit when Prefix_Index = Null_Iir; -- Eval index. Index := Get_Nth_Element (Indexes_List, I); Index := Eval_Static_Expr (Index); - Replace_Nth_Element (Indexes_List, I, Index); + Set_Nth_Element (Indexes_List, I, Index); -- Return overflow if out of range. if Get_Kind (Index) = Iir_Kind_Overflow_Literal @@ -2771,7 +2771,7 @@ package body Evaluation is function Is_Small_Composite_Value (Expr : Iir) return Boolean is Expr_Type : constant Iir := Get_Type (Expr); - Indexes : Iir_List; + Indexes : Iir_Flist; Len : Iir_Int64; begin -- Consider only arrays. Records are never composite. @@ -3128,17 +3128,16 @@ package body Evaluation is return True; end if; declare - E_Indexes : constant Iir_List := + E_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Val_Type); - T_Indexes : constant Iir_List := + T_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Sub_Type); E_El : Iir; T_El : Iir; begin - for I in Natural loop + for I in Flist_First .. Flist_Last (E_Indexes) loop E_El := Get_Index_Type (E_Indexes, I); T_El := Get_Index_Type (T_Indexes, I); - exit when E_El = Null_Iir and T_El = Null_Iir; if Get_Type_Staticness (E_El) = Locally and then Get_Type_Staticness (T_El) = Locally diff --git a/src/vhdl/flists.adb b/src/vhdl/flists.adb index 481dc9bfd..6f14a7c7a 100644 --- a/src/vhdl/flists.adb +++ b/src/vhdl/flists.adb @@ -20,7 +20,7 @@ with Tables; package body Flists is -- Index of elements. - type El_Index_Type is new Nat32; + type El_Index_Type is new Int32; -- Describe an flist. type Entry_Type is record @@ -137,9 +137,7 @@ package body Flists is is E : Entry_Type renames Flistt.Table (Flist); begin - if N >= Natural (E.Len) then - return Null_Node; - end if; + pragma Assert (N < Natural (E.Len)); return Els.Table (E.Els + El_Index_Type (N)); end Get_Nth_Element; diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb index c47ffb445..1d4885c7e 100644 --- a/src/vhdl/ieee-vital_timing.adb +++ b/src/vhdl/ieee-vital_timing.adb @@ -571,7 +571,7 @@ package body Ieee.Vital_Timing is elsif Get_Kind (Ptype) = Iir_Kind_Array_Subtype_Definition and then Get_Base_Type (Ptype) = Std_Logic_Vector_Type then - Itype := Get_First_Element (Get_Index_Subtype_List (Ptype)); + Itype := Get_Nth_Element (Get_Index_Subtype_List (Ptype), 0); if Get_Type_Staticness (Itype) /= Locally then return Port_Length_Unknown; end if; @@ -640,8 +640,8 @@ package body Ieee.Vital_Timing is is Itype : Iir; begin - Itype := Get_First_Element - (Get_Index_Subtype_List (Get_Type (Gen_Decl))); + Itype := Get_Nth_Element + (Get_Index_Subtype_List (Get_Type (Gen_Decl)), 0); if Get_Type_Staticness (Itype) /= Locally then return Port_Length_Unknown; else diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index c6b926bc4..9283e8ebb 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -156,6 +156,11 @@ package body Iirs is function Iir_List_To_Iir is new Ada.Unchecked_Conversion (Source => Iir_List, Target => Iir); + function Iir_To_Iir_Flist is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_Flist); + function Iir_Flist_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_Flist, Target => Iir); + function Iir_To_Token_Type (N : Iir) return Token_Type is begin return Token_Type'Val (N); @@ -3044,36 +3049,36 @@ package body Iirs is Set_State2 (Atype, Iir_Constraint'Pos (State)); end Set_Constraint_State; - function Get_Index_Subtype_List (Decl : Iir) return Iir_List is + function Get_Index_Subtype_List (Decl : Iir) return Iir_Flist is begin pragma Assert (Decl /= Null_Iir); pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl)), "no field Index_Subtype_List"); - return Iir_To_Iir_List (Get_Field9 (Decl)); + return Iir_To_Iir_Flist (Get_Field9 (Decl)); end Get_Index_Subtype_List; - procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List) is + procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_Flist) is begin pragma Assert (Decl /= Null_Iir); pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl)), "no field Index_Subtype_List"); - Set_Field9 (Decl, Iir_List_To_Iir (List)); + Set_Field9 (Decl, Iir_Flist_To_Iir (List)); end Set_Index_Subtype_List; - function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List is + function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_Flist is begin pragma Assert (Def /= Null_Iir); pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def)), "no field Index_Subtype_Definition_List"); - return Iir_To_Iir_List (Get_Field6 (Def)); + return Iir_To_Iir_Flist (Get_Field6 (Def)); end Get_Index_Subtype_Definition_List; - procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List) is + procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_Flist) is begin pragma Assert (Def /= Null_Iir); pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def)), "no field Index_Subtype_Definition_List"); - Set_Field6 (Def, Iir_List_To_Iir (Idx)); + Set_Field6 (Def, Iir_Flist_To_Iir (Idx)); end Set_Index_Subtype_Definition_List; function Get_Element_Subtype_Indication (Decl : Iir) return Iir is @@ -3108,20 +3113,20 @@ package body Iirs is Set_Field1 (Decl, Sub_Type); end Set_Element_Subtype; - function Get_Index_Constraint_List (Def : Iir) return Iir_List is + function Get_Index_Constraint_List (Def : Iir) return Iir_Flist is begin pragma Assert (Def /= Null_Iir); pragma Assert (Has_Index_Constraint_List (Get_Kind (Def)), "no field Index_Constraint_List"); - return Iir_To_Iir_List (Get_Field6 (Def)); + return Iir_To_Iir_Flist (Get_Field6 (Def)); end Get_Index_Constraint_List; - procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List) is + procedure Set_Index_Constraint_List (Def : Iir; List : Iir_Flist) is begin pragma Assert (Def /= Null_Iir); pragma Assert (Has_Index_Constraint_List (Get_Kind (Def)), "no field Index_Constraint_List"); - Set_Field6 (Def, Iir_List_To_Iir (List)); + Set_Field6 (Def, Iir_Flist_To_Iir (List)); end Set_Index_Constraint_List; function Get_Array_Element_Constraint (Def : Iir) return Iir is @@ -3188,20 +3193,20 @@ package body Iirs is Set_Field5 (Target, Dtype); end Set_Designated_Subtype_Indication; - function Get_Index_List (Decl : Iir) return Iir_List is + function Get_Index_List (Decl : Iir) return Iir_Flist is begin pragma Assert (Decl /= Null_Iir); pragma Assert (Has_Index_List (Get_Kind (Decl)), "no field Index_List"); - return Iir_To_Iir_List (Get_Field2 (Decl)); + return Iir_To_Iir_Flist (Get_Field2 (Decl)); end Get_Index_List; - procedure Set_Index_List (Decl : Iir; List : Iir_List) is + procedure Set_Index_List (Decl : Iir; List : Iir_Flist) is begin pragma Assert (Decl /= Null_Iir); pragma Assert (Has_Index_List (Get_Kind (Decl)), "no field Index_List"); - Set_Field2 (Decl, Iir_List_To_Iir (List)); + Set_Field2 (Decl, Iir_Flist_To_Iir (List)); end Set_Index_List; function Get_Reference (Def : Iir) return Iir is diff --git a/src/vhdl/iirs.adb.in b/src/vhdl/iirs.adb.in index a13166f76..d25c48e29 100644 --- a/src/vhdl/iirs.adb.in +++ b/src/vhdl/iirs.adb.in @@ -156,6 +156,11 @@ package body Iirs is function Iir_List_To_Iir is new Ada.Unchecked_Conversion (Source => Iir_List, Target => Iir); + function Iir_To_Iir_Flist is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_Flist); + function Iir_Flist_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_Flist, Target => Iir); + function Iir_To_Token_Type (N : Iir) return Token_Type is begin return Token_Type'Val (N); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 47818a547..0d8c5926f 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -20,6 +20,7 @@ with Types; use Types; with Tokens; use Tokens; with Nodes; with Lists; +with Flists; package Iirs is -- This package defines the semantic tree and functions to handle it. @@ -5400,6 +5401,26 @@ package Iirs is renames Lists.Get_Last_Element; function "=" (L, R : Iir_List) return Boolean renames Lists."="; + subtype Iir_Flist is Flists.Flist_Type; + Null_Iir_Flist : constant Iir_Flist := Flists.Null_Flist; + Iir_Flist_Others : constant Iir_Flist := Flists.Flist_Others; + Iir_Flist_All : constant Iir_Flist := Flists.Flist_All; + + Flist_First : constant Natural := Flists.Ffirst; + function Flist_Last (Flist : Iir_Flist) return Natural + renames Flists.Flast; + function Create_Iir_Flist (Len : Natural) return Iir_Flist + renames Flists.Create_Flist; + function Get_Nth_Element (Flist : Iir_Flist; N : Natural) return Iir + renames Flists.Get_Nth_Element; + procedure Set_Nth_Element (Flist : Iir_Flist; N : Natural; El : Iir) + renames Flists.Set_Nth_Element; + function Get_Nbr_Elements (Flist : Iir_Flist) return Natural + renames Flists.Length; + procedure Destroy_Iir_Flist (Flist : in out Iir_Flist) + renames Flists.Destroy_Flist; + function "=" (L, R : Iir_Flist) return Boolean renames Flists."="; + -- This is used only for lists. type Iir_Array is array (Natural range <>) of Iir; type Iir_Array_Acc is access Iir_Array; @@ -5569,7 +5590,7 @@ package Iirs is -- Lists. - subtype Iir_Index_List is Iir_List; + subtype Iir_Index_List is Iir_Flist; subtype Iir_Design_Unit_List is Iir_List; @@ -6534,13 +6555,13 @@ package Iirs is -- the index_sutype is constrained (to differentiate with unconstrained -- index type). -- Field: Field9 Ref (uc) - function Get_Index_Subtype_List (Decl : Iir) return Iir_List; - procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List); + function Get_Index_Subtype_List (Decl : Iir) return Iir_Flist; + procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_Flist); -- List of type marks for indexes type of array types. -- Field: Field6 (uc) - function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List; - procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List); + function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_Flist; + procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_Flist); -- The subtype_indication as it appears in a array type declaration. -- Field: Field2 @@ -6552,8 +6573,8 @@ package Iirs is procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir); -- Field: Field6 (uc) - function Get_Index_Constraint_List (Def : Iir) return Iir_List; - procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List); + function Get_Index_Constraint_List (Def : Iir) return Iir_Flist; + procedure Set_Index_Constraint_List (Def : Iir; List : Iir_Flist); -- Field: Field8 function Get_Array_Element_Constraint (Def : Iir) return Iir; @@ -6574,8 +6595,8 @@ package Iirs is -- List of indexes for indexed name. -- Field: Field2 (uc) - function Get_Index_List (Decl : Iir) return Iir_List; - procedure Set_Index_List (Decl : Iir; List : Iir_List); + function Get_Index_List (Decl : Iir) return Iir_Flist; + procedure Set_Index_List (Decl : Iir; List : Iir_Flist); -- The terminal declaration for the reference (ground) of a nature -- Field: Field2 diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index b98961e91..e48b43893 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -57,6 +57,23 @@ package body Iirs_Utils is return Get_Kind (N) = Iir_Kind_Overflow_Literal; end Is_Overflow_Literal; + function List_To_Flist (L : Iir_List) return Iir_Flist + is + Len : constant Natural := Get_Nbr_Elements (L); + Temp_L : Iir_List; + Res : Iir_Flist; + begin + Res := Create_Iir_Flist (Len); + for I in 0 .. Len - 1 loop + Set_Nth_Element (Res, I, Get_Nth_Element (L, I)); + end loop; + + Temp_L := L; + Destroy_Iir_List (Temp_L); + + return Res; + end List_To_Flist; + function Get_Operator_Name (Op : Iir) return Name_Id is begin case Get_Kind (Op) is @@ -814,6 +831,16 @@ package body Iirs_Utils is end loop; end Free_Recursive_List; + procedure Free_Recursive_Flist (List : Iir_Flist) + is + El : Iir; + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Free_Recursive (El); + end loop; + end Free_Recursive_Flist; + procedure Free_Recursive (Node : Iir; Free_List : Boolean := False) is N : Iir; @@ -867,7 +894,7 @@ package body Iirs_Utils is return; end if; when Iir_Kind_Array_Subtype_Definition => - Free_Recursive_List (Get_Index_List (N)); + Free_Recursive_Flist (Get_Index_List (N)); Free_Recursive (Get_Base_Type (N)); when Iir_Kind_Entity_Aspect_Entity => Free_Recursive (Get_Entity (N)); @@ -1043,7 +1070,7 @@ package body Iirs_Utils is end case; end Get_Type_Of_Subtype_Indication; - function Get_Index_Type (Indexes : Iir_List; Idx : Natural) return Iir + function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir is Index : constant Iir := Get_Nth_Element (Indexes, Idx); begin @@ -1066,12 +1093,11 @@ package body Iirs_Utils is function Are_Array_Indexes_Locally_Static (Array_Type : Iir) return Boolean is - Indexes : constant Iir_List := Get_Index_Subtype_List (Array_Type); + Indexes : constant Iir_Flist := Get_Index_Subtype_List (Array_Type); Index : Iir; begin - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes) loop Index := Get_Index_Type (Indexes, I); - exit when Index = Null_Iir; if Get_Type_Staticness (Index) /= Locally then return False; end if; @@ -1376,7 +1402,7 @@ package body Iirs_Utils is if Get_Kind (Sub_Type) /= Iir_Kind_Array_Subtype_Definition then Error_Kind ("get_string_type_bound_type", Sub_Type); end if; - return Get_First_Element (Get_Index_Subtype_List (Sub_Type)); + return Get_Nth_Element (Get_Index_Subtype_List (Sub_Type), 0); end Get_String_Type_Bound_Type; procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; @@ -1449,7 +1475,7 @@ package body Iirs_Utils is Base_Type : constant Iir := Get_Base_Type (Arr_Type); El_Type : constant Iir := Get_Element_Subtype (Base_Type); Res : Iir_Array_Subtype_Definition; - List : Iir_List; + List : Iir_Flist; begin Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Location (Res, Loc); @@ -1461,7 +1487,7 @@ package body Iirs_Utils is Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type)); Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type)); Set_Type_Staticness (Res, Get_Type_Staticness (El_Type)); - List := Create_Iir_List; + List := Create_Iir_Flist (Get_Nbr_Dimensions (Base_Type)); Set_Index_Subtype_List (Res, List); Set_Index_Constraint_List (Res, List); return Res; diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index 43cda1d1a..4117166aa 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -43,6 +43,9 @@ package Iirs_Utils is -- Return TRUE if EL in an element of chain CHAIN. function Is_In_Chain (Chain : Iir; El : Iir) return Boolean; + -- Convert a list L to an Flist, and free L. + function List_To_Flist (L : Iir_List) return Iir_Flist; + -- Convert an operator node to a name. function Get_Operator_Name (Op : Iir) return Name_Id; @@ -219,7 +222,7 @@ package Iirs_Utils is -- index_constraint INDEXES. Return Null_Iir if IDX is out of dimension -- bounds, so that this function can be used to iterator over indexes of -- a type (or subtype). Note that IDX starts at 0. - function Get_Index_Type (Indexes : Iir_List; Idx : Natural) return Iir; + function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir; -- Likewise but for array type or subtype ARRAY_TYPE. function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir; diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index e7f784146..b9556526a 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -171,16 +171,16 @@ package body Nodes_Meta is Field_Is_Character_Type => Type_Boolean, Field_Type_Staticness => Type_Iir_Staticness, Field_Constraint_State => Type_Iir_Constraint, - Field_Index_Subtype_List => Type_Iir_List, - Field_Index_Subtype_Definition_List => Type_Iir_List, + Field_Index_Subtype_List => Type_Iir_Flist, + Field_Index_Subtype_Definition_List => Type_Iir_Flist, Field_Element_Subtype_Indication => Type_Iir, Field_Element_Subtype => Type_Iir, - Field_Index_Constraint_List => Type_Iir_List, + Field_Index_Constraint_List => Type_Iir_Flist, Field_Array_Element_Constraint => Type_Iir, Field_Elements_Declaration_List => Type_Iir_List, Field_Designated_Type => Type_Iir, Field_Designated_Subtype_Indication => Type_Iir, - Field_Index_List => Type_Iir_List, + Field_Index_List => Type_Iir_Flist, Field_Reference => Type_Iir, Field_Nature_Declarator => Type_Iir, Field_Across_Type => Type_Iir, @@ -5904,6 +5904,42 @@ package body Nodes_Meta is end case; end Set_Iir_Direction; + function Get_Iir_Flist + (N : Iir; F : Fields_Enum) return Iir_Flist is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Flist); + case F is + when Field_Index_Subtype_List => + return Get_Index_Subtype_List (N); + when Field_Index_Subtype_Definition_List => + return Get_Index_Subtype_Definition_List (N); + when Field_Index_Constraint_List => + return Get_Index_Constraint_List (N); + when Field_Index_List => + return Get_Index_List (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Flist; + + procedure Set_Iir_Flist + (N : Iir; F : Fields_Enum; V: Iir_Flist) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Flist); + case F is + when Field_Index_Subtype_List => + Set_Index_Subtype_List (N, V); + when Field_Index_Subtype_Definition_List => + Set_Index_Subtype_Definition_List (N, V); + when Field_Index_Constraint_List => + Set_Index_Constraint_List (N, V); + when Field_Index_List => + Set_Index_List (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Flist; + function Get_Iir_Fp64 (N : Iir; F : Fields_Enum) return Iir_Fp64 is begin @@ -6041,16 +6077,8 @@ package body Nodes_Meta is return Get_Enumeration_Literal_List (N); when Field_Group_Constituent_List => return Get_Group_Constituent_List (N); - when Field_Index_Subtype_List => - return Get_Index_Subtype_List (N); - when Field_Index_Subtype_Definition_List => - return Get_Index_Subtype_Definition_List (N); - when Field_Index_Constraint_List => - return Get_Index_Constraint_List (N); when Field_Elements_Declaration_List => return Get_Elements_Declaration_List (N); - when Field_Index_List => - return Get_Index_List (N); when Field_Sensitivity_List => return Get_Sensitivity_List (N); when Field_Callees_List => @@ -6091,16 +6119,8 @@ package body Nodes_Meta is Set_Enumeration_Literal_List (N, V); when Field_Group_Constituent_List => Set_Group_Constituent_List (N, V); - when Field_Index_Subtype_List => - Set_Index_Subtype_List (N, V); - when Field_Index_Subtype_Definition_List => - Set_Index_Subtype_Definition_List (N, V); - when Field_Index_Constraint_List => - Set_Index_Constraint_List (N, V); when Field_Elements_Declaration_List => Set_Elements_Declaration_List (N, V); - when Field_Index_List => - Set_Index_List (N, V); when Field_Sensitivity_List => Set_Sensitivity_List (N, V); when Field_Callees_List => diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index 89f8aa6a5..e8d302936 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -33,6 +33,7 @@ package Nodes_Meta is Type_Iir_Constraint, Type_Iir_Delay_Mechanism, Type_Iir_Direction, + Type_Iir_Flist, Type_Iir_Fp64, Type_Iir_Index32, Type_Iir_Int32, @@ -473,6 +474,11 @@ package Nodes_Meta is procedure Set_Iir_Direction (N : Iir; F : Fields_Enum; V: Iir_Direction); + function Get_Iir_Flist + (N : Iir; F : Fields_Enum) return Iir_Flist; + procedure Set_Iir_Flist + (N : Iir; F : Fields_Enum; V: Iir_Flist); + function Get_Iir_Fp64 (N : Iir; F : Fields_Enum) return Iir_Fp64; procedure Set_Iir_Fp64 diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index bb20c3644..1daed149f 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -2028,11 +2028,12 @@ package body Parse is -- Sem_Type will create the array type. Res_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Array_Element_Constraint (Res_Type, Element_Subtype); - Set_Index_Constraint_List (Res_Type, Index_List); + Set_Index_Constraint_List (Res_Type, List_To_Flist (Index_List)); else Res_Type := Create_Iir (Iir_Kind_Array_Type_Definition); Set_Element_Subtype_Indication (Res_Type, Element_Subtype); - Set_Index_Subtype_Definition_List (Res_Type, Index_List); + Set_Index_Subtype_Definition_List (Res_Type, + List_To_Flist (Index_List)); end if; Set_Location (Res_Type, Loc); @@ -2637,7 +2638,6 @@ package body Parse is Scan; else Index_List := Create_Iir_List; - Set_Index_Constraint_List (Def, Index_List); -- index_constraint ::= (discrete_range {, discrete_range} ) loop El := Parse_Discrete_Range; @@ -2649,6 +2649,7 @@ package body Parse is Expect (Tok_Comma); Scan; end loop; + Set_Index_Constraint_List (Def, List_To_Flist (Index_List)); end if; -- Eat ')' diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 6fa2f3ac6..c0cfcae61 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -1374,14 +1374,15 @@ package body Sem is return False; end if; declare - L_Left, L_Right : Iir_List; + L_Left : constant Iir_Flist := Get_Index_Subtype_List (Left); + L_Right : constant Iir_Flist := Get_Index_Subtype_List (Right); begin - L_Left := Get_Index_Subtype_List (Left); - L_Right := Get_Index_Subtype_List (Right); - for I in Natural loop + if Get_Nbr_Elements (L_Left) /= Get_Nbr_Elements (L_Right) then + return False; + end if; + for I in Flist_First .. Flist_Last (L_Left) loop El_Left := Get_Nth_Element (L_Left, I); El_Right := Get_Nth_Element (L_Right, I); - exit when El_Left = Null_Iir; if not Are_Trees_Equal (El_Left, El_Right) then return False; end if; diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index 5be583945..e15d9184d 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -55,7 +55,6 @@ package body Sem_Assocs is Set_Subtype_Type_Mark (N_Actual, Get_Prefix (Actual)); Sub_Assoc := Get_Association_Chain (Actual); Indexes := Create_Iir_List; - Set_Index_Constraint_List (N_Actual, Indexes); while Is_Valid (Sub_Assoc) loop if Get_Kind (Sub_Assoc) /= Iir_Kind_Association_Element_By_Expression @@ -75,6 +74,8 @@ package body Sem_Assocs is end loop; Old := Actual; Free_Iir (Old); + Set_Index_Constraint_List + (N_Actual, List_To_Flist (Indexes)); Actual := N_Actual; end; end if; @@ -626,7 +627,7 @@ package body Sem_Assocs is procedure Add_Individual_Assoc_Indexed_Name (Choice : out Iir; Base_Assoc : Iir; Formal : Iir) is - Index_List : constant Iir_List := Get_Index_List (Formal); + Index_List : constant Iir_Flist := Get_Index_List (Formal); Nbr : constant Natural := Get_Nbr_Elements (Index_List); Last_Choice : Iir; Index : Iir; @@ -642,7 +643,7 @@ package body Sem_Assocs is Staticness := Get_Expr_Staticness (Index); if Staticness = Locally then Index := Eval_Expr (Index); - Replace_Nth_Element (Index_List, I, Index); + Set_Nth_Element (Index_List, I, Index); else Error_Msg_Sem (+Index, "index expression must be locally static"); Set_Choice_Staticness (Base_Assoc, None); @@ -866,7 +867,7 @@ package body Sem_Assocs is procedure Finish_Individual_Assoc_Array_Subtype (Assoc : Iir; Atype : Iir; Dim : Positive) is - Index_Tlist : constant Iir_List := Get_Index_Subtype_List (Atype); + Index_Tlist : constant Iir_Flist := Get_Index_Subtype_List (Atype); Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist); Index_Type : constant Iir := Get_Nth_Element (Index_Tlist, Dim - 1); Low, High : Iir; @@ -891,14 +892,13 @@ package body Sem_Assocs is procedure Finish_Individual_Assoc_Array (Actual : Iir; Assoc : Iir; Dim : Natural) is - Actual_Type : Iir; + Actual_Type : constant Iir := Get_Actual_Type (Actual); Actual_Index : Iir; Base_Type : Iir; Base_Index : Iir; Low, High : Iir; Chain : Iir; begin - Actual_Type := Get_Actual_Type (Actual); Actual_Index := Get_Nth_Element (Get_Index_Subtype_List (Actual_Type), Dim - 1); if Actual_Index /= Null_Iir then @@ -958,8 +958,8 @@ package body Sem_Assocs is Set_Right_Limit_Expr (Index_Subtype_Constraint, Low); end case; Set_Expr_Staticness (Index_Subtype_Constraint, Locally); - Append_Element (Get_Index_Subtype_List (Actual_Type), - Actual_Index); + Set_Nth_Element (Get_Index_Subtype_List (Actual_Type), Dim - 1, + Actual_Index); end; else declare diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 10417b3de..664272182 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -3025,7 +3025,7 @@ package body Sem_Expr is Constrained : Boolean; Dim: Natural) is - Index_List : constant Iir_List := Get_Index_Subtype_List (A_Type); + Index_List : constant Iir_Flist := Get_Index_Subtype_List (A_Type); -- Type of the index (this is also the type of the choices). Index_Type : constant Iir := Get_Index_Type (Index_List, Dim - 1); @@ -3419,7 +3419,7 @@ package body Sem_Expr is is A_Subtype: Iir; Base_Type : Iir; - Index_List : constant Iir_List := Get_Index_Subtype_List (Aggr_Type); + Index_List : constant Iir_Flist := Get_Index_Subtype_List (Aggr_Type); Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List); Infos : Array_Aggr_Info_Arr (1 .. Nbr_Dim); Aggr_Constrained : Boolean; @@ -3451,8 +3451,8 @@ package body Sem_Expr is A_Subtype := Create_Array_Subtype (Base_Type, Get_Location (Aggr)); Type_Staticness := Get_Type_Staticness (A_Subtype); for I in Infos'Range loop - Append_Element (Get_Index_Subtype_List (A_Subtype), - Infos (I).Index_Subtype); + Set_Nth_Element (Get_Index_Subtype_List (A_Subtype), I - 1, + Infos (I).Index_Subtype); Type_Staticness := Min (Type_Staticness, Get_Type_Staticness (Infos (I).Index_Subtype)); end loop; diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index eee370cb0..3101d4219 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -186,6 +186,27 @@ package body Sem_Inst is end case; end Instantiate_Iir_List; + function Instantiate_Iir_Flist (L : Iir_Flist; Is_Ref : Boolean) + return Iir_Flist + is + Res : Iir_Flist; + El : Iir; + begin + case L is + when Null_Iir_Flist + | Iir_Flist_All + | Iir_Flist_Others => + return L; + when others => + Res := Create_Iir_Flist (Get_Nbr_Elements (L)); + for I in Flist_First .. Flist_Last (L) loop + El := Get_Nth_Element (L, I); + Set_Nth_Element (Res, I, Instantiate_Iir (El, Is_Ref)); + end loop; + return Res; + end case; + end Instantiate_Iir_Flist; + -- Instantiate a chain. This is a special case to reduce stack depth. function Instantiate_Iir_Chain (N : Iir) return Iir is @@ -271,6 +292,27 @@ package body Sem_Inst is R := Instantiate_Iir_List (S, Ref); Set_Iir_List (Res, F, R); end; + when Type_Iir_Flist => + declare + S : constant Iir_Flist := Get_Iir_Flist (N, F); + R : Iir_Flist; + Ref : Boolean; + begin + case Get_Field_Attribute (F) is + when Attr_None => + Ref := False; + when Attr_Of_Ref => + Ref := True; + when Attr_Of_Maybe_Ref => + Ref := Get_Is_Ref (N); + when others => + -- Ref is specially handled in Instantiate_Iir. + -- Others cannot appear for lists. + raise Internal_Error; + end case; + R := Instantiate_Iir_Flist (S, Ref); + Set_Iir_Flist (Res, F, R); + end; when Type_PSL_NFA | Type_PSL_Node => -- TODO @@ -387,14 +429,14 @@ package body Sem_Inst is -- the instance of the referenced list. This is a special -- case because there is no origins for list. declare - List : Iir_List; + List : Iir_Flist; begin case Kind is when Iir_Kind_Array_Type_Definition => List := Get_Index_Subtype_Definition_List (Res); when Iir_Kind_Array_Subtype_Definition => List := Get_Index_Constraint_List (Res); - if List = Null_Iir_List then + if List = Null_Iir_Flist then List := Get_Index_Subtype_List (Get_Denoted_Type_Mark (Res)); end if; diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 211314c08..d16ef8897 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -615,7 +615,7 @@ package body Sem_Names is is Prefix : constant Iir := Get_Prefix (Expr); Prefix_Type : constant Iir := Get_Type (Prefix); - Index_List : constant Iir_List := Get_Index_List (Expr); + Index_List : constant Iir_Flist := Get_Index_List (Expr); Index_Subtype : Iir; Index : Iir; Expr_Staticness : Iir_Staticness; @@ -626,10 +626,9 @@ package body Sem_Names is -- position of the array and each expression must be of the -- type of the corresponding index. -- Loop on the indexes. - for I in Natural loop - Index_Subtype := Get_Index_Type (Prefix_Type, I); - exit when Index_Subtype = Null_Iir; + for I in Flist_First .. Flist_Last (Index_List) loop Index := Get_Nth_Element (Index_List, I); + Index_Subtype := Get_Index_Type (Prefix_Type, I); -- The index_subtype can be an unconstrained index type. Index := Check_Is_Expression (Index, Index); if Index /= Null_Iir then @@ -641,7 +640,7 @@ package body Sem_Names is then Index := Eval_Expr_Check (Index, Index_Subtype); end if; - Replace_Nth_Element (Get_Index_List (Expr), I, Index); + Set_Nth_Element (Index_List, I, Index); Expr_Staticness := Min (Expr_Staticness, Get_Expr_Staticness (Index)); else @@ -689,7 +688,7 @@ package body Sem_Names is Prefix_Type : constant Iir := Get_Type (Prefix); Prefix_Base_Type : Iir; Prefix_Bt : constant Iir := Get_Base_Type (Prefix_Type); - Index_List: Iir_List; + Index_List: Iir_Flist; Index_Type: Iir; Suffix: Iir; Slice_Type : Iir; @@ -801,14 +800,14 @@ package body Sem_Names is Expr_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Location (Expr_Type, Get_Location (Suffix)); - Set_Index_Subtype_List (Expr_Type, Create_Iir_List); + Set_Index_Subtype_List (Expr_Type, Create_Iir_Flist (1)); Set_Index_Constraint_List (Expr_Type, Get_Index_Subtype_List (Expr_Type)); Prefix_Base_Type := Get_Base_Type (Prefix_Type); Set_Base_Type (Expr_Type, Prefix_Base_Type); Set_Signal_Type_Flag (Expr_Type, Get_Signal_Type_Flag (Prefix_Base_Type)); - Append_Element (Get_Index_Subtype_List (Expr_Type), Slice_Type); + Set_Nth_Element (Get_Index_Subtype_List (Expr_Type), 0, Slice_Type); Set_Element_Subtype (Expr_Type, Get_Element_Subtype (Prefix_Type)); if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then Set_Resolution_Indication @@ -1008,7 +1007,7 @@ package body Sem_Names is declare Dim : Iir_Int64; - Indexes_List : constant Iir_List := + Indexes_List : constant Iir_Flist := Get_Index_Subtype_List (Prefix_Type); begin if Is_Null (Parameter) @@ -1218,7 +1217,7 @@ package body Sem_Names is Base_Type1 : constant Iir := Get_Base_Type (Type1); Base_Type2 : constant Iir := Get_Base_Type (Type2); Ant1, Ant2 : Boolean; - Index_List1, Index_List2 : Iir_List; + Index_List1, Index_List2 : Iir_Flist; El1, El2 : Iir; begin -- LRM 7.3.5 @@ -1261,9 +1260,8 @@ package body Sem_Names is then return False; end if; - for I in Natural loop + for I in Flist_First .. Flist_Last (Index_List1) loop El1 := Get_Index_Type (Index_List1, I); - exit when El1 = Null_Iir; El2 := Get_Index_Type (Index_List2, I); if not Are_Types_Closely_Related (El1, El2) then return False; @@ -2334,8 +2332,8 @@ package body Sem_Names is if Get_Expr_Staticness (Actual) < Globally then Error_Msg_Sem (+Name, "index must be a static expression"); end if; - Set_Index_List (Res, Create_Iir_List); - Append_Element (Get_Index_List (Res), Actual); + Set_Index_List (Res, Create_Iir_Flist (1)); + Set_Nth_Element (Get_Index_List (Res), 0, Actual); when Iir_Kind_Slice_Name => Actual := Sem_Discrete_Range_Expression (Actual, Itype, False); if Actual = Null_Iir then @@ -2421,7 +2419,7 @@ package body Sem_Names is -- The FINISH = True case will be handled by Finish_Sem_Indexed_Name. if Slice_Index_Kind = Iir_Kind_Indexed_Name and then not Finish then declare - Type_Index_List : constant Iir_List := + Type_Index_List : constant Iir_Flist := Get_Index_Subtype_List (Base_Type); Type_Index : Iir; Assoc : Iir; @@ -2472,12 +2470,12 @@ package body Sem_Names is Idx_List : Iir_List; begin Idx_List := Create_Iir_List; - Set_Index_List (R, Idx_List); Idx_El := Assoc_Chain; while Idx_El /= Null_Iir loop Append_Element (Idx_List, Get_Actual (Idx_El)); Idx_El := Get_Chain (Idx_El); end loop; + Set_Index_List (R, List_To_Flist (Idx_List)); end; Set_Type (R, Get_Element_Subtype (Base_Type)); when others => diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb index d82eddb29..754f615fb 100644 --- a/src/vhdl/sem_stmts.adb +++ b/src/vhdl/sem_stmts.adb @@ -134,7 +134,7 @@ package body Sem_Stmts is -- prefix to suffix. function Is_Disjoint (N1, N2: Iir) return Boolean is - List1, List2 : Iir_List; + List1, List2 : Iir_Flist; El1, El2 : Iir; begin if N1 = N2 then @@ -149,14 +149,13 @@ package body Sem_Stmts is -- Check indexes. List1 := Get_Index_List (N1); List2 := Get_Index_List (N2); - for I in Natural loop + for I in Flist_First .. Flist_Last (List1) loop El1 := Get_Nth_Element (List1, I); El2 := Get_Nth_Element (List2, I); - exit when El1 = Null_Iir; El1 := Eval_Expr (El1); - Replace_Nth_Element (List1, I, El1); + Set_Nth_Element (List1, I, El1); El2 := Eval_Expr (El2); - Replace_Nth_Element (List2, I, El2); + Set_Nth_Element (List2, I, El2); -- EL are of discrete type. if Get_Value (El1) /= Get_Value (El2) then return True; @@ -992,8 +991,8 @@ package body Sem_Stmts is -- must be locally static. So I don't check this in 93c. if Flags.Vhdl_Std /= Vhdl_93c and then - Get_Expr_Staticness (Get_First_Element - (Get_Index_List (Expr))) /= Locally + (Get_Expr_Staticness + (Get_Nth_Element (Get_Index_List (Expr), 0)) /= Locally) then Error_Msg_Sem (+Expr, "indexing expression must be locally static"); diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb index 04cb74d47..cddeacb4f 100644 --- a/src/vhdl/sem_types.adb +++ b/src/vhdl/sem_types.adb @@ -880,18 +880,17 @@ package body Sem_Types is function Sem_Unbounded_Array_Type_Definition (Def: Iir) return Iir is - Index_List : constant Iir_List := + Index_List : constant Iir_Flist := Get_Index_Subtype_Definition_List (Def); Index_Type : Iir; begin Set_Base_Type (Def, Def); - for I in Natural loop + for I in Flist_First .. Flist_Last (Index_List) loop Index_Type := Get_Nth_Element (Index_List, I); - exit when Index_Type = Null_Iir; Index_Type := Sem_Type_Mark (Index_Type); - Replace_Nth_Element (Index_List, I, Index_Type); + Set_Nth_Element (Index_List, I, Index_Type); Index_Type := Get_Type (Index_Type); if Get_Kind (Index_Type) not in Iir_Kinds_Discrete_Type_Definition @@ -933,10 +932,10 @@ package body Sem_Types is function Sem_Constrained_Array_Type_Definition (Def: Iir; Decl: Iir) return Iir is + Index_List : constant Iir_Flist := Get_Index_Constraint_List (Def); Index_Type : Iir; Index_Name : Iir; - Index_List : Iir_List; - Base_Index_List : Iir_List; + Base_Index_List : Iir_Flist; El_Type : Iir; Staticness : Iir_Staticness; @@ -974,15 +973,13 @@ package body Sem_Types is Location_Copy (Base_Type, Def); Set_Base_Type (Base_Type, Base_Type); Set_Type_Declarator (Base_Type, Decl); - Base_Index_List := Create_Iir_List; + Base_Index_List := Create_Iir_Flist (Get_Nbr_Elements (Index_List)); Set_Index_Subtype_Definition_List (Base_Type, Base_Index_List); Set_Index_Subtype_List (Base_Type, Base_Index_List); Staticness := Locally; - Index_List := Get_Index_Constraint_List (Def); - for I in Natural loop + for I in Flist_First .. Flist_Last (Index_List) loop Index_Type := Get_Nth_Element (Index_List, I); - exit when Index_Type = Null_Iir; Index_Name := Sem_Discrete_Range_Integer (Index_Type); if Index_Name /= Null_Iir then @@ -995,7 +992,7 @@ package body Sem_Types is Set_Type (Index_Name, Natural_Subtype_Definition); end if; - Replace_Nth_Element (Index_List, I, Index_Name); + Set_Nth_Element (Index_List, I, Index_Name); Index_Type := Get_Index_Type (Index_Name); Staticness := Min (Staticness, Get_Type_Staticness (Index_Type)); @@ -1021,7 +1018,7 @@ package body Sem_Types is Index_Name := Build_Simple_Name (Index_Type, Index_Name); Set_Type (Index_Name, Get_Type (Index_Type)); - Append_Element (Base_Index_List, Index_Name); + Set_Nth_Element (Base_Index_List, I, Index_Name); end loop; Set_Index_Subtype_List (Def, Index_List); @@ -1442,7 +1439,7 @@ package body Sem_Types is Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Type_Staticness (Res, Get_Type_Staticness (Def)); Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); - Set_Index_Constraint_List (Res, Null_Iir_List); + Set_Index_Constraint_List (Res, Null_Iir_Flist); Set_Index_Subtype_List (Res, Get_Index_Subtype_Definition_List (Def)); Set_Element_Subtype (Res, Get_Element_Subtype (Def)); @@ -1482,6 +1479,113 @@ package body Sem_Types is return Res; end Copy_Subtype_Indication; + procedure Sem_Array_Constraint_Indexes (Def : Iir; Type_Mark : Iir) + is + El_Type : constant Iir := Get_Element_Subtype (Type_Mark); + Type_Index, Subtype_Index: Iir; + Base_Type : Iir; + Index_Staticness : Iir_Staticness; + Type_Nbr_Dim : Natural; + Subtype_Nbr_Dim : Natural; + Type_Index_List : Iir_Flist; + Subtype_Index_List : Iir_Flist; + Subtype_Index_List2 : Iir_Flist; + begin + -- Check each index constraint against array type. + Base_Type := Get_Base_Type (Type_Mark); + Set_Base_Type (Def, Base_Type); + + Index_Staticness := Locally; + Type_Index_List := Get_Index_Subtype_Definition_List (Base_Type); + Subtype_Index_List := Get_Index_Constraint_List (Def); + + -- LRM08 5.3.2.2 + -- If an array constraint of the first form (including an index + -- constraint) applies to a type or subtype, then the type or + -- subtype shall be an unconstrained or partially constrained + -- array type with no index constraint applying to the index + -- subtypes, or an access type whose designated type is such + -- a type. + if Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition + and then Get_Index_Constraint_Flag (Type_Mark) + then + Error_Msg_Sem (+Def, "constrained array cannot be re-constrained"); + end if; + if Subtype_Index_List = Null_Iir_Flist then + -- Array is not constrained. + Set_Index_Constraint_Flag (Def, False); + Set_Index_Subtype_List (Def, Type_Index_List); + else + Type_Nbr_Dim := Get_Nbr_Elements (Type_Index_List); + Subtype_Nbr_Dim := Get_Nbr_Elements (Subtype_Index_List); + + if Subtype_Nbr_Dim /= Type_Nbr_Dim then + -- Number of dimension mismatch. Create an index with the right + -- length. + Subtype_Index_List2 := Create_Iir_Flist (Type_Nbr_Dim); + for I in 1 .. Natural'Min (Subtype_Nbr_Dim, Type_Nbr_Dim) loop + Set_Nth_Element + (Subtype_Index_List2, I - 1, + Get_Nth_Element (Subtype_Index_List, I - 1)); + end loop; + + if Subtype_Nbr_Dim < Type_Nbr_Dim then + Error_Msg_Sem + (+Def, + "subtype has less indexes than %n defined at %l", + (+Type_Mark, +Type_Mark)); + + -- Clear extra indexes. + for I in Subtype_Nbr_Dim + 1 .. Type_Nbr_Dim loop + Set_Nth_Element (Subtype_Index_List2, I - 1, Null_Iir); + end loop; + else + Error_Msg_Sem + (+Get_Nth_Element (Subtype_Index_List, Type_Nbr_Dim), + "subtype has more indexes than %n defined at %l", + (+Type_Mark, +Type_Mark)); + + -- Forget extra indexes. + end if; + Destroy_Iir_Flist (Subtype_Index_List); + Subtype_Index_List := Subtype_Index_List2; + end if; + + for I in 1 .. Type_Nbr_Dim loop + Type_Index := Get_Nth_Element (Type_Index_List, I - 1); + + if I <= Subtype_Nbr_Dim then + Subtype_Index := Get_Nth_Element (Subtype_Index_List, I - 1); + Subtype_Index := Sem_Discrete_Range_Expression + (Subtype_Index, Get_Index_Type (Type_Index), True); + if Subtype_Index /= Null_Iir then + Subtype_Index := + Range_To_Subtype_Indication (Subtype_Index); + Index_Staticness := Min + (Index_Staticness, + Get_Type_Staticness (Get_Type_Of_Subtype_Indication + (Subtype_Index))); + end if; + else + Subtype_Index := Null_Iir; + end if; + if Subtype_Index = Null_Iir then + -- Create a fake subtype from type_index. + -- FIXME: It is too fake. + Subtype_Index := Type_Index; + Index_Staticness := None; + end if; + Set_Nth_Element (Subtype_Index_List, I - 1, Subtype_Index); + end loop; + + Set_Index_Subtype_List (Def, Subtype_Index_List); + Set_Index_Constraint_Flag (Def, True); + end if; + Set_Type_Staticness + (Def, Min (Get_Type_Staticness (El_Type), Index_Staticness)); + Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Type_Mark)); + end Sem_Array_Constraint_Indexes; + -- DEF is an incomplete subtype_indication or array_constraint, -- TYPE_MARK is the base type of the subtype_indication. function Sem_Array_Constraint @@ -1489,13 +1593,7 @@ package body Sem_Types is is El_Type : constant Iir := Get_Element_Subtype (Type_Mark); Res : Iir; - Type_Index, Subtype_Index: Iir; - Base_Type : Iir; El_Def : Iir; - Index_Staticness : Iir_Staticness; - Error_Seen : Boolean; - Type_Index_List : Iir_List; - Subtype_Index_List : Iir_List; Resolv_Func : Iir := Null_Iir; Resolv_El : Iir := Null_Iir; Resolv_Ind : Iir; @@ -1548,95 +1646,11 @@ package body Sem_Types is -- No element constraint. El_Def := Null_Iir; - Index_Staticness := None; when Iir_Kind_Array_Subtype_Definition => -- Case of a constraint for an array. - -- Check each index constraint against array type. - - Base_Type := Get_Base_Type (Type_Mark); - Set_Base_Type (Def, Base_Type); El_Def := Get_Array_Element_Constraint (Def); - - Index_Staticness := Locally; - Error_Seen := False; - Type_Index_List := - Get_Index_Subtype_Definition_List (Base_Type); - Subtype_Index_List := Get_Index_Constraint_List (Def); - - -- LRM08 5.3.2.2 - -- If an array constraint of the first form (including an index - -- constraint) applies to a type or subtype, then the type or - -- subtype shall be an unconstrained or partially constrained - -- array type with no index constraint applying to the index - -- subtypes, or an access type whose designated type is such - -- a type. - if Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition - and then Get_Index_Constraint_Flag (Type_Mark) - then - Error_Msg_Sem - (+Def, "constrained array cannot be re-constrained"); - end if; - if Subtype_Index_List = Null_Iir_List then - -- Array is not constrained. - Set_Index_Constraint_Flag (Def, False); - Set_Index_Subtype_List (Def, Type_Index_List); - else - for I in Natural loop - Type_Index := Get_Nth_Element (Type_Index_List, I); - Subtype_Index := Get_Nth_Element (Subtype_Index_List, I); - exit when Type_Index = Null_Iir - and Subtype_Index = Null_Iir; - - if Type_Index = Null_Iir then - Error_Msg_Sem - (+Subtype_Index, - "subtype has more indexes than %n defined at %l", - (+Type_Mark, +Type_Mark)); - -- Forget extra indexes. - Set_Nbr_Elements (Subtype_Index_List, I); - exit; - end if; - if Subtype_Index = Null_Iir then - if not Error_Seen then - Error_Msg_Sem - (+Def, - "subtype has less indexes than %n defined at %l", - (+Type_Mark, +Type_Mark)); - Error_Seen := True; - end if; - else - Subtype_Index := Sem_Discrete_Range_Expression - (Subtype_Index, Get_Index_Type (Type_Index), True); - if Subtype_Index /= Null_Iir then - Subtype_Index := - Range_To_Subtype_Indication (Subtype_Index); - Index_Staticness := Min - (Index_Staticness, - Get_Type_Staticness - (Get_Type_Of_Subtype_Indication - (Subtype_Index))); - end if; - end if; - if Subtype_Index = Null_Iir then - -- Create a fake subtype from type_index. - -- FIXME: It is too fake. - Subtype_Index := Type_Index; - Index_Staticness := None; - end if; - if Error_Seen then - Append_Element (Subtype_Index_List, Subtype_Index); - else - Replace_Nth_Element - (Subtype_Index_List, I, Subtype_Index); - end if; - end loop; - Set_Index_Subtype_List (Def, Subtype_Index_List); - Set_Index_Constraint_Flag (Def, True); - end if; - Set_Type_Staticness - (Def, Min (Get_Type_Staticness (El_Type), Index_Staticness)); - Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Type_Mark)); + Sem_Array_Constraint_Indexes (Def, Type_Mark); Res := Def; when others => @@ -1798,7 +1812,6 @@ package body Sem_Types is end if; else El_List := Create_Iir_List; - Set_Index_Constraint_List (Res, El_List); while Chain /= Null_Iir loop if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression or else Get_Formal (Chain) /= Null_Iir @@ -1809,6 +1822,7 @@ package body Sem_Types is end if; Chain := Get_Chain (Chain); end loop; + Set_Index_Constraint_List (Res, List_To_Flist (El_List)); end if; Def_El_Type := Get_Element_Subtype (Def_Type); @@ -1835,7 +1849,7 @@ package body Sem_Types is El_Type : Iir; Res_List : Iir_List; - Index_List : Iir_List; + Index_List : Iir_Flist; Index_El : Iir; begin Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); @@ -1859,9 +1873,8 @@ package body Sem_Types is Index_List := Get_Index_Constraint_List (Def); El_List := Create_Iir_List; Set_Elements_Declaration_List (Res, El_List); - for I in Natural loop + for I in Flist_First .. Flist_Last (Index_List) loop Index_El := Get_Nth_Element (Index_List, I); - exit when Index_El = Null_Iir; El := Reparse_As_Record_Element_Constraint (Index_El); if El /= Null_Iir then Append_Element (El_List, El); diff --git a/src/vhdl/std_package.adb b/src/vhdl/std_package.adb index 3fc1064df..234f1000c 100644 --- a/src/vhdl/std_package.adb +++ b/src/vhdl/std_package.adb @@ -291,7 +291,7 @@ package body Std_Package is procedure Create_Array_Type (Def : out Iir; Decl : out Iir; El_Decl : Iir; Name : Name_Id) is - Index_List : Iir_List; + Index_List : Iir_Flist; Index : Iir; Element : Iir; begin @@ -301,10 +301,10 @@ package body Std_Package is Def := Create_Std_Iir (Iir_Kind_Array_Type_Definition); Set_Base_Type (Def, Def); - Index_List := Create_Iir_List; + Index_List := Create_Iir_Flist (1); Set_Index_Subtype_Definition_List (Def, Index_List); Set_Index_Subtype_List (Def, Index_List); - Append_Element (Index_List, Index); + Set_Nth_Element (Index_List, 0, Index); Set_Element_Subtype_Indication (Def, Element); Set_Element_Subtype (Def, Get_Type (El_Decl)); @@ -1054,15 +1054,15 @@ package body Std_Package is -- type string is array (positive range <>) of character; declare Element : Iir; - Index_List : Iir_List; + Index_List : Iir_Flist; begin Element := Create_Std_Type_Mark (Character_Type_Declaration); String_Type_Definition := Create_Std_Iir (Iir_Kind_Array_Type_Definition); Set_Base_Type (String_Type_Definition, String_Type_Definition); - Index_List := Create_Iir_List; - Append_Element (Index_List, + Index_List := Create_Iir_Flist (1); + Set_Nth_Element (Index_List, 0, Create_Std_Type_Mark (Positive_Subtype_Declaration)); Set_Index_Subtype_Definition_List (String_Type_Definition, Index_List); diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index 93534f028..08b22098c 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -708,10 +708,10 @@ package body Trans.Chap1 is Apply_To_All_Others_Blocks (True); when Iir_Kind_Indexed_Name => declare - Index_List : constant Iir_List := Get_Index_List (Spec); + Index_List : constant Iir_Flist := Get_Index_List (Spec); Rng : Mnode; begin - if Index_List = Iir_List_Others then + if Index_List = Iir_Flist_Others then Apply_To_All_Others_Blocks (False); else Open_Temp; diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 790200218..d975a2ac1 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1134,6 +1134,23 @@ package body Trans.Chap2 is end case; end Instantiate_Iir_List_Info; + procedure Instantiate_Iir_Flist_Info (L : Iir_Flist) + is + El : Iir; + begin + case L is + when Null_Iir_Flist + | Iir_Flist_All + | Iir_Flist_Others => + return; + when others => + for I in Flist_First .. Flist_Last (L) loop + El := Get_Nth_Element (L, I); + Instantiate_Iir_Info (El); + end loop; + end case; + end Instantiate_Iir_Flist_Info; + -- B must be passed by reference. procedure Adjust_Info_Basetype (B : access Ortho_Info_Basetype_Type; Orig : access Ortho_Info_Basetype_Type) is @@ -1422,6 +1439,20 @@ package body Trans.Chap2 is when others => raise Internal_Error; end case; + when Type_Iir_Flist => + case Get_Field_Attribute (F) is + when Attr_None => + Instantiate_Iir_Flist_Info (Get_Iir_Flist (N, F)); + when Attr_Of_Maybe_Ref => + if not Get_Is_Ref (N) then + Instantiate_Iir_Flist_Info (Get_Iir_Flist (N, F)); + end if; + when Attr_Ref + | Attr_Of_Ref => + null; + when others => + raise Internal_Error; + end case; when Type_PSL_NFA | Type_PSL_Node => -- TODO diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index e5ba9a1ee..e585cc747 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -564,13 +564,12 @@ package body Trans.Chap3 is case Get_Kind (Def) is when Iir_Kind_Array_Subtype_Definition => declare - Indexes_List : constant Iir_List := + Indexes_List : constant Iir_Flist := Get_Index_Subtype_List (Def); Index : Iir; begin - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes_List) loop Index := Get_Index_Type (Indexes_List, I); - exit when Index = Null_Iir; New_Record_Aggr_El (List, Create_Static_Type_Definition_Type_Range (Index)); end loop; @@ -621,18 +620,17 @@ package body Trans.Chap3 is case Get_Kind (Def) is when Iir_Kind_Array_Subtype_Definition => declare - Indexes_List : constant Iir_List := + Indexes_List : constant Iir_Flist := Get_Index_Subtype_List (Def); - Indexes_Def_List : constant Iir_List := + Indexes_Def_List : constant Iir_Flist := Get_Index_Subtype_Definition_List (Base_Type); Index : Iir; begin if Get_Nbr_Elements (Indexes_List) > 1 then Targ := Stabilize (Targ); end if; - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes_List) loop Index := Get_Index_Type (Indexes_List, I); - exit when Index = Null_Iir; declare Index_Type : constant Iir := Get_Base_Type (Index); Index_Info : constant Type_Info_Acc := @@ -737,7 +735,7 @@ package body Trans.Chap3 is procedure Translate_Array_Type_Bounds (Def : Iir_Array_Type_Definition; Info : Type_Info_Acc) is - Indexes_List : constant Iir_List := + Indexes_List : constant Iir_Flist := Get_Index_Subtype_Definition_List (Def); Constr : O_Element_List; Dim : String (1 .. 8); @@ -748,9 +746,8 @@ package body Trans.Chap3 is Index_Type_Mark : Iir; begin Start_Record_Type (Constr); - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes_List) loop Index_Type_Mark := Get_Nth_Element (Indexes_List, I); - exit when Index_Type_Mark = Null_Iir; Index := Get_Index_Type (Index_Type_Mark); -- Index comes from a type mark. @@ -835,16 +832,15 @@ package body Trans.Chap3 is function Get_Array_Subtype_Length (Def : Iir_Array_Subtype_Definition) return Iir_Int64 is - Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def); + Indexes_List : constant Iir_Flist := Get_Index_Subtype_List (Def); Index : Iir; Idx_Len : Iir_Int64; Len : Iir_Int64; begin -- Check if the bounds of the array are locally static. Len := 1; - for I in Natural loop + for I in Flist_First .. Flist_Last (Indexes_List) loop Index := Get_Index_Type (Indexes_List, I); - exit when Index = Null_Iir; if Get_Type_Staticness (Index) /= Locally then return -1; @@ -1817,13 +1813,12 @@ package body Trans.Chap3 is when Iir_Kind_Array_Type_Definition => declare - Index_List : constant Iir_List := + Index_List : constant Iir_Flist := Get_Index_Subtype_List (Def); Index : Iir; begin - for I in Natural loop + for I in Flist_First .. Flist_Last (Index_List) loop Index := Get_Index_Type (Index_List, I); - exit when Index = Null_Iir; if Is_Anonymous_Type_Definition (Index) then Create_Type_Definition_Type_Range (Index); end if; @@ -2540,7 +2535,7 @@ package body Trans.Chap3 is function Get_Thin_Array_Length (Atype : Iir) return O_Cnode is - Indexes_List : constant Iir_List := Get_Index_Subtype_List (Atype); + Indexes_List : constant Iir_Flist := Get_Index_Subtype_List (Atype); Nbr_Dim : constant Natural := Get_Nbr_Elements (Indexes_List); Index : Iir; Val : Iir_Int64; @@ -2558,7 +2553,7 @@ package body Trans.Chap3 is function Bounds_To_Range (B : Mnode; Atype : Iir; Dim : Positive) return Mnode is - Indexes_List : constant Iir_List := + Indexes_List : constant Iir_Flist := Get_Index_Subtype_Definition_List (Get_Base_Type (Atype)); Index_Type_Mark : constant Iir := Get_Nth_Element (Indexes_List, Dim - 1); @@ -2696,7 +2691,7 @@ package body Trans.Chap3 is function Get_Bounds_Length (Bounds : Mnode; Atype : Iir) return O_Enode is Type_Info : constant Type_Info_Acc := Get_Info (Atype); - Index_List : constant Iir_List := Get_Index_Subtype_List (Atype); + Index_List : constant Iir_Flist := Get_Index_Subtype_List (Atype); Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List); Dim_Length : O_Enode; Res : O_Enode; @@ -3266,15 +3261,14 @@ package body Trans.Chap3 is function Locally_Array_Match (L_Type, R_Type : Iir) return Boolean is - L_Indexes : constant Iir_List := Get_Index_Subtype_List (L_Type); - R_Indexes : constant Iir_List := Get_Index_Subtype_List (R_Type); + L_Indexes : constant Iir_Flist := Get_Index_Subtype_List (L_Type); + R_Indexes : constant Iir_Flist := Get_Index_Subtype_List (R_Type); L_El : Iir; R_El : Iir; begin - for I in Natural loop + for I in Flist_First .. Flist_Last (L_Indexes) loop L_El := Get_Index_Type (L_Indexes, I); R_El := Get_Index_Type (R_Indexes, I); - exit when L_El = Null_Iir and R_El = Null_Iir; if Eval_Discrete_Type_Length (L_El) /= Eval_Discrete_Type_Length (R_El) then @@ -3308,23 +3302,20 @@ package body Trans.Chap3 is else -- Check length match. declare - Index_List : constant Iir_List := + Index_List : constant Iir_Flist := Get_Index_Subtype_List (L_Type); - Index : Iir; Cond : O_Enode; Sub_Cond : O_Enode; begin - for I in Natural loop - Index := Get_Nth_Element (Index_List, I); - exit when Index = Null_Iir; + for I in 1 .. Get_Nbr_Elements (Index_List) loop Sub_Cond := New_Compare_Op (ON_Neq, M2E (Range_To_Length - (Get_Array_Range (L_Node, L_Type, I + 1))), + (Get_Array_Range (L_Node, L_Type, I))), M2E (Range_To_Length - (Get_Array_Range (R_Node, R_Type, I + 1))), + (Get_Array_Range (R_Node, R_Type, I))), Ghdl_Bool_Type); - if I = 0 then + if I = 1 then Cond := Sub_Cond; else Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond); diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index c5d7df598..d4808ed2f 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -1978,7 +1978,7 @@ package body Trans.Chap4 is Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); Base_Type := Get_Base_Type (Arr_Type); Index_Info := Get_Info - (Get_First_Element (Get_Index_Subtype_Definition_List (Base_Type))); + (Get_Nth_Element (Get_Index_Subtype_Definition_List (Base_Type), 0)); Base_Info := Get_Info (Base_Type); El_Type := Get_Element_Subtype (Arr_Type); diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index 5838562f3..5537890c9 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -350,8 +350,8 @@ package body Trans.Chap6 is is Prefix_Type : constant Iir := Get_Type (Get_Prefix (Expr)); Prefix_Info : constant Type_Info_Acc := Get_Info (Prefix_Type); - Index_List : constant Iir_List := Get_Index_List (Expr); - Type_List : constant Iir_List := Get_Index_Subtype_List (Prefix_Type); + Index_List : constant Iir_Flist := Get_Index_List (Expr); + Type_List : constant Iir_Flist := Get_Index_Subtype_List (Prefix_Type); Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List); Prefix : Mnode; Index : Iir; diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 1e741d024..833cbc5ed 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -797,7 +797,7 @@ package body Trans.Chap7 is when Iir_Kind_Array_Type_Definition | Iir_Kind_Array_Subtype_Definition => declare - Expr_Indexes : constant Iir_List := + Expr_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Expr_Type); begin for I in 1 .. Get_Nbr_Elements (Expr_Indexes) loop @@ -2889,7 +2889,7 @@ package body Trans.Chap7 is Dim : Natural; Var_Index : O_Dnode) is - Index_List : Iir_List; + Index_List : Iir_Flist; Expr_Type : Iir; Final : Boolean; @@ -3199,9 +3199,9 @@ package body Trans.Chap7 is (Target : Mnode; Target_Type : Iir; Aggr : Iir) is Aggr_Type : constant Iir := Get_Type (Aggr); - Index_List : constant Iir_List := + Index_List : constant Iir_Flist := Get_Index_Subtype_List (Aggr_Type); - Targ_Index_List : constant Iir_List := + Targ_Index_List : constant Iir_Flist := Get_Index_Subtype_List (Target_Type); Aggr_Info : Iir_Aggregate_Info; @@ -3255,9 +3255,8 @@ package body Trans.Chap7 is Aggr_Info := Get_Aggregate_Info (Aggr); -- Check type - for I in Natural loop + for I in Flist_First .. Flist_Last (Index_List) loop Subaggr_Type := Get_Index_Type (Index_List, I); - exit when Subaggr_Type = Null_Iir; Subtarg_Type := Get_Index_Type (Targ_Index_List, I); Bt := Get_Base_Type (Subaggr_Type); @@ -3633,23 +3632,22 @@ package body Trans.Chap7 is procedure Translate_Type_Conversion_Bounds (Res : Mnode; Src : Mnode; Res_Type : Iir; Src_Type : Iir; Loc : Iir) is - Res_Indexes : constant Iir_List := Get_Index_Subtype_List (Res_Type); - Src_Indexes : constant Iir_List := Get_Index_Subtype_List (Src_Type); + Res_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Res_Type); + Src_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Src_Type); Res_Base_Type : constant Iir := Get_Base_Type (Res_Type); Src_Base_Type : constant Iir := Get_Base_Type (Src_Type); - Res_Base_Indexes : constant Iir_List := + Res_Base_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Res_Base_Type); - Src_Base_Indexes : constant Iir_List := + Src_Base_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Src_Base_Type); R_El : Iir; S_El : Iir; begin -- Convert bounds. - for I in Natural loop + for I in Flist_First .. Flist_Last (Src_Indexes) loop R_El := Get_Index_Type (Res_Indexes, I); S_El := Get_Index_Type (Src_Indexes, I); - exit when S_El = Null_Iir; declare Rb_Ptr : Mnode; Sb_Ptr : Mnode; @@ -4712,7 +4710,7 @@ package body Trans.Chap7 is Info : constant Type_Info_Acc := Get_Info (Arr_Type); F_Info : constant Operator_Info_Acc := Get_Info (Subprg); L, R : Mnode; - Indexes : constant Iir_List := Get_Index_Subtype_List (Arr_Type); + Indexes : constant Iir_Flist := Get_Index_Subtype_List (Arr_Type); Nbr_Indexes : constant Natural := Get_Nbr_Elements (Indexes); If_Blk : O_If_Block; Var_I : O_Dnode; diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index c97807064..a4416f068 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -3907,7 +3907,7 @@ package body Trans.Chap8 is Idx : O_Dnode; Dim : Natural) is - Index_List : constant Iir_List := + Index_List : constant Iir_Flist := Get_Index_Subtype_List (Target_Type); Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List); Sub_Aggr : Mnode; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index bd8bcde4b..c6a900855 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -1127,6 +1127,23 @@ package body Trans.Chap9 is end case; end Destroy_Types_In_List; + procedure Destroy_Types_In_Flist (L : Iir_Flist) + is + El : Iir; + begin + case L is + when Null_Iir_Flist + | Iir_Flist_All + | Iir_Flist_Others => + return; + when others => + for I in Flist_First .. Flist_Last (L) loop + El := Get_Nth_Element (L, I); + Destroy_Types (El); + end loop; + end case; + end Destroy_Types_In_Flist; + procedure Destroy_Types (N : Iir) is begin -- Nothing to do for null node. @@ -1194,6 +1211,20 @@ package body Trans.Chap9 is when others => raise Internal_Error; end case; + when Type_Iir_Flist => + case Get_Field_Attribute (F) is + when Attr_None => + Destroy_Types_In_Flist (Get_Iir_Flist (N, F)); + when Attr_Of_Maybe_Ref => + if not Get_Is_Ref (N) then + Destroy_Types_In_Flist (Get_Iir_Flist (N, F)); + end if; + when Attr_Ref + | Attr_Of_Ref => + null; + when others => + raise Internal_Error; + end case; when Type_PSL_NFA | Type_PSL_Node => -- TODO diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index dd60c817a..a555920e7 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -1398,7 +1398,7 @@ package body Trans.Rtis is procedure Generate_Array_Type_Indexes (Atype : Iir; Res : out O_Dnode; Max_Depth : in out Rti_Depth_Type) is - List : constant Iir_List := Get_Index_Subtype_List (Atype); + List : constant Iir_Flist := Get_Index_Subtype_List (Atype); Nbr_Indexes : constant Natural := Get_Nbr_Elements (List); Index : Iir; Tmp : O_Dnode; @@ -1456,7 +1456,7 @@ package body Trans.Rtis is Info : Type_Info_Acc; Aggr : O_Record_Aggr_List; Val : O_Cnode; - List : Iir_List; + List : Iir_Flist; Arr : O_Dnode; Element : Iir; Name : O_Dnode; |