- (let* ((expt (- expt 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) nil))
- (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 num spaceleft fdig k 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)))))))))
+ (let* ((expt (- expt 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) nil))
+ (spaceleft (if w
+ (- w 2 elen
+ (if (or atsign (minusp (float-sign 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 tpoint)
+ (sb!impl::flonum-to-string num spaceleft fdig k fmin)
+ (when (and d (zerop d)) (setq tpoint nil))
+ (when w
+ (decf spaceleft flen)
+ (when lpoint
+ (if (or (> spaceleft 0) tpoint)
+ (decf spaceleft)
+ (setq lpoint nil)))
+ (when tpoint
+ (if (> spaceleft 0)
+ (decf spaceleft)
+ (setq tpoint 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 (float-sign number))
+ (write-char #\- stream)
+ (if atsign (write-char #\+ stream)))
+ (when lpoint (write-char #\0 stream))
+ (write-string fstr stream)
+ (when tpoint (write-char #\0 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)))))))))