# define SU_HAS_NEW_CXT
#endif
-
#ifndef dVAR
# define dVAR dNOOP
#endif
# define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES"
#endif
-/* CX_ARGARRAY(cx): the AV at pad[0] of the CV associated with CXt_SUB
- * context cx */
-
-#if XSH_HAS_PERL(5, 23, 8)
-# define CX_ARGARRAY(cx) \
- ((AV*)(AvARRAY(MUTABLE_AV( \
- PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \
- CvDEPTH(cx->blk_sub.cv)]))[0]))
-# define CX_ARGARRAY_set(cx,ary) \
- (AvARRAY(MUTABLE_AV( \
- PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \
- CvDEPTH(cx->blk_sub.cv)]))[0] = (SV*)(ary))
-#else
-# define CX_ARGARRAY(cx) (cx->blk_sub.argarray)
-# define CX_ARGARRAY_set(cx,ary) (cx->blk_sub.argarray = (ary))
-#endif
-
-
/* --- Error messages ------------------------------------------------------ */
static const char su_stack_smash[] = "Cannot target a scope outside of the current stack";
CV *renamed;
#ifdef SU_HAS_NEW_CXT
- U8 *cxtypes; /* array of saved context types */
- I32 gap; /* how many contexts have temporarily CXt_NULLed out */
- AV* argarray; /* the PL_curpad[0] of the uplevel sub */
+ U8 *cxtypes; /* array of saved context types */
+ I32 gap; /* how many contexts have temporarily CXt_NULLed out*/
+ AV* argarray; /* the PL_curpad[0] of the uplevel sub */
#else
I32 target_depth;
CV *target;
sud->tmp_uid_storage.used = 0;
sud->tmp_uid_storage.alloc = 0;
- #ifndef SU_HAS_NEW_CXT
+#ifndef SU_HAS_NEW_CXT
Newx(si, 1, PERL_SI);
si->si_stack = newAV();
AvREAL_off(si->si_stack);
# define SU_SAVE_HELEM_OR_HDELETE_SIZE SU_SAVE_HELEM_SIZE
#endif
-
#ifndef SvCANEXISTDELETE
# define SvCANEXISTDELETE(sv) \
(!SvRMAGICAL(sv) \
/* --- Actions ------------------------------------------------------------- */
typedef struct {
- I32 orig_ix; /* original savestack_ix */
- I32 offset; /* how much we bumped this savestack index */
+ I32 orig_ix; /* original savestack_ix */
+ I32 offset; /* how much we bumped this savestack index */
} su_ud_origin_elem;
typedef struct {
- U8 type;
- U8 private;
+ U8 type;
+ U8 private;
/* spare */
- I32 depth;
+ I32 depth;
su_ud_origin_elem *origin;
} su_ud_common;
-
#define SU_UD_TYPE(U) (((su_ud_common *) (U))->type)
#define SU_UD_PRIVATE(U) (((su_ud_common *) (U))->private)
#define SU_UD_DEPTH(U) (((su_ud_common *) (U))->depth)
# endif
};
-
-
/* push at least 'size' slots worth of padding onto the savestack */
static void su_ss_push_padding(pTHX_ void *ud, I32 size) {
save_alloc((size - SU_SAVE_ALLOC_SIZE)*sizeof(*PL_savestack), 0);
}
-
static void su_pop(pTHX_ void *ud);
-
-
/* push an su_pop destructor onto the savestack with suitable padding.
* first indicates that this is the first push of a destructor */
PL_savestack_ix <= origin[depth+1].orig_ix + origin[depth+1].offset);
}
-
/* this is called during each leave_scope() via SAVEDESTRUCTOR_X */
static void su_pop(pTHX_ void *ud) {
XSH_D(su_debug_log("%p: end pop: ss_ix=%d\n", ud, PL_savestack_ix));
}
-
/* --- Initialize the stack and the action userdata ------------------------ */
static void su_init(pTHX_ void *ud, I32 cxix, I32 size) {
*
* The passed cxix argument represents the scope we wish to inject into;
* we have to adjust all the savestack frame boundaries above (but not
- * including) that context.
+ * including) that context.
*/
Newx(origin, depth, su_ud_origin_elem);
su_ss_push_destructor(aTHX_ ud, depth-1, 1);
}
-
/* --- Unwind stack -------------------------------------------------------- */
static void su_unwind(pTHX_ void *ud_) {
switch (CxTYPE(cx)) {
case CXt_SUB:
if (CxHASARGS(cx)) {
- argarray = CX_ARGARRAY(cx);
+ argarray = cx->blk_sub.argarray;
goto done;
}
break;
* reached without a goto() happening, and the old argarray member is
* actually our fake argarray. Destroy it properly in that case. */
if (cx->blk_sub.cv == sud->renamed) {
- SvREFCNT_dec(CX_ARGARRAY(cx));
- CX_ARGARRAY_set(cx, argarray);
+ SvREFCNT_dec(cx->blk_sub.argarray);
+ cx->blk_sub.argarray = argarray;
}
CvDEPTH(sud->callback)--;
return cv;
}
-
-
#ifdef SU_HAS_NEW_CXT
/* this one-shot runops "loop" is designed to be called just before
return 0;
}
-
-
static I32 su_uplevel_new(pTHX_ CV *callback, I32 cxix, I32 args) {
su_uplevel_ud *sud;
U8 *saved_cxtypes;
sud->gap = cxstack_ix - cxix + 1;
sud->argarray = NULL;
-
Newx(saved_cxtypes, sud->gap, U8);
sud->cxtypes = saved_cxtypes;
sud->renamed = su_cv_clone(callback, CvGV(base_cv));
sud->old_runops = PL_runops;
-
if (!CvISXSUB(sud->renamed) && CxHASARGS(&cxstack[cxix])) {
sud->argarray = (AV*)su_at_underscore(base_cv);
assert(PL_runops != su_uplevel_runops_hook_entersub);
if ((PL_op = PL_ppaddr[OP_ENTERSUB](aTHX))) {
PERL_CONTEXT *sub_cx = cxstack + cxstack_ix;
- AV *argarray = CX_ARGARRAY(cx);
+ AV *argarray = cx->blk_sub.argarray;
/* If pp_entersub() returns a non-null OP, it means that the callback is not
* an XSUB. */
av_extend(av, AvMAX(argarray));
AvFILLp(av) = AvFILLp(argarray);
Copy(AvARRAY(argarray), AvARRAY(av), AvFILLp(av) + 1, SV *);
- CX_ARGARRAY_set(sub_cx, av);
+ sub_cx->blk_sub.argarray = av;
} else {
- SvREFCNT_inc_simple_void(CX_ARGARRAY(sub_cx));
+ SvREFCNT_inc_simple_void(sub_cx->blk_sub.argarray);
}
if (su_uplevel_goto_static(CvROOT(renamed))) {
return cxix;
}
-
#ifdef SU_HAS_NEW_CXT
/* convert a physical context stack index into the logical equivalent:
# define su_context_logical2real(C) (C)
#endif
-
static I32 su_context_normalize_up(pTHX_ I32 cxix) {
#define su_context_normalize_up(C) su_context_normalize_up(aTHX_ (C))
PERL_CONTEXT *cx;
projects / perl / modules / Scope-Upper.git / blobdiff