grt: split grt-errors, disp current process.

18 files changed, 183 insertions, 104 deletions

diff --git a/src/grt/grt-avhpi_utils.adb b/src/grt/grt-avhpi_utils.adb
index 6fedf1b4c..77cd15579 100644
--- a/src/grt/grt-avhpi_utils.adb
+++ b/src/grt/grt-avhpi_utils.adb
@@ -61,5 +61,3 @@ package body Grt.Avhpi_Utils is
    end Name_Compare;
 
 end Grt.Avhpi_Utils;
-
-
diff --git a/src/grt/grt-backtraces-gcc.ads b/src/grt/grt-backtraces-gcc.ads
index b5b35ffd9..8d5b87077 100644
--- a/src/grt/grt-backtraces-gcc.ads
+++ b/src/grt/grt-backtraces-gcc.ads
@@ -26,8 +26,6 @@
 with System;
 
 package Grt.Backtraces.Gcc is
-   pragma Preelaborate (Grt.Backtraces.Gcc);
-
    procedure Symbolizer (Pc : System.Address;
                          Filename : out System.Address;
                          Lineno : out Natural;
diff --git a/src/grt/grt-backtraces-jit.ads b/src/grt/grt-backtraces-jit.ads
index 77afdfda6..4e57b52f9 100644
--- a/src/grt/grt-backtraces-jit.ads
+++ b/src/grt/grt-backtraces-jit.ads
@@ -26,8 +26,6 @@
 with System;
 
 package Grt.Backtraces.Jit is
-   pragma Preelaborate (Grt.Backtraces.Jit);
-
    procedure Symbolizer (Pc : System.Address;
                          Filename : out System.Address;
                          Lineno : out Natural;
diff --git a/src/grt/grt-backtraces.adb b/src/grt/grt-backtraces.adb
index 80ea5331f..2be99eca7 100644
--- a/src/grt/grt-backtraces.adb
+++ b/src/grt/grt-backtraces.adb
@@ -26,6 +26,7 @@
 with System;
 with Grt.Types; use Grt.Types;
 with Grt.Hooks; use Grt.Hooks;
+with Grt.Errors; use Grt.Errors;
 with Grt.Backtraces.Impl;
 
 package body Grt.Backtraces is
diff --git a/src/grt/grt-backtraces.ads b/src/grt/grt-backtraces.ads
index 301131f93..6b840e6fd 100644
--- a/src/grt/grt-backtraces.ads
+++ b/src/grt/grt-backtraces.ads
@@ -23,11 +23,9 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 
-with Grt.Errors; use Grt.Errors;
+with Grt.Errors_Exec; use Grt.Errors_Exec;
 
 package Grt.Backtraces is
-   pragma Preelaborate (Grt.Backtraces);
-
    --  Display a backtrace on standard error, or nothing if not available.
    procedure Put_Err_Backtrace (Bt : Backtrace_Addrs);
 
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index cdaf48923..3afc6cce9 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -27,7 +27,6 @@ with Grt.Astdio; use Grt.Astdio;
 with Grt.Astdio.Vhdl; use Grt.Astdio.Vhdl;
 with Grt.Options; use Grt.Options;
 with Grt.Hooks; use Grt.Hooks;
-with Grt.Backtraces;
 
 package body Grt.Errors is
    --  Output stream to send error messages
@@ -193,15 +192,6 @@ package body Grt.Errors is
       Error_E;
    end Error;
 
-   procedure Error_Call_Stack (Str : String; Skip : Natural)
-   is
-      Bt : Backtrace_Addrs;
-   begin
-      Save_Backtrace (Bt, Skip + 1);
-      Diag_C (Str);
-      Error_E_Call_Stack (Bt);
-   end Error_Call_Stack;
-
    procedure Error (Str : String;
                     Filename : Ghdl_C_String;
                     Line : Ghdl_I32) is
@@ -242,35 +232,4 @@ package body Grt.Errors is
       Newline_Err;
       Fatal_Error;
    end Internal_Error;
-
-   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs) is
-   begin
-      Newline_Err;
-
-      Grt.Backtraces.Put_Err_Backtrace (Bt);
-
-      --  Should be able to call Error_E, but we don't want the newline.
-      Fatal_Error;
-   end Error_E_Call_Stack;
-
-   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs_Acc) is
-   begin
-      if Bt /= null then
-         Error_E_Call_Stack (Bt.all);
-      else
-         Error_E;
-      end if;
-   end Error_E_Call_Stack;
-
-   procedure Grt_Overflow_Error (Bt : Backtrace_Addrs_Acc) is
-   begin
-      Error_S ("overflow detected");
-      Error_E_Call_Stack (Bt);
-   end Grt_Overflow_Error;
-
-   procedure Grt_Null_Access_Error (Bt : Backtrace_Addrs_Acc) is
-   begin
-      Error_S ("NULL access dereferenced");
-      Error_E_Call_Stack (Bt);
-   end Grt_Null_Access_Error;
 end Grt.Errors;
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index f97d25573..175609cf9 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -77,10 +77,6 @@ package Grt.Errors is
    procedure Error (Str : String);
    pragma No_Return (Error);
 
