X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Upper.xs;h=76496ac34e683671fa7192cd49a099e5a7cedee5;hb=979a80f45ad9c555a698eddbc9114e696817739f;hp=63d267b928aeb3c3a059d464001ac61d71bbb030;hpb=2b4a5dedb43b2b9ce4020d7257ede8c2040e232e;p=perl%2Fmodules%2FScope-Upper.git diff --git a/Upper.xs b/Upper.xs index 63d267b..76496ac 100644 --- a/Upper.xs +++ b/Upper.xs @@ -116,6 +116,11 @@ STATIC SV *su_newSV_type(pTHX_ svtype t) { # define CvISXSUB(C) CvXSUB(C) #endif +#ifndef PadlistARRAY +# define PadlistARRAY(P) AvARRAY(P) +# define PadARRAY(P) AvARRAY(P) +#endif + #ifndef CxHASARGS # define CxHASARGS(C) ((C)->blk_sub.hasargs) #endif @@ -660,6 +665,8 @@ typedef struct { /* ... Reap ................................................................ */ +#define SU_SAVE_LAST_CX (!SU_HAS_PERL(5, 8, 4) || (SU_HAS_PERL(5, 9, 5) && !SU_HAS_PERL(5, 14, 0)) || SU_HAS_PERL(5, 15, 0)) + typedef struct { su_ud_common ci; SV *cb; @@ -667,10 +674,10 @@ typedef struct { STATIC void su_call(pTHX_ void *ud_) { su_ud_reap *ud = (su_ud_reap *) ud_; -#if SU_HAS_PERL(5, 9, 5) - PERL_CONTEXT saved_cx; +#if SU_SAVE_LAST_CX I32 cxix; -#endif + PERL_CONTEXT saved_cx; +#endif /* SU_SAVE_LAST_CX */ dSP; @@ -686,22 +693,18 @@ STATIC void su_call(pTHX_ void *ud_) { PUSHMARK(SP); PUTBACK; +#if SU_SAVE_LAST_CX /* If the recently popped context isn't saved there, it will be overwritten by * the sub scope from call_sv, although it's still needed in our caller. */ - -#if SU_HAS_PERL(5, 9, 5) - if (cxstack_ix < cxstack_max) - cxix = cxstack_ix + 1; - else - cxix = Perl_cxinc(aTHX); + cxix = (cxstack_ix < cxstack_max) ? (cxstack_ix + 1) : Perl_cxinc(aTHX); saved_cx = cxstack[cxix]; -#endif +#endif /* SU_SAVE_LAST_CX */ call_sv(ud->cb, G_VOID); -#if SU_HAS_PERL(5, 9, 5) +#if SU_SAVE_LAST_CX cxstack[cxix] = saved_cx; -#endif +#endif /* SU_SAVE_LAST_CX */ PUTBACK; @@ -890,9 +893,9 @@ done: #if SU_DEBUG # ifdef DEBUGGING -# define SU_CXNAME PL_block_type[CxTYPE(&cxstack[cxstack_ix])] +# define SU_CXNAME(C) PL_block_type[CxTYPE(C)] # else -# define SU_CXNAME "XXX" +# define SU_CXNAME(C) "XXX" # endif #endif @@ -905,7 +908,7 @@ STATIC void su_pop(pTHX_ void *ud) { 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, + ud, SU_CXNAME(cxstack + cxstack_ix), ud, depth, PL_scopestack_ix,PL_savestack_ix,PL_scopestack[PL_scopestack_ix]) ); @@ -1251,7 +1254,7 @@ done: #endif /* SU_UPLEVEL_HIJACKS_RUNOPS */ -#define su_at_underscore(C) AvARRAY(AvARRAY(CvPADLIST(C))[CvDEPTH(C)])[0] +#define su_at_underscore(C) PadARRAY(PadlistARRAY(CvPADLIST(C))[CvDEPTH(C)])[0] STATIC void su_uplevel_restore(pTHX_ void *sus_) { su_uplevel_ud *sud = sus_;