define Spopcount in scheme.h and use intrinsics when possible (#1037)

Author: burgerrg

boot/pb/scheme.h

@@ -140,6 +140,22 @@ typedef unsigned char octet;
 #define Sstring_length(x) ((iptr)((uptr)(*((iptr *)TO_VOIDP((uptr)(x)+1)))>>4))
 #define Sstring_ref(x,i) Schar_value(((string_char *)TO_VOIDP((uptr)(x)+9))[i])
 #define Sunbox(x) (*((ptr *)TO_VOIDP((uptr)(x)+9)))
+static inline int Spopcount(uptr x) {
+#if defined(__clang__) || defined(__GNUC__)
+  return __builtin_popcountll(x);
+#else
+  /* count bits of each 2-bit chunk */
+  x = x - ((x >> 1) & 0x5555555555555555ULL);
+  /* count bits of each 4-bit chunk */
+  x = (x & 0x3333333333333333ULL) + ((x >> 2) & 0x3333333333333333ULL);
+  /* count bits of each 8-bit chunk */
+  x = x + (x >> 4);
+  /* mask out junk */
+  x &= 0x0F0F0F0F0F0F0F0FULL;
+  /* add all 8-bit chunks */
+  return (x * 0x0101010101010101ULL) >> 56;
+#endif
+}
 #define Sstencil_vector_length(x) Spopcount(((uptr)(*((iptr *)TO_VOIDP((uptr)(x)+1))))>>6)
 #define Sstencil_vector_ref(x,i) (((ptr *)TO_VOIDP((uptr)(x)+9))[i])
 EXPORT iptr Sinteger_value(ptr);

c/alloc.c

@@ -15,7 +15,6 @@
  */
 
 #include "system.h"
-#include "popcount.h"
 
 /* locally defined functions */
 static void maybe_queue_fire_collector(thread_gc *tgc);

c/build.zuo

@@ -119,7 +119,7 @@
      (map at-source
           (list "system.h" "types.h" "version.h" "globals.h" "externs.h" "segment.h"
                 "atomic.h" "thread.h" "sort.h" "compress-io.h"
-                "nocurses.h" "popcount.h"))
+                "nocurses.h"))
      (list c-config-file)
      (map at-mach
           (list "equates.h"

c/fasl.c

@@ -195,7 +195,6 @@
 
 #include "system.h"
 #include "zlib.h"
-#include "popcount.h"
 
 #ifdef WIN32
 #include <io.h>

c/gc.c

@@ -18,7 +18,6 @@
 #ifndef WIN32
 #include <sys/wait.h>
 #endif /* WIN32 */
-#include "popcount.h"
 #include <assert.h>
 
 /* 

c/gcwrapper.c

@@ -15,7 +15,6 @@
  */
 
 #include "system.h"
-#include "popcount.h"
 
 /* locally defined functions */
 static void segment_tell(uptr seg);

c/popcount.h

@@ -2991,6 +2991,12 @@ in fasl files does not generally make sense.
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
+
+\subsection{Declare \scheme{Spopcount} in scheme.h (10.4.0)}
+
+A bug where the header file scheme.h refers to an undeclared \scheme{Spopcount} function
+has been fixed.
+
 \subsection{Eager port closing on error in \scheme{open-source-file} (10.4.0)}
 
 When \scheme{open-source-file} fails on a non-seekable device, the file descriptor port

release_notes/release_notes.stex

@@ -339,7 +339,30 @@
           (format "Schar_value~a" (access "x" "i" string data)))
 
         (defref Sunbox box ref)
-  
+
+        (let-values
+            ([(suffix fives threes junk-mask ones shift)
+              (constant-case ptr-bits
+                [(32) (values "l" "0x55555555" "0x33333333" "0xF0F0F0F" "0x01010101" 24)]
+                [(64) (values "ll" "0x5555555555555555ULL" "0x3333333333333333ULL"
+                        "0x0F0F0F0F0F0F0F0FULL" "0x0101010101010101ULL" 56)])])
+          (pr "static inline int Spopcount(uptr x) {\n")
+          (pr "#if defined(__clang__) || defined(__GNUC__)\n")
+          (pr "  return __builtin_popcount~a(x);\n" suffix)
+          (pr "#else\n")
+          (pr "  /* count bits of each 2-bit chunk */\n")
+          (pr "  x = x - ((x >> 1) & ~a);\n" fives)
+          (pr "  /* count bits of each 4-bit chunk */\n")
+          (pr "  x = (x & ~a) + ((x >> 2) & ~a);\n" threes threes)
+          (pr "  /* count bits of each 8-bit chunk */\n")
+          (pr "  x = x + (x >> 4);\n")
+          (pr "  /* mask out junk */\n")
+          (pr "  x &= ~a;\n" junk-mask)
+          (pr "  /* add all 8-bit chunks */\n")
+          (pr "  return (x * ~a) >> ~d;\n" ones shift)
+          (pr "#endif\n")
+          (pr "}\n"))
+
         (def "Sstencil_vector_length(x)"
           (format "Spopcount(((uptr)~a)>>~d)"
             (access "x" stencil-vector type)