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-2017, 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 pragma Warnings
(Off
);
33 with System
.Standard_Library
;
36 with GNAT
.Debug_Utilities
; use GNAT
.Debug_Utilities
;
37 with GNAT
.IO
; use GNAT
.IO
;
39 -- Default last chance handler for use with the full VxWorks 653 partition OS
40 -- Ada run-time library.
42 -- Logs error with health monitor, and dumps exception identity and argument
43 -- string for vxaddr2line for generation of a symbolic stack backtrace.
45 procedure Ada
.Exceptions
.Last_Chance_Handler
(Except
: Exception_Occurrence
) is
47 ----------------------
48 -- APEX definitions --
49 ----------------------
51 pragma Warnings
(Off
);
52 type Error_Code_Type
is (
62 pragma Convention
(C
, Error_Code_Type
);
63 -- APEX Health Management error codes
65 type Message_Addr_Type
is new System
.Address
;
67 type Apex_Integer
is range -(2 ** 31) .. (2 ** 31) - 1;
68 pragma Convention
(C
, Apex_Integer
);
70 Max_Error_Message_Size
: constant := 64;
72 type Error_Message_Size_Type
is new Apex_Integer
range
73 1 .. Max_Error_Message_Size
;
75 pragma Warnings
(Off
);
76 type Return_Code_Type
is (
77 No_Error
, -- request valid and operation performed
78 No_Action
, -- status of system unaffected by request
79 Not_Available
, -- resource required by request unavailable
80 Invalid_Param
, -- invalid parameter specified in request
81 Invalid_Config
, -- parameter incompatible with configuration
82 Invalid_Mode
, -- request incompatible with current mode
83 Timed_Out
); -- time-out tied up with request has expired
85 pragma Convention
(C
, Return_Code_Type
);
88 procedure Raise_Application_Error
89 (Error_Code
: Error_Code_Type
;
90 Message_Addr
: Message_Addr_Type
;
91 Length
: Error_Message_Size_Type
;
92 Return_Code
: out Return_Code_Type
);
93 pragma Import
(C
, Raise_Application_Error
, "RAISE_APPLICATION_ERROR");
95 procedure Unhandled_Terminate
;
96 pragma No_Return
(Unhandled_Terminate
);
97 pragma Import
(C
, Unhandled_Terminate
, "__gnat_unhandled_terminate");
98 -- Perform system dependent shutdown code
101 pragma Import
(Ada
, Adainit
, "adainit");
103 Adainit_Addr
: constant System
.Address
:= Adainit
'Code_Address;
104 -- Part of arguments to vxaddr2line
106 Result
: Return_Code_Type
;
109 Exception_Name
(Except
) & ": " & ASCII
.LF
&
110 Exception_Message
(Except
) & ASCII
.NUL
;
112 Message_Length
: Error_Message_Size_Type
;
116 Put_Line
("In last chance handler");
117 Put_Line
(Message
(1 .. Message
'Length - 1));
120 Put_Line
("adainit and traceback addresses for vxaddr2line:");
122 Put
(Image_C
(Adainit_Addr
)); Put
(" ");
124 for J
in 1 .. Except
.Num_Tracebacks
loop
125 Put
(Image_C
(Except
.Tracebacks
(J
)));
131 if Message
'Length > Error_Message_Size_Type
'Last then
132 Message_Length
:= Error_Message_Size_Type
'Last;
134 Message_Length
:= Message
'Length;
137 Raise_Application_Error
138 (Error_Code
=> Application_Error
,
139 Message_Addr
=> Message_Addr_Type
(Message
(1)'Address),
140 Length
=> Message_Length
,
141 Return_Code
=> Result
);
143 -- Shutdown the run-time library now. The rest of the procedure needs to be
144 -- careful not to use anything that would require runtime support. In
145 -- particular, functions returning strings are banned since the sec stack
146 -- is no longer functional.
148 System
.Standard_Library
.Adafinal
;
150 end Ada
.Exceptions
.Last_Chance_Handler
;