WIP dtrace stuff

tonycoz · Mar 14, 2024 · 623d1bd · 623d1bd
1 parent 08ec9d9
commit 623d1bd
Show file tree

Hide file tree

Showing 6 changed files with 39 additions and 0 deletions.
diff --git a/embed.fnc b/embed.fnc
@@ -6154,6 +6154,8 @@ Adp	|SV *	|get_c_backtrace_dump					\
 EXop	|void	|dtrace_probe_call					\
 				|NN CV *cv				\
 				|bool is_call
+EXop	|void	|dtrace_probe_line_number				\
+				|NN const COP *cop
 EXop	|void	|dtrace_probe_load					\
 				|NN const char *name			\
 				|bool is_loading

diff --git a/mydtrace.h b/mydtrace.h
@@ -37,6 +37,30 @@
     if (PERL_OP_ENTRY_ENABLED())                    \
         Perl_dtrace_probe_phase(aTHX_ phase);
 
+#  define PERL_DTRACE_PROBE_LINE_NUMBER(cop)           \
+    if (PERL_LINE_NUMBER_ENABLED())                 \
+        Perl_dtrace_probe_line_number(aTHX_ cop)
+
+#  define PERL_DTRACE_SAFESYSMALLOC(size, addr, num) \
+    if (PERL_SAFESYSMALLOC_ENABLED())                \
+        PERL_SAFESYSMALLOC(size, addr, num)
+
+#  define PERL_DTRACE_SAFESYSCALLOC(size, count, addr, num) \
+    if (PERL_SAFESYSCALLOC_ENABLED())                       \
+        PERL_SAFESYSCALLOC(size, count, (unsigned long)addr, num)
+
+#  define PERL_DTRACE_SAFESYSFREE(addr, num)         \
+    if (PERL_SAFESYSFREE_ENABLED())                  \
+        PERL_SAFESYSFREE((unsigned long)(addr), num)
+
+#  define PERL_DTRACE_SAFESYSREALLOC_FREE(addr, num)         \
+    if (PERL_SAFESYSREALLOC_FREE_ENABLED())                  \
+        PERL_SAFESYSREALLOC_FREE((unsigned long)(addr), num)
+
+#  define PERL_DTRACE_SAFESYSREALLOC_ALLOC(size, addr, num) \
+    if (PERL_SAFESYSREALLOC_ALLOC_ENABLED())                \
+        PERL_SAFESYSREALLOC_ALLOC(size, addr, num)
+
 #else
 
 /* NOPs */

diff --git a/pp_ctl.c b/pp_ctl.c
@@ -2366,6 +2366,7 @@ PP(pp_dbstate)
     FREETMPS;
 
     PERL_ASYNC_CHECK();
+    PERL_DTRACE_PROBE_LINE_NUMBER(PL_curcop);
 
     if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */
             || PL_DBsingle_iv || PL_DBsignal_iv || PL_DBtrace_iv)

diff --git a/pp_hot.c b/pp_hot.c
@@ -235,6 +235,7 @@ PP(pp_nextstate)
     rpp_popfree_to_NN(PL_stack_base + CX_CUR()->blk_oldsp);
     FREETMPS;
     PERL_ASYNC_CHECK();
+    PERL_DTRACE_PROBE_LINE_NUMBER(PL_curcop);
     return NORMAL;
 }
 

diff --git a/proto.h b/proto.h
diff --git a/util.c b/util.c
@@ -6747,6 +6747,12 @@ Perl_dtrace_probe_phase(pTHX_ enum perl_phase phase)
     PERL_PHASE_CHANGE(ph_new, ph_old);
 }
 
+void
+Perl_dtrace_probe_line_number(pTHX_ const COP *cop)
+{
+    PERL_LINE_NUMBER(CopFILE(cop), CopLINE(cop));
+}
+
 #endif
 
 /*
-Original file line number
+Diff line change
@@ Expand Up / @@ -6747,6 +6747,12 @@ Perl_dtrace_probe_phase(pTHX_ enum perl_phase phase) @@
         PERL_PHASE_CHANGE(ph_new, ph_old);
     }
+    void
+    Perl_dtrace_probe_line_number(pTHX_ const COP *cop)
+    {
+        PERL_LINE_NUMBER(CopFILE(cop), CopLINE(cop));
+    }
     #endif
     /*
@@ Expand Down @@