X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d3c7a87b9b292c7e0ab3f11b2e598f11a89d808a..445f13ff0d8bfc70e382b8372318dad6ad0d9bd2:/sv.h diff --git a/sv.h b/sv.h index 97ce119..18d3015 100644 --- a/sv.h +++ b/sv.h @@ -224,42 +224,10 @@ perform the upgrade if necessary. See C. #define SvFLAGS(sv) (sv)->sv_flags #define SvREFCNT(sv) (sv)->sv_refcnt -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define SvREFCNT_inc(sv) \ - ({ \ - SV * const _sv = MUTABLE_SV(sv); \ - if (_sv) \ - (SvREFCNT(_sv))++; \ - _sv; \ - }) -# define SvREFCNT_inc_simple(sv) \ - ({ \ - if (sv) \ - (SvREFCNT(sv))++; \ - MUTABLE_SV(sv); \ - }) -# define SvREFCNT_inc_NN(sv) \ - ({ \ - SV * const _sv = MUTABLE_SV(sv); \ - SvREFCNT(_sv)++; \ - _sv; \ - }) -# define SvREFCNT_inc_void(sv) \ - ({ \ - SV * const _sv = MUTABLE_SV(sv); \ - if (_sv) \ - (void)(SvREFCNT(_sv)++); \ - }) -#else -# define SvREFCNT_inc(sv) \ - ((PL_Sv=MUTABLE_SV(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) -# define SvREFCNT_inc_simple(sv) \ - ((sv) ? (SvREFCNT(sv)++,MUTABLE_SV(sv)) : NULL) -# define SvREFCNT_inc_NN(sv) \ - (PL_Sv=MUTABLE_SV(sv),++(SvREFCNT(PL_Sv)),PL_Sv) -# define SvREFCNT_inc_void(sv) \ - (void)((PL_Sv=MUTABLE_SV(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) -#endif +#define SvREFCNT_inc(sv) S_SvREFCNT_inc(MUTABLE_SV(sv)) +#define SvREFCNT_inc_simple(sv) SvREFCNT_inc(sv) +#define SvREFCNT_inc_NN(sv) S_SvREFCNT_inc_NN(MUTABLE_SV(sv)) +#define SvREFCNT_inc_void(sv) S_SvREFCNT_inc_void(MUTABLE_SV(sv)) /* These guys don't need the curly blocks */ #define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END @@ -267,22 +235,7 @@ perform the upgrade if necessary. See C. #define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) #define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define SvREFCNT_dec(sv) \ - ({ \ - SV * const _sv = MUTABLE_SV(sv); \ - if (_sv) { \ - if (SvREFCNT(_sv)) { \ - if (--(SvREFCNT(_sv)) == 0) \ - Perl_sv_free2(aTHX_ _sv); \ - } else { \ - sv_free(_sv); \ - } \ - } \ - }) -#else -#define SvREFCNT_dec(sv) sv_free(MUTABLE_SV(sv)) -#endif +#define SvREFCNT_dec(sv) S_SvREFCNT_dec(aTHX_ MUTABLE_SV(sv)) #define SVTYPEMASK 0xff #define SvTYPE(sv) ((svtype)((sv)->sv_flags & SVTYPEMASK)) @@ -302,12 +255,12 @@ perform the upgrade if necessary. See C. #define SVp_IOK 0x00001000 /* has valid non-public integer value */ #define SVp_NOK 0x00002000 /* has valid non-public numeric value */ #define SVp_POK 0x00004000 /* has valid non-public pointer value */ -#define SVp_SCREAM 0x00008000 /* has been studied? */ +#define SVp_SCREAM 0x00008000 /* method name is DOES */ #define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects */ #define SVpgv_GP SVp_SCREAM /* GV has a valid GP */ #define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant subroutine in another package. Set the - CvIMPORTED_CV_ON() if it needs to be + GvIMPORTED_CV_on() if it needs to be expanded to a real GV */ /* 0x00010000 *** FREE SLOT */ #define SVs_PADTMP 0x00020000 /* in use as tmp; only if ! SVs_PADMY */ @@ -348,7 +301,7 @@ perform the upgrade if necessary. See C. -#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE) +#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE|SVs_RMG) #define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \ SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP) @@ -378,7 +331,7 @@ perform the upgrade if necessary. See C. SVf_POK, SVp_POK also set: 0x00004400 Normal - 0x0000C400 Studied (SvSCREAM) + 0x0000C400 method name for DOES (SvSCREAM) 0x40004400 FBM compiled (SvVALID) 0x4000C400 pad name. @@ -494,8 +447,6 @@ struct xpvgv { union _xnvu xnv_u; }; -/* This structure must match XPVCV in cv.h */ - typedef U16 cv_flags_t; #define _XPVCV_COMMON \ @@ -508,19 +459,24 @@ typedef U16 cv_flags_t; OP * xcv_root; \ void (*xcv_xsub) (pTHX_ CV*); \ } xcv_root_u; \ - GV * xcv_gv; \ + union { \ + GV * xcv_gv; \ + HEK * xcv_hek; \ + } xcv_gv_u; \ char * xcv_file; \ - AV * xcv_padlist; \ + PADLIST * xcv_padlist; \ CV * xcv_outside; \ U32 xcv_outside_seq; /* the COP sequence (at the point of our \ * compilation) in the lexically enclosing \ * sub */ \ - cv_flags_t xcv_flags + cv_flags_t xcv_flags; \ + I32 xcv_depth /* >= 2 indicates recursive call */ + +/* This structure must match XPVCV in cv.h */ struct xpvfm { _XPV_HEAD; _XPVCV_COMMON; - IV xfm_lines; }; @@ -748,13 +704,8 @@ Set the actual length of the string which is in the SV. See C. #define SvNIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \ SVp_IOK|SVp_NOK|SVf_IVisUV)) -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -#define assert_not_ROK(sv) ({assert(!SvROK(sv) || !SvRV(sv));}), -#define assert_not_glob(sv) ({assert(!isGV_with_GP(sv));}), -#else -#define assert_not_ROK(sv) -#define assert_not_glob(sv) -#endif +#define assert_not_ROK(sv) assert_(!SvROK(sv) || !SvRV(sv)) +#define assert_not_glob(sv) assert_(!isGV_with_GP(sv)) #define SvOK(sv) ((SvTYPE(sv) == SVt_BIND) \ ? (SvFLAGS(SvRV(sv)) & SVf_OK) \ @@ -881,30 +832,38 @@ in gv.h: */ #define SvAMAGIC(sv) (SvROK(sv) && SvOBJECT(SvRV(sv)) && \ HvAMAGIC(SvSTASH(SvRV(sv)))) -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define SvAMAGIC_on(sv) ({ SV * const kloink = sv; \ - assert(SvROK(kloink)); \ - if (SvOBJECT(SvRV(kloink))) \ - HvAMAGIC_on(SvSTASH(SvRV(kloink))); \ - }) -# define SvAMAGIC_off(sv) ({ SV * const kloink = sv; \ - if(SvROK(kloink) \ - && SvOBJECT(SvRV(kloink))) \ - HvAMAGIC_off(SvSTASH(SvRV(kloink))); \ - }) -#else -# define SvAMAGIC_on(sv) \ - SvOBJECT(SvRV(sv)) && (SvFLAGS(SvSTASH(SvRV(sv))) |= SVf_AMAGIC) -# define SvAMAGIC_off(sv) \ - (SvROK(sv) && SvOBJECT(SvRV(sv)) \ - && (SvFLAGS(SvSTASH(SvRV(sv))) &= ~SVf_AMAGIC)) -#endif /* To be used on the stashes themselves: */ #define HvAMAGIC(hv) (SvFLAGS(hv) & SVf_AMAGIC) #define HvAMAGIC_on(hv) (SvFLAGS(hv) |= SVf_AMAGIC) #define HvAMAGIC_off(hv) (SvFLAGS(hv) &=~ SVf_AMAGIC) + +#define SvPOK_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK) +#define SvIOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVs_GMG)) == SVf_IOK) +#define SvUOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) +#define SvNOK_nog(sv) ((SvFLAGS(sv) & (SVf_NOK|SVs_GMG)) == SVf_NOK) +#define SvNIOK_nog(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & SVs_GMG)) + +#define SvPOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) +#define SvIOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_THINKFIRST|SVs_GMG)) == SVf_IOK) +#define SvUOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVf_THINKFIRST|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) +#define SvNOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_NOK|SVf_THINKFIRST|SVs_GMG)) == SVf_NOK) +#define SvNIOK_nogthink(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & (SVf_THINKFIRST|SVs_GMG))) + +#define SvPOK_utf8_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == (SVf_POK|SVf_UTF8)) +#define SvPOK_utf8_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) + +#define SvPOK_byte_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == SVf_POK) +#define SvPOK_byte_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) + +#define SvPOK_pure_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) +#define SvPOK_utf8_pure_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) +#define SvPOK_byte_pure_nogthink(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) + /* =for apidoc Am|U32|SvGAMAGIC|SV* sv @@ -936,6 +895,30 @@ the scalar's value cannot change unless written to. #define SvPCS_IMPORTED_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_PCS_IMPORTED)) #define SvPCS_IMPORTED_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED)) +/* +=for apidoc m|U32|SvTHINKFIRST|SV *sv + +A quick flag check to see whether an sv should be passed to sv_force_normal +to be "downgraded" before SvIVX or SvPVX can be modified directly. + +For example, if your scalar is a reference and you want to modify the SvIVX +slot, you can't just do SvROK_off, as that will leak the referent. + +This is used internally by various sv-modifying functions, such as +sv_setsv, sv_setiv and sv_pvn_force. + +One case that this does not handle is a gv without SvFAKE set. After + + if (SvTHINKFIRST(gv)) sv_force_normal(gv); + +it will still be a gv. + +SvTHINKFIRST sometimes produces false positives. In those cases +sv_force_normal does nothing. + +=cut +*/ + #define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST) #define SvPADMY(sv) (SvFLAGS(sv) & SVs_PADMY) @@ -947,33 +930,10 @@ the scalar's value cannot change unless written to. #define SvPADSTALE(sv) ((SvFLAGS(sv) & (SVs_PADMY|SVs_PADSTALE)) \ == (SVs_PADMY|SVs_PADSTALE)) -#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define SvPADTMP_on(sv) ({ \ - SV *const _svpad = MUTABLE_SV(sv); \ - assert(!(SvFLAGS(_svpad) & SVs_PADMY)); \ - SvFLAGS(_svpad) |= SVs_PADTMP; \ - }) -# define SvPADTMP_off(sv) ({ \ - SV *const _svpad = MUTABLE_SV(sv); \ - assert(!(SvFLAGS(_svpad) & SVs_PADMY)); \ - SvFLAGS(_svpad) &= ~SVs_PADTMP; \ - }) -# define SvPADSTALE_on(sv) ({ \ - SV *const _svpad = MUTABLE_SV(sv); \ - assert(SvFLAGS(_svpad) & SVs_PADMY); \ - SvFLAGS(_svpad) |= SVs_PADSTALE; \ - }) -# define SvPADSTALE_off(sv) ({ \ - SV *const _svpad = MUTABLE_SV(sv); \ - assert(SvFLAGS(_svpad) & SVs_PADMY); \ - SvFLAGS(_svpad) &= ~SVs_PADSTALE; \ - }) -#else -# define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP) -# define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP) -# define SvPADSTALE_on(sv) (SvFLAGS(sv) |= SVs_PADSTALE) -# define SvPADSTALE_off(sv) (SvFLAGS(sv) &= ~SVs_PADSTALE) -#endif +#define SvPADTMP_on(sv) S_SvPADTMP_on(MUTABLE_SV(sv)) +#define SvPADTMP_off(sv) S_SvPADTMP_off(MUTABLE_SV(sv)) +#define SvPADSTALE_on(sv) S_SvPADSTALE_on(MUTABLE_SV(sv)) +#define SvPADSTALE_off(sv) S_SvPADSTALE_off(MUTABLE_SV(sv)) #define SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP) #define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP) @@ -1085,7 +1045,7 @@ the scalar's value cannot change unless written to. # define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv) /* Don't test the core XS code yet. */ # if defined (PERL_CORE) && PERL_DEBUG_COW > 1 -# define SvPVX(sv) (0 + (assert(!SvREADONLY(sv)), (sv)->sv_u.svu_pv)) +# define SvPVX(sv) (0 + (assert_(!SvREADONLY(sv)) (sv)->sv_u.svu_pv)) # else # define SvPVX(sv) SvPVX_mutable(sv) # endif @@ -1093,13 +1053,8 @@ the scalar's value cannot change unless written to. # define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len) # define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) -# ifdef DEBUGGING -# define SvMAGIC(sv) (0 + *(assert(SvTYPE(sv) >= SVt_PVMG), &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic)) -# define SvSTASH(sv) (0 + *(assert(SvTYPE(sv) >= SVt_PVMG), &((XPVMG*) SvANY(sv))->xmg_stash)) -# else -# define SvMAGIC(sv) (0 + ((XPVMG*) SvANY(sv))->xmg_u.xmg_magic) -# define SvSTASH(sv) (0 + ((XPVMG*) SvANY(sv))->xmg_stash) -# endif +# define SvMAGIC(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic)) +# define SvSTASH(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_stash)) #else # define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len # define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) @@ -1208,8 +1163,9 @@ the scalar's value cannot change unless written to. STMT_START {if (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv))) \ (void) SvIV(sv); } STMT_END #define SvIV_please_nomg(sv) \ - STMT_START {if (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv))) \ - (void) SvIV_nomg(sv); } STMT_END + (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv)) \ + ? (SvIV_nomg(sv), SvIOK(sv)) \ + : SvIOK(sv)) #define SvIV_set(sv, val) \ STMT_START { \ assert(PL_valid_types_IV_set[SvTYPE(sv) & SVt_MASK]); \ @@ -1336,7 +1292,7 @@ the scalar's value cannot change unless written to. #endif -#define FmLINES(sv) ((XPVFM*) SvANY(sv))->xfm_lines +#define FmLINES(sv) ((XPVIV*) SvANY(sv))->xiv_iv #define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type #define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ @@ -1415,14 +1371,14 @@ attention to precisely which outputs are influenced by which inputs. /* =for apidoc Am|char*|SvPV_force|SV* sv|STRLEN len -Like C but will force the SV into containing just a string -(C). You want force if you are going to update the C -directly. +Like C but will force the SV into containing a string (C), and +only a string (C), by hook or by crook. You want force if you are +going to update the C directly. Processes get magic. =for apidoc Am|char*|SvPV_force_nomg|SV* sv|STRLEN len -Like C but will force the SV into containing just a string -(C). You want force if you are going to update the C -directly. Doesn't process magic. +Like C but will force the SV into containing a string (C), and +only a string (C), by hook or by crook. You want force if you are +going to update the C directly. Doesn't process get magic. =for apidoc Am|char*|SvPV|SV* sv|STRLEN len Returns a pointer to the string in the SV, or a stringified form of @@ -1562,9 +1518,9 @@ Like sv_utf8_upgrade, but doesn't do magic on C. */ /* Let us hope that bitmaps for UV and IV are the same */ -#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) -#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) -#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv)) +#define SvIV(sv) (SvIOK_nog(sv) ? SvIVX(sv) : sv_2iv(sv)) +#define SvUV(sv) (SvUOK_nog(sv) ? SvUVX(sv) : sv_2uv(sv)) +#define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv)) #define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0)) #define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0)) @@ -1572,23 +1528,23 @@ Like sv_utf8_upgrade, but doesn't do magic on C. /* ----*/ -#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC) -#define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) +#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC) +#define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) #define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) #define SvPV_flags(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) #define SvPV_flags_const(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) #define SvPV_flags_const_nolen(sv, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX_const(sv) : \ (const char*) sv_2pv_flags(sv, 0, flags|SV_CONST_RETURN)) #define SvPV_flags_mutable(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) @@ -1600,26 +1556,28 @@ Like sv_utf8_upgrade, but doesn't do magic on C. #define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) #define SvPV_force_flags(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) + (SvPOK_pure_nogthink(sv) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) + #define SvPV_force_flags_nolen(sv, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags)) + (SvPOK_pure_nogthink(sv) \ + ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags)) + #define SvPV_force_flags_mutable(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ + (SvPOK_pure_nogthink(sv) \ + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) #define SvPV_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC)) #define SvPV_nomg_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX(sv) : sv_2pv_flags(sv, 0, 0)) #define SvPV_nolen_const(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN)) #define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) @@ -1629,33 +1587,31 @@ Like sv_utf8_upgrade, but doesn't do magic on C. /* ----*/ #define SvPVutf8(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \ + (SvPOK_utf8_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp)) #define SvPVutf8_force(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \ + (SvPOK_utf8_pure_nogthink(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) - #define SvPVutf8_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\ + (SvPOK_utf8_nog(sv) \ ? SvPVX(sv) : sv_2pvutf8(sv, 0)) /* ----*/ #define SvPVbyte(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ + (SvPOK_byte_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) #define SvPVbyte_force(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK) \ + (SvPOK_byte_pure_nogthink(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp)) #define SvPVbyte_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)\ + (SvPOK_byte_nog(sv) \ ? SvPVX(sv) : sv_2pvbyte(sv, 0)) - /* define FOOx(): idempotent versions of FOO(). If possible, use a local * var to evaluate the arg once; failing that, use a global if possible; @@ -1666,6 +1622,17 @@ Like sv_utf8_upgrade, but doesn't do magic on C. #define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp) #define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp) +#define SvTRUE(sv) ((sv) && (SvGMAGICAL(sv) ? sv_2bool(sv) : SvTRUE_common(sv, sv_2bool_nomg(sv)))) +#define SvTRUE_nomg(sv) ((sv) && ( SvTRUE_common(sv, sv_2bool_nomg(sv)))) +#define SvTRUE_common(sv,fallback) ( \ + !SvOK(sv) \ + ? 0 \ + : (SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK)) \ + ? ( (SvPOK(sv) && SvPVXtrue(sv)) \ + || (SvIOK(sv) && SvIVX(sv) != 0) \ + || (SvNOK(sv) && SvNVX(sv) != 0.0)) \ + : (fallback)) + #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define SvIVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvIV(_sv); }) @@ -1678,39 +1645,13 @@ Like sv_utf8_upgrade, but doesn't do magic on C. # define SvPVutf8x(sv, lp) ({SV *_sv = (sv); SvPVutf8(_sv, lp); }) # define SvPVbytex(sv, lp) ({SV *_sv = (sv); SvPVbyte(_sv, lp); }) # define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); }) -# define SvTRUE(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? (({XPV *nxpv = (XPV*)SvANY(sv); \ - nxpv && \ - (nxpv->xpv_cur > 1 || \ - (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool(sv) ) -# define SvTRUE_nomg(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? (({XPV *nxpv = (XPV*)SvANY(sv); \ - nxpv && \ - (nxpv->xpv_cur > 1 || \ - (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool_flags(sv,0) ) -# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); }) +# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); }) +# define SvTRUEx_nomg(sv) ({SV *_sv = (sv); SvTRUE_nomg(_sv); }) +# define SvPVXtrue(sv) \ + ({XPV *nxpv; \ + (nxpv = (XPV*)SvANY(sv)) \ + && (nxpv->xpv_cur > 1 \ + || (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0'));}) #else /* __GNUC__ */ @@ -1727,37 +1668,12 @@ Like sv_utf8_upgrade, but doesn't do magic on C. # define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp)) # define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp)) # define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv)) -# define SvTRUE(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) && \ - (PL_Xpv->xpv_cur > 1 || \ - (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool(sv) ) -# define SvTRUE_nomg(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) && \ - (PL_Xpv->xpv_cur > 1 || \ - (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool_flags(sv,0) ) -# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) +# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) +# define SvTRUEx_nomg(sv) ((PL_Sv = (sv)), SvTRUE_nomg(PL_Sv)) +# define SvPVXtrue(sv) \ + ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) \ + && (PL_Xpv->xpv_cur > 1 \ + || (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0'))) #endif /* __GNU__ */ #define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \ @@ -1867,8 +1783,9 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect #define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0) #define sv_catsv_mg(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC|SV_SMAGIC) #define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC) -#define sv_catpvn_mg(sv, sstr, slen) \ - sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC); +#define sv_catpvn_mg(sv, sstr, slen) sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC); +#define sv_copypv(dsv, ssv) sv_copypv_flags(dsv, ssv, SV_GMAGIC) +#define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0) #define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC) #define sv_2pv_nolen(sv) sv_2pv(sv, 0) #define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0) @@ -1884,12 +1801,13 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect #define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC) #define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC) #define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC) +#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0) #define sv_insert(bigstr, offset, len, little, littlelen) \ Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \ (littlelen), SV_GMAGIC) /* Should be named SvCatPVN_utf8_upgrade? */ -#define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \ +#define sv_catpvn_nomg_utf8_upgrade(dsv, sstr, slen, nsv) \ STMT_START { \ if (!(nsv)) \ nsv = newSVpvn_flags(sstr, slen, SVs_TEMP); \ @@ -1897,7 +1815,7 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect sv_setpvn(nsv, sstr, slen); \ SvUTF8_off(nsv); \ sv_utf8_upgrade(nsv); \ - sv_catsv(dsv, nsv); \ + sv_catsv_nomg(dsv, nsv); \ } STMT_END /* @@ -1917,11 +1835,14 @@ incremented. =head1 Magical Functions =for apidoc Am|void|SvGETMAGIC|SV* sv -Invokes C on an SV if it has 'get' magic. This macro evaluates its +Invokes C on an SV if it has 'get' magic. For example, this +will call C on a tied variable. This macro evaluates its argument more than once. =for apidoc Am|void|SvSETMAGIC|SV* sv -Invokes C on an SV if it has 'set' magic. This macro evaluates its +Invokes C on an SV if it has 'set' magic. This is necessary +after modifying a scalar, in case it is a magical variable like C<$|> +or a tied variable (it calls C). This macro evaluates its argument more than once. =for apidoc Am|void|SvSetSV|SV* dsb|SV* ssv @@ -2065,6 +1986,18 @@ C on the new SV. Implemented as a wrapper around C. #define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) /* +=for apidoc Amx|SV*|newSVpadname|PADNAME *pn + +Creates a new SV containing the pad name. This is currently identical +to C, but pad names may cease being SVs at some point, so +C is preferable. + +=cut +*/ + +#define newSVpadname(pn) newSVsv(pn) + +/* =for apidoc Am|void|SvOOK_offset|NN SV*sv|STRLEN len Reads into I the offset from SvPVX back to the true start of the @@ -2084,23 +2017,23 @@ Evaluates I more than once. Sets I to 0 if C is false. # define SvOOK_offset(sv, offset) STMT_START { \ assert(sizeof(offset) == sizeof(STRLEN)); \ if (SvOOK(sv)) { \ - const U8 *crash = (U8*)SvPVX_const(sv); \ - offset = *--crash; \ - if (!offset) { \ - crash -= sizeof(STRLEN); \ - Copy(crash, (U8 *)&offset, sizeof(STRLEN), U8); \ + const U8 *_crash = (U8*)SvPVX_const(sv); \ + (offset) = *--_crash; \ + if (!(offset)) { \ + _crash -= sizeof(STRLEN); \ + Copy(_crash, (U8 *)&(offset), sizeof(STRLEN), U8); \ } \ { \ /* Validate the preceding buffer's sentinels to \ verify that no-one is using it. */ \ - const U8 *const bonk = (U8 *) SvPVX_const(sv) - offset; \ - while (crash > bonk) { \ - --crash; \ - assert (*crash == (U8)PTR2UV(crash)); \ + const U8 *const _bonk = (U8*)SvPVX_const(sv) - (offset);\ + while (_crash > _bonk) { \ + --_crash; \ + assert (*_crash == (U8)PTR2UV(_crash)); \ } \ } \ } else { \ - offset = 0; \ + (offset) = 0; \ } \ } STMT_END #else @@ -2108,13 +2041,13 @@ Evaluates I more than once. Sets I to 0 if C is false. # define SvOOK_offset(sv, offset) STMT_START { \ assert(sizeof(offset) == sizeof(STRLEN)); \ if (SvOOK(sv)) { \ - offset = ((U8*)SvPVX_const(sv))[-1]; \ - if (!offset) { \ + (offset) = ((U8*)SvPVX_const(sv))[-1]; \ + if (!(offset)) { \ Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN), \ - (U8 *)&offset, sizeof(STRLEN), U8); \ + (U8*)&(offset), sizeof(STRLEN), U8); \ } \ } else { \ - offset = 0; \ + (offset) = 0; \ } \ } STMT_END #endif @@ -2125,8 +2058,8 @@ Evaluates I more than once. Sets I to 0 if C is false. * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */