if (PL_top_env->je_prev) \
PerlProc_longjmp(PL_top_env->je_buf, (v)); \
if ((v) == 2) \
- PerlProc_exit(STATUS_NATIVE_EXPORT); \
+ PerlProc_exit(STATUS_EXIT); \
PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \
PerlProc_exit(1); \
} STMT_END
# define CopSTASH(c) (CopSTASHPV(c) \
? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : Nullch)
-# define CopSTASH_eq(c,hv) ((hv) \
- && (CopSTASHPV(c) == HvNAME_get(hv) \
- || (CopSTASHPV(c) && HvNAME_get(hv)\
- && strEQ(CopSTASHPV(c), HvNAME_get(hv)))))
+# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv))
# ifdef NETWARE
# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
-# else
-# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
-# endif
-
-# ifdef NETWARE
# define CopFILE_free(c) SAVECOPFILE_FREE(c)
# else
-# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))
+# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
+# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))
# endif
#else
# define CopFILEGV(c) ((c)->cop_filegv)
#define POPLOOP(cx) \
SvREFCNT_dec(cx->blk_loop.iterlval); \
if (CxITERVAR(cx)) { \
- SV **s_v_p = CxITERVAR(cx); \
- sv_2mortal(*s_v_p); \
- *s_v_p = cx->blk_loop.itersave; \
+ if (SvPADMY(cx->blk_loop.itersave)) { \
+ SV **s_v_p = CxITERVAR(cx); \
+ sv_2mortal(*s_v_p); \
+ *s_v_p = cx->blk_loop.itersave; \
+ } \
+ else { \
+ SvREFCNT_dec(cx->blk_loop.itersave); \
+ } \
} \
if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
SvREFCNT_dec(cx->blk_loop.iterary);
#define CXt_BLOCK 5
#define CXt_FORMAT 6
+/* private flags for CXt_SUB and CXt_NULL */
+#define CXp_MULTICALL 0x00000400 /* part of a multicall (so don't
+ tear down context on exit). */
+
/* private flags for CXt_EVAL */
#define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
#define CXp_TRYBLOCK 0x00000200 /* eval{}, not eval'' or similar */
#endif
#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
+#define CxMULTICALL(c) (((c)->cx_type & CXp_MULTICALL) \
+ == CXp_MULTICALL)
#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) \
== (CXt_EVAL|CXp_REAL))
#define CxTRYBLOCK(c) (((c)->cx_type & (CXt_EVAL|CXp_TRYBLOCK)) \
#define POPSTACK \
STMT_START { \
dSP; \
- PERL_SI *prev = PL_curstackinfo->si_prev; \
+ PERL_SI * const prev = PL_curstackinfo->si_prev; \
if (!prev) { \
PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \
my_exit(1); \
#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
+/*
+=head1 Multicall Functions
+
+=for apidoc Ams||dMULTICALL
+Declare local variables for a multicall. See L<perlcall/Lightweight Callbacks>.
+
+=for apidoc Ams||PUSH_MULTICALL
+Opening bracket for a lightweight callback.
+See L<perlcall/Lightweight Callbacks>.
+
+=for apidoc Ams||MULTICALL
+Make a lightweight callback. See L<perlcall/Lightweight Callbacks>.
+
+=for apidoc Ams||POP_MULTICALL
+Closing bracket for a lightweight callback.
+See L<perlcall/Lightweight Callbacks>.
+
+=cut
+*/
+
+#define dMULTICALL \
+ SV **newsp; /* set by POPBLOCK */ \
+ PERL_CONTEXT *cx; \
+ CV *multicall_cv; \
+ OP *multicall_cop; \
+ bool multicall_oldcatch; \
+ U8 hasargs = 0 /* used by PUSHSUB */
+
+#define PUSH_MULTICALL(the_cv) \
+ STMT_START { \
+ CV * const _nOnclAshIngNamE_ = the_cv; \
+ CV * const cv = _nOnclAshIngNamE_; \
+ AV * const padlist = CvPADLIST(cv); \
+ ENTER; \
+ multicall_oldcatch = CATCH_GET; \
+ SAVETMPS; SAVEVPTR(PL_op); \
+ CATCH_SET(TRUE); \
+ PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp); \
+ PUSHSUB(cx); \
+ if (++CvDEPTH(cv) >= 2) { \
+ PERL_STACK_OVERFLOW_CHECK(); \
+ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
+ } \
+ SAVECOMPPAD(); \
+ PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
+ multicall_cv = cv; \
+ multicall_cop = CvSTART(cv); \
+ } STMT_END
+
+#define MULTICALL \
+ STMT_START { \
+ PL_op = multicall_cop; \
+ CALLRUNOPS(aTHX); \
+ } STMT_END
+
+#define POP_MULTICALL \
+ STMT_START { \
+ LEAVESUB(multicall_cv); \
+ CvDEPTH(multicall_cv)--; \
+ POPBLOCK(cx,PL_curpm); \
+ CATCH_SET(multicall_oldcatch); \
+ LEAVE; \
+ } STMT_END