Re: Debugging emacs memory management

[Dima Kogan]

Eli Zaretskii <address@hidden> writes:

> This doesn't seem to be a leak in itself.

Hi. I'm fairly certain that this is the leak. I know I didn't show any
evidence to that effect earlier, but I simply haven't written it up yet.
Doing that now. Note that the attached scripts aren't particularly nice;
they were quickly whipped up to solve a problem.


Procedure:

0. Preliminaries. I built my own emacs with -fno-omit-frame-pointer. I'm
   using the lucid X11 widgets. I'm on Debian/sid and the split debug
   symbols are available. I patched my perf to be able to find these
   split debug symbols:

     http://lkml.iu.edu/hypermail/linux/kernel/1509.0/04006.html

1. Set up emacs to continually leak memory. Here I do that by running
   'emacs -Q --daemon'. Then "emacsclient -a '' -c" to open a frame.
   Then in a loop open/destroy a second frame:

     while true; do timeout 1 emacsclient -a '' -c; sleep 1; done

   This is described in earlier emails. As this goes I can observe the
   memory leak:

     while (true) { ps -h -p `pidof emacs` -O rss; sleep 1 } | awk '{print $2;}'

   A snapshot of this is attached in memory.log, and plotted in
   memory.pdf:

     <memory.log | feedgnuplot --lines --xlabel 'Time(s)' --ylabel 'Emacs 
memory footprint (kB)'

   We leak on the order of 8.5kB/s. There's a new frame every 2s so
   that's 17kB/client frame.

2. As this runs make a record of all memory allocation operations. I use
   perf to do this:

     perf probe --del '*'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 'malloc=malloc 
bytes'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 
'malloc_ret=malloc%return $retval'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 'calloc=calloc 
elem_size n'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 
'calloc_ret=calloc%return $retval'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 'realloc=realloc 
oldmem bytes'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 
'realloc_ret=realloc%return $retval'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 'aligned_alloc 
alignment bytes'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 
'aligned_alloc_ret=aligned_alloc%return $retval'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 'posix_memalign 
alignment size'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 
'posix_memalign_ret=posix_memalign%return $retval'
     perf probe -x /lib/x86_64-linux-gnu/libc-2.19.so --add 'free mem'

     timeout 40 perf record -m512 -r50 -g --call-graph=fp -p `pidof emacs` 
-eprobe_libc:{free,{malloc,calloc,realloc}{,_ret}} 
-eprobe_libc:aligned_alloc{,_1,_ret} -eprobe_libc:posix_memalign{,_ret}

   This makes a (very large) perf.data file with all the data in it. Too
   big; not attaching it. Back traces are available wherever frame
   pointers are, so malloc() directly from emacs has a backtrace,
   malloc() that goes through something like libgtk first does not. Perf
   can get overloaded and not write all the data. I make sure to only
   keep full data files

3. Convert the log file to a human-readable one

     perf script > script

   This makes a human-readable, but even larger file. Way too big;
   definitely not attaching it.

4. Analyze.

Note that the emacs client loop creates a client for 1 second, then
kills it and waits 1 more second. So there's a new client every 2
seconds. I "perf record" for 40 seconds, so ~ 20 new clients were
created in that time.

I now run the script file through parse_script.pl to follow all
allocations, and report any that have not been freed. Anything that has
been allocated at the start of the log file, and hasn't been freed by
the end is potentially a leak. Attaching a "leaks" file that's the
result of this. I make a plot of leak size vs line number:

  <leaks awk '$1=="Leaked" {print $6,$2}' | feedgnuplot --domain --points 
--xlabel 'script line number' --ylabel 'size leaked'

Attaching that too; leaks_all.pdf. Note that it looks like we leak 4096
bytes (4k from now on) at regular intervals, about 20 times. This is a
strong indication that whatever happens with those 4k allocations
happens every time we create (or destroy) a client frame. It actually
turns out to be a little more complicated than that. If we look just at
the 4k leaks and plot each one against its line number in the log then
we see that each time we leak a 4k chunk several times
(leaks_4k_line_numbers.pdf)

  <leaks awk '$1=="Leaked" && $2==4096 {print $6}' | feedgnuplot --points 
--xlabel '4k leak index' --ylabel 'script line number'

As shown earlier, we leak 17kB per frame. On average we have:

  $ echo $(( 4. * $(<leaks awk '$1=="Leaked" && $2==4096 {print $6}' | wc -l) / 
19 ))
  10.947368421052632

