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-2024, 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 with System
.Standard_Library
; use System
.Standard_Library
;
35 with System
.Soft_Links
; use System
;
37 procedure Ada
.Exceptions
.Last_Chance_Handler
38 (Except
: Exception_Occurrence
)
40 procedure Unhandled_Terminate
;
41 pragma No_Return
(Unhandled_Terminate
);
42 pragma Import
(C
, Unhandled_Terminate
, "__gnat_unhandled_terminate");
43 -- Perform system dependent shutdown code
45 function Exception_Message_Length
46 (X
: Exception_Occurrence
) return Natural;
47 pragma Import
(Ada
, Exception_Message_Length
, "__gnat_exception_msg_len");
49 procedure Append_Info_Exception_Message
50 (X
: Exception_Occurrence
;
52 Ptr
: in out Natural);
54 (Ada
, Append_Info_Exception_Message
, "__gnat_append_info_e_msg");
56 procedure Append_Info_Untailored_Exception_Information
57 (X
: Exception_Occurrence
;
59 Ptr
: in out Natural);
61 (Ada
, Append_Info_Untailored_Exception_Information
,
62 "__gnat_append_info_u_e_info");
64 procedure To_Stderr
(S
: String);
65 pragma Import
(Ada
, To_Stderr
, "__gnat_to_stderr");
66 -- Little routine to output string to stderr
68 Gnat_Argv
: System
.Address
;
69 pragma Import
(C
, Gnat_Argv
, "gnat_argv");
71 procedure Fill_Arg
(A
: System
.Address
; Arg_Num
: Integer);
72 pragma Import
(C
, Fill_Arg
, "__gnat_fill_arg");
74 function Len_Arg
(Arg_Num
: Integer) return Integer;
75 pragma Import
(C
, Len_Arg
, "__gnat_len_arg");
78 Nobuf
: String (1 .. 0);
80 Nline
: constant String := String'(1 => ASCII.LF);
81 -- Convenient shortcut
84 -- Do not execute any task termination code when shutting down the system.
85 -- The Adafinal procedure would execute the task termination routine for
86 -- normal termination, but we have already executed the task termination
87 -- procedure because of an unhandled exception.
89 System.Soft_Links.Task_Termination_Handler :=
90 System.Soft_Links.Task_Termination_NT'Access;
92 -- We shutdown the runtime now. The rest of the procedure needs to be
93 -- careful not to use anything that would require runtime support. In
94 -- particular, functions returning strings are banned since the sec stack
95 -- is no longer functional. This is particularly important to note for the
96 -- Exception_Information output. We used to allow the tailored version to
97 -- show up here, which turned out to be a bad idea as it might involve a
98 -- traceback decorator the length of which we don't control. Potentially
99 -- heavy primary/secondary stack use or dynamic allocations right before
100 -- this point are not welcome, moving the output before the finalization
101 -- raises order of outputs concerns, and decorators are intended to only
102 -- be used with exception traces, which should have been issued already.
104 System.Standard_Library.Adafinal;
106 -- Print a message only when exception traces are not active
108 if Exception_Trace /= RM_Convention then
111 -- Check for special case of raising _ABORT_SIGNAL, which is not
112 -- really an exception at all. We recognize this by the fact that
113 -- it is the only exception whose name starts with underscore.
115 elsif To_Ptr (Except.Id.Full_Name) (1) = '_
' then
117 To_Stderr ("Execution terminated by abort of environment task");
120 -- If no tracebacks, we print the unhandled exception in the old style
121 -- (i.e. the style used before ZCX was implemented). We do this to
122 -- retain compatibility.
124 elsif Except.Num_Tracebacks = 0 then
126 To_Stderr ("raised ");
128 (To_Ptr (Except.Id.Full_Name) (1 .. Except.Id.Name_Length - 1));
130 if Exception_Message_Length (Except) /= 0 then
132 Append_Info_Exception_Message (Except, Nobuf, Ptr);
142 if Gnat_Argv = System.Null_Address then
143 To_Stderr ("Execution terminated by unhandled exception");
146 Arg : aliased String (1 .. Len_Arg (0));
148 Fill_Arg (Arg'Address, 0);
149 To_Stderr ("Execution of ");
151 To_Stderr (" terminated by unhandled exception");
157 Append_Info_Untailored_Exception_Information (Except, Nobuf, Ptr);
161 end Ada.Exceptions.Last_Chance_Handler;