memprobe.in
#!@perl@
################################################################################
#
# Authors : D.Bertini and M.Ivanov
# Date: 23/10/2000
# Updated: 10/05/2001 D.Bertini, v2.0 port to gdb5.0 + glibc2.2
#
#
# To activate the memory checker you have to set in the .rootrc file
# the resource Root.MemCheck to 1 (e.g.: Root.MemCheck: 1) and you
# have to link with libNew.so (e.g. use root-config --new --libs) or
# use rootn.exe. When all this is the case you will find at the end
# of the program execution a file "memcheck.out" in the directory
# where you started your ROOT program. Alternatively you can set
# the resource Root.MemCheckFile to the name of a file to which
# the leak information will be written. The contents of this
# "memcheck.out" file can be analyzed and transformed into printable
# text via the memprobe program (in $ROOTSYS/bin).
#
################################################################################
if ( ( $#ARGV < 0 )) {
Usage();
}
use Getopt::Std;
getopt "h,e,m,d,f";
#Usage("exec file is mandatory !\n") if ( !($opt_h or $opt_e) );
if ( $opt_h ) { Usage();}
if ( $opt_e ) { $ExeFile=$opt_e;
}else {
if (!$opt_h){ Usage("an exec file must be provided !\n");}
}
if ( $opt_m ) { $MemStatFile=$opt_m;
}else{
$MemStatFile="memcheck.out";
}
if ( $opt_d ) { $MemDescFile=$opt_d;
}else{
$MemDescFile="memcheckdesc.out";
}
if ( $opt_f ) { $MemFiltFile=$opt_f;
}else{
$MemFiltFile="analfilter";
}
sub Usage
{
my ($txt) = @_;
print "MemProbe v2.0 Usage:\n";
print "\t $0 -e exec-file [options] [files] \n ";
print "\t-e \t\t\tname of analyzed program\n";
print "Options: \n";
print "\t-h \t\t\tthis usage help\n";
print "\t-m \t\tname of analyzed program output file\n";
print "\t-d \t\tname of the stat description file\n";
print "\t-f \t\tname of the filter file\n";
print "\nWarning: $txt\n" if $txt;
exit 2;
}
# old version
#$ExeFile = shift @ARGV;
#$MemStatFile = $#ARGV >= 0 ? shift @ARGV : "memcheck.out";
open (MEMSTAT, $MemStatFile) or die "-E- Could not open leaks data file $MemStatFile: $!";
if ($#ARGV >= 0) {
$BreakOn = shift @ARGV;
# Rest in @ARGV are program arguments
}
##############################################################################
# Read filter expression
##############################################################################
open (FILTERFILE, $MemFiltFile);
@FILTER = <FILTERFILE>;
close (FILTERFILE);
for ($j = 0; $j <= $#FILTER; ++$j){
chop $FILTER[$j];
# print $FILTER[$j];
}
##############################################################################
# Find leak adresses
##############################################################################
$n = $u = 0;
$nfull = $ufull = 0;
while (<MEMSTAT>) {
# remove newline
chop $_ ;
if (/\s*(stack:)\s*/) {
$addrfull = $'; #obtain stack info
$_ = $addrfull;
s/(st)//g;
s/(0x)/:0x/g;
@arr = split(/:/); #obtain different leak points
for ($i = 1; $i < $#arr; ++$i){
$addr = $arr[$i];
$u++ if not exists $Size{$addr};
$Size{$addr} += 0;
$n++;
}
}
}
close (MEMSTAT);
##############################################################################
# FIND debug info for addresses - information stored
# in file leak.desc.C
##############################################################################
# redirect standard output to the trash
open (STDERR,">/dev/null");
# Redirect list of commands to a file
# using unix pipes (needed for RH.7.1 & gdb5.0)
open (myFile,">commands");
# Change set listsize 2 to something else to show more lines
print myFile "set prompt\nset listsize 1\nset height 0\nset verbose off\n";
if (defined($BreakOn)) {
print myFile "break $BreakOn\n";
print myFile "run ", join(" ", @ARGV), " \n";
}
else{
print myFile "break main \n ";
print myFile "run ", join(" ", @ARGV), " \n";
}
foreach (sort keys %Size) {
print myFile "l \*$_\n ";
}
if (defined($BreakOn)) {
print myFile "kill\n";
}
close (myFile);
##############################################################################
# Calling now gdb services in batch mode using
# dumped list of commands.
# ==> works with gdb-4.18 gdb-5.0 release versions
##############################################################################
open (PIPE, "| gdb -n -q $ExeFile < commands > $MemDescFile")
or die "-E- Cannot start gdb !!!";
close (PIPE);
##############################################################################
# ASIGN debug info to address
##############################################################################
open (DBGinfo, $MemDescFile) or die "-E- Could not open desc file $MemDescFile: $!";
$addr =0;
while (<DBGinfo>){
# if (/(0x[0-9a-f]+)\s*/){
if (/(^0x[0-9a-f]+)/){
$addr = $1;
#print $addr;
/is in /;
# print $';
# print "\n";
$filename{$addr} =$';
# print "$addr $filename{$addr}\n";
}else{
$line{$addr} = $_ if ! /^\s*l/;
}
for ($j = 0; $j <= $#FILTER; ++$j){
if ( ( $line{$addr} =~ /(${FILTER[$j]})/ ) ||
( $filename{$addr} =~ /(${FILTER[$j]})/ )){
$line{$addr} = "filtered";
}
}
}
close (DBGinfo);
##############################################################################
# FIND unique leak stack sequences
##############################################################################
open (MEMSTAT, $MemStatFile) or die "-E- Could not open leaks data file $MemStatFile: $!";
while (<MEMSTAT>) {
# remove newline
chop $_ ;
if (/\s*(stack:)\s*/) {
$addrfull = $'; #obtain stack info
$info =$`;
$info =~ s/size //; #obtain mem info for given stack sequence
$_ = $addrfull;
s/(st)//g;
s/(0x)/:0x/g;
s/ //g;
@arr = split(/:/); #obtain leak points
$addrfull ="stack";
$FilterOut=0;
for ($i = 1; ($i <= $#arr)&&($FilterOut==0); ++$i){
$addr = $arr[$i];
if ( $line{$addr} =~ /filtered/)
{
$FilterOut=1;
}
if ( $filename{$addr} =~ /\)/)
{
$addrfull .= ":";
$addrfull .= $addr;
}
}
if ($FilterOut==0){
$_= $info;
@meminfo = split(/:/);
$ufull++ if not exists $Sizefull{$addrfull};
$SizeTotal{$addrfull} += $meminfo[1];
$CountTotal{$addrfull}+= $meminfo[0];
$SizeLeak{$addrfull} += $meminfo[3];
$CountLeak{$addrfull}+= $meminfo[2];
$nfull++;
}
}
}
print STDERR "total memory corrupted at point==> ($nfull) \n";
print STDERR "unique allocations ==> ($ufull) \n";
close (MEMSTAT);
##############################################################################
# PRINT output leak information to leak.info.C output file
##############################################################################
open (LEAKinfo,">leak.info");
open (MULTI,">multidelete.info");
open (MEMSTAT,">memcheck.info");
# sort by size of leak
sub bysize {
$SizeLeak{$b} <=> $SizeLeak{$a}; # presuming integers
}
sub bysizetotal {
$SizeTotal{$b} <=> $SizeTotal{$a}; # presuming integers
}
foreach (sort bysizetotal keys %SizeTotal) {
print MEMSTAT "Count: $CountTotal{$_}($CountLeak{$_}) Size: $SizeTotal{$_}($SizeLeak{$_}) \n";
s/stack://g;
@arr = split(/:/); #obtain leak points
for ($i = 0; $i <= $#arr; ++$i){
$addr = $arr[$i];
print MEMSTAT "$filename{$addr}$line{$addr}";
}
print MEMSTAT "\n\n";
}
foreach (sort bysize keys %SizeLeak) {
if ($CountLeak{$_}<0){
print MULTI "Multiple deallocation :$CountLeak{$_}\n";
s/stack://g;
@arr = split(/:/); #obtain leak points
for ($i = 0; $i <= $#arr; ++$i){
$addr = $arr[$i];
print MULTI "$filename{$addr}$line{$addr}";
}
print MULTI "\n\n";
}
if ($SizeLeak{$_}!=0){
print LEAKinfo "Leaked allocations: $CountLeak{$_} \t Leaked size: $SizeLeak{$_} \n";
s/stack://g;
@arr = split(/:/); #obtain leak points
for ($i = 0; $i <= $#arr; ++$i){
$addr = $arr[$i];
print LEAKinfo "$filename{$addr}$line{$addr}";
}
print LEAKinfo "\n\n";
}
}
close(LEAKinfo);
close(MULTI);
close(MEMSTAT);
$remove = 'rm -rf commands';
exec $remove;
die " -E- no commands file !";