3 * Copyright (C) 2012 by Larry Wall and others
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.
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.
12 * Each section names the header file that the functions "belong" to.
15 /* ------------------------------- av.h ------------------------------- */
17 PERL_STATIC_INLINE SSize_t
18 S_av_top_index(pTHX_ AV *av)
20 PERL_ARGS_ASSERT_AV_TOP_INDEX;
21 assert(SvTYPE(av) == SVt_PVAV);
26 /* ------------------------------- cv.h ------------------------------- */
28 PERL_STATIC_INLINE GV *
32 ? Perl_cvgv_from_hek(aTHX_ sv)
33 : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
36 PERL_STATIC_INLINE I32 *
37 S_CvDEPTHp(const CV * const sv)
39 assert(SvTYPE(sv) == SVt_PVCV || SvTYPE(sv) == SVt_PVFM);
40 return &((XPVCV*)SvANY(sv))->xcv_depth;
44 CvPROTO returns the prototype as stored, which is not necessarily what
45 the interpreter should be using. Specifically, the interpreter assumes
46 that spaces have been stripped, which has been the case if the prototype
47 was added by toke.c, but is generally not the case if it was added elsewhere.
48 Since we can't enforce the spacelessness at assignment time, this routine
49 provides a temporary copy at parse time with spaces removed.
50 I<orig> is the start of the original buffer, I<len> is the length of the
51 prototype and will be updated when this returns.
55 PERL_STATIC_INLINE char *
56 S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
60 tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP);
68 *len = tmps - SvPVX(tmpsv);
73 /* ------------------------------- mg.h ------------------------------- */
75 #if defined(PERL_CORE) || defined(PERL_EXT)
76 /* assumes get-magic and stringification have already occurred */
77 PERL_STATIC_INLINE STRLEN
78 S_MgBYTEPOS(pTHX_ MAGIC *mg, SV *sv, const char *s, STRLEN len)
80 assert(mg->mg_type == PERL_MAGIC_regex_global);
81 assert(mg->mg_len != -1);
82 if (mg->mg_flags & MGf_BYTES || !DO_UTF8(sv))
83 return (STRLEN)mg->mg_len;
85 const STRLEN pos = (STRLEN)mg->mg_len;
86 /* Without this check, we may read past the end of the buffer: */
87 if (pos > sv_or_pv_len_utf8(sv, s, len)) return len+1;
88 return sv_or_pv_pos_u2b(sv, s, pos, NULL);
93 /* ----------------------------- regexp.h ----------------------------- */
95 PERL_STATIC_INLINE struct regexp *
96 S_ReANY(const REGEXP * const re)
99 return re->sv_u.svu_rx;
102 /* ------------------------------- sv.h ------------------------------- */
104 PERL_STATIC_INLINE SV *
105 S_SvREFCNT_inc(SV *sv)
107 if (LIKELY(sv != NULL))
111 PERL_STATIC_INLINE SV *
112 S_SvREFCNT_inc_NN(SV *sv)
117 PERL_STATIC_INLINE void
118 S_SvREFCNT_inc_void(SV *sv)
120 if (LIKELY(sv != NULL))
123 PERL_STATIC_INLINE void
124 S_SvREFCNT_dec(pTHX_ SV *sv)
126 if (LIKELY(sv != NULL)) {
127 U32 rc = SvREFCNT(sv);
129 SvREFCNT(sv) = rc - 1;
131 Perl_sv_free2(aTHX_ sv, rc);
135 PERL_STATIC_INLINE void
136 S_SvREFCNT_dec_NN(pTHX_ SV *sv)
138 U32 rc = SvREFCNT(sv);
140 SvREFCNT(sv) = rc - 1;
142 Perl_sv_free2(aTHX_ sv, rc);
145 PERL_STATIC_INLINE void
149 if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
151 PERL_STATIC_INLINE void
154 if (SvROK(sv) && SvOBJECT(SvRV(sv)))
155 HvAMAGIC_off(SvSTASH(SvRV(sv)));
158 PERL_STATIC_INLINE U32
159 S_SvPADTMP_on(SV *sv)
161 assert(!(SvFLAGS(sv) & SVs_PADMY));
162 return SvFLAGS(sv) |= SVs_PADTMP;
164 PERL_STATIC_INLINE U32
165 S_SvPADTMP_off(SV *sv)
167 assert(!(SvFLAGS(sv) & SVs_PADMY));
168 return SvFLAGS(sv) &= ~SVs_PADTMP;
170 PERL_STATIC_INLINE U32
171 S_SvPADSTALE_on(SV *sv)
173 assert(SvFLAGS(sv) & SVs_PADMY);
174 return SvFLAGS(sv) |= SVs_PADSTALE;
176 PERL_STATIC_INLINE U32
177 S_SvPADSTALE_off(SV *sv)
179 assert(SvFLAGS(sv) & SVs_PADMY);
180 return SvFLAGS(sv) &= ~SVs_PADSTALE;
182 #if defined(PERL_CORE) || defined (PERL_EXT)
183 PERL_STATIC_INLINE STRLEN
184 S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
186 PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B;
188 U8 *hopped = utf8_hop((U8 *)pv, pos);
189 if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
190 return (STRLEN)(hopped - (U8 *)pv);
192 return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
196 /* ------------------------------- handy.h ------------------------------- */
198 /* saves machine code for a common noreturn idiom typically used in Newx*() */
199 #ifdef GCC_DIAG_PRAGMA
200 GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
203 S_croak_memory_wrap(void)
205 Perl_croak_nocontext("%s",PL_memory_wrap);
207 #ifdef GCC_DIAG_PRAGMA
208 GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
211 /* ------------------------------- utf8.h ------------------------------- */
213 PERL_STATIC_INLINE void
214 S_append_utf8_from_native_byte(const U8 byte, U8** dest)
216 /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
217 * encoded string at '*dest', updating '*dest' to include it */
219 PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
221 if (NATIVE_BYTE_IS_INVARIANT(byte))
224 *(*dest)++ = UTF8_EIGHT_BIT_HI(byte);
225 *(*dest)++ = UTF8_EIGHT_BIT_LO(byte);
231 A helper function for the macro isUTF8_CHAR(), which should be used instead of
232 this function. The macro will handle smaller code points directly saving time,
233 using this function as a fall-back for higher code points.
235 Tests if the first bytes of string C<s> form a valid UTF-8 character. 0 is
236 returned if the bytes starting at C<s> up to but not including C<e> do not form a
237 complete well-formed UTF-8 character; otherwise the number of bytes in the
238 character is returned.
240 Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a valid UTF-8
244 PERL_STATIC_INLINE STRLEN
245 S__is_utf8_char_slow(const U8 *s, const U8 *e)
247 dTHX; /* The function called below requires thread context */
251 PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW;
254 utf8n_to_uvchr(s, e - s, &actual_len, UTF8_CHECK_ONLY);
256 return (actual_len == (STRLEN) -1) ? 0 : actual_len;
259 /* ------------------------------- perl.h ----------------------------- */
262 =head1 Miscellaneous Functions
264 =for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
266 Test that the given C<pv> doesn't contain any internal C<NUL> characters.
267 If it does, set C<errno> to ENOENT, optionally warn, and return FALSE.
269 Return TRUE if the name is safe.
271 Used by the IS_SAFE_SYSCALL() macro.
276 PERL_STATIC_INLINE bool
277 S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) {
278 /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
279 * perl itself uses xce*() functions which accept 8-bit strings.
282 PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
286 if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
287 SETERRNO(ENOENT, LIB_INVARG);
288 Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
289 "Invalid \\0 character in %s for %s: %s\\0%s",
290 what, op_name, pv, null_at+1);
300 Return true if the supplied filename has a newline character
301 immediately before the final NUL.
303 My original look at this incorrectly used the len from SvPV(), but
304 that's incorrect, since we allow for a NUL in pv[len-1].
306 So instead, strlen() and work from there.
308 This allow for the user reading a filename, forgetting to chomp it,
311 open my $foo, "$file\0";
317 PERL_STATIC_INLINE bool
318 S_should_warn_nl(const char *pv) {
321 PERL_ARGS_ASSERT_SHOULD_WARN_NL;
325 return len > 0 && pv[len-1] == '\n';
330 /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
332 #define MAX_CHARSET_NAME_LENGTH 2
334 PERL_STATIC_INLINE const char *
335 get_regex_charset_name(const U32 flags, STRLEN* const lenp)
337 /* Returns a string that corresponds to the name of the regex character set
338 * given by 'flags', and *lenp is set the length of that string, which
339 * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
342 switch (get_regex_charset(flags)) {
343 case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
344 case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS;
345 case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
346 case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
347 case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
349 return ASCII_MORE_RESTRICT_PAT_MODS;
351 /* The NOT_REACHED; hides an assert() which has a rather complex
352 * definition in perl.h. */
353 NOT_REACHED; /* NOTREACHED */
354 return "?"; /* Unknown */
359 * c-indentation-style: bsd
361 * indent-tabs-mode: nil
364 * ex: set ts=8 sts=4 sw=4 et: