Use Flist for simple_aggregate.

9 files changed, 103 insertions, 86 deletions

diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index 4dac2402f..f6bde461f 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -2625,15 +2625,13 @@ package body Disp_Vhdl is
 
    procedure Disp_Simple_Aggregate (Aggr: Iir_Simple_Aggregate)
    is
-      List : Iir_List;
+      List : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr);
       El : Iir;
       First : Boolean := True;
    begin
       Put ("(");
-      List := Get_Simple_Aggregate_List (Aggr);
-      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 First then
             First := False;
          else
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index 3e6cdc7f4..0c1a91444 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -159,7 +159,7 @@ package body Evaluation is
    --  Build a simple aggregate composed of EL_LIST from ORIGIN.  STYPE is the
    --  type of the aggregate.  DEF_TYPE should be either Null_Iir or STYPE.  It
    --  is set only when a new subtype has been created for the aggregate.
-   function Build_Simple_Aggregate (El_List : Iir_List;
+   function Build_Simple_Aggregate (El_List : Iir_Flist;
                                     Origin : Iir;
                                     Stype : Iir;
                                     Def_Type : Iir := Null_Iir)
@@ -452,11 +452,11 @@ package body Evaluation is
    --  Free the result RES of Eval_String_Literal called with ORIG, if created.
    procedure Free_Eval_String_Literal (Res : Iir; Orig : Iir)
    is
-      L : Iir_List;
+      L : Iir_Flist;
    begin
       if Res /= Orig then
          L := Get_Simple_Aggregate_List (Res);
-         Destroy_Iir_List (L);
+         Destroy_Iir_Flist (L);
          Free_Iir (Res);
       end if;
    end Free_Eval_String_Literal;
@@ -471,15 +471,15 @@ package body Evaluation is
       Len : constant Nat32 := Get_String_Length (Str);
       Id : constant String8_Id := Get_String8_Id (Str);
 
-      List : Iir_List;
+      List : Iir_Flist;
       Lit : Iir;
    begin
-      List := Create_Iir_List;
+      List := Create_Iir_Flist (Natural (Len));
 
       for I in 1 .. Len loop
          Lit := Get_Nth_Element
            (Literal_List, Natural (Str_Table.Element_String8 (Id, I)));
-         Append_Element (List, Lit);
+         Set_Nth_Element (List, Natural (I - 1), Lit);
       end loop;
       return Build_Simple_Aggregate (List, Str, Get_Type (Str));
    end String_Literal8_To_Simple_Aggregate;
@@ -566,7 +566,7 @@ package body Evaluation is
       Len : constant Iir_Int64 := Eval_Discrete_Range_Length (Index_Range);
       Assocs : constant Iir := Get_Association_Choices_Chain (Aggr);
       Vect : Iir_Array (0 .. Integer (Len - 1));
-      List : Iir_List;
+      List : Iir_Flist;
       Assoc : Iir;
       Expr : Iir;
    begin
@@ -586,11 +586,11 @@ package body Evaluation is
 
       Build_Array_Choices_Vector (Vect, Index_Range, Assocs);
 
-      List := Create_Iir_List;
+      List := Create_Iir_Flist (Natural (Len));
       if Len > 0 then
          --  Workaround GNAT GPL2014 compiler bug.
          for I in Vect'Range loop
-            Append_Element (List, Get_Associated_Expr (Vect (I)));
+            Set_Nth_Element (List, I, Get_Associated_Expr (Vect (I)));
          end loop;
       end if;
 
@@ -657,18 +657,17 @@ package body Evaluation is
          when Iir_Predefined_TF_Array_Not =>
             declare
                Lit_Val : Iir;
-               O_List : Iir_List;
-               R_List : Iir_List;
+               O_List : Iir_Flist;
+               R_List : Iir_Flist;
                El : Iir;
                Lit : Iir;
             begin
                Lit_Val := Eval_String_Literal (Operand);
                O_List := Get_Simple_Aggregate_List (Lit_Val);
-               R_List := Create_Iir_List;
+               R_List := Create_Iir_Flist (Get_Nbr_Elements (O_List));
 
-               for I in Natural loop
+               for I in Flist_First .. Flist_Last (O_List) loop
                   El := Get_Nth_Element (O_List, I);
-                  exit when El = Null_Iir;
                   case Get_Enum_Pos (El) is
                      when 0 =>
                         Lit := Bit_1;
@@ -677,7 +676,7 @@ package body Evaluation is
                      when others =>
                         raise Internal_Error;
                   end case;
-                  Append_Element (R_List, Lit);
+                  Set_Nth_Element (R_List, I, Lit);
                end loop;
                Free_Eval_String_Literal (Lit_Val, Operand);
                return Build_Simple_Aggregate
@@ -694,7 +693,7 @@ package body Evaluation is
             --  LRM08 5.3.2.4 Predefined operations on array types
             declare
                Saggr : Iir;
-               Lits : Iir_List;
+               Lits : Iir_Flist;
                Res : Iir;
                El : Iir;
                Cmp : Compare_Type;
@@ -718,9 +717,8 @@ package body Evaluation is
                   end;
                else
                   Res := Get_Nth_Element (Lits, 0);
-                  for I in Positive loop
+                  for I in Flist_First .. Flist_Last (Lits) loop
                      El := Get_Nth_Element (Lits, I);
-                     exit when El = Null_Iir;
                      Cmp := Eval_Scalar_Compare (El, Res);
                      case Iir_Predefined_Vector_Minmax (Func) is
                         when Iir_Predefined_Vector_Minimum =>
@@ -876,17 +874,14 @@ package body Evaluation is
      (Left, Right : Iir; Origin : Iir; Func : Iir_Predefined_Shift_Functions)
      return Iir
    is
-      Count : Iir_Int64;
+      Count : constant Iir_Int64 := Get_Value (Right);
+      Arr_List : constant Iir_Flist := Get_Simple_Aggregate_List (Left);
+      Len : constant Natural := Get_Nbr_Elements (Arr_List);
       Cnt : Natural;
-      Len : Natural;
-      Arr_List : Iir_List;
-      Res_List : Iir_List;
+      Res_List : Iir_Flist;
       Dir_Left : Boolean;
       E : Iir;
    begin
-      Count := Get_Value (Right);
-      Arr_List := Get_Simple_Aggregate_List (Left);
-      Len := Get_Nbr_Elements (Arr_List);
       --  LRM93 7.2.3
       --  That is, if R is 0 or if L is a null array, the return value is L.
       if Count = 0 or Len = 0 then
@@ -934,7 +929,7 @@ package body Evaluation is
             end if;
       end case;
 
-      Res_List := Create_Iir_List;
+      Res_List := Create_Iir_Flist (Len);
 
       case Func is
          when Iir_Predefined_Array_Sll
@@ -944,32 +939,32 @@ package body Evaluation is
             if Dir_Left then
                if Cnt < Len then
                   for I in Cnt .. Len - 1 loop
-                     Append_Element
-                       (Res_List, Get_Nth_Element (Arr_List, I));
+                     Set_Nth_Element
+                       (Res_List, I - Cnt, Get_Nth_Element (Arr_List, I));
                   end loop;
                else
                   Cnt := Len;
                end if;
                for I in 0 .. Cnt - 1 loop
-                  Append_Element (Res_List, E);
+                  Set_Nth_Element (Res_List, Len - Cnt + I, E);
                end loop;
             else
                if Cnt > Len then
                   Cnt := Len;
                end if;
                for I in 0 .. Cnt - 1 loop
-                  Append_Element (Res_List, E);
+                  Set_Nth_Element (Res_List, I, E);
                end loop;
                for I in Cnt .. Len - 1 loop
-                  Append_Element
-                    (Res_List, Get_Nth_Element (Arr_List, I - Cnt));
+                  Set_Nth_Element
+                    (Res_List, I, Get_Nth_Element (Arr_List, I - Cnt));
                end loop;
             end if;
          when Iir_Predefined_Array_Rol
            | Iir_Predefined_Array_Ror =>
             for I in 1 .. Len loop
-               Append_Element
-                 (Res_List, Get_Nth_Element (Arr_List, Cnt));
+               Set_Nth_Element
+                 (Res_List, I - 1, Get_Nth_Element (Arr_List, Cnt));
                Cnt := Cnt + 1;
                if Cnt = Len then
                   Cnt := 0;
@@ -984,29 +979,50 @@ package body Evaluation is
      (Left, Right : Iir; Orig : Iir; Func : Iir_Predefined_Concat_Functions)
      return Iir
    is
-      Res_List : Iir_List;
-      L : Natural;
+      Res_List : Iir_Flist;
+      Res_Len : Natural;
       Res_Type : Iir;
       Origin_Type : Iir;
       Left_Aggr, Right_Aggr : Iir;
-      Left_List, Right_List : Iir_List;
-      Left_Len : Natural;
+      Left_List, Right_List : Iir_Flist;
+      Left_Len, Right_Len : Natural;
    begin
-      Res_List := Create_Iir_List;
-      --  Do the concatenation.
+      --  Compute length of the result.
       --  Left:
       case Func is
          when Iir_Predefined_Element_Array_Concat
            | Iir_Predefined_Element_Element_Concat =>
-            Append_Element (Res_List, Left);
             Left_Len := 1;
          when Iir_Predefined_Array_Element_Concat
            | Iir_Predefined_Array_Array_Concat =>
             Left_Aggr := Eval_String_Literal (Left);
             Left_List := Get_Simple_Aggregate_List (Left_Aggr);
             Left_Len := Get_Nbr_Elements (Left_List);
+      end case;
+      --  Right:
+      case Func is
+         when Iir_Predefined_Array_Element_Concat
+           | Iir_Predefined_Element_Element_Concat =>
+            Right_Len := 1;
+         when Iir_Predefined_Element_Array_Concat
+           | Iir_Predefined_Array_Array_Concat =>
+            Right_Aggr := Eval_String_Literal (Right);
+            Right_List := Get_Simple_Aggregate_List (Right_Aggr);
+            Right_Len := Get_Nbr_Elements (Right_List);
+      end case;
+
+      Res_Len := Left_Len + Right_Len;
+      Res_List := Create_Iir_Flist (Res_Len);
+      --  Do the concatenation.
+      --  Left:
+      case Func is
+         when Iir_Predefined_Element_Array_Concat
+           | Iir_Predefined_Element_Element_Concat =>
+            Set_Nth_Element (Res_List, 0, Left);
+         when Iir_Predefined_Array_Element_Concat
+           | Iir_Predefined_Array_Array_Concat =>
             for I in 0 .. Left_Len - 1 loop
-               Append_Element (Res_List, Get_Nth_Element (Left_List, I));
+               Set_Nth_Element (Res_List, I, Get_Nth_Element (Left_List, I));
             end loop;
             Free_Eval_String_Literal (Left_Aggr, Left);
       end case;
@@ -1014,18 +1030,15 @@ package body Evaluation is
       case Func is
          when Iir_Predefined_Array_Element_Concat
            | Iir_Predefined_Element_Element_Concat =>
-            Append_Element (Res_List, Right);
+            Set_Nth_Element (Res_List, Left_Len, Right);
          when Iir_Predefined_Element_Array_Concat
            | Iir_Predefined_Array_Array_Concat =>
-            Right_Aggr := Eval_String_Literal (Right);
-            Right_List := Get_Simple_Aggregate_List (Right_Aggr);
-            L := Get_Nbr_Elements (Right_List);
-            for I in 0 .. L - 1 loop
-               Append_Element (Res_List, Get_Nth_Element (Right_List, I));
+            for I in 0 .. Right_Len - 1 loop
+               Set_Nth_Element
+                 (Res_List, Left_Len + I, Get_Nth_Element (Right_List, I));
             end loop;
             Free_Eval_String_Literal (Right_Aggr, Right);
       end case;
-      L := Get_Nbr_Elements (Res_List);
 
       --  Compute subtype...
       Origin_Type := Get_Type (Orig);
@@ -1074,7 +1087,7 @@ package body Evaluation is
                Set_Left_Limit (A_Range, Get_Left_Limit (Left_Range));
                Set_Direction (A_Range, Get_Direction (Left_Range));
                Location_Copy (A_Range, Orig);
-               Set_Right_Limit_By_Length (A_Range, Iir_Int64 (L));
+               Set_Right_Limit_By_Length (A_Range, Iir_Int64 (Res_Len));
                Index_Type := Create_Range_Subtype_From_Type
                  (Left_Index, Get_Location (Orig));
                Set_Range_Constraint (Index_Type, A_Range);
@@ -1089,7 +1102,7 @@ package body Evaluation is
             --  concatenation is the direction of S, and the left bound of the
             --  result is S'LEFT.
             Res_Type := Create_Unidim_Array_By_Length
-              (Origin_Type, Iir_Int64 (L), Orig);
+              (Origin_Type, Iir_Int64 (Res_Len), Orig);
          end if;
       end if;
       --  FIXME: this is not necessarily a string, it may be an aggregate if
@@ -1209,7 +1222,7 @@ package body Evaluation is
          --  General case.
          declare
             Left_Val, Right_Val : Iir;
-            R_List, L_List : Iir_List;
+            R_List, L_List : Iir_Flist;
             R_Len, L_Len : Natural;
             P : Natural;
             Res : Compare_Type;
@@ -3554,7 +3567,8 @@ package body Evaluation is
          case Get_Kind (Expr) is
             when Iir_Kind_Simple_Aggregate =>
                declare
-                  List : constant Iir_List := Get_Simple_Aggregate_List (Expr);
+                  List : constant Iir_Flist :=
+                    Get_Simple_Aggregate_List (Expr);
                begin
                   return Str_Info'(Is_String => False,
                                    Len => Nat32 (Get_Nbr_Elements (List)),
diff --git a/src/vhdl/evaluation.ads b/src/vhdl/evaluation.ads
index a0eb3bdd8..279f5dd80 100644
--- a/src/vhdl/evaluation.ads
+++ b/src/vhdl/evaluation.ads
@@ -184,7 +184,7 @@ package Evaluation is
                Id : String8_Id;
             when False =>
                --  A simple aggregate.  List of elements.
-               List : Iir_List;
+               List : Iir_Flist;
          end case;
       end record;
 
diff --git a/src/vhdl/flists.adb b/src/vhdl/flists.adb
index 6f14a7c7a..4aca3d6ad 100644
--- a/src/vhdl/flists.adb
+++ b/src/vhdl/flists.adb
@@ -50,10 +50,10 @@ package body Flists is
    --  Linked list of free flist.  For length less than the last index, the
    --  index corresponds to the length.  All free lists whose length is equal
    --  or greater than the last index are grouped to the last index.
-   Free_Flists : Flist_Array (1 .. 16) := (others => Null_Flist);
+   Free_Flists : Flist_Array (0 .. 16) := (others => Null_Flist);
 
-   --  Get the chain for a free flist.  It is stored at the first element of
-   --  the list.
+   --  Get the chain for a free flist for large length.  It is stored at the
+   --  first element of the list.
    function Free_Next (Flist : Flist_Type) return Flist_Type is
    begin
       return Flist_Type (Els.Table (Flistt.Table (Flist).Els));
@@ -61,15 +61,15 @@ package body Flists is
 
    function Create_Flist (Len : Natural) return Flist_Type
    is
-      pragma Assert (Len > 0);
       Res : Flist_Type;
       Prev : Flist_Type;
       Next : Flist_Type;
    begin
       if Len >= Free_Flists'Last then
+         --  Large length.
          Res := Free_Flists (Free_Flists'Last);
          Prev := Null_Flist;
-         while Res /= Null_Flist and Length (Res) /= Len loop
+         while Res /= Null_Flist and then Length (Res) /= Len loop
             Prev := Res;
             Res := Free_Next (Res);
          end loop;
@@ -82,9 +82,16 @@ package body Flists is
             end if;
          end if;
       else
+         --  Small length.  The Len field contains the next free list.
          Res := Free_Flists (Len);
          if Res /= Null_Flist then
-            Free_Flists (Len) := Free_Next (Res);
+            Free_Flists (Len) := Flist_Type (Flistt.Table (Res).Len);
+            Flistt.Table (Res).Len := Nat32 (Len);
+         elsif Len = 0 then
+            --  Quick case for len = 0.
+            Res := Flistt.Allocate (1);
+            Flistt.Table (Res) := (Els => 0, Len => 0);
+            return Res;
          end if;
       end if;
 
@@ -114,12 +121,15 @@ package body Flists is
       if Len >= Free_Flists'Last then
          Prev := Free_Flists (Free_Flists'Last);
          Free_Flists (Free_Flists'Last) := Flist;
+
+         Els.Table (Flistt.Table (Flist).Els) := Node_Type (Prev);
       else
          Prev := Free_Flists (Len);
          Free_Flists (Len) := Flist;
+
+         Flistt.Table (Flist).Len := Nat32 (Prev);
       end if;
 
-      Els.Table (Flistt.Table (Flist).Els) := Node_Type (Prev);
       Flist := Null_Flist;
    end Destroy_Flist;
 
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index 9283e8ebb..286055d2a 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -997,20 +997,20 @@ package body Iirs is
       Set_Field5 (Lit, Conv.Field5);
    end Set_Fp_Value;
 
-   function Get_Simple_Aggregate_List (Target : Iir) return Iir_List is
+   function Get_Simple_Aggregate_List (Target : Iir) return Iir_Flist is
    begin
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target)),
                      "no field Simple_Aggregate_List");
-      return Iir_To_Iir_List (Get_Field4 (Target));
+      return Iir_To_Iir_Flist (Get_Field4 (Target));
    end Get_Simple_Aggregate_List;
 
-   procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List) is
+   procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_Flist) is
    begin
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target)),
                      "no field Simple_Aggregate_List");
