CV * cv;
GV * gv;
GV * dfoutgv;
+#ifndef USE_THREADS
AV * savearray;
+#endif /* USE_THREADS */
AV * argarray;
U16 olddepth;
U8 hasargs;
#define POPSUB1(cx) \
cxsub = cx->blk_sub; /* because DESTROY may clobber *cx */
+#ifdef USE_THREADS
+#define POPSAVEARRAY() NOOP
+#else
+#define POPSAVEARRAY() \
+ STMT_START { \
+ SvREFCNT_dec(GvAV(defgv)); \
+ GvAV(defgv) = cxsub.savearray; \
+ } STMT_END
+#endif /* USE_THREADS */
+
#define POPSUB2() \
if (cxsub.hasargs) { \
- /* put back old @_ */ \
- SvREFCNT_dec(GvAV(defgv)); \
- GvAV(defgv) = cxsub.savearray; \
+ POPSAVEARRAY(); \
/* destroy arg array */ \
av_clear(cxsub.argarray); \
AvREAL_off(cxsub.argarray); \
char * sbu_s;
char * sbu_m;
char * sbu_strend;
- char * sbu_subbase;
+ void * sbu_rxres;
REGEXP * sbu_rx;
};
#define sb_iters cx_u.cx_subst.sbu_iters
#define sb_s cx_u.cx_subst.sbu_s
#define sb_m cx_u.cx_subst.sbu_m
#define sb_strend cx_u.cx_subst.sbu_strend
-#define sb_subbase cx_u.cx_subst.sbu_subbase
+#define sb_rxres cx_u.cx_subst.sbu_rxres
#define sb_rx cx_u.cx_subst.sbu_rx
#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
cx->sb_s = s, \
cx->sb_m = m, \
cx->sb_strend = strend, \
+ cx->sb_rxres = Null(void*), \
cx->sb_rx = rx, \
- cx->cx_type = CXt_SUBST
+ cx->cx_type = CXt_SUBST; \
+ rxres_save(&cx->sb_rxres, rx)
-#define POPSUBST(cx) cxstack_ix--
+#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
+ rxres_free(&cx->sb_rxres)
struct context {
I32 cx_type; /* what kind of context this is */
/* "gimme" values */
#define G_SCALAR 0
#define G_ARRAY 1
+#define G_VOID 128 /* skip this bit when adding flags below */
/* extra flags for perl_call_* routines */
#define G_DISCARD 2 /* Call FREETMPS. */
#define G_EVAL 4 /* Assume eval {} around subroutine call. */
#define G_NOARGS 8 /* Don't construct a @_ array. */
-#define G_KEEPERR 16 /* Append errors to $@ rather than overwriting it */
+#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
+
+/* Support for switching (stack and block) contexts.
+ * This ensures magic doesn't invalidate local stack and cx pointers.
+ */
+
+#define SI_UNDEF 0
+#define SI_MAIN 1
+#define SI_MAGIC 2
+#define SI_SORT 3
+#define SI_SIGNAL 4
+#define SI_OVERLOAD 5
+#define SI_DESTROY 6
+/* XXX todo
+#define SI_WARNHOOK 7
+#define SI_DIEHOOK 8
+*/
+
+struct stackinfo {
+ AV * si_stack; /* stack for current runlevel */
+ PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
+ I32 si_cxix; /* current context index */
+ I32 si_cxmax; /* maximum allocated index */
+ I32 si_type; /* type of runlevel */
+ struct stackinfo * si_prev;
+ struct stackinfo * si_next;
+ I32 * si_markbase; /* where markstack begins for us.
+ * currently used only with DEBUGGING,
+ * but not #ifdef-ed for bincompat */
+};
+
+typedef struct stackinfo PERL_SI;
+
+#define cxstack (curstackinfo->si_cxstack)
+#define cxstack_ix (curstackinfo->si_cxix)
+#define cxstack_max (curstackinfo->si_cxmax)
+
+#ifdef DEBUGGING
+# define SET_MARKBASE curstackinfo->si_markbase = markstack_ptr
+#else
+# define SET_MARKBASE NOOP
+#endif
+
+#define PUSHSTACK(type) \
+ STMT_START { \
+ PERL_SI *next = curstackinfo->si_next; \
+ if (!next) { \
+ next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
+ next->si_prev = curstackinfo; \
+ curstackinfo->si_next = next; \
+ } \
+ next->si_type = type; \
+ next->si_cxix = -1; \
+ AvFILLp(next->si_stack) = 0; \
+ SWITCHSTACK(curstack,next->si_stack); \
+ curstackinfo = next; \
+ SET_MARKBASE; \
+ } STMT_END
+
+#define POPSTACK() \
+ STMT_START { \
+ PERL_SI *prev = curstackinfo->si_prev; \
+ if (!prev) { \
+ PerlIO_printf(PerlIO_stderr(), "panic: POPSTACK\n"); \
+ my_exit(1); \
+ } \
+ SWITCHSTACK(curstack,prev->si_stack); \
+ /* don't free prev here, free them all at the END{} */ \
+ curstackinfo = prev; \
+ } STMT_END
+
+#define POPSTACK_TO(s) \
+ STMT_START { \
+ while (curstack != s) \
+ POPSTACK(); \
+ } STMT_END