1-- GHDL Run Time (GRT) - Error handling. 2-- Copyright (C) 2002 - 2014 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16-- 17-- As a special exception, if other files instantiate generics from this 18-- unit, or you link this unit with other files to produce an executable, 19-- this unit does not by itself cause the resulting executable to be 20-- covered by the GNU General Public License. This exception does not 21-- however invalidate any other reasons why the executable file might be 22-- covered by the GNU Public License. 23 24with Grt.Errors; use Grt.Errors; 25with Grt.Backtraces; 26 27with Grt.Signals; 28with Grt.Rtis_Addr; 29with Grt.Threads; 30with Grt.Processes; 31with Grt.Rtis_Utils; 32 33package body Grt.Errors_Exec is 34 procedure Error_Call_Stack (Str : String; Skip : Natural) 35 is 36 Bt : Backtrace_Addrs; 37 begin 38 Save_Backtrace (Bt, Skip + 1); 39 Diag_C (Str); 40 Error_E_Call_Stack (Bt); 41 end Error_Call_Stack; 42 43 procedure Error_E_Call_Stack (Bt : Backtrace_Addrs) 44 is 45 use Grt.Signals; 46 use Grt.Rtis_Addr; 47 use Grt.Threads; 48 use Grt.Processes; 49 use Grt.Rtis_Utils; 50 Proc : Process_Acc; 51 Proc_Rti : Rti_Context; 52 begin 53 Newline_Err; 54 55 Proc := Get_Current_Process; 56 if Proc /= null then 57 Proc_Rti := Get_Rti_Context (Proc); 58 if Proc_Rti /= Null_Context then 59 Diag_C ("in process "); 60 Put (Get_Error_Stream, Proc_Rti); 61 Newline_Err; 62 end if; 63 end if; 64 65 Grt.Backtraces.Put_Err_Backtrace (Bt); 66 67 -- Should be able to call Error_E, but we don't want the newline. 68 Fatal_Error; 69 end Error_E_Call_Stack; 70 71 procedure Error_E_Call_Stack (Bt : Backtrace_Addrs_Acc) is 72 begin 73 if Bt /= null then 74 Error_E_Call_Stack (Bt.all); 75 else 76 Error_E; 77 end if; 78 end Error_E_Call_Stack; 79 80 procedure Grt_Overflow_Error (Bt : Backtrace_Addrs_Acc) is 81 begin 82 Error_S ("overflow detected"); 83 Error_E_Call_Stack (Bt); 84 end Grt_Overflow_Error; 85 86 procedure Grt_Null_Access_Error (Bt : Backtrace_Addrs_Acc) is 87 begin 88 Error_S ("NULL access dereferenced"); 89 Error_E_Call_Stack (Bt); 90 end Grt_Null_Access_Error; 91end Grt.Errors_Exec; 92