From cc45dc044d1b1d4ead8145599c8b15c6b5ea63f1 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 9 Apr 2019 04:19:52 -0600
Subject: [PATCH] cs: faster `number->string` on fixnums

---
 racket/src/cs/rumble/hash-code.ss | 11 ++++----
 racket/src/cs/rumble/number.ss    | 47 ++++++++++++++++++++++++++-----
 2 files changed, 46 insertions(+), 12 deletions(-)

diff --git a/racket/src/cs/rumble/hash-code.ss b/racket/src/cs/rumble/hash-code.ss
index c6be084773..9546776fe0 100644
--- a/racket/src/cs/rumble/hash-code.ss
+++ b/racket/src/cs/rumble/hash-code.ss
@@ -30,11 +30,12 @@
    [(char? x) (char->integer x)]
    [else
     (with-global-lock
-     (or (eq-hashtable-ref codes x #f)
-         (let ([c (fx1+ counter)])
-           (set! counter c)
-           (eq-hashtable-set! codes x counter)
-           c)))]))
+     (let ([p (eq-hashtable-cell codes x #f)])
+       (or (cdr p)
+           (let ([c (fx1+ counter)])
+             (set! counter c)
+             (set-cdr! p c)
+             c))))]))
 
 ;; Mostly copied from Chez Scheme's "newhash.ss":
 (define number-hash
diff --git a/racket/src/cs/rumble/number.ss b/racket/src/cs/rumble/number.ss
index daf6c5a98a..2dc31ac376 100644
--- a/racket/src/cs/rumble/number.ss
+++ b/racket/src/cs/rumble/number.ss
@@ -272,18 +272,51 @@
 
 (define/who number->string
   (case-lambda
-   [(n) (number->string n 10)]
    [(n radix)
-    (check who number? n)
+    (unless (or (eq? radix 2) (eq? radix 8) (eq? radix 10) (eq? radix 16))
+      (check who number? n)
+      (check who (lambda (radix) #f)
+             :contract "(or/c 2 8 10 16)"
+             radix))
+    (do-number->string n radix)]
+   [(n)
+    (do-number->string n 10)]))
+
+(define (do-number->string n radix)
+  ;; Host `number->string` goes through `format`, so we can do
+  ;; significantly better for fixnums by handling them directly
+  (cond
+   [(fixnum? n)
+    (let-values ([(result pos) ; result string and pos after written so far
+                  (let loop ([v (fxabs n)] [len 0])
+                    (cond
+                     [(fx= v 0)
+                      (cond
+                       [(fx= len 0)
+                        (values (#%make-string 1 #\0) 1)]
+                       [(fx< n 0)
+                        (let ([result (#%make-string (fx+ 1 len))])
+                          (string-set! result 0 #\-)
+                          (values result 1))]
+                       [else
+                        (values (#%make-string len)
+                                0)])]
+                     [else
+                      (let ([q (fxquotient v radix)])
+                        (let-values ([(d) (fx- v (fx* q radix))]
+                                     [(result pos) (loop q (fx+ 1 len))])
+                          (string-set! result pos (integer->char (+ d (if (fx< d 10)
+                                                                          (char->integer #\0)
+                                                                          (fx- (char->integer #\a) 10)))))
+                          (values result (fx+ 1 pos))))]))])
+      result)]
+   [else
     (cond
      [(eq? radix 16)
       ;; Host generates uppercase letters, Racket generates lowercase
-      (string-downcase (chez:number->string n 16))]
+      (string-downcase (#2%number->string n radix))]
      [else
-      (check who (lambda (radix) (or (eq? radix 2) (eq? radix 8) (eq? radix 10) (eq? radix 16)))
-             :contract "(or/c 2 8 10 16)"
-             radix)
-      (chez:number->string n radix)])]))
+      (#2%number->string n radix)])]))
 
 (define/who (quotient/remainder n m)
   (check who integer? n)