1 files changed, 159 insertions, 0 deletions
diff --git a/scripts/extend_dmalloc b/scripts/extend_dmalloc
new file mode 100755
index 00000000..53bd7491
--- /dev/null
+++ b/scripts/extend_dmalloc
@@ -0,0 +1,159 @@
+#! /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 [email protected]
+#
+# $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 $_;
+  }
+}