return (char *)from;
}
-/* return ptr to little string in big string, NULL if not found */
-/* This routine was donated by Corey Satten. */
-
-char *
-Perl_instr(const char *big, const char *little)
-{
-
- PERL_ARGS_ASSERT_INSTR;
-
- return strstr((char*)big, (char*)little);
-}
-
/*
=head1 Miscellaneous Functions
Perl_ninstr(const char *big, const char *bigend, const char *little, const char *lend)
{
PERL_ARGS_ASSERT_NINSTR;
+
+#ifdef HAS_MEMMEM
+ return ninstr(big, bigend, little, lend);
+#else
+
if (little >= lend)
return (char*)big;
{
}
}
return NULL;
+
+#endif
+
}
/*
const char *filename, const int linenumber,
const char *funcname)
{
+ PERL_ARGS_ASSERT_MEM_LOG_ALLOC;
+
mem_log_common_if(MLT_ALLOC, n, typesize, type_name,
NULL, NULL, newalloc,
filename, linenumber, funcname);
const char *filename, const int linenumber,
const char *funcname)
{
+ PERL_ARGS_ASSERT_MEM_LOG_REALLOC;
+
mem_log_common_if(MLT_REALLOC, n, typesize, type_name,
NULL, oldalloc, newalloc,
filename, linenumber, funcname);
const char *filename, const int linenumber,
const char *funcname)
{
+ PERL_ARGS_ASSERT_MEM_LOG_FREE;
+
mem_log_common_if(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL,
filename, linenumber, funcname);
return oldalloc;
*source_name_size = source_name_end - p;
if (grok_atoUV(source_number_start, &uv, &source_line_end)
&& source_line_end == close_paren
- && uv <= MAX_STRLEN
+ && uv <= PERL_INT_MAX
) {
*source_line = (STRLEN)uv;
return p;
char out[1024];
UV cnt = fread(out, 1, sizeof(out), fp);
if (cnt < sizeof(out)) {
- const char* p = atos_parse(out + cnt, out,
+ const char* p = atos_parse(out + cnt - 1, out,
source_name_size,
source_line);
if (p) {
Newx(*source_name,
- *source_name_size + 1, char);
+ *source_name_size, char);
Copy(p, *source_name,
- *source_name_size + 1, char);
+ *source_name_size, char);
}
}
pclose(fp);
for (i = skip; i < try_depth; i++) {
Dl_info* dl_info = &dl_infos[i];
- total_bytes += sizeof(Perl_c_backtrace_frame);
-
+ object_name_sizes[i] = 0;
source_names[i] = NULL;
source_name_sizes[i] = 0;
source_lines[i] = 0;
/* Yes, zero from dladdr() is failure. */
if (dladdr(raw_frames[i], dl_info)) {
+ total_bytes += sizeof(Perl_c_backtrace_frame);
+
object_name_sizes[i] =
dl_info->dli_fname ? strlen(dl_info->dli_fname) : 0;
symbol_name_sizes[i] =
#endif
+
+#ifdef USE_DTRACE
+
+/* log a sub call or return */
+
+void
+Perl_dtrace_probe_call(pTHX_ CV *cv, bool is_call)
+{
+ const char *func;
+ const char *file;
+ const char *stash;
+ const COP *start;
+ line_t line;
+
+ PERL_ARGS_ASSERT_DTRACE_PROBE_CALL;
+
+ if (CvNAMED(cv)) {
+ HEK *hek = CvNAME_HEK(cv);
+ func = HEK_KEY(hek);
+ }
+ else {
+ GV *gv = CvGV(cv);
+ func = GvENAME(gv);
+ }
+ start = (const COP *)CvSTART(cv);
+ file = CopFILE(start);
+ line = CopLINE(start);
+ stash = CopSTASHPV(start);
+
+ if (is_call) {
+ PERL_SUB_ENTRY(func, file, line, stash);
+ }
+ else {
+ PERL_SUB_RETURN(func, file, line, stash);
+ }
+}
+
+
+/* log a require file loading/loaded */
+
+void
+Perl_dtrace_probe_load(pTHX_ const char *name, bool is_loading)
+{
+ PERL_ARGS_ASSERT_DTRACE_PROBE_LOAD;
+
+ if (is_loading) {
+ PERL_LOADING_FILE(name);
+ }
+ else {
+ PERL_LOADED_FILE(name);
+ }
+}
+
+
+/* log an op execution */
+
+void
+Perl_dtrace_probe_op(pTHX_ const OP *op)
+{
+ PERL_ARGS_ASSERT_DTRACE_PROBE_OP;
+
+ PERL_OP_ENTRY(OP_NAME(op));
+}
+
+
+/* log a compile/run phase change */
+
+void
+Perl_dtrace_probe_phase(pTHX_ enum perl_phase phase)
+{
+ const char *ph_old = PL_phase_names[PL_phase];
+ const char *ph_new = PL_phase_names[phase];
+
+ PERL_PHASE_CHANGE(ph_new, ph_old);
+}
+
+#endif
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/