-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

=pod

Disclaimer: I'm walking around in the dark here.

I mentioned the other day that I notice Angerwhale leaking memory, so I've
been trying to track down I<what's> leaking so I can fix it. 

The CPAN is generally lacking when it comes to memory leak profiling.
All the modules there are invasive, which means you have to guess
where the leak is, and then see if you're right by adding some code to
your application that will look for memory cycles within one data
structure.  This is inefficient, because Angerwhale is a big codebase,
and I don't want to manually guess where the leaks are.

I tried a variant of this technique which lead me to
C<File::ExtAttr::getfattr>, which is definitely leaking memory.  What I did
was an iterative guess-n-check procedure.  Say you have some code:

   lang:Perl
   sub foo {
      my $bar = some_function();
      my $baz = $bar->another_function($_[0]);
      blah();
  }

You can see if this is being leaky by running it a bunch of times
while watching C<top>:

   sub foo {
      while(1){
         my $bar = ...; # etc.
      }
   }

Run this, and watch C<perl> crawl to the top of the Vsize column:

   lang:undef
   12048 jon       15   0 201m 137m 5936 S    1  0.8   1:09.06 perl

The 137m and 201m should be increasing steadily, and now you know that
the code in the loop is allocating a lot more memory than it's
freeing.  That's never good.

Now you can move the C<while(1)> to a smaller block of code, until you
find one function that's leaking.  Then you fix it.  Repeat.  Watch several
days go by with Angerwhale still leaking.

At about that point, I got tired of touching the code.  I wanted a list
of all functions and how much memory they used, like DProf, but for memory
instead of time.

Thanks to the Perl debugger C<DB>, this is actually somewhat simple.
When you invoke perl like C<perl -d:Something>, perl will load
C<Devel::Something> and treat it as the debugger.  It will call
C<DB::DB> every time it's about to execute a line of code.  It will
call C<DB::sub> every time it's about to call a sub.  So, if you want
to see how much memory a sub uses, you can just implement a C<DB::sub>
that sees how much memory is in use, runs the sub, and then sees how much
more memory is in use.  The details are a bit complicated, since you
have to account for C<DB::sub> being called when you check how much memory
is in use, and you have to account for running the real sub in the correct
context (scalar, list, or void).  The code looks something like this:
   
    lang:Perl
    package DB;
    sub sub {
        no strict 'refs';
        push(@stack, $DB::single);
        $DB::single &= 1;
        $DB::single |= 4 if $#stack == $DEEP;
    
        my ($before,$after);
        if (!$deep) {
            $before = size();
        }
    
        my $void = $DB::sub eq 'DESTROY' || 
          substr($DB::sub, -9) eq '::DESTROY' ||
            not defined wantarray;
    
        if ($void){
            &$DB::sub;
        }
        elsif (wantarray) {
            @DB::ret = &$DB::sub;
        }
        else {
            $DB::ret = &$DB::sub;
        }
        $DB::single |= pop(@stack);
    
        if (!$deep) {
            $after = size();
            record($DB::sub, $before, $after);
        }
        
        if ($void) {
            $DB::ret = undef;
            return $DB::ret;
        }
        elsif (wantarray) {
            return @DB::ret;
        }
        else {
            return $DB::ret;
        }
    }

Details are icky.  But the idea is:

    sub sub { 
       my $before = size();
       $DB::sub;
       my $after = size();
       record($DB::sub, $before, $after);
       return ...;
   }

There are two more functions, size and record:

    BEGIN { open OUT, '>', 'mprof.out' or die "failed to open mprof.out: $!" };
    our $deep = 0;
    
    sub size {
        $deep = 1;
    
        open M, '<', "/proc/$$/statm" or die "failed to open statm: $!";
        my $line = join '', <M>;
        $line =~ /^(\d+)\s/; # <size> ...
        close M;
        
        $deep = 0;
        return $1;
    };
    
    sub record {
        $deep = 1;
        print OUT join ':',@_;
        print OUT "\n";
        $deep = 0;
    }

These are simple.  C<size> gets the process' size from
C</proc/$$/statm>, and C<record> writes a record to mprof.out for
every function.  (C<$deep> prevents calling into C<size> and C<record>
when already inside of C<size> or C<record>.)

Why am I using C<OLD_STYLE> filehandles instead of C<my $lexicals>?
C<IO::Handle> seems to break everything, which leads me to believe
that my C<DB::sub> is b0rken.  Some things are flaky, but most things
aren't.  More meta-debugging (debugging the debugger) is needed.  That's
why this article is Part 1 and not Part "It's Done".

