translation: use a simple mark&sweep to free infos.

3 files changed, 57 insertions, 51 deletions

diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index f71b4ad10..fbd04d9b8 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -1198,6 +1198,7 @@ package body Trans.Chap2 is
       case Src.Kind is
          when Kind_Type =>
             Dest.all := (Kind => Kind_Type,
+                         Mark => False,
                          Type_Mode => Src.Type_Mode,
                          Type_Incomplete => Src.Type_Incomplete,
                          Type_Locally_Constrained =>
@@ -1213,7 +1214,8 @@ package body Trans.Chap2 is
             if Src.C /= null then
                Dest.C := new Complex_Type_Arr_Info'
                  (Mode_Value =>
-                    (Size_Var => Instantiate_Var
+                    (Mark => False,
+                     Size_Var => Instantiate_Var
                        (Src.C (Mode_Value).Size_Var),
                      Builder_Need_Func =>
                        Src.C (Mode_Value).Builder_Need_Func,
@@ -1226,7 +1228,8 @@ package body Trans.Chap2 is
                      Builder_Func =>
                        Src.C (Mode_Value).Builder_Func),
                   Mode_Signal =>
-                    (Size_Var => Instantiate_Var
+                    (Mark => False,
+                     Size_Var => Instantiate_Var
                        (Src.C (Mode_Signal).Size_Var),
                      Builder_Need_Func =>
                        Src.C (Mode_Signal).Builder_Need_Func,
@@ -1242,6 +1245,7 @@ package body Trans.Chap2 is
          when Kind_Object =>
             Dest.all :=
               (Kind => Kind_Object,
+               Mark => False,
                Object_Static => Src.Object_Static,
                Object_Var => Instantiate_Var (Src.Object_Var),
                Object_Rti => Src.Object_Rti);
@@ -1250,6 +1254,7 @@ package body Trans.Chap2 is
             pragma Assert (Src.Signal_Function = O_Dnode_Null);
             Dest.all :=
               (Kind => Kind_Signal,
+               Mark => False,
                Signal_Val => Instantiate_Var (Src.Signal_Val),
                Signal_Valp => Instantiate_Var (Src.Signal_Valp),
                Signal_Sig => Instantiate_Var (Src.Signal_Sig),
@@ -1261,6 +1266,7 @@ package body Trans.Chap2 is
               Instantiate_Var_Scope (Src.Subprg_Frame_Scope);
             Dest.all :=
               (Kind => Kind_Subprg,
+               Mark => False,
                Use_Stack2 => Src.Use_Stack2,
                Subprg_Node => Src.Subprg_Node,
                Res_Interface => Src.Res_Interface,
@@ -1283,6 +1289,7 @@ package body Trans.Chap2 is
          when Kind_Operator =>
             Dest.all :=
               (Kind => Kind_Operator,
+               Mark => False,
                Operator_Stack2 => Src.Operator_Stack2,
                Operator_Body => Src.Operator_Body,
                Operator_Node => Src.Operator_Node,
@@ -1293,18 +1300,22 @@ package body Trans.Chap2 is
                Operator_Res => Src.Operator_Res);
          when Kind_Interface =>
             Dest.all := (Kind => Kind_Interface,
+                         Mark => False,
                          Interface_Mechanism => Src.Interface_Mechanism,
                          Interface_Decl => Src.Interface_Decl,
                          Interface_Field => Src.Interface_Field);
          when Kind_Index =>
             Dest.all := (Kind => Kind_Index,
+                         Mark => False,
                          Index_Field => Src.Index_Field);
          when Kind_Expr =>
             Dest.all := (Kind => Kind_Expr,
+                         Mark => False,
                          Expr_Node => Src.Expr_Node);
          when Kind_Package_Instance =>
             Dest.all :=
               (Kind => Kind_Package_Instance,
+               Mark => False,
                Package_Instance_Spec_Var =>
                  Instantiate_Var (Src.Package_Instance_Spec_Var),
                Package_Instance_Body_Var =>
@@ -1324,12 +1335,14 @@ package body Trans.Chap2 is
 
          when Kind_Field =>
             Dest.all := (Kind => Kind_Field,
+                         Mark => False,
                          Field_Node => Src.Field_Node,
                          Field_Bound => Src.Field_Bound);
 
          when Kind_Package =>
             Dest.all :=
               (Kind => Kind_Package,
+               Mark => False,
                Package_Elab_Spec_Subprg => Src.Package_Elab_Spec_Subprg,
                Package_Elab_Body_Subprg => Src.Package_Elab_Body_Subprg,
                Package_Elab_Spec_Instance =>
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index dc948dbcc..a2385cbe6 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -1462,60 +1462,47 @@ package body Trans is
 
    procedure Free_Node_Infos
    is
-      Info      : Ortho_Info_Acc;
-      Prev_Info : Ortho_Info_Acc;
+      Info : Ortho_Info_Acc;
    begin
-      Prev_Info := null;
+      --  Check each node is not marked.
+      for I in Node_Infos.First .. Node_Infos.Last loop
+         Info := Get_Info (I);
+         pragma Assert (Info = null or else not Info.Mark);
+      end loop;
+
+      --  Clear duplicated nodes
       for I in Node_Infos.First .. Node_Infos.Last loop
          Info := Get_Info (I);
-         if Info /= null and then Info /= Prev_Info then
-            case Get_Kind (I) is
-               when Iir_Kind_Constant_Declaration =>
-                  if Get_Deferred_Declaration_Flag (I) = False
-                    and then Get_Deferred_Declaration (I) /= Null_Iir
-                  then
-                     --  Info are copied from incomplete constant declaration
-                     --  to full constant declaration.
-                     Clear_Info (I);
+         if Info /= null then
+            if Info.Mark then
+               --  This info is shared by another node and was already seen.
+               --  Unreference it.
+               Clear_Info (I);
+            else
+               Info.Mark := True;
+               if Info.Kind = Kind_Type and then Info.C /= null then
+                  if Info.C (Mode_Value).Mark then
+                     Info.C := null;
                   else
-                     Free_Info (I);
-                  end if;
-               when Iir_Kind_Record_Subtype_Definition
-                  | Iir_Kind_Access_Subtype_Definition =>
-                  null;
-               when Iir_Kind_Enumeration_Type_Definition
-                  | Iir_Kind_Array_Type_Definition
-                  | Iir_Kind_Integer_Subtype_Definition
-                  | Iir_Kind_Floating_Subtype_Definition
-                  | Iir_Kind_Physical_Subtype_Definition
-                  | Iir_Kind_Enumeration_Subtype_Definition =>
-                  Free_Type_Info (Info);
-               when Iir_Kind_Array_Subtype_Definition =>
-                  if Get_Index_Constraint_Flag (I) then
-                     Info.B := Ortho_Info_Basetype_Array_Init;
-                     Info.S := Ortho_Info_Subtype_Array_Init;
-                     Free_Type_Info (Info);
+                     Info.C (Mode_Value).Mark := True;
                   end if;
-               when Iir_Kind_Function_Declaration =>
-                  case Get_Implicit_Definition (I) is
-                     when Iir_Predefined_Bit_Array_Match_Equality
-                        |  Iir_Predefined_Bit_Array_Match_Inequality =>
-                        --  Not in sequence.
-                        null;
-                     when others =>
-                        --  By default, info are not shared.
-                        --  The exception is infos for implicit subprograms,
-                        --  but they are always consecutive and not free twice
-                        --  due to prev_info mechanism.
-                        Free_Info (I);
-                  end case;
-               when others =>
-                  --  By default, info are not shared.
-                  Free_Info (I);
-            end case;
-            Prev_Info := Info;
+               end if;
+            end if;
          end if;
       end loop;
+
+      --  Free infos
+      for I in Node_Infos.First .. Node_Infos.Last loop
+         Info := Get_Info (I);
+         if Info /= null then
+            if Info.Kind = Kind_Type then
+               Free_Type_Info (Info);
+            else
+               Free_Info (I);
+            end if;
+         end if;
+      end loop;
+
       Node_Infos.Free;
    end Free_Node_Infos;
 
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 29dd593dc..8b6888764 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -1168,13 +1168,16 @@ package Trans is
 
    --  Additional info for complex types.
    type Complex_Type_Info is record
+      --  For a simple memory management: use mark and sweep to free all infos.
+      Mark : Boolean := False;
+
+      Builder_Need_Func : Boolean := False;
+
       --  Variable containing the size of the type.
       --  This is defined only for types whose size is only known at
       --  running time (and not a compile-time).
       Size_Var : Var_Type := Null_Var;
 
-      Builder_Need_Func : Boolean := False;
-
       --  Parameters for type builders.
       --  NOTE: this is only set for types (and *not* for subtypes).
       Builder_Instance    : Subprgs.Subprg_Instance_Type;
@@ -1219,6 +1222,9 @@ package Trans is
    type Ortho_Info_Acc is access Ortho_Info_Type;
 
    type Ortho_Info_Type (Kind : Ortho_Info_Kind) is record
+      --  For a simple memory management: use mark and sweep to free all infos.
+      Mark : Boolean := False;
+
       case Kind is
          when Kind_Type =>
             --  Mode of the type.