* Added fxlength

scheme/ikarus.numerics.ss

@@ -2838,13 +2838,16 @@
 
 (library (ikarus bitwise misc)
   (export bitwise-first-bit-set
-          fxbit-count bitwise-bit-count)
+          fxbit-count bitwise-bit-count
+          fxlength)
   (import 
     (ikarus system $fx)
     (ikarus system $bignums)
+    (ikarus system $flonums)
     (except (ikarus) 
       bitwise-first-bit-set
-      fxbit-count bitwise-bit-count))
+      fxbit-count bitwise-bit-count
+      fxlength))
 
   (define (bitwise-first-bit-set x)
     (define (byte-first-bit-set x i) 
@@ -2917,6 +2920,19 @@
         [(bignum? n) (bnbitcount n)]
         [else (error 'bitwise-bit-count "not an exact integer" n)])))
   
+
+  (define (fxlength x) 
+    (if (fixnum? x) 
+        (let ([fl ($fixnum->flonum
+                    (if ($fx< x 0) ($fxlognot x) x))])
+          (let ([sbe ($fxlogor 
+                       ($fxsll ($flonum-u8-ref fl 0) 4)
+                       ($fxsra ($flonum-u8-ref fl 1) 4))])
+            (cond
+              [($fx= sbe 0) 0]
+              [else ($fx- sbe 1022)])))
+        (error 'fxlength "not a fixnum" x)))
+
   )
 
 

scheme/makefile.ss

@@ -798,7 +798,7 @@
     [fxfirst-bit-set                             r fx]
     [fxif                                        i r fx]
     [fxior                                       i r fx]
-    [fxlength                                    r fx]
+    [fxlength                                    i r fx]
     [fxmax                                       i r fx]
     [fxmin                                       i r fx]
     [fxmod                                       i r fx]

scheme/run-tests.ss

@@ -63,5 +63,6 @@
 (test-fldiv0-and-mod0)
 (test-fxdiv-and-mod)
 (test-fxdiv0-and-mod0)
+(test-fxlength)
 (test-bitwise-bit-count)
 (printf "Happy Happy Joy Joy\n")

scheme/tests/fixnums.ss

@@ -1,6 +1,7 @@
 
 (library (tests fixnums)
-  (export test-fxdiv-and-mod test-fxdiv0-and-mod0)
+  (export test-fxdiv-and-mod test-fxdiv0-and-mod0
+          test-fxlength)
   (import (ikarus))
 
   (define (test-fxdiv-and-mod)
@@ -82,5 +83,34 @@
     (test (least-fixnum) (greatest-fixnum))
     (test (greatest-fixnum) (greatest-fixnum)))
   
+
+  (define (test-fxlength)
+    (define (test x)
+      (define (bitlen x)
+        (if (zero? x) 
+            0
+            (+ 1 (bitlen (bitwise-arithmetic-shift-right x 1)))))
+      (define (len x) 
+        (if (< x 0) 
+            (bitlen (bitwise-not x))
+            (bitlen x)))
+      (let ([c0 (len x)]
+            [c1 (fxlength x)])
+        (unless (= c0 c1) 
+          (error 'test-fxlength "failed/expected/got" x c0 c1))))
+    (define (fxtest x)
+      (when (fixnum? x) 
+        (when (zero? (bitwise-and x #xFFFFFFF)) 
+          (printf "fxlength ~s\n" x))
+        (test x) 
+        (fxtest (+ x #x100))))
+    (test 0)
+    (test 1)
+    (test 2)
+    (test 3)
+    (test -1)
+    (test -2)
+    (test -3)
+    (fxtest (least-fixnum)))
   )
 

scheme/todo-r6rs.ss

@@ -301,7 +301,7 @@
     [fxfirst-bit-set                            S fx]
     [fxif                                       C fx]
     [fxior                                      C fx]
-    [fxlength                                   S fx]
+    [fxlength                                   C fx]
     [fxmax                                      C fx]
     [fxmin                                      C fx]
     [fxmod                                      C fx]