1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- 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 --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Default version for most targets
procedure Ada.Exceptions.Last_Chance_Handler
(Except : Exception_Occurrence)
is
procedure Unhandled_Terminate;
pragma No_Return (Unhandled_Terminate);
pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
-- Perform system dependent shutdown code
function Exception_Message_Length
(X : Exception_Occurrence) return Natural;
pragma Import (Ada, Exception_Message_Length, "__gnat_exception_msg_len");
procedure Append_Info_Exception_Message
(X : Exception_Occurrence; Info : in out String; Ptr : in out Natural);
pragma Import
(Ada, Append_Info_Exception_Message, "__gnat_append_info_e_msg");
procedure Append_Info_Exception_Information
(X : Exception_Occurrence; Info : in out String; Ptr : in out Natural);
pragma Import
(Ada, Append_Info_Exception_Information, "__gnat_append_info_e_info");
procedure To_Stderr (S : String);
pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
-- Little routine to output string to stderr
Ptr : Natural := 0;
Nobuf : String (1 .. 0);
Nline : constant String := String'(1 => ASCII.LF);
-- Convenient shortcut
begin
-- Let's shutdown the runtime now. The rest of the procedure needs to be
-- careful not to use anything that would require runtime support. In
-- particular, functions returning strings are banned since the sec stack
-- is no longer functional. This is particularly important to note for the
-- Exception_Information output. We used to allow the tailored version to
-- show up here, which turned out to be a bad idea as it might involve a
-- traceback decorator the length of which we don't control. Potentially
-- heavy primary/secondary stack use or dynamic allocations right before
-- this point are not welcome, moving the output before the finalization
-- raises order of outputs concerns, and decorators are intended to only
-- be used with exception traces, which should have been issued already.
System.Standard_Library.Adafinal;
-- Check for special case of raising _ABORT_SIGNAL, which is not
-- really an exception at all. We recognize this by the fact that
-- it is the only exception whose name starts with underscore.
if Except.Id.Full_Name.all (1) = '_' then
To_Stderr (Nline);
To_Stderr ("Execution terminated by abort of environment task");
To_Stderr (Nline);
-- If no tracebacks, we print the unhandled exception in the old style
-- (i.e. the style used before ZCX was implemented). We do this to
-- retain compatibility.
elsif Except.Num_Tracebacks = 0 then
To_Stderr (Nline);
To_Stderr ("raised ");
To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
if Exception_Message_Length (Except) /= 0 then
To_Stderr (" : ");
Append_Info_Exception_Message (Except, Nobuf, Ptr);
end if;
To_Stderr (Nline);
-- Traceback exists
else
To_Stderr (Nline);
To_Stderr ("Execution terminated by unhandled exception");
To_Stderr (Nline);
Append_Info_Exception_Information (Except, Nobuf, Ptr);
end if;
Unhandled_Terminate;
end Ada.Exceptions.Last_Chance_Handler;
|