Anyway, this works well enough.  I called the module C<Devel::MProf>,
so it's used like this:

   lang:Bash
   ANGERWHALE_EXIT_OK=1 perl -Ilib -d:MProf script/angerwhale_server.pl

Then you can hit something in Angerwhale:

   GET http://localhost:3000/

And tell Angerwhale to exit

   GET http://localhost:3000/exit

Then you can read the C<mprof.out> file, which looks like:

    lang:undef
    URI::canonical:18527:18527
    CODE(0x84e082c):18527:18527
    Catalyst::DispatchType::Path::register_path:18527:18527
    Catalyst::DispatchType::Path::register:18527:18527
    CODE(0x9071650):18527:18527
    Catalyst::DispatchType::Regex::register:18527:18527

I don't really want to write a progrm to compute aggregates, so I'll
just load the records into a SQLite database and query it from the
sqlite3 shell:

    lang:Perl
    use strict;
    use warnings;
    use DBI;
    
    my $dbh = DBI->connect('DBI:SQLite:mprof', undef, undef, { AutoCommit => 0} );
    $dbh->do('CREATE TABLE f(id INTEGER PRIMARY KEY, function TEXT, before INT, after INT)');
    $dbh->do('CREATE INDEX functions on f(function)');
    
    my $sth = $dbh->prepare('INSERT INTO f VALUES(NULL,?,?,?)');
    
    while (<>) {
        my ($func, $before, $after) = /^(.+):(\d+):(\d+)$/;
        $sth->execute($func, $before, $after);
    }
    
    $dbh->commit;

As an aside, turning off AutoCommit sped things up remarkably.  The
file loads into the database as fast as the disk can read it now
(about 20 seconds).  With AutoCommit on, it took about 5 minutes!

Anyway, now we can get at the data:

   lang:SQL
   SELECT count(1) AS c, sum(after-before) AS s, function 
   FROM f GROUP BY function HAVING s <> 0 ORDER BY s ASC;  

And we can see what's using a lot of memory:

   lang:undef
   4|5715|Catalyst::Plugin::Cache::Store::FastMmap::setup_fastmmap_cache_backend
   1|5715|Catalyst::Plugin::Cache::setup_cache_backends
   4|5715|Catalyst::Plugin::Cache::setup_generic_cache_backend
   115|6313|base::import
   5|7139|Cache::FastMmap::CImpl::fc_init
   5|7158|Cache::FastMmap::new
   1|7190|Catalyst::Plugin::Cache::setup
   1|7268|Catalyst::Plugin::Static::Simple::setup
   1|7300|Catalyst::Plugin::ConfigLoader::setup
   1|14506|Catalyst::setup
   389|24084|NEXT::AUTOLOAD

These numbers make sense.  I allow my cache to use 5M of storage, and
there it is using 5715k.  C<Catalyst::setup> loads all of the plugins,
so it uses a bit of memory that doesn't get freed until the program
exists.  NEXT::AUTOLOAD is what handles dispatching to methods inside
Catalyst, so all the memory that leaks is going to leak somewhere in
there.

What did I learn from this?  Nothing.  I can't really see anything
that gets called a lot that leaks memory, but that's probably because
the resolution is 1k.  

I need to figure out how to get higher-resolution data.  A function
that leaks 1 byte 1024 times is just as bad as a function that leaks
1k but is only called once.  Right now, that function falls under the
radar.

I also need to either do line-by-line profiling, or keep track of the
call tree at each point, so I can produce inclusive and exclusive
memory use (like DProf does for time).  NEXT::AUTOLOAD probably isn't
leaking, but it sure looks like it when you read the inclusive memory
usage.

Now I will probably have to implement this with XS instead of in Perl,
which will be a time drain.  But it's probably worth it.

Stay tuned for part C<n> where C<n> > 1.
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.6 (GNU/Linux)

iQCVAwUBRrrC59AZeFPdJeQvAQIYtQQAqMhT+3H8Rc5lFV19gl5UDtZX6NNVnr1Y
W4eWuSEKs1pXnAEoWOdPcc1sxqytlkqHkuJWwi8w2SvcpinlPCiKbtWRoFKltPpc
GXCOXtTKMyZ/RAlJjyTSBhghRfukOKYakv4e1T5A+VomJHiXJhUQndbrg2zisQzK
4+E9ib8w48k=
=UWy2
-----END PGP SIGNATURE-----