S_TOPMARK(pTHX)
{
DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
- "MARK top %p %"IVdf"\n",
+ "MARK top %p %" IVdf "\n",
PL_markstack_ptr,
(IV)*PL_markstack_ptr)));
return *PL_markstack_ptr;
S_POPMARK(pTHX)
{
DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
- "MARK pop %p %"IVdf"\n",
+ "MARK pop %p %" IVdf "\n",
(PL_markstack_ptr-1),
(IV)*(PL_markstack_ptr-1))));
assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");
s--;
}
}
+ GCC_DIAG_IGNORE(-Wcast-qual);
return (U8 *)s;
+ GCC_DIAG_RESTORE;
+}
+
+/*
+=for apidoc utf8_hop_forward
+
+Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
+forward.
+
+C<off> must be non-negative.
+
+C<s> must be before or equal to C<end>.
+
+When moving forward it will not move beyond C<end>.
+
+Will not exceed this limit even if the string is not valid "UTF-8".
+
+=cut
+*/
+
+PERL_STATIC_INLINE U8 *
+Perl_utf8_hop_forward(const U8 *s, SSize_t off, const U8 *end)
+{
+ PERL_ARGS_ASSERT_UTF8_HOP_FORWARD;
+
+ /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
+ * the bitops (especially ~) can create illegal UTF-8.
+ * In other words: in Perl UTF-8 is not just for Unicode. */
+
+ assert(s <= end);
+ assert(off >= 0);
+
+ while (off--) {
+ STRLEN skip = UTF8SKIP(s);
+ if ((STRLEN)(end - s) <= skip) {
+ GCC_DIAG_IGNORE(-Wcast-qual);
+ return (U8 *)end;
+ GCC_DIAG_RESTORE;
+ }
+ s += skip;
+ }
+
+ GCC_DIAG_IGNORE(-Wcast-qual);
+ return (U8 *)s;
+ GCC_DIAG_RESTORE;
+}
+
+/*
+=for apidoc utf8_hop_back
+
+Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
+backward.
+
+C<off> must be non-positive.
+
+C<s> must be after or equal to C<start>.
+
+When moving backward it will not move before C<start>.
+
+Will not exceed this limit even if the string is not valid "UTF-8".
+
+=cut
+*/
+
+PERL_STATIC_INLINE U8 *
+Perl_utf8_hop_back(const U8 *s, SSize_t off, const U8 *start)
+{
+ PERL_ARGS_ASSERT_UTF8_HOP_BACK;
+
+ /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
+ * the bitops (especially ~) can create illegal UTF-8.
+ * In other words: in Perl UTF-8 is not just for Unicode. */
+
+ assert(start <= s);
+ assert(off <= 0);
+
+ while (off++ && s > start) {
+ s--;
+ while (UTF8_IS_CONTINUATION(*s) && s > start)
+ s--;
+ }
+
+ GCC_DIAG_IGNORE(-Wcast-qual);
+ return (U8 *)s;
+ GCC_DIAG_RESTORE;
+}
+
+/*
+=for apidoc utf8_hop_safe
+
+Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
+either forward or backward.
+
+When moving backward it will not move before C<start>.
+
+When moving forward it will not move beyond C<end>.
+
+Will not exceed those limits even if the string is not valid "UTF-8".
+
+=cut
+*/
+
+PERL_STATIC_INLINE U8 *
+Perl_utf8_hop_safe(const U8 *s, SSize_t off, const U8 *start, const U8 *end)
+{
+ PERL_ARGS_ASSERT_UTF8_HOP_SAFE;
+
+ /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
+ * the bitops (especially ~) can create illegal UTF-8.
+ * In other words: in Perl UTF-8 is not just for Unicode. */
+
+ assert(start <= s && s <= end);
+
+ if (off >= 0) {
+ return utf8_hop_forward(s, off, end);
+ }
+ else {
+ return utf8_hop_back(s, off, start);
+ }
}
/*
cx->blk_eval.cv = NULL; /* later set by doeval_compile() */
cx->blk_eval.cur_top_env = PL_top_env;
- assert(!(PL_in_eval & ~ 0x7F));
+ assert(!(PL_in_eval & ~ 0x3F));
assert(!(PL_op->op_type & ~0x1FF));
- cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7);
+ cx->blk_u16 = (PL_in_eval & 0x3F) | ((U16)PL_op->op_type << 7);
}
assert(CxTYPE(cx) == CXt_EVAL);
PL_in_eval = CxOLD_IN_EVAL(cx);
+ assert(!(PL_in_eval & 0xc0));
PL_eval_root = cx->blk_eval.old_eval_root;
sv = cx->blk_eval.cur_text;
- if (sv && SvSCREAM(sv)) {
+ if (sv && CxEVAL_TXT_REFCNTED(cx)) {
cx->blk_eval.cur_text = NULL;
SvREFCNT_dec_NN(sv);
}
SvREFCNT_dec(sv);
}
+/* ------------------ util.h ------------------------------------------- */
+
+/*
+=head1 Miscellaneous Functions
+
+=for apidoc foldEQ
+
+Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
+same
+case-insensitively; false otherwise. Uppercase and lowercase ASCII range bytes
+match themselves and their opposite case counterparts. Non-cased and non-ASCII
+range bytes match only themselves.
+
+=cut
+*/
+
+PERL_STATIC_INLINE I32
+Perl_foldEQ(const char *s1, const char *s2, I32 len)
+{
+ const U8 *a = (const U8 *)s1;
+ const U8 *b = (const U8 *)s2;
+
+ PERL_ARGS_ASSERT_FOLDEQ;
+
+ assert(len >= 0);
+
+ while (len--) {
+ if (*a != *b && *a != PL_fold[*b])
+ return 0;
+ a++,b++;
+ }
+ return 1;
+}
+
+PERL_STATIC_INLINE I32
+Perl_foldEQ_latin1(const char *s1, const char *s2, I32 len)
+{
+ /* Compare non-utf8 using Unicode (Latin1) semantics. Does not work on
+ * MICRO_SIGN, LATIN_SMALL_LETTER_SHARP_S, nor
+ * LATIN_SMALL_LETTER_Y_WITH_DIAERESIS, and does not check for these. Nor
+ * does it check that the strings each have at least 'len' characters */
+
+ const U8 *a = (const U8 *)s1;
+ const U8 *b = (const U8 *)s2;
+
+ PERL_ARGS_ASSERT_FOLDEQ_LATIN1;
+
+ assert(len >= 0);
+
+ while (len--) {
+ if (*a != *b && *a != PL_fold_latin1[*b]) {
+ return 0;
+ }
+ a++, b++;
+ }
+ return 1;
+}
+
+/*
+=for apidoc foldEQ_locale
+
+Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
+same case-insensitively in the current locale; false otherwise.
+
+=cut
+*/
+
+PERL_STATIC_INLINE I32
+Perl_foldEQ_locale(const char *s1, const char *s2, I32 len)
+{
+ dVAR;
+ const U8 *a = (const U8 *)s1;
+ const U8 *b = (const U8 *)s2;
+
+ PERL_ARGS_ASSERT_FOLDEQ_LOCALE;
+
+ assert(len >= 0);
+
+ while (len--) {
+ if (*a != *b && *a != PL_fold_locale[*b])
+ return 0;
+ a++,b++;
+ }
+ return 1;
+}
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff