From: Vasiliy Fofanov Date: Wed, 6 Jun 2007 10:30:04 +0000 (+0200) Subject: gmem.c: Add support for timestamps on memory operations. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8cc39ff26bdd6d6b5dc8bc62b5db504f22e50a1b;p=gcc.git gmem.c: Add support for timestamps on memory operations. 2007-04-20 Vasiliy Fofanov * gmem.c: Add support for timestamps on memory operations. * memtrack.adb, gnatmem.adb: Add support for timestamps on memory operations (not used currently, just foundation for future enhancements). Add possibility to perform full dump of gmem.out file. (Print_Back_Traces): Declare accesses to root arrays constants since they aren't modified. (Print_Back_Traces): allocate root arrays on the heap rather than stack. From-SVN: r125419 --- diff --git a/gcc/ada/gmem.c b/gcc/ada/gmem.c index e45e12c000d..508d18d7cd6 100644 --- a/gcc/ada/gmem.c +++ b/gcc/ada/gmem.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2000-2006, Free Software Foundation, Inc. * + * Copyright (C) 2000-2007, 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- * @@ -31,7 +31,7 @@ ****************************************************************************/ /* This unit reads the allocation tracking log produced by augmented - __gnat_malloc and __gnat_free procedures (see file a-raise.c) and + __gnat_malloc and __gnat_free procedures (see file memtrack.adb) and provides GNATMEM tool with gdb-compliant output. The output is processed by GNATMEM to detect dynamic memory allocation errors. @@ -43,9 +43,11 @@ GNU/Linux x86 Solaris (sparc and x86) (*) Windows 98/95/NT (x86) + Alpha OpenVMS (*) on these targets, the compilation must be done with -funwind-tables to be able to build the stack backtrace. + */ #include @@ -65,6 +67,7 @@ struct struct_storage_elmt { char Elmt; void * Address; size_t Size; + long long Timestamp; }; static void @@ -108,14 +111,15 @@ gmem_read_backtrace (void) cur_tb_pos = 0; } -/* initialize gmem feature from the dumpname file. It returns 1 if the - dumpname has been generated by GMEM (instrumented malloc/free) and 0 if not - (i.e. probably a GDB generated file). +/* initialize gmem feature from the dumpname file. It returns t0 timestamp + if the dumpname has been generated by GMEM (instrumented malloc/free) + and 0 if not. */ -int __gnat_gmem_initialize (char *dumpname) +long long __gnat_gmem_initialize (char *dumpname) { char header [10]; + long long t0; gmemfile = fopen (dumpname, "rb"); fread (header, 10, 1, gmemfile); @@ -127,7 +131,9 @@ int __gnat_gmem_initialize (char *dumpname) return 0; } - return 1; + fread (&t0, sizeof (long long), 1, gmemfile); + + return t0; } /* initialize addr2line library */ @@ -163,10 +169,12 @@ __gnat_gmem_read_next (struct struct_storage_elmt *buf) buf->Elmt = LOG_ALLOC; fread (&(buf->Address), sizeof (void *), 1, gmemfile); fread (&(buf->Size), sizeof (size_t), 1, gmemfile); + fread (&(buf->Timestamp), sizeof (long long), 1, gmemfile); break; case 'D' : buf->Elmt = LOG_DEALL; fread (&(buf->Address), sizeof (void *), 1, gmemfile); + fread (&(buf->Timestamp), sizeof (long long), 1, gmemfile); break; default: puts ("GNATMEM dump file corrupt"); diff --git a/gcc/ada/gnatmem.adb b/gcc/ada/gnatmem.adb index d52fe005f34..b5c092f30da 100644 --- a/gcc/ada/gnatmem.adb +++ b/gcc/ada/gnatmem.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2005, AdaCore -- +-- Copyright (C) 1997-2007, AdaCore -- -- -- -- 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- -- @@ -53,24 +53,25 @@ -- execution generating memory allocation where data is collected (such as -- number of allocations, amount of memory allocated, high water mark, etc.) -with Gnatvsn; use Gnatvsn; - -with Ada.Text_IO; use Ada.Text_IO; with Ada.Float_Text_IO; with Ada.Integer_Text_IO; +with Ada.Text_IO; use Ada.Text_IO; + +with System; use System; +with System.Storage_Elements; use System.Storage_Elements; with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Heap_Sort_G; with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.HTable; use GNAT.HTable; -with System; use System; -with System.Storage_Elements; use System.Storage_Elements; - +with Gnatvsn; use Gnatvsn; with Memroot; use Memroot; procedure Gnatmem is + package Int_IO renames Ada.Integer_Text_IO; + ------------------------ -- Other Declarations -- ------------------------ @@ -80,13 +81,24 @@ procedure Gnatmem is -- * = End of log file -- A = found a ALLOC mark in the log -- D = found a DEALL mark in the log + Address : Integer_Address; Size : Storage_Count; + Timestamp : Duration; end record; - -- This needs a comment ??? + -- This type is used to read heap operations from the log file. + -- Elmt contains the type of the operation, which can be either + -- allocation, deallocation, or a special mark indicating the + -- end of the log file. Address is used to store address on the + -- heap where a chunk was allocated/deallocated, size is only + -- for A event and contains size of the allocation, and Timestamp + -- is the clock value at the moment of allocation + + Log_Name : String_Access; + -- Holds the name of the heap operations log file - Log_Name, Program_Name : String_Access; - -- These need comments, and should be on separate lines ??? + Program_Name : String_Access; + -- Holds the name of the user executable function Read_Next return Storage_Elmt; -- Reads next dynamic storage operation from the log file @@ -133,18 +145,37 @@ procedure Gnatmem is BT_Depth : Integer := 1; - -- The following need comments ??? + -- Some global statistics + + Global_Alloc_Size : Storage_Count := 0; + -- Total number of bytes allocated during the lifetime of a program + + Global_High_Water_Mark : Storage_Count := 0; + -- Largest amount of storage ever in use during the lifetime - Global_Alloc_Size : Storage_Count := 0; - Global_High_Water_Mark : Storage_Count := 0; - Global_Nb_Alloc : Integer := 0; - Global_Nb_Dealloc : Integer := 0; - Nb_Root : Integer := 0; - Nb_Wrong_Deall : Integer := 0; - Minimum_NB_Leaks : Integer := 1; + Global_Nb_Alloc : Integer := 0; + -- Total number of allocations - Tmp_Alloc : Allocation; - Quiet_Mode : Boolean := False; + Global_Nb_Dealloc : Integer := 0; + -- Total number of deallocations + + Nb_Root : Integer := 0; + -- Total number of allocation roots + + Nb_Wrong_Deall : Integer := 0; + -- Total number of wrong deallocations (i.e. without matching alloc) + + Minimum_Nb_Leaks : Integer := 1; + -- How many unfreed allocs should be in a root for it to count as leak + + T0 : Duration := 0.0; + -- The moment at which memory allocation routines initialized (should + -- be pretty close to the moment the program started since there are + -- always some allocations at RTL elaboration + + Tmp_Alloc : Allocation; + Dump_Log_Mode : Boolean := False; + Quiet_Mode : Boolean := False; ------------------------------ -- Allocation Roots Sorting -- @@ -160,16 +191,25 @@ procedure Gnatmem is -- GMEM functionality binding -- -------------------------------- + --------------------- + -- Gmem_Initialize -- + --------------------- + function Gmem_Initialize (Dumpname : String) return Boolean is - function Initialize (Dumpname : System.Address) return Boolean; + function Initialize (Dumpname : System.Address) return Duration; pragma Import (C, Initialize, "__gnat_gmem_initialize"); S : aliased String := Dumpname & ASCII.NUL; begin - return Initialize (S'Address); + T0 := Initialize (S'Address); + return T0 > 0.0; end Gmem_Initialize; + ------------------------- + -- Gmem_A2l_Initialize -- + ------------------------- + procedure Gmem_A2l_Initialize (Exename : String) is procedure A2l_Initialize (Exename : System.Address); pragma Import (C, A2l_Initialize, "__gnat_gmem_a2l_initialize"); @@ -180,6 +220,10 @@ procedure Gnatmem is A2l_Initialize (S'Address); end Gmem_A2l_Initialize; + --------------- + -- Read_Next -- + --------------- + function Read_Next return Storage_Elmt is procedure Read_Next (buf : System.Address); pragma Import (C, Read_Next, "__gnat_gmem_read_next"); @@ -205,9 +249,9 @@ procedure Gnatmem is --------------- function Mem_Image (X : Storage_Count) return String is - Ks : constant Storage_Count := X / 1024; - Megs : constant Storage_Count := Ks / 1024; - Buff : String (1 .. 7); + Ks : constant Storage_Count := X / 1024; + Megs : constant Storage_Count := Ks / 1024; + Buff : String (1 .. 7); begin if Megs /= 0 then @@ -233,7 +277,7 @@ procedure Gnatmem is New_Line; Put ("GNATMEM "); Put_Line (Gnat_Version_String); - Put_Line ("Copyright 1997-2005, Free Software Foundation, Inc."); + Put_Line ("Copyright 1997-2007, Free Software Foundation, Inc."); New_Line; Put_Line ("Usage: gnatmem switches [depth] exename"); @@ -263,7 +307,7 @@ procedure Gnatmem is -- Parse the options first loop - case Getopt ("b: m: i: q s:") is + case Getopt ("b: dd m: i: q s:") is when ASCII.Nul => exit; when 'b' => @@ -274,9 +318,12 @@ procedure Gnatmem is Usage; end; + when 'd' => + Dump_Log_Mode := True; + when 'm' => begin - Minimum_NB_Leaks := Natural'Value (Parameter); + Minimum_Nb_Leaks := Natural'Value (Parameter); exception when Constraint_Error => Usage; @@ -291,7 +338,6 @@ procedure Gnatmem is when 's' => declare S : constant String (Sort_Order'Range) := Parameter; - begin for J in Sort_Order'Range loop if S (J) = 'n' or else @@ -399,13 +445,36 @@ procedure Gnatmem is Usage; end Process_Arguments; + -- Local variables + Cur_Elmt : Storage_Elmt; + Buff : String (1 .. 16); -- Start of processing for Gnatmem begin Process_Arguments; + if Dump_Log_Mode then + Put_Line ("Full dump of dynamic memory operations history"); + Put_Line ("----------------------------------------------"); + + declare + function CTime (Clock : Address) return Address; + pragma Import (C, CTime, "ctime"); + + Int_T0 : Integer := Integer (T0); + CTime_Addr : constant Address := CTime (Int_T0'Address); + + Buffer : String (1 .. 30); + for Buffer'Address use CTime_Addr; + + begin + Put_Line ("Log started at T0 =" & Duration'Image (T0) & " (" + & Buffer (1 .. 24) & ")"); + end; + end if; + -- Main loop analysing the data generated by the instrumented routines. -- For each allocation, the backtrace is kept and stored in a htable -- whose entry is the address. For each deallocation, we look for the @@ -420,10 +489,11 @@ begin when 'A' => - -- Update global counters if the allocated size is meaningful + -- Read the corresponding back trace + + Tmp_Alloc.Root := Read_BT (BT_Depth); if Quiet_Mode then - Tmp_Alloc.Root := Read_BT (BT_Depth); if Nb_Alloc (Tmp_Alloc.Root) = 0 then Nb_Root := Nb_Root + 1; @@ -434,6 +504,8 @@ begin elsif Cur_Elmt.Size > 0 then + -- Update global counters if the allocated size is meaningful + Global_Alloc_Size := Global_Alloc_Size + Cur_Elmt.Size; Global_Nb_Alloc := Global_Nb_Alloc + 1; @@ -441,10 +513,6 @@ begin Global_High_Water_Mark := Global_Alloc_Size; end if; - -- Read the corresponding back trace - - Tmp_Alloc.Root := Read_BT (BT_Depth); - -- Update the number of allocation root if this is a new one if Nb_Alloc (Tmp_Alloc.Root) = 0 then @@ -470,10 +538,6 @@ begin Tmp_Alloc.Size := Cur_Elmt.Size; Address_HTable.Set (Cur_Elmt.Address, Tmp_Alloc); - -- non meaningful output, just consumes the backtrace - - else - Tmp_Alloc.Root := Read_BT (BT_Depth); end if; when 'D' => @@ -485,7 +549,7 @@ begin if Tmp_Alloc.Root = No_Root_Id then -- There was no prior allocation at this address, something is - -- very wrong. Mark this allocation root as problematic + -- very wrong. Mark this allocation root as problematic. Tmp_Alloc.Root := Read_BT (BT_Depth); @@ -512,14 +576,14 @@ begin Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) - 1); - -- update the number of allocation root if this one disappear + -- Update the number of allocation root if this one disappears if Nb_Alloc (Tmp_Alloc.Root) = 0 - and then Minimum_NB_Leaks > 0 then + and then Minimum_Nb_Leaks > 0 then Nb_Root := Nb_Root - 1; end if; - -- De-associate the deallocated address + -- Deassociate the deallocated address Address_HTable.Remove (Cur_Elmt.Address); end if; @@ -527,6 +591,30 @@ begin when others => raise Program_Error; end case; + + if Dump_Log_Mode then + case Cur_Elmt.Elmt is + when 'A' => + Put ("ALLOC"); + Int_IO.Put (Buff (1 .. 16), Integer (Cur_Elmt.Address), 16); + Put (Buff); + Int_IO.Put (Buff (1 .. 8), Integer (Cur_Elmt.Size)); + Put (Buff (1 .. 8) & " bytes at moment T0 +"); + Put_Line (Duration'Image (Cur_Elmt.Timestamp - T0)); + + when 'D' => + Put ("DEALL"); + Int_IO.Put (Buff (1 .. 16), Integer (Cur_Elmt.Address), 16); + Put (Buff); + Put_Line (" at moment T0 +" + & Duration'Image (Cur_Elmt.Timestamp - T0)); + when others => + raise Program_Error; + end case; + + Print_BT (Tmp_Alloc.Root); + end if; + end loop Main; -- Print out general information about overall allocation @@ -551,33 +639,51 @@ begin end if; -- Print out the back traces corresponding to potential leaks in order - -- greatest number of non-deallocated allocations + -- greatest number of non-deallocated allocations. Print_Back_Traces : declare type Root_Array is array (Natural range <>) of Root_Id; - Leaks : Root_Array (0 .. Nb_Root); + type Access_Root_Array is access Root_Array; + + Leaks : constant Access_Root_Array := + new Root_Array (0 .. Nb_Root); Leak_Index : Natural := 0; - Bogus_Dealls : Root_Array (1 .. Nb_Wrong_Deall); + Bogus_Dealls : constant Access_Root_Array := + new Root_Array (1 .. Nb_Wrong_Deall); Deall_Index : Natural := 0; Nb_Alloc_J : Natural := 0; procedure Move (From : Natural; To : Natural); - function Lt (Op1, Op2 : Natural) return Boolean; - package Root_Sort is new GNAT.Heap_Sort_G (Move, Lt); + function Lt (Op1, Op2 : Natural) return Boolean; + package Root_Sort is new GNAT.Heap_Sort_G (Move, Lt); + + ---------- + -- Move -- + ---------- procedure Move (From : Natural; To : Natural) is begin Leaks (To) := Leaks (From); end Move; + -------- + -- Lt -- + -------- + function Lt (Op1, Op2 : Natural) return Boolean is + function Apply_Sort_Criterion (S : Character) return Integer; -- Applies a specific sort criterion; returns -1, 0 or 1 if Op1 is - -- smaller than, equal, or greater than Op2 according to criterion + -- smaller than, equal, or greater than Op2 according to criterion. + + -------------------------- + -- Apply_Sort_Criterion -- + -------------------------- function Apply_Sort_Criterion (S : Character) return Integer is LOp1, LOp2 : Integer; + begin case S is when 'n' => @@ -603,11 +709,14 @@ begin else return 0; end if; + exception when Constraint_Error => return 0; end Apply_Sort_Criterion; + -- Local Variables + Result : Integer; -- Start of processing for Lt @@ -627,12 +736,11 @@ begin -- Start of processing for Print_Back_Traces begin - -- Transfer all the relevant Roots in the Leaks and a - -- Bogus_Deall arrays + -- Transfer all the relevant Roots in the Leaks and a Bogus_Deall arrays Tmp_Alloc.Root := Get_First; while Tmp_Alloc.Root /= No_Root_Id loop - if Nb_Alloc (Tmp_Alloc.Root) = 0 and then Minimum_NB_Leaks > 0 then + if Nb_Alloc (Tmp_Alloc.Root) = 0 and then Minimum_Nb_Leaks > 0 then null; elsif Nb_Alloc (Tmp_Alloc.Root) < 0 then @@ -663,15 +771,16 @@ begin -- Print out all allocation Leaks - if Nb_Root > 0 then + if Leak_Index > 0 then -- Sort the Leaks so that potentially important leaks appear first - Root_Sort.Sort (Nb_Root); + Root_Sort.Sort (Leak_Index); - for J in 1 .. Leaks'Last loop + for J in 1 .. Leak_Index loop Nb_Alloc_J := Nb_Alloc (Leaks (J)); - if Nb_Alloc_J >= Minimum_NB_Leaks then + + if Nb_Alloc_J >= Minimum_Nb_Leaks then if Quiet_Mode then if Nb_Alloc_J = 1 then Put_Line (" 1 leak at :"); diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb index ce613950ba9..ad5c900a8ab 100644 --- a/gcc/ada/memtrack.adb +++ b/gcc/ada/memtrack.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2007, 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- -- @@ -64,6 +64,12 @@ -- Irix -- Solaris -- Tru64 +-- Alpha OpenVMS + +-- NOTE FOR FUTURE PLATFORMS SUPPORT: It is assumed that type Duration is +-- 64 bit. If the need arises to support architectures where this assumption +-- is incorrect, it will require changing the way timestamps of allocation +-- events are recorded. pragma Source_File_Name (System.Memory, Body_File_Name => "memtrack.adb"); @@ -72,6 +78,7 @@ with System.Soft_Links; with System.Traceback; with System.Traceback_Entries; with GNAT.IO; +with System.OS_Primitives; package body System.Memory is @@ -140,6 +147,9 @@ package body System.Memory is Gmemfile : File_Ptr; -- Global C file pointer to the allocation log + Needs_Init : Boolean := True; + -- Reset after first call to Gmem_Initialize + procedure Gmem_Initialize; -- Initialization routine; opens the file and writes a header string. This -- header string is used as a magic-tag to know if the .out file is to be @@ -157,6 +167,7 @@ package body System.Memory is function Alloc (Size : size_t) return System.Address is Result : aliased System.Address; Actual_Size : aliased size_t := Size; + Timestamp : aliased Duration; begin if Size = size_t'Last then @@ -184,13 +195,19 @@ package body System.Memory is First_Call := False; - Gmem_Initialize; + if Needs_Init then + Gmem_Initialize; + end if; + + Timestamp := System.OS_Primitives.Clock; 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 (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, + Gmemfile); fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, Gmemfile); @@ -219,9 +236,6 @@ package body System.Memory is -- Finalize -- -------------- - Needs_Init : Boolean := True; - -- Reset after first call to Gmem_Initialize - procedure Finalize is begin if not Needs_Init then @@ -234,7 +248,8 @@ package body System.Memory is ---------- procedure Free (Ptr : System.Address) is - Addr : aliased constant System.Address := Ptr; + Addr : aliased constant System.Address := Ptr; + Timestamp : aliased Duration; begin Lock_Task.all; @@ -247,11 +262,17 @@ package body System.Memory is First_Call := False; - Gmem_Initialize; + if Needs_Init then + Gmem_Initialize; + end if; + Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls, Skip_Frames => 2); + Timestamp := System.OS_Primitives.Clock; fputc (Character'Pos ('D'), Gmemfile); fwrite (Addr'Address, Address_Size, 1, Gmemfile); + fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, + Gmemfile); fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, Gmemfile); @@ -276,9 +297,13 @@ package body System.Memory is --------------------- procedure Gmem_Initialize is + Timestamp : aliased Duration; + begin if Needs_Init then Needs_Init := False; + System.OS_Primitives.Initialize; + Timestamp := System.OS_Primitives.Clock; Gmemfile := fopen (Gmemfname, "wb" & ASCII.NUL); if Gmemfile = System.Null_Address then @@ -287,6 +312,8 @@ package body System.Memory is end if; fwrite ("GMEM DUMP" & ASCII.LF, 10, 1, Gmemfile); + fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, + Gmemfile); end if; end Gmem_Initialize; @@ -295,10 +322,12 @@ package body System.Memory is ------------- function Realloc - (Ptr : System.Address; Size : size_t) return System.Address + (Ptr : System.Address; + Size : size_t) return System.Address is - Addr : aliased constant System.Address := Ptr; - Result : aliased System.Address; + Addr : aliased constant System.Address := Ptr; + Result : aliased System.Address; + Timestamp : aliased Duration; begin -- For the purposes of allocations logging, we treat realloc as a free @@ -317,11 +346,16 @@ package body System.Memory is -- We first log deallocation call - Gmem_Initialize; + if Needs_Init then + Gmem_Initialize; + end if; Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls, Skip_Frames => 2); + Timestamp := System.OS_Primitives.Clock; fputc (Character'Pos ('D'), Gmemfile); fwrite (Addr'Address, Address_Size, 1, Gmemfile); + fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, + Gmemfile); fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, Gmemfile); @@ -343,6 +377,8 @@ package body System.Memory is fwrite (Result'Address, Address_Size, 1, Gmemfile); fwrite (Size'Address, size_t'Max_Size_In_Storage_Elements, 1, Gmemfile); + fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, + Gmemfile); fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, Gmemfile);