From: Andreas Rottmann <a.rottmann@gmx.at>
Subject: [PATCH] Implement fxreverse-bit-field

---
 scheme/ikarus.not-yet-implemented.ss |    5 +--
 scheme/ikarus.numerics.ss            |   36 +++++++++++++++++++++++++++++++--
 2 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/scheme/ikarus.not-yet-implemented.ss b/scheme/ikarus.not-yet-implemented.ss
index df0c3d9..84f8a1f 100644
--- a/scheme/ikarus.not-yet-implemented.ss
+++ b/scheme/ikarus.not-yet-implemented.ss
@@ -18,7 +18,7 @@
 (library (ikarus not-yet-implemented)
   (export 
     bitwise-reverse-bit-field
-    bitwise-rotate-bit-field fxreverse-bit-field
+    bitwise-rotate-bit-field
     make-custom-binary-input/output-port
     make-custom-textual-input/output-port
     open-file-input/output-port 
@@ -26,7 +26,7 @@
 
   (import (except (ikarus) 
     bitwise-reverse-bit-field
-    bitwise-rotate-bit-field fxreverse-bit-field
+    bitwise-rotate-bit-field
     make-custom-binary-input/output-port
     make-custom-textual-input/output-port
     open-file-input/output-port 
@@ -57,7 +57,6 @@
   (not-yet 
     ;;; should be implemented
     bitwise-rotate-bit-field bitwise-reverse-bit-field
-    fxreverse-bit-field 
     ;;; not top priority at the moment
     equal-hash
     ;;; won't be implemented
diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss
index 3f1fb43..db3e1fa 100644
--- a/scheme/ikarus.numerics.ss
+++ b/scheme/ikarus.numerics.ss
@@ -3603,7 +3603,7 @@
           fxlength
           fxbit-set?
           fxcopy-bit
-          fxcopy-bit-field fxrotate-bit-field
+          fxcopy-bit-field fxrotate-bit-field fxreverse-bit-field
           fxbit-field)
   (import 
     (ikarus system $fx)
@@ -3615,7 +3615,7 @@
       fxlength
       fxbit-set?
       fxcopy-bit
-      fxcopy-bit-field fxrotate-bit-field
+      fxcopy-bit-field fxrotate-bit-field fxreverse-bit-field
       fxbit-field))
 
   (module (bitwise-first-bit-set fxfirst-bit-set)
@@ -3853,7 +3853,37 @@
             (die who "start index is not a fixnum" i))
         (die who "not a fixnum" x)))
 
-                    
+
+  (define ($fxreverse-bit-field x i j w)
+    (let ([m ($fxsll ($fxsub1 ($fxsll 1 w)) i)])
+      (let ([x0 ($fxsra ($fxlogand x m) i)])
+        (let loop ([x0 ($fxlogand x0 1)]
+                   [v ($fxsra x0 1)]
+                   [c ($fxsub1 w)])
+          (if ($fx= 0 v)
+              (let ([x0 ($fxlogand ($fxsll x0 ($fx+ c i)) m)])
+                ($fxlogor x0 ($fxlogand x ($fxlognot m))))
+              (loop ($fxlogor ($fxsll x0 1) ($fxlogand v 1))
+                    ($fxsra v 1)
+                    ($fxsub1 c)))))))
+  
+  (define (fxreverse-bit-field x i j)
+    (define who 'fxreverse-bit-field)
+    (if (fixnum? x)
+        (if (fixnum? i)
+            (if ($fx>= i 0)
+                (if (fixnum? j)
+                    (if ($fx< j (fixnum-width))
+                        (let ([w ($fx- j i)])
+                          (if ($fx>= w 0)
+                              ($fxreverse-bit-field x i j w)
+                              (die who "field width is negative" i j)))
+                        (die who "end index is out of range" j))
+                    (die who "end index is not a fixnum" j))
+                (die who "start index is out of range" i))
+            (die who "start index is not a fixnum" i))
+        (die who "not a fixnum" x)))
+  
 
   (define (fxbit-field x i j)
     (define who 'fxbit-field)
-- 
tg: (91e5e29..) t/fxreverse-bit-field (depends on: t/build-tweaks)