/*
=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|const char *key|U32 flags
-Like L</cophh_fetch_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cophh_fetch_pvn>, but takes a C<NUL>-terminated literal string instead
+of a string/length pair, and no precomputed hash.
=cut
*/
/*
=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|const char *key|SV *value|U32 flags
-Like L</cophh_store_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cophh_store_pvn>, but takes a C<NUL>-terminated literal string instead
+of a string/length pair, and no precomputed hash.
=cut
*/
/*
=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|const char *key|U32 flags
-Like L</cophh_delete_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cophh_delete_pvn>, but takes a C<NUL>-terminated literal string instead
+of a string/length pair, and no precomputed hash.
=cut
*/
/*
=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|const char *key|U32 flags
-Like L</cop_hints_fetch_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cop_hints_fetch_pvn>, but takes a C<NUL>-terminated literal string
+instead of a string/length pair, and no precomputed hash.
=cut
*/
* The context frame holds a reference to the CV so that it can't be
* freed while we're executing it */
-#define CX_PUSHSUB_BASE(cx, cv, op, hasargs) \
- ENTRY_PROBE(CvNAMED(cv) \
- ? HEK_KEY(CvNAME_HEK(cv)) \
- : GvENAME(CvGV(cv)), \
- CopFILE((const COP *)CvSTART(cv)), \
- CopLINE((const COP *)CvSTART(cv)), \
- CopSTASHPV((const COP *)CvSTART(cv))); \
- \
- cx->blk_sub.cv = cv; \
- cx->blk_sub.olddepth = CvDEPTH(cv); \
- cx->blk_sub.prevcomppad = PL_comppad; \
- cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; \
- cx->blk_sub.retop = op; \
- SvREFCNT_inc_simple_void_NN(cv);
#define CX_PUSHSUB_GET_LVALUE_MASK(func) \
/* If the context is indeterminate, then only the lvalue */ \
? 0 : (U8)func(aTHX) \
)
-#define CX_PUSHSUB(cx, cv, op, hasargs) \
- { \
- U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub); \
- CX_PUSHSUB_BASE(cx, cv, op, hasargs) \
- cx->blk_u16 = PL_op->op_private & \
- (phlags|OPpDEREF); \
- }
-
-/* variant for use by OP_DBSTATE, where op_private holds hint bits */
-#define CX_PUSHSUB_DB(cx, cv, op, hasargs) \
- CX_PUSHSUB_BASE(cx, cv, op, hasargs) \
- cx->blk_u16 = 0;
-
-
-#define CX_PUSHFORMAT(cx, cv, gv, retop) \
- cx->blk_format.cv = cv; \
- cx->blk_format.gv = gv; \
- cx->blk_format.retop = (retop); \
- cx->blk_format.dfoutgv = PL_defoutgv; \
- cx->blk_format.prevcomppad = PL_comppad; \
- cx->blk_u16 = 0; \
- SvREFCNT_inc_simple_void_NN(cv); \
- CvDEPTH(cv)++; \
- SvREFCNT_inc_void(cx->blk_format.dfoutgv)
-
/* Restore old @_ */
#define CX_POP_SAVEARRAY(cx) \
STMT_START { \
- AV *av = GvAV(PL_defgv); \
+ AV *cx_pop_savearray_av = GvAV(PL_defgv); \
GvAV(PL_defgv) = cx->blk_sub.savearray; \
cx->blk_sub.savearray = NULL; \
- SvREFCNT_dec(av); \
+ SvREFCNT_dec(cx_pop_savearray_av); \
} STMT_END
/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
} STMT_END
-/* subsets of CX_POPSUB */
-
-#define CX_POPSUB_COMMON(cx) \
- STMT_START { \
- CV *cv; \
- assert(CxTYPE(cx) == CXt_SUB); \
- PL_comppad = cx->blk_sub.prevcomppad; \
- PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
- cv = cx->blk_sub.cv; \
- CvDEPTH(cv) = cx->blk_sub.olddepth; \
- cx->blk_sub.cv = NULL; \
- SvREFCNT_dec(cv); \
- } STMT_END
-
-/* handle the @_ part of leaving a sub */
-
-#define CX_POPSUB_ARGS(cx) \
- STMT_START { \
- AV *av; \
- assert(CxTYPE(cx) == CXt_SUB); \
- assert(AvARRAY(MUTABLE_AV( \
- PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \
- CvDEPTH(cx->blk_sub.cv)])) == PL_curpad); \
- CX_POP_SAVEARRAY(cx); \
- av = MUTABLE_AV(PAD_SVl(0)); \
- if (UNLIKELY(AvREAL(av))) \
- /* abandon @_ if it got reified */ \
- clear_defarray(av, 0); \
- else { \
- CLEAR_ARGARRAY(av); \
- } \
- } STMT_END
-
-#define CX_POPSUB(cx) \
- STMT_START { \
- assert(CxTYPE(cx) == CXt_SUB); \
- RETURN_PROBE(CvNAMED(cx->blk_sub.cv) \
- ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv)) \
- : GvENAME(CvGV(cx->blk_sub.cv)), \
- CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \
- CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \
- CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv))); \
- \
- if (CxHASARGS(cx)) { \
- CX_POPSUB_ARGS(cx); \
- } \
- CX_POPSUB_COMMON(cx); \
- } STMT_END
-
-#define CX_POPFORMAT(cx) \
- STMT_START { \
- CV *cv; \
- GV * const dfout = cx->blk_format.dfoutgv; \
- assert(CxTYPE(cx) == CXt_FORMAT); \
- setdefout(dfout); \
- cx->blk_format.dfoutgv = NULL; \
- SvREFCNT_dec_NN(dfout); /* the cx->defoutgv ref */ \
- PL_comppad = cx->blk_format.prevcomppad; \
- PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
- cv = cx->blk_format.cv; \
- cx->blk_format.cv = NULL;; \
- --CvDEPTH(cv); \
- SvREFCNT_dec_NN(cv); \
- } STMT_END
-
/* eval context */
struct block_eval {
OP * retop; /* op to execute on exit from eval */
#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F)
#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7)
-#define CX_PUSHEVAL(cx, op, n) \
- STMT_START { \
- assert(!(PL_in_eval & ~0x7F)); \
- assert(!(PL_op->op_type & ~0x1FF)); \
- cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); \
- cx->blk_eval.old_namesv = (n); \
- cx->blk_eval.old_eval_root = PL_eval_root; \
- cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL; \
- cx->blk_eval.cv = NULL; /* set by doeval_compile() as applicable */ \
- cx->blk_eval.retop = op; \
- cx->blk_eval.cur_top_env = PL_top_env; \
- } STMT_END
-
-#define CX_POPEVAL(cx) \
- STMT_START { \
- SV *sv; \
- assert(CxTYPE(cx) == CXt_EVAL); \
- PL_in_eval = CxOLD_IN_EVAL(cx); \
- PL_eval_root = cx->blk_eval.old_eval_root; \
- sv = cx->blk_eval.cur_text; \
- if (sv && SvSCREAM(sv)) { \
- cx->blk_eval.cur_text = NULL; \
- SvREFCNT_dec_NN(sv); \
- } \
- sv = cx->blk_eval.old_namesv; \
- if (sv && !SvTEMP(sv))/* TEMP implies CX_POPEVAL re-entrantly called */ \
- sv_2mortal(sv); \
- } STMT_END
-
/* loop context */
struct block_loop {
LOOP * my_op; /* My op, that contains redo, next and last ops. */
#define CxLVAL(c) (0 + ((c)->blk_u16 & 0xff))
-#define CX_PUSHLOOP_PLAIN(cx) \
- cx->blk_loop.my_op = cLOOP;
-
-#ifdef USE_ITHREADS
-# define CX_PUSHLOOP_FOR_setpad(c) (c)->blk_loop.oldcomppad = PL_comppad
-#else
-# define CX_PUSHLOOP_FOR_setpad(c) NOOP
-#endif
-
-#define CX_PUSHLOOP_FOR(cx, ivar, isave) \
- CX_PUSHLOOP_PLAIN(cx); \
- cx->blk_loop.itervar_u.svp = (SV**)(ivar); \
- cx->blk_loop.itersave = isave; \
- CX_PUSHLOOP_FOR_setpad(cx);
-
-#define CX_POPLOOP(cx) \
- assert(CxTYPE_is_LOOP(cx)); \
- if ( CxTYPE(cx) == CXt_LOOP_ARY \
- || CxTYPE(cx) == CXt_LOOP_LAZYSV) \
- { \
- /* Free ary or cur. This assumes that state_u.ary.ary \
- * aligns with state_u.lazysv.cur. See cx_dup() */ \
- SV *sv = cx->blk_loop.state_u.lazysv.cur; \
- cx->blk_loop.state_u.lazysv.cur = NULL; \
- SvREFCNT_dec_NN(sv); \
- if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \
- sv = cx->blk_loop.state_u.lazysv.end; \
- cx->blk_loop.state_u.lazysv.end = NULL; \
- SvREFCNT_dec_NN(sv); \
- } \
- } \
- if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) { \
- SV *cursv; \
- SV **svp = (cx)->blk_loop.itervar_u.svp; \
- if ((cx->cx_type & CXp_FOR_GV)) \
- svp = &GvSV((GV*)svp); \
- cursv = *svp; \
- *svp = cx->blk_loop.itersave; \
- cx->blk_loop.itersave = NULL; \
- SvREFCNT_dec(cursv); \
- }
/* given/when context */
struct block_givwhen {
SV *defsv_save; /* the original $_ */
};
-#define CX_PUSHWHEN(cx) \
- cx->blk_givwhen.leave_op = cLOGOP->op_other;
-
-#define CX_PUSHGIVEN(cx, orig_var) \
- CX_PUSHWHEN(cx); \
- cx->blk_givwhen.defsv_save = orig_var;
-
-#define CX_POPWHEN(cx) \
- assert(CxTYPE(cx) == CXt_WHEN); \
- NOOP;
-
-#define CX_POPGIVEN(cx) \
- STMT_START { \
- SV *sv = GvSV(PL_defgv); \
- assert(CxTYPE(cx) == CXt_GIVEN); \
- GvSV(PL_defgv) = cx->blk_givwhen.defsv_save; \
- cx->blk_givwhen.defsv_save = NULL; \
- SvREFCNT_dec(sv); \
- } STMT_END
-
/* context common to subroutines, evals and loops */
#define blk_gimme cx_u.cx_blk.blku_gimme
#define blk_u16 cx_u.cx_blk.blku_u16
#define blk_oldsaveix cx_u.cx_blk.blku_oldsaveix
+#define blk_old_tmpsfloor cx_u.cx_blk.blku_old_tmpsfloor
#define blk_sub cx_u.cx_blk.blk_u.blku_sub
#define blk_format cx_u.cx_blk.blk_u.blku_format
#define blk_eval cx_u.cx_blk.blk_u.blku_eval
/* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP,
* CxFOREACH compare ranges */
-#define CXt_LOOP_ARY 4 /* for (@ary) {} */
-#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') {} */
-#define CXt_LOOP_LAZYIV 6 /* for (1..9) {} */
-#define CXt_LOOP_LIST 7 /* for (1,2,3) {} */
-#define CXt_LOOP_PLAIN 8 /* {} */
-
+#define CXt_LOOP_ARY 4 /* for (@ary) { ...; } */
+#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') { ...; } */
+#define CXt_LOOP_LAZYIV 6 /* for (1..9) { ...; } */
+#define CXt_LOOP_LIST 7 /* for (1,2,3) { ...; } */
+#define CXt_LOOP_PLAIN 8 /* while (...) { ...; }
+ or plain block { ...; } */
#define CXt_SUB 9
#define CXt_FORMAT 10
#define CXt_EVAL 11
} \
} STMT_END
-#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
-#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
+#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling)
+#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling)
*/
#define dMULTICALL \
- SV **newsp; /* set by cx_popblock */ \
- PERL_CONTEXT *cx; \
- CV *multicall_cv; \
- OP *multicall_cop; \
- bool multicall_oldcatch; \
- I32 saveix_floor; \
- U8 hasargs = 0 /* used by CX_PUSHSUB */
+ OP *multicall_cop; \
+ bool multicall_oldcatch
#define PUSH_MULTICALL(the_cv) \
PUSH_MULTICALL_FLAGS(the_cv, 0)
#define PUSH_MULTICALL_FLAGS(the_cv, flags) \
STMT_START { \
+ PERL_CONTEXT *cx; \
CV * const _nOnclAshIngNamE_ = the_cv; \
CV * const cv = _nOnclAshIngNamE_; \
PADLIST * const padlist = CvPADLIST(cv); \
multicall_oldcatch = CATCH_GET; \
CATCH_SET(TRUE); \
PUSHSTACKi(PERLSI_MULTICALL); \
- cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), gimme, \
+ cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), (U8)gimme, \
PL_stack_sp, PL_savestack_ix); \
- CX_PUSHSUB(cx, cv, NULL, hasargs); \
+ cx_pushsub(cx, cv, NULL, 0); \
SAVEOP(); \
- saveix_floor = PL_savestack_ix; \
if (!(flags & CXp_SUB_RE_FAKE)) \
CvDEPTH(cv)++; \
if (CvDEPTH(cv) >= 2) \
Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
- multicall_cv = cv; \
- PERL_UNUSED_VAR(multicall_cv); /* for API */ \
multicall_cop = CvSTART(cv); \
} STMT_END
STMT_START { \
PL_op = multicall_cop; \
CALLRUNOPS(aTHX); \
- cx = CX_CUR(); \
- LEAVE_SCOPE(saveix_floor); \
} STMT_END
#define POP_MULTICALL \
STMT_START { \
+ PERL_CONTEXT *cx; \
cx = CX_CUR(); \
CX_LEAVE_SCOPE(cx); \
- CX_POPSUB_COMMON(cx); \
- newsp = PL_stack_base + cx->blk_oldsp; \
+ cx_popsub_common(cx); \
gimme = cx->blk_gimme; \
- PERL_UNUSED_VAR(newsp); /* for API */ \
PERL_UNUSED_VAR(gimme); /* for API */ \
cx_popblock(cx); \
CX_POP(cx); \
CV * const _nOnclAshIngNamE_ = the_cv; \
CV * const cv = _nOnclAshIngNamE_; \
PADLIST * const padlist = CvPADLIST(cv); \
- cx = CX_CUR(); \
+ PERL_CONTEXT *cx = CX_CUR(); \
assert(CxMULTICALL(cx)); \
- CX_POPSUB_COMMON(cx); \
+ cx_popsub_common(cx); \
cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \
- CX_PUSHSUB(cx, cv, NULL, hasargs); \
+ cx_pushsub(cx, cv, NULL, 0); \
if (!(flags & CXp_SUB_RE_FAKE)) \
CvDEPTH(cv)++; \
if (CvDEPTH(cv) >= 2) \
Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
- multicall_cv = cv; \
multicall_cop = CvSTART(cv); \
} STMT_END
/*
https://perl5.git.perl.org / perl5.git / blobdiff