-   --  Complete error message with a call stack.  SKIP is the number of
-   --  frame to skip, 0 means the caller of this procedure is displayed.
-   procedure Error_Call_Stack (Str : String; Skip : Natural);
-
    procedure Error (Str : String;
                     Filename : Ghdl_C_String;
                     Line : Ghdl_I32);
@@ -98,41 +94,6 @@ package Grt.Errors is
    procedure Info_S (Str : String := "");
    procedure Info_E;
 
-   --  Backtrace used to report call stack in case of error.
-   --  Note: for simplicity we assume that a PC is enough to display the
-   --  corresponding file name, line number and routine name.  Might not be
-   --  true on some platforms.
-   --  There is a C version of this record in grt_itf.h
-   type Integer_Address_Array is array (Natural range <>) of Integer_Address;
-   type Backtrace_Addrs is record
-      Size : Natural;
-      Skip : Natural;
-      Addrs : Integer_Address_Array (0 .. 31);
-   end record;
-   pragma Convention (C, Backtrace_Addrs);
-
-   type Backtrace_Addrs_Acc is access Backtrace_Addrs;
-
-   --  Save the current backtrace to BT, but skip SKIP frame.  0 means that
-   --  the caller of this procedure will be in the backtrace.
-   procedure Save_Backtrace (Bt : out Backtrace_Addrs; Skip : Natural);
-   pragma Import (C, Save_Backtrace, "grt_save_backtrace");
-
-   --  Finish error message with a call stack.
-   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs);
-   pragma No_Return (Error_E_Call_Stack);
-
-   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs_Acc);
-   pragma No_Return (Error_E_Call_Stack);
-
-   --  Display an error message for an overflow.
-   procedure Grt_Overflow_Error (Bt : Backtrace_Addrs_Acc);
-   pragma No_Return (Grt_Overflow_Error);
-
-   --  Display an error message for a NULL access dereference.
-   procedure Grt_Null_Access_Error (Bt : Backtrace_Addrs_Acc);
-   pragma No_Return (Grt_Null_Access_Error);
-
    --  Called at end of error message.  Central point for failures.
    procedure Fatal_Error;
    pragma No_Return (Fatal_Error);
@@ -162,13 +123,15 @@ package Grt.Errors is
    --  If true, an error is expected and the exit status is inverted.
    Expect_Failure : Boolean := False;
 
+   Note_Severity    : constant Integer := 0;
+   Warning_Severity : constant Integer := 1;
+   Error_Severity   : constant Integer := 2;
+   Failure_Severity : constant Integer := 3;
+
    --  Internal subprograms, to be called only by the symbolizer.
    procedure Put_Err (C : Character) renames Diag_C;
    procedure Put_Err (Str : String) renames Diag_C;
    procedure Put_Err (Str : Ghdl_C_String) renames Diag_C;
    procedure Put_Err (N : Integer) renames Diag_C;
    procedure Newline_Err;
