Subject: bug#22689: [PATCH] Add logcount

From: Paul Eggert <[email-masked]>
Date: Sat, 30 Sep 2017 15:48:50 -0700

I looked at this patch after it landed in 'master'. Thanks for contributing it.

A couple of minor improvements. First, the implementation of logcount can use 
the count_one_bits functions already used by Emacs, rather than reinventing that 
wheel; these functions should be just as fast as __builtin_popcount etc. when 
using GCC. Second, logcount should count zero bits in negative numbers, for 
compatibility with Common Lisp. I installed the attached two patches to 
implement these improvements.
From 6fe5f5db496f5962e1504991bf77e2b7d23a681f Mon Sep 17 00:00:00 2001
From: Paul Eggert <[email-masked]>
Date: Sat, 30 Sep 2017 13:12:33 -0700
Subject: [PATCH 1/2] Simplify logcount implementation

* src/data.c (HAVE_BUILTIN_POPCOUNTLL, logcount32, logcount64):
Remove.
(Flogcount): Simplify by using count_one_bits.
---
 src/data.c | 60 +++++++-----------------------------------------------------
 1 file changed, 7 insertions(+), 53 deletions(-)

diff --git a/src/data.c b/src/data.c
index b595e3fb1a..fd8cdd19aa 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3069,64 +3069,18 @@ 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 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;
+  EMACS_UINT v = XUINT (value);
+  return make_number (EMACS_UINT_WIDTH <= UINT_WIDTH
+		      ? count_one_bits (v)
+		      : EMACS_UINT_WIDTH <= ULONG_WIDTH
+		      ? count_one_bits_l (v)
+		      : count_one_bits_ll (v));
 }
 
 static Lisp_Object
-- 
2.13.5

From 3b6d6b03383ac413fd0f25c4ae4fed1c780a3c29 Mon Sep 17 00:00:00 2001
From: Paul Eggert <[email-masked]>
Date: Sat, 30 Sep 2017 15:36:52 -0700
Subject: [PATCH 2/2] Make logcount act like CL on negative arg

Behaving like Common Lisp is less likely to lead to surprises,
as it yields the same answers on 32- vs 64-bit machines.
* doc/lispref/numbers.texi (Bitwise Operations):
Document behavior on negative integers.
* src/data.c (Flogcount):
Behave like Common Lisp for negative arguments.
* test/src/data-tests.el (data-tests-popcnt)
(data-tests-logcount): Test negative args too.
---
 doc/lispref/numbers.texi | 7 ++++++-
 src/data.c               | 6 ++++--
 test/src/data-tests.el   | 4 +++-
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 5058063af4..be74b0c611 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1113,9 +1113,14 @@ Bitwise Operations
 @defun logcount integer
 This function returns the @dfn{Hamming weight} of @var{integer}: the
 number of ones in the binary representation of @var{integer}.
+If @var{integer} is negative, it returns the number of zero bits in
+its two's complement binary representation.  The result is always
+nonnegative.
 
 @example
-(logcount 42)     ; 42 = #b101010
+(logcount 43)     ; 43 = #b101011
+     @result{} 4
+(logcount -43)    ; -43 = #b111...1010101
      @result{} 3
 @end example
 @end defun
diff --git a/src/data.c b/src/data.c
index fd8cdd19aa..2e7f3e017b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3071,11 +3071,13 @@ usage: (logxor &rest INTS-OR-MARKERS)  */)
 
 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.  */)
+This is the number of one bits in the two's complement representation
+of VALUE.  If VALUE is negative, return the number of zero bits in the
+representation.  */)
   (Lisp_Object value)
 {
   CHECK_NUMBER (value);
-  EMACS_UINT v = XUINT (value);
+  EMACS_INT v = XINT (value) < 0 ? -1 - XINT (value) : XINT (value);
   return make_number (EMACS_UINT_WIDTH <= UINT_WIDTH
 		      ? count_one_bits (v)
 		      : EMACS_UINT_WIDTH <= ULONG_WIDTH
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index d1154cc5c4..374d1689b9 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -109,12 +109,14 @@
 
 (defun data-tests-popcnt (byte)
   "Calculate the Hamming weight of BYTE."
+  (if (< byte 0)
+      (setq byte (lognot 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)
+  (should (cl-loop for n in (number-sequence -255 255)
                    always (= (logcount n) (data-tests-popcnt n))))
   ;; https://oeis.org/A000120
   (should (= 11 (logcount 9727)))
-- 
2.13.5