SPUG: Part II: Coupling of closure parsing and compilation
Fred Morris
m3047 at inwa.net
Sun Oct 12 16:40:18 CDT 2003
Here's a sample program and also some actual stats using anonymous closures
as completion handlers.
You'll notice that the anonymous version takes slightly more than twice as
long as the "straight" call scenario. Don't read too much into that, it's
not that surprising given not only the work of creating the closures, but
also storing them in the hash that carries the object and then later
retrieving them. The more salient point is that it's still managing on the
order of 10000 closures per second (500 MHz K6, Perl 5.8.0 built for i586
Linux).
The memory issue is the other one. "Straight" mode doesn't leak, of course.
But you can clearly see that one technique for invoking handlers leaks and
the other doesn't: the for loop leaks because it doesn't remove the references
from the list of handlers, however the while/shift loop doesn't leak because
it removes the references as a side effect.
A little long for a sample, but kinda slick. Thanks to
Yitzchak Scott-Thoennes for the early encouragement, and now I'll have to
bend this technique to its real purpose.
--
Fred Morris
m3047 at inwa.net
--
#!/usr/bin/perl -w
#
=pod
=head1 Test2 - Memory Leak Tester
Demonstrates how anonymous callback handlers work.
=cut
package A;
sub new( $$ ) {
my $class = shift;
my $write = shift; $write = 0 unless ($write);
my $self = { write => $write };
return bless $self, $class;
} # &new
sub do_stuff( $$ ) {
my $self = shift;
my $param = shift;
print "This is A, doing stuff.\n" if ($self->{write});
$self->{_b}->here_ya_go( sub { $self->finis( $param ); } );
} # &do_stuff
sub also_do_stuff( $$ ) {
my $self = shift;
my $param = shift;
print "This is A, doing stuff.\n" if ($self->{write});
} # &also_do_stuff
sub finis( $$ ) {
my $self = shift;
my $param = shift;
print "This is A ($param), saying until next time have a good tomorrow.\n"
if ($self->{write});
} # &finis
package B;
sub new( $ ) {
my $class = shift;
my $write = shift; $write = 0 unless ($write);
my $self = { write => $write };
return bless $self, $class;
} # &new
# Conceptually adds a to b. Actually, a has a pointer to b, not the other
# way around.
sub add( $$ ) {
my $self = shift;
my $a = shift;
$a->{_b} = $self;
} # &add
sub here_ya_go( $$ ) {
my $self = shift;
my $handler = shift;
push @{$self->{_handler}}, $handler;
} # &here_ya_go
sub do_more_stuff( $$ ) {
my $self = shift;
my $leak = shift;
print "This is B, doing stuff.\n" if ($self->{write});
# If I'm right about this, leaving stuff in the handler stack
# leads to a circular memory reference... or looking at it the
# other way around, creating a shift register for handlers
# prevents it!
if ($leak) {
foreach my $handler (@{$self->{_handler}}) {
&$handler();
}
}
else {
while (my $handler = shift @{$self->{_handler}}) {
&$handler();
}
}
} # &do_more_stuff
sub also_do_more_stuff( $$ ) {
my $self = shift;
my $leak = shift;
print "This is B, doing stuff.\n" if ($self->{write});
} # &also_do_more_stuff
package main;
my $iterations = 1;
my $a_calls = 2;
my $leak = 0;
my $write = 1;
print "test> ";
while (<>) {
chomp;
if (m/\?|help/io) {
foreach my $cmd ('help','show','set [iterations|a_call|leak|write] n',
'exec [anonymous|straight]' ) {
print " $cmd\n";
}
print "\n";
}
elsif (m/show/io) {
print " iterations: $iterations\n";
print " a_calls: $a_calls\n";
print " leak: $leak\n";
print " write: $write\n";
print "\n";
}
elsif (m/set\s+(\S+)\s+(\d+)/io) {
my $n = $2;
my $p = $1;
if ($p =~ m/iter/io) {
$iterations = $n;
}
elsif ($p =~ m/a_/io) {
$a_calls = $n;
}
elsif ($p =~ m/leak/io) {
$leak = $n;
}
elsif ($p =~ m/wri/io) {
$write = $n;
}
}
elsif (m/exec\s+(\S+)/io) {
my $mode = $1;
if ($mode =~ m/anon/io) {
# Anonymous execution with handlers as closures.
for( my $i = 0; $i < $iterations; $i++ ) {
my $a = A->new( $write );
my $b = B->new( $write );
$b->add( $a );
for( my $j = 0; $j < $a_calls; $j++ ) {
$a->do_stuff( $j );
}
$b->do_more_stuff( $leak );
}
}
elsif ($mode =~ m/stra/io) {
# Straight execution, without closures.
for( my $i = 0; $i < $iterations; $i++ ) {
my $a = A->new( $write );
my $b = B->new( $write );
$b->add( $a );
for( my $j = 0; $j < $a_calls; $j++ ) {
$a->also_do_stuff( $j );
}
# Leak doesn't really do anything since there are
# no closures.
$b->also_do_more_stuff( $leak );
for( my $j = 0; $j < $a_calls; $j++ ) {
$a->finis( $j );
}
}
}
}
print "\ntest> ";
}
exit(0);
__END__
m3047 at flame:~> #initial
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 0:00 323 1048 4503 1424 0.7 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #anon
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 0:00 348 1048 4503 1524 0.7 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #straight
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 0:00 348 1048 4503 1524 0.7 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #write = 0
m3047 at flame:~> #iterations = 100000
m3047 at flame:~> #anon
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 0:40 349 1048 4503 1528 0.7 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #straight
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 0:58 349 1048 4503 1528 0.7 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #anon
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 1:39 349 1048 4503 1528 0.7 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #straight
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 1:57 349 1048 4503 1528 0.7 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #iterations = 500
m3047 at flame:~> #leak = 1
m3047 at flame:~> #anon
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 1:57 349 1048 5215 2240 1.1 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #straight
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 1:57 349 1048 5215 2240 1.1 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #straight
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 1:57 349 1048 5215 2240 1.1 /usr/bin/perl -w ./test2.plx
m3047 at flame:~> #anon
m3047 at flame:~> ps v | grep test2 | grep -v grep
11640 pts/1 S 1:57 349 1048 5931 2956 1.5 /usr/bin/perl -w ./test2.plx
m3047 at flame:~>
More information about the spug-list
mailing list