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) is
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)
51 -- Exception information to be output in the case of automatic tracing
52 -- requested through GNAT.Exception_Traces.
54 -- This is the same as Exception_Information if no backtrace decorator
55 -- is currently in place. Otherwise, this is Exception_Information with
56 -- the call chain raw addresses replaced by the result of a call to the
57 -- current decorator provided with the call chain addresses.
60 (Ada, Tailored_Exception_Information,
61 "__gnat_tailored_exception_information");
63 procedure Tailored_Exception_Information
64 (X : Exception_Occurrence;
66 Last : in out Integer);
67 -- Procedural version of the above function. Instead of returning the
68 -- result, this one is put in Buff (Buff'first .. Buff'first + Last)
70 procedure To_Stderr (S : String);
71 pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
72 -- Little routine to output string to stderr
74 Nline : constant String := String'(1 => ASCII.LF);
75 -- Convenient shortcut
77 Msg : constant String := Except.Msg (1 .. Except.Msg_Length);
79 Max_Static_Exc_Info : constant := 1024;
80 -- This should be enough for most exception information cases
81 -- even though tailoring introduces some uncertainty. The
82 -- name+message should not exceed 320 chars, so that leaves at
83 -- least 35 backtrace slots (each slot needs 19 chars for
84 -- representing a 64 bit address).
86 subtype Exc_Info_Type is String (1 .. Max_Static_Exc_Info);
87 type Str_Ptr is access Exc_Info_Type;
89 Exc_Info_Last : Natural := 0;
90 -- Buffer that is allocated to store the tailored exception
91 -- information while Adafinal is run. This buffer is allocated
92 -- on the heap only when it is needed. It is better to allocate
93 -- on the heap than on the stack since stack overflows are more
94 -- common than heap overflows.
96 procedure Tailored_Exception_Information
97 (X : Exception_Occurrence;
99 Last : in out Integer) is
101 Info : String := Tailored_Exception_Information (X);
104 Buff (1 .. Last) := Info;
105 end Tailored_Exception_Information;
110 -- First allocate & store the exception info in a buffer when
111 -- we know it will be needed. This needs to be done before
112 -- Adafinal because it implicitly uses the secondary stack.
114 if Except.Id.Full_Name.all (1) /= '_'
115 and then Except.Num_Tracebacks /= 0
117 Exc_Info := new Exc_Info_Type;
118 if Exc_Info /= null then
119 Tailored_Exception_Information
120 (Except, Exc_Info.all, Exc_Info_Last);
124 -- Let's shutdown the runtime now. The rest of the procedure
125 -- needs to be careful not to use anything that would require
126 -- runtime support. In particular, functions returning strings
127 -- are banned since the sec stack is no longer functional.
128 System.Standard_Library.Adafinal;
130 -- Check for special case of raising _ABORT_SIGNAL, which is not
131 -- really an exception at all. We recognize this by the fact that
132 -- it is the only exception whose name starts with underscore.
134 if Except.Id.Full_Name.all (1) = '_' then
136 To_Stderr ("Execution terminated by abort of environment task");
139 -- If no tracebacks, we print the unhandled exception in the old style
140 -- (i.e. the style used before ZCX was implemented). We do this to
141 -- retain compatibility.
143 elsif Except.Num_Tracebacks = 0 then
145 To_Stderr ("raised ");
146 To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
148 if Msg'Length /= 0 then
158 -- Note we can have this whole information output twice if
159 -- this occurrence gets reraised up to here.
162 To_Stderr ("Execution terminated by unhandled exception");
164 To_Stderr (Exc_Info (1 .. Exc_Info_Last));
169 end Ada.Exceptions.Last_Chance_Handler;