-      Set_Field4 (Target, Iir_List_To_Iir (List));
+      Set_Field4 (Target, Iir_Flist_To_Iir (List));
    end Set_Simple_Aggregate_List;
 
    function Get_String8_Id (Lit : Iir) return String8_Id is
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 0d8c5926f..119f0b3fc 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -5922,8 +5922,8 @@ package Iirs is
 
    --  List of elements of a simple aggregate.
    --  Field: Field4 Ref (uc)
-   function Get_Simple_Aggregate_List (Target : Iir) return Iir_List;
-   procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List);
+   function Get_Simple_Aggregate_List (Target : Iir) return Iir_Flist;
+   procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_Flist);
 
    --  For a string literal: the string identifier.
    --  Field: Field5 (uc)
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index b9556526a..aa1261220 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -46,7 +46,7 @@ package body Nodes_Meta is
       Field_Enum_Pos => Type_Iir_Int32,
       Field_Physical_Literal => Type_Iir,
       Field_Fp_Value => Type_Iir_Fp64,
-      Field_Simple_Aggregate_List => Type_Iir_List,
+      Field_Simple_Aggregate_List => Type_Iir_Flist,
       Field_String8_Id => Type_String8_Id,
       Field_String_Length => Type_Int32,
       Field_Bit_String_Base => Type_Number_Base_Type,
