diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/grt/grt-processes.adb | 7 | ||||
-rw-r--r-- | src/grt/grt-stack2.adb | 18 | ||||
-rw-r--r-- | src/grt/grt-stack2.ads | 6 |
3 files changed, 27 insertions, 4 deletions
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb index c10c0ac95..a4850d9ad 100644 --- a/src/grt/grt-processes.adb +++ b/src/grt/grt-processes.adb @@ -807,6 +807,13 @@ package body Grt.Processes is Set_Current_Process (Proc); Proc.Subprg.all (Proc.This); if Grt.Options.Checks then + if Proc.State = State_Sensitized + and then not Is_Empty (Proc.Stack2) + then + -- A non-sensitized process may store its state + -- on stack2. + Internal_Error ("non-empty stack2"); + end if; Ghdl_Signal_Internal_Checks; end if; end; diff --git a/src/grt/grt-stack2.adb b/src/grt/grt-stack2.adb index 1ae18be5a..aaf686980 100644 --- a/src/grt/grt-stack2.adb +++ b/src/grt/grt-stack2.adb @@ -142,7 +142,8 @@ package body Grt.Stack2 is return Chunk.Mem (Chunk.First)'Address; end Allocate; - function Create return Stack2_Ptr is + function Create return Stack2_Ptr + is Res : Stack2_Acc; Chunk : Chunk_Acc; begin @@ -154,9 +155,15 @@ package body Grt.Stack2 is return To_Addr (Res); end Create; - -- May be used to debug. - procedure Dump_Stack2 (S : Stack2_Ptr); - pragma Unreferenced (Dump_Stack2); + function Is_Empty (S : Stack2_Ptr) return Boolean + is + S2 : constant Stack2_Acc := To_Acc (S); + begin + if S2 = null then + return True; + end if; + return S2.Top = 1; + end Is_Empty; procedure Dump_Stack2 (S : Stack2_Ptr) is @@ -174,6 +181,9 @@ package body Grt.Stack2 is Put ("Stack 2 at "); Put (stdout, Address (S)); New_Line; + if S2 = null then + return; + end if; Put ("First Chunk at "); Put (stdout, To_Address (S2.First_Chunk)); Put (", last chunk at "); diff --git a/src/grt/grt-stack2.ads b/src/grt/grt-stack2.ads index 1c0c79afe..a7c2799f6 100644 --- a/src/grt/grt-stack2.ads +++ b/src/grt/grt-stack2.ads @@ -58,6 +58,12 @@ package Grt.Stack2 is -- Create a secondary stack. function Create return Stack2_Ptr; + + -- Return True iff S is null or empty. + function Is_Empty (S : Stack2_Ptr) return Boolean; + + -- May be used to debug. + procedure Dump_Stack2 (S : Stack2_Ptr); private type Stack2_Ptr is new System.Address; Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address); |