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 /* ------------------------------- pad.h ------------------------------ */
95 #if defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C)
96 PERL_STATIC_INLINE bool
97 PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq)
99 /* is seq within the range _LOW to _HIGH ?
100 * This is complicated by the fact that PL_cop_seqmax
101 * may have wrapped around at some point */
102 if (COP_SEQ_RANGE_LOW(pn) == PERL_PADSEQ_INTRO)
103 return FALSE; /* not yet introduced */
105 if (COP_SEQ_RANGE_HIGH(pn) == PERL_PADSEQ_INTRO) {
106 /* in compiling scope */
108 (seq > COP_SEQ_RANGE_LOW(pn))
109 ? (seq - COP_SEQ_RANGE_LOW(pn) < (U32_MAX >> 1))
110 : (COP_SEQ_RANGE_LOW(pn) - seq > (U32_MAX >> 1))
115 (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn))
117 ( seq > COP_SEQ_RANGE_LOW(pn)
118 || seq <= COP_SEQ_RANGE_HIGH(pn))
120 : ( seq > COP_SEQ_RANGE_LOW(pn)
121 && seq <= COP_SEQ_RANGE_HIGH(pn))
128 /* ------------------------------- pp.h ------------------------------- */
130 PERL_STATIC_INLINE I32
133 DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
134 "MARK top %p %" IVdf "\n",
136 (IV)*PL_markstack_ptr)));
137 return *PL_markstack_ptr;
140 PERL_STATIC_INLINE I32
143 DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
144 "MARK pop %p %" IVdf "\n",
145 (PL_markstack_ptr-1),
146 (IV)*(PL_markstack_ptr-1))));
147 assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");
148 return *PL_markstack_ptr--;
151 /* ----------------------------- regexp.h ----------------------------- */
153 PERL_STATIC_INLINE struct regexp *
154 S_ReANY(const REGEXP * const re)
156 assert(isREGEXP(re));
157 return re->sv_u.svu_rx;
160 /* ------------------------------- sv.h ------------------------------- */
162 PERL_STATIC_INLINE SV *
163 S_SvREFCNT_inc(SV *sv)
165 if (LIKELY(sv != NULL))
169 PERL_STATIC_INLINE SV *
170 S_SvREFCNT_inc_NN(SV *sv)
175 PERL_STATIC_INLINE void
176 S_SvREFCNT_inc_void(SV *sv)
178 if (LIKELY(sv != NULL))
181 PERL_STATIC_INLINE void
182 S_SvREFCNT_dec(pTHX_ SV *sv)
184 if (LIKELY(sv != NULL)) {
185 U32 rc = SvREFCNT(sv);
187 SvREFCNT(sv) = rc - 1;
189 Perl_sv_free2(aTHX_ sv, rc);
193 PERL_STATIC_INLINE void
194 S_SvREFCNT_dec_NN(pTHX_ SV *sv)
196 U32 rc = SvREFCNT(sv);
198 SvREFCNT(sv) = rc - 1;
200 Perl_sv_free2(aTHX_ sv, rc);
203 PERL_STATIC_INLINE void
207 if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
209 PERL_STATIC_INLINE void
212 if (SvROK(sv) && SvOBJECT(SvRV(sv)))
213 HvAMAGIC_off(SvSTASH(SvRV(sv)));
216 PERL_STATIC_INLINE U32
217 S_SvPADSTALE_on(SV *sv)
219 assert(!(SvFLAGS(sv) & SVs_PADTMP));
220 return SvFLAGS(sv) |= SVs_PADSTALE;
222 PERL_STATIC_INLINE U32
223 S_SvPADSTALE_off(SV *sv)
225 assert(!(SvFLAGS(sv) & SVs_PADTMP));
226 return SvFLAGS(sv) &= ~SVs_PADSTALE;
228 #if defined(PERL_CORE) || defined (PERL_EXT)
229 PERL_STATIC_INLINE STRLEN
230 S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
232 PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B;
234 U8 *hopped = utf8_hop((U8 *)pv, pos);
235 if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
236 return (STRLEN)(hopped - (U8 *)pv);
238 return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
242 /* ------------------------------- handy.h ------------------------------- */
244 /* saves machine code for a common noreturn idiom typically used in Newx*() */
245 #ifdef GCC_DIAG_PRAGMA
246 GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
249 S_croak_memory_wrap(void)
251 Perl_croak_nocontext("%s",PL_memory_wrap);
253 #ifdef GCC_DIAG_PRAGMA
254 GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
257 /* ------------------------------- utf8.h ------------------------------- */
260 =head1 Unicode Support
263 PERL_STATIC_INLINE void
264 S_append_utf8_from_native_byte(const U8 byte, U8** dest)
266 /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
267 * encoded string at '*dest', updating '*dest' to include it */
269 PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
271 if (NATIVE_BYTE_IS_INVARIANT(byte))
274 *((*dest)++) = UTF8_EIGHT_BIT_HI(byte);
275 *((*dest)++) = UTF8_EIGHT_BIT_LO(byte);
280 =for apidoc valid_utf8_to_uvchr
281 Like C<L</utf8_to_uvchr_buf>>, but should only be called when it is known that
282 the next character in the input UTF-8 string C<s> is well-formed (I<e.g.>,
283 it passes C<L</isUTF8_CHAR>>. Surrogates, non-character code points, and
284 non-Unicode code points are allowed.
290 PERL_STATIC_INLINE UV
291 Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen)
293 const UV expectlen = UTF8SKIP(s);
294 const U8* send = s + expectlen;
297 PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR;
303 /* An invariant is trivially returned */
304 if (expectlen == 1) {
308 /* Remove the leading bits that indicate the number of bytes, leaving just
309 * the bits that are part of the value */
310 uv = NATIVE_UTF8_TO_I8(uv) & UTF_START_MASK(expectlen);
312 /* Now, loop through the remaining bytes, accumulating each into the
313 * working total as we go. (I khw tried unrolling the loop for up to 4
314 * bytes, but there was no performance improvement) */
315 for (++s; s < send; s++) {
316 uv = UTF8_ACCUMULATE(uv, *s);
319 return UNI_TO_NATIVE(uv);
324 =for apidoc is_utf8_invariant_string
326 Returns TRUE if the first C<len> bytes of the string C<s> are the same
327 regardless of the UTF-8 encoding of the string (or UTF-EBCDIC encoding on
328 EBCDIC machines); otherwise it returns FALSE. That is, it returns TRUE if they
329 are UTF-8 invariant. On ASCII-ish machines, all the ASCII characters and only
330 the ASCII characters fit this definition. On EBCDIC machines, the ASCII-range
331 characters are invariant, but so also are the C1 controls.
333 If C<len> is 0, it will be calculated using C<strlen(s)>, (which means if you
334 use this option, that C<s> can't have embedded C<NUL> characters and has to
335 have a terminating C<NUL> byte).
338 C<L</is_utf8_string>>,
339 C<L</is_utf8_string_flags>>,
340 C<L</is_utf8_string_loc>>,
341 C<L</is_utf8_string_loc_flags>>,
342 C<L</is_utf8_string_loclen>>,
343 C<L</is_utf8_string_loclen_flags>>,
344 C<L</is_utf8_fixed_width_buf_flags>>,
345 C<L</is_utf8_fixed_width_buf_loc_flags>>,
346 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
347 C<L</is_strict_utf8_string>>,
348 C<L</is_strict_utf8_string_loc>>,
349 C<L</is_strict_utf8_string_loclen>>,
350 C<L</is_c9strict_utf8_string>>,
351 C<L</is_c9strict_utf8_string_loc>>,
353 C<L</is_c9strict_utf8_string_loclen>>.
358 PERL_STATIC_INLINE bool
359 S_is_utf8_invariant_string(const U8* const s, const STRLEN len)
361 const U8* const send = s + (len ? len : strlen((const char *)s));
364 PERL_ARGS_ASSERT_IS_UTF8_INVARIANT_STRING;
366 for (; x < send; ++x) {
367 if (!UTF8_IS_INVARIANT(*x))
375 =for apidoc is_utf8_string
377 Returns TRUE if the first C<len> bytes of string C<s> form a valid
378 Perl-extended-UTF-8 string; returns FALSE otherwise. If C<len> is 0, it will
379 be calculated using C<strlen(s)> (which means if you use this option, that C<s>
380 can't have embedded C<NUL> characters and has to have a terminating C<NUL>
381 byte). Note that all characters being ASCII constitute 'a valid UTF-8 string'.
383 This function considers Perl's extended UTF-8 to be valid. That means that
384 code points above Unicode, surrogates, and non-character code points are
385 considered valid by this function. Use C<L</is_strict_utf8_string>>,
386 C<L</is_c9strict_utf8_string>>, or C<L</is_utf8_string_flags>> to restrict what
387 code points are considered valid.
390 C<L</is_utf8_invariant_string>>,
391 C<L</is_utf8_string_loc>>,
392 C<L</is_utf8_string_loclen>>,
393 C<L</is_utf8_fixed_width_buf_flags>>,
394 C<L</is_utf8_fixed_width_buf_loc_flags>>,
395 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
400 PERL_STATIC_INLINE bool
401 Perl_is_utf8_string(const U8 *s, const STRLEN len)
403 /* This is now marked pure in embed.fnc, because isUTF8_CHAR now is pure.
404 * Be aware of possible changes to that */
406 const U8* const send = s + (len ? len : strlen((const char *)s));
409 PERL_ARGS_ASSERT_IS_UTF8_STRING;
412 const STRLEN cur_len = isUTF8_CHAR(x, send);
413 if (UNLIKELY(! cur_len)) {
423 =for apidoc is_strict_utf8_string
425 Returns TRUE if the first C<len> bytes of string C<s> form a valid
426 UTF-8-encoded string that is fully interchangeable by any application using
427 Unicode rules; otherwise it returns FALSE. If C<len> is 0, it will be
428 calculated using C<strlen(s)> (which means if you use this option, that C<s>
429 can't have embedded C<NUL> characters and has to have a terminating C<NUL>
430 byte). Note that all characters being ASCII constitute 'a valid UTF-8 string'.
432 This function returns FALSE for strings containing any
433 code points above the Unicode max of 0x10FFFF, surrogate code points, or
434 non-character code points.
437 C<L</is_utf8_invariant_string>>,
438 C<L</is_utf8_string>>,
439 C<L</is_utf8_string_flags>>,
440 C<L</is_utf8_string_loc>>,
441 C<L</is_utf8_string_loc_flags>>,
442 C<L</is_utf8_string_loclen>>,
443 C<L</is_utf8_string_loclen_flags>>,
444 C<L</is_utf8_fixed_width_buf_flags>>,
445 C<L</is_utf8_fixed_width_buf_loc_flags>>,
446 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
447 C<L</is_strict_utf8_string_loc>>,
448 C<L</is_strict_utf8_string_loclen>>,
449 C<L</is_c9strict_utf8_string>>,
450 C<L</is_c9strict_utf8_string_loc>>,
452 C<L</is_c9strict_utf8_string_loclen>>.
457 PERL_STATIC_INLINE bool
458 S_is_strict_utf8_string(const U8 *s, const STRLEN len)
460 const U8* const send = s + (len ? len : strlen((const char *)s));
463 PERL_ARGS_ASSERT_IS_STRICT_UTF8_STRING;
466 const STRLEN cur_len = isSTRICT_UTF8_CHAR(x, send);
467 if (UNLIKELY(! cur_len)) {
477 =for apidoc is_c9strict_utf8_string
479 Returns TRUE if the first C<len> bytes of string C<s> form a valid
480 UTF-8-encoded string that conforms to
481 L<Unicode Corrigendum #9|http://www.unicode.org/versions/corrigendum9.html>;
482 otherwise it returns FALSE. If C<len> is 0, it will be calculated using
483 C<strlen(s)> (which means if you use this option, that C<s> can't have embedded
484 C<NUL> characters and has to have a terminating C<NUL> byte). Note that all
485 characters being ASCII constitute 'a valid UTF-8 string'.
487 This function returns FALSE for strings containing any code points above the
488 Unicode max of 0x10FFFF or surrogate code points, but accepts non-character
490 L<Corrigendum #9|http://www.unicode.org/versions/corrigendum9.html>.
493 C<L</is_utf8_invariant_string>>,
494 C<L</is_utf8_string>>,
495 C<L</is_utf8_string_flags>>,
496 C<L</is_utf8_string_loc>>,
497 C<L</is_utf8_string_loc_flags>>,
498 C<L</is_utf8_string_loclen>>,
499 C<L</is_utf8_string_loclen_flags>>,
500 C<L</is_utf8_fixed_width_buf_flags>>,
501 C<L</is_utf8_fixed_width_buf_loc_flags>>,
502 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
503 C<L</is_strict_utf8_string>>,
504 C<L</is_strict_utf8_string_loc>>,
505 C<L</is_strict_utf8_string_loclen>>,
506 C<L</is_c9strict_utf8_string_loc>>,
508 C<L</is_c9strict_utf8_string_loclen>>.
513 PERL_STATIC_INLINE bool
514 S_is_c9strict_utf8_string(const U8 *s, const STRLEN len)
516 const U8* const send = s + (len ? len : strlen((const char *)s));
519 PERL_ARGS_ASSERT_IS_C9STRICT_UTF8_STRING;
522 const STRLEN cur_len = isC9_STRICT_UTF8_CHAR(x, send);
523 if (UNLIKELY(! cur_len)) {
532 /* The above 3 functions could have been moved into the more general one just
533 * below, and made #defines that call it with the right 'flags'. They are
534 * currently kept separate to increase their chances of getting inlined */
537 =for apidoc is_utf8_string_flags
539 Returns TRUE if the first C<len> bytes of string C<s> form a valid
540 UTF-8 string, subject to the restrictions imposed by C<flags>;
541 returns FALSE otherwise. If C<len> is 0, it will be calculated
542 using C<strlen(s)> (which means if you use this option, that C<s> can't have
543 embedded C<NUL> characters and has to have a terminating C<NUL> byte). Note
544 that all characters being ASCII constitute 'a valid UTF-8 string'.
546 If C<flags> is 0, this gives the same results as C<L</is_utf8_string>>; if
547 C<flags> is C<UTF8_DISALLOW_ILLEGAL_INTERCHANGE>, this gives the same results
548 as C<L</is_strict_utf8_string>>; and if C<flags> is
549 C<UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE>, this gives the same results as
550 C<L</is_c9strict_utf8_string>>. Otherwise C<flags> may be any
551 combination of the C<UTF8_DISALLOW_I<foo>> flags understood by
552 C<L</utf8n_to_uvchr>>, with the same meanings.
555 C<L</is_utf8_invariant_string>>,
556 C<L</is_utf8_string>>,
557 C<L</is_utf8_string_loc>>,
558 C<L</is_utf8_string_loc_flags>>,
559 C<L</is_utf8_string_loclen>>,
560 C<L</is_utf8_string_loclen_flags>>,
561 C<L</is_utf8_fixed_width_buf_flags>>,
562 C<L</is_utf8_fixed_width_buf_loc_flags>>,
563 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
564 C<L</is_strict_utf8_string>>,
565 C<L</is_strict_utf8_string_loc>>,
566 C<L</is_strict_utf8_string_loclen>>,
567 C<L</is_c9strict_utf8_string>>,
568 C<L</is_c9strict_utf8_string_loc>>,
570 C<L</is_c9strict_utf8_string_loclen>>.
575 PERL_STATIC_INLINE bool
576 S_is_utf8_string_flags(const U8 *s, const STRLEN len, const U32 flags)
578 const U8* const send = s + (len ? len : strlen((const char *)s));
581 PERL_ARGS_ASSERT_IS_UTF8_STRING_FLAGS;
582 assert(0 == (flags & ~(UTF8_DISALLOW_ILLEGAL_INTERCHANGE
583 |UTF8_DISALLOW_ABOVE_31_BIT)));
586 return is_utf8_string(s, len);
589 if ((flags & ~UTF8_DISALLOW_ABOVE_31_BIT)
590 == UTF8_DISALLOW_ILLEGAL_INTERCHANGE)
592 return is_strict_utf8_string(s, len);
595 if ((flags & ~UTF8_DISALLOW_ABOVE_31_BIT)
596 == UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE)
598 return is_c9strict_utf8_string(s, len);
602 STRLEN cur_len = isUTF8_CHAR_flags(x, send, flags);
603 if (UNLIKELY(! cur_len)) {
614 =for apidoc is_utf8_string_loc
616 Like C<L</is_utf8_string>> but stores the location of the failure (in the
617 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
618 "utf8ness success") in the C<ep> pointer.
620 See also C<L</is_utf8_string_loclen>>.
625 #define is_utf8_string_loc(s, len, ep) is_utf8_string_loclen(s, len, ep, 0)
629 =for apidoc is_utf8_string_loclen
631 Like C<L</is_utf8_string>> but stores the location of the failure (in the
632 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
633 "utf8ness success") in the C<ep> pointer, and the number of UTF-8
634 encoded characters in the C<el> pointer.
636 See also C<L</is_utf8_string_loc>>.
641 PERL_STATIC_INLINE bool
642 Perl_is_utf8_string_loclen(const U8 *s, const STRLEN len, const U8 **ep, STRLEN *el)
644 const U8* const send = s + (len ? len : strlen((const char *)s));
648 PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN;
651 const STRLEN cur_len = isUTF8_CHAR(x, send);
652 if (UNLIKELY(! cur_len)) {
671 =for apidoc is_strict_utf8_string_loc
673 Like C<L</is_strict_utf8_string>> but stores the location of the failure (in the
674 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
675 "utf8ness success") in the C<ep> pointer.
677 See also C<L</is_strict_utf8_string_loclen>>.
682 #define is_strict_utf8_string_loc(s, len, ep) \
683 is_strict_utf8_string_loclen(s, len, ep, 0)
687 =for apidoc is_strict_utf8_string_loclen
689 Like C<L</is_strict_utf8_string>> but stores the location of the failure (in the
690 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
691 "utf8ness success") in the C<ep> pointer, and the number of UTF-8
692 encoded characters in the C<el> pointer.
694 See also C<L</is_strict_utf8_string_loc>>.
699 PERL_STATIC_INLINE bool
700 S_is_strict_utf8_string_loclen(const U8 *s, const STRLEN len, const U8 **ep, STRLEN *el)
702 const U8* const send = s + (len ? len : strlen((const char *)s));
706 PERL_ARGS_ASSERT_IS_STRICT_UTF8_STRING_LOCLEN;
709 const STRLEN cur_len = isSTRICT_UTF8_CHAR(x, send);
710 if (UNLIKELY(! cur_len)) {
729 =for apidoc is_c9strict_utf8_string_loc
731 Like C<L</is_c9strict_utf8_string>> but stores the location of the failure (in
732 the case of "utf8ness failure") or the location C<s>+C<len> (in the case of
733 "utf8ness success") in the C<ep> pointer.
735 See also C<L</is_c9strict_utf8_string_loclen>>.
740 #define is_c9strict_utf8_string_loc(s, len, ep) \
741 is_c9strict_utf8_string_loclen(s, len, ep, 0)
745 =for apidoc is_c9strict_utf8_string_loclen
747 Like C<L</is_c9strict_utf8_string>> but stores the location of the failure (in
748 the case of "utf8ness failure") or the location C<s>+C<len> (in the case of
749 "utf8ness success") in the C<ep> pointer, and the number of UTF-8 encoded
750 characters in the C<el> pointer.
752 See also C<L</is_c9strict_utf8_string_loc>>.
757 PERL_STATIC_INLINE bool
758 S_is_c9strict_utf8_string_loclen(const U8 *s, const STRLEN len, const U8 **ep, STRLEN *el)
760 const U8* const send = s + (len ? len : strlen((const char *)s));
764 PERL_ARGS_ASSERT_IS_C9STRICT_UTF8_STRING_LOCLEN;
767 const STRLEN cur_len = isC9_STRICT_UTF8_CHAR(x, send);
768 if (UNLIKELY(! cur_len)) {
787 =for apidoc is_utf8_string_loc_flags
789 Like C<L</is_utf8_string_flags>> but stores the location of the failure (in the
790 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
791 "utf8ness success") in the C<ep> pointer.
793 See also C<L</is_utf8_string_loclen_flags>>.
798 #define is_utf8_string_loc_flags(s, len, ep, flags) \
799 is_utf8_string_loclen_flags(s, len, ep, 0, flags)
802 /* The above 3 actual functions could have been moved into the more general one
803 * just below, and made #defines that call it with the right 'flags'. They are
804 * currently kept separate to increase their chances of getting inlined */
808 =for apidoc is_utf8_string_loclen_flags
810 Like C<L</is_utf8_string_flags>> but stores the location of the failure (in the
811 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
812 "utf8ness success") in the C<ep> pointer, and the number of UTF-8
813 encoded characters in the C<el> pointer.
815 See also C<L</is_utf8_string_loc_flags>>.
820 PERL_STATIC_INLINE bool
821 S_is_utf8_string_loclen_flags(const U8 *s, const STRLEN len, const U8 **ep, STRLEN *el, const U32 flags)
823 const U8* const send = s + (len ? len : strlen((const char *)s));
827 PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN_FLAGS;
828 assert(0 == (flags & ~(UTF8_DISALLOW_ILLEGAL_INTERCHANGE
829 |UTF8_DISALLOW_ABOVE_31_BIT)));
832 return is_utf8_string_loclen(s, len, ep, el);
835 if ((flags & ~UTF8_DISALLOW_ABOVE_31_BIT)
836 == UTF8_DISALLOW_ILLEGAL_INTERCHANGE)
838 return is_strict_utf8_string_loclen(s, len, ep, el);
841 if ((flags & ~UTF8_DISALLOW_ABOVE_31_BIT)
842 == UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE)
844 return is_c9strict_utf8_string_loclen(s, len, ep, el);
848 const STRLEN cur_len = isUTF8_CHAR_flags(x, send, flags);
849 if (UNLIKELY(! cur_len)) {
867 =for apidoc utf8_distance
869 Returns the number of UTF-8 characters between the UTF-8 pointers C<a>
872 WARNING: use only if you *know* that the pointers point inside the
878 PERL_STATIC_INLINE IV
879 Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b)
881 PERL_ARGS_ASSERT_UTF8_DISTANCE;
883 return (a < b) ? -1 * (IV) utf8_length(a, b) : (IV) utf8_length(b, a);
889 Return the UTF-8 pointer C<s> displaced by C<off> characters, either
892 WARNING: do not use the following unless you *know* C<off> is within
893 the UTF-8 data pointed to by C<s> *and* that on entry C<s> is aligned
894 on the first byte of character or just after the last byte of a character.
899 PERL_STATIC_INLINE U8 *
900 Perl_utf8_hop(const U8 *s, SSize_t off)
902 PERL_ARGS_ASSERT_UTF8_HOP;
904 /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
905 * the bitops (especially ~) can create illegal UTF-8.
906 * In other words: in Perl UTF-8 is not just for Unicode. */
915 while (UTF8_IS_CONTINUATION(*s))
919 GCC_DIAG_IGNORE(-Wcast-qual);
925 =for apidoc utf8_hop_forward
927 Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
930 C<off> must be non-negative.
932 C<s> must be before or equal to C<end>.
934 When moving forward it will not move beyond C<end>.
936 Will not exceed this limit even if the string is not valid "UTF-8".
941 PERL_STATIC_INLINE U8 *
942 Perl_utf8_hop_forward(const U8 *s, SSize_t off, const U8 *end)
944 PERL_ARGS_ASSERT_UTF8_HOP_FORWARD;
946 /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
947 * the bitops (especially ~) can create illegal UTF-8.
948 * In other words: in Perl UTF-8 is not just for Unicode. */
954 STRLEN skip = UTF8SKIP(s);
955 if ((STRLEN)(end - s) <= skip) {
956 GCC_DIAG_IGNORE(-Wcast-qual);
963 GCC_DIAG_IGNORE(-Wcast-qual);
969 =for apidoc utf8_hop_back
971 Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
974 C<off> must be non-positive.
976 C<s> must be after or equal to C<start>.
978 When moving backward it will not move before C<start>.
980 Will not exceed this limit even if the string is not valid "UTF-8".
985 PERL_STATIC_INLINE U8 *
986 Perl_utf8_hop_back(const U8 *s, SSize_t off, const U8 *start)
988 PERL_ARGS_ASSERT_UTF8_HOP_BACK;
990 /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
991 * the bitops (especially ~) can create illegal UTF-8.
992 * In other words: in Perl UTF-8 is not just for Unicode. */
997 while (off++ && s > start) {
999 while (UTF8_IS_CONTINUATION(*s) && s > start)
1003 GCC_DIAG_IGNORE(-Wcast-qual);
1009 =for apidoc utf8_hop_safe
1011 Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
1012 either forward or backward.
1014 When moving backward it will not move before C<start>.
1016 When moving forward it will not move beyond C<end>.
1018 Will not exceed those limits even if the string is not valid "UTF-8".
1023 PERL_STATIC_INLINE U8 *
1024 Perl_utf8_hop_safe(const U8 *s, SSize_t off, const U8 *start, const U8 *end)
1026 PERL_ARGS_ASSERT_UTF8_HOP_SAFE;
1028 /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
1029 * the bitops (especially ~) can create illegal UTF-8.
1030 * In other words: in Perl UTF-8 is not just for Unicode. */
1032 assert(start <= s && s <= end);
1035 return utf8_hop_forward(s, off, end);
1038 return utf8_hop_back(s, off, start);
1044 =for apidoc is_utf8_valid_partial_char
1046 Returns 0 if the sequence of bytes starting at C<s> and looking no further than
1047 S<C<e - 1>> is the UTF-8 encoding, as extended by Perl, for one or more code
1048 points. Otherwise, it returns 1 if there exists at least one non-empty
1049 sequence of bytes that when appended to sequence C<s>, starting at position
1050 C<e> causes the entire sequence to be the well-formed UTF-8 of some code point;
1051 otherwise returns 0.
1053 In other words this returns TRUE if C<s> points to a partial UTF-8-encoded code
1056 This is useful when a fixed-length buffer is being tested for being well-formed
1057 UTF-8, but the final few bytes in it don't comprise a full character; that is,
1058 it is split somewhere in the middle of the final code point's UTF-8
1059 representation. (Presumably when the buffer is refreshed with the next chunk
1060 of data, the new first bytes will complete the partial code point.) This
1061 function is used to verify that the final bytes in the current buffer are in
1062 fact the legal beginning of some code point, so that if they aren't, the
1063 failure can be signalled without having to wait for the next read.
1067 #define is_utf8_valid_partial_char(s, e) \
1068 is_utf8_valid_partial_char_flags(s, e, 0)
1072 =for apidoc is_utf8_valid_partial_char_flags
1074 Like C<L</is_utf8_valid_partial_char>>, it returns a boolean giving whether
1075 or not the input is a valid UTF-8 encoded partial character, but it takes an
1076 extra parameter, C<flags>, which can further restrict which code points are
1079 If C<flags> is 0, this behaves identically to
1080 C<L</is_utf8_valid_partial_char>>. Otherwise C<flags> can be any combination
1081 of the C<UTF8_DISALLOW_I<foo>> flags accepted by C<L</utf8n_to_uvchr>>. If
1082 there is any sequence of bytes that can complete the input partial character in
1083 such a way that a non-prohibited character is formed, the function returns
1084 TRUE; otherwise FALSE. Non character code points cannot be determined based on
1085 partial character input. But many of the other possible excluded types can be
1086 determined from just the first one or two bytes.
1091 PERL_STATIC_INLINE bool
1092 S_is_utf8_valid_partial_char_flags(const U8 * const s, const U8 * const e, const U32 flags)
1094 PERL_ARGS_ASSERT_IS_UTF8_VALID_PARTIAL_CHAR_FLAGS;
1096 assert(0 == (flags & ~(UTF8_DISALLOW_ILLEGAL_INTERCHANGE
1097 |UTF8_DISALLOW_ABOVE_31_BIT)));
1099 if (s >= e || s + UTF8SKIP(s) <= e) {
1103 return cBOOL(_is_utf8_char_helper(s, e, flags));
1108 =for apidoc is_utf8_fixed_width_buf_flags
1110 Returns TRUE if the fixed-width buffer starting at C<s> with length C<len>
1111 is entirely valid UTF-8, subject to the restrictions given by C<flags>;
1112 otherwise it returns FALSE.
1114 If C<flags> is 0, any well-formed UTF-8, as extended by Perl, is accepted
1115 without restriction. If the final few bytes of the buffer do not form a
1116 complete code point, this will return TRUE anyway, provided that
1117 C<L</is_utf8_valid_partial_char_flags>> returns TRUE for them.
1119 If C<flags> in non-zero, it can be any combination of the
1120 C<UTF8_DISALLOW_I<foo>> flags accepted by C<L</utf8n_to_uvchr>>, and with the
1123 This function differs from C<L</is_utf8_string_flags>> only in that the latter
1124 returns FALSE if the final few bytes of the string don't form a complete code
1129 #define is_utf8_fixed_width_buf_flags(s, len, flags) \
1130 is_utf8_fixed_width_buf_loclen_flags(s, len, 0, 0, flags)
1134 =for apidoc is_utf8_fixed_width_buf_loc_flags
1136 Like C<L</is_utf8_fixed_width_buf_flags>> but stores the location of the
1137 failure in the C<ep> pointer. If the function returns TRUE, C<*ep> will point
1138 to the beginning of any partial character at the end of the buffer; if there is
1139 no partial character C<*ep> will contain C<s>+C<len>.
1141 See also C<L</is_utf8_fixed_width_buf_loclen_flags>>.
1146 #define is_utf8_fixed_width_buf_loc_flags(s, len, loc, flags) \
1147 is_utf8_fixed_width_buf_loclen_flags(s, len, loc, 0, flags)
1151 =for apidoc is_utf8_fixed_width_buf_loclen_flags
1153 Like C<L</is_utf8_fixed_width_buf_loc_flags>> but stores the number of
1154 complete, valid characters found in the C<el> pointer.
1159 PERL_STATIC_INLINE bool
1160 S_is_utf8_fixed_width_buf_loclen_flags(const U8 * const s,
1166 const U8 * maybe_partial;
1168 PERL_ARGS_ASSERT_IS_UTF8_FIXED_WIDTH_BUF_LOCLEN_FLAGS;
1171 ep = &maybe_partial;
1174 /* If it's entirely valid, return that; otherwise see if the only error is
1175 * that the final few bytes are for a partial character */
1176 return is_utf8_string_loclen_flags(s, len, ep, el, flags)
1177 || is_utf8_valid_partial_char_flags(*ep, s + len, flags);
1180 /* ------------------------------- perl.h ----------------------------- */
1183 =head1 Miscellaneous Functions
1185 =for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
1187 Test that the given C<pv> doesn't contain any internal C<NUL> characters.
1188 If it does, set C<errno> to C<ENOENT>, optionally warn, and return FALSE.
1190 Return TRUE if the name is safe.
1192 Used by the C<IS_SAFE_SYSCALL()> macro.
1197 PERL_STATIC_INLINE bool
1198 S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) {
1199 /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
1200 * perl itself uses xce*() functions which accept 8-bit strings.
1203 PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
1207 if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
1208 SETERRNO(ENOENT, LIB_INVARG);
1209 Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
1210 "Invalid \\0 character in %s for %s: %s\\0%s",
1211 what, op_name, pv, null_at+1);
1221 Return true if the supplied filename has a newline character
1222 immediately before the first (hopefully only) NUL.
1224 My original look at this incorrectly used the len from SvPV(), but
1225 that's incorrect, since we allow for a NUL in pv[len-1].
1227 So instead, strlen() and work from there.
1229 This allow for the user reading a filename, forgetting to chomp it,
1232 open my $foo, "$file\0";
1238 PERL_STATIC_INLINE bool
1239 S_should_warn_nl(const char *pv) {
1242 PERL_ARGS_ASSERT_SHOULD_WARN_NL;
1246 return len > 0 && pv[len-1] == '\n';
1251 /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
1253 #define MAX_CHARSET_NAME_LENGTH 2
1255 PERL_STATIC_INLINE const char *
1256 get_regex_charset_name(const U32 flags, STRLEN* const lenp)
1258 /* Returns a string that corresponds to the name of the regex character set
1259 * given by 'flags', and *lenp is set the length of that string, which
1260 * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
1263 switch (get_regex_charset(flags)) {
1264 case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
1265 case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS;
1266 case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
1267 case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
1268 case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
1270 return ASCII_MORE_RESTRICT_PAT_MODS;
1272 /* The NOT_REACHED; hides an assert() which has a rather complex
1273 * definition in perl.h. */
1274 NOT_REACHED; /* NOTREACHED */
1275 return "?"; /* Unknown */
1280 Return false if any get magic is on the SV other than taint magic.
1284 PERL_STATIC_INLINE bool
1285 S_sv_only_taint_gmagic(SV *sv) {
1286 MAGIC *mg = SvMAGIC(sv);
1288 PERL_ARGS_ASSERT_SV_ONLY_TAINT_GMAGIC;
1291 if (mg->mg_type != PERL_MAGIC_taint
1292 && !(mg->mg_flags & MGf_GSKIP)
1293 && mg->mg_virtual->svt_get) {
1296 mg = mg->mg_moremagic;
1302 /* ------------------ cop.h ------------------------------------------- */
1305 /* Enter a block. Push a new base context and return its address. */
1307 PERL_STATIC_INLINE PERL_CONTEXT *
1308 S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix)
1312 PERL_ARGS_ASSERT_CX_PUSHBLOCK;
1317 cx->blk_gimme = gimme;
1318 cx->blk_oldsaveix = saveix;
1319 cx->blk_oldsp = (I32)(sp - PL_stack_base);
1320 cx->blk_oldcop = PL_curcop;
1321 cx->blk_oldmarksp = (I32)(PL_markstack_ptr - PL_markstack);
1322 cx->blk_oldscopesp = PL_scopestack_ix;
1323 cx->blk_oldpm = PL_curpm;
1324 cx->blk_old_tmpsfloor = PL_tmps_floor;
1326 PL_tmps_floor = PL_tmps_ix;
1327 CX_DEBUG(cx, "PUSH");
1332 /* Exit a block (RETURN and LAST). */
1334 PERL_STATIC_INLINE void
1335 S_cx_popblock(pTHX_ PERL_CONTEXT *cx)
1337 PERL_ARGS_ASSERT_CX_POPBLOCK;
1339 CX_DEBUG(cx, "POP");
1340 /* these 3 are common to cx_popblock and cx_topblock */
1341 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
1342 PL_scopestack_ix = cx->blk_oldscopesp;
1343 PL_curpm = cx->blk_oldpm;
1345 /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats
1346 * and leaves a CX entry lying around for repeated use, so
1347 * skip for multicall */ \
1348 assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx))
1349 || PL_savestack_ix == cx->blk_oldsaveix);
1350 PL_curcop = cx->blk_oldcop;
1351 PL_tmps_floor = cx->blk_old_tmpsfloor;
1354 /* Continue a block elsewhere (e.g. NEXT, REDO, GOTO).
1355 * Whereas cx_popblock() restores the state to the point just before
1356 * cx_pushblock() was called, cx_topblock() restores it to the point just
1357 * *after* cx_pushblock() was called. */
1359 PERL_STATIC_INLINE void
1360 S_cx_topblock(pTHX_ PERL_CONTEXT *cx)
1362 PERL_ARGS_ASSERT_CX_TOPBLOCK;
1364 CX_DEBUG(cx, "TOP");
1365 /* these 3 are common to cx_popblock and cx_topblock */
1366 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
1367 PL_scopestack_ix = cx->blk_oldscopesp;
1368 PL_curpm = cx->blk_oldpm;
1370 PL_stack_sp = PL_stack_base + cx->blk_oldsp;
1374 PERL_STATIC_INLINE void
1375 S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
1377 U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub);
1379 PERL_ARGS_ASSERT_CX_PUSHSUB;
1381 PERL_DTRACE_PROBE_ENTRY(cv);
1382 cx->blk_sub.cv = cv;
1383 cx->blk_sub.olddepth = CvDEPTH(cv);
1384 cx->blk_sub.prevcomppad = PL_comppad;
1385 cx->cx_type |= (hasargs) ? CXp_HASARGS : 0;
1386 cx->blk_sub.retop = retop;
1387 SvREFCNT_inc_simple_void_NN(cv);
1388 cx->blk_u16 = PL_op->op_private & (phlags|OPpDEREF);
1392 /* subsets of cx_popsub() */
1394 PERL_STATIC_INLINE void
1395 S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx)
1399 PERL_ARGS_ASSERT_CX_POPSUB_COMMON;
1400 assert(CxTYPE(cx) == CXt_SUB);
1402 PL_comppad = cx->blk_sub.prevcomppad;
1403 PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
1404 cv = cx->blk_sub.cv;
1405 CvDEPTH(cv) = cx->blk_sub.olddepth;
1406 cx->blk_sub.cv = NULL;
1411 /* handle the @_ part of leaving a sub */
1413 PERL_STATIC_INLINE void
1414 S_cx_popsub_args(pTHX_ PERL_CONTEXT *cx)
1418 PERL_ARGS_ASSERT_CX_POPSUB_ARGS;
1419 assert(CxTYPE(cx) == CXt_SUB);
1420 assert(AvARRAY(MUTABLE_AV(
1421 PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
1422 CvDEPTH(cx->blk_sub.cv)])) == PL_curpad);
1424 CX_POP_SAVEARRAY(cx);
1425 av = MUTABLE_AV(PAD_SVl(0));
1426 if (UNLIKELY(AvREAL(av)))
1427 /* abandon @_ if it got reified */
1428 clear_defarray(av, 0);
1435 PERL_STATIC_INLINE void
1436 S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
1438 PERL_ARGS_ASSERT_CX_POPSUB;
1439 assert(CxTYPE(cx) == CXt_SUB);
1441 PERL_DTRACE_PROBE_RETURN(cx->blk_sub.cv);
1445 cx_popsub_common(cx);
1449 PERL_STATIC_INLINE void
1450 S_cx_pushformat(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, GV *gv)
1452 PERL_ARGS_ASSERT_CX_PUSHFORMAT;
1454 cx->blk_format.cv = cv;
1455 cx->blk_format.retop = retop;
1456 cx->blk_format.gv = gv;
1457 cx->blk_format.dfoutgv = PL_defoutgv;
1458 cx->blk_format.prevcomppad = PL_comppad;
1461 SvREFCNT_inc_simple_void_NN(cv);
1463 SvREFCNT_inc_void(cx->blk_format.dfoutgv);
1467 PERL_STATIC_INLINE void
1468 S_cx_popformat(pTHX_ PERL_CONTEXT *cx)
1473 PERL_ARGS_ASSERT_CX_POPFORMAT;
1474 assert(CxTYPE(cx) == CXt_FORMAT);
1476 dfout = cx->blk_format.dfoutgv;
1478 cx->blk_format.dfoutgv = NULL;
1479 SvREFCNT_dec_NN(dfout);
1481 PL_comppad = cx->blk_format.prevcomppad;
1482 PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
1483 cv = cx->blk_format.cv;
1484 cx->blk_format.cv = NULL;
1486 SvREFCNT_dec_NN(cv);
1490 PERL_STATIC_INLINE void
1491 S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv)
1493 PERL_ARGS_ASSERT_CX_PUSHEVAL;
1495 cx->blk_eval.retop = retop;
1496 cx->blk_eval.old_namesv = namesv;
1497 cx->blk_eval.old_eval_root = PL_eval_root;
1498 cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL;
1499 cx->blk_eval.cv = NULL; /* later set by doeval_compile() */
1500 cx->blk_eval.cur_top_env = PL_top_env;
1502 assert(!(PL_in_eval & ~ 0x3F));
1503 assert(!(PL_op->op_type & ~0x1FF));
1504 cx->blk_u16 = (PL_in_eval & 0x3F) | ((U16)PL_op->op_type << 7);
1508 PERL_STATIC_INLINE void
1509 S_cx_popeval(pTHX_ PERL_CONTEXT *cx)
1513 PERL_ARGS_ASSERT_CX_POPEVAL;
1514 assert(CxTYPE(cx) == CXt_EVAL);
1516 PL_in_eval = CxOLD_IN_EVAL(cx);
1517 assert(!(PL_in_eval & 0xc0));
1518 PL_eval_root = cx->blk_eval.old_eval_root;
1519 sv = cx->blk_eval.cur_text;
1520 if (sv && CxEVAL_TXT_REFCNTED(cx)) {
1521 cx->blk_eval.cur_text = NULL;
1522 SvREFCNT_dec_NN(sv);
1525 sv = cx->blk_eval.old_namesv;
1527 cx->blk_eval.old_namesv = NULL;
1528 SvREFCNT_dec_NN(sv);
1533 /* push a plain loop, i.e.
1535 * while (cond) { block }
1536 * for (init;cond;continue) { block }
1537 * This loop can be last/redo'ed etc.
1540 PERL_STATIC_INLINE void
1541 S_cx_pushloop_plain(pTHX_ PERL_CONTEXT *cx)
1543 PERL_ARGS_ASSERT_CX_PUSHLOOP_PLAIN;
1544 cx->blk_loop.my_op = cLOOP;
1548 /* push a true for loop, i.e.
1549 * for var (list) { block }
1552 PERL_STATIC_INLINE void
1553 S_cx_pushloop_for(pTHX_ PERL_CONTEXT *cx, void *itervarp, SV* itersave)
1555 PERL_ARGS_ASSERT_CX_PUSHLOOP_FOR;
1557 /* this one line is common with cx_pushloop_plain */
1558 cx->blk_loop.my_op = cLOOP;
1560 cx->blk_loop.itervar_u.svp = (SV**)itervarp;
1561 cx->blk_loop.itersave = itersave;
1563 cx->blk_loop.oldcomppad = PL_comppad;
1568 /* pop all loop types, including plain */
1570 PERL_STATIC_INLINE void
1571 S_cx_poploop(pTHX_ PERL_CONTEXT *cx)
1573 PERL_ARGS_ASSERT_CX_POPLOOP;
1575 assert(CxTYPE_is_LOOP(cx));
1576 if ( CxTYPE(cx) == CXt_LOOP_ARY
1577 || CxTYPE(cx) == CXt_LOOP_LAZYSV)
1579 /* Free ary or cur. This assumes that state_u.ary.ary
1580 * aligns with state_u.lazysv.cur. See cx_dup() */
1581 SV *sv = cx->blk_loop.state_u.lazysv.cur;
1582 cx->blk_loop.state_u.lazysv.cur = NULL;
1583 SvREFCNT_dec_NN(sv);
1584 if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
1585 sv = cx->blk_loop.state_u.lazysv.end;
1586 cx->blk_loop.state_u.lazysv.end = NULL;
1587 SvREFCNT_dec_NN(sv);
1590 if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) {
1592 SV **svp = (cx)->blk_loop.itervar_u.svp;
1593 if ((cx->cx_type & CXp_FOR_GV))
1594 svp = &GvSV((GV*)svp);
1596 *svp = cx->blk_loop.itersave;
1597 cx->blk_loop.itersave = NULL;
1598 SvREFCNT_dec(cursv);
1603 PERL_STATIC_INLINE void
1604 S_cx_pushwhen(pTHX_ PERL_CONTEXT *cx)
1606 PERL_ARGS_ASSERT_CX_PUSHWHEN;
1608 cx->blk_givwhen.leave_op = cLOGOP->op_other;
1612 PERL_STATIC_INLINE void
1613 S_cx_popwhen(pTHX_ PERL_CONTEXT *cx)
1615 PERL_ARGS_ASSERT_CX_POPWHEN;
1616 assert(CxTYPE(cx) == CXt_WHEN);
1618 PERL_UNUSED_ARG(cx);
1619 PERL_UNUSED_CONTEXT;
1620 /* currently NOOP */
1624 PERL_STATIC_INLINE void
1625 S_cx_pushgiven(pTHX_ PERL_CONTEXT *cx, SV *orig_defsv)
1627 PERL_ARGS_ASSERT_CX_PUSHGIVEN;
1629 cx->blk_givwhen.leave_op = cLOGOP->op_other;
1630 cx->blk_givwhen.defsv_save = orig_defsv;
1634 PERL_STATIC_INLINE void
1635 S_cx_popgiven(pTHX_ PERL_CONTEXT *cx)
1639 PERL_ARGS_ASSERT_CX_POPGIVEN;
1640 assert(CxTYPE(cx) == CXt_GIVEN);
1642 sv = GvSV(PL_defgv);
1643 GvSV(PL_defgv) = cx->blk_givwhen.defsv_save;
1644 cx->blk_givwhen.defsv_save = NULL;
1648 /* ------------------ util.h ------------------------------------------- */
1651 =head1 Miscellaneous Functions
1655 Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
1657 case-insensitively; false otherwise. Uppercase and lowercase ASCII range bytes
1658 match themselves and their opposite case counterparts. Non-cased and non-ASCII
1659 range bytes match only themselves.
1664 PERL_STATIC_INLINE I32
1665 Perl_foldEQ(const char *s1, const char *s2, I32 len)
1667 const U8 *a = (const U8 *)s1;
1668 const U8 *b = (const U8 *)s2;
1670 PERL_ARGS_ASSERT_FOLDEQ;
1675 if (*a != *b && *a != PL_fold[*b])
1682 PERL_STATIC_INLINE I32
1683 Perl_foldEQ_latin1(const char *s1, const char *s2, I32 len)
1685 /* Compare non-utf8 using Unicode (Latin1) semantics. Does not work on
1686 * MICRO_SIGN, LATIN_SMALL_LETTER_SHARP_S, nor
1687 * LATIN_SMALL_LETTER_Y_WITH_DIAERESIS, and does not check for these. Nor
1688 * does it check that the strings each have at least 'len' characters */
1690 const U8 *a = (const U8 *)s1;
1691 const U8 *b = (const U8 *)s2;
1693 PERL_ARGS_ASSERT_FOLDEQ_LATIN1;
1698 if (*a != *b && *a != PL_fold_latin1[*b]) {
1707 =for apidoc foldEQ_locale
1709 Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
1710 same case-insensitively in the current locale; false otherwise.
1715 PERL_STATIC_INLINE I32
1716 Perl_foldEQ_locale(const char *s1, const char *s2, I32 len)
1719 const U8 *a = (const U8 *)s1;
1720 const U8 *b = (const U8 *)s2;
1722 PERL_ARGS_ASSERT_FOLDEQ_LOCALE;
1727 if (*a != *b && *a != PL_fold_locale[*b])
1735 * ex: set ts=8 sts=4 sw=4 et: