1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S Y S T E M . T R A C E B A C K -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1999-2015, 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 32-- This is the default version of this package 33 34-- Note: this unit must be compiled using -fno-optimize-sibling-calls. 35-- See comment below in body of Call_Chain for details on the reason. 36 37pragma Compiler_Unit_Warning; 38 39package body System.Traceback is 40 41 procedure Call_Chain 42 (Traceback : System.Address; 43 Max_Len : Natural; 44 Len : out Natural; 45 Exclude_Min : System.Address := System.Null_Address; 46 Exclude_Max : System.Address := System.Null_Address; 47 Skip_Frames : Natural := 1); 48 -- Same as the exported version, but takes Traceback as an Address 49 50 ------------------ 51 -- C_Call_Chain -- 52 ------------------ 53 54 function C_Call_Chain 55 (Traceback : System.Address; 56 Max_Len : Natural) return Natural 57 is 58 Val : Natural; 59 begin 60 Call_Chain (Traceback, Max_Len, Val); 61 return Val; 62 end C_Call_Chain; 63 64 ---------------- 65 -- Call_Chain -- 66 ---------------- 67 68 function Backtrace 69 (Traceback : System.Address; 70 Len : Integer; 71 Exclude_Min : System.Address; 72 Exclude_Max : System.Address; 73 Skip_Frames : Integer) 74 return Integer; 75 pragma Import (C, Backtrace, "__gnat_backtrace"); 76 77 procedure Call_Chain 78 (Traceback : System.Address; 79 Max_Len : Natural; 80 Len : out Natural; 81 Exclude_Min : System.Address := System.Null_Address; 82 Exclude_Max : System.Address := System.Null_Address; 83 Skip_Frames : Natural := 1) 84 is 85 begin 86 -- Note: Backtrace relies on the following call actually creating a 87 -- stack frame. To ensure that this is the case, it is essential to 88 -- compile this unit without sibling call optimization. 89 90 -- We want the underlying engine to skip its own frame plus the 91 -- ones we have been requested to skip ourselves. 92 93 Len := Backtrace (Traceback => Traceback, 94 Len => Max_Len, 95 Exclude_Min => Exclude_Min, 96 Exclude_Max => Exclude_Max, 97 Skip_Frames => Skip_Frames + 1); 98 end Call_Chain; 99 100 procedure Call_Chain 101 (Traceback : in out System.Traceback_Entries.Tracebacks_Array; 102 Max_Len : Natural; 103 Len : out Natural; 104 Exclude_Min : System.Address := System.Null_Address; 105 Exclude_Max : System.Address := System.Null_Address; 106 Skip_Frames : Natural := 1) 107 is 108 begin 109 Call_Chain 110 (Traceback'Address, Max_Len, Len, 111 Exclude_Min, Exclude_Max, 112 113 -- Skip one extra frame to skip the other Call_Chain entry as well 114 115 Skip_Frames => Skip_Frames + 1); 116 end Call_Chain; 117 118end System.Traceback; 119