inline.h

   1 /*    inline.h
   2  *
   3  *    Copyright (C) 2012 by Larry Wall and others
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * This file is a home for static inline functions that cannot go in other
   9  * headers files, because they depend on proto.h (included after most other
  10  * headers) or struct definitions.
  11  *
  12  * Each section names the header file that the functions "belong" to.
  13  */
  14
  15 /* ------------------------------- av.h ------------------------------- */
  16
  17 PERL_STATIC_INLINE I32
  18 S_av_top_index(pTHX_ AV *av)
  19 {
  20     PERL_ARGS_ASSERT_AV_TOP_INDEX;
  21     assert(SvTYPE(av) == SVt_PVAV);
  22
  23     return AvFILL(av);
  24 }
  25
  26 /* ------------------------------- cv.h ------------------------------- */
  27
  28 PERL_STATIC_INLINE I32 *
  29 S_CvDEPTHp(const CV * const sv)
  30 {
  31     assert(SvTYPE(sv) == SVt_PVCV || SvTYPE(sv) == SVt_PVFM);
  32     return &((XPVCV*)SvANY(sv))->xcv_depth;
  33 }
  34
  35 /*
  36  CvPROTO returns the prototype as stored, which is not necessarily what
  37  the interpreter should be using. Specifically, the interpreter assumes
  38  that spaces have been stripped, which has been the case if the prototype
  39  was added by toke.c, but is generally not the case if it was added elsewhere.
  40  Since we can't enforce the spacelessness at assignment time, this routine
  41  provides a temporary copy at parse time with spaces removed.
  42  I<orig> is the start of the original buffer, I<len> is the length of the
  43  prototype and will be updated when this returns.
  44  */
  45
  46 #ifdef PERL_CORE
  47 PERL_STATIC_INLINE char *
  48 S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
  49 {
  50     SV * tmpsv;
  51     char * tmps;
  52     tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP);
  53     tmps = SvPVX(tmpsv);
  54     while ((*len)--) {
  55         if (!isSPACE(*orig))
  56             *tmps++ = *orig;
  57         orig++;
  58     }
  59     *tmps = '\0';
  60     *len = tmps - SvPVX(tmpsv);
  61                 return SvPVX(tmpsv);
  62 }
  63 #endif
  64
  65 /* ----------------------------- regexp.h ----------------------------- */
  66
  67 PERL_STATIC_INLINE struct regexp *
  68 S_ReANY(const REGEXP * const re)
  69 {
  70     assert(isREGEXP(re));
  71     return re->sv_u.svu_rx;
  72 }
  73
  74 /* ------------------------------- sv.h ------------------------------- */
  75
  76 PERL_STATIC_INLINE SV *
  77 S_SvREFCNT_inc(SV *sv)
  78 {
  79     if (LIKELY(sv != NULL))
  80         SvREFCNT(sv)++;
  81     return sv;
  82 }
  83 PERL_STATIC_INLINE SV *
  84 S_SvREFCNT_inc_NN(SV *sv)
  85 {
  86     SvREFCNT(sv)++;
  87     return sv;
  88 }
  89 PERL_STATIC_INLINE void
  90 S_SvREFCNT_inc_void(SV *sv)
  91 {
  92     if (LIKELY(sv != NULL))
  93         SvREFCNT(sv)++;
  94 }
  95 PERL_STATIC_INLINE void
  96 S_SvREFCNT_dec(pTHX_ SV *sv)
  97 {
  98     if (LIKELY(sv != NULL)) {
  99         U32 rc = SvREFCNT(sv);
 100         if (LIKELY(rc > 1))
 101             SvREFCNT(sv) = rc - 1;
 102         else
 103             Perl_sv_free2(aTHX_ sv, rc);
 104     }
 105 }
 106
 107 PERL_STATIC_INLINE void
 108 S_SvREFCNT_dec_NN(pTHX_ SV *sv)
 109 {
 110     U32 rc = SvREFCNT(sv);
 111     if (LIKELY(rc > 1))
 112         SvREFCNT(sv) = rc - 1;
 113     else
 114         Perl_sv_free2(aTHX_ sv, rc);
 115 }
 116
 117 PERL_STATIC_INLINE void
 118 SvAMAGIC_on(SV *sv)
 119 {
 120     assert(SvROK(sv));
 121     if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
 122 }
 123 PERL_STATIC_INLINE void
 124 SvAMAGIC_off(SV *sv)
 125 {
 126     if (SvROK(sv) && SvOBJECT(SvRV(sv)))
 127         HvAMAGIC_off(SvSTASH(SvRV(sv)));
 128 }
 129
 130 PERL_STATIC_INLINE U32
 131 S_SvPADTMP_on(SV *sv)
 132 {
 133     assert(!(SvFLAGS(sv) & SVs_PADMY));
 134     return SvFLAGS(sv) |= SVs_PADTMP;
 135 }
 136 PERL_STATIC_INLINE U32
 137 S_SvPADTMP_off(SV *sv)
 138 {
 139     assert(!(SvFLAGS(sv) & SVs_PADMY));
 140     return SvFLAGS(sv) &= ~SVs_PADTMP;
 141 }
 142 PERL_STATIC_INLINE U32
 143 S_SvPADSTALE_on(SV *sv)
 144 {
 145     assert(SvFLAGS(sv) & SVs_PADMY);
 146     return SvFLAGS(sv) |= SVs_PADSTALE;
 147 }
 148 PERL_STATIC_INLINE U32
 149 S_SvPADSTALE_off(SV *sv)
 150 {
 151     assert(SvFLAGS(sv) & SVs_PADMY);
 152     return SvFLAGS(sv) &= ~SVs_PADSTALE;
 153 }
 154 #ifdef PERL_CORE
 155 PERL_STATIC_INLINE STRLEN
 156 S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
 157 {
 158     if (SvGAMAGIC(sv)) {
 159         U8 *hopped = utf8_hop((U8 *)pv, pos);
 160         if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
 161         return (STRLEN)(hopped - (U8 *)pv);
 162     }
 163     return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
 164 }
 165 #endif
 166
 167 /* ------------------------------- utf8.h ------------------------------- */
 168
 169 /* These exist only to replace the macros they formerly were so that their use
 170  * can be deprecated */
 171
 172 PERL_STATIC_INLINE bool
 173 S_isIDFIRST_lazy(pTHX_ const char* p)
 174 {
 175     PERL_ARGS_ASSERT_ISIDFIRST_LAZY;
 176
 177     return isIDFIRST_lazy_if(p,1);
 178 }
 179
 180 PERL_STATIC_INLINE bool
 181 S_isALNUM_lazy(pTHX_ const char* p)
 182 {
 183     PERL_ARGS_ASSERT_ISALNUM_LAZY;
 184
 185     return isALNUM_lazy_if(p,1);
 186 }