OS/2 Shareware BBS: 10 Tools

home *** CD-ROM | disk | FTP | other *** search

/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnatlib / s-traceb.adb < prev next >

Wrap

Text File | 2000-07-19 | 10KB | 250 lines

------------------------------------------------------------------------------ -- -- -- 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;