bug#22689: [PATCH] Add logcount

[Mark Oteiza <mvoteiza@udel.edu>]

On 30/09/17 at 07:17pm, Eli Zaretskii wrote:
> > Date: Sat, 30 Sep 2017 12:03:31 -0400
> > From: Mark Oteiza <mvoteiza@udel.edu>
> > Cc: 22689@debbugs.gnu.org
> > 
> > > > I tried implementing your comments (and added a test).  I don't know
> > > > what to do in the #else for ULONG_LONG_MAX.
> > > 
> > > Same as you do for ULONG_MAX, I think.
> > 
> > so the following?
> > 
> >   else if (v <= ULONG_MAX || v <= ULONG_LONG_MAX)
> >       XSETINT (res, logcount64 (v));
> 
> Yes.

Ok.  Patch including this, Benjamin's catch, and documentation.


 doc/lispref/numbers.texi | 10 ++++++++
 etc/NEWS                 |  3 +++
 src/data.c               | 61 ++++++++++++++++++++++++++++++++++++++++++++++++
 test/src/data-tests.el   | 13 +++++++++++
 4 files changed, 87 insertions(+)

diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 3fdc94169b..29c6429eda 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1107,6 +1107,16 @@ Bitwise Operations
 @end example
 @end defun
 
+@defun logcount integer
+This function returns the population count of @var{integer}: the
+number of ones in the binary representation of @var{integer}.
+
+@example
+(logcount 42)     ; 42 = #b101010
+     @result{} 3
+@end example
+@end defun
+
 @node Math Functions
 @section Standard Mathematical Functions
 @cindex transcendental functions
diff --git a/etc/NEWS b/etc/NEWS
index 238c7b7ea4..8fbc354fc0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -31,6 +31,9 @@ When you add a new item, use the appropriate mark if you are sure it applies,
 \f
 * Changes in Emacs 27.1
 
++++
+** New function 'logcount' calculates an integer's Hamming weight.
+
 \f
 * Editing Changes in Emacs 27.1
 
diff --git a/src/data.c b/src/data.c
index e070be6c20..f470d6ffaa 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3069,6 +3069,66 @@ usage: (logxor &rest INTS-OR-MARKERS)  */)
   return arith_driver (Alogxor, nargs, args);
 }
 
+#if GNUC_PREREQ (4, 1, 0)
+#define HAVE_BUILTIN_POPCOUNTLL
+#endif
+
+#ifndef HAVE_BUILTIN_POPCOUNTLL
+static uint32_t
+logcount32 (uint32_t b)
+{
+  b -= (b >> 1) & 0x55555555;
+  b = (b & 0x33333333) + ((b >> 2) & 0x33333333);
+  b = (b + (b >> 4)) & 0x0f0f0f0f;
+  return (b * 0x01010101) >> 24;
+}  
+
+static uint64_t
+logcount64 (uint64_t b)
+{
+  b -= (b >> 1) & 0x5555555555555555ULL;
+  b = (b & 0x3333333333333333ULL) + ((b >> 2) & 0x3333333333333333ULL);
+  b = (b + (b >> 4)) & 0x0f0f0f0f0f0f0f0fULL;
+  return (b * 0x0101010101010101ULL) >> 56;
+}
+#endif /* HAVE_BUILTIN_POPCOUNTLL */
+
+DEFUN ("logcount", Flogcount, Slogcount, 1, 1, 0,
+       doc: /* Return population count of VALUE.
+If VALUE is negative, the count is of its two's complement representation.  */)
+  (register Lisp_Object value)
+{
+  Lisp_Object res;
+  EMACS_UINT v;
+
+  CHECK_NUMBER (value);
+
+  v = XUINT (value);
+#ifdef HAVE_BUILTIN_POPCOUNTLL
+  if (v <= UINT_MAX)
+    XSETINT (res, __builtin_popcount (v));
+  else if (v <= ULONG_MAX)
+    XSETINT (res, __builtin_popcountl (v));
+  else if (v <= ULONG_LONG_MAX)
+    XSETINT (res, __builtin_popcountll (v));
+#else  /* HAVE_BUILTIN_POPCOUNTLL */
+  if (v <= UINT_MAX)
+    XSETINT (res, logcount32 (v));
+  else if (v <= ULONG_MAX || v <= ULONG_LONG_MAX)
+    XSETINT (res, logcount64 (v));
+#endif /* HAVE_BUILTIN_POPCOUNTLL */
+  else
+    {
+      unsigned int count;
+      for (count = 0; v; count++)
+        {
+          v &= v - 1;
+        }
+      XSETINT (res, count);
+    }
+  return res;
+}
+
 static Lisp_Object
 ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
 {
@@ -3856,6 +3916,7 @@ syms_of_data (void)
   defsubr (&Slogand);
   defsubr (&Slogior);
   defsubr (&Slogxor);
+  defsubr (&Slogcount);
   defsubr (&Slsh);
   defsubr (&Sash);
   defsubr (&Sadd1);
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 8de8c145d4..d1154cc5c4 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -107,6 +107,19 @@
   (should (isnan (min 1.0 0.0e+NaN)))
   (should (isnan (min 1.0 0.0e+NaN 1.1))))
 
+(defun data-tests-popcnt (byte)
+  "Calculate the Hamming weight of BYTE."
+  (setq byte (- byte (logand (lsh byte -1) #x55555555)))
+  (setq byte (+ (logand byte #x33333333) (logand (lsh byte -2) #x33333333)))
+  (lsh (* (logand (+ byte (lsh byte -4)) #x0f0f0f0f) #x01010101) -24))
+
+(ert-deftest data-tests-logcount ()
+  (should (cl-loop for n in (number-sequence 0 255)
+                   always (= (logcount n) (data-tests-popcnt n))))
+  ;; https://oeis.org/A000120
+  (should (= 11 (logcount 9727)))
+  (should (= 8 (logcount 9999))))
+
 ;; Bool vector tests.  Compactly represent bool vectors as hex
 ;; strings.