From f1fb22f0a7f0086796b262eb316f400684338241 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 25 Feb 2021 06:34:45 -0700
Subject: [PATCH] Chez Scheme: faster bignum printing for power-of-two bases

Insteda of using the generic strategy that involves division, walk
through the bits of a bignum to convert to a power-of-two base.
---
 racket/src/ChezScheme/mats/5_3.ms |  8 ++++++
 racket/src/ChezScheme/s/print.ss  | 44 ++++++++++++++++++++++---------
 2 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/racket/src/ChezScheme/mats/5_3.ms b/racket/src/ChezScheme/mats/5_3.ms
index 49e024fd2e..c51f040b1b 100644
--- a/racket/src/ChezScheme/mats/5_3.ms
+++ b/racket/src/ChezScheme/mats/5_3.ms
@@ -806,6 +806,14 @@
   (equal? (number->string #x100 16) "100")
   (equal? (number->string #x100 8) "400")
   (equal? (number->string #x100 16) "100")
+  (equal? (number->string (* 10 (+ 10 (expt 2 100))) 16)
+          "A0000000000000000000000064")
+  (equal? (number->string (* 10 (+ 10 (expt 2 100))) 8)
+          "24000000000000000000000000000000144")
+  (equal? (number->string (* 10 (+ 10 (expt 2 100))) 4)
+          "2200000000000000000000000000000000000000000000001210")
+  (equal? (number->string (* 10 (+ 10 (expt 2 100))) 2)
+          "10100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001100100")
 )
 
 (mat r6rs:number->string
diff --git a/racket/src/ChezScheme/s/print.ss b/racket/src/ChezScheme/s/print.ss
index 06085866f3..535b5e1e34 100644
--- a/racket/src/ChezScheme/s/print.ss
+++ b/racket/src/ChezScheme/s/print.ss
@@ -918,7 +918,7 @@ floating point returns with (1 0 -1 ...).
        [else
         (wrfixits (fx/ n r) r p)
         (write-char (digit->char (fxremainder n r)) p)])]
-    [(n r d p)
+    [(n r d p) ; add leading zeros as needed to ensure that `d` digits are printed
      (cond
        [(fx< n r)
         (do ([d d (fx- d 1)]) ((fx<= d 1)) (write-char #\0 p))
@@ -939,10 +939,14 @@ floating point returns with (1 0 -1 ...).
 
 (define wrbigits
   (let ()
-   ; divide-and-conquer, treating bignum as two ``big base'' bigits
-   ; first base must be >= sqrt(n); base i+1 must be >= sqrt(base i)
-   ; last base must be <= most-positive-fixnum
+    ;; divide-and-conquer, treating bignum as two "big base" bigits,
+    ;; where a big base is a power of the radix;
+    ;; first base must be >= sqrt(n); base i+1 must be >= sqrt(base i);
+    ;; last base must be <= most-positive-fixnum
     (define largest-fixnum-big-base
+      ;; maps `radix` to `(cons big-base output-digits)` for a fixnum `big-base`,
+      ;; where `output-digits` is the same as `(log big-base radix)`; we need the
+      ;; number of digits in the big base to write out any needed leading `0`s
       (let ([v (make-vector 37)])
         (do ([b 2 (fx+ b 1)])
             ((fx= b 37) v)
@@ -953,6 +957,9 @@ floating point returns with (1 0 -1 ...).
                     (f bb^2 (* d 2))
                     (cons (cons bb d) '()))))))))
     (define (big-bases n r)
+      ;; get a list of spans of big-base digits, where each span's length is
+      ;; a power of two, so it corresponds to some number of squaring of
+      ;; the  big base; pair that with the number of digits in the span
       (let ([iln/2 (bitwise-arithmetic-shift-right (+ (bitwise-length n) 1) 1)])
         (let f ([bb* (vector-ref largest-fixnum-big-base r)])
           (let ([bb (caar bb*)])
@@ -960,14 +967,27 @@ floating point returns with (1 0 -1 ...).
                 bb*
                 (f (cons (cons (* bb bb) (* (cdar bb*) 2)) bb*)))))))
     (lambda (n r p)
-      (let f ([n n] [d 0] [bb* (big-bases n r)])
-        (cond
-          [(fixnum? n) (wrfixits n r d p)]
-          [(> (caar bb*) n) (f n d (cdr bb*))]
-          [else
-           (let ([hi.lo ($quotient-remainder n (caar bb*))])
-             (f (car hi.lo) (- d (cdar bb*)) (cdr bb*))
-             (f (cdr hi.lo) (cdar bb*) (cdr bb*)))])))))
+      (case r
+        [(2 4 8 16 32)
+         ;; For powers of 2, we can stream through the binary representation
+         (let* ([big-base (car (vector-ref largest-fixnum-big-base r))]
+                [bits (bitwise-length (fx- (car big-base) 1))]
+                [digits (cdr big-base)])
+           (let loop ([start (fx* bits (fx- (fxquotient (fx+ (bitwise-length n) (fx- bits 1)) bits) 1))]
+                      [d 0])
+             (wrfixits (bitwise-bit-field n start (fx+ start bits)) r d p)
+             (unless (fx= start 0)
+               (loop (fx- start bits) digits))))]
+        [else
+         ;; Use the general divide-and-conquer approach
+         (let f ([n n] [d 0] [bb* (big-bases n r)])
+           (cond
+             [(fixnum? n) (wrfixits n r d p)]
+             [(> (caar bb*) n) (f n d (cdr bb*))]
+             [else
+              (let ([hi.lo ($quotient-remainder n (caar bb*))])
+                (f (car hi.lo) (- d (cdar bb*)) (cdr bb*))
+                (f (cdr hi.lo) (cdar bb*) (cdr bb*)))]))]))))
 
 (define wrradix
    (lambda (r p)