/* ------------------------------- cv.h ------------------------------- */
+PERL_STATIC_INLINE GV *
+S_CvGV(pTHX_ CV *sv)
+{
+ return CvNAMED(sv)
+ ? Perl_cvgv_from_hek(aTHX_ sv)
+ : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
+}
+
PERL_STATIC_INLINE I32 *
S_CvDEPTHp(const CV * const sv)
{
}
#endif
+/* ------------------------------- pad.h ------------------------------ */
+
+#if defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C)
+PERL_STATIC_INLINE bool
+PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq)
+{
+ /* is seq within the range _LOW to _HIGH ?
+ * This is complicated by the fact that PL_cop_seqmax
+ * may have wrapped around at some point */
+ if (COP_SEQ_RANGE_LOW(pn) == PERL_PADSEQ_INTRO)
+ return FALSE; /* not yet introduced */
+
+ if (COP_SEQ_RANGE_HIGH(pn) == PERL_PADSEQ_INTRO) {
+ /* in compiling scope */
+ if (
+ (seq > COP_SEQ_RANGE_LOW(pn))
+ ? (seq - COP_SEQ_RANGE_LOW(pn) < (U32_MAX >> 1))
+ : (COP_SEQ_RANGE_LOW(pn) - seq > (U32_MAX >> 1))
+ )
+ return TRUE;
+ }
+ else if (
+ (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn))
+ ?
+ ( seq > COP_SEQ_RANGE_LOW(pn)
+ || seq <= COP_SEQ_RANGE_HIGH(pn))
+
+ : ( seq > COP_SEQ_RANGE_LOW(pn)
+ && seq <= COP_SEQ_RANGE_HIGH(pn))
+ )
+ return TRUE;
+ return FALSE;
+}
+#endif
+
/* ----------------------------- regexp.h ----------------------------- */
PERL_STATIC_INLINE struct regexp *
}
PERL_STATIC_INLINE U32
-S_SvPADTMP_on(SV *sv)
-{
- assert(!(SvFLAGS(sv) & SVs_PADMY));
- return SvFLAGS(sv) |= SVs_PADTMP;
-}
-PERL_STATIC_INLINE U32
-S_SvPADTMP_off(SV *sv)
-{
- assert(!(SvFLAGS(sv) & SVs_PADMY));
- return SvFLAGS(sv) &= ~SVs_PADTMP;
-}
-PERL_STATIC_INLINE U32
S_SvPADSTALE_on(SV *sv)
{
- assert(SvFLAGS(sv) & SVs_PADMY);
+ assert(!(SvFLAGS(sv) & SVs_PADTMP));
return SvFLAGS(sv) |= SVs_PADSTALE;
}
PERL_STATIC_INLINE U32
S_SvPADSTALE_off(SV *sv)
{
- assert(SvFLAGS(sv) & SVs_PADMY);
+ assert(!(SvFLAGS(sv) & SVs_PADTMP));
return SvFLAGS(sv) &= ~SVs_PADSTALE;
}
#if defined(PERL_CORE) || defined (PERL_EXT)
/* ------------------------------- handy.h ------------------------------- */
/* saves machine code for a common noreturn idiom typically used in Newx*() */
-GCC_DIAG_IGNORE(-Wunused-function)
+#ifdef GCC_DIAG_PRAGMA
+GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
+#endif
static void
S_croak_memory_wrap(void)
{
Perl_croak_nocontext("%s",PL_memory_wrap);
}
-GCC_DIAG_RESTORE;
+#ifdef GCC_DIAG_PRAGMA
+GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
+#endif
/* ------------------------------- utf8.h ------------------------------- */
=for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
Test that the given C<pv> doesn't contain any internal C<NUL> characters.
-If it does, set C<errno> to ENOENT, optionally warn, and return FALSE.
+If it does, set C<errno> to C<ENOENT>, optionally warn, and return FALSE.
Return TRUE if the name is safe.
-Used by the IS_SAFE_SYSCALL() macro.
+Used by the C<IS_SAFE_SYSCALL()> macro.
=cut
*/
PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
- if (pv && len > 1) {
+ if (len > 1) {
char *null_at;
if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
SETERRNO(ENOENT, LIB_INVARG);
/*
Return true if the supplied filename has a newline character
-immediately before the final NUL.
+immediately before the first (hopefully only) NUL.
My original look at this incorrectly used the len from SvPV(), but
that's incorrect, since we allow for a NUL in pv[len-1].
}
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
+
+Return false if any get magic is on the SV other than taint magic.
+
+*/
+
+PERL_STATIC_INLINE bool
+S_sv_only_taint_gmagic(SV *sv) {
+ MAGIC *mg = SvMAGIC(sv);
+
+ PERL_ARGS_ASSERT_SV_ONLY_TAINT_GMAGIC;
+
+ while (mg) {
+ if (mg->mg_type != PERL_MAGIC_taint
+ && !(mg->mg_flags & MGf_GSKIP)
+ && mg->mg_virtual->svt_get) {
+ return FALSE;
+ }
+ mg = mg->mg_moremagic;
+ }
+
+ return TRUE;
+}
+
+/* ------------------ cop.h ------------------------------------------- */
+
+
+/* Enter a block. Push a new base context and return its address. */
+
+PERL_STATIC_INLINE PERL_CONTEXT *
+S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix)
+{
+ PERL_CONTEXT * cx;
+
+ PERL_ARGS_ASSERT_CX_PUSHBLOCK;
+
+ CXINC;
+ cx = CX_CUR();
+ cx->cx_type = type;
+ cx->blk_gimme = gimme;
+ cx->blk_oldsaveix = saveix;
+ cx->blk_oldsp = (I32)(sp - PL_stack_base);
+ cx->blk_oldcop = PL_curcop;
+ cx->blk_oldmarksp = (I32)(PL_markstack_ptr - PL_markstack);
+ cx->blk_oldscopesp = PL_scopestack_ix;
+ cx->blk_oldpm = PL_curpm;
+ cx->blk_old_tmpsfloor = PL_tmps_floor;
+
+ PL_tmps_floor = PL_tmps_ix;
+ CX_DEBUG(cx, "PUSH");
+ return cx;
+}
+
+
+/* Exit a block (RETURN and LAST). */
+
+PERL_STATIC_INLINE void
+S_cx_popblock(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_POPBLOCK;
+
+ CX_DEBUG(cx, "POP");
+ /* these 3 are common to cx_popblock and cx_topblock */
+ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
+ PL_scopestack_ix = cx->blk_oldscopesp;
+ PL_curpm = cx->blk_oldpm;
+
+ /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats
+ * and leaves a CX entry lying around for repeated use, so
+ * skip for multicall */ \
+ assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx))
+ || PL_savestack_ix == cx->blk_oldsaveix);
+ PL_curcop = cx->blk_oldcop;
+ PL_tmps_floor = cx->blk_old_tmpsfloor;
+}
+
+/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO).
+ * Whereas cx_popblock() restores the state to the point just before
+ * cx_pushblock() was called, cx_topblock() restores it to the point just
+ * *after* cx_pushblock() was called. */
+
+PERL_STATIC_INLINE void
+S_cx_topblock(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_TOPBLOCK;
+
+ CX_DEBUG(cx, "TOP");
+ /* these 3 are common to cx_popblock and cx_topblock */
+ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
+ PL_scopestack_ix = cx->blk_oldscopesp;
+ PL_curpm = cx->blk_oldpm;
+
+ PL_stack_sp = PL_stack_base + cx->blk_oldsp;
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
+{
+ U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub);
+
+ PERL_ARGS_ASSERT_CX_PUSHSUB;
+
+ PERL_DTRACE_PROBE_ENTRY(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 = retop;
+ SvREFCNT_inc_simple_void_NN(cv);
+ cx->blk_u16 = PL_op->op_private & (phlags|OPpDEREF);
+}
+
+
+/* subsets of cx_popsub() */
+
+PERL_STATIC_INLINE void
+S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx)
+{
+ CV *cv;
+
+ PERL_ARGS_ASSERT_CX_POPSUB_COMMON;
+ 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);
+}
+
+
+/* handle the @_ part of leaving a sub */
+
+PERL_STATIC_INLINE void
+S_cx_popsub_args(pTHX_ PERL_CONTEXT *cx)
+{
+ AV *av;
+
+ PERL_ARGS_ASSERT_CX_POPSUB_ARGS;
+ 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);
+ }
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_POPSUB;
+ assert(CxTYPE(cx) == CXt_SUB);
+
+ PERL_DTRACE_PROBE_RETURN(cx->blk_sub.cv);
+
+ if (CxHASARGS(cx))
+ cx_popsub_args(cx);
+ cx_popsub_common(cx);
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_pushformat(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, GV *gv)
+{
+ PERL_ARGS_ASSERT_CX_PUSHFORMAT;
+
+ cx->blk_format.cv = cv;
+ cx->blk_format.retop = retop;
+ cx->blk_format.gv = gv;
+ 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);
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popformat(pTHX_ PERL_CONTEXT *cx)
+{
+ CV *cv;
+ GV *dfout;
+
+ PERL_ARGS_ASSERT_CX_POPFORMAT;
+ assert(CxTYPE(cx) == CXt_FORMAT);
+
+ dfout = cx->blk_format.dfoutgv;
+ setdefout(dfout);
+ cx->blk_format.dfoutgv = NULL;
+ SvREFCNT_dec_NN(dfout);
+
+ 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);
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv)
+{
+ PERL_ARGS_ASSERT_CX_PUSHEVAL;
+
+ cx->blk_eval.retop = retop;
+ cx->blk_eval.old_namesv = namesv;
+ 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; /* later set by doeval_compile() */
+ cx->blk_eval.cur_top_env = PL_top_env;
+
+ assert(!(PL_in_eval & ~ 0x7F));
+ assert(!(PL_op->op_type & ~0x1FF));
+ cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7);
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popeval(pTHX_ PERL_CONTEXT *cx)
+{
+ SV *sv;
+
+ PERL_ARGS_ASSERT_CX_POPEVAL;
+ 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);
+}
+
+
+/* push a plain loop, i.e.
+ * { block }
+ * while (cond) { block }
+ * for (init;cond;continue) { block }
+ * This loop can be last/redo'ed etc.
+ */
+
+PERL_STATIC_INLINE void
+S_cx_pushloop_plain(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_PUSHLOOP_PLAIN;
+ cx->blk_loop.my_op = cLOOP;
+}
+
+
+/* push a true for loop, i.e.
+ * for var (list) { block }
+ */
+
+PERL_STATIC_INLINE void
+S_cx_pushloop_for(pTHX_ PERL_CONTEXT *cx, void *itervarp, SV* itersave)
+{
+ PERL_ARGS_ASSERT_CX_PUSHLOOP_FOR;
+
+ /* this one line is common with cx_pushloop_plain */
+ cx->blk_loop.my_op = cLOOP;
+
+ cx->blk_loop.itervar_u.svp = (SV**)itervarp;
+ cx->blk_loop.itersave = itersave;
+#ifdef USE_ITHREADS
+ cx->blk_loop.oldcomppad = PL_comppad;
+#endif
+}
+
+
+/* pop all loop types, including plain */
+
+PERL_STATIC_INLINE void
+S_cx_poploop(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_POPLOOP;
+
+ 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);
+ }
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_pushwhen(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_PUSHWHEN;
+
+ cx->blk_givwhen.leave_op = cLOGOP->op_other;
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popwhen(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_POPWHEN;
+ assert(CxTYPE(cx) == CXt_WHEN);
+
+ PERL_UNUSED_ARG(cx);
+ /* currently NOOP */
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_pushgiven(pTHX_ PERL_CONTEXT *cx, SV *orig_defsv)
+{
+ PERL_ARGS_ASSERT_CX_PUSHGIVEN;
+
+ cx->blk_givwhen.leave_op = cLOGOP->op_other;
+ cx->blk_givwhen.defsv_save = orig_defsv;
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popgiven(pTHX_ PERL_CONTEXT *cx)
+{
+ SV *sv;
+
+ PERL_ARGS_ASSERT_CX_POPGIVEN;
+ assert(CxTYPE(cx) == CXt_GIVEN);
+
+ sv = GvSV(PL_defgv);
+ GvSV(PL_defgv) = cx->blk_givwhen.defsv_save;
+ cx->blk_givwhen.defsv_save = NULL;
+ SvREFCNT_dec(sv);
+}
+
+
+
+
+/*
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff