diff options
| -rw-r--r-- | inline.h | 303 | ||||
| -rw-r--r-- | sv_inline.h | 303 |
2 files changed, 303 insertions, 303 deletions
@@ -314,309 +314,6 @@ Perl_ReANY(const REGEXP * const re) : (struct regexp *)p; } -/* ------------------------------- sv.h ------------------------------- */ - -/* -=for apidoc_section $SV -=for apidoc SvPVXtrue - -Returns a boolean as to whether or not C<sv> contains a PV that is considered -TRUE. FALSE is returned if C<sv> doesn't contain a PV, or if the PV it does -contain is zero length, or consists of just the single character '0'. Every -other PV value is considered TRUE. - -As of Perl v5.37.1, C<sv> is evaluated exactly once; in earlier releases, it -could be evaluated more than once. - -=cut -*/ - -PERL_STATIC_INLINE bool -Perl_SvPVXtrue(pTHX_ SV *sv) -{ - PERL_ARGS_ASSERT_SVPVXTRUE; - - if (! (XPV *) SvANY(sv)) { - return false; - } - - if ( ((XPV *) SvANY(sv))->xpv_cur > 1) { /* length > 1 */ - return true; - } - - if (( (XPV *) SvANY(sv))->xpv_cur == 0) { - return false; - } - - return *sv->sv_u.svu_pv != '0'; -} - -PERL_STATIC_INLINE bool -Perl_SvTRUE(pTHX_ SV *sv) -{ - PERL_ARGS_ASSERT_SVTRUE; - - if (UNLIKELY(sv == NULL)) - return FALSE; - SvGETMAGIC(sv); - return SvTRUE_nomg_NN(sv); -} - -PERL_STATIC_INLINE bool -Perl_SvTRUE_nomg(pTHX_ SV *sv) -{ - PERL_ARGS_ASSERT_SVTRUE_NOMG; - - if (UNLIKELY(sv == NULL)) - return FALSE; - return SvTRUE_nomg_NN(sv); -} - -PERL_STATIC_INLINE bool -Perl_SvTRUE_NN(pTHX_ SV *sv) -{ - PERL_ARGS_ASSERT_SVTRUE_NN; - - SvGETMAGIC(sv); - return SvTRUE_nomg_NN(sv); -} - -PERL_STATIC_INLINE bool -Perl_SvTRUE_common(pTHX_ SV * sv, const bool sv_2bool_is_fallback) -{ - PERL_ARGS_ASSERT_SVTRUE_COMMON; - - if (UNLIKELY(SvIMMORTAL_INTERP(sv))) - return SvIMMORTAL_TRUE(sv); - - if (! SvOK(sv)) - return FALSE; - - if (SvPOK(sv)) - return SvPVXtrue(sv); - - if (SvIOK(sv)) - return SvIVX(sv) != 0; /* casts to bool */ - - if (SvROK(sv) && !(SvOBJECT(SvRV(sv)) && HvAMAGIC(SvSTASH(SvRV(sv))))) - return TRUE; - - if (sv_2bool_is_fallback) - return sv_2bool_nomg(sv); - - return isGV_with_GP(sv); -} - - -PERL_STATIC_INLINE SV * -Perl_SvREFCNT_inc(SV *sv) -{ - if (LIKELY(sv != NULL)) - SvREFCNT(sv)++; - return sv; -} -PERL_STATIC_INLINE SV * -Perl_SvREFCNT_inc_NN(SV *sv) -{ - PERL_ARGS_ASSERT_SVREFCNT_INC_NN; - - SvREFCNT(sv)++; - return sv; -} -PERL_STATIC_INLINE void -Perl_SvREFCNT_inc_void(SV *sv) -{ - if (LIKELY(sv != NULL)) - SvREFCNT(sv)++; -} -PERL_STATIC_INLINE void -Perl_SvREFCNT_dec(pTHX_ SV *sv) -{ - if (LIKELY(sv != NULL)) { - U32 rc = SvREFCNT(sv); - if (LIKELY(rc > 1)) - SvREFCNT(sv) = rc - 1; - else - Perl_sv_free2(aTHX_ sv, rc); - } -} - -PERL_STATIC_INLINE void -Perl_SvREFCNT_dec_NN(pTHX_ SV *sv) -{ - U32 rc = SvREFCNT(sv); - - PERL_ARGS_ASSERT_SVREFCNT_DEC_NN; - - if (LIKELY(rc > 1)) - SvREFCNT(sv) = rc - 1; - else - Perl_sv_free2(aTHX_ sv, rc); -} - -/* -=for apidoc SvAMAGIC_on - -Indicate that C<sv> has overloading (active magic) enabled. - -=cut -*/ - -PERL_STATIC_INLINE void -Perl_SvAMAGIC_on(SV *sv) -{ - PERL_ARGS_ASSERT_SVAMAGIC_ON; - assert(SvROK(sv)); - - if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv))); -} - -/* -=for apidoc SvAMAGIC_off - -Indicate that C<sv> has overloading (active magic) disabled. - -=cut -*/ - -PERL_STATIC_INLINE void -Perl_SvAMAGIC_off(SV *sv) -{ - PERL_ARGS_ASSERT_SVAMAGIC_OFF; - - if (SvROK(sv) && SvOBJECT(SvRV(sv))) - HvAMAGIC_off(SvSTASH(SvRV(sv))); -} - -PERL_STATIC_INLINE U32 -Perl_SvPADSTALE_on(SV *sv) -{ - assert(!(SvFLAGS(sv) & SVs_PADTMP)); - return SvFLAGS(sv) |= SVs_PADSTALE; -} -PERL_STATIC_INLINE U32 -Perl_SvPADSTALE_off(SV *sv) -{ - assert(!(SvFLAGS(sv) & SVs_PADTMP)); - return SvFLAGS(sv) &= ~SVs_PADSTALE; -} - -/* -=for apidoc_section $SV -=for apidoc SvIV -=for apidoc_item SvIVx -=for apidoc_item SvIV_nomg - -These each coerce the given SV to IV and return it. The returned value in many -circumstances will get stored in C<sv>'s IV slot, but not in all cases. (Use -C<L</sv_setiv>> to make sure it does). - -As of 5.37.1, all are guaranteed to evaluate C<sv> only once. - -C<SvIVx> is now identical to C<SvIV>, but prior to 5.37.1, it was the only form -guaranteed to evaluate C<sv> only once. - -C<SvIV_nomg> is the same as C<SvIV>, but does not perform 'get' magic. - -=for apidoc SvNV -=for apidoc_item SvNVx -=for apidoc_item SvNV_nomg - -These each coerce the given SV to NV and return it. The returned value in many -circumstances will get stored in C<sv>'s NV slot, but not in all cases. (Use -C<L</sv_setnv>> to make sure it does). - -As of 5.37.1, all are guaranteed to evaluate C<sv> only once. - -C<SvNVx> is now identical to C<SvNV>, but prior to 5.37.1, it was the only form -guaranteed to evaluate C<sv> only once. - -C<SvNV_nomg> is the same as C<SvNV>, but does not perform 'get' magic. - -=for apidoc SvUV -=for apidoc_item SvUVx -=for apidoc_item SvUV_nomg - -These each coerce the given SV to UV and return it. The returned value in many -circumstances will get stored in C<sv>'s UV slot, but not in all cases. (Use -C<L</sv_setuv>> to make sure it does). - -As of 5.37.1, all are guaranteed to evaluate C<sv> only once. - -C<SvUVx> is now identical to C<SvUV>, but prior to 5.37.1, it was the only form -guaranteed to evaluate C<sv> only once. - -=cut -*/ - -PERL_STATIC_INLINE IV -Perl_SvIV(pTHX_ SV *sv) { - PERL_ARGS_ASSERT_SVIV; - - if (SvIOK_nog(sv)) - return SvIVX(sv); - return sv_2iv(sv); -} - -PERL_STATIC_INLINE UV -Perl_SvUV(pTHX_ SV *sv) { - PERL_ARGS_ASSERT_SVUV; - - if (SvUOK_nog(sv)) - return SvUVX(sv); - return sv_2uv(sv); -} - -PERL_STATIC_INLINE NV -Perl_SvNV(pTHX_ SV *sv) { - PERL_ARGS_ASSERT_SVNV; - - if (SvNOK_nog(sv)) - return SvNVX(sv); - return sv_2nv(sv); -} - -PERL_STATIC_INLINE IV -Perl_SvIV_nomg(pTHX_ SV *sv) { - PERL_ARGS_ASSERT_SVIV_NOMG; - - if (SvIOK(sv)) - return SvIVX(sv); - return sv_2iv_flags(sv, 0); -} - -PERL_STATIC_INLINE UV -Perl_SvUV_nomg(pTHX_ SV *sv) { - PERL_ARGS_ASSERT_SVUV_NOMG; - - if (SvIOK_nog(sv)) - return SvUVX(sv); - return sv_2uv_flags(sv, 0); -} - -PERL_STATIC_INLINE NV -Perl_SvNV_nomg(pTHX_ SV *sv) { - PERL_ARGS_ASSERT_SVNV_NOMG; - - if (SvNOK_nog(sv)) - return SvNVX(sv); - return sv_2nv_flags(sv, 0); -} - -#if defined(PERL_CORE) || defined (PERL_EXT) -PERL_STATIC_INLINE STRLEN -S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp) -{ - PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B; - if (SvGAMAGIC(sv)) { - U8 *hopped = utf8_hop((U8 *)pv, pos); - if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped); - return (STRLEN)(hopped - (U8 *)pv); - } - return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN); -} -#endif - /* ------------------------------- utf8.h ------------------------------- */ /* diff --git a/sv_inline.h b/sv_inline.h index 7288797d41..c495d3cea0 100644 --- a/sv_inline.h +++ b/sv_inline.h @@ -527,6 +527,309 @@ Perl_newSV_type_mortal(pTHX_ const svtype type) return sv; } +/* The following functions started out in sv.h and then moved to inline.h. They + * moved again into this file during the 5.37.x development cycle. */ + +/* +=for apidoc_section $SV +=for apidoc SvPVXtrue + +Returns a boolean as to whether or not C<sv> contains a PV that is considered +TRUE. FALSE is returned if C<sv> doesn't contain a PV, or if the PV it does +contain is zero length, or consists of just the single character '0'. Every +other PV value is considered TRUE. + +As of Perl v5.37.1, C<sv> is evaluated exactly once; in earlier releases, it +could be evaluated more than once. + +=cut +*/ + +PERL_STATIC_INLINE bool +Perl_SvPVXtrue(pTHX_ SV *sv) +{ + PERL_ARGS_ASSERT_SVPVXTRUE; + + if (! (XPV *) SvANY(sv)) { + return false; + } + + if ( ((XPV *) SvANY(sv))->xpv_cur > 1) { /* length > 1 */ + return true; + } + + if (( (XPV *) SvANY(sv))->xpv_cur == 0) { + return false; + } + + return *sv->sv_u.svu_pv != '0'; +} + +PERL_STATIC_INLINE bool +Perl_SvTRUE(pTHX_ SV *sv) +{ + PERL_ARGS_ASSERT_SVTRUE; + + if (UNLIKELY(sv == NULL)) + return FALSE; + SvGETMAGIC(sv); + return SvTRUE_nomg_NN(sv); +} + +PERL_STATIC_INLINE bool +Perl_SvTRUE_nomg(pTHX_ SV *sv) +{ + PERL_ARGS_ASSERT_SVTRUE_NOMG; + + if (UNLIKELY(sv == NULL)) + return FALSE; + return SvTRUE_nomg_NN(sv); +} + +PERL_STATIC_INLINE bool +Perl_SvTRUE_NN(pTHX_ SV *sv) +{ + PERL_ARGS_ASSERT_SVTRUE_NN; + + SvGETMAGIC(sv); + return SvTRUE_nomg_NN(sv); +} + +PERL_STATIC_INLINE bool +Perl_SvTRUE_common(pTHX_ SV * sv, const bool sv_2bool_is_fallback) +{ + PERL_ARGS_ASSERT_SVTRUE_COMMON; + + if (UNLIKELY(SvIMMORTAL_INTERP(sv))) + return SvIMMORTAL_TRUE(sv); + + if (! SvOK(sv)) + return FALSE; + + if (SvPOK(sv)) + return SvPVXtrue(sv); + + if (SvIOK(sv)) + return SvIVX(sv) != 0; /* casts to bool */ + + if (SvROK(sv) && !(SvOBJECT(SvRV(sv)) && HvAMAGIC(SvSTASH(SvRV(sv))))) + return TRUE; + + if (sv_2bool_is_fallback) + return sv_2bool_nomg(sv); + + return isGV_with_GP(sv); +} + +PERL_STATIC_INLINE SV * +Perl_SvREFCNT_inc(SV *sv) +{ + if (LIKELY(sv != NULL)) + SvREFCNT(sv)++; + return sv; +} +PERL_STATIC_INLINE SV * +Perl_SvREFCNT_inc_NN(SV *sv) +{ + PERL_ARGS_ASSERT_SVREFCNT_INC_NN; + + SvREFCNT(sv)++; + return sv; +} +PERL_STATIC_INLINE void +Perl_SvREFCNT_inc_void(SV *sv) +{ + if (LIKELY(sv != NULL)) + SvREFCNT(sv)++; +} +PERL_STATIC_INLINE void +Perl_SvREFCNT_dec(pTHX_ SV *sv) +{ + if (LIKELY(sv != NULL)) { + U32 rc = SvREFCNT(sv); + if (LIKELY(rc > 1)) + SvREFCNT(sv) = rc - 1; + else + Perl_sv_free2(aTHX_ sv, rc); + } +} + +PERL_STATIC_INLINE void +Perl_SvREFCNT_dec_NN(pTHX_ SV *sv) +{ + U32 rc = SvREFCNT(sv); + + PERL_ARGS_ASSERT_SVREFCNT_DEC_NN; + + if (LIKELY(rc > 1)) + SvREFCNT(sv) = rc - 1; + else + Perl_sv_free2(aTHX_ sv, rc); +} + +/* +=for apidoc SvAMAGIC_on + +Indicate that C<sv> has overloading (active magic) enabled. + +=cut +*/ + +PERL_STATIC_INLINE void +Perl_SvAMAGIC_on(SV *sv) +{ + PERL_ARGS_ASSERT_SVAMAGIC_ON; + assert(SvROK(sv)); + + if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv))); +} + +/* +=for apidoc SvAMAGIC_off + +Indicate that C<sv> has overloading (active magic) disabled. + +=cut +*/ + +PERL_STATIC_INLINE void +Perl_SvAMAGIC_off(SV *sv) +{ + PERL_ARGS_ASSERT_SVAMAGIC_OFF; + + if (SvROK(sv) && SvOBJECT(SvRV(sv))) + HvAMAGIC_off(SvSTASH(SvRV(sv))); +} + +PERL_STATIC_INLINE U32 +Perl_SvPADSTALE_on(SV *sv) +{ + assert(!(SvFLAGS(sv) & SVs_PADTMP)); + return SvFLAGS(sv) |= SVs_PADSTALE; +} +PERL_STATIC_INLINE U32 +Perl_SvPADSTALE_off(SV *sv) +{ + assert(!(SvFLAGS(sv) & SVs_PADTMP)); + return SvFLAGS(sv) &= ~SVs_PADSTALE; +} + +/* +=for apidoc_section $SV +=for apidoc SvIV +=for apidoc_item SvIVx +=for apidoc_item SvIV_nomg + +These each coerce the given SV to IV and return it. The returned value in many +circumstances will get stored in C<sv>'s IV slot, but not in all cases. (Use +C<L</sv_setiv>> to make sure it does). + +As of 5.37.1, all are guaranteed to evaluate C<sv> only once. + +C<SvIVx> is now identical to C<SvIV>, but prior to 5.37.1, it was the only form +guaranteed to evaluate C<sv> only once. + +C<SvIV_nomg> is the same as C<SvIV>, but does not perform 'get' magic. + +=for apidoc SvNV +=for apidoc_item SvNVx +=for apidoc_item SvNV_nomg + +These each coerce the given SV to NV and return it. The returned value in many +circumstances will get stored in C<sv>'s NV slot, but not in all cases. (Use +C<L</sv_setnv>> to make sure it does). + +As of 5.37.1, all are guaranteed to evaluate C<sv> only once. + +C<SvNVx> is now identical to C<SvNV>, but prior to 5.37.1, it was the only form +guaranteed to evaluate C<sv> only once. + +C<SvNV_nomg> is the same as C<SvNV>, but does not perform 'get' magic. + +=for apidoc SvUV +=for apidoc_item SvUVx +=for apidoc_item SvUV_nomg + +These each coerce the given SV to UV and return it. The returned value in many +circumstances will get stored in C<sv>'s UV slot, but not in all cases. (Use +C<L</sv_setuv>> to make sure it does). + +As of 5.37.1, all are guaranteed to evaluate C<sv> only once. + +C<SvUVx> is now identical to C<SvUV>, but prior to 5.37.1, it was the only form +guaranteed to evaluate C<sv> only once. + +=cut +*/ + +PERL_STATIC_INLINE IV +Perl_SvIV(pTHX_ SV *sv) { + PERL_ARGS_ASSERT_SVIV; + + if (SvIOK_nog(sv)) + return SvIVX(sv); + return sv_2iv(sv); +} + +PERL_STATIC_INLINE UV +Perl_SvUV(pTHX_ SV *sv) { + PERL_ARGS_ASSERT_SVUV; + + if (SvUOK_nog(sv)) + return SvUVX(sv); + return sv_2uv(sv); +} + +PERL_STATIC_INLINE NV +Perl_SvNV(pTHX_ SV *sv) { + PERL_ARGS_ASSERT_SVNV; + + if (SvNOK_nog(sv)) + return SvNVX(sv); + return sv_2nv(sv); +} + +PERL_STATIC_INLINE IV +Perl_SvIV_nomg(pTHX_ SV *sv) { + PERL_ARGS_ASSERT_SVIV_NOMG; + + if (SvIOK(sv)) + return SvIVX(sv); + return sv_2iv_flags(sv, 0); +} + +PERL_STATIC_INLINE UV +Perl_SvUV_nomg(pTHX_ SV *sv) { + PERL_ARGS_ASSERT_SVUV_NOMG; + + if (SvIOK_nog(sv)) + return SvUVX(sv); + return sv_2uv_flags(sv, 0); +} + +PERL_STATIC_INLINE NV +Perl_SvNV_nomg(pTHX_ SV *sv) { + PERL_ARGS_ASSERT_SVNV_NOMG; + + if (SvNOK_nog(sv)) + return SvNVX(sv); + return sv_2nv_flags(sv, 0); +} + +#if defined(PERL_CORE) || defined (PERL_EXT) +PERL_STATIC_INLINE STRLEN +S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp) +{ + PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B; + if (SvGAMAGIC(sv)) { + U8 *hopped = utf8_hop((U8 *)pv, pos); + if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped); + return (STRLEN)(hopped - (U8 *)pv); + } + return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN); +} +#endif + /* * ex: set ts=8 sts=4 sw=4 et: */ |