#! @PERL@

# file: $isip/util/devel/dmalloc_run/isip_dmalloc_run.pl
#

# load the command_line source
#
require "$ENV{'ISIP'}/lib/scripts/perl/command_line.pm";

$DEF_MODE = "isip_runtime";
$DEF_RC_FILE = "$ENV{ISIP}/login/debugger_gdb_dmallocrc.text";

# define the help function to be called if -help is present on the
# command line. this should print a help file to the screen.
#

$ISIP_HELP_FILE = <<__ISIP_HELP_HERE_FILE__;
name: dmalloc_run
synopsis: isip_dmalloc_run [options] executable
descr: run the executable with dmalloc turned on
example: dmalloc_run String.exe

options:
 -mode: what mode to run dmalloc with (def = isip_runtime, isip_high, etc)
 -static: should we parse away the static memory errors?
 -verbose: print wrapper commands before execution

arguments: executable to run

man page: none

__ISIP_HELP_HERE_FILE__

# parse the command line
#
($mode,$static,$verbose,@exec_str) = command_line(-1,"-mode", 1,"-static",0,
						  "-verbose", 0);

$executable = $exec_str[0];

if (!(-e $executable)) {
    isip_die("you must specify an executable");
}

if ($static eq "") {
    $static = 0;
} else {
    $static = 1;
}

if ($mode eq "") {
    $mode = $DEF_MODE;
}


# create a string that will call isip_dmalloc
#
$com_str = "dmalloc -b -f $DEF_RC_FILE $mode -p print-messages";

if ($static) {
    $com_str = "$com_str -p log-trans";
}

# setup dmalloc
#
open(FP,"$com_str|") or isip_die("cannot run dmalloc");

if ($verbose) {
    print "$com_str\n";
}

while(<FP>) {
    if ($verbose) {
	print;
    }
    if (/DMALLOC_OPTIONS=(.*)$/) {
	$ENV{DMALLOC_OPTIONS} = $1;
    }
}
close(FP);

print "set dmalloc to $ENV{DMALLOC_OPTIONS}\n";

# run the executable
#
$executable = join(' ',@exec_str);
open(FP,"$executable 2>&1 |") or isip_die("cannot run executable");

$state = 0;
$prefix = "";

LINE: while(<FP>) {

    if (!$static) {
	print;
    } else {

	if (/checking heap/) {
	    next LINE;
	}
	if ($state == 0) {

	    if (/^\d+:\s+\d+: \*\*\* alloc: at .*? for (\d+) bytes, got .(0x.*?)\|/) {
#		print "mode = alloc, ptr = $2, size = $1\n";
	    }
	    elsif (/^\d+:\s+\d+: \*\*\* free: at .*? pnt .(0x.*?)\|.*?size (\d+),/) {
#		print "mode = free, ptr = $1, size = $2\n";
	    }
	    elsif (/^(.*?): final user memory space/) {
		print;
		$state = 1;
		$prefix = $1;
	    }
	    else {
		print;
	    }
	} elsif ($state == 1) {
	    
	    if (/^\d+:\s+\d+: \*\*\* alloc: at .*? for (\d+) bytes, got .(0x.*?)\|/) {
		print "$prefix: *** alloc after shutdown, ptr = $2, size = $1 bytes\n";
	    }
	    elsif (/^\d+:\s+\d+: \*\*\* free: at .*? pnt .(0x.*?)\|.*?size (\d+),/) {
		$ptr = $1;
		$size = $2;
		#print "mode = free, ptr = $1, size = $2\n";
		if (defined($UNFREED_HASH{$ptr})) {
		    if ($UNFREED_SIZES{$ptr} eq $size) {
			#printf "$prefix: memory at $ptr ($size bytes) accounted for\n";
			undef $UNFREED_HASH{$ptr};
			undef $UNFREED_SIZES{$ptr};
			undef $UNFREED_RA{$ptr};
		    }
		    else {
			printf "$prefix: *** memory at $ptr size mismatch\n";
		    }
		}
		else {
		    printf "$prefix: *** unregisted memory freed at $ptr\n";
		}
	    }
	    elsif (/ending time/) {
		print;
		print "$prefix: ISIP: performing accounting of static memory\n";
	    } elsif (/not freed: (\'(0x.*?)\|.*?) \((\d+) bytes\) from \'(.*)\'/) {
		$unfreed = $2;
		$size = $3;
		$UNFREED_HASH{$unfreed} = $1;
		$UNFREED_SIZES{$unfreed} = $size;
		$UNFREED_RA{$unfreed} = $4;
		#print "unfreed memory = $unfreed; size = $size\n";
	    }
	    else {
		print;
	    }
	}
    }
}

if ($static) {
    @keys = keys(%UNFREED_HASH);
    $num = 0;
    $bytes = 0;
    
    foreach $key (@keys) {
	$ptr = $UNFREED_HASH{$key};
	if ($ptr ne "") {
	    print "$prefix: ISIP: not freed: $UNFREED_HASH{$key}, ($UNFREED_SIZES{$key} bytes) from $UNFREED_RA{$key}\n";
	    $bytes += $UNFREED_SIZES{$key};
	    $num ++;
	}
    }
    
    if ($num > 0) {
	print "$prefix: ISIP: unknown memory not freed: $num pointers, $bytes bytes\n";
    } else {
	print "$prefix: ISIP: all memory accounted for\n";
    }
}
close(FP);

#
# end of file
