Author: tim.bunce
Date: Thu Nov 13 15:03:36 2008
New Revision: 605
Modified:
trunk/NYTProf.xs
trunk/lib/Devel/NYTProf/Data.pm
trunk/lib/Devel/NYTProf/FileInfo.pm
Log:
Add NYTP_FIDi_SUBS_CALLED attribute to fileinfo containing a hash
ref of { line => { subname => [...callinfo...], ... }, ... }
and corresponding $fi->sub_call_lines() method.
Modify $fi->hash_evals to optionally walk and return the tree of nested
evals.
Modify line_calls_for_file to use has_evals.
Delete base_fid_2_eval_fids_map and caller_fid_2_subname_map as they're no
longer used.
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Thu Nov 13 15:03:36 2008
@@ -3185,10 +3185,14 @@
sv_setsv(sv, newRV_noinc((SV*)newHV()));
if (fid) {
+ SV *fi;
len = my_snprintf(text, sizeof(text), "%u", line);
+
sv = *hv_fetch((HV*)SvRV(sv), text, len, 1);
if (!SvROK(sv)) /* autoviv */
sv_setsv(sv, newRV_noinc((SV*)newAV()));
+ else warn("sub_caller info for %s %d:%d already
exists!",
+ SvPV_nolen(subname_sv), fid, line);
sv = SvRV(sv);
sv_setuv(*av_fetch((AV *)sv, NYTP_SCi_CALL_COUNT, 1),
count);
sv_setnv(*av_fetch((AV *)sv, NYTP_SCi_INCL_RTIME, 1),
incl_time);
@@ -3197,6 +3201,16 @@
sv_setnv(*av_fetch((AV *)sv, NYTP_SCi_INCL_STIME, 1),
scpu_time);
sv_setnv(*av_fetch((AV *)sv, NYTP_SCi_RECI_RTIME, 1),
reci_time);
sv_setuv(*av_fetch((AV *)sv, NYTP_SCi_REC_DEPTH, 1),
rec_depth);
+
+ /* add sub call to NYTP_FIDi_SUBS_CALLED of fid */
+ /* => { line => { subname => [ ... ] } } */
+ fi = SvRV(*av_fetch(fid_fileinfo_av, fid, 1));
+ fi = *av_fetch((AV *)fi, NYTP_FIDi_SUBS_CALLED, 1);
+ fi = *hv_fetch((HV*)SvRV(fi), text, len, 1);
+ if (!SvROK(fi)) /* autoviv */
+ sv_setsv(fi, newRV_noinc((SV*)newHV()));
+ fi = HeVAL(hv_fetch_ent((HV *)SvRV(fi), subname_sv, 1,
0));
+ sv_setsv(fi, newRV(sv));
}
else { /* is meta-data about
sub */
/* line == 0: is_xs - set line range to 0,0 as marker
*/
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Thu Nov 13 15:03:36 2008
@@ -221,17 +221,6 @@
}
-# map of { base_fid => [ eval_fid, ...]. }
-sub base_fid_2_eval_fids_map {
- my ($self, $flatten_evals) = @_;
- my $e2b = $self->eval_fid_2_base_fid_map($flatten_evals);
- my $b2e = {};
- while ( my ($eval_fid, $base_fid) = each %$e2b ) {
- push @{ $b2e->{$base_fid} }, $eval_fid;
- }
- return $b2e;
-}
-
sub fid_sub_calls_map {
my $self = shift;
my $sub_caller = $self->{sub_caller} || {};
@@ -245,26 +234,6 @@
}
-sub caller_fid_2_subname_map {
- my $self = shift;
-
- my $caches = $self->_caches;
- my $cache_key = "caller_fid_2_subname_map";
- return $caches->{$cache_key} if $caches->{$cache_key};
-
- my $sub_caller = $self->{sub_caller} || {};
- my %map;
- while (my ($subname, $fid_hash) = each %$sub_caller) {
- while ( my ($caller_fid, $line_calls_hash) = each %$fid_hash ) {
- $map{ $caller_fid }{ $subname } = $line_calls_hash;
- }
- }
-
- $caches->{$cache_key} = \%map;
- return \%map;
-}
-
-
sub inc {
# XXX should return inc from profile data, when it's there
@@ -929,36 +898,30 @@
=cut
sub line_calls_for_file {
- my ($self, $fid, $flatten_evals) = @_;
- $fid = $self->resolve_fid($fid);
+ my ($self, $fid, $include_evals) = @_;
+ my $orig_fi = $self->fileinfo_of($fid);
- my $sub_caller = $self->{sub_caller}
- or return;
+ # shallow copy
+ my $line_calls = { %{ $orig_fi->sub_call_lines } };
+ return $line_calls unless $include_evals;
- # list of fids we're interested in
- my @fids = ($fid);
- # add in all the fids for evals compiled in this fid
- my $eval_fids =
$self->base_fid_2_eval_fids_map($flatten_evals)->{$fid};
- push @fids, @$eval_fids if $eval_fids;
-
- # { fid => { subname => { line => count, ... }, ... }, ... }
- my $caller_fid_2_subname_map = $self->caller_fid_2_subname_map;
-
- my $line_calls = {};
- # for the fid we're interested in, and all the related eval fids
- # loop over the sub calls made by those fids
- for my $caller_fid (@fids) {
- my $subs_called_hash = $caller_fid_2_subname_map->{$caller_fid}
- or next;
+ for my $fi (@{ $orig_fi->has_evals(1) || [] }) {
+ # { line => { subname => [...] }, ... }
+ my $sub_call_lines = $fi->sub_call_lines;
+
+ # $outer_line is the line of the eval
+ # XXX outer(1) is a little inefficient, could refactor the loop to
+ # separate top-level evals from nested evals and use the outer_line
+ # from the top level evals
+ my (undef, $outer_line) = $fi->outer(1); # outermost
- while (my ($subname, $line_calls_hash) = each %$subs_called_hash) {
+ while (my ($line, $sub_calls_hash) = each %$sub_call_lines) {
- my $caller_fi = $self->fileinfo_of($caller_fid);
- my ($outer_fi, $outer_line) = $caller_fi->outer(1);
+ my $ci_for_subs = $line_calls->{$outer_line || $line} ||= {};
- while (my ($line, $callinfo) = each %$line_calls_hash) {
- my $caller_line = $outer_line || $line;
- my $ci = $line_calls->{$caller_line}{$subname} ||= [];
+ while (my ($subname, $callinfo) = each %$sub_calls_hash) {
+
+ my $ci = $ci_for_subs->{$subname} ||= [];
if ([EMAIL PROTECTED]) { # typical case
@$ci = @$callinfo;
}
@@ -969,7 +932,6 @@
}
}
}
-
}
return $line_calls;
}
Modified: trunk/lib/Devel/NYTProf/FileInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/FileInfo.pm Thu Nov 13 15:03:36 2008
@@ -7,7 +7,7 @@
use Devel::NYTProf::Constants qw(
NYTP_FIDi_FILENAME NYTP_FIDi_EVAL_FID NYTP_FIDi_EVAL_LINE NYTP_FIDi_FID
NYTP_FIDi_FLAGS NYTP_FIDi_FILESIZE NYTP_FIDi_FILEMTIME
NYTP_FIDi_PROFILE
- NYTP_FIDi_EVAL_FI NYTP_FIDi_SUBS_DEFINED NYTP_FIDi_HAS_EVALS
+ NYTP_FIDi_EVAL_FI NYTP_FIDi_HAS_EVALS NYTP_FIDi_SUBS_DEFINED
NYTP_FIDi_SUBS_CALLED
NYTP_FIDf_IS_PMC
);
@@ -21,13 +21,30 @@
sub profile { shift->[NYTP_FIDi_PROFILE()] }
# if fid is an eval then return fileinfo obj for the fid that executed the
eval
-sub eval_fi { $_[0]->[NYTP_FIDi_EVAL_FI()] }
+sub eval_fi { shift->[NYTP_FIDi_EVAL_FI()] }
# ref to array of fileinfo's for each string eval in the file, else undef
-sub has_evals { $_[0]->[NYTP_FIDi_HAS_EVALS()] }
+sub has_evals {
+ my ($self, $include_nested) = @_;
+
+ my $eval_fis = $self->[NYTP_FIDi_HAS_EVALS()]
+ or return undef;
+ return $eval_fis if !$include_nested;
+
+ my @eval_fis = @$eval_fis;
+ # walk down tree of nested evals, adding them to @fi
+ for (my $i=0; my $fi = $eval_fis[$i]; ++$i) {
+ push @eval_fis, @{ $fi->has_evals || [] };
+ }
+
+ return [EMAIL PROTECTED];
+}
# return a ref to a hash of { subname => subinfo, ... }
-sub subs { $_[0]->[NYTP_FIDi_SUBS_DEFINED()] }
+sub subs { shift->[NYTP_FIDi_SUBS_DEFINED()] }
+
+# return a ref to a hash of { line => { subname => [...] }, ... }
+sub sub_call_lines { shift->[NYTP_FIDi_SUBS_CALLED()] }
sub _values_for_dump {
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
