From 4b7f03df1ae5cf0150f7fddd2478664c73826fde Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Tue, 13 Nov 2007 00:10:10 -0500
Subject: [PATCH] * Added bitwise-first-bit-set.

---
 scheme/ikarus.numerics.ss | 41 ++++++++++++++++++++++++++++++++++++++-
 scheme/makefile.ss        |  2 +-
 scheme/todo-r6rs.ss       |  2 +-
 3 files changed, 42 insertions(+), 3 deletions(-)

diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss
index 44e373a..9458662 100644
--- a/scheme/ikarus.numerics.ss
+++ b/scheme/ikarus.numerics.ss
@@ -2858,6 +2858,45 @@
             (error 'fldiv0-and-mod0 "not a flonum" m))
         (error 'fldiv0-and-mod0 "not a flonum" n))))
 
-
+(library (ikarus bitwise misc)
+  (export bitwise-first-bit-set)
+  (import 
+    (ikarus system $fx)
+    (ikarus system $bignums)
+    (except (ikarus) bitwise-first-bit-set))
+
+  (module (bitwise-first-bit-set)
+    (define (byte-first-bit-set x i) 
+      (case ($fxlogand x #b11)
+        [(0) (byte-first-bit-set ($fxsra x 2) ($fx+ i 2))]
+        [(2) ($fx+ i 1)]
+        [else i]))
+    
+    (define (fx-first-bit-set x i)
+      (let ([y ($fxlogand x 255)])
+        (if ($fx= y 0)
+            (fx-first-bit-set ($fxsra x 8) ($fx+ i 8))
+            (byte-first-bit-set y i))))
+    
+    (define (bn-first-bit-set x i idx)
+      (let ([b ($bignum-byte-ref x idx)])
+        (if ($fxzero? b) 
+            (bn-first-bit-set x ($fx+ i 8) ($fx+ idx 1))
+            (byte-first-bit-set b i))))
+    
+    (define (bitwise-first-bit-set x)
+      (cond
+        [(fixnum? x) 
+         (if ($fx> x 0) 
+             (fx-first-bit-set x 0)
+             (if ($fx= x 0) 
+                 -1 
+                 (if ($fx> x (least-fixnum)) 
+                     (fx-first-bit-set ($fx- 0 x) 0)
+                     (bn-first-bit-set (- x) 0 0))))]
+        [(bignum? x) (bn-first-bit-set x 0 0)]
+        [else (error 'bitwise-first-bit-set "not an exact integer" x)])))
+  
+  )
 
 
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index ac09622..68e271d 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -760,7 +760,7 @@
     [bitwise-bit-set?                            r bw]
     [bitwise-copy-bit                            r bw]
     [bitwise-copy-bit-field                      r bw]
-    [bitwise-first-bit-set                       r bw]
+    [bitwise-first-bit-set                       i r bw]
     [bitwise-if                                  r bw]
     [bitwise-length                              r bw]
     [bitwise-reverse-bit-field                   r bw]
diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss
index 018d384..4909401 100755
--- a/scheme/todo-r6rs.ss
+++ b/scheme/todo-r6rs.ss
@@ -263,7 +263,7 @@
     [bitwise-bit-set?                           S bw]
     [bitwise-copy-bit                           S bw]
     [bitwise-copy-bit-field                     S bw]
-    [bitwise-first-bit-set                      S bw]
+    [bitwise-first-bit-set                      C bw]
     [bitwise-if                                 S bw]
     [bitwise-length                             S bw]
     [bitwise-reverse-bit-field                  S bw]