From cde8d8b7c3f82a33992bf4ff1b05512a546abdbd Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Mon, 19 Jun 2017 19:28:55 -0400
Subject: [PATCH] Avoid a few rebindings of *print-base* and *print-radix*

---
 src/code/early-print.lisp | 16 +++++++---------
 src/code/print.lisp       | 36 +++++++++++++++---------------------
 2 files changed, 22 insertions(+), 30 deletions(-)

diff --git a/src/code/early-print.lisp b/src/code/early-print.lisp
index bbae626a0..45edc5264 100644
--- a/src/code/early-print.lisp
+++ b/src/code/early-print.lisp
@@ -181,15 +181,13 @@
      nil)
     (t
      (write-char #\# stream)
-     (let ((*print-base* 10) (*print-radix* nil))
-       (cond ((minusp marker)
-              (output-integer (- marker) stream)
-              (write-char #\# stream)
-              nil)
-             (t
-              (output-integer marker stream)
-              (write-char #\= stream)
-              t))))))
+     (output-integer (abs marker) stream 10 nil)
+     (cond ((minusp marker)
+            (write-char #\# stream)
+            nil)
+           (t
+            (write-char #\= stream)
+            t)))))
 
 (defmacro with-circularity-detection ((object stream) &body body)
   (with-unique-names (marker body-name)
diff --git a/src/code/print.lisp b/src/code/print.lisp
index f8e58579a..54e7da0c1 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -195,7 +195,7 @@ variable: an unreadable object representing the error is printed instead.")
                     (stream (%make-finite-base-string-output-stream string)))
                (declare (inline %make-finite-base-string-output-stream))
                (declare (truly-dynamic-extent stream))
-               (output-integer object stream)
+               (output-integer object stream *print-base* *print-radix*)
                (%shrink-vector string
                                (finite-base-string-output-stream-pointer stream)))))))
     ;; Could do something for other numeric types, symbols, ...
@@ -939,9 +939,7 @@ variable: an unreadable object representing the error is printed instead.")
   (cond ((or (not *print-readably*)
              (array-readably-printable-p array))
          (write-char #\# stream)
-         (let ((*print-base* 10)
-               (*print-radix* nil))
-           (output-integer (array-rank array) stream))
+         (output-integer (array-rank array) stream 10 nil)
          (write-char #\A stream)
          (with-array-data ((data array) (start) (end))
            (declare (ignore end))
@@ -1089,15 +1087,15 @@ variable: an unreadable object representing the error is printed instead.")
 
 ;;; This gets both a method and a specifically named function
 ;;; since the latter is called from a few places.
-(defmethod print-object ((object integer) stream) (output-integer object stream))
-(defun output-integer (integer stream)
-  (let ((base *print-base*))
-    (cond (*print-radix*
-           (unless (= base 10) (%output-radix base stream))
-           (%output-integer-in-base integer base stream)
-           (when (= base 10) (write-char #\. stream)))
-          (t
-           (%output-integer-in-base integer base stream)))))
+(defmethod print-object ((object integer) stream)
+  (output-integer object stream *print-base* *print-radix*))
+(defun output-integer (integer stream base radixp)
+  (cond (radixp
+         (unless (= base 10) (%output-radix base stream))
+         (%output-integer-in-base integer base stream)
+         (when (= base 10) (write-char #\. stream)))
+        (t
+         (%output-integer-in-base integer base stream))))
 
 (defmethod print-object ((ratio ratio) stream)
   (let ((base *print-base*))
@@ -1712,25 +1710,21 @@ variable: an unreadable object representing the error is printed instead.")
                        (output-object (value-cell-ref object) stream))
                       (t
                        (write-string "unknown pointer object, widetag=" stream)
-                       (let ((*print-base* 16) (*print-radix* t))
-                         (output-integer widetag stream))))))
+                       (output-integer widetag stream 16 t)))))
                  ((#.sb!vm:fun-pointer-lowtag
                    #.sb!vm:instance-pointer-lowtag
                    #.sb!vm:list-pointer-lowtag)
                   (write-string "unknown pointer object, lowtag=" stream)
-                  (let ((*print-base* 16) (*print-radix* t))
-                    (output-integer lowtag stream)))
+                  (output-integer lowtag stream 16 t))
                 (t
                  (case (widetag-of object)
                    (#.sb!vm:unbound-marker-widetag
                     (write-string "unbound marker" stream))
                    (t
                     (write-string "unknown immediate object, lowtag=" stream)
-                    (let ((*print-base* 2) (*print-radix* t))
-                      (output-integer lowtag stream))
+                    (output-integer lowtag stream 2 t)
                     (write-string ", widetag=" stream)
-                    (let ((*print-base* 16) (*print-radix* t))
-                      (output-integer (widetag-of object) stream))))))))))
+                    (output-integer (widetag-of object) stream 16 t)))))))))
     (if *print-pretty*
       ;; This block might not be necessary. Not sure, probably can't hurt.
         (pprint-logical-block (stream nil) (output-it stream))
-- 
2.11.4.GIT