#!/usr/bin/perl

sub alloc {
    my $addr = shift;
    my $file = shift;
    my $line = shift;

    if ( $arena{$addr} ) {
        ($ofile,$oline) = @{$arena{$addr}};
        print( "duplicate allocation $addr at $file $line\n  allocated at $ofile $oline\n" );
    }
    if ( $freed{$addr} ) {
	delete $freed{$addr};
    }
    $arena{$addr} = [$file,$line];
}

sub free {
    my $addr = shift;
    my $file = shift;
    my $line = shift;
    
    if ( $arena{$addr} ) {
        $freed{$addr} = [$arena{$addr}->[0], $arena{$addr}->[1], $file, $line];
        delete $arena{$addr};
    }
    else {
        if ($freed{$addr}) {
            ($afile,$aline,$ffile,$fline) = @{$freed{$addr}};
            print( "double free $addr at $file $line\n  allocated at $afile $aline\n  last freed at $ffile $fline\n" );
        }
        else {
            print( "freeing unallocated $addr at $file $line\n" );
        }
    }
}

sub unfreed {
    for $addr (keys %arena) {
        ($file,$line)=@{$arena{$addr}};
        print( "unfreed $addr allocated at $file $line\n" );
    }
    undef %arena;
    undef %freed;
}

open(FILE, "</tmp/gpsbabel.debug");

while (<FILE>) {
    chomp; 
    @args = split(', ',$_);
    if ($args[0] eq 'malloc') {
        &alloc($args[1], $args[3], $args[4]);
    }
    if ($args[0] eq 'calloc') {
        &alloc($args[1], $args[4], $args[5]);
    }
    if ($args[0] eq 'strdup') {
        &alloc($args[1], $args[3], $args[4]);
    }
    if ($args[0] eq 'realloc') {
        &free($args[2], $args[4], $args[5]);
        &alloc($args[1], $args[4], $args[5]);
    }
    if ($args[0] eq 'free') {
        &free($args[1], $args[2], $args[3]);
    }
    if ($args[0] =~ m/^command/) {
        &unfreed;
        print "$args[0]\n";
    }
}
&unfreed;
close(FILE);
