Devel-NYTProf
view release on metacpan or search on metacpan
}
case 'i':
{
I32 i32 = va_arg(args, I32);
sv_setuv(cb_args[i], i32);
XPUSHs(cb_args[i++]);
break;
}
case 'n':
{
NV n = va_arg(args, NV);
sv_setnv(cb_args[i], n);
XPUSHs(cb_args[i++]);
break;
}
case 's':
{
SV *sv = va_arg(args, SV *);
sv_setsv(cb_args[i], sv);
XPUSHs(cb_args[i++]);
break;
}
case 'S':
{
SV *sv = va_arg(args, SV *);
XPUSHs(sv_2mortal(sv));
break;
}
case '3':
{
char *p = va_arg(args, char *);
unsigned long len = va_arg(args, unsigned long);
unsigned int utf8 = va_arg(args, unsigned int);
sv_setpvn(cb_args[i], p, len);
if (utf8)
SvUTF8_on(cb_args[i]);
else
SvUTF8_off(cb_args[i]);
XPUSHs(cb_args[i++]);
break;
}
default:
croak("Bad type '%c' in perl callback", type);
}
}
va_end(args);
assert(i <= C_ARRAY_LENGTH(state->cb_args));
PUTBACK;
call_sv((SV *)state->cb[tag], G_DISCARD);
}
static loader_callback perl_callbacks[nytp_tag_max] =
{
0,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback,
load_perl_callback
};
static loader_callback processing_callbacks[nytp_tag_max] =
{
0,
0, /* version */
load_attribute_callback,
load_option_callback,
0, /* comment */
load_time_callback,
load_time_callback,
load_discount_callback,
load_new_fid_callback,
load_src_line_callback,
load_sub_info_callback,
load_sub_callers_callback,
load_pid_start_callback,
load_pid_end_callback,
0, /* string */
0, /* string utf8 */
0, /* sub entry */
0, /* sub return */
0 /* start deflate */
};
/**
* Process a profile output file and return the results in a hash like
* { fid_fileinfo => [ [file, other...info ], ... ], # index by [fid]
* fid_line_time => [ [...],[...],.. ] # index by [fid][line]
* }
* The value of each [fid][line] is an array ref containing:
* [ number of calls, total time spent ]
* lines containing string evals also get an extra element
* [ number of calls, total time spent, [...] ]
* which is an reference to an array containing the [calls,time]
* data for each line of the string eval.
*/
static void
load_profile_data_from_stream(pTHX_ loader_callback *callbacks,
Loader_state_base *state, NYTP_file in)
{
int file_major, file_minor;
SV *tmp_str1_sv = newSVpvn("",0);
SV *tmp_str2_sv = newSVpvn("",0);
size_t buffer_len = MAXPATHLEN * 2;
char *buffer = (char *)safemalloc(buffer_len);
if (1) {
if (!NYTP_gets(in, &buffer, &buffer_len))
croak("NYTProf data format error while reading header");
if (2 != sscanf(buffer, "NYTProf %d %d\n", &file_major, &file_minor))
croak("NYTProf data format error while parsing header");
if (file_major != NYTP_FILE_MAJOR_VERSION)
croak("NYTProf data format version %d.%d is not supported by NYTProf %s (which expects version %d.%d)",
file_major, file_minor, XS_VERSION, NYTP_FILE_MAJOR_VERSION, NYTP_FILE_MINOR_VERSION);
if (file_minor > NYTP_FILE_MINOR_VERSION)
warn("NYTProf data format version %d.%d is newer than that understood by this NYTProf %s, so errors are likely",
file_major, file_minor, XS_VERSION);
}
if (callbacks[nytp_version])
callbacks[nytp_version](state, nytp_version, file_major, file_minor);
while (1) {
/* Loop "forever" until EOF. We can only check the EOF flag *after* we
attempt a read. */
char c;
if (NYTP_read_unchecked(in, &c, sizeof(c)) != sizeof(c)) {
if (NYTP_eof(in))
break;
croak("Profile format error '%s' whilst reading tag at %ld (see TROUBLESHOOTING in NYTProf docs)",
NYTP_fstrerror(in), NYTP_tell(in));
}
state->input_chunk_seqn++;
if (trace_level >= 9)
logwarn("Chunk %lu token is %d ('%c') at %ld%s\n",
state->input_chunk_seqn, c, c, NYTP_tell(in)-1,
NYTP_type_of_offset(in));
switch (c) {
case NYTP_TAG_DISCOUNT:
{
callbacks[nytp_discount](state, nytp_discount);
break;
}
case NYTP_TAG_TIME_LINE: /*FALLTHRU*/
case NYTP_TAG_TIME_BLOCK:
{
I32 ticks = read_i32(in);
unsigned int file_num = read_u32(in);
unsigned int line_num = read_u32(in);
unsigned int block_line_num = 0;
unsigned int sub_line_num = 0;
nytp_tax_index tag = nytp_time_line;
if (c == NYTP_TAG_TIME_BLOCK) {
block_line_num = read_u32(in);
sub_line_num = read_u32(in);
tag = nytp_time_block;
}
/* Because it happens that the two "optional" arguments are
last, a single call will work. */
callbacks[tag](state, tag, ticks, file_num, line_num,
block_line_num, sub_line_num);
break;
}
case NYTP_TAG_NEW_FID: /* file */
{
SV *filename_sv;
unsigned int file_num = read_u32(in);
unsigned int eval_file_num = read_u32(in);
unsigned int eval_line_num = read_u32(in);
unsigned int fid_flags = read_u32(in);
unsigned int file_size = read_u32(in);
unsigned int file_mtime = read_u32(in);
filename_sv = read_str(aTHX_ in, NULL);
callbacks[nytp_new_fid](state, nytp_new_fid, file_num,
eval_file_num, eval_line_num,
fid_flags, file_size, file_mtime,
filename_sv);
break;
}
case NYTP_TAG_SRC_LINE:
{
unsigned int file_num = read_u32(in);
unsigned int line_num = read_u32(in);
SV *src = read_str(aTHX_ in, NULL);
callbacks[nytp_src_line](state, nytp_src_line, file_num,
line_num, src);
break;
}
case NYTP_TAG_SUB_ENTRY:
{
unsigned int file_num = read_u32(in);
unsigned int line_num = read_u32(in);
if (callbacks[nytp_sub_entry])
callbacks[nytp_sub_entry](state, nytp_sub_entry, file_num, line_num);
break;
}
case NYTP_TAG_SUB_RETURN:
{
unsigned int depth = read_u32(in);
NV incl_time = read_nv(in);
NV excl_time = read_nv(in);
SV *subname = read_str(aTHX_ in, tmp_str1_sv);
if (callbacks[nytp_sub_return])
callbacks[nytp_sub_return](state, nytp_sub_return, depth, incl_time, excl_time, subname);
break;
}
case NYTP_TAG_SUB_INFO:
{
unsigned int fid = read_u32(in);
SV *subname_sv = read_str(aTHX_ in, tmp_str1_sv);
unsigned int first_line = read_u32(in);
unsigned int last_line = read_u32(in);
callbacks[nytp_sub_info](state, nytp_sub_info, fid,
first_line, last_line, subname_sv);
break;
}
case NYTP_TAG_SUB_CALLERS:
{
unsigned int fid = read_u32(in);
unsigned int line = read_u32(in);
SV *caller_subname_sv = read_str(aTHX_ in, tmp_str2_sv);
unsigned int count = read_u32(in);
NV incl_time = read_nv(in);
NV excl_time = read_nv(in);
NV reci_time = read_nv(in);
unsigned int rec_depth = read_u32(in);
SV *called_subname_sv = read_str(aTHX_ in, tmp_str1_sv);
callbacks[nytp_sub_callers](state, nytp_sub_callers, fid,
line, count, incl_time, excl_time,
reci_time, rec_depth,
called_subname_sv,
caller_subname_sv);
break;
}
case NYTP_TAG_PID_START:
{
unsigned int pid = read_u32(in);
unsigned int ppid = read_u32(in);
NV start_time = read_nv(in);
callbacks[nytp_pid_start](state, nytp_pid_start, pid, ppid,
start_time);
break;
}
case NYTP_TAG_PID_END:
{
unsigned int pid = read_u32(in);
NV end_time = read_nv(in);
callbacks[nytp_pid_end](state, nytp_pid_end, pid, end_time);
break;
}
case NYTP_TAG_ATTRIBUTE:
{
char *value, *key_end;
char *end = NYTP_gets(in, &buffer, &buffer_len);
if (NULL == end)
/* probably EOF */
croak("Profile format error reading attribute (see TROUBLESHOOTING in NYTProf docs)");
--end; /* End, as returned, points 1 after the \n */
if ((NULL == (value = (char *)memchr(buffer, '=', end - buffer)))) {
logwarn("attribute malformed '%s'\n", buffer);
continue;
}
key_end = value++;
callbacks[nytp_attribute](state, nytp_attribute, buffer,
(unsigned long)(key_end - buffer),
0, value,
(unsigned long)(end - value), 0);
if (memEQs(buffer, key_end - buffer, "ticks_per_sec")) {
ticks_per_sec = (unsigned int)atoi(value);
}
else if (memEQs(buffer, key_end - buffer, "nv_size")) {
if (sizeof(NV) != atoi(value))
croak("Profile data created by incompatible perl config (NV size %d but ours is %d)",
atoi(value), (int)sizeof(NV));
}
break;
}
case NYTP_TAG_OPTION:
{
char *value, *key_end;
char *end = NYTP_gets(in, &buffer, &buffer_len);
if (NULL == end)
/* probably EOF */
croak("Profile format error reading attribute (see TROUBLESHOOTING in NYTProf docs)");
--end; /* end, as returned, points 1 after the \n */
if ((NULL == (value = (char *)memchr(buffer, '=', end - buffer)))) {
logwarn("option malformed '%s'\n", buffer);
continue;
}
key_end = value++;
callbacks[nytp_option](state, nytp_option, buffer,
(unsigned long)(key_end - buffer),
0, value,
(unsigned long)(end - value), 0);
break;
}
case NYTP_TAG_COMMENT:
{
char *end = NYTP_gets(in, &buffer, &buffer_len);
if (!end)
/* probably EOF */
croak("Profile format error reading comment (see TROUBLESHOOTING in NYTProf docs)");
if (callbacks[nytp_comment])
callbacks[nytp_comment](state, nytp_comment, buffer,
(unsigned long)(end - buffer), 0);
if (trace_level >= 1)
logwarn("# %s", buffer); /* includes \n */
break;
}
case NYTP_TAG_START_DEFLATE:
{
#ifdef HAS_ZLIB
if (callbacks[nytp_start_deflate]) {
callbacks[nytp_start_deflate](state, nytp_start_deflate);
}
NYTP_start_inflate(in);
#else
croak("File uses compression but compression is not supported by this build of NYTProf");
#endif
break;
}
default:
croak("Profile format error: token %d ('%c'), chunk %lu, pos %ld%s (see TROUBLESHOOTING in NYTProf docs)",
c, c, state->input_chunk_seqn, NYTP_tell(in)-1,
NYTP_type_of_offset(in));
}
}
sv_free(tmp_str1_sv);
sv_free(tmp_str2_sv);
Safefree(buffer);
}
static HV*
load_profile_to_hv(pTHX_ NYTP_file in)
{
Loader_state_profiler state;
HV *profile_hv;
HV *profile_modes;
Zero(&state, 1, Loader_state_profiler);
state.total_stmts_duration = 0.0;
state.profiler_start_time = 0.0;
state.profiler_end_time = 0.0;
state.profiler_duration = 0.0;
#ifdef MULTIPLICITY
state.interp = my_perl;
#endif
state.fid_line_time_av = newAV();
state.fid_srclines_av = newAV();
state.fid_fileinfo_av = newAV();
state.sub_subinfo_hv = newHV();
state.live_pids_hv = newHV();
state.attr_hv = newHV();
state.option_hv = newHV();
state.file_info_stash = gv_stashpv("Devel::NYTProf::FileInfo", GV_ADDWARN);
av_extend(state.fid_fileinfo_av, 64); /* grow them up front. */
av_extend(state.fid_srclines_av, 64);
av_extend(state.fid_line_time_av, 64);
load_profile_data_from_stream(aTHX_ processing_callbacks,
(Loader_state_base *)&state, in);
if (HvKEYS(state.live_pids_hv)) {
logwarn("Profile data incomplete, no terminator for %" IVdf " pids %s\n",
(IV)HvKEYS(state.live_pids_hv),
"(refer to TROUBLESHOOTING in the NYTProf documentation)");
store_attrib_sv(aTHX_ state.attr_hv, STR_WITH_LEN("complete"),
&PL_sv_no);
}
else {
store_attrib_sv(aTHX_ state.attr_hv, STR_WITH_LEN("complete"),
&PL_sv_yes);
}
sv_free((SV*)state.live_pids_hv);
if (state.statement_discount) /* discard unused statement_discount */
state.total_stmts_discounted -= state.statement_discount;
store_attrib_sv(aTHX_ state.attr_hv, STR_WITH_LEN("total_stmts_measured"),
newSVnv(state.total_stmts_measured));
store_attrib_sv(aTHX_ state.attr_hv, STR_WITH_LEN("total_stmts_discounted"),
newSVnv(state.total_stmts_discounted));
store_attrib_sv(aTHX_ state.attr_hv, STR_WITH_LEN("total_stmts_duration"),
newSVnv(state.total_stmts_duration));
store_attrib_sv(aTHX_ state.attr_hv, STR_WITH_LEN("total_sub_calls"),
newSVnv(state.total_sub_calls));
if (1) {
int show_summary_stats = (trace_level >= 1);
if (state.profiler_end_time
&& state.total_stmts_duration > state.profiler_duration * 1.1
/* GetSystemTimeAsFiletime/gettimeofday_nv on Win32 have 15.625 ms resolution
by default. 1 ms best case scenario if you use special options which Perl
land doesn't use, and MS strongly discourages in
"Timers, Timer Resolution, and Development of Efficient Code". So for short
programs profiler_duration winds up being 0. If necessery, in the future
profiler_duration could be set to 15.625 ms automatically on NYTProf start
because of the argument that a process can not execute in 0 ms according to
the laws of space and time, or at "the end" if profiler_duration is 0.0, set
it to 15.625 ms*/
#ifdef HAS_QPC
&& state.profiler_duration != 0.0
#endif
) {
logwarn("The sum of the statement timings is %.1" NVff "%% of the total time profiling."
" (Values slightly over 100%% can be due simply to cumulative timing errors,"
" whereas larger values can indicate a problem with the clock used.)\n",
state.total_stmts_duration / state.profiler_duration * 100);
show_summary_stats = 1;
}
if (show_summary_stats)
logwarn("Summary: statements profiled %lu (=%lu-%lu), sum of time %" NVff "s, profile spanned %" NVff "s\n",
(unsigned long)(state.total_stmts_measured - state.total_stmts_discounted),
(unsigned long)state.total_stmts_measured, (unsigned long)state.total_stmts_discounted,
state.total_stmts_duration,
state.profiler_end_time - state.profiler_start_time);
}
{
Loader_state_callback state;
int i;
HV *cb_hv = NULL;
CV *default_cb = NULL;
if (SvTYPE(cb) == SVt_PVHV) {
/* A default callback is stored with an empty key. */
SV **svp;
cb_hv = (HV *)cb;
svp = hv_fetch(cb_hv, "", 0, 0);
if (svp) {
if (!SvROK(*svp) && SvTYPE(SvRV(*svp)) != SVt_PVCV)
croak("Default callback is not a CODE reference");
default_cb = (CV *)SvRV(*svp);
}
} else if (SvTYPE(cb) == SVt_PVCV) {
default_cb = (CV *) cb;
} else
croak("Not a CODE or HASH reference");
#ifdef MULTIPLICITY
state.interp = my_perl;
#endif
state.base_state.input_chunk_seqn = 0;
state.input_chunk_seqn_sv = save_scalar(gv_fetchpv(".", GV_ADD, SVt_IV));
i = C_ARRAY_LENGTH(state.tag_names);
while (--i) {
if (callback_info[i].args) {
state.tag_names[i]
= newSVpvn_flags(callback_info[i].description,
callback_info[i].len, SVs_TEMP);
SvREADONLY_on(state.tag_names[i]);
/* Don't steal the string buffer. */
SvTEMP_off(state.tag_names[i]);
} else
state.tag_names[i] = NULL;
if (cb_hv) {
SV **svp = hv_fetch(cb_hv, callback_info[i].description,
(I32)(callback_info[i].len), 0);
if (svp) {
if (!SvROK(*svp) && SvTYPE(SvRV(*svp)) != SVt_PVCV)
croak("Callback for %s is not a CODE reference",
callback_info[i].description);
state.cb[i] = (CV *)SvRV(*svp);
} else
state.cb[i] = default_cb;
} else
state.cb[i] = default_cb;
}
for (i = 0; i < C_ARRAY_LENGTH(state.cb_args); i++)
state.cb_args[i] = sv_newmortal();
load_profile_data_from_stream(aTHX_ perl_callbacks, (Loader_state_base *)&state,
in);
}
struct int_constants_t {
const char *name;
int value;
};
static struct int_constants_t int_constants[] = {
/* NYTP_FIDf_* */
{"NYTP_FIDf_IS_PMC", NYTP_FIDf_IS_PMC},
{"NYTP_FIDf_VIA_STMT", NYTP_FIDf_VIA_STMT},
{"NYTP_FIDf_VIA_SUB", NYTP_FIDf_VIA_SUB},
{"NYTP_FIDf_IS_AUTOSPLIT", NYTP_FIDf_IS_AUTOSPLIT},
{"NYTP_FIDf_HAS_SRC", NYTP_FIDf_HAS_SRC},
{"NYTP_FIDf_SAVE_SRC", NYTP_FIDf_SAVE_SRC},
{"NYTP_FIDf_IS_ALIAS", NYTP_FIDf_IS_ALIAS},
{"NYTP_FIDf_IS_FAKE", NYTP_FIDf_IS_FAKE},
{"NYTP_FIDf_IS_EVAL", NYTP_FIDf_IS_EVAL},
/* NYTP_FIDi_* */
{"NYTP_FIDi_FILENAME", NYTP_FIDi_FILENAME},
{"NYTP_FIDi_EVAL_FID", NYTP_FIDi_EVAL_FID},
{"NYTP_FIDi_EVAL_LINE", NYTP_FIDi_EVAL_LINE},
{"NYTP_FIDi_FID", NYTP_FIDi_FID},
{"NYTP_FIDi_FLAGS", NYTP_FIDi_FLAGS},
{"NYTP_FIDi_FILESIZE", NYTP_FIDi_FILESIZE},
{"NYTP_FIDi_FILEMTIME", NYTP_FIDi_FILEMTIME},
{"NYTP_FIDi_PROFILE", NYTP_FIDi_PROFILE},
{"NYTP_FIDi_EVAL_FI", NYTP_FIDi_EVAL_FI},
{"NYTP_FIDi_HAS_EVALS", NYTP_FIDi_HAS_EVALS},
{"NYTP_FIDi_SUBS_DEFINED", NYTP_FIDi_SUBS_DEFINED},
{"NYTP_FIDi_SUBS_CALLED", NYTP_FIDi_SUBS_CALLED},
{"NYTP_FIDi_elements", NYTP_FIDi_elements},
/* NYTP_SIi_* */
{"NYTP_SIi_FID", NYTP_SIi_FID},
{"NYTP_SIi_FIRST_LINE", NYTP_SIi_FIRST_LINE},
{"NYTP_SIi_LAST_LINE", NYTP_SIi_LAST_LINE},
{"NYTP_SIi_CALL_COUNT", NYTP_SIi_CALL_COUNT},
{"NYTP_SIi_INCL_RTIME", NYTP_SIi_INCL_RTIME},
{"NYTP_SIi_EXCL_RTIME", NYTP_SIi_EXCL_RTIME},
{"NYTP_SIi_SUB_NAME", NYTP_SIi_SUB_NAME},
{"NYTP_SIi_PROFILE", NYTP_SIi_PROFILE},
{"NYTP_SIi_REC_DEPTH", NYTP_SIi_REC_DEPTH},
{"NYTP_SIi_RECI_RTIME", NYTP_SIi_RECI_RTIME},
{"NYTP_SIi_CALLED_BY", NYTP_SIi_CALLED_BY},
{"NYTP_SIi_elements", NYTP_SIi_elements},
/* NYTP_SCi_* */
{"NYTP_SCi_CALL_COUNT", NYTP_SCi_CALL_COUNT},
{"NYTP_SCi_INCL_RTIME", NYTP_SCi_INCL_RTIME},
{"NYTP_SCi_EXCL_RTIME", NYTP_SCi_EXCL_RTIME},
{"NYTP_SCi_INCL_TICKS", NYTP_SCi_INCL_TICKS},
{"NYTP_SCi_EXCL_TICKS", NYTP_SCi_EXCL_TICKS},
{"NYTP_SCi_RECI_RTIME", NYTP_SCi_RECI_RTIME},
{"NYTP_SCi_REC_DEPTH", NYTP_SCi_REC_DEPTH},
{"NYTP_SCi_CALLING_SUB", NYTP_SCi_CALLING_SUB},
{"NYTP_SCi_elements", NYTP_SCi_elements},
/* others */
{"NYTP_DEFAULT_COMPRESSION", default_compression_level},
{"NYTP_FILE_MAJOR_VERSION", NYTP_FILE_MAJOR_VERSION},
{"NYTP_FILE_MINOR_VERSION", NYTP_FILE_MINOR_VERSION},
( run in 0.818 second using v1.01-cache-2.11-cpan-bbe5e583499 )