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 Free Software Foundation, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 2, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
24 -- MA 02111-1307, USA. --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
33 -- GNAT was originally developed by the GNAT team at New York University. --
34 -- Extensive contributions were provided by Ada Core Technologies Inc. --
36 ------------------------------------------------------------------------------
38 -- Default version for most targets
40 procedure Ada
.Exceptions
.Last_Chance_Handler
41 (Except
: Exception_Occurrence
)
43 procedure Unhandled_Terminate
;
44 pragma No_Return
(Unhandled_Terminate
);
45 pragma Import
(C
, Unhandled_Terminate
, "__gnat_unhandled_terminate");
46 -- Perform system dependent shutdown code
48 function Tailored_Exception_Information
49 (X
: Exception_Occurrence
) return String;
50 -- Exception information to be output in the case of automatic tracing
51 -- requested through GNAT.Exception_Traces.
53 -- This is the same as Exception_Information if no backtrace decorator
54 -- is currently in place. Otherwise, this is Exception_Information with
55 -- the call chain raw addresses replaced by the result of a call to the
56 -- current decorator provided with the call chain addresses.
59 (Ada
, Tailored_Exception_Information
,
60 "__gnat_tailored_exception_information");
62 procedure Tailored_Exception_Information
63 (X
: Exception_Occurrence
;
65 Last
: in out Integer);
66 -- Procedural version of the above function. Instead of returning the
67 -- result, this one is put in Buff (Buff'first .. Buff'first + Last)
69 procedure To_Stderr
(S
: String);
70 pragma Import
(Ada
, To_Stderr
, "__gnat_to_stderr");
71 -- Little routine to output string to stderr
73 Nline
: constant String := String'(1 => ASCII.LF);
74 -- Convenient shortcut
76 Msg : constant String := Except.Msg (1 .. Except.Msg_Length);
78 Max_Static_Exc_Info : constant := 1024;
79 -- This should be enough for most exception information cases
80 -- even though tailoring introduces some uncertainty. The
81 -- name+message should not exceed 320 chars, so that leaves at
82 -- least 35 backtrace slots (each slot needs 19 chars for
83 -- representing a 64 bit address).
85 subtype Exc_Info_Type is String (1 .. Max_Static_Exc_Info);
86 type Str_Ptr is access Exc_Info_Type;
88 Exc_Info_Last : Natural := 0;
89 -- Buffer that is allocated to store the tailored exception
90 -- information while Adafinal is run. This buffer is allocated
91 -- on the heap only when it is needed. It is better to allocate
92 -- on the heap than on the stack since stack overflows are more
93 -- common than heap overflows.
95 procedure Tailored_Exception_Information
96 (X : Exception_Occurrence;
98 Last : in out Integer)
100 Info : constant String := Tailored_Exception_Information (X);
103 Buff (1 .. Last) := Info;
104 end Tailored_Exception_Information;
107 -- First allocate & store the exception info in a buffer when
108 -- we know it will be needed. This needs to be done before
109 -- Adafinal because it implicitly uses the secondary stack.
111 if Except.Id.Full_Name.all (1) /= '_
'
112 and then Except.Num_Tracebacks /= 0
114 Exc_Info := new Exc_Info_Type;
115 if Exc_Info /= null then
116 Tailored_Exception_Information
117 (Except, Exc_Info.all, Exc_Info_Last);
121 -- Let's shutdown the runtime now. The rest of the procedure
122 -- needs to be careful not to use anything that would require
123 -- runtime support. In particular, functions returning strings
124 -- are banned since the sec stack is no longer functional.
125 System.Standard_Library.Adafinal;
127 -- Check for special case of raising _ABORT_SIGNAL, which is not
128 -- really an exception at all. We recognize this by the fact that
129 -- it is the only exception whose name starts with underscore.
131 if Except.Id.Full_Name.all (1) = '_
' then
133 To_Stderr ("Execution terminated by abort of environment task");
136 -- If no tracebacks, we print the unhandled exception in the old style
137 -- (i.e. the style used before ZCX was implemented). We do this to
138 -- retain compatibility.
140 elsif Except.Num_Tracebacks = 0 then
142 To_Stderr ("raised ");
143 To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
145 if Msg'Length /= 0 then
155 -- Note we can have this whole information output twice if
156 -- this occurrence gets reraised up to here.
159 To_Stderr ("Execution terminated by unhandled exception");
161 To_Stderr (Exc_Info (1 .. Exc_Info_Last));
165 end Ada.Exceptions.Last_Chance_Handler;