So these 4k leaks could be responsible for ~ 11kB out of the 17kB.

OK. So what are those 4k leaks? I follow all the 4k allocations with a
follow_alloc.pl script. This acts as a filter to pull out the salient
parts of the "script" file.

  <script ./follow_alloc.pl 4096 > follow4096

Looking at the follow4096 file I see that most of the 4k allocs have the
backtrace in the previous email. None of these are ever freed. Some of
the 4k allocs touch the menu stuff, and those are all freed (in
garbage_collect, so the gc IS being called). Some of the 4k allocs are
from the tool bar, and those all leak too, but there aren't as many of
them as the font ones.



So this tells me that the backtrace in the previous email is the main
one causing the leak. There's more stuff to look at however, like the
toolbar stuff and a suspicious 16384 byte alloc, but those aren't as
significant as this 4k one.

memory.log
Description: Binary data

memory.pdf
Description: Adobe PDF document

#!/usr/bin/perl

use strict;
use warnings;


use feature 'say';


my $Nbytes_allocated = 0;
my %allocated;

my ($prev_addr, $prev_ret, $prev_type, $prev_realloc0, $prev_realloc0_addr, 
$prev_realloc0_bytes);
my $allocating;


while(<>)
{
    next unless /probe_libc:([^:]+)/;

    my $type = $1;
    my $ret = $type =~ /_ret$/;
    $type =~ s/_ret$//;


    if ( $ret && !( !$prev_ret && $type eq $prev_type) &&
         !($prev_realloc0 && $prev_type eq 'malloc' && $prev_ret && $type eq 
'realloc') ) {
        die "$type ret, but prev wasn't a corresponding !ret";
    }
    elsif ( !$ret && !$prev_ret &&
            !($prev_realloc0 && $prev_type eq 'realloc' && !$prev_ret && $type 
eq 'malloc') &&
            $. > 1) {
        die "$type !ret following another !ret";
    }
    elsif ( $prev_realloc0 && !($type eq 'malloc' || $type eq 'realloc'))
    {
        die "realloc(0, N) must be followed by malloc(N)";
    }
    elsif ( !$ret )
    {
        if ($type eq 'malloc' && /bytes=([0-9a-z]+)/)
        {
            $allocating = hex $1;
            if ( $prev_realloc0 && $allocating != $prev_realloc0_bytes )
            {
                die "realloc(0, N) must be followed by malloc(N)";
            }
        }
        elsif ($type eq 'calloc' && /elem_size=([0-9a-z]+).*n=([0-9a-z]+)/)
        {
            $allocating = (hex $1) * (hex $2);
        }
        elsif ($type eq 'aligned_alloc' && /bytes=([0-9a-z]+)/)
        {
            $allocating = hex $1;
        }
        elsif ($type eq 'realloc' && /oldmem=([0-9a-z]+).*bytes=([0-9a-z]+)/)
        {
            if ( hex($1) == 0 )
            {
                # realloc(0, xxx) is always mapped to a malloc apparently. I 
treat
                # this specially
                $prev_realloc0       = 1;
                $prev_realloc0_bytes = hex $2;
            }
            else
            {
                $allocating = hex $2;
                $prev_addr = $1;
            }
        }
        elsif ($type eq 'free' && /mem=([0-9a-z]+)/)
        {
            if ( hex($1) != 0)  # free(0) does nothing
            {
                if (!defined $allocated{$1})
                {
                    say "Unallocated free at $1. Line $.";
                }
                else
                {
                    $Nbytes_allocated -= $allocated{$1}{bytes};
                    delete $allocated{$1};
                }
            }

            $ret = 1;           # free has no free-ret so I set that now
        }
        else
        {
            say "Unknown !ret line: '$_'";
            exit;
        }
    }
    elsif ( $ret )
    {
        if ( !/arg1=([0-9a-z]+)/ )
        {
            die "Ret didn't get arg1";
        }

        my $addr = $1;

        if ( hex($addr) == 0 )
        {
            say "$type returned NULL. Giving up";
            exit;
        }
        elsif ( $type =~ /^(?:[cm]alloc|aligned_alloc)$/ )
        {
            if (defined $allocated{$addr})
            {
                say "Double alloc at $addr. Line $.";
            }
            else
            {
                $allocated{$addr}{bytes} = $allocating;
                $allocated{$addr}{line} = $.;
                $Nbytes_allocated += $allocating;
            }

            if ( $prev_realloc0 && $type eq 'malloc')
            {
                $prev_realloc0_addr = $addr;
            }
        }
        elsif ( $type eq 'realloc' )
        {
            if ( $prev_realloc0 )
            {
                if ( $addr ne $prev_realloc0_addr )
                {
                    die "realloc(0, N) must be followed by malloc(N); differing 
addr";
                }

                $prev_realloc0       = undef;
                $prev_realloc0_addr  = undef;
                $prev_realloc0_bytes = undef;
            }
            else
            {
                my $prev0 = (hex($prev_addr) == 0);

                if (!$prev0 && !defined $allocated{$prev_addr})
                {
                    say "realloc not alloced at $prev_addr. Line $.";
                    $prev0 = 1;
                }

                if ($addr ne $prev_addr && defined $allocated{$addr})
                {
                    say "Double realloc at $addr. Line $.";
                }

                if ( !$prev0 )
                {
                    $Nbytes_allocated -= $allocated{$prev_addr}{bytes};
                    delete $allocated{$prev_addr};
                }

                $allocated{$addr}{bytes} = $allocating;
                $allocated{$addr}{line} = $.;
                $Nbytes_allocated += $allocating;
            }
        }
        else
        {
            say "Unknown ret line: '$_'";
            exit;
        }


        $allocating = undef;
    }


    $prev_type = $type;
    $prev_ret = $ret;
}


