0.8.16.25:
[sbcl.git] / src / code / print.lisp
index 057df86..02a3ca0 100644 (file)
 ;;; [CMUC]<steele>tradix.press. DO NOT EVEN THINK OF ATTEMPTING TO
 ;;; UNDERSTAND THIS CODE WITHOUT READING THE PAPER!
 
-(declaim (type (simple-array character (10)) *digits*))
-(defvar *digits* "0123456789")
-
 (defun flonum-to-string (x &optional width fdigits scale fmin)
   (cond ((zerop x)
         ;; Zero is a special case which FLOAT-STRING cannot handle.
 (defun float-string (fraction exponent precision width fdigits scale fmin)
   (let ((r fraction) (s 1) (m- 1) (m+ 1) (k 0)
        (digits 0) (decpnt 0) (cutoff nil) (roundup nil) u low high
+        (digit-characters "0123456789")
        (digit-string (make-array 50
                                  :element-type 'base-char
                                  :fill-pointer 0
       ;; Stop when either precision is exhausted or we have printed as
       ;; many fraction digits as permitted.
       (when (or low high (and cutoff (<= k cutoff))) (return))
-      (vector-push-extend (char *digits* u) digit-string)
+      (vector-push-extend (char digit-characters u) digit-string)
       (incf digits))
     ;; If cutoff occurred before first digit, then no digits are
     ;; generated at all.
     (when (or (not cutoff) (>= k cutoff))
       ;; Last digit may need rounding
-      (vector-push-extend (char *digits*
+      (vector-push-extend (char digit-characters
                                (cond ((and low (not high)) u)
                                      ((and high (not low)) (1+ u))
                                      (t (if (<= (ash r 1) s) u (1+ u)))))
   (let ((print-base 10) ; B
        (float-radix 2) ; b
        (float-digits (float-digits v)) ; p
+        (digit-characters "0123456789")
        (min-e
         (etypecase v
           (single-float single-float-min-e)
                                      (and high-ok (= (+ r m+) s))))
                        (when (or tc1 tc2)
                          (go end))
-                       (vector-push-extend (char *digits* d) result)
+                       (vector-push-extend (char digit-characters d) result)
                        (go loop)
                      end
                        (let ((d (cond
                                   ((and tc1 (not tc2)) d)
                                   (t ; (and tc1 tc2)
                                    (if (< (* r 2) s) d (1+ d))))))
-                         (vector-push-extend (char *digits* d) result)
+                         (vector-push-extend (char digit-characters d) result)
                          (return-from generate result))))))
          (if (>= e 0)
              (if (/= f (expt float-radix (1- float-digits)))