Author: tim.bunce
Date: Wed Nov 12 09:55:35 2008
New Revision: 596
Modified:
trunk/NYTProf.xs
trunk/lib/Devel/NYTProf/Data.pm
trunk/lib/Devel/NYTProf/FileInfo.pm
trunk/lib/Devel/NYTProf/Reader.pm
Log:
Set NYTP_FIDi_EVAL_FI element as weakref to eval fileinfo in XS code for
speed.
Bless fid_fileinfo elements in XS.
Use make_path_strip_editor instead of strip_prefix_from_paths because
strip_prefix_from_paths enthusiatically recurses into structures,
which won't work now objects has refs to other objects.
Rename and generalize make_fid_filenames_relative into
make_filenames_relative
and make it work for sub_subinfo and sub_caller as well as fid_fileinfo.
Remove $opts->{relative_paths} from ::Reader - it never really existed.
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Wed Nov 12 09:55:35 2008
@@ -2757,6 +2757,8 @@
HV* sub_subinfo_hv = newHV();
HV* sub_callers_hv = newHV();
SV *tmp_str_sv = newSVpvn("",0);
+ HV *file_info_stash = gv_stashpv("Devel::NYTProf::FileInfo",
GV_ADDWARN);
+ HV *sub_info_stash = gv_stashpv("Devel::NYTProf::SubInfo",
GV_ADDWARN);
/* these times don't reflect profile_enable & profile_disable calls */
NV profiler_start_time = 0.0;
@@ -2950,6 +2952,7 @@
case NYTP_TAG_NEW_FID: /* file */
{
AV *av;
+ SV *rv;
SV *filename_sv;
unsigned int file_num = read_int();
unsigned int eval_file_num = read_int();
@@ -3006,10 +3009,14 @@
av_store(av, NYTP_FIDi_FILESIZE, newSVuv(file_size));
av_store(av, NYTP_FIDi_FILEMTIME, newSVuv(file_mtime));
av_store(av, NYTP_FIDi_PROFILE, &PL_sv_undef);
- av_store(av, NYTP_FIDi_EVAL_FI, &PL_sv_undef);
+ av_store(av, NYTP_FIDi_EVAL_FI, eval_file_num
+ ? sv_rvweaken(newSVsv(*av_fetch(fid_fileinfo_av,
eval_file_num, 1)))
+ : &PL_sv_undef);
av_store(av, NYTP_FIDi_SUBS_DEFN, &PL_sv_undef);
- av_store(fid_fileinfo_av, file_num, newRV_noinc((SV*)av));
+ rv = newRV_noinc((SV*)av);
+ sv_bless(rv, file_info_stash);
+ av_store(fid_fileinfo_av, file_num, rv);
break;
}
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Wed Nov 12 09:55:35 2008
@@ -50,7 +50,7 @@
use Devel::NYTProf::Core;
use Devel::NYTProf::FileInfo;
use Devel::NYTProf::SubInfo;
-use Devel::NYTProf::Util qw(strip_prefix_from_paths
get_abs_paths_alternation_regex);
+use Devel::NYTProf::Util qw(make_path_strip_editor strip_prefix_from_paths
get_abs_paths_alternation_regex);
our $VERSION = '2.07';
@@ -77,6 +77,7 @@
my $profile = load_profile_data_from_file($file);
bless $profile => $class;
+ #use Data::Dumper; warn Dumper($profile->{fid_fileinfo});
my $fid_fileinfo = $profile->{fid_fileinfo};
my $sub_subinfo = $profile->{sub_subinfo};
@@ -87,16 +88,10 @@
$_ and $_->[7] = $profile for @$fid_fileinfo;
$_->[7] = $profile for values %$sub_subinfo;
- # bless fid_fileinfo data
- (my $fid_class = $class) =~ s/\w+$/FileInfo/;
- $_ and bless $_ => $fid_class for @$fid_fileinfo;
-
# bless sub_subinfo data
(my $sub_class = $class) =~ s/\w+$/SubInfo/;
$_ and bless $_ => $sub_class for values %$sub_subinfo;
- #$profile->_migrate_sub_callers_from_eval_fids;
-
# XXX merge evals - should become a method optionally called here
# (which uses other methods to do the work and those methods
# should also be called by Devel::NYTProf::SubInfo::callers())
@@ -557,20 +552,21 @@
my $eval_regex = qr/ \( ((?:re_)?) eval \s \d+ \) /x;
- # remove_internal_data_of library files
- # (the definition of which is quite vague at the moment)
my $abs_path_regex = $^O eq "MSWin32" ? qr,^\w:/, : qr,^/,;
+ my $inc = [ $self->inc, '.' ];
my @abs_inc = grep { $_ =~ $abs_path_regex } $self->inc;
my $is_lib_regex = get_abs_paths_alternation_regex([EMAIL PROTECTED]);
- for my $fileinfo ($self->all_fileinfos) {
+ my $editor = make_path_strip_editor([ $self->inc, '.' ], qr{^|
\[}, '/.../');
- # normalize eval sequence numbers in 'file' names to 0
- $fileinfo->[0] =~ s/$eval_regex/(${1}eval 0)/g;
+ for my $fi ($self->all_fileinfos) {
- # ignore files not in perl's own lib
- next if $fileinfo->filename !~ $is_lib_regex;
+ # normalize eval sequence numbers in 'file' names to 0
+ $fi->[0] =~ s/$eval_regex/(${1}eval 0)/g;
- $self->remove_internal_data_of($fileinfo);
+ # strip out internal details of library modules
+ # (the definition of which is quite vague at the moment)
+ $self->remove_internal_data_of($fi)
+ if $fi->filename =~ $is_lib_regex;
}
# normalize line data
@@ -596,16 +592,10 @@
$_->[1] = $_->[2] = $_->[3] = $_->[4] = $_->[5] = 0;
}
- my $inc = [EMAIL PROTECTED], '.'];
-
- $self->make_fid_filenames_relative($inc, '/.../');
+ $self->make_filenames_relative($inc, '/.../');
for my $info ($self->{sub_subinfo}, $self->{sub_caller}) {
- # normalize paths in sub names like
- # AutoLoader::__ANON__[/lib/perl5/5.8.6/AutoLoader.pm:96]
- strip_prefix_from_paths($inc, $info, '\[', '/.../');
-
# normalize eval sequence numbers in sub names to 0
for my $subname (keys %$info) {
(my $newname = $subname) =~ s/$eval_regex/(${1}eval 0)/g;
@@ -621,6 +611,7 @@
}
+# not currently used, guts may be refactored into new methods later
sub _migrate_sub_callers_from_eval_fids {
my $self = shift;
@@ -663,12 +654,34 @@
}
-sub make_fid_filenames_relative {
+sub make_filenames_relative {
my ($self, $roots, $replacement) = @_;
$roots ||= ['.']; # e.g. [ @INC, '.' ]
+
+ warn "making filenames relative to @$roots\n"
+ if $trace;
+
+ my $editor = make_path_strip_editor($roots, qr{^|\[}, $replacement);
+
# strip prefix from start of string and also when embeded
# e.g., "(eval 42)[/foo/bar/...]"
- strip_prefix_from_paths($roots, $self->{fid_fileinfo}, qr{^|\[},
$replacement);
+ for my $fi ($self->all_fileinfos) {
+ $editor->($fi->[0]); # XXX breaks encapsulation
+ }
+
+ # edit sub names, e.g., "__ANON__[/foo/bar/...:42]"
+ for my $info ($self->{sub_subinfo}, $self->{sub_caller}) {
+ for my $subname (keys %$info) {
+ $editor->(my $newname = $subname)
+ or next;
+ next if $newname eq $subname;
+ warn "Discarded previous $newname info" if $info->{$newname};
+ my $value = delete $info->{$subname};
+ $info->{$newname} = $value;
+ # update subname attribute of SubInfo XXX breaks encapsulation
+ $value->[6] = $newname if UNIVERSAL::can($value, 'subname');
+ }
+ }
}
Modified: trunk/lib/Devel/NYTProf/FileInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/FileInfo.pm Wed Nov 12 09:55:35 2008
@@ -8,6 +8,7 @@
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_DEFN
+ NYTP_FIDf_IS_PMC
);
sub filename { shift->[NYTP_FIDi_FILENAME()] }
@@ -20,7 +21,7 @@
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()] ||=
$_[0]->profile->fileinfo_of($_[0]->eval_fid || return) }
+sub eval_fi { $_[0]->[NYTP_FIDi_EVAL_FI()] }
# return a ref to a hash of { subname => subinfo, ... }
sub subs { $_[0]->[NYTP_FIDi_SUBS_DEFN()] ||=
$_[0]->profile->fid_subs_map->{ $_[0]->fid } }
@@ -79,7 +80,7 @@
sub is_pmc {
- return (shift->flags & 1); # NYTP_FIDf_IS_PMC
+ return (shift->flags & NYTP_FIDf_IS_PMC());
}
Modified: trunk/lib/Devel/NYTProf/Reader.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Reader.pm (original)
+++ trunk/lib/Devel/NYTProf/Reader.pm Wed Nov 12 09:55:35 2008
@@ -112,7 +112,7 @@
bless($self, $class);
$self->{profile} = Devel::NYTProf::Data->new({filename =>
$self->{file}});
- $self->{profile}->make_fid_filenames_relative($opts->{relative_paths});
+ $self->{profile}->make_filenames_relative();
# a hack for testing/debugging
exit $ENV{NYTPROF_EXIT_AFTER_LOAD} if defined
$ENV{NYTPROF_EXIT_AFTER_LOAD};
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
