This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make op.c:op_const_sv static
[perl5.git] / inline.h
CommitLineData
25468daa
FC
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 */
27669aa4 14
be3a7a5d
KW
15/* ------------------------------- av.h ------------------------------- */
16
c70927a6 17PERL_STATIC_INLINE SSize_t
be3a7a5d
KW
18S_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
1afe1db1
FC
26/* ------------------------------- cv.h ------------------------------- */
27
ae77754a
FC
28PERL_STATIC_INLINE GV *
29S_CvGV(pTHX_ CV *sv)
30{
31 return CvNAMED(sv)
32 ? Perl_cvgv_from_hek(aTHX_ sv)
33 : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
34}
35
1afe1db1
FC
36PERL_STATIC_INLINE I32 *
37S_CvDEPTHp(const CV * const sv)
38{
39 assert(SvTYPE(sv) == SVt_PVCV || SvTYPE(sv) == SVt_PVFM);
8de47657 40 return &((XPVCV*)SvANY(sv))->xcv_depth;
1afe1db1
FC
41}
42
d16269d8
PM
43/*
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.
52 */
53
5b67adb8 54#ifdef PERL_CORE
d16269d8
PM
55PERL_STATIC_INLINE char *
56S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
57{
58 SV * tmpsv;
59 char * tmps;
60 tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP);
61 tmps = SvPVX(tmpsv);
62 while ((*len)--) {
63 if (!isSPACE(*orig))
64 *tmps++ = *orig;
65 orig++;
66 }
67 *tmps = '\0';
68 *len = tmps - SvPVX(tmpsv);
69 return SvPVX(tmpsv);
70}
5b67adb8 71#endif
d16269d8 72
25fdce4a
FC
73/* ------------------------------- mg.h ------------------------------- */
74
75#if defined(PERL_CORE) || defined(PERL_EXT)
76/* assumes get-magic and stringification have already occurred */
77PERL_STATIC_INLINE STRLEN
78S_MgBYTEPOS(pTHX_ MAGIC *mg, SV *sv, const char *s, STRLEN len)
79{
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;
84 else {
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);
89 }
90}
91#endif
92
8d919b0a
FC
93/* ----------------------------- regexp.h ----------------------------- */
94
95PERL_STATIC_INLINE struct regexp *
96S_ReANY(const REGEXP * const re)
97{
98 assert(isREGEXP(re));
99 return re->sv_u.svu_rx;
100}
101
27669aa4
FC
102/* ------------------------------- sv.h ------------------------------- */
103
104PERL_STATIC_INLINE SV *
105S_SvREFCNT_inc(SV *sv)
106{
2439e033 107 if (LIKELY(sv != NULL))
27669aa4
FC
108 SvREFCNT(sv)++;
109 return sv;
110}
111PERL_STATIC_INLINE SV *
112S_SvREFCNT_inc_NN(SV *sv)
113{
114 SvREFCNT(sv)++;
115 return sv;
116}
117PERL_STATIC_INLINE void
118S_SvREFCNT_inc_void(SV *sv)
119{
2439e033 120 if (LIKELY(sv != NULL))
27669aa4
FC
121 SvREFCNT(sv)++;
122}
75e16a44
FC
123PERL_STATIC_INLINE void
124S_SvREFCNT_dec(pTHX_ SV *sv)
125{
2439e033 126 if (LIKELY(sv != NULL)) {
75a9bf96 127 U32 rc = SvREFCNT(sv);
79e2a32a 128 if (LIKELY(rc > 1))
75a9bf96
DM
129 SvREFCNT(sv) = rc - 1;
130 else
131 Perl_sv_free2(aTHX_ sv, rc);
75e16a44
FC
132 }
133}
541377b1
FC
134
135PERL_STATIC_INLINE void
4a9a56a7
DM
136S_SvREFCNT_dec_NN(pTHX_ SV *sv)
137{
138 U32 rc = SvREFCNT(sv);
79e2a32a 139 if (LIKELY(rc > 1))
4a9a56a7
DM
140 SvREFCNT(sv) = rc - 1;
141 else
142 Perl_sv_free2(aTHX_ sv, rc);
143}
144
145PERL_STATIC_INLINE void
541377b1
FC
146SvAMAGIC_on(SV *sv)
147{
148 assert(SvROK(sv));
149 if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
150}
151PERL_STATIC_INLINE void
152SvAMAGIC_off(SV *sv)
153{
154 if (SvROK(sv) && SvOBJECT(SvRV(sv)))
155 HvAMAGIC_off(SvSTASH(SvRV(sv)));
156}
157
158PERL_STATIC_INLINE U32
541377b1
FC
159S_SvPADSTALE_on(SV *sv)
160{
c0683843 161 assert(!(SvFLAGS(sv) & SVs_PADTMP));
541377b1
FC
162 return SvFLAGS(sv) |= SVs_PADSTALE;
163}
164PERL_STATIC_INLINE U32
165S_SvPADSTALE_off(SV *sv)
166{
c0683843 167 assert(!(SvFLAGS(sv) & SVs_PADTMP));
541377b1
FC
168 return SvFLAGS(sv) &= ~SVs_PADSTALE;
169}
25fdce4a 170#if defined(PERL_CORE) || defined (PERL_EXT)
4ddea69a 171PERL_STATIC_INLINE STRLEN
6964422a 172S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
4ddea69a 173{
25fdce4a 174 PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B;
4ddea69a
FC
175 if (SvGAMAGIC(sv)) {
176 U8 *hopped = utf8_hop((U8 *)pv, pos);
177 if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
178 return (STRLEN)(hopped - (U8 *)pv);
179 }
180 return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
181}
182#endif
f019c49e 183
d1decf2b
TC
184/* ------------------------------- handy.h ------------------------------- */
185
186/* saves machine code for a common noreturn idiom typically used in Newx*() */
c1d6452f 187#ifdef GCC_DIAG_PRAGMA
6ab56f1e 188GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
c1d6452f 189#endif
d1decf2b
TC
190static void
191S_croak_memory_wrap(void)
192{
193 Perl_croak_nocontext("%s",PL_memory_wrap);
194}
c1d6452f 195#ifdef GCC_DIAG_PRAGMA
6ab56f1e 196GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
c1d6452f 197#endif
d1decf2b 198
a8a2ceaa
KW
199/* ------------------------------- utf8.h ------------------------------- */
200
55d09dc8
KW
201PERL_STATIC_INLINE void
202S_append_utf8_from_native_byte(const U8 byte, U8** dest)
203{
204 /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
205 * encoded string at '*dest', updating '*dest' to include it */
206
55d09dc8
KW
207 PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
208
6f2d5cbc 209 if (NATIVE_BYTE_IS_INVARIANT(byte))
9ff651ce 210 *(*dest)++ = byte;
55d09dc8 211 else {
9ff651ce
KW
212 *(*dest)++ = UTF8_EIGHT_BIT_HI(byte);
213 *(*dest)++ = UTF8_EIGHT_BIT_LO(byte);
55d09dc8
KW
214 }
215}
216
e123187a 217/*
f2645549 218
6302f837
KW
219A helper function for the macro isUTF8_CHAR(), which should be used instead of
220this function. The macro will handle smaller code points directly saving time,
221using this function as a fall-back for higher code points.
f2645549 222
6302f837
KW
223Tests if the first bytes of string C<s> form a valid UTF-8 character. 0 is
224returned if the bytes starting at C<s> up to but not including C<e> do not form a
225complete well-formed UTF-8 character; otherwise the number of bytes in the
226character is returned.
f2645549 227
6302f837
KW
228Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a valid UTF-8
229character.
e123187a
KW
230
231=cut */
232PERL_STATIC_INLINE STRLEN
6302f837 233S__is_utf8_char_slow(const U8 *s, const U8 *e)
e123187a
KW
234{
235 dTHX; /* The function called below requires thread context */
236
237 STRLEN actual_len;
238
239 PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW;
240
6302f837
KW
241 assert(e >= s);
242 utf8n_to_uvchr(s, e - s, &actual_len, UTF8_CHECK_ONLY);
e123187a
KW
243
244 return (actual_len == (STRLEN) -1) ? 0 : actual_len;
245}
246
c8028aa6
TC
247/* ------------------------------- perl.h ----------------------------- */
248
249/*
dcccc8ff
KW
250=head1 Miscellaneous Functions
251
41188aa0 252=for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
c8028aa6 253
6602b933 254Test that the given C<pv> doesn't contain any internal C<NUL> characters.
c8028aa6
TC
255If it does, set C<errno> to ENOENT, optionally warn, and return FALSE.
256
257Return TRUE if the name is safe.
258
259Used by the IS_SAFE_SYSCALL() macro.
260
261=cut
262*/
263
264PERL_STATIC_INLINE bool
41188aa0 265S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) {
c8028aa6
TC
266 /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
267 * perl itself uses xce*() functions which accept 8-bit strings.
268 */
269
270 PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
271
6c4650b3 272 if (len > 1) {
c8028aa6 273 char *null_at;
41188aa0 274 if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
c8028aa6 275 SETERRNO(ENOENT, LIB_INVARG);
1d505182 276 Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
c8028aa6 277 "Invalid \\0 character in %s for %s: %s\\0%s",
41188aa0 278 what, op_name, pv, null_at+1);
c8028aa6
TC
279 return FALSE;
280 }
281 }
282
283 return TRUE;
284}
285
286/*
7cb3f959
TC
287
288Return true if the supplied filename has a newline character
289immediately before the final NUL.
290
291My original look at this incorrectly used the len from SvPV(), but
292that's incorrect, since we allow for a NUL in pv[len-1].
293
294So instead, strlen() and work from there.
295
296This allow for the user reading a filename, forgetting to chomp it,
297then calling:
298
299 open my $foo, "$file\0";
300
301*/
302
303#ifdef PERL_CORE
304
305PERL_STATIC_INLINE bool
306S_should_warn_nl(const char *pv) {
307 STRLEN len;
308
309 PERL_ARGS_ASSERT_SHOULD_WARN_NL;
310
311 len = strlen(pv);
312
313 return len > 0 && pv[len-1] == '\n';
314}
315
316#endif
317
81d52ecd
JH
318/* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
319
320#define MAX_CHARSET_NAME_LENGTH 2
321
322PERL_STATIC_INLINE const char *
323get_regex_charset_name(const U32 flags, STRLEN* const lenp)
324{
325 /* Returns a string that corresponds to the name of the regex character set
326 * given by 'flags', and *lenp is set the length of that string, which
327 * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
328
329 *lenp = 1;
330 switch (get_regex_charset(flags)) {
331 case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
332 case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS;
333 case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
334 case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
335 case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
336 *lenp = 2;
337 return ASCII_MORE_RESTRICT_PAT_MODS;
338 }
339 /* The NOT_REACHED; hides an assert() which has a rather complex
340 * definition in perl.h. */
341 NOT_REACHED; /* NOTREACHED */
342 return "?"; /* Unknown */
343}
344
7cb3f959 345/*
c8028aa6
TC
346 * Local variables:
347 * c-indentation-style: bsd
348 * c-basic-offset: 4
349 * indent-tabs-mode: nil
350 * End:
351 *
352 * ex: set ts=8 sts=4 sw=4 et:
353 */