Skip to content

Commit

Permalink
Add 64bit single-1bit_pos()
Browse files Browse the repository at this point in the history
This will prove useful in future commits on platforms that have 64 bit
capability.

The deBruijn sequence used here, taken from the internet, differs
from the 32 bit one 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.
  • Loading branch information
khwilliamson committed Jul 30, 2021
1 parent bf87418 commit 995a495
Show file tree
Hide file tree
Showing 6 changed files with 50 additions and 3 deletions.
3 changes: 3 additions & 0 deletions embed.fnc
Expand Up @@ -1142,6 +1142,9 @@ ATidRp |bool |is_utf8_invariant_string_loc|NN const U8* const s \
|STRLEN len \
|NULLOK const U8 ** ep
CTiRp |unsigned|single_1bit_pos32|U32 word
#ifdef U64TYPE /* HAS_QUAD undefined outside of core */
CTiRp |unsigned|single_1bit_pos64|U64 word
#endif
#ifndef EBCDIC
CTiRp |unsigned int|variant_byte_number|PERL_UINTMAX_T word
#endif
Expand Down
3 changes: 3 additions & 0 deletions embed.h
Expand Up @@ -870,6 +870,9 @@
#if defined(PERL_USE_3ARG_SIGHANDLER)
#define csighandler Perl_csighandler
#endif
#if defined(U64TYPE) /* HAS_QUAD undefined outside of core */
#define single_1bit_pos64 Perl_single_1bit_pos64
#endif
#if defined(UNLINK_ALL_VERSIONS)
#define unlnk(a) Perl_unlnk(aTHX_ a)
#endif
Expand Down
1 change: 1 addition & 0 deletions globvar.sym
Expand Up @@ -13,6 +13,7 @@ PL_charclass
PL_check
PL_core_reg_engine
PL_deBruijn_bitpos_tab32
PL_deBruijn_bitpos_tab64
PL_EXACTFish_bitmask
PL_EXACT_REQ8_bitmask
PL_extended_utf8_dfa_tab
Expand Down
26 changes: 23 additions & 3 deletions inline.h
Expand Up @@ -664,6 +664,29 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep)
return TRUE;
}

#ifdef U64TYPE /* HAS_QUAD not usable outside the core */

PERL_STATIC_INLINE unsigned
Perl_single_1bit_pos64(U64 word)
{
/* Given a 64-bit 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));
# else
ASSUME(word && (word & (word-1)) == 0);
# 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_tab64[(word * PERL_deBruijnMagic64_)
>> PERL_deBruijnShift64_];
}

#endif

PERL_STATIC_INLINE unsigned
Perl_single_1bit_pos32(U32 word)
{
Expand All @@ -676,9 +699,6 @@ Perl_single_1bit_pos32(U32 word)
ASSUME(word && (word & (word-1)) == 0);
#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_tab32[(word * PERL_deBruijnMagic32_)
>> PERL_deBruijnShift32_];
}
Expand Down
12 changes: 12 additions & 0 deletions perl.h
Expand Up @@ -5849,6 +5849,15 @@ PL_deBruijn_bitpos_tab32[] = {
31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
};

EXTCONST U8
PL_deBruijn_bitpos_tab64[] = {
/* 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
};

#else

EXTCONST bool PL_valid_types_IVX[];
Expand All @@ -5858,12 +5867,15 @@ 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_tab32[];
EXTCONST U8 PL_deBruijn_bitpos_tab64[];

#endif

/* The constants for using PL_deBruijn_bitpos_tab */
#define PERL_deBruijnMagic32_ 0x077CB531
#define PERL_deBruijnShift32_ 27
#define PERL_deBruijnMagic64_ 0x07EDD5E59A4E28C2
#define PERL_deBruijnShift64_ 58

/* In C99 we could use designated (named field) union initializers.
* In C89 we need to initialize the member declared first.
Expand Down
8 changes: 8 additions & 0 deletions proto.h
Expand Up @@ -6709,6 +6709,14 @@ PERL_CALLCONV Signal_t Perl_csighandler(int sig, Siginfo_t *info, void *uap);
#define PERL_ARGS_ASSERT_CSIGHANDLER
PERL_CALLCONV Signal_t Perl_sighandler(int sig, Siginfo_t *info, void *uap);
#define PERL_ARGS_ASSERT_SIGHANDLER
#endif
#if defined(U64TYPE) /* HAS_QUAD undefined outside of core */
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE unsigned Perl_single_1bit_pos64(U64 word)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_SINGLE_1BIT_POS64
#endif

#endif
#if defined(UNLINK_ALL_VERSIONS)
PERL_CALLCONV I32 Perl_unlnk(pTHX_ const char* f);
Expand Down

0 comments on commit 995a495

Please sign in to comment.