Skip to content
Snippets Groups Projects
Commit 050b7943 authored by pw's avatar pw
Browse files

Misc fixes from Ray Toy

parent ce4a65df
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.34 1997/02/08 16:02:22 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.35 1997/04/20 21:31:26 pw Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1055,7 +1055,10 @@ ...@@ -1055,7 +1055,10 @@
;;; ;;;
(defun format-fixed-aux (stream number w d k ovf pad atsign) (defun format-fixed-aux (stream number w d k ovf pad atsign)
(cond (cond
((not (or w d)) ((or (not (or w d))
(and (floatp number)
(or (float-infinity-p number)
(float-nan-p number))))
(prin1 number stream) (prin1 number stream)
nil) nil)
(t (t
...@@ -1144,15 +1147,22 @@ ...@@ -1144,15 +1147,22 @@
;;;errors. As for now, we let the user get away with it, and merely guarantee ;;;errors. As for now, we let the user get away with it, and merely guarantee
;;;that at least one significant digit will appear. ;;;that at least one significant digit will appear.
;;; toy@rtp.ericsson.se: The Hyperspec seems to say that the exponent
;;; marker is always printed. Make it so. Also, the original version
;;; causes errors when printing infinities or NaN's. The Hyperspec is
;;; silent here, so let's just print out infinities and NaN's instead
;;; of causing an error.
(defun format-exp-aux (stream number w d e k ovf pad marker atsign) (defun format-exp-aux (stream number w d e k ovf pad marker atsign)
(if (not (or w d)) (if (and (floatp number)
(or (float-infinity-p number)
(float-nan-p number)))
(prin1 number stream) (prin1 number stream)
(multiple-value-bind (num expt) (multiple-value-bind (num expt)
(lisp::scale-exponent (abs number)) (lisp::scale-exponent (abs number))
(let* ((expt (- expt k)) (let* ((expt (- expt k))
(estr (decimal-string (abs expt))) (estr (decimal-string (abs expt)))
(elen (if e (max (length estr) e) (length estr))) (elen (if e (max (length estr) e) (length estr)))
(fdig (if d (if (plusp k) (1+ (- d k)) d) nil)) (fdig (if d (if (plusp k) (1+ (- d k)) d) 1))
(fmin (if (minusp k) (- 1 k) nil)) (fmin (if (minusp k) (- 1 k) nil))
(spaceleft (if w (spaceleft (if w
(- w 2 elen (- w 2 elen
...@@ -1225,32 +1235,37 @@ ...@@ -1225,32 +1235,37 @@
(format-princ stream number nil nil w 1 0 pad))) (format-princ stream number nil nil w 1 0 pad)))
;;; toy@rtp.ericsson.se: Same change as for format-exp-aux.
(defun format-general-aux (stream number w d e k ovf pad marker atsign) (defun format-general-aux (stream number w d e k ovf pad marker atsign)
(multiple-value-bind (ignore n) (if (and (floatp number)
(lisp::scale-exponent (abs number)) (or (float-infinity-p number)
(declare (ignore ignore)) (float-nan-p number)))
;;Default d if omitted. The procedure is taken directly (prin1 number stream)
;;from the definition given in the manual, and is not (multiple-value-bind (ignore n)
;;very efficient, since we generate the digits twice. (lisp::scale-exponent (abs number))
;;Future maintainers are encouraged to improve on this. (declare (ignore ignore))
(unless d ;;Default d if omitted. The procedure is taken directly
(multiple-value-bind (str len) ;;from the definition given in the manual, and is not
(lisp::flonum-to-string (abs number)) ;;very efficient, since we generate the digits twice.
(declare (ignore str)) ;;Future maintainers are encouraged to improve on this.
(let ((q (if (= len 1) 1 (1- len)))) (unless d
(setq d (max q (min n 7)))))) (multiple-value-bind (str len)
(let* ((ee (if e (+ e 2) 4)) (lisp::flonum-to-string (abs number))
(ww (if w (- w ee) nil)) (declare (ignore str))
(dd (- d n))) (let ((q (if (= len 1) 1 (1- len))))
(cond ((<= 0 dd d) (setq d (max q (min n 7))))))
(let ((char (if (format-fixed-aux stream number ww dd nil (let* ((ee (if e (+ e 2) 4))
ovf pad atsign) (ww (if w (- w ee) nil))
ovf (dd (- d n)))
#\space))) (cond ((<= 0 dd d)
(dotimes (i ee) (write-char char stream)))) (let ((char (if (format-fixed-aux stream number ww dd nil
(t ovf pad atsign)
(format-exp-aux stream number w d e (or k 1) ovf
ovf pad marker atsign)))))) #\space)))
(dotimes (i ee) (write-char char stream))))
(t
(format-exp-aux stream number w d e (or k 1)
ovf pad marker atsign)))))))
(def-format-directive #\$ (colonp atsignp params) (def-format-directive #\$ (colonp atsignp params)
(expand-bind-defaults ((d 2) (n 1) (w 0) (pad #\space)) params (expand-bind-defaults ((d 2) (n 1) (w 0) (pad #\space)) params
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment