On Fri, Feb 19, 2010 at 04:19:50PM +0000, Tim Bunce wrote:
> Uh, yeah. I've been up to my neck in PostgreSQL/Safe stuff and haven't
> made much progress on NYTProf. Guess we should get a release out the
> door before the land such a significant reorg.
Yes. :-)
As part of temptation, building on everything else I've done, I've just
made nytprofmerge take about 30% less time, by allowing the callback to
load_profile_data_from_file() to also be a hash reference.
For a hash reference, the tag name is looked up, with the value being a
callback subroutine to dispatch to. If there is no entry for the tag, a lookup
is made with an empty string key for a default subroutine. If there is no
default, then no callback is made for that tag.
Internally, in load_profile_to_callback() [doesn't exist yet on trunk],
it iterates over the hash when setting up the state, converting it to an array
of callback functions. This avoids all hash lookups at execution time.
Behaviour for a code reference is unchanged.
The diff for this for nytprofmerge is small, as I pretty much re-implemented
my existing dispatcher in XS:
diff --git a/bin/nytprofmerge b/bin/nytprofmerge
index 0fa4291..275d598 100755
--- a/bin/nytprofmerge
+++ b/bin/nytprofmerge
@@ -88,6 +88,9 @@ my $deflating;
my %dispatcher =
(
+ '' => sub {
+ die "Unknown tag '$_[0]' in $input\n";
+ },
VERSION => sub {
my (undef, $major, $minor) = @_;
my $this_version = "$major $minor";
@@ -209,10 +212,9 @@ foreach $input (@ARGV) {
@pending_fids = ();
%pending_subs = ();
- Devel::NYTProf::Data->new({filename => $input, callback => sub {
- my $tag = shift;
- if($tag eq 'NEW_FID') {
- my ($fid, $eval_fid, $eval_line, $flags, $size, $mtime, $name) = @_;
+ Devel::NYTProf::Data->new({filename => $input, callback => {
+ NEW_FID => sub {
+ my (undef, $fid, $eval_fid, $eval_line, $flags, $size, $mtime,
$name) = @_;
my ($new_fid, $new_eval_fid);
if($eval_fid) {
# Generally, treat every eval as distinct, even at the same
location
@@ -249,8 +251,9 @@ foreach $input (@ARGV) {
}
$fid_to_file{$new_fid} = $name;
$pending_fids[$fid] = [$new_fid, $new_eval_fid];
- } elsif ($tag eq 'SUB_INFO') {
- my ($fid, $first_line, $last_line, $name) = @_;
+ },
+ SUB_INFO => sub {
+ my (undef, $fid, $first_line, $last_line, $name) = @_;
my $output_fid;
if ($name =~ $sub_is_anon_in_eval) {
confess("No mapping for $fid") unless defined $fids{$fid};
@@ -289,11 +292,7 @@ foreach $input (@ARGV) {
}});
print "Re-reading $input...\n" if $opt_verbose;
- Devel::NYTProf::Data->new({filename => $input, callback => sub {
- my $sub = $dispatcher{$_[0]}
- or die "Unknown tag '$_[0]' in $input\n";
- &$sub(@_);
- }});
+ Devel::NYTProf::Data->new({filename => $input, callback => \%dispatcher});
}
print "Finalizing...\n" if $opt_verbose;
[that's a diff from a state not yet on trunk either - it's been refactored
to avoid for_chunk, instead calling Devel::NYTProf::Data->new() directly.]
Of course, not even making a callback to Perl space when it's not wanted is
a big win, as is elimination of the second level subroutine call (as was).
Nicholas Clark
--
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [email protected]
