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 SSize_t
  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 GV *
  29 S_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
  36 PERL_STATIC_INLINE I32 *
  37 S_CvDEPTHp(const CV * const sv)
  38 {
  39     assert(SvTYPE(sv) == SVt_PVCV || SvTYPE(sv) == SVt_PVFM);
  40     return &((XPVCV*)SvANY(sv))->xcv_depth;
  41 }
  42
  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
  54 #ifdef PERL_CORE
  55 PERL_STATIC_INLINE char *
  56 S_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 }
  71 #endif
  72
  73 /* ------------------------------- mg.h ------------------------------- */
  74
  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)
  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
  93 /* ------------------------------- pad.h ------------------------------ */
  94
  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)
  98 {
  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 */
 104
 105     if (COP_SEQ_RANGE_HIGH(pn) == PERL_PADSEQ_INTRO) {
 106     /* in compiling scope */
 107         if (
 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))
 111         )
 112             return TRUE;
 113     }
 114     else if (
 115         (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn))
 116         ?
 117             (  seq >  COP_SEQ_RANGE_LOW(pn)
 118             || seq <= COP_SEQ_RANGE_HIGH(pn))
 119
 120         :    (  seq >  COP_SEQ_RANGE_LOW(pn)
 121              && seq <= COP_SEQ_RANGE_HIGH(pn))
 122     )
 123         return TRUE;
 124     return FALSE;
 125 }
 126 #endif
 127
 128 /* ------------------------------- pp.h ------------------------------- */
 129
 130 PERL_STATIC_INLINE I32
 131 S_TOPMARK(pTHX)
 132 {
 133     DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
 134                                  "MARK top  %p %" IVdf "\n",
 135                                   PL_markstack_ptr,
 136                                   (IV)*PL_markstack_ptr)));
 137     return *PL_markstack_ptr;
 138 }
 139
 140 PERL_STATIC_INLINE I32
 141 S_POPMARK(pTHX)
 142 {
 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--;
 149 }
 150
 151 /* ----------------------------- regexp.h ----------------------------- */
 152
 153 PERL_STATIC_INLINE struct regexp *
 154 S_ReANY(const REGEXP * const re)
 155 {
 156     XPV* const p = (XPV*)SvANY(re);
 157     assert(isREGEXP(re));
 158     return SvTYPE(re) == SVt_PVLV ? p->xpv_len_u.xpvlenu_rx
 159                                    : (struct regexp *)p;
 160 }
 161
 162 /* ------------------------------- sv.h ------------------------------- */
 163
 164 PERL_STATIC_INLINE SV *
 165 S_SvREFCNT_inc(SV *sv)
 166 {
 167     if (LIKELY(sv != NULL))
 168         SvREFCNT(sv)++;
 169     return sv;
 170 }
 171 PERL_STATIC_INLINE SV *
 172 S_SvREFCNT_inc_NN(SV *sv)
 173 {
 174     SvREFCNT(sv)++;
 175     return sv;
 176 }
 177 PERL_STATIC_INLINE void
 178 S_SvREFCNT_inc_void(SV *sv)
 179 {
 180     if (LIKELY(sv != NULL))
 181         SvREFCNT(sv)++;
 182 }
 183 PERL_STATIC_INLINE void
 184 S_SvREFCNT_dec(pTHX_ SV *sv)
 185 {
 186     if (LIKELY(sv != NULL)) {
 187         U32 rc = SvREFCNT(sv);
 188         if (LIKELY(rc > 1))
 189             SvREFCNT(sv) = rc - 1;
 190         else
 191             Perl_sv_free2(aTHX_ sv, rc);
 192     }
 193 }
 194
 195 PERL_STATIC_INLINE void
 196 S_SvREFCNT_dec_NN(pTHX_ SV *sv)
 197 {
 198     U32 rc = SvREFCNT(sv);
 199     if (LIKELY(rc > 1))
 200         SvREFCNT(sv) = rc - 1;
 201     else
 202         Perl_sv_free2(aTHX_ sv, rc);
 203 }
 204
 205 PERL_STATIC_INLINE void
 206 SvAMAGIC_on(SV *sv)
 207 {
 208     assert(SvROK(sv));
 209     if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
 210 }
 211 PERL_STATIC_INLINE void
 212 SvAMAGIC_off(SV *sv)
 213 {
 214     if (SvROK(sv) && SvOBJECT(SvRV(sv)))
 215         HvAMAGIC_off(SvSTASH(SvRV(sv)));
 216 }
 217
 218 PERL_STATIC_INLINE U32
 219 S_SvPADSTALE_on(SV *sv)
 220 {
 221     assert(!(SvFLAGS(sv) & SVs_PADTMP));
 222     return SvFLAGS(sv) |= SVs_PADSTALE;
 223 }
 224 PERL_STATIC_INLINE U32
 225 S_SvPADSTALE_off(SV *sv)
 226 {
 227     assert(!(SvFLAGS(sv) & SVs_PADTMP));
 228     return SvFLAGS(sv) &= ~SVs_PADSTALE;
 229 }
 230 #if defined(PERL_CORE) || defined (PERL_EXT)
 231 PERL_STATIC_INLINE STRLEN
 232 S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
 233 {
 234     PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B;
 235     if (SvGAMAGIC(sv)) {
 236         U8 *hopped = utf8_hop((U8 *)pv, pos);
 237         if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
 238         return (STRLEN)(hopped - (U8 *)pv);
 239     }
 240     return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
 241 }
 242 #endif
 243
 244 /* ------------------------------- handy.h ------------------------------- */
 245
 246 /* saves machine code for a common noreturn idiom typically used in Newx*() */
 247 #ifdef GCC_DIAG_PRAGMA
 248 GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
 249 #endif
 250 static void
 251 S_croak_memory_wrap(void)
 252 {
 253     Perl_croak_nocontext("%s",PL_memory_wrap);
 254 }
 255 #ifdef GCC_DIAG_PRAGMA
 256 GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
 257 #endif
 258
 259 /* ------------------------------- utf8.h ------------------------------- */
 260
 261 /*
 262 =head1 Unicode Support
 263 */
 264
 265 PERL_STATIC_INLINE void
 266 S_append_utf8_from_native_byte(const U8 byte, U8** dest)
 267 {
 268     /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
 269      * encoded string at '*dest', updating '*dest' to include it */
 270
 271     PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
 272
 273     if (NATIVE_BYTE_IS_INVARIANT(byte))
 274         *((*dest)++) = byte;
 275     else {
 276         *((*dest)++) = UTF8_EIGHT_BIT_HI(byte);
 277         *((*dest)++) = UTF8_EIGHT_BIT_LO(byte);
 278     }
 279 }
 280
 281 /*
 282 =for apidoc valid_utf8_to_uvchr
 283 Like C<L</utf8_to_uvchr_buf>>, but should only be called when it is known that
 284 the next character in the input UTF-8 string C<s> is well-formed (I<e.g.>,
 285 it passes C<L</isUTF8_CHAR>>.  Surrogates, non-character code points, and
 286 non-Unicode code points are allowed.
 287
 288 =cut
 289
 290  */
 291
 292 PERL_STATIC_INLINE UV
 293 Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen)
 294 {
 295     const UV expectlen = UTF8SKIP(s);
 296     const U8* send = s + expectlen;
 297     UV uv = *s;
 298
 299     PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR;
 300
 301     if (retlen) {
 302         *retlen = expectlen;
 303     }
 304
 305     /* An invariant is trivially returned */
 306     if (expectlen == 1) {
 307         return uv;
 308     }
 309
 310     /* Remove the leading bits that indicate the number of bytes, leaving just
 311      * the bits that are part of the value */
 312     uv = NATIVE_UTF8_TO_I8(uv) & UTF_START_MASK(expectlen);
 313
 314     /* Now, loop through the remaining bytes, accumulating each into the
 315      * working total as we go.  (I khw tried unrolling the loop for up to 4
 316      * bytes, but there was no performance improvement) */
 317     for (++s; s < send; s++) {
 318         uv = UTF8_ACCUMULATE(uv, *s);
 319     }
 320
 321     return UNI_TO_NATIVE(uv);
 322
 323 }
 324
 325 /*
 326 =for apidoc is_utf8_invariant_string
 327
 328 Returns TRUE if the first C<len> bytes of the string C<s> are the same
 329 regardless of the UTF-8 encoding of the string (or UTF-EBCDIC encoding on
 330 EBCDIC machines); otherwise it returns FALSE.  That is, it returns TRUE if they
 331 are UTF-8 invariant.  On ASCII-ish machines, all the ASCII characters and only
 332 the ASCII characters fit this definition.  On EBCDIC machines, the ASCII-range
 333 characters are invariant, but so also are the C1 controls.
 334
 335 If C<len> is 0, it will be calculated using C<strlen(s)>, (which means if you
 336 use this option, that C<s> can't have embedded C<NUL> characters and has to
 337 have a terminating C<NUL> byte).
 338
 339 See also
 340 C<L</is_utf8_string>>,
 341 C<L</is_utf8_string_flags>>,
 342 C<L</is_utf8_string_loc>>,
 343 C<L</is_utf8_string_loc_flags>>,
 344 C<L</is_utf8_string_loclen>>,
 345 C<L</is_utf8_string_loclen_flags>>,
 346 C<L</is_utf8_fixed_width_buf_flags>>,
 347 C<L</is_utf8_fixed_width_buf_loc_flags>>,
 348 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 349 C<L</is_strict_utf8_string>>,
 350 C<L</is_strict_utf8_string_loc>>,
 351 C<L</is_strict_utf8_string_loclen>>,
 352 C<L</is_c9strict_utf8_string>>,
 353 C<L</is_c9strict_utf8_string_loc>>,
 354 and
 355 C<L</is_c9strict_utf8_string_loclen>>.
 356
 357 =cut
 358
 359 */
 360
 361 #define is_utf8_invariant_string(s, len)                                    \
 362                                 is_utf8_invariant_string_loc(s, len, NULL)
 363
 364 /*
 365 =for apidoc is_utf8_invariant_string_loc
 366
 367 Like C<L</is_utf8_invariant_string>> but upon failure, stores the location of
 368 the first UTF-8 variant character in the C<ep> pointer; if all characters are
 369 UTF-8 invariant, this function does not change the contents of C<*ep>.
 370
 371 =cut
 372
 373 */
 374
 375 PERL_STATIC_INLINE bool
 376 S_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep)
 377 {
 378     const U8* send;
 379     const U8* x = s;
 380
 381     PERL_ARGS_ASSERT_IS_UTF8_INVARIANT_STRING_LOC;
 382
 383     if (len == 0) {
 384         len = strlen((const char *)s);
 385     }
 386
 387     send = s + len;
 388
 389 #ifndef EBCDIC
 390     /* Try to get the widest word on this platform */
 391 #  ifdef HAS_LONG_LONG
 392 #    define PERL_WORDCAST unsigned long long
 393 #    define PERL_WORDSIZE LONGLONGSIZE
 394 #  else
 395 #    define PERL_WORDCAST UV
 396 #    define PERL_WORDSIZE UVSIZE
 397 #  endif
 398
 399 #  if PERL_WORDSIZE == 4
 400 #    define PERL_VARIANTS_WORD_MASK 0x80808080
 401 #    define PERL_WORD_BOUNDARY_MASK 0x3
 402 #  elif PERL_WORDSIZE == 8
 403 #    define PERL_VARIANTS_WORD_MASK UINT64_C(0x8080808080808080)
 404 #    define PERL_WORD_BOUNDARY_MASK 0x7
 405 #  else
 406 #    error Unexpected word size
 407 #  endif
 408
 409     if ((STRLEN) (send - x) >= PERL_WORDSIZE) {
 410
 411         /* Process per-byte until reach word boundary.  XXX This loop could be
 412          * eliminated if we knew that this platform had fast unaligned reads */
 413         while (PTR2nat(x) & PERL_WORD_BOUNDARY_MASK) {
 414             if (! UTF8_IS_INVARIANT(*x)) {
 415                 if (ep) {
 416                     *ep = x;
 417                 }
 418
 419                 return FALSE;
 420             }
 421             x++;
 422         }
 423
 424         /* Process per-word as long as we have at least a full word left */
 425         while (x + PERL_WORDSIZE <= send) {
 426             if ((* (PERL_WORDCAST *) x) & PERL_VARIANTS_WORD_MASK)  {
 427
 428                 /* Found a variant.  Just return if caller doesn't want its
 429                  * exact position */
 430                 if (! ep) {
 431                     return FALSE;
 432                 }
 433
 434                 /* Otherwise fall into final loop to find which byte it is */
 435                 break;
 436             }
 437             x += PERL_WORDSIZE;
 438         }
 439     }
 440
 441 #  undef PERL_WORDCAST
 442 #  undef PERL_WORDSIZE
 443 #  undef PERL_WORD_BOUNDARY_MASK
 444 #  undef PERL_VARIANTS_WORD_MASK
 445 #endif
 446
 447     /* Process per-byte */
 448     while (x < send) {
 449         if (! UTF8_IS_INVARIANT(*x)) {
 450             if (ep) {
 451                 *ep = x;
 452             }
 453
 454             return FALSE;
 455         }
 456
 457         x++;
 458     }
 459
 460     return TRUE;
 461 }
 462
 463 /*
 464 =for apidoc is_utf8_string
 465
 466 Returns TRUE if the first C<len> bytes of string C<s> form a valid
 467 Perl-extended-UTF-8 string; returns FALSE otherwise.  If C<len> is 0, it will
 468 be calculated using C<strlen(s)> (which means if you use this option, that C<s>
 469 can't have embedded C<NUL> characters and has to have a terminating C<NUL>
 470 byte).  Note that all characters being ASCII constitute 'a valid UTF-8 string'.
 471
 472 This function considers Perl's extended UTF-8 to be valid.  That means that
 473 code points above Unicode, surrogates, and non-character code points are
 474 considered valid by this function.  Use C<L</is_strict_utf8_string>>,
 475 C<L</is_c9strict_utf8_string>>, or C<L</is_utf8_string_flags>> to restrict what
 476 code points are considered valid.
 477
 478 See also
 479 C<L</is_utf8_invariant_string>>,
 480 C<L</is_utf8_invariant_string_loc>>,
 481 C<L</is_utf8_string_loc>>,
 482 C<L</is_utf8_string_loclen>>,
 483 C<L</is_utf8_fixed_width_buf_flags>>,
 484 C<L</is_utf8_fixed_width_buf_loc_flags>>,
 485 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 486
 487 =cut
 488 */
 489
 490 #define is_utf8_string(s, len)  is_utf8_string_loclen(s, len, NULL, NULL)
 491
 492 #if defined(PERL_CORE) || defined (PERL_EXT)
 493
 494 /*
 495 =for apidoc is_utf8_non_invariant_string
 496
 497 Returns TRUE if L<perlapi/is_utf8_invariant_string> returns FALSE for the first
 498 C<len> bytes of the string C<s>, but they are, nonetheless, legal Perl-extended
 499 UTF-8; otherwise returns FALSE.
 500
 501 A TRUE return means that at least one code point represented by the sequence
 502 either is a wide character not representable as a single byte, or the
 503 representation differs depending on whether the sequence is encoded in UTF-8 or
 504 not.
 505
 506 See also
 507 C<L<perlapi/is_utf8_invariant_string>>,
 508 C<L<perlapi/is_utf8_string>>
 509
 510 =cut
 511
 512 This is commonly used to determine if a SV's UTF-8 flag should be turned on.
 513 It needn't be if its string is entirely UTF-8 invariant, and it shouldn't be if
 514 it otherwise contains invalid UTF-8.
 515
 516 It is an internal function because khw thinks that XS code shouldn't be working
 517 at this low a level.  A valid use case could change that.
 518
 519 */
 520
 521 PERL_STATIC_INLINE bool
 522 S_is_utf8_non_invariant_string(const U8* const s, STRLEN len)
 523 {
 524     const U8 * first_variant;
 525
 526     PERL_ARGS_ASSERT_IS_UTF8_NON_INVARIANT_STRING;
 527
 528     if (is_utf8_invariant_string_loc(s, len, &first_variant)) {
 529         return FALSE;
 530     }
 531
 532     return is_utf8_string(first_variant, len - (first_variant - s));
 533 }
 534
 535 #endif
 536
 537 /*
 538 =for apidoc is_strict_utf8_string
 539
 540 Returns TRUE if the first C<len> bytes of string C<s> form a valid
 541 UTF-8-encoded string that is fully interchangeable by any application using
 542 Unicode rules; otherwise it returns FALSE.  If C<len> is 0, it will be
 543 calculated using C<strlen(s)> (which means if you use this option, that C<s>
 544 can't have embedded C<NUL> characters and has to have a terminating C<NUL>
 545 byte).  Note that all characters being ASCII constitute 'a valid UTF-8 string'.
 546
 547 This function returns FALSE for strings containing any
 548 code points above the Unicode max of 0x10FFFF, surrogate code points, or
 549 non-character code points.
 550
 551 See also
 552 C<L</is_utf8_invariant_string>>,
 553 C<L</is_utf8_invariant_string_loc>>,
 554 C<L</is_utf8_string>>,
 555 C<L</is_utf8_string_flags>>,
 556 C<L</is_utf8_string_loc>>,
 557 C<L</is_utf8_string_loc_flags>>,
 558 C<L</is_utf8_string_loclen>>,
 559 C<L</is_utf8_string_loclen_flags>>,
 560 C<L</is_utf8_fixed_width_buf_flags>>,
 561 C<L</is_utf8_fixed_width_buf_loc_flags>>,
 562 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 563 C<L</is_strict_utf8_string_loc>>,
 564 C<L</is_strict_utf8_string_loclen>>,
 565 C<L</is_c9strict_utf8_string>>,
 566 C<L</is_c9strict_utf8_string_loc>>,
 567 and
 568 C<L</is_c9strict_utf8_string_loclen>>.
 569
 570 =cut
 571 */
 572
 573 #define is_strict_utf8_string(s, len)  is_strict_utf8_string_loclen(s, len, NULL, NULL)
 574
 575 /*
 576 =for apidoc is_c9strict_utf8_string
 577
 578 Returns TRUE if the first C<len> bytes of string C<s> form a valid
 579 UTF-8-encoded string that conforms to
 580 L<Unicode Corrigendum #9|http://www.unicode.org/versions/corrigendum9.html>;
 581 otherwise it returns FALSE.  If C<len> is 0, it will be calculated using
 582 C<strlen(s)> (which means if you use this option, that C<s> can't have embedded
 583 C<NUL> characters and has to have a terminating C<NUL> byte).  Note that all
 584 characters being ASCII constitute 'a valid UTF-8 string'.
 585
 586 This function returns FALSE for strings containing any code points above the
 587 Unicode max of 0x10FFFF or surrogate code points, but accepts non-character
 588 code points per
 589 L<Corrigendum #9|http://www.unicode.org/versions/corrigendum9.html>.
 590
 591 See also
 592 C<L</is_utf8_invariant_string>>,
 593 C<L</is_utf8_invariant_string_loc>>,
 594 C<L</is_utf8_string>>,
 595 C<L</is_utf8_string_flags>>,
 596 C<L</is_utf8_string_loc>>,
 597 C<L</is_utf8_string_loc_flags>>,
 598 C<L</is_utf8_string_loclen>>,
 599 C<L</is_utf8_string_loclen_flags>>,
 600 C<L</is_utf8_fixed_width_buf_flags>>,
 601 C<L</is_utf8_fixed_width_buf_loc_flags>>,
 602 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 603 C<L</is_strict_utf8_string>>,
 604 C<L</is_strict_utf8_string_loc>>,
 605 C<L</is_strict_utf8_string_loclen>>,
 606 C<L</is_c9strict_utf8_string_loc>>,
 607 and
 608 C<L</is_c9strict_utf8_string_loclen>>.
 609
 610 =cut
 611 */
 612
 613 #define is_c9strict_utf8_string(s, len)  is_c9strict_utf8_string_loclen(s, len, NULL, 0)
 614
 615 /*
 616 =for apidoc is_utf8_string_flags
 617
 618 Returns TRUE if the first C<len> bytes of string C<s> form a valid
 619 UTF-8 string, subject to the restrictions imposed by C<flags>;
 620 returns FALSE otherwise.  If C<len> is 0, it will be calculated
 621 using C<strlen(s)> (which means if you use this option, that C<s> can't have
 622 embedded C<NUL> characters and has to have a terminating C<NUL> byte).  Note
 623 that all characters being ASCII constitute 'a valid UTF-8 string'.
 624
 625 If C<flags> is 0, this gives the same results as C<L</is_utf8_string>>; if
 626 C<flags> is C<UTF8_DISALLOW_ILLEGAL_INTERCHANGE>, this gives the same results
 627 as C<L</is_strict_utf8_string>>; and if C<flags> is
 628 C<UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE>, this gives the same results as
 629 C<L</is_c9strict_utf8_string>>.  Otherwise C<flags> may be any
 630 combination of the C<UTF8_DISALLOW_I<foo>> flags understood by
 631 C<L</utf8n_to_uvchr>>, with the same meanings.
 632
 633 See also
 634 C<L</is_utf8_invariant_string>>,
 635 C<L</is_utf8_invariant_string_loc>>,
 636 C<L</is_utf8_string>>,
 637 C<L</is_utf8_string_loc>>,
 638 C<L</is_utf8_string_loc_flags>>,
 639 C<L</is_utf8_string_loclen>>,
 640 C<L</is_utf8_string_loclen_flags>>,
 641 C<L</is_utf8_fixed_width_buf_flags>>,
 642 C<L</is_utf8_fixed_width_buf_loc_flags>>,
 643 C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 644 C<L</is_strict_utf8_string>>,
 645 C<L</is_strict_utf8_string_loc>>,
 646 C<L</is_strict_utf8_string_loclen>>,
 647 C<L</is_c9strict_utf8_string>>,
 648 C<L</is_c9strict_utf8_string_loc>>,
 649 and
 650 C<L</is_c9strict_utf8_string_loclen>>.
 651
 652 =cut
 653 */
 654
 655 PERL_STATIC_INLINE bool
 656 S_is_utf8_string_flags(const U8 *s, STRLEN len, const U32 flags)
 657 {
 658     const U8 * first_variant;
 659
 660     PERL_ARGS_ASSERT_IS_UTF8_STRING_FLAGS;
 661     assert(0 == (flags & ~(UTF8_DISALLOW_ILLEGAL_INTERCHANGE
 662                           |UTF8_DISALLOW_PERL_EXTENDED)));
 663
 664     if (len == 0) {
 665         len = strlen((const char *)s);
 666     }
 667
 668     if (flags == 0) {
 669         return is_utf8_string(s, len);
 670     }
 671
 672     if ((flags & ~UTF8_DISALLOW_PERL_EXTENDED)
 673                                         == UTF8_DISALLOW_ILLEGAL_INTERCHANGE)
 674     {
 675         return is_strict_utf8_string(s, len);
 676     }
 677
 678     if ((flags & ~UTF8_DISALLOW_PERL_EXTENDED)
 679                                        == UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE)
 680     {
 681         return is_c9strict_utf8_string(s, len);
 682     }
 683
 684     if (! is_utf8_invariant_string_loc(s, len, &first_variant)) {
 685         const U8* const send = s + len;
 686         const U8* x = first_variant;
 687
 688         while (x < send) {
 689             STRLEN cur_len = isUTF8_CHAR_flags(x, send, flags);
 690             if (UNLIKELY(! cur_len)) {
 691                 return FALSE;
 692             }
 693             x += cur_len;
 694         }
 695     }
 696
 697     return TRUE;
 698 }
 699
 700 /*
 701
 702 =for apidoc is_utf8_string_loc
 703
 704 Like C<L</is_utf8_string>> but stores the location of the failure (in the
 705 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 706 "utf8ness success") in the C<ep> pointer.
 707
 708 See also C<L</is_utf8_string_loclen>>.
 709
 710 =cut
 711 */
 712
 713 #define is_utf8_string_loc(s, len, ep)  is_utf8_string_loclen(s, len, ep, 0)
 714
 715 /*
 716
 717 =for apidoc is_utf8_string_loclen
 718
 719 Like C<L</is_utf8_string>> but stores the location of the failure (in the
 720 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 721 "utf8ness success") in the C<ep> pointer, and the number of UTF-8
 722 encoded characters in the C<el> pointer.
 723
 724 See also C<L</is_utf8_string_loc>>.
 725
 726 =cut
 727 */
 728
 729 PERL_STATIC_INLINE bool
 730 Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
 731 {
 732     const U8 * first_variant;
 733
 734     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN;
 735
 736     if (len == 0) {
 737         len = strlen((const char *) s);
 738     }
 739
 740     if (is_utf8_invariant_string_loc(s, len, &first_variant)) {
 741         if (el)
 742             *el = len;
 743
 744         if (ep) {
 745             *ep = s + len;
 746         }
 747
 748         return TRUE;
 749     }
 750
 751     {
 752         const U8* const send = s + len;
 753         const U8* x = first_variant;
 754         STRLEN outlen = first_variant - s;
 755
 756         while (x < send) {
 757             const STRLEN cur_len = isUTF8_CHAR(x, send);
 758             if (UNLIKELY(! cur_len)) {
 759                 break;
 760             }
 761             x += cur_len;
 762             outlen++;
 763         }
 764
 765         if (el)
 766             *el = outlen;
 767
 768         if (ep) {
 769             *ep = x;
 770         }
 771
 772         return (x == send);
 773     }
 774 }
 775
 776 /*
 777
 778 =for apidoc is_strict_utf8_string_loc
 779
 780 Like C<L</is_strict_utf8_string>> but stores the location of the failure (in the
 781 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 782 "utf8ness success") in the C<ep> pointer.
 783
 784 See also C<L</is_strict_utf8_string_loclen>>.
 785
 786 =cut
 787 */
 788
 789 #define is_strict_utf8_string_loc(s, len, ep)                               \
 790                                 is_strict_utf8_string_loclen(s, len, ep, 0)
 791
 792 /*
 793
 794 =for apidoc is_strict_utf8_string_loclen
 795
 796 Like C<L</is_strict_utf8_string>> but stores the location of the failure (in the
 797 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 798 "utf8ness success") in the C<ep> pointer, and the number of UTF-8
 799 encoded characters in the C<el> pointer.
 800
 801 See also C<L</is_strict_utf8_string_loc>>.
 802
 803 =cut
 804 */
 805
 806 PERL_STATIC_INLINE bool
 807 S_is_strict_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
 808 {
 809     const U8 * first_variant;
 810
 811     PERL_ARGS_ASSERT_IS_STRICT_UTF8_STRING_LOCLEN;
 812
 813     if (len == 0) {
 814         len = strlen((const char *) s);
 815     }
 816
 817     if (is_utf8_invariant_string_loc(s, len, &first_variant)) {
 818         if (el)
 819             *el = len;
 820
 821         if (ep) {
 822             *ep = s + len;
 823         }
 824
 825         return TRUE;
 826     }
 827
 828     {
 829         const U8* const send = s + len;
 830         const U8* x = first_variant;
 831         STRLEN outlen = first_variant - s;
 832
 833         while (x < send) {
 834             const STRLEN cur_len = isSTRICT_UTF8_CHAR(x, send);
 835             if (UNLIKELY(! cur_len)) {
 836                 break;
 837             }
 838             x += cur_len;
 839             outlen++;
 840         }
 841
 842         if (el)
 843             *el = outlen;
 844
 845         if (ep) {
 846             *ep = x;
 847         }
 848
 849         return (x == send);
 850     }
 851 }
 852
 853 /*
 854
 855 =for apidoc is_c9strict_utf8_string_loc
 856
 857 Like C<L</is_c9strict_utf8_string>> but stores the location of the failure (in
 858 the case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 859 "utf8ness success") in the C<ep> pointer.
 860
 861 See also C<L</is_c9strict_utf8_string_loclen>>.
 862
 863 =cut
 864 */
 865
 866 #define is_c9strict_utf8_string_loc(s, len, ep)                             \
 867                             is_c9strict_utf8_string_loclen(s, len, ep, 0)
 868
 869 /*
 870
 871 =for apidoc is_c9strict_utf8_string_loclen
 872
 873 Like C<L</is_c9strict_utf8_string>> but stores the location of the failure (in
 874 the case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 875 "utf8ness success") in the C<ep> pointer, and the number of UTF-8 encoded
 876 characters in the C<el> pointer.
 877
 878 See also C<L</is_c9strict_utf8_string_loc>>.
 879
 880 =cut
 881 */
 882
 883 PERL_STATIC_INLINE bool
 884 S_is_c9strict_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
 885 {
 886     const U8 * first_variant;
 887
 888     PERL_ARGS_ASSERT_IS_C9STRICT_UTF8_STRING_LOCLEN;
 889
 890     if (len == 0) {
 891         len = strlen((const char *) s);
 892     }
 893
 894     if (is_utf8_invariant_string_loc(s, len, &first_variant)) {
 895         if (el)
 896             *el = len;
 897
 898         if (ep) {
 899             *ep = s + len;
 900         }
 901
 902         return TRUE;
 903     }
 904
 905     {
 906         const U8* const send = s + len;
 907         const U8* x = first_variant;
 908         STRLEN outlen = first_variant - s;
 909
 910         while (x < send) {
 911             const STRLEN cur_len = isC9_STRICT_UTF8_CHAR(x, send);
 912             if (UNLIKELY(! cur_len)) {
 913                 break;
 914             }
 915             x += cur_len;
 916             outlen++;
 917         }
 918
 919         if (el)
 920             *el = outlen;
 921
 922         if (ep) {
 923             *ep = x;
 924         }
 925
 926         return (x == send);
 927     }
 928 }
 929
 930 /*
 931
 932 =for apidoc is_utf8_string_loc_flags
 933
 934 Like C<L</is_utf8_string_flags>> but stores the location of the failure (in the
 935 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 936 "utf8ness success") in the C<ep> pointer.
 937
 938 See also C<L</is_utf8_string_loclen_flags>>.
 939
 940 =cut
 941 */
 942
 943 #define is_utf8_string_loc_flags(s, len, ep, flags)                         \
 944                         is_utf8_string_loclen_flags(s, len, ep, 0, flags)
 945
 946
 947 /* The above 3 actual functions could have been moved into the more general one
 948  * just below, and made #defines that call it with the right 'flags'.  They are
 949  * currently kept separate to increase their chances of getting inlined */
 950
 951 /*
 952
 953 =for apidoc is_utf8_string_loclen_flags
 954
 955 Like C<L</is_utf8_string_flags>> but stores the location of the failure (in the
 956 case of "utf8ness failure") or the location C<s>+C<len> (in the case of
 957 "utf8ness success") in the C<ep> pointer, and the number of UTF-8
 958 encoded characters in the C<el> pointer.
 959
 960 See also C<L</is_utf8_string_loc_flags>>.
 961
 962 =cut
 963 */
 964
 965 PERL_STATIC_INLINE bool
 966 S_is_utf8_string_loclen_flags(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el, const U32 flags)
 967 {
 968     const U8 * first_variant;
 969
 970     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN_FLAGS;
 971     assert(0 == (flags & ~(UTF8_DISALLOW_ILLEGAL_INTERCHANGE
 972                           |UTF8_DISALLOW_PERL_EXTENDED)));
 973
 974     if (len == 0) {
 975         len = strlen((const char *) s);
 976     }
 977
 978     if (flags == 0) {
 979         return is_utf8_string_loclen(s, len, ep, el);
 980     }
 981
 982     if ((flags & ~UTF8_DISALLOW_PERL_EXTENDED)
 983                                         == UTF8_DISALLOW_ILLEGAL_INTERCHANGE)
 984     {
 985         return is_strict_utf8_string_loclen(s, len, ep, el);
 986     }
 987
 988     if ((flags & ~UTF8_DISALLOW_PERL_EXTENDED)
 989                                     == UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE)
 990     {
 991         return is_c9strict_utf8_string_loclen(s, len, ep, el);
 992     }
 993
 994     if (is_utf8_invariant_string_loc(s, len, &first_variant)) {
 995         if (el)
 996             *el = len;
 997
 998         if (ep) {
 999             *ep = s + len;
1000         }
1001
1002         return TRUE;
1003     }
1004
1005     {
1006         const U8* send = s + len;
1007         const U8* x = first_variant;
1008         STRLEN outlen = first_variant - s;
1009
1010         while (x < send) {
1011             const STRLEN cur_len = isUTF8_CHAR_flags(x, send, flags);
1012             if (UNLIKELY(! cur_len)) {
1013                 break;
1014             }
1015             x += cur_len;
1016             outlen++;
1017         }
1018
1019         if (el)
1020             *el = outlen;
1021
1022         if (ep) {
1023             *ep = x;
1024         }
1025
1026         return (x == send);
1027     }
1028 }
1029
1030 /*
1031 =for apidoc utf8_distance
1032
1033 Returns the number of UTF-8 characters between the UTF-8 pointers C<a>
1034 and C<b>.
1035
1036 WARNING: use only if you *know* that the pointers point inside the
1037 same UTF-8 buffer.
1038
1039 =cut
1040 */
1041
1042 PERL_STATIC_INLINE IV
1043 Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b)
1044 {
1045     PERL_ARGS_ASSERT_UTF8_DISTANCE;
1046
1047     return (a < b) ? -1 * (IV) utf8_length(a, b) : (IV) utf8_length(b, a);
1048 }
1049
1050 /*
1051 =for apidoc utf8_hop
1052
1053 Return the UTF-8 pointer C<s> displaced by C<off> characters, either
1054 forward or backward.
1055
1056 WARNING: do not use the following unless you *know* C<off> is within
1057 the UTF-8 data pointed to by C<s> *and* that on entry C<s> is aligned
1058 on the first byte of character or just after the last byte of a character.
1059
1060 =cut
1061 */
1062
1063 PERL_STATIC_INLINE U8 *
1064 Perl_utf8_hop(const U8 *s, SSize_t off)
1065 {
1066     PERL_ARGS_ASSERT_UTF8_HOP;
1067
1068     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
1069      * the bitops (especially ~) can create illegal UTF-8.
1070      * In other words: in Perl UTF-8 is not just for Unicode. */
1071
1072     if (off >= 0) {
1073         while (off--)
1074             s += UTF8SKIP(s);
1075     }
1076     else {
1077         while (off++) {
1078             s--;
1079             while (UTF8_IS_CONTINUATION(*s))
1080                 s--;
1081         }
1082     }
1083     GCC_DIAG_IGNORE(-Wcast-qual);
1084     return (U8 *)s;
1085     GCC_DIAG_RESTORE;
1086 }
1087
1088 /*
1089 =for apidoc utf8_hop_forward
1090
1091 Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
1092 forward.
1093
1094 C<off> must be non-negative.
1095
1096 C<s> must be before or equal to C<end>.
1097
1098 When moving forward it will not move beyond C<end>.
1099
1100 Will not exceed this limit even if the string is not valid "UTF-8".
1101
1102 =cut
1103 */
1104
1105 PERL_STATIC_INLINE U8 *
1106 Perl_utf8_hop_forward(const U8 *s, SSize_t off, const U8 *end)
1107 {
1108     PERL_ARGS_ASSERT_UTF8_HOP_FORWARD;
1109
1110     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
1111      * the bitops (especially ~) can create illegal UTF-8.
1112      * In other words: in Perl UTF-8 is not just for Unicode. */
1113
1114     assert(s <= end);
1115     assert(off >= 0);
1116
1117     while (off--) {
1118         STRLEN skip = UTF8SKIP(s);
1119         if ((STRLEN)(end - s) <= skip) {
1120             GCC_DIAG_IGNORE(-Wcast-qual);
1121             return (U8 *)end;
1122             GCC_DIAG_RESTORE;
1123         }
1124         s += skip;
1125     }
1126
1127     GCC_DIAG_IGNORE(-Wcast-qual);
1128     return (U8 *)s;
1129     GCC_DIAG_RESTORE;
1130 }
1131
1132 /*
1133 =for apidoc utf8_hop_back
1134
1135 Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
1136 backward.
1137
1138 C<off> must be non-positive.
1139
1140 C<s> must be after or equal to C<start>.
1141
1142 When moving backward it will not move before C<start>.
1143
1144 Will not exceed this limit even if the string is not valid "UTF-8".
1145
1146 =cut
1147 */
1148
1149 PERL_STATIC_INLINE U8 *
1150 Perl_utf8_hop_back(const U8 *s, SSize_t off, const U8 *start)
1151 {
1152     PERL_ARGS_ASSERT_UTF8_HOP_BACK;
1153
1154     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
1155      * the bitops (especially ~) can create illegal UTF-8.
1156      * In other words: in Perl UTF-8 is not just for Unicode. */
1157
1158     assert(start <= s);
1159     assert(off <= 0);
1160
1161     while (off++ && s > start) {
1162         s--;
1163         while (UTF8_IS_CONTINUATION(*s) && s > start)
1164             s--;
1165     }
1166
1167     GCC_DIAG_IGNORE(-Wcast-qual);
1168     return (U8 *)s;
1169     GCC_DIAG_RESTORE;
1170 }
1171
1172 /*
1173 =for apidoc utf8_hop_safe
1174
1175 Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
1176 either forward or backward.
1177
1178 When moving backward it will not move before C<start>.
1179
1180 When moving forward it will not move beyond C<end>.
1181
1182 Will not exceed those limits even if the string is not valid "UTF-8".
1183
1184 =cut
1185 */
1186
1187 PERL_STATIC_INLINE U8 *
1188 Perl_utf8_hop_safe(const U8 *s, SSize_t off, const U8 *start, const U8 *end)
1189 {
1190     PERL_ARGS_ASSERT_UTF8_HOP_SAFE;
1191
1192     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
1193      * the bitops (especially ~) can create illegal UTF-8.
1194      * In other words: in Perl UTF-8 is not just for Unicode. */
1195
1196     assert(start <= s && s <= end);
1197
1198     if (off >= 0) {
1199         return utf8_hop_forward(s, off, end);
1200     }
1201     else {
1202         return utf8_hop_back(s, off, start);
1203     }
1204 }
1205
1206 /*
1207
1208 =for apidoc is_utf8_valid_partial_char
1209
1210 Returns 0 if the sequence of bytes starting at C<s> and looking no further than
1211 S<C<e - 1>> is the UTF-8 encoding, as extended by Perl, for one or more code
1212 points.  Otherwise, it returns 1 if there exists at least one non-empty
1213 sequence of bytes that when appended to sequence C<s>, starting at position
1214 C<e> causes the entire sequence to be the well-formed UTF-8 of some code point;
1215 otherwise returns 0.
1216
1217 In other words this returns TRUE if C<s> points to a partial UTF-8-encoded code
1218 point.
1219
1220 This is useful when a fixed-length buffer is being tested for being well-formed
1221 UTF-8, but the final few bytes in it don't comprise a full character; that is,
1222 it is split somewhere in the middle of the final code point's UTF-8
1223 representation.  (Presumably when the buffer is refreshed with the next chunk
1224 of data, the new first bytes will complete the partial code point.)   This
1225 function is used to verify that the final bytes in the current buffer are in
1226 fact the legal beginning of some code point, so that if they aren't, the
1227 failure can be signalled without having to wait for the next read.
1228
1229 =cut
1230 */
1231 #define is_utf8_valid_partial_char(s, e)                                    \
1232                                 is_utf8_valid_partial_char_flags(s, e, 0)
1233
1234 /*
1235
1236 =for apidoc is_utf8_valid_partial_char_flags
1237
1238 Like C<L</is_utf8_valid_partial_char>>, it returns a boolean giving whether
1239 or not the input is a valid UTF-8 encoded partial character, but it takes an
1240 extra parameter, C<flags>, which can further restrict which code points are
1241 considered valid.
1242
1243 If C<flags> is 0, this behaves identically to
1244 C<L</is_utf8_valid_partial_char>>.  Otherwise C<flags> can be any combination
1245 of the C<UTF8_DISALLOW_I<foo>> flags accepted by C<L</utf8n_to_uvchr>>.  If
1246 there is any sequence of bytes that can complete the input partial character in
1247 such a way that a non-prohibited character is formed, the function returns
1248 TRUE; otherwise FALSE.  Non character code points cannot be determined based on
1249 partial character input.  But many  of the other possible excluded types can be
1250 determined from just the first one or two bytes.
1251
1252 =cut
1253  */
1254
1255 PERL_STATIC_INLINE bool
1256 S_is_utf8_valid_partial_char_flags(const U8 * const s, const U8 * const e, const U32 flags)
1257 {
1258     PERL_ARGS_ASSERT_IS_UTF8_VALID_PARTIAL_CHAR_FLAGS;
1259
1260     assert(0 == (flags & ~(UTF8_DISALLOW_ILLEGAL_INTERCHANGE
1261                           |UTF8_DISALLOW_PERL_EXTENDED)));
1262
1263     if (s >= e || s + UTF8SKIP(s) <= e) {
1264         return FALSE;
1265     }
1266
1267     return cBOOL(_is_utf8_char_helper(s, e, flags));
1268 }
1269
1270 /*
1271
1272 =for apidoc is_utf8_fixed_width_buf_flags
1273
1274 Returns TRUE if the fixed-width buffer starting at C<s> with length C<len>
1275 is entirely valid UTF-8, subject to the restrictions given by C<flags>;
1276 otherwise it returns FALSE.
1277
1278 If C<flags> is 0, any well-formed UTF-8, as extended by Perl, is accepted
1279 without restriction.  If the final few bytes of the buffer do not form a
1280 complete code point, this will return TRUE anyway, provided that
1281 C<L</is_utf8_valid_partial_char_flags>> returns TRUE for them.
1282
1283 If C<flags> in non-zero, it can be any combination of the
1284 C<UTF8_DISALLOW_I<foo>> flags accepted by C<L</utf8n_to_uvchr>>, and with the
1285 same meanings.
1286
1287 This function differs from C<L</is_utf8_string_flags>> only in that the latter
1288 returns FALSE if the final few bytes of the string don't form a complete code
1289 point.
1290
1291 =cut
1292  */
1293 #define is_utf8_fixed_width_buf_flags(s, len, flags)                        \
1294                 is_utf8_fixed_width_buf_loclen_flags(s, len, 0, 0, flags)
1295
1296 /*
1297
1298 =for apidoc is_utf8_fixed_width_buf_loc_flags
1299
1300 Like C<L</is_utf8_fixed_width_buf_flags>> but stores the location of the
1301 failure in the C<ep> pointer.  If the function returns TRUE, C<*ep> will point
1302 to the beginning of any partial character at the end of the buffer; if there is
1303 no partial character C<*ep> will contain C<s>+C<len>.
1304
1305 See also C<L</is_utf8_fixed_width_buf_loclen_flags>>.
1306
1307 =cut
1308 */
1309
1310 #define is_utf8_fixed_width_buf_loc_flags(s, len, loc, flags)               \
1311                 is_utf8_fixed_width_buf_loclen_flags(s, len, loc, 0, flags)
1312
1313 /*
1314
1315 =for apidoc is_utf8_fixed_width_buf_loclen_flags
1316
1317 Like C<L</is_utf8_fixed_width_buf_loc_flags>> but stores the number of
1318 complete, valid characters found in the C<el> pointer.
1319
1320 =cut
1321 */
1322
1323 PERL_STATIC_INLINE bool
1324 S_is_utf8_fixed_width_buf_loclen_flags(const U8 * const s,
1325                                        STRLEN len,
1326                                        const U8 **ep,
1327                                        STRLEN *el,
1328                                        const U32 flags)
1329 {
1330     const U8 * maybe_partial;
1331
1332     PERL_ARGS_ASSERT_IS_UTF8_FIXED_WIDTH_BUF_LOCLEN_FLAGS;
1333
1334     if (! ep) {
1335         ep  = &maybe_partial;
1336     }
1337
1338     /* If it's entirely valid, return that; otherwise see if the only error is
1339      * that the final few bytes are for a partial character */
1340     return    is_utf8_string_loclen_flags(s, len, ep, el, flags)
1341            || is_utf8_valid_partial_char_flags(*ep, s + len, flags);
1342 }
1343
1344 /* ------------------------------- perl.h ----------------------------- */
1345
1346 /*
1347 =head1 Miscellaneous Functions
1348
1349 =for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
1350
1351 Test that the given C<pv> doesn't contain any internal C<NUL> characters.
1352 If it does, set C<errno> to C<ENOENT>, optionally warn, and return FALSE.
1353
1354 Return TRUE if the name is safe.
1355
1356 Used by the C<IS_SAFE_SYSCALL()> macro.
1357
1358 =cut
1359 */
1360
1361 PERL_STATIC_INLINE bool
1362 S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) {
1363     /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
1364      * perl itself uses xce*() functions which accept 8-bit strings.
1365      */
1366
1367     PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
1368
1369     if (len > 1) {
1370         char *null_at;
1371         if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
1372                 SETERRNO(ENOENT, LIB_INVARG);
1373                 Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
1374                                    "Invalid \\0 character in %s for %s: %s\\0%s",
1375                                    what, op_name, pv, null_at+1);
1376                 return FALSE;
1377         }
1378     }
1379
1380     return TRUE;
1381 }
1382
1383 /*
1384
1385 Return true if the supplied filename has a newline character
1386 immediately before the first (hopefully only) NUL.
1387
1388 My original look at this incorrectly used the len from SvPV(), but
1389 that's incorrect, since we allow for a NUL in pv[len-1].
1390
1391 So instead, strlen() and work from there.
1392
1393 This allow for the user reading a filename, forgetting to chomp it,
1394 then calling:
1395
1396   open my $foo, "$file\0";
1397
1398 */
1399
1400 #ifdef PERL_CORE
1401
1402 PERL_STATIC_INLINE bool
1403 S_should_warn_nl(const char *pv) {
1404     STRLEN len;
1405
1406     PERL_ARGS_ASSERT_SHOULD_WARN_NL;
1407
1408     len = strlen(pv);
1409
1410     return len > 0 && pv[len-1] == '\n';
1411 }
1412
1413 #endif
1414
1415 /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
1416
1417 #define MAX_CHARSET_NAME_LENGTH 2
1418
1419 PERL_STATIC_INLINE const char *
1420 get_regex_charset_name(const U32 flags, STRLEN* const lenp)
1421 {
1422     /* Returns a string that corresponds to the name of the regex character set
1423      * given by 'flags', and *lenp is set the length of that string, which
1424      * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
1425
1426     *lenp = 1;
1427     switch (get_regex_charset(flags)) {
1428         case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
1429         case REGEX_LOCALE_CHARSET:  return LOCALE_PAT_MODS;
1430         case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
1431         case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
1432         case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
1433             *lenp = 2;
1434             return ASCII_MORE_RESTRICT_PAT_MODS;
1435     }
1436     /* The NOT_REACHED; hides an assert() which has a rather complex
1437      * definition in perl.h. */
1438     NOT_REACHED; /* NOTREACHED */
1439     return "?";     /* Unknown */
1440 }
1441
1442 /*
1443
1444 Return false if any get magic is on the SV other than taint magic.
1445
1446 */
1447
1448 PERL_STATIC_INLINE bool
1449 S_sv_only_taint_gmagic(SV *sv) {
1450     MAGIC *mg = SvMAGIC(sv);
1451
1452     PERL_ARGS_ASSERT_SV_ONLY_TAINT_GMAGIC;
1453
1454     while (mg) {
1455         if (mg->mg_type != PERL_MAGIC_taint
1456             && !(mg->mg_flags & MGf_GSKIP)
1457             && mg->mg_virtual->svt_get) {
1458             return FALSE;
1459         }
1460         mg = mg->mg_moremagic;
1461     }
1462
1463     return TRUE;
1464 }
1465
1466 /* ------------------ cop.h ------------------------------------------- */
1467
1468
1469 /* Enter a block. Push a new base context and return its address. */
1470
1471 PERL_STATIC_INLINE PERL_CONTEXT *
1472 S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix)
1473 {
1474     PERL_CONTEXT * cx;
1475
1476     PERL_ARGS_ASSERT_CX_PUSHBLOCK;
1477
1478     CXINC;
1479     cx = CX_CUR();
1480     cx->cx_type        = type;
1481     cx->blk_gimme      = gimme;
1482     cx->blk_oldsaveix  = saveix;
1483     cx->blk_oldsp      = (I32)(sp - PL_stack_base);
1484     cx->blk_oldcop     = PL_curcop;
1485     cx->blk_oldmarksp  = (I32)(PL_markstack_ptr - PL_markstack);
1486     cx->blk_oldscopesp = PL_scopestack_ix;
1487     cx->blk_oldpm      = PL_curpm;
1488     cx->blk_old_tmpsfloor = PL_tmps_floor;
1489
1490     PL_tmps_floor        = PL_tmps_ix;
1491     CX_DEBUG(cx, "PUSH");
1492     return cx;
1493 }
1494
1495
1496 /* Exit a block (RETURN and LAST). */
1497
1498 PERL_STATIC_INLINE void
1499 S_cx_popblock(pTHX_ PERL_CONTEXT *cx)
1500 {
1501     PERL_ARGS_ASSERT_CX_POPBLOCK;
1502
1503     CX_DEBUG(cx, "POP");
1504     /* these 3 are common to cx_popblock and cx_topblock */
1505     PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
1506     PL_scopestack_ix = cx->blk_oldscopesp;
1507     PL_curpm         = cx->blk_oldpm;
1508
1509     /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats
1510      * and leaves a CX entry lying around for repeated use, so
1511      * skip for multicall */                  \
1512     assert(   (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx))
1513             || PL_savestack_ix == cx->blk_oldsaveix);
1514     PL_curcop     = cx->blk_oldcop;
1515     PL_tmps_floor = cx->blk_old_tmpsfloor;
1516 }
1517
1518 /* Continue a block elsewhere (e.g. NEXT, REDO, GOTO).
1519  * Whereas cx_popblock() restores the state to the point just before
1520  * cx_pushblock() was called,  cx_topblock() restores it to the point just
1521  * *after* cx_pushblock() was called. */
1522
1523 PERL_STATIC_INLINE void
1524 S_cx_topblock(pTHX_ PERL_CONTEXT *cx)
1525 {
1526     PERL_ARGS_ASSERT_CX_TOPBLOCK;
1527
1528     CX_DEBUG(cx, "TOP");
1529     /* these 3 are common to cx_popblock and cx_topblock */
1530     PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
1531     PL_scopestack_ix = cx->blk_oldscopesp;
1532     PL_curpm         = cx->blk_oldpm;
1533
1534     PL_stack_sp      = PL_stack_base + cx->blk_oldsp;
1535 }
1536
1537
1538 PERL_STATIC_INLINE void
1539 S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
1540 {
1541     U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub);
1542
1543     PERL_ARGS_ASSERT_CX_PUSHSUB;
1544
1545     PERL_DTRACE_PROBE_ENTRY(cv);
1546     cx->blk_sub.cv = cv;
1547     cx->blk_sub.olddepth = CvDEPTH(cv);
1548     cx->blk_sub.prevcomppad = PL_comppad;
1549     cx->cx_type |= (hasargs) ? CXp_HASARGS : 0;
1550     cx->blk_sub.retop = retop;
1551     SvREFCNT_inc_simple_void_NN(cv);
1552     cx->blk_u16 = PL_op->op_private & (phlags|OPpDEREF);
1553 }
1554
1555
1556 /* subsets of cx_popsub() */
1557
1558 PERL_STATIC_INLINE void
1559 S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx)
1560 {
1561     CV *cv;
1562
1563     PERL_ARGS_ASSERT_CX_POPSUB_COMMON;
1564     assert(CxTYPE(cx) == CXt_SUB);
1565
1566     PL_comppad = cx->blk_sub.prevcomppad;
1567     PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
1568     cv = cx->blk_sub.cv;
1569     CvDEPTH(cv) = cx->blk_sub.olddepth;
1570     cx->blk_sub.cv = NULL;
1571     SvREFCNT_dec(cv);
1572 }
1573
1574
1575 /* handle the @_ part of leaving a sub */
1576
1577 PERL_STATIC_INLINE void
1578 S_cx_popsub_args(pTHX_ PERL_CONTEXT *cx)
1579 {
1580     AV *av;
1581
1582     PERL_ARGS_ASSERT_CX_POPSUB_ARGS;
1583     assert(CxTYPE(cx) == CXt_SUB);
1584     assert(AvARRAY(MUTABLE_AV(
1585         PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
1586                 CvDEPTH(cx->blk_sub.cv)])) == PL_curpad);
1587
1588     CX_POP_SAVEARRAY(cx);
1589     av = MUTABLE_AV(PAD_SVl(0));
1590     if (UNLIKELY(AvREAL(av)))
1591         /* abandon @_ if it got reified */
1592         clear_defarray(av, 0);
1593     else {
1594         CLEAR_ARGARRAY(av);
1595     }
1596 }
1597
1598
1599 PERL_STATIC_INLINE void
1600 S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
1601 {
1602     PERL_ARGS_ASSERT_CX_POPSUB;
1603     assert(CxTYPE(cx) == CXt_SUB);
1604
1605     PERL_DTRACE_PROBE_RETURN(cx->blk_sub.cv);
1606
1607     if (CxHASARGS(cx))
1608         cx_popsub_args(cx);
1609     cx_popsub_common(cx);
1610 }
1611
1612
1613 PERL_STATIC_INLINE void
1614 S_cx_pushformat(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, GV *gv)
1615 {
1616     PERL_ARGS_ASSERT_CX_PUSHFORMAT;
1617
1618     cx->blk_format.cv          = cv;
1619     cx->blk_format.retop       = retop;
1620     cx->blk_format.gv          = gv;
1621     cx->blk_format.dfoutgv     = PL_defoutgv;
1622     cx->blk_format.prevcomppad = PL_comppad;
1623     cx->blk_u16                = 0;
1624
1625     SvREFCNT_inc_simple_void_NN(cv);
1626     CvDEPTH(cv)++;
1627     SvREFCNT_inc_void(cx->blk_format.dfoutgv);
1628 }
1629
1630
1631 PERL_STATIC_INLINE void
1632 S_cx_popformat(pTHX_ PERL_CONTEXT *cx)
1633 {
1634     CV *cv;
1635     GV *dfout;
1636
1637     PERL_ARGS_ASSERT_CX_POPFORMAT;
1638     assert(CxTYPE(cx) == CXt_FORMAT);
1639
1640     dfout = cx->blk_format.dfoutgv;
1641     setdefout(dfout);
1642     cx->blk_format.dfoutgv = NULL;
1643     SvREFCNT_dec_NN(dfout);
1644
1645     PL_comppad = cx->blk_format.prevcomppad;
1646     PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
1647     cv = cx->blk_format.cv;
1648     cx->blk_format.cv = NULL;
1649     --CvDEPTH(cv);
1650     SvREFCNT_dec_NN(cv);
1651 }
1652
1653
1654 PERL_STATIC_INLINE void
1655 S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv)
1656 {
1657     PERL_ARGS_ASSERT_CX_PUSHEVAL;
1658
1659     cx->blk_eval.retop         = retop;
1660     cx->blk_eval.old_namesv    = namesv;
1661     cx->blk_eval.old_eval_root = PL_eval_root;
1662     cx->blk_eval.cur_text      = PL_parser ? PL_parser->linestr : NULL;
1663     cx->blk_eval.cv            = NULL; /* later set by doeval_compile() */
1664     cx->blk_eval.cur_top_env   = PL_top_env;
1665
1666     assert(!(PL_in_eval     & ~ 0x3F));
1667     assert(!(PL_op->op_type & ~0x1FF));
1668     cx->blk_u16 = (PL_in_eval & 0x3F) | ((U16)PL_op->op_type << 7);
1669 }
1670
1671
1672 PERL_STATIC_INLINE void
1673 S_cx_popeval(pTHX_ PERL_CONTEXT *cx)
1674 {
1675     SV *sv;
1676
1677     PERL_ARGS_ASSERT_CX_POPEVAL;
1678     assert(CxTYPE(cx) == CXt_EVAL);
1679
1680     PL_in_eval = CxOLD_IN_EVAL(cx);
1681     assert(!(PL_in_eval & 0xc0));
1682     PL_eval_root = cx->blk_eval.old_eval_root;
1683     sv = cx->blk_eval.cur_text;
1684     if (sv && CxEVAL_TXT_REFCNTED(cx)) {
1685         cx->blk_eval.cur_text = NULL;
1686         SvREFCNT_dec_NN(sv);
1687     }
1688
1689     sv = cx->blk_eval.old_namesv;
1690     if (sv) {
1691         cx->blk_eval.old_namesv = NULL;
1692         SvREFCNT_dec_NN(sv);
1693     }
1694 }
1695
1696
1697 /* push a plain loop, i.e.
1698  *     { block }
1699  *     while (cond) { block }
1700  *     for (init;cond;continue) { block }
1701  * This loop can be last/redo'ed etc.
1702  */
1703
1704 PERL_STATIC_INLINE void
1705 S_cx_pushloop_plain(pTHX_ PERL_CONTEXT *cx)
1706 {
1707     PERL_ARGS_ASSERT_CX_PUSHLOOP_PLAIN;
1708     cx->blk_loop.my_op = cLOOP;
1709 }
1710
1711
1712 /* push a true for loop, i.e.
1713  *     for var (list) { block }
1714  */
1715
1716 PERL_STATIC_INLINE void
1717 S_cx_pushloop_for(pTHX_ PERL_CONTEXT *cx, void *itervarp, SV* itersave)
1718 {
1719     PERL_ARGS_ASSERT_CX_PUSHLOOP_FOR;
1720
1721     /* this one line is common with cx_pushloop_plain */
1722     cx->blk_loop.my_op = cLOOP;
1723
1724     cx->blk_loop.itervar_u.svp = (SV**)itervarp;
1725     cx->blk_loop.itersave      = itersave;
1726 #ifdef USE_ITHREADS
1727     cx->blk_loop.oldcomppad = PL_comppad;
1728 #endif
1729 }
1730
1731
1732 /* pop all loop types, including plain */
1733
1734 PERL_STATIC_INLINE void
1735 S_cx_poploop(pTHX_ PERL_CONTEXT *cx)
1736 {
1737     PERL_ARGS_ASSERT_CX_POPLOOP;
1738
1739     assert(CxTYPE_is_LOOP(cx));
1740     if (  CxTYPE(cx) == CXt_LOOP_ARY
1741        || CxTYPE(cx) == CXt_LOOP_LAZYSV)
1742     {
1743         /* Free ary or cur. This assumes that state_u.ary.ary
1744          * aligns with state_u.lazysv.cur. See cx_dup() */
1745         SV *sv = cx->blk_loop.state_u.lazysv.cur;
1746         cx->blk_loop.state_u.lazysv.cur = NULL;
1747         SvREFCNT_dec_NN(sv);
1748         if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
1749             sv = cx->blk_loop.state_u.lazysv.end;
1750             cx->blk_loop.state_u.lazysv.end = NULL;
1751             SvREFCNT_dec_NN(sv);
1752         }
1753     }
1754     if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) {
1755         SV *cursv;
1756         SV **svp = (cx)->blk_loop.itervar_u.svp;
1757         if ((cx->cx_type & CXp_FOR_GV))
1758             svp = &GvSV((GV*)svp);
1759         cursv = *svp;
1760         *svp = cx->blk_loop.itersave;
1761         cx->blk_loop.itersave = NULL;
1762         SvREFCNT_dec(cursv);
1763     }
1764 }
1765
1766
1767 PERL_STATIC_INLINE void
1768 S_cx_pushwhen(pTHX_ PERL_CONTEXT *cx)
1769 {
1770     PERL_ARGS_ASSERT_CX_PUSHWHEN;
1771
1772     cx->blk_givwhen.leave_op = cLOGOP->op_other;
1773 }
1774
1775
1776 PERL_STATIC_INLINE void
1777 S_cx_popwhen(pTHX_ PERL_CONTEXT *cx)
1778 {
1779     PERL_ARGS_ASSERT_CX_POPWHEN;
1780     assert(CxTYPE(cx) == CXt_WHEN);
1781
1782     PERL_UNUSED_ARG(cx);
1783     PERL_UNUSED_CONTEXT;
1784     /* currently NOOP */
1785 }
1786
1787
1788 PERL_STATIC_INLINE void
1789 S_cx_pushgiven(pTHX_ PERL_CONTEXT *cx, SV *orig_defsv)
1790 {
1791     PERL_ARGS_ASSERT_CX_PUSHGIVEN;
1792
1793     cx->blk_givwhen.leave_op = cLOGOP->op_other;
1794     cx->blk_givwhen.defsv_save = orig_defsv;
1795 }
1796
1797
1798 PERL_STATIC_INLINE void
1799 S_cx_popgiven(pTHX_ PERL_CONTEXT *cx)
1800 {
1801     SV *sv;
1802
1803     PERL_ARGS_ASSERT_CX_POPGIVEN;
1804     assert(CxTYPE(cx) == CXt_GIVEN);
1805
1806     sv = GvSV(PL_defgv);
1807     GvSV(PL_defgv) = cx->blk_givwhen.defsv_save;
1808     cx->blk_givwhen.defsv_save = NULL;
1809     SvREFCNT_dec(sv);
1810 }
1811
1812 /* ------------------ util.h ------------------------------------------- */
1813
1814 /*
1815 =head1 Miscellaneous Functions
1816
1817 =for apidoc foldEQ
1818
1819 Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
1820 same
1821 case-insensitively; false otherwise.  Uppercase and lowercase ASCII range bytes
1822 match themselves and their opposite case counterparts.  Non-cased and non-ASCII
1823 range bytes match only themselves.
1824
1825 =cut
1826 */
1827
1828 PERL_STATIC_INLINE I32
1829 Perl_foldEQ(const char *s1, const char *s2, I32 len)
1830 {
1831     const U8 *a = (const U8 *)s1;
1832     const U8 *b = (const U8 *)s2;
1833
1834     PERL_ARGS_ASSERT_FOLDEQ;
1835
1836     assert(len >= 0);
1837
1838     while (len--) {
1839         if (*a != *b && *a != PL_fold[*b])
1840             return 0;
1841         a++,b++;
1842     }
1843     return 1;
1844 }
1845
1846 PERL_STATIC_INLINE I32
1847 Perl_foldEQ_latin1(const char *s1, const char *s2, I32 len)
1848 {
1849     /* Compare non-utf8 using Unicode (Latin1) semantics.  Does not work on
1850      * MICRO_SIGN, LATIN_SMALL_LETTER_SHARP_S, nor
1851      * LATIN_SMALL_LETTER_Y_WITH_DIAERESIS, and does not check for these.  Nor
1852      * does it check that the strings each have at least 'len' characters */
1853
1854     const U8 *a = (const U8 *)s1;
1855     const U8 *b = (const U8 *)s2;
1856
1857     PERL_ARGS_ASSERT_FOLDEQ_LATIN1;
1858
1859     assert(len >= 0);
1860
1861     while (len--) {
1862         if (*a != *b && *a != PL_fold_latin1[*b]) {
1863             return 0;
1864         }
1865         a++, b++;
1866     }
1867     return 1;
1868 }
1869
1870 /*
1871 =for apidoc foldEQ_locale
1872
1873 Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
1874 same case-insensitively in the current locale; false otherwise.
1875
1876 =cut
1877 */
1878
1879 PERL_STATIC_INLINE I32
1880 Perl_foldEQ_locale(const char *s1, const char *s2, I32 len)
1881 {
1882     dVAR;
1883     const U8 *a = (const U8 *)s1;
1884     const U8 *b = (const U8 *)s2;
1885
1886     PERL_ARGS_ASSERT_FOLDEQ_LOCALE;
1887
1888     assert(len >= 0);
1889
1890     while (len--) {
1891         if (*a != *b && *a != PL_fold_locale[*b])
1892             return 0;
1893         a++,b++;
1894     }
1895     return 1;
1896 }
1897
1898 #if ! defined (HAS_MEMRCHR) && (defined(PERL_CORE) || defined(PERL_EXT))
1899
1900 PERL_STATIC_INLINE void *
1901 S_my_memrchr(const char * s, const char c, const STRLEN len)
1902 {
1903     /* memrchr(), since many platforms lack it */
1904
1905     const char * t = s + len - 1;
1906
1907     PERL_ARGS_ASSERT_MY_MEMRCHR;
1908
1909     while (t >= s) {
1910         if (*t == c) {
1911             return (void *) t;
1912         }
1913         t--;
1914     }
1915
1916     return NULL;
1917 }
1918
1919 #endif
1920
1921 /*
1922  * ex: set ts=8 sts=4 sw=4 et:
1923  */