@@ -5909,6 +5909,8 @@ package body Nodes_Meta is
    begin
       pragma Assert (Fields_Type (F) = Type_Iir_Flist);
       case F is
+         when Field_Simple_Aggregate_List =>
+            return Get_Simple_Aggregate_List (N);
          when Field_Index_Subtype_List =>
             return Get_Index_Subtype_List (N);
          when Field_Index_Subtype_Definition_List =>
@@ -5927,6 +5929,8 @@ package body Nodes_Meta is
    begin
       pragma Assert (Fields_Type (F) = Type_Iir_Flist);
       case F is
+         when Field_Simple_Aggregate_List =>
+            Set_Simple_Aggregate_List (N, V);
          when Field_Index_Subtype_List =>
             Set_Index_Subtype_List (N, V);
          when Field_Index_Subtype_Definition_List =>
@@ -6067,8 +6071,6 @@ package body Nodes_Meta is
             return Get_Dependence_List (N);
          when Field_Analysis_Checks_List =>
             return Get_Analysis_Checks_List (N);
-         when Field_Simple_Aggregate_List =>
-            return Get_Simple_Aggregate_List (N);
          when Field_Entity_Name_List =>
             return Get_Entity_Name_List (N);
          when Field_Signal_List =>
@@ -6109,8 +6111,6 @@ package body Nodes_Meta is
             Set_Dependence_List (N, V);
          when Field_Analysis_Checks_List =>
             Set_Analysis_Checks_List (N, V);
