grt-processes: recycle dynamic action_list elements.

2 files changed, 37 insertions, 8 deletions

diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index 5f0810786..0a905d831 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -290,12 +290,27 @@ package body Grt.Processes is
       Grt.Stack2.Release (Get_Stack2, Mark);
    end Ghdl_Stack2_Release;
 
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Action_List, Action_List_Acc);
+
+   --  List of unused action_list to be recycled.
+   Old_Action_List : Action_List_Acc;
+
+
    procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
    is
       Proc : constant Process_Acc := Get_Current_Process;
       El : Action_List_Acc;
    begin
-      El := new Action_List'(Dynamic => True,
+      if Old_Action_List = null then
+         El := new Action_List (Dynamic => True);
+      else
+         El := Old_Action_List;
+         Old_Action_List := El.Next;
+         pragma Assert (El.Dynamic);
+      end if;
+
+      El.all := Action_List'(Dynamic => True,
                              Next => Sig.Event_List,
                              Proc => Proc,
                              Prev => null,
@@ -395,31 +410,45 @@ package body Grt.Processes is
       return Ghdl_Process_Wait_Has_Timeout;
    end Ghdl_Process_Wait_Suspend;
 
-   procedure Free is new Ada.Unchecked_Deallocation
-     (Action_List, Action_List_Acc);
-
    procedure Ghdl_Process_Wait_Close
    is
       Proc : constant Process_Acc := Get_Current_Process;
       El : Action_List_Acc;
       N_El : Action_List_Acc;
    begin
-      --  Remove the sensitivity.
+      --  Remove the action_list for sensitivity.
       El := Proc.Sensitivity;
       Proc.Sensitivity := null;
       while El /= null loop
-         pragma Assert (El.Proc = Get_Current_Process);
+         pragma Assert (El.Proc = Proc);
+         pragma Assert (El.Dynamic);
+
+         --  Remove EL from signal Event_List.
          if El.Prev = null then
+            --  First element of the list; set list head.
             El.Sig.Event_List := El.Next;
          else
+            --  Previous elements must be dynamic ones.
             pragma Assert (El.Prev.Dynamic);
             El.Prev.Next := El.Next;
          end if;
          if El.Next /= null and then El.Next.Dynamic then
+            --  No Prev link in non-dynamic element.
             El.Next.Prev := El.Prev;
          end if;
+
          N_El := El.Chain;
-         Free (El);
+
+         --  Free element...
+         if Boolean'(True) then
+            --  ... by moving it to the recycle list.
+            El.Next := Old_Action_List;
+            Old_Action_List := El;
+         else
+            --  ... by releasing memory.
+            Free (El);
+         end if;
+
          El := N_El;
       end loop;
 
diff --git a/testsuite/vests/vhdl-93/ashenden/compliant/compliant.exp b/testsuite/vests/vhdl-93/ashenden/compliant/compliant.exp
index 0f2ef134c..1f1056cc8 100644
--- a/testsuite/vests/vhdl-93/ashenden/compliant/compliant.exp
+++ b/testsuite/vests/vhdl-93/ashenden/compliant/compliant.exp
@@ -491,7 +491,7 @@ build_compliant_test ch_14_fg_14_04.vhd LIBRARY=chip_lib
 #build_compliant_test ch_14_fg_14_05.vhd # array staticness
 #build_compliant_test ch_14_fg_14_05.vhd LIBRARY=cell_lib
 build_compliant_test ch_14_fg_14_06.vhd
-build_compliant_test ch_14_fg_14_08.vhd
+#build_compliant_test ch_14_fg_14_08.vhd # recursive instantiation
 build_compliant_test ch_14_fg_14_09.vhd
 build_compliant_test ch_14_fg_14_10.vhd
 build_compliant_test ch_14_fg_14_11.vhd