1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . E X C E P T I O N S . L A S T _ C H A N C E _ H A N D L E R --
9 -- Copyright (C) 2003-2018, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- Default version for most targets
34 pragma Compiler_Unit_Warning
;
36 with System
.Standard_Library
; use System
.Standard_Library
;
37 with System
.Soft_Links
; use System
;
39 procedure Ada
.Exceptions
.Last_Chance_Handler
40 (Except
: Exception_Occurrence
)
42 procedure Unhandled_Terminate
;
43 pragma No_Return
(Unhandled_Terminate
);
44 pragma Import
(C
, Unhandled_Terminate
, "__gnat_unhandled_terminate");
45 -- Perform system dependent shutdown code
47 function Exception_Message_Length
48 (X
: Exception_Occurrence
) return Natural;
49 pragma Import
(Ada
, Exception_Message_Length
, "__gnat_exception_msg_len");
51 procedure Append_Info_Exception_Message
52 (X
: Exception_Occurrence
;
54 Ptr
: in out Natural);
56 (Ada
, Append_Info_Exception_Message
, "__gnat_append_info_e_msg");
58 procedure Append_Info_Untailored_Exception_Information
59 (X
: Exception_Occurrence
;
61 Ptr
: in out Natural);
63 (Ada
, Append_Info_Untailored_Exception_Information
,
64 "__gnat_append_info_u_e_info");
66 procedure To_Stderr
(S
: String);
67 pragma Import
(Ada
, To_Stderr
, "__gnat_to_stderr");
68 -- Little routine to output string to stderr
70 Gnat_Argv
: System
.Address
;
71 pragma Import
(C
, Gnat_Argv
, "gnat_argv");
73 procedure Fill_Arg
(A
: System
.Address
; Arg_Num
: Integer);
74 pragma Import
(C
, Fill_Arg
, "__gnat_fill_arg");
76 function Len_Arg
(Arg_Num
: Integer) return Integer;
77 pragma Import
(C
, Len_Arg
, "__gnat_len_arg");
80 Nobuf
: String (1 .. 0);
82 Nline
: constant String := String'(1 => ASCII.LF);
83 -- Convenient shortcut
86 -- Do not execute any task termination code when shutting down the system.
87 -- The Adafinal procedure would execute the task termination routine for
88 -- normal termination, but we have already executed the task termination
89 -- procedure because of an unhandled exception.
91 System.Soft_Links.Task_Termination_Handler :=
92 System.Soft_Links.Task_Termination_NT'Access;
94 -- We shutdown the runtime now. The rest of the procedure needs to be
95 -- careful not to use anything that would require runtime support. In
96 -- particular, functions returning strings are banned since the sec stack
97 -- is no longer functional. This is particularly important to note for the
98 -- Exception_Information output. We used to allow the tailored version to
99 -- show up here, which turned out to be a bad idea as it might involve a
100 -- traceback decorator the length of which we don't control. Potentially
101 -- heavy primary/secondary stack use or dynamic allocations right before
102 -- this point are not welcome, moving the output before the finalization
103 -- raises order of outputs concerns, and decorators are intended to only
104 -- be used with exception traces, which should have been issued already.
106 System.Standard_Library.Adafinal;
108 -- Print a message only when exception traces are not active
110 if Exception_Trace /= RM_Convention then
113 -- Check for special case of raising _ABORT_SIGNAL, which is not
114 -- really an exception at all. We recognize this by the fact that
115 -- it is the only exception whose name starts with underscore.
117 elsif To_Ptr (Except.Id.Full_Name) (1) = '_
' then
119 To_Stderr ("Execution terminated by abort of environment task");
122 -- If no tracebacks, we print the unhandled exception in the old style
123 -- (i.e. the style used before ZCX was implemented). We do this to
124 -- retain compatibility.
126 elsif Except.Num_Tracebacks = 0 then
128 To_Stderr ("raised ");
130 (To_Ptr (Except.Id.Full_Name) (1 .. Except.Id.Name_Length - 1));
132 if Exception_Message_Length (Except) /= 0 then
134 Append_Info_Exception_Message (Except, Nobuf, Ptr);
144 if Gnat_Argv = System.Null_Address then
145 To_Stderr ("Execution terminated by unhandled exception");
148 Arg : aliased String (1 .. Len_Arg (0));
150 Fill_Arg (Arg'Address, 0);
151 To_Stderr ("Execution of ");
153 To_Stderr (" terminated by unhandled exception");
159 Append_Info_Untailored_Exception_Information (Except, Nobuf, Ptr);
163 end Ada.Exceptions.Last_Chance_Handler;