/* cop.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
CV * cv;
GV * gv;
GV * dfoutgv;
+#ifndef USE_THREADS
AV * savearray;
+#endif /* USE_THREADS */
AV * argarray;
U16 olddepth;
U8 hasargs;
cx->blk_sub.dfoutgv = defoutgv; \
(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
-/* We muck with cxstack_ix since _dec may call a DESTROY, overwriting cx. */
-
#define POPSUB(cx) \
- if (cx->blk_sub.hasargs) { /* put back old @_ */ \
- GvAV(defgv) = cx->blk_sub.savearray; \
+ { struct block_sub cxsub; \
+ POPSUB1(cx); \
+ POPSUB2(); }
+
+#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) { \
+ POPSAVEARRAY(); \
+ /* destroy arg array */ \
+ av_clear(cxsub.argarray); \
+ AvREAL_off(cxsub.argarray); \
} \
- if (cx->blk_sub.cv) { \
- if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { \
- if (cx->blk_sub.hasargs) { \
- SvREFCNT_inc((SV*)cx->blk_sub.argarray); \
- } \
- cxstack_ix++; \
- SvREFCNT_dec((SV*)cx->blk_sub.cv); \
- cxstack_ix--; \
- } \
+ if (cxsub.cv) { \
+ if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth)) \
+ SvREFCNT_dec(cxsub.cv); \
}
#define POPFORMAT(cx) \
SV * itersave;
SV * iterlval;
AV * iterary;
- I32 iterix;
+ IV iterix;
+ IV itermax;
};
#define PUSHLOOP(cx, ivar, s) \
cx->blk_loop.redo_op = cLOOP->op_redoop; \
cx->blk_loop.next_op = cLOOP->op_nextop; \
cx->blk_loop.last_op = cLOOP->op_lastop; \
- cx->blk_loop.iterlval = Nullsv; \
if (cx->blk_loop.itervar = (ivar)) \
- cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);
+ cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);\
+ cx->blk_loop.iterlval = Nullsv; \
+ cx->blk_loop.iterary = Nullav; \
+ cx->blk_loop.iterix = -1;
#define POPLOOP(cx) \
- newsp = stack_base + cx->blk_loop.resetsp; \
- SvREFCNT_dec(cx->blk_loop.iterlval); \
- if (cx->blk_loop.itervar) { \
- SvREFCNT_dec(*cx->blk_loop.itervar); \
- *cx->blk_loop.itervar = cx->blk_loop.itersave; \
- }
+ { struct block_loop cxloop; \
+ POPLOOP1(cx); \
+ POPLOOP2(); }
+
+#define POPLOOP1(cx) \
+ cxloop = cx->blk_loop; /* because DESTROY may clobber *cx */ \
+ newsp = stack_base + cxloop.resetsp;
+
+#define POPLOOP2() \
+ SvREFCNT_dec(cxloop.iterlval); \
+ if (cxloop.itervar) { \
+ SvREFCNT_dec(*cxloop.itervar); \
+ *cxloop.itervar = cxloop.itersave; \
+ } \
+ if (cxloop.iterary && cxloop.iterary != curstack) \
+ SvREFCNT_dec(cxloop.iterary);
/* context common to subroutines, evals and loops */
struct block {
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 */
+#define G_NODEBUG 32 /* Disable debugging at toplevel. */
+
+/* Support for switching (stack and block) contexts.
+ * This ensures magic doesn't invalidate local stack and cx pointers.
+ */
+
+#define PERLSI_UNKNOWN -1
+#define PERLSI_UNDEF 0
+#define PERLSI_MAIN 1
+#define PERLSI_MAGIC 2
+#define PERLSI_SORT 3
+#define PERLSI_SIGNAL 4
+#define PERLSI_OVERLOAD 5
+#define PERLSI_DESTROY 6
+#define PERLSI_WARNHOOK 7
+#define PERLSI_DIEHOOK 8
+#define PERLSI_REQUIRE 9
+
+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 PUSHSTACKi(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 PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
+
+#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) { \
+ dounwind(-1); \
+ POPSTACK; \
+ } \
+ } STMT_END
https://perl5.git.perl.org / perl5.git / blobdiff