X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/101d63659b7355370ff8d5a0076c0e456293458e..9dfe0a3438ae69872b71b98e4fb4f4bef084983d:/pp.h diff --git a/pp.h b/pp.h index 687b0ca..54a19ed 100644 --- a/pp.h +++ b/pp.h @@ -24,7 +24,7 @@ Stack marker variable for the XSUB. See C>. Opening bracket for arguments on a callback. See C> and L. -=for apidoc Ams||dSP +=for apidoc Amns||dSP Declares a local copy of perl's stack pointer for the XSUB, available via the C macro. See C>. @@ -35,17 +35,17 @@ a local copy of perl's stack pointer, available via the C macro. See C>. (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, for the XSUB. See C> and C>. -=for apidoc Ams||dORIGMARK +=for apidoc Amns||dORIGMARK Saves the original stack mark for the XSUB. See C>. =for apidoc AmU||ORIGMARK The original stack mark for the XSUB. See C>. -=for apidoc Ams||SPAGAIN +=for apidoc Amns||SPAGAIN Refetch the stack pointer. Used after a callback. See L. =cut */ @@ -55,47 +55,28 @@ Refetch the stack pointer. Used after a callback. See L. #define MARK mark #define TARG targ -#if defined(DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) -# define PUSHMARK(p) \ +#define PUSHMARK(p) \ STMT_START { \ I32 * mark_stack_entry; \ - if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \ + 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(PerlIO_printf(Perl_debug_log, "MARK push %p %d\n", \ - PL_markstack_ptr, *mark_stack_entry)); \ + 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 \ - ({ \ - DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK top %p %d\n", \ - PL_markstack_ptr, *PL_markstack_ptr)); \ - *PL_markstack_ptr; \ - }) -# define POPMARK \ - ({ \ - DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK pop %p %d\n", \ - (PL_markstack_ptr-1), *(PL_markstack_ptr-1))); \ - assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");\ - *PL_markstack_ptr--; \ - }) -# define INCMARK \ - ({ \ - DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK inc %p %d\n", \ - (PL_markstack_ptr+1), *(PL_markstack_ptr+1))); \ - *PL_markstack_ptr++; \ - }) -#else -# 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); \ + +#define TOPMARK S_TOPMARK(aTHX) +#define POPMARK S_POPMARK(aTHX) + +#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 TOPMARK (*PL_markstack_ptr) -# define POPMARK (*PL_markstack_ptr--) -# define INCMARK (*PL_markstack_ptr++) -#endif #define dSP SV **sp = PL_stack_sp #define djSP dSP @@ -121,7 +102,7 @@ Refetch the stack pointer. Used after a callback. See L. #define DIE return Perl_die /* -=for apidoc Ams||PUTBACK +=for apidoc Amns||PUTBACK Closing bracket for XSUB arguments. This is usually handled by C. See C> and L for other uses. @@ -314,6 +295,20 @@ Does not use C. See also C>, C> and C>. =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 @@ -325,6 +320,8 @@ Does not use C. See also C>, C> and C>. (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); \ @@ -354,15 +351,32 @@ Does not use C. See also C>, C> and C>. * 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 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)); \ @@ -371,13 +385,14 @@ Does not use C. See also C>, C> and C>. } } 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)) == SVt_IV) \ + ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ & (do_taint ? !TAINT_get : 1))) \ { \ /* Cheap SvIOK_only(). \ @@ -399,7 +414,7 @@ Does not use C. See also C>, C> and C>. STMT_START { \ UV TARGu_uv = u; \ if (LIKELY( \ - ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST)) == SVt_IV) \ + ((SvFLAGS(TARG) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ & (do_taint ? !TAINT_get : 1) \ & (TARGu_uv <= (UV)IV_MAX))) \ { \ @@ -462,9 +477,9 @@ Does not use C. See also C>, C> and C>. #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 @@ -538,10 +553,10 @@ Does not use C. See also C>, C> and C>. #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 @@ -570,7 +585,7 @@ Does not use C. See also C>, C> and C>. 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 \ @@ -593,7 +608,7 @@ Does not use C. See also C>, C> and C>. 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; \ } \ @@ -619,6 +634,7 @@ Does not use C. See also C>, C> and C>. } STMT_END +/* 2019: no longer used in core */ #define opASSIGN (PL_op->op_flags & OPf_STACKED) /*