Add common integer bit string ffs, fls, ctz, and clz.

(ffs x): find first set, 1-indexed with 0 for 0
(fls x): find last set, 1-indexed with 0 for 0 (same as integer-length)
(ctz x): count trailing zeros (same as ffs)
((clz n) x): count leading zeros in n-bit word x

diff --git a/src/runtime/integer-bits.scm b/src/runtime/integer-bits.scm
index 22bf9c12a36f5da5f762af5a5ec48675eacb5674..5f9a598a0957c8c3ba66b69c61e6c9753bf0bcc3 100644 (file)
--- a/src/runtime/integer-bits.scm
+++ b/src/runtime/integer-bits.scm
@@ -216,3 +216,39 @@ USA.
 (define (shiftin x mask)
   ;; (bitwise-and ... mask)?
   (shift-left x (first-set-bit mask)))
+\f
+;;; Other standardish bit operations
+
+;;; Find First Set, 1-indexed; (ffs 0) = 0
+;;;
+;;; (Note some authors use 0-indexed ffs, and fail or return -1 for 0.)
+
+(define-integrable (ffs x)
+  (+ 1 (first-set-bit x)))
+
+;;; Find Last Set, 1-indexed; (fls 0) = 0
+;;;
+;;; For negative inputs, we find last clear, a.k.a. find last set of
+;;; complement.
+;;;
+;;; (Note some authors use 0-indexed fls, and fail or return -1 for 0.)
+
+(define-integrable (fls x)
+  (integer-length x))
+
+;;; Count Trailing Zeros; (ctz 0) = 0
+
+(define-integrable (ctz x)
+  (ffs x))
+
+;;; Count Leading Zeros in an n-bit word
+
+(declare (integrate clz))
+(define ((clz n) x)
+  ;; Round up to a power of two minus 1, at most 2^n; count the
+  ;; low-order one bits; subtract from n to get the zero bits
+  (assert (< x (shift-left 1 n)))
+  (let loop ((i 1) (x x))
+    (if (< i n)
+        (loop (* i 2) (bitwise-ior x (shift-right x i)))
+        (- n (bit-count x)))))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index aeb97efc01cd88fd7ce41ac3bf4208c072783702..36973f43ac2fa14cdf8b4ba612f4d734f9613e9d 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -374,10 +374,14 @@ USA.
          bitwise-merge
          bitwise-not
          clear-bit
+         clz
+         ctz
          edit-bit-field
          extract-bit
          extract-bit-field
+         ffs
          first-set-bit
+         fls
          hamming-distance
          integer-length
          replace-bit-field

diff --git a/tests/runtime/test-integer-bits.scm b/tests/runtime/test-integer-bits.scm
index 107b37a45e9ff8326f3d7b3c06e80937393e2528..de479c2e5b37ff54df6f79a71eeecce58f3b56ae 100644 (file)
--- a/tests/runtime/test-integer-bits.scm
+++ b/tests/runtime/test-integer-bits.scm
@@ -413,3 +413,52 @@ USA.
 
 (define-per-bit-test 'EXTRACT-BIT
   (lambda (n i) (assert-eqv (zero? (extract-bit i n)) (bit-clear? i n))))
+\f
+(define-test 'FFS:0 (lambda () (assert-= 0 (ffs 0))))
+(define-test 'FFS:1 (lambda () (assert-= 1 (ffs 1))))
+(define-test 'FFS:2 (lambda () (assert-= 2 (ffs 2))))
+(define-test 'FFS:3 (lambda () (assert-= 1 (ffs 3))))
+(define-test 'FFS:-1 (lambda () (assert-= 1 (ffs -1))))
+(define-test 'FFS:-2 (lambda () (assert-= 2 (ffs -2))))
+(define-test 'FFS:-3 (lambda () (assert-= 1 (ffs -3))))
+
+(define-per-bit-test 'FFS
+  (lambda (n i)
+    (assert-= (ffs n) (bit-count (bitwise-xor n (- n 1)))
+              'EXPRESSION `(FFS ,n))
+    (assert-= (ffs n) (+ 1 (first-set-bit n)) 'EXPRESSION `(FFS ,n))
+    (assert-= (ffs n) (+ 1 (first-set-bit n)) 'EXPRESSION `(FFS ,n))
+    (assert-= (ffs (- 0 n)) (ffs n) 'EXPRESSION `(FFS (- 0 ,n)))
+    ;; Clear the low i bits of n.
+    (let ((n (bitwise-andc2 n (bit-mask i 0))))
+      (assert-= (ffs n) (bit-count (bitwise-xor n (- n 1)))
+                'EXPRESSION `(FFS ,n))
+      (assert-= (ffs n) (+ 1 (first-set-bit n)) 'EXPRESSION `(FFS ,n))
+      (assert-= (ffs (- 0 n)) (ffs n) 'EXPRESSION `(FFS (- 0 ,n)))
+      (assert->= (ffs n) (+ i 1) 'EXPRESSION `(FFS ,n))
+      ;; Set the ith bit of n and make equality hold exactly.
+      (assert-= (ffs (bitwise-ior n (shift-left 1 i))) (+ i 1)
+                'EXPRESSION `(FFS (BITWISE-IOR ,n (SHIFT-LEFT 1 ,i))))
+      (assert-= (ffs (- 0 (bitwise-ior n (shift-left 1 i)))) (+ i 1)
+                'EXPRESSION `(FFS (- 0 (BITWISE-IOR ,N (SHIFT-LEFT 1 ,i))))))))
+
+(define-test 'CLZ:8:0 (lambda () (assert-= 8 ((clz 8) 0))))
+(define-test 'CLZ:8:1 (lambda () (assert-= 7 ((clz 8) 1))))
+(define-test 'CLZ:8:2 (lambda () (assert-= 6 ((clz 8) 2))))
+(define-test 'CLZ:8:3 (lambda () (assert-= 6 ((clz 8) 3))))
+(define-test 'CLZ:8:FF (lambda () (assert-= 0 ((clz 8) #xff))))
+
+;;; Number of octets in a UTF-8 sequence given the initial octet.
+
+(define (utf8-n o)
+  (max 1 ((clz 8) (bitwise-andc1 o #xff))))
+
+(define-test 'UTF8-N:1 (lambda () (assert-= 1 (utf8-n #b01101101))))
+(define-test 'UTF8-N:2 (lambda () (assert-= 2 (utf8-n #b11001101))))
+(define-test 'UTF8-N:3 (lambda () (assert-= 3 (utf8-n #b11101101))))
+(define-test 'UTF8-N:4 (lambda () (assert-= 4 (utf8-n #b11110011))))
+
+;;; Not real UTF-8, but the arithmetic works out the same!
+
+(define-test 'UTF8-N:5 (lambda () (assert-= 5 (utf8-n #b11111001))))
+(define-test 'UTF8-N:6 (lambda () (assert-= 6 (utf8-n #b11111101))))