Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-elchha.adb @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 -- -- 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 -- 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 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 2003-2017, Free Software Foundation, Inc. -- 9 -- Copyright (C) 2003-2018, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
32 -- Default version for most targets 32 -- Default version for most targets
33 33
34 pragma Compiler_Unit_Warning; 34 pragma Compiler_Unit_Warning;
35 35
36 with System.Standard_Library; use System.Standard_Library; 36 with System.Standard_Library; use System.Standard_Library;
37 with System.Soft_Links; 37 with System.Soft_Links; use System;
38 38
39 procedure Ada.Exceptions.Last_Chance_Handler 39 procedure Ada.Exceptions.Last_Chance_Handler
40 (Except : Exception_Occurrence) 40 (Except : Exception_Occurrence)
41 is 41 is
42 procedure Unhandled_Terminate; 42 procedure Unhandled_Terminate;
64 "__gnat_append_info_u_e_info"); 64 "__gnat_append_info_u_e_info");
65 65
66 procedure To_Stderr (S : String); 66 procedure To_Stderr (S : String);
67 pragma Import (Ada, To_Stderr, "__gnat_to_stderr"); 67 pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
68 -- Little routine to output string to stderr 68 -- Little routine to output string to stderr
69
70 Gnat_Argv : System.Address;
71 pragma Import (C, Gnat_Argv, "gnat_argv");
72
73 procedure Fill_Arg (A : System.Address; Arg_Num : Integer);
74 pragma Import (C, Fill_Arg, "__gnat_fill_arg");
75
76 function Len_Arg (Arg_Num : Integer) return Integer;
77 pragma Import (C, Len_Arg, "__gnat_len_arg");
69 78
70 Ptr : Natural := 0; 79 Ptr : Natural := 0;
71 Nobuf : String (1 .. 0); 80 Nobuf : String (1 .. 0);
72 81
73 Nline : constant String := String'(1 => ASCII.LF); 82 Nline : constant String := String'(1 => ASCII.LF);
129 138
130 -- Traceback exists 139 -- Traceback exists
131 140
132 else 141 else
133 To_Stderr (Nline); 142 To_Stderr (Nline);
134 To_Stderr ("Execution terminated by unhandled exception"); 143
144 if Gnat_Argv = System.Null_Address then
145 To_Stderr ("Execution terminated by unhandled exception");
146 else
147 declare
148 Arg : aliased String (1 .. Len_Arg (0));
149 begin
150 Fill_Arg (Arg'Address, 0);
151 To_Stderr ("Execution of ");
152 To_Stderr (Arg);
153 To_Stderr (" terminated by unhandled exception");
154 end;
155 end if;
156
135 To_Stderr (Nline); 157 To_Stderr (Nline);
136 158
137 Append_Info_Untailored_Exception_Information (Except, Nobuf, Ptr); 159 Append_Info_Untailored_Exception_Information (Except, Nobuf, Ptr);
138 end if; 160 end if;
139 161