From 2356f8bb5077e29623007d815dab58f43473a56d Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Sat, 28 May 2022 13:47:10 -0600 Subject: Move sv.h functions from inline.h into sv_inline.h, so that all functions inlined from sv.* are in one place. This was suggested by @khw. --- inline.h | 303 --------------------------------------------------------------- 1 file changed, 303 deletions(-) (limited to 'inline.h') diff --git a/inline.h b/inline.h index 53c52978be..11623071b7 100644 --- a/inline.h +++ b/inline.h @@ -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 contains a PV that is considered -TRUE. FALSE is returned if C 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 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 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 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's IV slot, but not in all cases. (Use -C> to make sure it does). - -As of 5.37.1, all are guaranteed to evaluate C only once. - -C is now identical to C, but prior to 5.37.1, it was the only form -guaranteed to evaluate C only once. - -C is the same as C, 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's NV slot, but not in all cases. (Use -C> to make sure it does). - -As of 5.37.1, all are guaranteed to evaluate C only once. - -C is now identical to C, but prior to 5.37.1, it was the only form -guaranteed to evaluate C only once. - -C is the same as C, 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's UV slot, but not in all cases. (Use -C> to make sure it does). - -As of 5.37.1, all are guaranteed to evaluate C only once. - -C is now identical to C, but prior to 5.37.1, it was the only form -guaranteed to evaluate C 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 ------------------------------- */ /* -- cgit v1.2.1