From 1d855962b454ad597f3a0766d4b7fc515e634dbc Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Jun 2021 10:22:42 -0600 Subject: [PATCH] Create single_1bit_pos() Given a word known to have exactly a single bit set, this function uses deBruijn sequences to quickly calculate its position. I took the 32 and 64 bit word versions from the internet. They differ in how they treat a word with no set bits. But this is considered undefined behavior, so that difference is immaterial. Apparently figuring this out uses brute force methods, and so I decided to live with this difference, rather than to expend the time needed to bring them into sync. --- embed.fnc | 1 + embed.h | 1 + globvar.sym | 1 + inline.h | 17 +++++++++++++++++ perl.h | 30 ++++++++++++++++++++++++++++++ proto.h | 6 ++++++ 6 files changed, 56 insertions(+) diff --git a/embed.fnc b/embed.fnc index 93801ec41f7b..ecf5cc1ae812 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1139,6 +1139,7 @@ ATdmoR |bool |is_utf8_invariant_string|NN const U8* const s \ ATidRp |bool |is_utf8_invariant_string_loc|NN const U8* const s \ |STRLEN len \ |NULLOK const U8 ** ep +CTiRp |unsigned|single_1bit_pos|PERL_UINTMAX_T word #ifndef EBCDIC CTiRp |unsigned int|variant_byte_number|PERL_UINTMAX_T word #endif diff --git a/embed.h b/embed.h index bbd8fd207ed2..3597987b418c 100644 --- a/embed.h +++ b/embed.h @@ -559,6 +559,7 @@ #define set_context Perl_set_context #define setdefout(a) Perl_setdefout(aTHX_ a) #define share_hek(a,b,c) Perl_share_hek(aTHX_ a,b,c) +#define single_1bit_pos Perl_single_1bit_pos #define sortsv(a,b,c) Perl_sortsv(aTHX_ a,b,c) #define sortsv_flags(a,b,c,d) Perl_sortsv_flags(aTHX_ a,b,c,d) #define stack_grow(a,b,c) Perl_stack_grow(aTHX_ a,b,c) diff --git a/globvar.sym b/globvar.sym index 03c324868ba4..06c41b491e84 100644 --- a/globvar.sym +++ b/globvar.sym @@ -12,6 +12,7 @@ PL_c9_utf8_dfa_tab PL_charclass PL_check PL_core_reg_engine +PL_deBruijn_bitpos_tab PL_EXACTFish_bitmask PL_EXACT_REQ8_bitmask PL_extended_utf8_dfa_tab diff --git a/inline.h b/inline.h index c59c7c5de266..a965aaa89f21 100644 --- a/inline.h +++ b/inline.h @@ -581,6 +581,23 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep) return TRUE; } +PERL_STATIC_INLINE unsigned +Perl_single_1bit_pos(PERL_UINTMAX_T word) +{ + /* Given a word known to contain all zero bits except one 1 bit, find and + * return the 1's position: 0..63 */ + +#ifdef PERL_CORE /* macro not exported */ + ASSUME(isPOWER_OF_2(word)); +#endif + + /* The position of the only set bit in a word can be quickly calculated + * using deBruijn sequences. See for example + * https://en.wikipedia.org/wiki/De_Bruijn_sequence */ + return PL_deBruijn_bitpos_tab[(word * PERL_deBruijnMagic_) + >> PERL_deBruijnShift_]; +} + #ifndef EBCDIC PERL_STATIC_INLINE unsigned int diff --git a/perl.h b/perl.h index 5e01a4ed327e..56c5f5cbceb0 100644 --- a/perl.h +++ b/perl.h @@ -5832,6 +5832,26 @@ PL_valid_types_IV_set[] = { 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1 }; EXTCONST bool PL_valid_types_NV_set[] = { 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 }; +EXTCONST U8 +PL_deBruijn_bitpos_tab[] = { + +# if PERL_UINTMAX_SIZE == 4 + /* https://graphics.stanford.edu/~seander/bithacks.html#IntegerLogDeBruijn */ + 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, + 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 + +# else + + /* https://stackoverflow.com/questions/11376288/fast-computing-of-log2-for-64-bit-integers */ + 63, 0, 58, 1, 59, 47, 53, 2, 60, 39, 48, 27, 54, 33, 42, 3, + 61, 51, 37, 40, 49, 18, 28, 20, 55, 30, 34, 11, 43, 14, 22, 4, + 62, 57, 46, 52, 38, 26, 32, 41, 50, 36, 17, 19, 29, 10, 13, 21, + 56, 45, 25, 31, 35, 16, 9, 12, 44, 24, 15, 8, 23, 7, 6, 5 + +# endif + +}; + #else EXTCONST bool PL_valid_types_IVX[]; @@ -5840,9 +5860,19 @@ EXTCONST bool PL_valid_types_PVX[]; EXTCONST bool PL_valid_types_RV[]; EXTCONST bool PL_valid_types_IV_set[]; EXTCONST bool PL_valid_types_NV_set[]; +EXTCONST U8 PL_deBruijn_bitpos_tab[]; #endif +/* The constants for using PL_deBruijn_bitpos_tab */ +#if PERL_UINTMAX_SIZE == 4 +# define PERL_deBruijnMagic_ 0x077CB531 +# define PERL_deBruijnShift_ 27 +#else +# define PERL_deBruijnMagic_ 0x07EDD5E59A4E28C2 +# define PERL_deBruijnShift_ 58 +#endif + /* In C99 we could use designated (named field) union initializers. * In C89 we need to initialize the member declared first. * In C++ we need extern C initializers. diff --git a/proto.h b/proto.h index 455e3ce34b0e..6aff6d41caa3 100644 --- a/proto.h +++ b/proto.h @@ -3234,6 +3234,12 @@ PERL_CALLCONV Signal_t Perl_sighandler1(int sig); #define PERL_ARGS_ASSERT_SIGHANDLER1 PERL_CALLCONV Signal_t Perl_sighandler3(int sig, Siginfo_t *info, void *uap); #define PERL_ARGS_ASSERT_SIGHANDLER3 +#ifndef PERL_NO_INLINE_FUNCTIONS +PERL_STATIC_INLINE unsigned Perl_single_1bit_pos(PERL_UINTMAX_T word) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT_SINGLE_1BIT_POS +#endif + PERL_CALLCONV char* Perl_skipspace_flags(pTHX_ char *s, U32 flags) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_SKIPSPACE_FLAGS \