diff options
| -rw-r--r-- | src/grt/grt-processes.adb | 43 | ||||
| -rw-r--r-- | testsuite/vests/vhdl-93/ashenden/compliant/compliant.exp | 2 |
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 |