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-- 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); 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 37with System.Traceback; 38 39pragma Warnings (On); 40 41separate (Ada.Exceptions) 42procedure 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 49begin 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 74end Call_Chain; 75