Create and use 32 and 64 bit lsbit_pos() fcns

The existing code to determine the position of the least significant 1 bit in a word is extracted from variant_byte_number() and moved to a new function in preparation for being called from other places. A U32 version is created, and on 64 bit platforms, a second, parallel, version taking a U64 argument is also created. This is because future commits may care about the word size differences.
Perl · Jul 30, 2021 · 19d2c52 · 19d2c52
1 parent 58ddb8c
commit 19d2c52
Show file tree

Hide file tree

Showing 4 changed files with 72 additions and 17 deletions.
diff --git a/embed.fnc b/embed.fnc
@@ -1142,8 +1142,10 @@ 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
+CTiRp	|unsigned|lsbit_pos32|U32 word
 #ifdef U64TYPE	/* HAS_QUAD undefined outside of core */
 CTiRp	|unsigned|single_1bit_pos64|U64 word
+CTiRp	|unsigned|lsbit_pos64|U64 word
 #endif
 #ifndef EBCDIC
 CTiRp	|unsigned int|variant_byte_number|PERL_UINTMAX_T word

diff --git a/embed.h b/embed.h
@@ -302,6 +302,7 @@
 #define load_module		Perl_load_module
 #endif
 #define looks_like_number(a)	Perl_looks_like_number(aTHX_ a)
+#define lsbit_pos32		Perl_lsbit_pos32
 #define magic_dump(a)		Perl_magic_dump(aTHX_ a)
 #define markstack_grow()	Perl_markstack_grow(aTHX)
 #ifndef MULTIPLICITY
@@ -871,6 +872,7 @@
 #define csighandler		Perl_csighandler
 #endif
 #if defined(U64TYPE)	/* HAS_QUAD undefined outside of core */
+#define lsbit_pos64		Perl_lsbit_pos64
 #define single_1bit_pos64	Perl_single_1bit_pos64
 #endif
 #if defined(UNLINK_ALL_VERSIONS)

diff --git a/inline.h b/inline.h
@@ -664,6 +664,55 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep)
     return TRUE;
 }
 
+/* Below are functions to find the final or only set bit in a word.  On
+ * platforms with 64-bit capability, there is a pair for each operation; the
+ * first taking a 64 bit operand, and the second a 32 bit one.  The logic is
+ * the same in each pair, so the second is stripped of most comments. */
+
+#ifdef U64TYPE  /* HAS_QUAD not usable outside the core */
+
+PERL_STATIC_INLINE unsigned
+Perl_lsbit_pos64(U64 word)
+{
+    /* Find the position (0..63) of the least significant set bit in the input
+     * word */
+
+    ASSUME(word != 0);
+
+    /*  Isolate the lsb;
+     * https://stackoverflow.com/questions/757059/position-of-least-significant-bit-that-is-set
+     *
+     * The word will look like this, with a rightmost set bit in position 's':
+     * ('x's are don't cares, and 'y's are their complements)
+     *      s
+     *  x..x100..00
+     *  y..y011..11      Complement
+     *  y..y100..00      Add 1
+     *  0..0100..00      And with the original
+     *
+     *  (Yes, complementing and adding 1 is just taking the negative on 2's
+     *  complement machines, but not on 1's complement ones, and some compilers
+     *  complain about negating an unsigned.)
+     */
+    return single_1bit_pos64(word & (~word + 1));
+}
+
+#  define lsbit_pos_uintmax_(word) lsbit_pos64(word)
+#else   /* ! QUAD */
+#  define lsbit_pos_uintmax_(word) lsbit_pos32(word)
+#endif
+
+PERL_STATIC_INLINE unsigned     /* Like above for 32 bit word */
+Perl_lsbit_pos32(U32 word)
+{
+    /* Find the position (0..31) of the least significant set bit in the input
+     * word */
+
+    ASSUME(word != 0);
+
+    return single_1bit_pos32(word & (~word + 1));
+}
+
 #ifdef U64TYPE  /* HAS_QUAD not usable outside the core */
 
 PERL_STATIC_INLINE unsigned
@@ -724,23 +773,13 @@ Perl_variant_byte_number(PERL_UINTMAX_T word)
     /* 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 like this, with a rightmost set bit in position 's':
-     * ('x's are don't cares, and 'y's are their complements)
-     *      s
-     *  x..x100..00
-     *  y..y011..11      Complement
-     *  y..y100..00      Add 1
-     *  0..0100..00      AND with the original
-     *
-     *  (Yes, complementing and adding 1 is just taking the negative on 2's
-     *  complement machines, but not on 1's complement ones, and some compilers
-     *  complain about negating an unsigned.)
-     */
-    word &= (~word + 1);
+     * so getting the lsb of the whole modified word is getting the msb of the
+     * first byte that has its msb set */
+    word = lsbit_pos_uintmax_(word);
+
+    /* Here, word contains the position 7,15,23,...55,63 of that bit.  Convert
+     * to 0..7 */
+    return (unsigned int) ((word + 1) >> 3) - 1;
 
 #  elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
 

diff --git a/proto.h b/proto.h
@@ -1861,6 +1861,12 @@ PERL_CALLCONV I32	Perl_looks_like_number(pTHX_ SV *const sv)
 #define PERL_ARGS_ASSERT_LOOKS_LIKE_NUMBER	\
 	assert(sv)
 
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE unsigned	Perl_lsbit_pos32(U32 word)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_LSBIT_POS32
+#endif
+
 PERL_CALLCONV int	Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_CLEAR_ALL_ENV	\
 	assert(sv); assert(mg)
@@ -6711,6 +6717,12 @@ 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_lsbit_pos64(U64 word)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_LSBIT_POS64
+#endif
+
 #ifndef PERL_NO_INLINE_FUNCTIONS
 PERL_STATIC_INLINE unsigned	Perl_single_1bit_pos64(U64 word)
 			__attribute__warn_unused_result__;