File : a-elchha-vxworks-ppc-full.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
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 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 pragma Warnings (Off);
33 with System.Standard_Library;
34 pragma Warnings (On);
35
36 with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
37 with GNAT.IO; use GNAT.IO;
38
39 -- Default last chance handler for use with the full VxWorks 653 partition OS
40 -- Ada run-time library.
41
42 -- Logs error with health monitor, and dumps exception identity and argument
43 -- string for vxaddr2line for generation of a symbolic stack backtrace.
44
45 procedure Ada.Exceptions.Last_Chance_Handler (Except : Exception_Occurrence) is
46
47 ----------------------
48 -- APEX definitions --
49 ----------------------
50
51 pragma Warnings (Off);
52 type Error_Code_Type is (
53 Deadline_Missed,
54 Application_Error,
55 Numeric_Error,
56 Illegal_Request,
57 Stack_Overflow,
58 Memory_Violation,
59 Hardware_Fault,
60 Power_Fail);
61 pragma Warnings (On);
62 pragma Convention (C, Error_Code_Type);
63 -- APEX Health Management error codes
64
65 type Message_Addr_Type is new System.Address;
66
67 type Apex_Integer is range -(2 ** 31) .. (2 ** 31) - 1;
68 pragma Convention (C, Apex_Integer);
69
70 Max_Error_Message_Size : constant := 64;
71
72 type Error_Message_Size_Type is new Apex_Integer range
73 1 .. Max_Error_Message_Size;
74
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
84 pragma Warnings (On);
85 pragma Convention (C, Return_Code_Type);
86 -- APEX return codes
87
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");
94
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
99
100 procedure Adainit;
101 pragma Import (Ada, Adainit, "adainit");
102
103 Adainit_Addr : constant System.Address := Adainit'Code_Address;
104 -- Part of arguments to vxaddr2line
105
106 Result : Return_Code_Type;
107
108 Message : String :=
109 Exception_Name (Except) & ": " & ASCII.LF &
110 Exception_Message (Except) & ASCII.NUL;
111
112 Message_Length : Error_Message_Size_Type;
113
114 begin
115 New_Line;
116 Put_Line ("In last chance handler");
117 Put_Line (Message (1 .. Message'Length - 1));
118 New_Line;
119
120 Put_Line ("adainit and traceback addresses for vxaddr2line:");
121
122 Put (Image_C (Adainit_Addr)); Put (" ");
123
124 for J in 1 .. Except.Num_Tracebacks loop
125 Put (Image_C (Except.Tracebacks (J)));
126 Put (" ");
127 end loop;
128
129 New_Line;
130
131 if Message'Length > Error_Message_Size_Type'Last then
132 Message_Length := Error_Message_Size_Type'Last;
133 else
134 Message_Length := Message'Length;
135 end if;
136
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);
142
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.
147
148 System.Standard_Library.Adafinal;
149 Unhandled_Terminate;
150 end Ada.Exceptions.Last_Chance_Handler;