(in-package :sb-impl)

(defun flonum-to-string (x &optional width fdigits scale fmin)
  (declare (type float x))
  (multiple-value-bind (e string)
      (if fdigits
          (flonum-to-digits x (min (- (+ fdigits (or scale 0)))
                                   (- (+ (or fmin 0) (or scale 0)))))
          (if (and width (> width 1))
              (let ((w (multiple-value-list
                        (flonum-to-digits x
                                          (max 1
                                               (+ (1- width)
                                                  (if (and scale (minusp scale))
                                                      scale 0)))
                                          t)))
                    (f (multiple-value-list
                        (flonum-to-digits x (- (+ (or fmin 0)
                                                  (if scale scale 0)))))))
                (cond
                  ((>= (length (cadr w)) (length (cadr f)))
                   (values-list w))
                  (t (values-list f))))
              (flonum-to-digits x)))
    (let ((e (if (zerop x)
                 e
                 (+ e (or scale 0))))
          (stream (make-string-output-stream)))
      (if (plusp e)
          (progn
            (write-string string stream :end (min (length string) e))
            (dotimes (i (- e (length string)))
              (write-char #\0 stream))
            (write-char #\. stream)
            (write-string string stream :start (min (length string) e))
            (when fdigits
              (dotimes (i (- fdigits
                             (- (length string)
                                (min (length string) e))))
                (write-char #\0 stream))))
          (progn
            (write-string "." stream)
            (dotimes (i (- e))
              (write-char #\0 stream))
            (write-string string stream :end (when fdigits
                                               (min (length string)
                                                    (max (or fmin 0)
                                                         (+ fdigits e)))))
            (when fdigits
              (dotimes (i (+ fdigits e (- (length string))))
                (write-char #\0 stream)))))
      (let ((string (get-output-stream-string stream)))
        (values string (length string)
                (char= (char string 0) #\.)
                (char= (char string (1- (length string))) #\.)
                (position #\. string))))))

(in-package :sb-format)

(defun exponent-in-base10 (x)
  (if (= x 0)
      1
      (1+ (floor (log (abs x) 10)))))

(defun format-exp-aux (stream number w d e k ovf pad marker atsign)
  (declare (type float number))
  (if (or (float-infinity-p number)
          (float-nan-p number))
      (prin1 number stream)
      (let* ((expt (- (exponent-in-base10 number) k))
             (estr (decimal-string (abs expt)))
             (elen (if e (max (length estr) e) (length estr)))
             (fdig (if d (if (plusp k) (1+ (- d k)) d) nil))
             (fmin (if (minusp k) (- 1 k) 0))
             (spaceleft (if w
                            (- w 2 elen
                               (if (or atsign (minusp number))
                                   1 0))
                            nil)))
        (if (and w ovf e (> elen e))   ;exponent overflow
            (dotimes (i w) (write-char ovf stream))
            (multiple-value-bind (fstr flen lpoint)
                (sb-impl::flonum-to-string number spaceleft fdig (- expt) fmin)
              (when w
                (decf spaceleft flen)
                (when lpoint
                  (if (> spaceleft 0)
                      (decf spaceleft)
                      (setq lpoint nil))))
              (cond ((and w (< spaceleft 0) ovf)
                     ;;significand overflow
                     (dotimes (i w) (write-char ovf stream)))
                    (t (when w
                         (dotimes (i spaceleft) (write-char pad stream)))
                       (if (minusp number)
                           (write-char #\- stream)
                           (if atsign (write-char #\+ stream)))
                       (when lpoint (write-char #\0 stream))
                       (write-string fstr stream)
                       (write-char (if marker
                                       marker
                                       (format-exponent-marker number))
                                   stream)
                       (write-char (if (minusp expt) #\- #\+) stream)
                       (when e
                         ;;zero-fill before exponent if necessary
                         (dotimes (i (- e (length estr)))
                           (write-char #\0 stream)))
                       (write-string estr stream))))))))