File : a-excach.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- A D A . E X C E P T I O N S . C A L L _ C H A I N --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2014, 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 -- Allow withing of non-Preelaborated units in Ada 2005 mode where this
34 -- package will be categorized as Preelaborate. See AI-362 for details.
35 -- It is safe in the context of the run-time to violate the rules.
36
37 with System.Traceback;
38
39 pragma Warnings (On);
40
41 separate (Ada.Exceptions)
42 procedure Call_Chain (Excep : EOA) is
43
44 Exception_Tracebacks : Integer;
45 pragma Import (C, Exception_Tracebacks, "__gl_exception_tracebacks");
46 -- Boolean indicating whether tracebacks should be stored in exception
47 -- occurrences.
48
49 begin
50 if Exception_Tracebacks /= 0 and Excep.Num_Tracebacks = 0 then
51
52 -- If Exception_Tracebacks = 0 then the program was not
53 -- compiled for storing tracebacks in exception occurrences
54 -- (-bargs -E switch) so that we do not generate them.
55 --
56 -- If Excep.Num_Tracebacks /= 0 then this is a reraise, no need
57 -- to store a new (wrong) chain.
58
59 -- We ask System.Traceback.Call_Chain to skip 3 frames to ensure that
60 -- itself, ourselves and our caller are not part of the result. Our
61 -- caller is always an exception propagation actor that we don't want
62 -- to see, and it may be part of a separate subunit which pulls it
63 -- outside the AAA/ZZZ range.
64
65 System.Traceback.Call_Chain
66 (Traceback => Excep.Tracebacks,
67 Max_Len => Max_Tracebacks,
68 Len => Excep.Num_Tracebacks,
69 Exclude_Min => Code_Address_For_AAA,
70 Exclude_Max => Code_Address_For_ZZZ,
71 Skip_Frames => 3);
72 end if;
73
74 end Call_Chain;