Skip to content

R
riscv-gcc-1
Commit 8cc39ff2 by Vasiliy Fofanov Committed by Arnaud Charlet
Options

gmem.c: Add support for timestamps on memory operations. 

2007-04-20  Vasiliy Fofanov  <fofanov@adacore.com>

	* 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
parent 9fd79385
Showing with 227 additions and 74 deletions
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 <stdio.h>
......@@ -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");
......
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 :");
......
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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment