diff options
Diffstat (limited to 'gcc/ada/memtrack.adb')
| -rw-r--r-- | gcc/ada/memtrack.adb | 129 |
1 files changed, 79 insertions, 50 deletions
diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb index f23f76c3eee..30eb2e61ebf 100644 --- a/gcc/ada/memtrack.adb +++ b/gcc/ada/memtrack.adb @@ -4,13 +4,9 @@ -- -- -- S Y S T E M . M E M O R Y -- -- -- --- S p e c -- +-- B o d y -- -- -- --- Copyright (C) 2001 Free Software Foundation, Inc. -- --- -- --- This specification is derived from the Ada Reference Manual for use with -- --- GNAT. The copyright notice above, and the license provisions that follow -- --- apply solely to the contents of the part following the private keyword. -- +-- Copyright (C) 2001-2003 Free Software Foundation, 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- -- @@ -36,30 +32,33 @@ ------------------------------------------------------------------------------ -- This version contains allocation tracking capability. + -- The object file corresponding to this instrumented version is to be found -- in libgmem. + -- When enabled, the subsystem logs all the calls to __gnat_malloc and -- __gnat_free. This log can then be processed by gnatmem to detect -- dynamic memory leaks. --- + -- To use this functionality, you must compile your application with -g -- and then link with this object file: --- + -- gnatmake -g program -largs -lgmem --- + -- After compilation, you may use your program as usual except that upon -- completion, it will generate in the current directory the file gmem.out. --- + -- You can then investigate for possible memory leaks and mismatch by calling -- gnatmem with this file as an input: --- + -- gnatmem -i gmem.out program --- + -- See gnatmem section in the GNAT User's Guide for more details. --- + -- NOTE: This capability is currently supported on the following targets: --- + -- Windows +-- AIX -- GNU/Linux -- HP-UX -- Irix @@ -71,12 +70,14 @@ pragma Source_File_Name (System.Memory, Body_File_Name => "memtrack.adb"); with Ada.Exceptions; with System.Soft_Links; with System.Traceback; +with System.Traceback_Entries; package body System.Memory is use Ada.Exceptions; use System.Soft_Links; use System.Traceback; + use System.Traceback_Entries; function c_malloc (Size : size_t) return System.Address; pragma Import (C, c_malloc, "malloc"); @@ -122,13 +123,8 @@ package body System.Memory is Max_Call_Stack : constant := 200; -- Maximum number of frames supported - Skip_Frame : constant := 1; - -- Number of frames to remove from the call stack to hide functions from - -- this unit. - - Tracebk : aliased array (0 .. Max_Call_Stack) of System.Address; + Tracebk : aliased array (0 .. Max_Call_Stack) of Traceback_Entry; Num_Calls : aliased Integer := 0; - -- Store the current call stack from Alloc and Free Gmemfname : constant String := "gmem.out" & ASCII.NUL; -- Allocation log of a program is saved in a file gmem.out @@ -143,6 +139,11 @@ package body System.Memory is -- header string is used as a magic-tag to know if the .out file is to be -- handled by GDB or by the GMEM (instrumented malloc/free) implementation. + First_Call : Boolean := True; + -- Depending on implementation, some of the traceback routines may + -- themselves do dynamic allocation. We use First_Call flag to avoid + -- infinite recursion + ----------- -- Alloc -- ----------- @@ -169,21 +170,35 @@ package body System.Memory is Result := c_malloc (Actual_Size); - -- Logs allocation call - -- format is: - -- 'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn> - - Gmem_Initialize; - Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls); - Num_Calls := Num_Calls - Skip_Frame; - fputc (Character'Pos ('A'), Gmemfile); - fwrite (Result'Address, Address_Size, 1, Gmemfile); - fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Tracebk (Skip_Frame)'Address, Address_Size, size_t (Num_Calls), - Gmemfile); + if First_Call then + + -- Logs allocation call + -- format is: + -- 'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn> + + First_Call := False; + + Gmem_Initialize; + Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls, + Skip_Frames => 2); + fputc (Character'Pos ('A'), Gmemfile); + fwrite (Result'Address, Address_Size, 1, Gmemfile); + fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements, 1, + Gmemfile); + fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, + Gmemfile); + + for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop + declare + Ptr : System.Address := PC_For (Tracebk (J)); + begin + fwrite (Ptr'Address, Address_Size, 1, Gmemfile); + end; + end loop; + + First_Call := True; + + end if; Unlock_Task.all; @@ -217,21 +232,35 @@ package body System.Memory is begin Lock_Task.all; - -- Logs deallocation call - -- format is: - -- 'D' <mem addr> <len backtrace> <addr1> ... <addrn> - - Gmem_Initialize; - Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls); - Num_Calls := Num_Calls - Skip_Frame; - fputc (Character'Pos ('D'), Gmemfile); - fwrite (Addr'Address, Address_Size, 1, Gmemfile); - fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Tracebk (Skip_Frame)'Address, Address_Size, size_t (Num_Calls), - Gmemfile); - - c_free (Ptr); + if First_Call then + + -- Logs deallocation call + -- format is: + -- 'D' <mem addr> <len backtrace> <addr1> ... <addrn> + + First_Call := False; + + Gmem_Initialize; + Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls, + Skip_Frames => 2); + fputc (Character'Pos ('D'), Gmemfile); + fwrite (Addr'Address, Address_Size, 1, Gmemfile); + fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, + Gmemfile); + + for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop + declare + Ptr : System.Address := PC_For (Tracebk (J)); + begin + fwrite (Ptr'Address, Address_Size, 1, Gmemfile); + end; + end loop; + + c_free (Ptr); + + First_Call := True; + + end if; Unlock_Task.all; end Free; |