Integrate mainline

[p5sagit/p5-mst-13.2.git] / ext / Devel / DProf / DProf.xs

diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 31e984f..3380d78 100644 (file)
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -3,11 +3,6 @@
 #include "perl.h"
 #include "XSUB.h"
 
-/* For older Perls */
-#ifndef dTHR
-#  define dTHR int dummy_thr
-#endif /* dTHR */ 
-
 /*#define DBG_SUB 1      */
 /*#define DBG_TIMER 1    */
 
@@ -28,6 +23,7 @@
 #  define HZ ((I32)CLK_TCK)
 #  define DPROF_HZ HZ
 #  include <starlet.h>  /* prototype for sys$gettim() */
+#  include <lib$routines.h>
 #  define Times(ptr) (dprof_times(aTHX_ ptr))
 #else
 #  ifndef HZ
@@ -91,7 +87,7 @@ typedef struct {
     U32                total;
     U32                lastid;
     U32                default_perldb;
-    U32                depth;
+    UV         depth;
 #ifdef OS2
     ULONG      frequ;
     long long  start_cnt;
@@ -280,10 +276,6 @@ prof_mark(pTHX_ opcode ptype)
 {
     struct tms t;
     clock_t realtime, rdelta, udelta, sdelta;
-    char *name, *pv;
-    char *hvname;
-    STRLEN len;
-    SV *sv;
     U32 id;
     SV *Sub = GvSV(PL_DBsub);  /* name of current sub */
 
@@ -388,12 +380,11 @@ prof_mark(pTHX_ opcode ptype)
 static void
 test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s)
 {
-    dTHR;
     CV *cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE);
     int i, j, k = 0;
     HV *oldstash = PL_curstash;
     struct tms t1, t2;
-    clock_t realtime1, realtime2;
+    clock_t realtime1 = 0, realtime2 = 0;
     U32 ototal = g_total;
     U32 ostack = g_SAVE_STACK;
     U32 operldb = PL_perldb;
@@ -477,8 +468,6 @@ prof_record(pTHX)
     /* Now that we know the runtimes, fill them in at the recorded
        location -JH */
 
-    clock_t r, u, s;
-
     if (g_SAVE_STACK) {
        prof_dump_until(aTHX_ g_profstack_ix);
     }
@@ -502,13 +491,13 @@ prof_record(pTHX)
 static void
 check_depth(pTHX_ void *foo)
 {
-    U32 need_depth = (U32)foo;
+    U32 need_depth = PTR2UV(foo);
     if (need_depth != g_depth) {
        if (need_depth > g_depth) {
            warn("garbled call depth when profiling");
        }
        else {
-           I32 marks = g_depth - need_depth;
+           IV marks = g_depth - need_depth;
 
 /*         warn("Check_depth: got %d, expected %d\n", g_depth, need_depth); */
            while (marks--) {
@@ -524,7 +513,7 @@ check_depth(pTHX_ void *foo)
 
 XS(XS_DB_sub)
 {
-    dXSARGS;
+    dMARK;
     dORIGMARK;
     SV *Sub = GvSV(PL_DBsub);          /* name of current sub */
 
@@ -532,7 +521,7 @@ XS(XS_DB_sub)
     /* profile only the interpreter that loaded us */
     if (g_THX != aTHX) {
         PUSHMARK(ORIGMARK);
-        perl_call_sv(INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG);
+        perl_call_sv(INT2PTR(SV*,SvIV(Sub)), GIMME_V | G_NODEBUG);
     }
     else
 #endif
@@ -541,12 +530,13 @@ XS(XS_DB_sub)
 
         DBG_SUB_NOTIFY("XS DBsub(%s)\n", SvPV_nolen(Sub));
 
-       SAVEDESTRUCTOR_X(check_depth, (void*)g_depth);
+       SAVEDESTRUCTOR_X(check_depth, INT2PTR(void*,g_depth));
        g_depth++;
 
         prof_mark(aTHX_ OP_ENTERSUB);
         PUSHMARK(ORIGMARK);
-        perl_call_sv(INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG);
+        perl_call_sv(INT2PTR(SV*,SvIV(Sub)), GIMME_V | G_NODEBUG);
+        PL_curstash = oldstash;
         prof_mark(aTHX_ OP_LEAVESUB);
        g_depth--;
     }
@@ -586,7 +576,7 @@ XS(XS_DB_goto)
                 PUSHMARK(ORIGMARK);
 
                 PL_curstash = PL_debstash;     /* To disable debugging of perl_call_sv */
-                perl_call_sv(Sub, GIMME);
+                perl_call_sv(Sub, GIMME_V);
                 PL_curstash = oldstash;
 
                 prof_mark(aTHX_ OP_LEAVESUB);