* Fixed a bug in number->string for hex/oct/binary numbers.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-14 23:18:49 -05:00
parent 4c632e435b
commit d18a041840
4 changed files with 35 additions and 5 deletions

View File

@ -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))
;------------------------------------------------------------------------------

View File

@ -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.

View File

@ -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.)

View File

@ -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)])