-private
-   pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
-   pragma Export (C, Grt_Null_Access_Error, "grt_null_access_error");
 end Grt.Errors;
diff --git a/src/grt/grt-errors_exec.adb b/src/grt/grt-errors_exec.adb
new file mode 100644
index 000000000..798ead9b9
--- /dev/null
+++ b/src/grt/grt-errors_exec.adb
@@ -0,0 +1,93 @@
+--  GHDL Run Time (GRT) - Error handling.
+--  Copyright (C) 2002 - 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+with Grt.Errors; use Grt.Errors;
+with Grt.Backtraces;
+
+with Grt.Signals;
+with Grt.Rtis_Addr;
+with Grt.Threads;
+with Grt.Processes;
+with Grt.Rtis_Utils;
+
+package body Grt.Errors_Exec is
+   procedure Error_Call_Stack (Str : String; Skip : Natural)
+   is
+      Bt : Backtrace_Addrs;
+   begin
+      Save_Backtrace (Bt, Skip + 1);
+      Diag_C (Str);
+      Error_E_Call_Stack (Bt);
+   end Error_Call_Stack;
+
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs)
+   is
+      use Grt.Signals;
+      use Grt.Rtis_Addr;
+      use Grt.Threads;
+      use Grt.Processes;
+      use Grt.Rtis_Utils;
+      Proc : Process_Acc;
+      Proc_Rti : Rti_Context;
+   begin
+      Newline_Err;
+
+      Proc := Get_Current_Process;
+      if Proc /= null then
+         Proc_Rti := Get_Rti_Context (Proc);
+         if Proc_Rti /= Null_Context then
+            Diag_C ("in process ");
+            Put (Get_Error_Stream, Proc_Rti);
+            Newline_Err;
+         end if;
+      end if;
+
+      Grt.Backtraces.Put_Err_Backtrace (Bt);
+
+      --  Should be able to call Error_E, but we don't want the newline.
+      Fatal_Error;
+   end Error_E_Call_Stack;
+
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs_Acc) is
+   begin
+      if Bt /= null then
+         Error_E_Call_Stack (Bt.all);
+      else
+         Error_E;
+      end if;
+   end Error_E_Call_Stack;
+
+   procedure Grt_Overflow_Error (Bt : Backtrace_Addrs_Acc) is
+   begin
+      Error_S ("overflow detected");
+      Error_E_Call_Stack (Bt);
+   end Grt_Overflow_Error;
+
+   procedure Grt_Null_Access_Error (Bt : Backtrace_Addrs_Acc) is
+   begin
+      Error_S ("NULL access dereferenced");
+      Error_E_Call_Stack (Bt);
+   end Grt_Null_Access_Error;
+end Grt.Errors_Exec;
diff --git a/src/grt/grt-errors_exec.ads b/src/grt/grt-errors_exec.ads
new file mode 100644
index 000000000..a722e605c
--- /dev/null
+++ b/src/grt/grt-errors_exec.ads
@@ -0,0 +1,69 @@
+--  GHDL Run Time (GRT) - Error handling during execution (backtrace).
+--  Copyright (C) 2002 - 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+
+package Grt.Errors_Exec is
+   --  Complete error message with a call stack.  SKIP is the number of
+   --  frame to skip, 0 means the caller of this procedure is displayed.
+   procedure Error_Call_Stack (Str : String; Skip : Natural);
+
+   --  Backtrace used to report call stack in case of error.
+   --  Note: for simplicity we assume that a PC is enough to display the
+   --  corresponding file name, line number and routine name.  Might not be
+   --  true on some platforms.
+   --  There is a C version of this record in grt_itf.h
+   type Integer_Address_Array is array (Natural range <>) of Integer_Address;
+   type Backtrace_Addrs is record
+      Size : Natural;
+      Skip : Natural;
+      Addrs : Integer_Address_Array (0 .. 31);
+   end record;
+   pragma Convention (C, Backtrace_Addrs);
+
+   type Backtrace_Addrs_Acc is access Backtrace_Addrs;
+
+   --  Save the current backtrace to BT, but skip SKIP frame.  0 means that
+   --  the caller of this procedure will be in the backtrace.
+   procedure Save_Backtrace (Bt : out Backtrace_Addrs; Skip : Natural);
+   pragma Import (C, Save_Backtrace, "grt_save_backtrace");
+
+   --  Finish error message with a call stack.
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs);
+   pragma No_Return (Error_E_Call_Stack);
+
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs_Acc);
+   pragma No_Return (Error_E_Call_Stack);
+
+   --  Display an error message for an overflow.
+   procedure Grt_Overflow_Error (Bt : Backtrace_Addrs_Acc);
+   pragma No_Return (Grt_Overflow_Error);
+
+   --  Display an error message for a NULL access dereference.
+   procedure Grt_Null_Access_Error (Bt : Backtrace_Addrs_Acc);
+   pragma No_Return (Grt_Null_Access_Error);
+private
+   pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
+   pragma Export (C, Grt_Null_Access_Error, "grt_null_access_error");
+end Grt.Errors_Exec;
diff --git a/src/grt/grt-files.adb b/src/grt/grt-files.adb
index 5ab74f127..826e9b05f 100644
--- a/src/grt/grt-files.adb
+++ b/src/grt/grt-files.adb
@@ -23,6 +23,7 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 with Grt.Errors; use Grt.Errors;
+with Grt.Errors_Exec; use Grt.Errors_Exec;
 with Grt.Stdio; use Grt.Stdio;
 with Grt.C; use Grt.C;
 with Grt.Table;