-         when Field_Simple_Aggregate_List =>
-            Set_Simple_Aggregate_List (N, V);
          when Field_Entity_Name_List =>
             Set_Entity_Name_List (N, V);
          when Field_Signal_List =>
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 833cbc5ed..bfa70ca3b 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -251,7 +251,7 @@ package body Trans.Chap7 is
    function Translate_Static_Simple_Aggregate (Aggr : Iir) return O_Cnode
    is
       Aggr_Type : constant Iir := Get_Type (Aggr);
-      El_List   : constant Iir_List := Get_Simple_Aggregate_List (Aggr);
+      El_List   : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr);
       El_Type   : constant Iir := Get_Element_Subtype (Aggr_Type);
       El        : Iir;
       List      : O_Array_Aggr_List;
@@ -260,9 +260,8 @@ package body Trans.Chap7 is
       Chap3.Translate_Anonymous_Type_Definition (Aggr_Type);
       Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));
 
-      for I in Natural loop
+      for I in Flist_First .. Flist_Last (El_List) loop
          El := Get_Nth_Element (El_List, I);
-         exit when El = Null_Iir;
          New_Array_Aggr_El
            (List, Translate_Static_Expression (El, El_Type));
       end loop;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 42620ba91..c6ef271fa 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -88,17 +88,13 @@ package body Translation is
             end;
          when Iir_Kind_Simple_Aggregate =>
             declare
-               List : Iir_List;
+               List : constant Iir_Flist := Get_Simple_Aggregate_List (Expr);
                El : Iir;
             begin
-               List := Get_Simple_Aggregate_List (Expr);
                Nam_Length := 0;
-               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 Get_Kind (El) /= Iir_Kind_Enumeration_Literal then
-                     raise Internal_Error;
-                  end if;
+                  pragma Assert (Get_Kind (El) = Iir_Kind_Enumeration_Literal);
                   Nam_Length := Nam_Length + 1;
                   Nam_Buffer (Nam_Length) :=
                     Character'Val (Get_Enum_Pos (El));