X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/bc0d193fb675e057840d0947b6bef8da756b5429..f3a0defb95e2da85126a0bd17bf5d67899fff9b3:/pp.h diff --git a/pp.h b/pp.h index 9c805c6..f1db6b7 100644 --- a/pp.h +++ b/pp.h @@ -1,7 +1,7 @@ /* pp.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, + * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -59,7 +59,7 @@ Refetch the stack pointer. Used after a callback. See L. STMT_START { \ if (++PL_markstack_ptr == PL_markstack_max) \ markstack_grow(); \ - *PL_markstack_ptr = (p) - PL_stack_base; \ + *PL_markstack_ptr = (I32)((p) - PL_stack_base);\ } STMT_END #define TOPMARK (*PL_markstack_ptr) @@ -68,7 +68,7 @@ Refetch the stack pointer. Used after a callback. See L. #define dSP SV **sp = PL_stack_sp #define djSP dSP #define dMARK register SV **mark = PL_stack_base + POPMARK -#define dORIGMARK const I32 origmark = mark - PL_stack_base +#define dORIGMARK const I32 origmark = (I32)(mark - PL_stack_base) #define ORIGMARK (PL_stack_base + origmark) #define SPAGAIN sp = PL_stack_sp @@ -224,55 +224,55 @@ called to declare it. Do not call multiple C-oriented macros to return lists from XSUB's - see C instead. See also C and C. +=for apidoc Am|void|mPUSHs|SV* sv +Push an SV onto the stack and mortalizes the SV. The stack must have room +for this element. Does not use C. See also C and C. + =for apidoc Am|void|PUSHmortal Push a new mortal SV onto the stack. The stack must have room for this -element. Does not handle 'set' magic. Does not use C. See also -C, C and C. +element. Does not use C. See also C, C and C. =for apidoc Am|void|mPUSHp|char* str|STRLEN len Push a string onto the stack. The stack must have room for this element. -The C indicates the length of the string. Handles 'set' magic. Does -not use C. See also C, C and C. +The C indicates the length of the string. Does not use C. +See also C, C and C. =for apidoc Am|void|mPUSHn|NV nv Push a double onto the stack. The stack must have room for this element. -Handles 'set' magic. Does not use C. See also C, C -and C. +Does not use C. See also C, C and C. =for apidoc Am|void|mPUSHi|IV iv Push an integer onto the stack. The stack must have room for this element. -Handles 'set' magic. Does not use C. See also C, C -and C. +Does not use C. See also C, C and C. =for apidoc Am|void|mPUSHu|UV uv Push an unsigned integer onto the stack. The stack must have room for this -element. Handles 'set' magic. Does not use C. See also C, -C and C. +element. Does not use C. See also C, C and C. + +=for apidoc Am|void|mXPUSHs|SV* sv +Push an SV onto the stack, extending the stack if necessary and mortalizes +the SV. Does not use C. See also C and C. =for apidoc Am|void|XPUSHmortal -Push a new mortal SV onto the stack, extending the stack if necessary. Does -not handle 'set' magic. Does not use C. See also C, -C and C. +Push a new mortal SV onto the stack, extending the stack if necessary. +Does not use C. See also C, C and C. =for apidoc Am|void|mXPUSHp|char* str|STRLEN len Push a string onto the stack, extending the stack if necessary. The C -indicates the length of the string. Handles 'set' magic. Does not use -C. See also C, C and C. +indicates the length of the string. Does not use C. See also C, +C and C. =for apidoc Am|void|mXPUSHn|NV nv -Push a double onto the stack, extending the stack if necessary. Handles -'set' magic. Does not use C. See also C, C and -C. +Push a double onto the stack, extending the stack if necessary. +Does not use C. See also C, C and C. =for apidoc Am|void|mXPUSHi|IV iv -Push an integer onto the stack, extending the stack if necessary. Handles -'set' magic. Does not use C. See also C, C and -C. +Push an integer onto the stack, extending the stack if necessary. +Does not use C. See also C, C and C. =for apidoc Am|void|mXPUSHu|UV uv Push an unsigned integer onto the stack, extending the stack if necessary. -Handles 'set' magic. Does not use C. See also C, C -and C. +Does not use C. See also C, C and C. =cut */ @@ -303,17 +303,19 @@ and C. #define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END #define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END +#define mPUSHs(s) PUSHs(sv_2mortal(s)) #define PUSHmortal PUSHs(sv_newmortal()) -#define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l)) -#define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n)) -#define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i)) -#define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u)) +#define mPUSHp(p,l) PUSHs(newSVpvn_flags((p), (l), SVs_TEMP)) +#define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) +#define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) +#define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) +#define mXPUSHs(s) XPUSHs(sv_2mortal(s)) #define XPUSHmortal XPUSHs(sv_newmortal()) -#define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END -#define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END -#define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END -#define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END +#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 SETs(s) (*sp = s) #define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END @@ -326,6 +328,7 @@ and C. #define dPOPss SV *sv = POPs #define dTOPnv NV value = TOPn #define dPOPnv NV value = POPn +#define dPOPnv_nomg NV value = (sp--, SvNV_nomg(TOPp1s)) #define dTOPiv IV value = TOPi #define dPOPiv IV value = POPi #define dTOPuv UV value = TOPu @@ -351,6 +354,10 @@ and C. IV right = POPi; \ SV *leftsv = CAT2(X,s); \ IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0 +#define dPOPXiirl_ul_nomg(X) \ + IV right = POPi; \ + SV *leftsv = CAT2(X,s); \ + IV left = USE_LEFT(leftsv) ? SvIV_nomg(leftsv) : 0 #define dPOPPOPssrl dPOPXssrl(POP) #define dPOPPOPnnrl dPOPXnnrl(POP) @@ -361,8 +368,13 @@ and C. #define dPOPTOPssrl dPOPXssrl(TOP) #define dPOPTOPnnrl dPOPXnnrl(TOP) #define dPOPTOPnnrl_ul dPOPXnnrl_ul(TOP) +#define dPOPTOPnnrl_nomg \ + NV right = SvNV_nomg(TOPs); NV left = (sp--, SvNV_nomg(TOPs)) #define dPOPTOPiirl dPOPXiirl(TOP) #define dPOPTOPiirl_ul dPOPXiirl_ul(TOP) +#define dPOPTOPiirl_ul_nomg dPOPXiirl_ul_nomg(TOP) +#define dPOPTOPiirl_nomg \ + IV right = SvIV_nomg(TOPs); IV left = (sp--, SvIV_nomg(TOPs)) #define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes)) #define RETPUSHNO RETURNX(PUSHs(&PL_sv_no)) @@ -396,6 +408,26 @@ and C. #define AMGf_noleft 2 #define AMGf_assign 4 #define AMGf_unary 8 +#define AMGf_numeric 0x10 /* for Perl_try_amagic_bin */ +#define AMGf_set 0x20 /* for Perl_try_amagic_bin */ + + +/* do SvGETMAGIC on the stack args before checking for overload */ + +#define tryAMAGICun_MG(method, flags) STMT_START { \ + if ( (SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG)) \ + && Perl_try_amagic_un(aTHX_ method, flags)) \ + return NORMAL; \ + } STMT_END +#define tryAMAGICbin_MG(method, flags) STMT_START { \ + if ( ((SvFLAGS(TOPm1s)|SvFLAGS(TOPs)) & (SVf_ROK|SVs_GMG)) \ + && Perl_try_amagic_bin(aTHX_ method, flags)) \ + return NORMAL; \ + } STMT_END + +/* these tryAMAGICun* tryAMAGICbin* macros are no longer used in core + * (except for tryAMAGICunDEREF*, tryAMAGICunTARGET), + * and are only here for backwards compatibility */ #define tryAMAGICbinW_var(meth_enum,assign,set) STMT_START { \ SV* const left = *(sp-1); \ @@ -448,6 +480,7 @@ and C. #define tryAMAGICun_var(meth_enum) tryAMAGICunW_var(meth_enum,SETsvUN,0,RETURN) #define tryAMAGICun(meth) tryAMAGICun_var(CAT2(meth,_amg)) +#define tryAMAGICunSET_var(meth_enum) tryAMAGICunW_var(meth_enum,SETs,0,RETURN) #define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0,RETURN) #define tryAMAGICunTARGET(meth, shift) \ STMT_START { dSP; sp--; /* get TARGET from below PL_stack_sp */ \ @@ -469,6 +502,40 @@ and C. #define tryAMAGICunDEREF_var(meth_enum) \ tryAMAGICunW_var(meth_enum,setAGAIN,0,(void)0) +/* this macro is obsolete and is only here for backwards compatibility */ + +#define tryAMAGICftest(chr) \ + STMT_START { \ + assert(chr != '?'); \ + SvGETMAGIC(TOPs); \ + if ((PL_op->op_flags & OPf_KIDS) \ + && SvAMAGIC(TOPs)) { \ + const char tmpchr = (chr); \ + SV * const tmpsv = amagic_call(TOPs, \ + newSVpvn_flags(&tmpchr, 1, SVs_TEMP), \ + ftest_amg, AMGf_unary); \ + \ + if (tmpsv) { \ + const OP *next = PL_op->op_next; \ + \ + SPAGAIN; \ + \ + if (next->op_type >= OP_FTRREAD && \ + next->op_type <= OP_FTBINARY && \ + next->op_private & OPpFT_STACKED \ + ) { \ + if (SvTRUE(tmpsv)) \ + /* leave the object alone */ \ + RETURN; \ + } \ + \ + SETs(tmpsv); \ + RETURN; \ + } \ + } \ + } STMT_END + + #define opASSIGN (PL_op->op_flags & OPf_STACKED) #define SETsv(sv) STMT_START { \ if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY)) \ @@ -485,9 +552,10 @@ and C. /* SV* ref causes confusion with the member variable changed SV* ref to SV* tmpRef */ -#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \ - if (SvREFCNT(tmpRef)>1) { \ - SvRV_set(rv, AMG_CALLun(rv,copy)); \ +#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); SV* rv_copy; \ + if (SvREFCNT(tmpRef)>1 && (rv_copy = AMG_CALLun(rv,copy))) { \ + SvRV_set(rv, rv_copy); \ + SvSETMAGIC(rv); \ SvREFCNT_dec(tmpRef); \ } } STMT_END @@ -498,6 +566,15 @@ True if this op will be the return value of an lvalue subroutine =cut */ #define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub()) +#define SvCANEXISTDELETE(sv) \ + (!SvRMAGICAL(sv) \ + || ((mg = mg_find((const SV *) sv, PERL_MAGIC_tied)) \ + && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \ + && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) \ + && gv_fetchmethod_autoload(stash, "DELETE", TRUE) \ + ) \ + ) + /* * Local variables: * c-indentation-style: bsd