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-2018, 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-- 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. -- 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 32pragma Warnings (Off); 33with System.Standard_Library; 34pragma Warnings (On); 35 36with GNAT.Debug_Utilities; use GNAT.Debug_Utilities; 37with 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 45procedure 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 114begin 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; 150end Ada.Exceptions.Last_Chance_Handler; 151