File : s-traceb.adb
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . T R A C E B A C K --
-- --
-- B o d y --
-- (Version for x86) --
-- --
-- $Revision: 1.10 $
-- --
-- Copyright (C) 1999-2000 Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Machine_Code; use System.Machine_Code;
with System.Soft_Links;
-- This is the x86 version of this package. The backtrace is computed directly
-- by analyzing the stack. It is required that the frame pointer be included
-- in the code. The code here will not work if some units are compiled with
-- the -fomit-frame-pointer GCC option.
package body System.Traceback is
Task_Wrapper_Address : Address
renames System.Soft_Links.Task_Wrapper_Address;
-- This code does not handle the stack backtrace for foreign threads ???
-- With a frame pointer, the prolog looks like:
-- pushl %ebp caller's stack address
-- movl %esp,%ebp
-- subl $nnn,%esp omitted if nnn = 0
-- pushl %edi omitted if edi not used
-- pushl %esi omitted if esi not used
-- pushl %ebx omitted if ebx not used
-- A call looks like:
-- pushl ... push parameters
-- pushl ...
-- call ... perform the call
-- addl $nnn,%esp omitted if no parameters
-- So a procedure call under an ix86 architecture push on the stack:
-- -------------------
-- - Proc param n -- the parameters
-- - Proc param n-1 --
-- - ... --
-- 8 - Proc param 1 --
-- 4 - return address --
-- 0 - ebp -- ebp is the caller stack address
-- -------------------
-- All this is sufficient to compute a full backtrace.
type Stack_Pointer is mod 2 ** 32;
type Stack_Pointer_Access is access Stack_Pointer;
subtype Stack_Offset is Stack_Pointer;
function To_Machine_State is
new Ada.Unchecked_Conversion (Stack_Pointer_Access, Machine_State);
function To_Pointer is
new Ada.Unchecked_Conversion (Machine_State, Stack_Pointer_Access);
procedure Main;
pragma Import (C, Main, "main");
-- Import this symbol here just to take it's address.
function Read_Mem (Adr : in Stack_Pointer) return Stack_Pointer;
-- This is a small routine to read a word at a specific address of the
-- process virtual memory. It would have been possible to use the NT
-- ReadProcessMemory but since we have had a problem and we want to get a
-- backtrace, using a NT Win32 API call could be unsafe.
Stop_Traceback_Offset : constant := 50;
-- Number of bytes for the stack traceback end point. The traceback is
-- stoped when we reach an address in the range:
--
-- [Stop_Traceback_Point .. Stop_Traceback_Point + Stop_Traceback_Offset]
--
Stop_Traceback_Thread_Offset : constant := 1000;
-- Number of bytes for the stack traceback end point for a tasking
-- program. The traceback is stopped when we reach an address in the range:
--
-- [Task_Wrapper_Address
-- .. Task_Wrapper_Address + Stop_Traceback_Thread_Offset]
--
-- The number is large because there is some code inlined in the
-- Task_Wrapper procedure. So the call to the thread entry point is far
-- from the start of the Task_Wrapper procedure.
Stop_Traceback_Point : Stack_Pointer;
-- This must be the address of the main entry point. It is used to check
-- if the stack traceback must be stopped. If we reach an address that is
-- Stop_Traceback_Offset bytes from this symbol we stop.
----------------------------
-- Allocate_Machine_State --
----------------------------
function Allocate_Machine_State return Machine_State is
SPA : Stack_Pointer_Access := new Stack_Pointer;
begin
return To_Machine_State (SPA);
end Allocate_Machine_State;
------------------------
-- Free_Machine_State --
------------------------
procedure Free_Machine_State (M : in out Machine_State) is
procedure Free is
new Ada.Unchecked_Deallocation (Stack_Pointer, Stack_Pointer_Access);
SPA : Stack_Pointer_Access := To_Pointer (M);
begin
Free (SPA);
end Free_Machine_State;
--------------
-- Read_Mem --
--------------
function Read_Mem (Adr : in Stack_Pointer) return Stack_Pointer is
Res : Stack_Pointer;
for Res'Address use Address (Adr);
begin
return Res;
end Read_Mem;
------------------
-- Get_Code_Loc --
------------------
function Get_Code_Loc (M : Machine_State) return Code_Loc is
Asm_Call_Size : constant := 2;
-- Minimum size for a call instruction under ix86. Using the minimum
-- size is safe here as the call point computed from the return point
-- will always be inside the call instruction.
SPA : Stack_Pointer_Access := To_Pointer (M);
Cur : Stack_Pointer := SPA.all;
ebp : Stack_Pointer;
Call : Stack_Pointer;
begin
-- First word on the stack is the caller stack's address followed by
-- the return point.
ebp := Read_Mem (Cur);
Cur := Cur + 4;
-- Get the call point by substracting Asm_Call_Size from the return
-- point.
declare
Ret_Point : Stack_Pointer := Read_Mem (Cur);
begin
Call := Ret_Point - Asm_Call_Size;
end;
-- Here we suppose that the call point address is always bigger than
-- the stop points. In fact, Task_Wrapper (pointed to by
-- Task_Wrapper_Address) is defined in the GNAT library and 'main'
-- (pointed to by Stop_Traceback_Point) is defined in the binder code
-- and both symbols are always added before user's code at link stage.
if Call - Stop_Traceback_Point < Stop_Traceback_Offset
or else
(Task_Wrapper_Address /= Null_Address
and then Call - Stack_Pointer (Task_Wrapper_Address)
< Stop_Traceback_Thread_Offset)
then
return Null_Address;
else
return Code_Loc (Call);
end if;
end Get_Code_Loc;
---------------
-- Pop_Frame --
---------------
procedure Pop_Frame (M : Machine_State) is
SPA : Stack_Pointer_Access := To_Pointer (M);
begin
-- go to the caller stack frame. The address of the caller stack is the
-- first word pointed by the machine state (the Stack_Pointer).
SPA.all := Read_Mem (SPA.all);
end Pop_Frame;
-----------------------
-- Set_Machine_State --
-----------------------
procedure Set_Machine_State (M : Machine_State) is
SPA : Stack_Pointer_Access := To_Pointer (M);
begin
-- Retrieve the caller's stack address which is the Call_Chain's one
-- see GNAT.Traceback.
Asm ("movl %%ebp, %0",
Outputs => Stack_Pointer'Asm_Output ("=m", SPA.all));
-- Pop one more frame to get the user's function stack address which
-- has called this procedure.
Pop_Frame (M);
-- Initialize the traceback end regions which is delimited by two
-- functions. Main used for the main thread and Task_Wrapper for a task
-- stack traceback.
Stop_Traceback_Point := Stack_Pointer (Main'Address);
end Set_Machine_State;
end System.Traceback;