#!/perl -w
# NAME: shwmemdbg.pl
# AIM: VERY SPECIFIC - read a _DEBUG memory dump file, and order the block in SIZE
# 10/10/2009 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $outfile = "temp.$pgmname.txt";
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );

my $in_file = 'C:\FG\27\Atlas\build\msvc\tempmemdbg.txt';
my $line_by_line = 1;

my $total_allocs = 0;
my $min_alloc = 0;
my $max_alloc = 0;
my $total_bytes = 0;
my $kilo_bytes = 0;

# first lines of file
# 42869784 bytes in 848765 Free Blocks.
# 89113390 bytes in 1047292 Normal Blocks.
# 21290 bytes in 115 CRT Blocks.
# 0 bytes in 0 Ignore Blocks.
# 0 bytes in 0 Client Blocks.
# Largest number used: 92343044 bytes.
# Total allocations: 132021465 bytes.

# expect line pairs, like
#{1895584} normal block at 0x1F012188, 1 bytes long.
# Data: < > 00 
#{1894773} normal block at 0x1EFFF398, 376 bytes long.
# Data: <  5 L~  |7=     > AC 80 35 15 4C 7E CE 15 7C 37 3D 16 C4 F9 C3 14 
# etc
sub process_file($) {
   my ($fil) = @_;
   my ($i, $line, $lnn, $len, $wrap, $clnn);
   my ($max, $min, $mxwrap, $clen, @lines, $lncnt, @inlines);
   $lnn = 0;
   my %hash = ();
   $wrap = 0;
   $max = -1;
   $min = 999999999;
   $mxwrap = 5;
   @lines = ();
   if (open INF, "<$fil") {
      if ($line_by_line) {
         prt( "Processing lines from [$fil]\n");
         while (<INF>) {
            $line = $_;
            $lnn++;
            chomp $line;
            $len = 0;
            if ($line =~ /.+,\s+(\d+)\s+bytes/) {
               $len = $1;
               $total_allocs++;
               $total_bytes += $len;
               $max = $len if ($len > $max);
               $min = $len if ($len < $min);
               $clen = sprintf("%07d",$len);
               if (defined $hash{$clen}) {
                  $hash{$clen}++;
               } else {
                  $clnn = sprintf("%7d",$lnn);
                  prt( "$clnn: $clen " );
                  $hash{$clen} = 1;
                  $wrap++;
                  if ($wrap == $mxwrap) {
                     prt("\n");
                     $wrap = 0;
                  }
               }
            } elsif ($total_allocs == 0) {
               if ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Free\s+Blocks/) {
                  $hash{'header001'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Normal\s+Blocks/) {
                  $hash{'header002'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+CRT\s+Blocks/) {
                  $hash{'header003'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Ignore\s+Blocks/) {
                  $hash{'header004'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Client\s+Blocks/) {
                  $hash{'header005'} = $line;
               } elsif ($line =~ /Largest\s+number\s+used:\s+(\d+)\s+bytes/) {
                  $hash{'header006'} = $line;
               } elsif ($line =~ /Total\s+allocations:\s+(\d+)\s+bytes/) {
                  $hash{'header007'} = $line;
               }
            }
            push(@lines, [$line, $len]);
         }
         prt("\n") if ($wrap);
      } else {
         @inlines = <INF>;
         close INF;
         $lncnt = scalar @inlines;
         prt( "Processing $lncnt lines, from [$fil]\n");
         for ($i = 0; $i < $lncnt; $i++) {
            $lnn++;
            $line = $inlines[$i];
            chomp $line;
            $len = 0;
            if ($line =~ /.+,\s+(\d+)\s+bytes/) {
               $len = $1;
               $total_allocs++;
               $total_bytes += $len;
               $max = $len if ($len > $max);
               $min = $len if ($len < $min);
               $clen = sprintf("%07d",$len);
               if (defined $hash{$clen}) {
                  $hash{$clen}++;
               } else {
                  $clnn = sprintf("%7d",$lnn);
                  prt( "$clnn: $clen " );
                  $hash{$clen} = 1;
                  $wrap++;
                  if ($wrap == $mxwrap) {
                     prt("\n");
                     $wrap = 0;
                  }
               }
            } elsif ($total_allocs == 0) {
               if ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Free\s+Blocks/) {
                  $hash{'header001'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Normal\s+Blocks/) {
                  $hash{'header002'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+CRT\s+Blocks/) {
                  $hash{'header003'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Ignore\s+Blocks/) {
                  $hash{'header004'} = $line;
               } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Client\s+Blocks/) {
                  $hash{'header005'} = $line;
               } elsif ($line =~ /Largest\s+number\s+used:\s+(\d+)\s+bytes/) {
                  $hash{'header006'} = $line;
               } elsif ($line =~ /Total\s+allocations:\s+(\d+)\s+bytes/) {
                  $hash{'header007'} = $line;
               }
            }
            push(@lines, [$line, $len]);
         }
      }
      prt( "Done $lnn lines, from [$fil]\n");
      $min_alloc = $min;
      $max_alloc = $max;
      $kilo_bytes = int($total_bytes / 1024);
      prt("Total allocs = $total_allocs, Range: max=$max_alloc, min=$min_alloc, total bytes $total_bytes ($kilo_bytes KB)\n");
   } else {
      prt( "ERROR: Unable to open file [$fil]\n" );
   }
   $hash{'lines'} = \@lines;
   return \%hash;
}

sub show_ref_hash($) {
   my ($rh) = @_;
   my ($size, $cnt, $line, $cnt2);
   $cnt = scalar keys(%{$rh});
   prt( "List of $cnt different sizes allocated...\n");
   prt( " Size   Count\n" );
   foreach $size (sort keys %{$rh}) {
      if ($size =~ /^\d/) {
         $cnt = ${$rh}{$size};
         prt( "$size $cnt\n" );
      }
   }
   prt("Done size/count list... now headers...\n" );
   foreach $size (sort keys %{$rh}) {
      if ( !(($size =~ /^\d/)||($size eq 'lines')) ) {
         $line = ${$rh}{$size};
         $cnt = '';
         $cnt2 = '';
         if ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Free\s+Blocks/) {
            #$hash{'header001'} = $line;
            $cnt = $1;
            $cnt2 = $2;
         } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Normal\s+Blocks/) {
            #$hash{'header002'} = $line;
            $cnt = $1;
            $cnt2 = $2;
         } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+CRT\s+Blocks/) {
            #$hash{'header003'} = $line;
            $cnt = $1;
            $cnt2 = $2;
         } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Ignore\s+Blocks/) {
            #$hash{'header004'} = $line;
            $cnt = $1;
            $cnt2 = $2;
         } elsif ($line =~ /(\d+)\s+bytes\s+in\s+(\d+)\s+Client\s+Blocks/) {
            #$hash{'header005'} = $line;
            $cnt = $1;
            $cnt2 = $2;
         } elsif ($line =~ /Largest\s+number\s+used:\s+(\d+)\s+bytes/) {
            #$hash{'header006'} = $line;
            $cnt = $1;
            $cnt2 = "";
         } elsif ($line =~ /Total\s+allocations:\s+(\d+)\s+bytes/) {
            #$hash{'header007'} = $line;
            $cnt = $1;
            $cnt2 = "";
         }

         prt( "$line [$cnt $cnt2]\n" );
      }
   }
   prt("Done list...\n" );
}

my $ref_hash = process_file( $in_file );
show_ref_hash($ref_hash);
prt("Total allocs = $total_allocs, Range: max=$max_alloc, min=$min_alloc, total bytes $total_bytes ($kilo_bytes KB)\n");

close_log($outfile,1);
exit(0);

# eof
