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(hv) : Nullch)
-# define CopSTASH_eq(c,hv) ((hv) \
- && (CopSTASHPV(c) == HvNAME(hv) \
- || (CopSTASHPV(c) && HvNAME(hv) \
- && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : Nullch)
+# 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 CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
# define CopSTASH(c) ((c)->cop_stash)
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
-# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
+# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : Nullch)
/* cop_stash is not refcounted */
# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
SvREFCNT_dec(cx->blk_sub.argarray); \
cx->blk_sub.argarray = newAV(); \
av_extend(cx->blk_sub.argarray, fill); \
- AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \
+ AvREIFY_only(cx->blk_sub.argarray); \
CX_CURPAD_SV(cx->blk_sub, 0) = (SV*)cx->blk_sub.argarray; \
} \
else { \
SV * cur_text;
CV * cv;
OP * retop; /* op to execute on exit from eval */
+ JMPENV * cur_top_env; /* value of PL_top_env when eval CX created */
};
#define PUSHEVAL(cx,n,fgv) \
cx->blk_eval.cur_text = PL_linestr; \
cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */ \
cx->blk_eval.retop = Nullop; \
+ cx->blk_eval.cur_top_env = PL_top_env; \
} STMT_END
#define POPEVAL(cx) \
#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 *cv; \
+ OP *multicall_cop; \
+ bool multicall_oldcatch; \
+ U8 hasargs = 0 /* used by PUSHSUB */
+
+#define PUSH_MULTICALL \
+ STMT_START { \
+ AV* 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_cop = CvSTART(cv); \
+ } STMT_END
+
+#define MULTICALL \
+ STMT_START { \
+ PL_op = multicall_cop; \
+ CALLRUNOPS(aTHX); \
+ } STMT_END
+
+#define POP_MULTICALL \
+ STMT_START { \
+ LEAVESUB(cv); \
+ CvDEPTH(cv)--; \
+ POPBLOCK(cx,PL_curpm); \
+ CATCH_SET(multicall_oldcatch); \
+ LEAVE; \
+ } STMT_END