From d18a04184003e396d7d52ccd2f282893b88a1691 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum 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)])