#define PP(s) OP * Perl_##s(pTHX)
/*
-=head1 Stack Manipulation Macros
+=for apidoc_section $stack
-=for apidoc AmU||SP
+=for apidoc AmnU||SP
Stack pointer. This is usually handled by C<xsubpp>. See C<L</dSP>> and
C<SPAGAIN>.
-=for apidoc AmU||MARK
+=for apidoc AmnU||MARK
Stack marker variable for the XSUB. See C<L</dMARK>>.
=for apidoc Am|void|PUSHMARK|SP
Opening bracket for arguments on a callback. See C<L</PUTBACK>> and
L<perlcall>.
-=for apidoc Ams||dSP
+=for apidoc Amns||dSP
Declares a local copy of perl's stack pointer for the XSUB, available via
the C<SP> macro. See C<L</SP>>.
See C<L<perlapi/SP>>. (Available for backward source code compatibility with
the old (Perl 5.005) thread model.)
-=for apidoc Ams||dMARK
+=for apidoc Amns||dMARK
Declare a stack marker variable, C<mark>, for the XSUB. See C<L</MARK>> and
C<L</dORIGMARK>>.
-=for apidoc Ams||dORIGMARK
+=for apidoc Amns||dORIGMARK
Saves the original stack mark for the XSUB. See C<L</ORIGMARK>>.
-=for apidoc AmU||ORIGMARK
+=for apidoc AmnU||ORIGMARK
The original stack mark for the XSUB. See C<L</dORIGMARK>>.
-=for apidoc Ams||SPAGAIN
+=for apidoc Amns||SPAGAIN
Refetch the stack pointer. Used after a callback. See L<perlcall>.
=cut */
#undef SP /* Solaris 2.7 i386 has this in /usr/include/sys/reg.h */
#define SP sp
#define MARK mark
+
+/*
+=for apidoc Amns||TARG
+
+C<TARG> is short for "target". It is an entry in the pad that an OPs
+C<op_targ> refers to. It is scratchpad space, often used as a return
+value for the OP, but some use it for other purposes.
+
+=cut
+*/
#define TARG targ
-#define PUSHMARK(p) \
- STMT_START { \
- I32 * mark_stack_entry; \
- if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
- mark_stack_entry = markstack_grow(); \
- *mark_stack_entry = (I32)((p) - PL_stack_base); \
- } STMT_END
+#define PUSHMARK(p) \
+ STMT_START { \
+ I32 * mark_stack_entry; \
+ if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) \
+ == PL_markstack_max)) \
+ mark_stack_entry = markstack_grow(); \
+ *mark_stack_entry = (I32)((p) - PL_stack_base); \
+ DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, \
+ "MARK push %p %" IVdf "\n", \
+ PL_markstack_ptr, (IV)*mark_stack_entry))); \
+ } STMT_END
+
+#define TOPMARK Perl_TOPMARK(aTHX)
+#define POPMARK Perl_POPMARK(aTHX)
-#define TOPMARK (*PL_markstack_ptr)
-#define POPMARK (*PL_markstack_ptr--)
+#define INCMARK \
+ STMT_START { \
+ DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, \
+ "MARK inc %p %" IVdf "\n", \
+ (PL_markstack_ptr+1), (IV)*(PL_markstack_ptr+1)))); \
+ PL_markstack_ptr++; \
+ } STMT_END
#define dSP SV **sp = PL_stack_sp
#define djSP dSP
#define dTARGETSTACKED SV * GETTARGETSTACKED
#define GETTARGET targ = PAD_SV(PL_op->op_targ)
+
+/*
+=for apidoc Amns||dTARGET
+Declare that this function uses C<TARG>
+
+=cut
+*/
#define dTARGET SV * GETTARGET
#define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ))
#define DIE return Perl_die
/*
-=for apidoc Ams||PUTBACK
+=for apidoc Amns||PUTBACK
Closing bracket for XSUB arguments. This is usually handled by C<xsubpp>.
See C<L</PUSHMARK>> and L<perlcall> for other uses.
for this element. Does not use C<TARG>. See also C<L</PUSHs>> and
C<L</mXPUSHs>>.
-=for apidoc Am|void|PUSHmortal
+=for apidoc Amn|void|PUSHmortal
Push a new mortal SV onto the stack. The stack must have room for this
element. Does not use C<TARG>. See also C<L</PUSHs>>, C<L</XPUSHmortal>> and
C<L</XPUSHs>>.
Push an SV onto the stack, extending the stack if necessary and mortalizes
the SV. Does not use C<TARG>. See also C<L</XPUSHs>> and C<L</mPUSHs>>.
-=for apidoc Am|void|XPUSHmortal
+=for apidoc Amn|void|XPUSHmortal
Push a new mortal SV onto the stack, extending the stack if necessary.
Does not use C<TARG>. See also C<L</XPUSHs>>, C<L</PUSHmortal>> and
C<L</PUSHs>>.
=cut
*/
+/* EXTEND_HWM_SET: note the high-water-mark to which the stack has been
+ * requested to be extended (which is likely to be less than PL_stack_max)
+ */
+#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+# define EXTEND_HWM_SET(p, n) \
+ STMT_START { \
+ SSize_t ix = (p) - PL_stack_base + (n); \
+ if (ix > PL_curstackinfo->si_stack_hwm) \
+ PL_curstackinfo->si_stack_hwm = ix; \
+ } STMT_END
+#else
+# define EXTEND_HWM_SET(p, n) NOOP
+#endif
+
/* _EXTEND_SAFE_N(n): private helper macro for EXTEND().
* Tests whether the value of n would be truncated when implicitly cast to
* SSize_t as an arg to stack_grow(). If so, sets it to -1 instead to
(sizeof(n) > sizeof(SSize_t) && ((SSize_t)(n) != (n)) ? -1 : (n))
#ifdef STRESS_REALLOC
+# define EXTEND_SKIP(p, n) EXTEND_HWM_SET(p, n)
+
# define EXTEND(p,n) STMT_START { \
sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \
PERL_UNUSED_VAR(sp); \
* this just gives a safe false positive
*/
-# define _EXTEND_NEEDS_GROW(p,n) ( (n) < 0 || PL_stack_max - p < (n))
+# define _EXTEND_NEEDS_GROW(p,n) ((n) < 0 || PL_stack_max - (p) < (n))
+
+
+/* EXTEND_SKIP(): used for where you would normally call EXTEND(), but
+ * you know for sure that a previous op will have already extended the
+ * stack sufficiently. For example pp_enteriter ensures that there
+ * is always at least 1 free slot, so pp_iter can return &PL_sv_yes/no
+ * without checking each time. Calling EXTEND_SKIP() defeats the HWM
+ * debugging mechanism which would otherwise whine
+ */
+
+# define EXTEND_SKIP(p, n) STMT_START { \
+ EXTEND_HWM_SET(p, n); \
+ assert(!_EXTEND_NEEDS_GROW(p,n)); \
+ } STMT_END
+
# define EXTEND(p,n) STMT_START { \
+ EXTEND_HWM_SET(p, n); \
if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \
sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \
PERL_UNUSED_VAR(sp); \
} } STMT_END
/* Same thing, but update mark register too. */
# define MEXTEND(p,n) STMT_START { \
+ EXTEND_HWM_SET(p, n); \
if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \
const SSize_t markoff = mark - PL_stack_base;\
sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \
} } STMT_END
#endif
+
+/* set TARG to the IV value i. If do_taint is false,
+ * assume that PL_tainted can never be true */
+#define TARGi(i, do_taint) \
+ STMT_START { \
+ IV TARGi_iv = i; \
+ if (LIKELY( \
+ ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \
+ & (do_taint ? !TAINT_get : 1))) \
+ { \
+ /* Cheap SvIOK_only(). \
+ * Assert that flags which SvIOK_only() would test or \
+ * clear can't be set, because we're SVt_IV */ \
+ assert(!(SvFLAGS(TARG) & \
+ (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \
+ SvFLAGS(TARG) |= (SVf_IOK|SVp_IOK); \
+ /* SvIV_set() where sv_any points to head */ \
+ TARG->sv_u.svu_iv = TARGi_iv; \
+ } \
+ else \
+ sv_setiv_mg(targ, TARGi_iv); \
+ } STMT_END
+
+/* set TARG to the UV value u. If do_taint is false,
+ * assume that PL_tainted can never be true */
+#define TARGu(u, do_taint) \
+ STMT_START { \
+ UV TARGu_uv = u; \
+ if (LIKELY( \
+ ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \
+ & (do_taint ? !TAINT_get : 1) \
+ & (TARGu_uv <= (UV)IV_MAX))) \
+ { \
+ /* Cheap SvIOK_only(). \
+ * Assert that flags which SvIOK_only() would test or \
+ * clear can't be set, because we're SVt_IV */ \
+ assert(!(SvFLAGS(TARG) & \
+ (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \
+ SvFLAGS(TARG) |= (SVf_IOK|SVp_IOK); \
+ /* SvIV_set() where sv_any points to head */ \
+ TARG->sv_u.svu_iv = TARGu_uv; \
+ } \
+ else \
+ sv_setuv_mg(targ, TARGu_uv); \
+ } STMT_END
+
+/* set TARG to the NV value n. If do_taint is false,
+ * assume that PL_tainted can never be true */
+#define TARGn(n, do_taint) \
+ STMT_START { \
+ NV TARGn_nv = n; \
+ if (LIKELY( \
+ ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST)) == SVt_NV) \
+ & (do_taint ? !TAINT_get : 1))) \
+ { \
+ /* Cheap SvNOK_only(). \
+ * Assert that flags which SvNOK_only() would test or \
+ * clear can't be set, because we're SVt_NV */ \
+ assert(!(SvFLAGS(TARG) & \
+ (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_NOK|SVp_NOK))))); \
+ SvFLAGS(TARG) |= (SVf_NOK|SVp_NOK); \
+ SvNV_set(TARG, TARGn_nv); \
+ } \
+ else \
+ sv_setnv_mg(targ, TARGn_nv); \
+ } STMT_END
+
#define PUSHs(s) (*++sp = (s))
#define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
#define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
-#define PUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); PUSHTARG; } STMT_END
-#define PUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
-#define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+#define PUSHn(n) STMT_START { TARGn(n,1); PUSHs(TARG); } STMT_END
+#define PUSHi(i) STMT_START { TARGi(i,1); PUSHs(TARG); } STMT_END
+#define PUSHu(u) STMT_START { TARGu(u,1); PUSHs(TARG); } STMT_END
#define XPUSHs(s) STMT_START { EXTEND(sp,1); *++sp = (s); } STMT_END
#define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
#define XPUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
-#define XPUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END
-#define XPUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
-#define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#define XPUSHn(n) STMT_START { TARGn(n,1); XPUSHs(TARG); } STMT_END
+#define XPUSHi(i) STMT_START { TARGi(i,1); XPUSHs(TARG); } STMT_END
+#define XPUSHu(u) STMT_START { TARGu(u,1); XPUSHs(TARG); } STMT_END
#define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END
#define mPUSHs(s) PUSHs(sv_2mortal(s))
#define mXPUSHs(s) XPUSHs(sv_2mortal(s))
#define XPUSHmortal XPUSHs(sv_newmortal())
#define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); mPUSHp((p), (l)); } STMT_END
-#define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
-#define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
-#define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
+#define mXPUSHn(n) STMT_START { EXTEND(sp,1); mPUSHn(n); } STMT_END
+#define mXPUSHi(i) STMT_START { EXTEND(sp,1); mPUSHi(i); } STMT_END
+#define mXPUSHu(u) STMT_START { EXTEND(sp,1); mPUSHu(u); } STMT_END
#define SETs(s) (*sp = s)
#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
#define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
-#define SETn(n) STMT_START { sv_setnv(TARG, (NV)(n)); SETTARG; } STMT_END
-#define SETi(i) STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
-#define SETu(u) STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END
+#define SETn(n) STMT_START { TARGn(n,1); SETs(TARG); } STMT_END
+#define SETi(i) STMT_START { TARGi(i,1); SETs(TARG); } STMT_END
+#define SETu(u) STMT_START { TARGu(u,1); SETs(TARG); } STMT_END
#define dTOPss SV *sv = TOPs
#define dPOPss SV *sv = POPs
#define AMGf_noright 1
#define AMGf_noleft 2
-#define AMGf_assign 4
+#define AMGf_assign 4 /* op supports mutator variant, e.g. $x += 1 */
#define AMGf_unary 8
#define AMGf_numeric 0x10 /* for Perl_try_amagic_bin */
-#define AMGf_set 0x20 /* for Perl_try_amagic_bin */
+
#define AMGf_want_list 0x40
#define AMGf_numarg 0x80
dSP; \
SV *tmpsv; \
SV *arg= *sp; \
- int gimme = GIMME_V; \
+ U8 gimme = GIMME_V; \
if (UNLIKELY(SvAMAGIC(arg) && \
(tmpsv = amagic_call(arg, &PL_sv_undef, meth, \
AMGf_want_list | AMGf_noright \
SSize_t i; \
SSize_t len; \
assert(SvTYPE(tmpsv) == SVt_PVAV); \
- len = av_tindex((AV *)tmpsv) + 1; \
+ len = av_count((AV *)tmpsv); \
(void)POPs; /* get rid of the arg */ \
EXTEND(sp, len); \
for (i = 0; i < len; ++i) \
else { /* AMGf_want_scalar */ \
dATARGET; /* just use the arg's location */ \
sv_setsv(TARG, tmpsv); \
- if (opASSIGN) \
+ if (PL_op->op_flags & OPf_STACKED) \
sp--; \
SETTARG; \
} \
while (jump_o->op_type == OP_NULL) \
jump_o = jump_o->op_next; \
assert(jump_o->op_type == OP_ENTERSUB); \
- PL_markstack_ptr--; \
+ (void)POPMARK; \
return jump_o->op_next; \
} \
return NORMAL; \
} STMT_END
+/* 2019: no longer used in core */
#define opASSIGN (PL_op->op_flags & OPf_STACKED)
/*
-=for apidoc mU||LVRET
+=for apidoc mnU||LVRET
True if this op will be the return value of an lvalue subroutine
=cut */
https://perl5.git.perl.org / perl5.git / blobdiff