diff --git a/src/grt/grt-images.adb b/src/grt/grt-images.adb
index d048b195d..f0c2d8392 100644
--- a/src/grt/grt-images.adb
+++ b/src/grt/grt-images.adb
@@ -27,6 +27,7 @@ with Ada.Unchecked_Conversion;
 with Grt.Rtis_Utils; use Grt.Rtis_Utils;
 with Grt.Processes; use Grt.Processes;
 with Grt.Errors; use Grt.Errors;
+with Grt.Errors_Exec; use Grt.Errors_Exec;
 with Grt.To_Strings; use Grt.To_Strings;
 
 package body Grt.Images is
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb
index b6f006e4a..5391ad3b9 100644
--- a/src/grt/grt-lib.adb
+++ b/src/grt/grt-lib.adb
@@ -25,6 +25,7 @@
 
 with Interfaces;
 with Grt.Errors; use Grt.Errors;
+with Grt.Errors_Exec; use Grt.Errors_Exec;
 with Grt.Options;
 with Grt.Fcvt;
 
@@ -283,6 +284,7 @@ package body Grt.Lib is
 
    procedure Ghdl_Check_Stack_Allocation (Size : Ghdl_Index_Type)
    is
+      use Options;
       Bt : Backtrace_Addrs;
    begin
       if Max_Stack_Allocation = 0 then
diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads
index 51f4b4a95..b0f68d3e9 100644
--- a/src/grt/grt-lib.ads
+++ b/src/grt/grt-lib.ads
@@ -25,8 +25,6 @@
 with Grt.Types; use Grt.Types;
 
 package Grt.Lib is
-   pragma Preelaborate (Grt.Lib);
-
    procedure Ghdl_Memcpy
      (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type);
 
@@ -50,11 +48,6 @@ package Grt.Lib is
    procedure Ghdl_Report
      (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
 
-   Note_Severity    : constant Integer := 0;
-   Warning_Severity : constant Integer := 1;
-   Error_Severity   : constant Integer := 2;
-   Failure_Severity : constant Integer := 3;
-
    --  Bound / Direction error.
    procedure Ghdl_Bound_Check_Failed (Filename : Ghdl_C_String;
                                       Line: Ghdl_I32);
@@ -73,8 +66,6 @@ package Grt.Lib is
    --  Called before allocation of large (complex) objects.
    procedure Ghdl_Check_Stack_Allocation (Size : Ghdl_Index_Type);
 
-   Max_Stack_Allocation : Ghdl_Index_Type := 128 * 1024;
-
    function Ghdl_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr;
 
    --  Allocate and clear SIZE bytes.
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
index e19d491ca..58505b381 100644
--- a/src/grt/grt-options.adb
+++ b/src/grt/grt-options.adb
@@ -305,7 +305,7 @@ package body Grt.Options is
                Diag_C (Option);
                Error_E ("'");
             else
-               Lib.Max_Stack_Allocation := Ghdl_Index_Type (Val * 1024);
+               Max_Stack_Allocation := Ghdl_Index_Type (Val * 1024);
             end if;
          end;
       elsif Len >= 11 and then Option (1 .. 11) = "--activity=" then
diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads
index 32852d650..fd0daad07 100644
--- a/src/grt/grt-options.ads
+++ b/src/grt/grt-options.ads
@@ -23,7 +23,7 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 with Grt.Types; use Grt.Types;
-with Grt.Lib; use Grt.Lib;
+with Grt.Errors;
 
 package Grt.Options is
    pragma Preelaborate (Grt.Options);
@@ -120,7 +120,7 @@ package Grt.Options is
    Checks : Boolean := False;
 
    --  Level at which an assert stop the simulation.
-   Severity_Level : Integer := Failure_Severity;
+   Severity_Level : Integer := Grt.Errors.Failure_Severity;
 
    --  How assertions are handled.
    type Assert_Handling is
@@ -157,6 +157,9 @@ package Grt.Options is
    -- or append_mode (TEXTIO)
    Unbuffered_Writes : Boolean := False;
 
+   --  Set maximum dynamic stack allocation.
+   Max_Stack_Allocation : Ghdl_Index_Type := 128 * 1024;
+
    --  Helper: extract time from STR (a number followed by a unit, without
    --  spaces; the number is optionnal).  In case of error, display an error
    --  message and returns -1.
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index 3fe7603c6..a2060ad02 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -30,6 +30,7 @@ with Grt.Disp;
 with Grt.Astdio;
 with Grt.Astdio.Vhdl; use Grt.Astdio.Vhdl;
 with Grt.Errors; use Grt.Errors;
+with Grt.Errors_Exec; use Grt.Errors_Exec;
 with Grt.Options;
 with Grt.Rtis_Addr; use Grt.Rtis_Addr;
 with Grt.Rtis_Utils;
diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb
index ff9ea74a4..0478146e2 100644
--- a/src/grt/grt-signals.adb
+++ b/src/grt/grt-signals.adb
@@ -26,7 +26,9 @@ with System; use System;
 with System.Storage_Elements; --  Work around GNAT bug.
 pragma Unreferenced (System.Storage_Elements);
 with Ada.Unchecked_Deallocation;
+
 with Grt.Errors; use Grt.Errors;
+with Grt.Errors_Exec; use Grt.Errors_Exec;
 with Grt.Processes; use Grt.Processes;
 with Grt.Options; use Grt.Options;
 with Grt.Disp_Signals;
diff --git a/src/grt/grt-std_logic_1164.adb b/src/grt/grt-std_logic_1164.adb
index c9c5f91e5..472febc97 100644
--- a/src/grt/grt-std_logic_1164.adb
+++ b/src/grt/grt-std_logic_1164.adb
@@ -24,6 +24,7 @@
 --  covered by the GNU Public License.
 
 with Grt.Lib;
+with Grt.Errors; use Grt.Errors;
 
 package body Grt.Std_Logic_1164 is
    Assert_DC_Msg : constant String :=