From 45d60f3353522eda4e520af003703aace5edaef3 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Wed, 12 Feb 1992 16:10:36 +0000 Subject: [PATCH] Added DECIMAL-STRING function for use in getting the string for float exponents. Worries about getting the right base, etc. --- code/format.lisp | 38 ++++++++++++++++++-------------------- 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/code/format.lisp b/code/format.lisp index 601ea0a4f..3c30db067 100644 --- a/code/format.lisp +++ b/code/format.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.22 1992/01/17 19:56:29 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.23 1992/02/12 16:10:36 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1009,6 +1009,9 @@ ;;;; Floating point noise. +(defun decimal-string (n) + (write-to-string n :base 10 :radix nil :escape nil)) + (def-format-directive #\F (colonp atsignp params) (when colonp (error 'format-error @@ -1033,10 +1036,9 @@ (format-fixed-aux stream (coerce number 'single-float) w d k ovf pad atsign) - (let ((*print-base* 10)) - (format-write-field stream - (princ-to-string number) - w 1 0 #\space t))))) + (format-write-field stream + (decimal-string number) + w 1 0 #\space t)))) ;;; We return true if we overflowed, so that ~G can output the overflow char ;;; instead of spaces. @@ -1109,10 +1111,9 @@ (format-exp-aux stream (coerce number 'single-float) w d e k ovf pad marker atsign) - (let ((*print-base* 10)) - (format-write-field stream - (princ-to-string number) - w 1 0 #\space t))))) + (format-write-field stream + (decimal-string number) + w 1 0 #\space t)))) (defun format-exponent-marker (number) (if (typep number *read-default-float-format*) @@ -1136,14 +1137,13 @@ (multiple-value-bind (num expt) (lisp::scale-exponent (abs number)) (let* ((expt (- expt k)) - (estr (princ-to-string (abs expt))) + (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) nil))) (when (or atsign (minusp number)) (decf spaceleft)) - (if (and w e ovf (> elen e)) - ;;exponent overflow + (if (and w ovf e (> elen e)) ;exponent overflow (dotimes (i w) (write-char ovf stream)) (multiple-value-bind (fstr flen lpoint) @@ -1205,10 +1205,9 @@ (format-general-aux stream (coerce number 'single-float) w d e k ovf pad marker atsign) - (let ((*print-base* 10)) - (format-write-field stream - (princ-to-string number) - w 1 0 #\space t))))) + (format-write-field stream + (decimal-string number) + w 1 0 #\space t)))) (defun format-general-aux (stream number w d e k ovf pad marker atsign) (multiple-value-bind (ignore n) @@ -1260,10 +1259,9 @@ (unless colon (write-string signstr stream)) (dotimes (i (- n pointplace)) (write-char #\0 stream)) (write-string str stream))) - (let ((*print-base* 10)) - (format-write-field stream - (princ-to-string number) - w 1 0 #\space t)))) + (format-write-field stream + (decimal-string number) + w 1 0 #\space t))) ;;;; line/page breaks and other stuff like that. -- GitLab