Author: tim.bunce
Date: Thu Mar 5 15:16:40 2009
New Revision: 694
Modified:
trunk/NYTProf.xs
trunk/lib/Devel/NYTProf/FileInfo.pm
trunk/t/test14.rdt
Log:
Initial structural changes to support smarter autosplit handling.
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Thu Mar 5 15:16:40 2009
@@ -76,6 +76,7 @@
#define NYTP_FIDf_IS_PMC 0x0001 /* .pm probably really loaded
as .pmc */
#define NYTP_FIDf_VIA_STMT 0x0002 /* fid first seen by stmt profiler
*/
#define NYTP_FIDf_VIA_SUB 0x0004 /* fid first seen by sub profiler
*/
+#define NYTP_FIDf_IS_AUTOSPLIT 0x0008 /* fid is cone of the 'parent' fid
it was autosplit from */
#define NYTP_TAG_ATTRIBUTE ':' /* :name=value\n */
#define NYTP_TAG_COMMENT '#' /* till newline */
@@ -134,6 +135,8 @@
/* Hash table definitions */
#define MAX_HASH_SIZE 512
+static int next_fid = 1; /* 0 is reserved */
+
typedef struct hash_entry
{
unsigned int id;
@@ -147,6 +150,7 @@
unsigned int fid_flags;
char *key_abs;
void* next_inserted; /* linked list in
insertion order */
+ /* update autosplit logic in get_file_id if fields are added or
changed */
} Hash_entry;
typedef struct hash_table
@@ -955,7 +959,6 @@
static char
hash_op (Hash_entry entry, Hash_entry** retval, bool insert)
{
- static int next_fid = 1; /* 0 is reserved */
unsigned long h = hash(entry.key, entry.key_len) % hashtable.size;
Hash_entry* found = hashtable.table[h];
@@ -1093,12 +1096,20 @@
{
Hash_entry *e = hashtable.first_inserted;
while (e) {
- emit_fid(e);
+ if ( !(e->fid_flags & NYTP_FIDf_IS_AUTOSPLIT) )
+ emit_fid(e);
e = (Hash_entry *)e->next_inserted;
}
}
+static Hash_entry *
+find_autosplit_parent(pTHX_ char* file_name)
+{
+ return NULL;
+}
+
+
/**
* Return a unique persistent id number for a file.
* If file name has not been seen before
@@ -1113,16 +1124,9 @@
get_file_id(pTHX_ char* file_name, STRLEN file_name_len, int created_via)
{
- Hash_entry entry, *found;
+ Hash_entry entry, *found, *parent_entry;
AV *src_av = Nullav;
- /* AutoLoader adds some information to Perl's internal file name that
we have
- to remove or else the file path will be borked */
- if (')' == file_name[file_name_len - 1]) {
- char* new_end = strstr(file_name, " (autosplit ");
- if (new_end)
- file_name_len = new_end - file_name;
- }
entry.key = file_name;
entry.key_len = (unsigned int)file_name_len;
@@ -1137,10 +1141,10 @@
}
/* if this is a synthetic filename for an 'eval'
- * ie "(eval 42)[/some/filename.pl:line]"
- * then ensure we've already generated an id for the underlying
- * filename
- */
+ * ie "(eval 42)[/some/filename.pl:line]"
+ * then ensure we've already generated an id for the underlying
+ * filename
+ */
if ('(' == file_name[0] && ']' == file_name[file_name_len-1]) {
char *start = strchr(file_name, '[');
const char *colon = ":";
@@ -1155,6 +1159,39 @@
/* recurse */
found->eval_fid = get_file_id(aTHX_ start, end - start,
created_via);
found->eval_line_num = atoi(end+1);
+ }
+
+ /* if the file is an autosplit, with a file_name like
+ * "../../lib/POSIX.pm (autosplit into ../../lib/auto/POSIX/errno.al)"
+ * then we want it to have the same fid as the file it was split from.
+ * Thankfully that file will almost certainly be in the fid hash,
+ * so we can find it and copy the details.
+ * We do this after the string eval check above in the (untested) hope
+ * that string evals inside autoloaded subs get treated properly! XXX
+ */
+ if ( ')' == file_name[file_name_len-1]
+ && strstr(file_name, " (autosplit ")
+ && (parent_entry = find_autosplit_parent(aTHX_ file_name))
+ ) {
+ /* copy some details from parent_entry to found */
+ found->id = parent_entry->id;
+ found->eval_fid = parent_entry->eval_fid;
+ found->eval_line_num = parent_entry->eval_line_num;
+ found->file_size = parent_entry->file_size;
+ found->file_mtime = parent_entry->file_mtime;
+ found->fid_flags = parent_entry->fid_flags;
+ /* prevent write_cached_fids() from writing this fid */
+ found->fid_flags |= NYTP_FIDf_IS_AUTOSPLIT;
+ /* avoid a gap in the fid sequence */
+ --next_fid;
+ /* write a log message if tracing */
+ if (trace_level >= 2)
+ warn("Old fid %2u (after %2u:%-4u) %x e%u:%u %.*s %s%s\n",
+ found->id, last_executed_fid, last_executed_line,
+ found->fid_flags, found->eval_fid, found->eval_line_num,
+ found->key_len, found->key, (found->key_abs) ?
found->key_abs : "");
+ /* bail out without calling emit_fid() */
+ return found->id;
}
/* determine absolute path if file_name is relative */
Modified: trunk/lib/Devel/NYTProf/FileInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/FileInfo.pm Thu Mar 5 15:16:40 2009
@@ -127,6 +127,9 @@
my $filename = $self->filename;
+ # strip of autosplit annotation, if any
+ $filename =~ s/ \(autosplit into .*//;
+
# if it's a .pmc then assume that's the file we want to look at
# (because the main use for .pmc's are related to perl6)
$filename .= "c" if $self->is_pmc;
Modified: trunk/t/test14.rdt
==============================================================================
--- trunk/t/test14.rdt (original)
+++ trunk/t/test14.rdt Thu Mar 5 15:16:40 2009
@@ -15,39 +15,41 @@
fid_block_time 1 17 [ 0 1 ]
fid_block_time 1 18 [ 0 1 ]
fid_block_time 3 7 [ 0 1 ]
-fid_block_time 3 11 0 0
-fid_block_time 3 11 1 2
-fid_block_time 3 11 2 1 [ 0 1 ]
-fid_block_time 3 14 [ 0 1 ]
+fid_block_time 3 11 [ 0 1 ]
+fid_block_time 4 11 0 0
+fid_block_time 4 11 1 1
+fid_block_time 4 11 2 1 [ 0 1 ]
+fid_block_time 4 14 [ 0 1 ]
fid_fileinfo 1 [ test14.p 1 2 0 0 ]
fid_fileinfo 1 sub main::BEGIN 16-16
fid_fileinfo 1 call 17 AutoLoader::AUTOLOAD [ 1 0 0 0 0 0 0
]
fid_fileinfo 1 call 18 AutoLoader::AUTOLOAD [ 1 0 0 0 0 0 0
]
fid_fileinfo 2 [ AutoLoader.pm 2 2 0 0 ]
-fid_fileinfo 3 [ test14.pm 3 2 0 0 ]
-fid_fileinfo 3 sub test14::BEGIN 2-2
-fid_fileinfo 3 sub test14::bar 10-12
+fid_fileinfo 3 [ test14.pm (autosplit into auto/test14/foo.al) 3 2 0
0 ]
fid_fileinfo 3 sub test14::foo 6-8
-fid_fileinfo 3 eval 11 [ 1 0 ]
-fid_fileinfo 4 [ (eval 0)[test14.pm (autosplit into
auto/test14/bar.al):11] 3 11 4 2 0 0 ]
+fid_fileinfo 4 [ test14.pm (autosplit into auto/test14/bar.al) 4 2 0
0 ]
+fid_fileinfo 4 sub test14::bar 10-12
+fid_fileinfo 4 eval 11 [ 1 0 ]
+fid_fileinfo 5 [ (eval 0)[test14.pm (autosplit into
auto/test14/bar.al):11] 4 11 5 2 0 0 ]
fid_line_time 1 17 [ 0 1 ]
fid_line_time 1 18 [ 0 1 ]
fid_line_time 3 7 [ 0 1 ]
-fid_line_time 3 11 0 0
-fid_line_time 3 11 1 2
-fid_line_time 3 11 2 1 [ 0 1 ]
-fid_line_time 3 14 [ 0 1 ]
+fid_line_time 3 11 [ 0 1 ]
+fid_line_time 4 11 0 0
+fid_line_time 4 11 1 1
+fid_line_time 4 11 2 1 [ 0 1 ]
+fid_line_time 4 14 [ 0 1 ]
fid_sub_time 1 17 [ 0 1 ]
fid_sub_time 1 18 [ 0 1 ]
fid_sub_time 3 7 [ 0 1 ]
-fid_sub_time 3 11 0 0
-fid_sub_time 3 11 1 2
-fid_sub_time 3 11 2 1 [ 0 1 ]
-fid_sub_time 3 14 [ 0 1 ]
+fid_sub_time 3 11 [ 0 1 ]
+fid_sub_time 4 11 0 0
+fid_sub_time 4 11 1 1
+fid_sub_time 4 11 2 1 [ 0 1 ]
+fid_sub_time 4 14 [ 0 1 ]
profile_modes fid_block_time block
profile_modes fid_line_time line
profile_modes fid_sub_time sub
sub_subinfo main::BEGIN [ 1 16 16 0 0 0 0 0 ]
-sub_subinfo test14::BEGIN [ 3 2 2 0 0 0 0 0 ]
-sub_subinfo test14::bar [ 3 10 12 0 0 0 0 0 ]
+sub_subinfo test14::bar [ 4 10 12 0 0 0 0 0 ]
sub_subinfo test14::foo [ 3 6 8 0 0 0 0 0 ]
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
