tdesdk/scripts/extend_dmalloc

#! /usr/bin/env perl
#
# script to run gdb on return-addresses
# Usage: $0 malloc-log-file binary
#
# Copyright 1995 by Gray Watson
#
# This file is part of the dmalloc package.
#
# Permission to use, copy, modify, and distribute this software for
# any purpose and without fee is hereby granted, provided that the
# above copyright notice and this permission notice appear in all
# copies, and that the name of Gray Watson not be used in advertising
# or publicity pertaining to distribution of the document or software
# without specific, written prior permission.
#
# Gray Watson makes no representations about the suitability of the
# software described herein for any purpose.  It is provided "as is"
# without express or implied warranty.
#
# The author may be contacted at gray.watson@letters.com
#
# $Id$
#

#
# Use this Perl script to run gdb and get information on the return-address
# (ra) addresses from a dmalloc logfile output.  This will search for
# any ra= lines and will examine them and try to get the line number.
#
# NOTE: you may want to direct the output from the script to a file
# else gdb seems to prompt for a return like you are on the end of a
# page.
#
# Be sure to send me mail if there is an easier way to do all this.
#

###############################################################################
# usage message
#
if (@ARGV != 2 ) {
  die "Usage:  $0  dmalloc-log  binary-that-generated-log\n";
}

$malloc = @ARGV[0];
$command = @ARGV[1];

@addresses = ();

open(malloc, $malloc);
while ( <malloc> ) {
  if ($_ =~ m/ra=(0x[0-9a-fA-F]+)/) {
    push(@addresses, $1);
  }
}
close(malloc);
open(SORT, "|sort -u > $malloc.tmp");

foreach $address (@addresses) {
  print SORT "$address\n";
}
close(SORT);

@addresses = ();

open(SORT, "< $malloc.tmp");
while ( <SORT> ) {
  chomp $_;
  push(@addresses, $_);
}
close(SORT);
unlink $malloc.tmp;

open (gdb, "|gdb -nx -q $command > $malloc.tmp") || die "Could not run gdb: $!\n";
$| = 1;

# get rid of the (gdb)
printf (gdb "set prompt\n");
printf (gdb "echo \\n\n");

# load in the shared libraries
printf (gdb "sharedlibrary\n");

# run the program to have _definitly_ the informations 
# we need from the shared libraries. Unfortunatly gdb 4.18's
# version of sharedlibrary does nothing ;(
printf (gdb "b main\n");
printf (gdb "run\n");

foreach $address (@addresses) {

  printf (gdb "echo -----------------------------------------------\\n\n");
  # printf (gdb "echo Address = '%s'\n", $address);
  printf (gdb "x %s\n", $address);
  printf (gdb "info line *(%s)\n", $address);
}
printf (gdb "quit\ny\n");
# $| = 0;

close(gdb);

%lines = ();

open(malloc, "< $malloc.tmp");

$count = 0;
$address = "";
$line = "";

while ( <malloc> ) {

  # ignore our own input
  if ($_ =~ m/^x 0x/ || $_ =~ m/^echo ------/ || $_ =~ m/^info line/) {
    next;
  }

  if ($_ =~ m/^--------/) {
    if ($line) {
      $lines{$address} = "$line";
    }
    $count = 0;
    $address = "";
    $line = "";
  } else {
    $count = $count + 1;
  }
  
  if ($count == 1 && $_ =~ m/(0x[0-9a-fA-F]+)\s*<(.*)>:\s*(\S+)/) {
    $address = $1;
    $line = "$2<$3>";
  }
  
  if ($count == 2 && $_ =~ m/Line ([0-9]+) of \"([^\"]*)\"/) {
    $line = "$2:$1";
  }
  
}

if ($line) {
  $lines{$address} = "$line";
}

close(malloc);

open(malloc, $malloc);

while ( <malloc> ) {
  if ($_ =~ m/ra=(0x[0-9a-fA-F]+)/) {
    $address = $1;
    if (defined($lines{$address})) {
      $_ =~ s/ra=$address/$lines{$address}/;
      print STDOUT $_;
    } else {
      print STDOUT $_;
    }
  } else {
    print STDOUT $_;
  }
}