/* cop.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
- * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
+ * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
- * Control ops (cops) are one of the three ops OP_NEXTSTATE, OP_DBSTATE,
- * and OP_SETSTATE that (loosely speaking) are separate statements.
+ * Control ops (cops) are one of the two ops OP_NEXTSTATE and OP_DBSTATE,
+ * that (loosely speaking) are separate statements.
* They hold information important for lexical state and error reporting.
* At run time, PL_curcop is set to point to the most recently executed cop,
* and thus can be used to determine our current state.
#define JMPENV_PUSH(v) \
STMT_START { \
- DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \
- (void*)&cur_env, (void*)PL_top_env)); \
+ DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p at %s:%d\n", \
+ (void*)&cur_env, (void*)PL_top_env, \
+ __FILE__, __LINE__)); \
cur_env.je_prev = PL_top_env; \
OP_REG_TO_MEM; \
cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \
#define JMPENV_POP \
STMT_START { \
- DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n", \
- (void*)PL_top_env, (void*)cur_env.je_prev)); \
+ DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p at %s:%d\n", \
+ (void*)PL_top_env, (void*)cur_env.je_prev, \
+ __FILE__, __LINE__)); \
+ assert(PL_top_env == &cur_env); \
PL_top_env = cur_env.je_prev; \
} STMT_END
#define CopLINE_set(c,l) (CopLINE(c) = (l))
/* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
-#ifdef MACOS_TRADITIONAL
-# define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c))
-#else
-# define OutCopFILE(c) CopFILE(c)
-#endif
+#define OutCopFILE(c) CopFILE(c)
/* If $[ is non-zero, it's stored in cop_hints under the key "$[", and
HINT_ARYBASE is set to indicate this.
#define CopARYBASE_set(c, b) STMT_START { \
if (b || ((c)->cop_hints & HINT_ARYBASE)) { \
(c)->cop_hints |= HINT_ARYBASE; \
- if ((c) == &PL_compiling) \
- PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE; \
- (c)->cop_hints_hash \
- = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \
+ if ((c) == &PL_compiling) { \
+ SV *val = newSViv(b); \
+ (void)hv_stores(GvHV(PL_hintgv), "$[", val); \
+ mg_set(val); \
+ PL_hints |= HINT_ARYBASE; \
+ } else { \
+ (c)->cop_hints_hash \
+ = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \
newSVpvs_flags("$[", SVs_TEMP), \
sv_2mortal(newSViv(b))); \
+ } \
} \
} STMT_END
#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], \
+#ifdef PERL_CORE
+# define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
cx->sb_iters = iters, \
cx->sb_maxiters = maxiters, \
cx->sb_rflags = r_flags, \
rxres_save(&cx->sb_rxres, rx); \
(void)ReREFCNT_inc(rx)
-#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE)
-
-#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
+# define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
rxres_free(&cx->sb_rxres); \
ReREFCNT_dec(cx->sb_rx)
+#endif
+
+#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE)
struct context {
union {
multicall_oldcatch = CATCH_GET; \
SAVETMPS; SAVEVPTR(PL_op); \
CATCH_SET(TRUE); \
+ PUSHSTACKi(PERLSI_SORT); \
PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp); \
PUSHSUB(cx); \
if (++CvDEPTH(cv) >= 2) { \
LEAVESUB(multicall_cv); \
CvDEPTH(multicall_cv)--; \
POPBLOCK(cx,PL_curpm); \
+ POPSTACK; \
CATCH_SET(multicall_oldcatch); \
LEAVE; \
+ SPAGAIN; \
} STMT_END
/*