In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/1d2af5744d75143cf7ee8bfd33d4366a95dd1b95?hp=27169d3827c027798ac2b8fbce9fe92773829bd4>
- Log -----------------------------------------------------------------
commit 1d2af5744d75143cf7ee8bfd33d4366a95dd1b95
Author: Karl Williamson <k...@cpan.org>
Date: Sat Jan 13 15:40:34 2018 -0700
Avoid some branches
This replaces some looping with branchless code in two places: looking
for the first UTF-8 variant byte in a string (which is used under
several circumstances), and looking for an ASCII or non-ASCII character
during pattern matching.
Recent commits have changed these operations to do word-at-a-time look-
ups, essentially vectorizing the problem into 4 or 8 parallel probes.
But when the word is found which contains the desired byte, until this
commit, that word would be scanned byte-at-a-time in a loop.
I found some bit hacks on the internet, which when stitched togther, can
find the first desired byte in the word without branching, while doing
this while the word is still loaded, without having to load each byte.
commit 5d0379de16ad15d28efd4497c918e0ed272eb8c3
Author: Karl Williamson <k...@cpan.org>
Date: Mon Jan 15 15:15:14 2018 -0700
inline.h: Add comment.
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 3 ++
embed.h | 3 ++
ext/XS-APItest/APItest.pm | 2 +-
inline.h | 108 +++++++++++++++++++++++++++++++++++++++++++++-
proto.h | 7 +++
regexec.c | 16 ++++++-
6 files changed, 136 insertions(+), 3 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index beb52e8b66..cd654dd1e7 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -806,6 +806,9 @@ AndmoR |bool |is_utf8_invariant_string|NN const U8*
const s \
AnidR |bool |is_utf8_invariant_string_loc|NN const U8* const s \
|STRLEN len \
|NULLOK const U8 ** ep
+#ifndef EBCDIC
+AniR |unsigned int|_variant_byte_number|PERL_UINTMAX_T word
+#endif
#if defined(PERL_CORE) || defined(PERL_EXT)
EinR |Size_t |variant_under_utf8_count|NN const U8* const s \
|NN const U8* const e
diff --git a/embed.h b/embed.h
index 33c7d493f0..c968191616 100644
--- a/embed.h
+++ b/embed.h
@@ -774,6 +774,9 @@
#if !(defined(HAS_SIGACTION) && defined(SA_SIGINFO))
#define csighandler Perl_csighandler
#endif
+#if !defined(EBCDIC)
+#define _variant_byte_number S__variant_byte_number
+#endif
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
#define my_chsize(a,b) Perl_my_chsize(aTHX_ a,b)
#endif
diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 64022244d5..e30838ae3b 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Carp;
-our $VERSION = '0.94';
+our $VERSION = '0.95';
require XSLoader;
diff --git a/inline.h b/inline.h
index 1abee4f22f..29ddd2c544 100644
--- a/inline.h
+++ b/inline.h
@@ -438,10 +438,23 @@ S_is_utf8_invariant_string_loc(const U8* const s, STRLEN
len, const U8 ** ep)
return FALSE;
}
- /* Otherwise fall into final loop to find which byte it is */
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 \
+ || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+
+ *ep = x + _variant_byte_number(* (PERL_UINTMAX_T *) x);
+ assert(*ep >= s && *ep < send);
+
+ return FALSE;
+
+#else /* If weird byte order, drop into next loop to do byte-at-a-time
+ checks. */
+
break;
+#endif
}
+
x += PERL_WORDSIZE;
+
} while (x + PERL_WORDSIZE <= send);
}
@@ -463,6 +476,97 @@ S_is_utf8_invariant_string_loc(const U8* const s, STRLEN
len, const U8 ** ep)
return TRUE;
}
+#ifndef EBCDIC
+
+PERL_STATIC_INLINE unsigned int
+S__variant_byte_number(PERL_UINTMAX_T word)
+{
+
+ /* This returns the position in a word (0..7) of the first variant byte in
+ * it. This is a helper function. Note that there are no branches */
+
+ assert(word);
+
+ /* Get just the msb bits of each byte */
+ word &= PERL_VARIANTS_WORD_MASK;
+
+# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+
+ /* Bytes are stored like
+ * Byte8 ... Byte2 Byte1
+ * 63..56...15...8 7...0
+ *
+ * Isolate the lsb;
+ *
https://stackoverflow.com/questions/757059/position-of-least-significant-bit-that-is-set
+ *
+ * The word will look this this, with a rightmost set bit in position 's':
+ * ('x's are don't cares)
+ * s
+ * x..x100..0
+ * x..xx10..0 Right shift (rightmost 0 is shifted off)
+ * x..xx01..1 Subtract 1, turns all the trailing zeros into 1's and
+ * the 1 just to their left into a 0; the remainder is
+ * untouched
+ * 0..0011..1 The xor with x..xx10..0 clears that remainder, sets
+ * bottom to all 1
+ * 0..0100..0 Add 1 to clear the word except for the bit in 's'
+ *
+ * Another method is to do 'word &= -word'; but it generates a compiler
+ * message on some platforms about taking the negative of an unsigned */
+
+ word >>= 1;
+ word = 1 + (word ^ (word - 1));
+
+# elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+
+ /* Bytes are stored like
+ * Byte1 Byte2 ... Byte8
+ * 63..56 55..47 ... 7...0
+ *
+ * Isolate the msb; http://codeforces.com/blog/entry/10330
+ *
+ * Only the most significant set bit matters. Or'ing word with its right
+ * shift of 1 makes that bit and the next one to its right both 1. Then
+ * right shifting by 2 makes for 4 1-bits in a row. ... We end with the
+ * msb and all to the right being 1. */
+ word |= word >> 1;
+ word |= word >> 2;
+ word |= word >> 4;
+ word |= word >> 8;
+ word |= word >> 16;
+ word |= word >> 32; /* This should get optimized out on 32-bit systems. */
+
+ /* Then subtracting the right shift by 1 clears all but the left-most of
+ * the 1 bits, which is our desired result */
+ word -= (word >> 1);
+
+# else
+# error Unexpected byte order
+# endif
+
+ /* Here 'word' has a single bit set, the msb is of the first byte which
+ * has it set. Calculate that position in the word. We can use this
+ * specialized solution: https://stackoverflow.com/a/32339674/1626653,
+ * assumes an 8-bit byte */
+ word = (word >> 7) * (( 7ULL << 56) | (15ULL << 48) | (23ULL << 40)
+ | (31ULL << 32) | (39ULL << 24) | (47ULL << 16)
+ | (55ULL << 8) | (63ULL << 0));
+ word >>= PERL_WORDSIZE * 7; /* >> by either 56 or 24 */
+
+ /* Here, word contains the position 7..63 of that bit. Convert to 0..7 */
+ word = ((word + 1) >> 3) - 1;
+
+# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+
+ /* And invert the result */
+ word = CHARBITS - word - 1;
+
+# endif
+
+ return (unsigned int) word;
+}
+
+#endif /* ! EBCDIC */
#if defined(PERL_CORE) || defined(PERL_EXT)
/*
@@ -502,6 +606,8 @@ S_variant_under_utf8_count(const U8* const s, const U8*
const e)
# ifndef EBCDIC
+ /* Test if the string is long enough to use word-at-a-time. (Logic is the
+ * same as for is_utf8_invariant_string()) */
if ((STRLEN) (e - x) >= PERL_WORDSIZE
+ PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(x)
- (PTR2nat(x) & PERL_WORD_BOUNDARY_MASK))
diff --git a/proto.h b/proto.h
index f1bdcec150..8e0c669db7 100644
--- a/proto.h
+++ b/proto.h
@@ -3857,6 +3857,13 @@ PERL_CALLCONV_NO_RET int Perl_magic_regdatum_set(pTHX_
SV* sv, MAGIC* mg)
#define PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET \
assert(sv); assert(mg)
+#endif
+#if !defined(EBCDIC)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE unsigned int S__variant_byte_number(PERL_UINTMAX_T
word)
+ __attribute__warn_unused_result__;
+#endif
+
#endif
#if !defined(HAS_GETENV_LEN)
PERL_CALLCONV char* Perl_getenv_len(pTHX_ const char *env_elem, unsigned
long *len);
diff --git a/regexec.c b/regexec.c
index 6bad0a3a94..9ee7e6bab5 100644
--- a/regexec.c
+++ b/regexec.c
@@ -584,10 +584,24 @@ S_find_next_ascii(char * s, const char * send, const bool
utf8_target)
/* Here, we know we have at least one full word to process. Process
* per-word as long as we have at least a full word left */
do {
- if ( ~ (* (PERL_UINTMAX_T *) s) & PERL_VARIANTS_WORD_MASK) {
+ PERL_UINTMAX_T complemented = ~ * (PERL_UINTMAX_T *) s;
+ if (complemented & PERL_VARIANTS_WORD_MASK) {
+
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 \
+ || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+
+ s += _variant_byte_number(complemented);
+ return s;
+
+#else /* If weird byte order, drop into next loop to do byte-at-a-time
+ checks. */
+
break;
+#endif
}
+
s += PERL_WORDSIZE;
+
} while (s + PERL_WORDSIZE <= send);
}
--
Perl5 Master Repository
