]> git.vpit.fr Git - perl/modules/Scope-Upper.git/commitdiff
Factor a part of the debugging logic into an helper function
authorVincent Pit <vince@profvince.com>
Tue, 18 Aug 2015 13:40:09 +0000 (10:40 -0300)
committerVincent Pit <vince@profvince.com>
Tue, 18 Aug 2015 13:40:09 +0000 (10:40 -0300)
Upper.xs

index c2036cce24e91c10f65fee5a780693e95f5cbcb0..f85cc54d6db3294fb905092cf9a2545115230fe3 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
 
 #if SU_DEBUG
 # define SU_D(X) STMT_START X STMT_END
+static void su_debug_log(const char *fmt, ...) {
+ va_list va;
+ dTHX;
+ va_start(va, fmt);
+ PerlIO_vprintf(Perl_debug_log, fmt, va);
+ va_end(va);
+ return;
+}
 #else
 # define SU_D(X)
 #endif
@@ -761,11 +769,8 @@ static void su_call(pTHX_ SV *cb) {
 
  dSP;
 
- SU_D({
-  PerlIO_printf(Perl_debug_log,
-                "@@@ call scope_ix=%2d save_ix=%2d\n",
-                PL_scopestack_ix, PL_savestack_ix);
- });
+ SU_D(su_debug_log("@@@ call scope_ix=%2d save_ix=%2d\n",
+                         PL_scopestack_ix, PL_savestack_ix));
 
  ENTER;
  SAVETMPS;
@@ -922,10 +927,9 @@ static void su_localize(pTHX_ void *ud_) {
  SU_D({
   SV *z = newSV(0);
   SvUPGRADE(z, t);
-  PerlIO_printf(Perl_debug_log, "%p: === localize a %s\n",ud, sv_reftype(z, 0));
-  PerlIO_printf(Perl_debug_log,
-                "%p: depth=%2d scope_ix=%2d save_ix=%2d\n",
-                 ud, SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix);
+  su_debug_log("%p: === localize a %s\n",ud, sv_reftype(z, 0));
+  su_debug_log("%p: depth=%2d scope_ix=%2d save_ix=%2d\n",
+                ud, SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix);
   SvREFCNT_dec(z);
  });
 
@@ -1036,21 +1040,19 @@ static void su_pop(pTHX_ void *ud) {
  I32 depth, base, mark, *origin;
  depth = SU_UD_DEPTH(ud);
 
- SU_D(
-  PerlIO_printf(Perl_debug_log,
-   "%p: --- pop a %s\n"
-   "%p: leave scope     at depth=%2d scope_ix=%2d cur_top=%2d cur_base=%2d\n",
-    ud, SU_CXNAME(cxstack + cxstack_ix),
-    ud, depth, PL_scopestack_ix,PL_savestack_ix,PL_scopestack[PL_scopestack_ix])
- );
+ SU_D(su_debug_log(
+  "%p: --- pop a %s\n"
+  "%p: leave scope     at depth=%2d scope_ix=%2d cur_top=%2d cur_base=%2d\n",
+   ud, SU_CXNAME(cxstack + cxstack_ix),
+   ud, depth, PL_scopestack_ix,PL_savestack_ix,PL_scopestack[PL_scopestack_ix]
+ ));
 
  origin = SU_UD_ORIGIN(ud);
  mark   = origin[depth];
  base   = origin[depth - 1];
 
- SU_D(PerlIO_printf(Perl_debug_log,
-                    "%p: original scope was %*c top=%2d     base=%2d\n",
-                     ud,                24, ' ',    mark,        base));
+ SU_D(su_debug_log("%p: original scope was %*c top=%2d     base=%2d\n",
+                    ud,                24, ' ',    mark,        base));
 
  if (base < mark) {
 #if SU_HAS_PERL(5, 19, 4)
@@ -1058,7 +1060,7 @@ static void su_pop(pTHX_ void *ud) {
   PERL_CONTEXT *cx;
 #endif
 
-  SU_D(PerlIO_printf(Perl_debug_log, "%p: clear leftovers\n", ud));
+  SU_D(su_debug_log("%p: clear leftovers\n", ud));
 
 #if SU_HAS_PERL(5, 19, 4)
   cx = cxstack + cxstack_ix;
@@ -1084,25 +1086,22 @@ static void su_pop(pTHX_ void *ud) {
   if ((pad = SU_UD_PAD(ud)) > 0) {
    dMY_CXT;
    do {
-    SU_D(PerlIO_printf(Perl_debug_log,
+    SU_D(su_debug_log(
           "%p: push a pad slot at depth=%2d scope_ix=%2d save_ix=%2d\n",
            ud,                       depth, PL_scopestack_ix, PL_savestack_ix));
     SU_SAVE_PLACEHOLDER();
    } while (--pad);
   }
 
-  SU_D(PerlIO_printf(Perl_debug_log,
-          "%p: push destructor at depth=%2d scope_ix=%2d save_ix=%2d\n",
-           ud,                       depth, PL_scopestack_ix, PL_savestack_ix));
+  SU_D(su_debug_log(
+         "%p: push destructor at depth=%2d scope_ix=%2d save_ix=%2d\n",
+          ud,                        depth, PL_scopestack_ix, PL_savestack_ix));
   SAVEDESTRUCTOR_X(su_pop, ud);
  } else {
   switch (SU_UD_TYPE(ud)) {
    case SU_UD_TYPE_REAP: {
-    SU_D({
-     PerlIO_printf(Perl_debug_log,
-                "%p: === reap\n%p: depth=%2d scope_ix=%2d save_ix=%2d\n",
-                 ud, ud, SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix);
-    });
+    SU_D(su_debug_log("%p: === reap\n%p: depth=%2d scope_ix=%2d save_ix=%2d\n",
+                   ud, ud, SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix));
     SAVEDESTRUCTOR_X(su_call, SU_UD_REAP_CB(ud));
     SU_UD_FREE(ud);
     break;
@@ -1117,9 +1116,8 @@ static void su_pop(pTHX_ void *ud) {
   }
  }
 
- SU_D(PerlIO_printf(Perl_debug_log,
-                    "%p: --- end pop: cur_top=%2d == cur_base=%2d\n",
-                     ud, PL_savestack_ix, PL_scopestack[PL_scopestack_ix]));
+ SU_D(su_debug_log("%p: --- end pop: cur_top=%2d == cur_base=%2d\n",
+                    ud, PL_savestack_ix, PL_scopestack[PL_scopestack_ix]));
 }
 
 /* --- Initialize the stack and the action userdata ------------------------ */
@@ -1129,7 +1127,7 @@ static I32 su_init(pTHX_ void *ud, I32 cxix, I32 size) {
  I32 i, depth, offset, base, *origin;
  U8 pad;
 
- SU_D(PerlIO_printf(Perl_debug_log, "%p: ### init for cx %d\n", ud, cxix));
+ SU_D(su_debug_log("%p: ### init for cx %d\n", ud, cxix));
 
  /* su_pop() is going to be called from leave_scope(), so before pushing the
   * next callback, we'll want to flush the current scope stack slice first.
@@ -1152,12 +1150,10 @@ static I32 su_init(pTHX_ void *ud, I32 cxix, I32 size) {
    ++pad;
  }
  offset = SU_SAVE_DESTRUCTOR_SIZE + SU_SAVE_PLACEHOLDER_SIZE * pad;
-
- SU_D(PerlIO_printf(Perl_debug_log, "%p: size=%d pad=%d offset=%d\n",
-                                     ud,    size,   pad,   offset));
+ SU_D(su_debug_log("%p: size=%d pad=%d offset=%d\n", ud, size, pad, offset));
 
  depth = PL_scopestack_ix - cxstack[cxix].blk_oldscopesp;
- SU_D(PerlIO_printf(Perl_debug_log, "%p: going down to depth %d\n", ud, depth));
+ SU_D(su_debug_log("%p: going down to depth %d\n", ud, depth));
 
  /* We need to bump all the intermediary stack markers just in case an
   * exception is thrown before the target scope is reached. Indeed, in this
@@ -1190,24 +1186,21 @@ static I32 su_init(pTHX_ void *ud, I32 cxix, I32 size) {
                                        <= PL_scopestack[PL_scopestack_ix - 1]) {
   dMY_CXT;
   do {
-   SU_D(PerlIO_printf(Perl_debug_log,
-                  "%p: push a fake slot      at scope_ix=%2d  save_ix=%2d\n",
-                   ud,                      PL_scopestack_ix, PL_savestack_ix));
+   SU_D(su_debug_log("%p: push a fake slot      at scope_ix=%2d  save_ix=%2d\n",
+                      ud,                   PL_scopestack_ix, PL_savestack_ix));
    SU_SAVE_PLACEHOLDER();
   } while (PL_savestack_ix + SU_SAVE_DESTRUCTOR_SIZE
                                         <= PL_scopestack[PL_scopestack_ix - 1]);
  }
- SU_D(PerlIO_printf(Perl_debug_log,
-                  "%p: push first destructor at scope_ix=%2d  save_ix=%2d\n",
-                   ud,                      PL_scopestack_ix, PL_savestack_ix));
+ SU_D(su_debug_log("%p: push first destructor at scope_ix=%2d  save_ix=%2d\n",
+                    ud,                     PL_scopestack_ix, PL_savestack_ix));
  SAVEDESTRUCTOR_X(su_pop, ud);
 
  SU_D({
   for (i = 0; i <= depth; ++i) {
    I32 j = PL_scopestack_ix  - i;
-   PerlIO_printf(Perl_debug_log,
-                 "%p: depth=%2d scope_ix=%2d saved_floor=%2d new_floor=%2d\n",
-                  ud,        i, j, origin[depth - i],
+   su_debug_log("%p: depth=%2d scope_ix=%2d saved_floor=%2d new_floor=%2d\n",
+                 ud,         i,           j, origin[depth - i],
                                    i == 0 ? PL_savestack_ix : PL_scopestack[j]);
   }
  });
@@ -1244,8 +1237,7 @@ static void su_unwind(pTHX_ void *ud_) {
 
  SU_D({
   I32 gimme = GIMME_V;
-  PerlIO_printf(Perl_debug_log,
-                "%p: cx=%d gimme=%s items=%d sp=%d oldmark=%d mark=%d\n",
+  su_debug_log("%p: cx=%d gimme=%s items=%d sp=%d oldmark=%d mark=%d\n",
                 &MY_CXT, cxix,
                 gimme == G_VOID ? "void" : gimme == G_ARRAY ? "list" : "scalar",
                 items, PL_stack_sp - PL_stack_base, *PL_markstack_ptr, mark);