From: Vincent Pit Date: Tue, 18 Aug 2015 13:40:09 +0000 (-0300) Subject: Factor a part of the debugging logic into an helper function X-Git-Tag: v0.28~3 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=8596ba5e15fc913103009f3cd5a0aa996e0075ab;p=perl%2Fmodules%2FScope-Upper.git Factor a part of the debugging logic into an helper function --- diff --git a/Upper.xs b/Upper.xs index c2036cc..f85cc54 100644 --- a/Upper.xs +++ b/Upper.xs @@ -52,6 +52,14 @@ #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);