Warning, /sdk/kde-dev-scripts/extend_dmalloc is written in an unsupported language. File is not indexed.

 #! /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 information
 # we need from the shared libraries. Unfortunately 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 $_;
   }
 }