#!/usr/bin/env perl

# Script to identify mismatched allocations and deallocations,
# from the output of an Octopus run with ProfilingMode = prof_memory
# or prof_memory_full. Pass the output as an argument on the command line.

%alloc   = {};
%dealloc = {};
$alloc_count = 0;
$dealloc_count = 0;

# skip header line
$_=<>;

while($_=<>){
    $_=~s/^\s*//;
    my ($time,$type,$mem,$totmem,$pages,$pos) = split(/\s+/);

    $varname = $pos;
    $varname =~ s/^.*%//;
    $varname =~ s/\([^(]*\.F90\:[0-9]+\)//g;

    if($type eq 'A'){
	$alloc_count++;
	$alloc{$varname}++;
	if($dealloc{$varname} eq "") {
	    $dealloc{$varname} = 0;
	}
    }elsif($type eq 'D'){
	$dealloc_count++;
	$dealloc{$varname}++;
	if($alloc{$varname} eq "") {
	    $alloc{$varname} = 0;
	}
    }
}

print " $alloc_count allocations, $dealloc_count deallocations\n";

print "\n Allocs not deallocated\n"; 
foreach $key (keys %alloc) {
    if($alloc{$key} > $dealloc{$key}){
	print "Variable '$key' allocated ", $alloc{$key},
	" times and deallocated ", $dealloc{$key}, " times\n";
    }
}

print "\n Deallocs not allocated\n"; 
foreach $key (keys %dealloc) {
    if($alloc{$key} < $dealloc{$key}){
	print "Variable '$key' allocated ", $alloc{$key},
	" times and deallocated ", $dealloc{$key}, " times\n";
    }
}