$Nbytes_allocated /= 1e6;
say "Total allocated: $Nbytes_allocated MB";
say '';

for my $addr ( sort { $allocated{$a}{line} <=> $allocated{$b}{line}} keys 
%allocated )
{
    my ($bytes,$line) = ($allocated{$addr}{bytes},
                         $allocated{$addr}{line});
    say "Leaked " . sprintf('%5d', $bytes) . " bytes at line $line ($addr)";
}

leaks
Description: Binary data

leaks_all.pdf
Description: Adobe PDF document

leaks_4k_line_numbers.pdf
Description: Adobe PDF document

#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Euclid;
use feature ':5.10';

my $size = sprintf('0x%x', $ARGV{'<size>'} =~ /^0x/ ? hex($ARGV{'<size>'}) : 
$ARGV{'<size>'} );


my $next_after_alloc_type;
my %addrs;

my $refcount = 0;

my $printing;

while(<>)
{
    if(/^$/)
    {
        print "\n" if $printing;
        $printing = undef;
        next;
    }

    if( $printing && /^\s/ )
    {
        print;
        next;
    }


    next unless /probe_libc:([^:]+)/;

    if( /$size\b/ )
    {
        if(/realloc/)
        {
            die "realloc not supported";
        }

        my $type = /probe_libc:([a-z_]+)/;
        ($next_after_alloc_type) = $type;

        # I don't print allocation entries. Those aren't interesting. Allocation
        # EXITS are interesting and I print those further down
        # doprint();
    }
    elsif( $next_after_alloc_type )
    {
        my $type = /probe_libc:([a-z_]+)/;
        if($type ne $next_after_alloc_type)
        {
            die "Didn't get ret for type $type";
        }

        my ($addr) = /arg1=(0x[0-9a-f]+)/;
        $addrs{$addr} = 1;

        $next_after_alloc_type = undef;

        $refcount++;

        doprint();
        next;
    }
    else
    {
        for my $addr(keys %addrs)
        {
            if(/$addr\b/)
            {
                if(/free|realloc/)
                {
                    $refcount--;
                }

                delete $addrs{$addr};
                doprint();
            }
        }
    }
}

sub doprint
{
    $printing = 1;
    print "Line: $. Refcount: $refcount. $_";
}



=head1 NAME

follow_alloc.pl - trace allocation of a particular size

=head1 SYNOPSIS

 $ ./follow_alloc.pl --size 0x1234

=head1 DESCRIPTION

Looks at C<perf script> output and reports stuff

=head1 REQUIRED ARGUMENTS

=over

=item <size>

Size of allocation to trace

=for Euclid:
  size.type: /0x[0-9a-f]+|[0-9]+/

=back

=head1 AUTHOR

Dima Kogan, C<< <address@hidden> >>

follow4096
Description: Binary data