adds arbitrary-precision loopless clz and popcount in Primus Lisp (#1464

)

plugins/arm/semantics/arm.lisp

@@ -6,4 +6,4 @@
 
 (defun CLZ (rd rn pre _)
   (when (condition-holds pre)
-    (set$ rd (clz32 rn))))
+    (set$ rd (clz rn))))

plugins/primus_lisp/semantics/bits.lisp

@@ -26,35 +26,85 @@
   (logor (logand (msb rn) (msb rm) (lnot (msb rd)))
          (logand (lnot (msb rn)) (lnot (msb rm)) (msb rd))))
 
-(defmacro popcount/helper (x sh m1 m2 m4 h01)
-  (prog
-     (set x (- x (logand (rshift x 1) m1)))
-     (set x (+ (logand x m2) (logand (rshift x 2) m2)))
-     (set x (logand (+ x (rshift x 4)) m4))
-     (rshift (* x h01) sh)))
-
-(defmacro popcount16 (x)
+(defun clz (x)
+  "(clz X) counts leading zeros in X.
+   The returned value is the number of consecutive zeros starting
+   from the most significant bit. Returns 0 for 0 and works for
+   inputs of any size, including inputs that are not statically
+   known. In the latter case, the computation is unfolded into
+   the loopless code with the size proportional to the size of word
+   divided by 64."
+  (case (word-width x)
+    8  (clz8  x)
+    16 (clz16 x)
+    32 (clz32 x)
+    64 (clz64 x)
+    (if (> (word-width x) 64)
+        (clz/rec x)
+      (clz/small x))))
+
+(defun popcount (x)
+  "(popcount X) computes the total number of 1 bits in X."
+  (if (> (word-width x) 64)
+      (+ (popcount64 (cast-high 64 x))
+         (popcount (cast-low (- (word-width x) 64) x)))
+    (if (= (word-width x) 64)
+        (popcount64 x)
+      (popcount64 (cast-unsigned 64 x)))))
+
+;; private helpers
+
+(defun popcount/helper (x sh m1 m2 m4 h01)
+  (declare (visibility :private))
+  (let ((x x))
+    (set x (- x (logand (rshift x 1) m1)))
+    (set x (+ (logand x m2) (logand (rshift x 2) m2)))
+    (set x (logand (+ x (rshift x 4)) m4))
+    (rshift (* x h01) sh)))
+
+(defun popcount8 (x)
+  (declare (visibility :private))
+  (popcount/helper x 0
+                   0x55:8
+                   0x33:8
+                   0x0f:8
+                   0x01:8))
+
+(defun popcount16 (x)
+  (declare (visibility :private))
   (popcount/helper x 8
-                   0x5555
-                   0x3333
-                   0x0f0f
-                   0x0101))
+                   0x5555:16
+                   0x3333:16
+                   0x0f0f:16
+                   0x0101:16))
 
-(defmacro popcount32 (x)
+(defun popcount32 (x)
+  (declare (visibility :private))
   (popcount/helper x 24
-                   0x55555555
-                   0x33333333
-                   0x0f0f0f0f
-                   0x01010101))
+                   0x55555555:32
+                   0x33333333:32
+                   0x0f0f0f0f:32
+                   0x01010101:32))
 
-(defmacro popcount64 (x)
+(defun popcount64 (x)
+  (declare (visibility :private))
   (popcount/helper x 56
-                   0x5555555555555555
-                   0x3333333333333333
-                   0x0f0f0f0f0f0f0f0f
-                   0x0101010101010101))
+                   0x5555555555555555:64
+                   0x3333333333333333:64
+                   0x0f0f0f0f0f0f0f0f:64
+                   0x0101010101010101:64))
+
+(defun clz8 (r)
+  (declare (visibility :private))
+  (let ((x r))
+    (set x (logor x (rshift x 1)))
+    (set x (logor x (rshift x 2)))
+    (set x (logor x (rshift x 4)))
+    (set x (lnot x))
+    (popcount8 x)))
 
 (defun clz16 (r)
+  (declare (visibility :private))
   (let ((x r))
     (set x (logor x (rshift x 1)))
     (set x (logor x (rshift x 2)))
@@ -64,6 +114,7 @@
     (popcount16 x)))
 
 (defun clz32 (x)
+  (declare (visibility :private))
   (let ((x x))
     (set x (logor x (rshift x 1)))
     (set x (logor x (rshift x 2)))
@@ -74,6 +125,7 @@
     (popcount32 x)))
 
 (defun clz64 (x)
+  (declare (visibility :private))
   (let ((x x))
     (set x (logor x (rshift x 1)))
     (set x (logor x (rshift x 2)))
@@ -83,3 +135,20 @@
     (set x (logor x (rshift x 32)))
     (set x (lnot x))
     (popcount64 x)))
+
+(defun clz/rec (x)
+  (declare (visibility :private))
+  (if (> (word-width x) 64)
+        (if (is-zero (cast-high 64 x))
+            (+ 64 (clz (cast-low (- (word-width x) 64) x)))
+          (clz64 (cast-high 64 x)))
+    (clz x)))
+
+(defun clz/small (x)
+  (declare (visibility :private))
+  (let ((w (word-width x)))
+    (if       (< w 8)  (- (clz8  (cast-unsigned 8 x))  (- 8 w))
+      (if     (< w 16) (- (clz16 (cast-unsigned 16 x)) (- 16 w))
+        (if   (< w 32) (- (clz32 (cast-unsigned 32 x)) (- 32 w))
+          (if (< w 64) (- (clz64 (cast-unsigned 64 x)) (- 64 w))
+            (clz x)))))))