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 I32 *
29 S_CvDEPTHp(const CV * const sv)
31 assert(SvTYPE(sv) == SVt_PVCV || SvTYPE(sv) == SVt_PVFM);
32 return &((XPVCV*)SvANY(sv))->xcv_depth;
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.
47 PERL_STATIC_INLINE char *
48 S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
52 tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP);
60 *len = tmps - SvPVX(tmpsv);
65 /* ------------------------------- mg.h ------------------------------- */
67 #if defined(PERL_CORE) || defined(PERL_EXT)
68 /* assumes get-magic and stringification have already occurred */
69 PERL_STATIC_INLINE STRLEN
70 S_MgBYTEPOS(pTHX_ MAGIC *mg, SV *sv, const char *s, STRLEN len)
72 assert(mg->mg_type == PERL_MAGIC_regex_global);
73 assert(mg->mg_len != -1);
74 if (mg->mg_flags & MGf_BYTES || !DO_UTF8(sv))
75 return (STRLEN)mg->mg_len;
77 const STRLEN pos = (STRLEN)mg->mg_len;
78 /* Without this check, we may read past the end of the buffer: */
79 if (pos > sv_or_pv_len_utf8(sv, s, len)) return len+1;
80 return sv_or_pv_pos_u2b(sv, s, pos, NULL);
85 /* ----------------------------- regexp.h ----------------------------- */
87 PERL_STATIC_INLINE struct regexp *
88 S_ReANY(const REGEXP * const re)
91 return re->sv_u.svu_rx;
94 /* ------------------------------- sv.h ------------------------------- */
96 PERL_STATIC_INLINE SV *
97 S_SvREFCNT_inc(SV *sv)
99 if (LIKELY(sv != NULL))
103 PERL_STATIC_INLINE SV *
104 S_SvREFCNT_inc_NN(SV *sv)
109 PERL_STATIC_INLINE void
110 S_SvREFCNT_inc_void(SV *sv)
112 if (LIKELY(sv != NULL))
115 PERL_STATIC_INLINE void
116 S_SvREFCNT_dec(pTHX_ SV *sv)
118 if (LIKELY(sv != NULL)) {
119 U32 rc = SvREFCNT(sv);
121 SvREFCNT(sv) = rc - 1;
123 Perl_sv_free2(aTHX_ sv, rc);
127 PERL_STATIC_INLINE void
128 S_SvREFCNT_dec_NN(pTHX_ SV *sv)
130 U32 rc = SvREFCNT(sv);
132 SvREFCNT(sv) = rc - 1;
134 Perl_sv_free2(aTHX_ sv, rc);
137 PERL_STATIC_INLINE void
141 if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
143 PERL_STATIC_INLINE void
146 if (SvROK(sv) && SvOBJECT(SvRV(sv)))
147 HvAMAGIC_off(SvSTASH(SvRV(sv)));
150 PERL_STATIC_INLINE U32
151 S_SvPADTMP_on(SV *sv)
153 assert(!(SvFLAGS(sv) & SVs_PADMY));
154 return SvFLAGS(sv) |= SVs_PADTMP;
156 PERL_STATIC_INLINE U32
157 S_SvPADTMP_off(SV *sv)
159 assert(!(SvFLAGS(sv) & SVs_PADMY));
160 return SvFLAGS(sv) &= ~SVs_PADTMP;
162 PERL_STATIC_INLINE U32
163 S_SvPADSTALE_on(SV *sv)
165 assert(SvFLAGS(sv) & SVs_PADMY);
166 return SvFLAGS(sv) |= SVs_PADSTALE;
168 PERL_STATIC_INLINE U32
169 S_SvPADSTALE_off(SV *sv)
171 assert(SvFLAGS(sv) & SVs_PADMY);
172 return SvFLAGS(sv) &= ~SVs_PADSTALE;
174 #if defined(PERL_CORE) || defined (PERL_EXT)
175 PERL_STATIC_INLINE STRLEN
176 S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
178 PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B;
180 U8 *hopped = utf8_hop((U8 *)pv, pos);
181 if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
182 return (STRLEN)(hopped - (U8 *)pv);
184 return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
188 /* ------------------------------- handy.h ------------------------------- */
190 /* saves machine code for a common noreturn idiom typically used in Newx*() */
192 #pragma clang diagnostic push
193 #pragma clang diagnostic ignored "-Wunused-function"
196 S_croak_memory_wrap(void)
198 Perl_croak_nocontext("%s",PL_memory_wrap);
201 #pragma clang diagnostic pop
204 /* ------------------------------- utf8.h ------------------------------- */
206 PERL_STATIC_INLINE void
207 S_append_utf8_from_native_byte(const U8 byte, U8** dest)
209 /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
210 * encoded string at '*dest', updating '*dest' to include it */
212 PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
214 if (NATIVE_BYTE_IS_INVARIANT(byte))
217 *(*dest)++ = UTF8_EIGHT_BIT_HI(byte);
218 *(*dest)++ = UTF8_EIGHT_BIT_LO(byte);
224 A helper function for the macro isUTF8_CHAR(), which should be used instead of
225 this function. The macro will handle smaller code points directly saving time,
226 using this function as a fall-back for higher code points.
228 Tests if the first bytes of string C<s> form a valid UTF-8 character. 0 is
229 returned if the bytes starting at C<s> up to but not including C<e> do not form a
230 complete well-formed UTF-8 character; otherwise the number of bytes in the
231 character is returned.
233 Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a valid UTF-8
237 PERL_STATIC_INLINE STRLEN
238 S__is_utf8_char_slow(const U8 *s, const U8 *e)
240 dTHX; /* The function called below requires thread context */
244 PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW;
247 utf8n_to_uvchr(s, e - s, &actual_len, UTF8_CHECK_ONLY);
249 return (actual_len == (STRLEN) -1) ? 0 : actual_len;
252 /* ------------------------------- perl.h ----------------------------- */
255 =head1 Miscellaneous Functions
257 =for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
259 Test that the given C<pv> doesn't contain any internal C<NUL> characters.
260 If it does, set C<errno> to ENOENT, optionally warn, and return FALSE.
262 Return TRUE if the name is safe.
264 Used by the IS_SAFE_SYSCALL() macro.
269 PERL_STATIC_INLINE bool
270 S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) {
271 /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
272 * perl itself uses xce*() functions which accept 8-bit strings.
275 PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
279 if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
280 SETERRNO(ENOENT, LIB_INVARG);
281 Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
282 "Invalid \\0 character in %s for %s: %s\\0%s",
283 what, op_name, pv, null_at+1);
293 Return true if the supplied filename has a newline character
294 immediately before the final NUL.
296 My original look at this incorrectly used the len from SvPV(), but
297 that's incorrect, since we allow for a NUL in pv[len-1].
299 So instead, strlen() and work from there.
301 This allow for the user reading a filename, forgetting to chomp it,
304 open my $foo, "$file\0";
310 PERL_STATIC_INLINE bool
311 S_should_warn_nl(const char *pv) {
314 PERL_ARGS_ASSERT_SHOULD_WARN_NL;
318 return len > 0 && pv[len-1] == '\n';
323 /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
325 #define MAX_CHARSET_NAME_LENGTH 2
327 PERL_STATIC_INLINE const char *
328 get_regex_charset_name(const U32 flags, STRLEN* const lenp)
330 /* Returns a string that corresponds to the name of the regex character set
331 * given by 'flags', and *lenp is set the length of that string, which
332 * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
335 switch (get_regex_charset(flags)) {
336 case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
337 case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS;
338 case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
339 case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
340 case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
342 return ASCII_MORE_RESTRICT_PAT_MODS;
344 /* The NOT_REACHED; hides an assert() which has a rather complex
345 * definition in perl.h. */
346 NOT_REACHED; /* NOTREACHED */
347 return "?"; /* Unknown */
352 * c-indentation-style: bsd
354 * indent-tabs-mode: nil
357 * ex: set ts=8 sts=4 sw=4 et: