From d18a04184003e396d7d52ccd2f282893b88a1691 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Wed, 14 Nov 2007 23:18:49 -0500
Subject: [PATCH] * Fixed a bug in number->string for hex/oct/binary numbers.

---
 benchmarks.larceny/prefix/prefix-gambit.scm  |  3 +++
 benchmarks.larceny/prefix/prefix-larceny.scm |  3 +++
 benchmarks.larceny/results.Larceny-r6rs      | 25 ++++++++++++++++++++
 scheme/ikarus.numerics.ss                    |  9 ++++---
 4 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/benchmarks.larceny/prefix/prefix-gambit.scm b/benchmarks.larceny/prefix/prefix-gambit.scm
index 4082600..7430753 100644
--- a/benchmarks.larceny/prefix/prefix-gambit.scm
+++ b/benchmarks.larceny/prefix/prefix-gambit.scm
@@ -26,6 +26,9 @@
   (exit 1))
 
  (define (call-with-output-file/truncate filename proc)
+   (display "opening ")
+   (write filename)
+   (newline)
    (call-with-output-file filename proc))
 
 ;------------------------------------------------------------------------------
diff --git a/benchmarks.larceny/prefix/prefix-larceny.scm b/benchmarks.larceny/prefix/prefix-larceny.scm
index 48cbd27..d6373de 100644
--- a/benchmarks.larceny/prefix/prefix-larceny.scm
+++ b/benchmarks.larceny/prefix/prefix-larceny.scm
@@ -27,6 +27,9 @@
   (apply error #f args))
 
 (define (call-with-output-file/truncate filename proc)
+  (display "opening ")
+  (write filename)
+  (newline)
   (call-with-output-file filename proc))
 
 ; Bitwise operations on exact integers.
diff --git a/benchmarks.larceny/results.Larceny-r6rs b/benchmarks.larceny/results.Larceny-r6rs
index 984736b..f2ca38d 100644
--- a/benchmarks.larceny/results.Larceny-r6rs
+++ b/benchmarks.larceny/results.Larceny-r6rs
@@ -8574,3 +8574,28 @@ Words allocated: 220925448
 Words reclaimed: 0
 Elapsed time...: 20776 ms (User: 10963 ms; System: 9734 ms)
 Elapsed GC time: 164 ms (CPU: 166 in 843 collections.)
+
+****************************
+Benchmarking Larceny-r6rs on Wed Nov 14 21:16:54 EST 2007 under Darwin Vesuvius.local 8.10.1 Darwin Kernel Version 8.10.1: Wed May 23 16:33:00 PDT 2007; root:xnu-792.22.5~1/RELEASE_I386 i386 i386
+
+Testing ray under Larceny-r6rs
+Compiling...
+Larceny v0.95 "First Safety" (Nov  8 2007 04:30:20, precise:BSD Unix:unified)
+larceny.heap, built on Thu Nov  8 04:39:44 EST 2007
+
+> 
+> 
+Running...
+Larceny v0.95 "First Safety" (Nov  8 2007 04:30:20, precise:BSD Unix:unified)
+larceny.heap, built on Thu Nov  8 04:39:44 EST 2007
+
+> 
+opening "spheres.pgm"
+opening "spheres.pgm"
+opening "spheres.pgm"
+opening "spheres.pgm"
+opening "spheres.pgm"
+Words allocated: 221189818
+Words reclaimed: 0
+Elapsed time...: 20809 ms (User: 11008 ms; System: 9796 ms)
+Elapsed GC time: 164 ms (CPU: 175 in 844 collections.)
diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss
index 2c69d4c..1c34f1c 100644
--- a/scheme/ikarus.numerics.ss
+++ b/scheme/ikarus.numerics.ss
@@ -1305,11 +1305,10 @@
               [($fxzero? b) n]
               [else (add-bits ($fxsra b 1) ($fx+ n 1))]))
           (let f ([i ($fxsub1 ($bignum-size x))])
-            (let ([i ($fxsub1 i)])
-              (let ([b ($bignum-byte-ref x i)])
-                (cond
-                  [($fxzero? b) (f i)]
-                  [else (add-bits b ($fxsll i 3))])))))
+            (let ([b ($bignum-byte-ref x i)])
+              (cond
+                [($fxzero? b) (f ($fxsub1 i))]
+                [else (add-bits b ($fxsll i 3))]))))
         (define (bignum->power-string x mask shift)
           (let ([bits (bignum-bits x)])
             (let ([chars (fxquotient (fx+ bits (fx- shift 1)) shift)])