From 5737c17897993f46504dc728f9546f0dacddee15 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Thu, 4 Jun 2020 03:59:37 +0200
Subject: grt: add check for empty stack2.
---
src/grt/grt-processes.adb | 7 +++++++
src/grt/grt-stack2.adb | 18 ++++++++++++++----
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);
--
cgit v1.2.3