1 - operator<< should respect and reset the istream flags
2 - operator>> should respect and reset the ostream flags
3 See ANSI/ISO C++ section 22.2.2.2 num_put
4 see egcs-1.1b/libio/iostream.cc : write_int,
5 uses stream.flags(), stream.width(0), stream.fill()
7 ; (format-float-for-f w d k overflowchar padchar plus-sign-flag arg stream)
8 ; gibt die Floating-Point-Zahl arg in Festkommadarstellung auf stream aus.
9 (defun format-float-for-f (w d k overflowchar padchar plus-sign-flag arg stream)
10 (let ((width (if w (if (or plus-sign-flag (minusp arg)) (1- w) w) nil)))
11 ; width = zur Verfügung stehende Zeichen ohne Vorzeichen
12 (multiple-value-bind (digits digitslength leadingpoint trailingpoint)
13 (format-float-to-string arg width d k nil)
14 (when (eql d 0) (setq trailingpoint nil)) ; d=0 -> keine Zusatz-Null hinten
16 (setq width (- width digitslength))
17 (when leadingpoint ; evtl. Zusatz-Null vorne einplanen
18 (if (> width 0) (setq width (1- width)) (setq leadingpoint nil))
20 (when trailingpoint ; evtl. Zusatz-Null hinten einplanen
21 (if (> width 0) (setq width (1- width)) (setq trailingpoint nil))
24 ; Es bleiben noch width Zeichen übrig.
25 (if (and overflowchar w (minusp width))
26 (format-padding w overflowchar stream) ; Zu wenig Platz -> overflow
28 (when (and w (> width 0)) (format-padding width padchar stream))
30 (write-char #\- stream)
31 (if plus-sign-flag (write-char #\+ stream))
33 (when leadingpoint (write-char #\0 stream))
34 (write-string digits stream)
35 (when trailingpoint (write-char #\0 stream))
39 ; (format-float-for-e w d e k overflowchar padchar exponentchar plus-sign-flag
41 ; gibt die Floating-point-Zahl arg in Exponentialdarstellung auf den stream aus.
42 ; (vgl. CLTL S.392-394)
43 ; Aufteilung der Mantisse:
44 ; Falls k<=0, erst 1 Null (falls von der Breite her passend), dann der Punkt,
45 ; dann |k| Nullen, dann d-|k| signifikante Stellen;
46 ; zusammen also d Nachkommastellen.
47 ; Falls k>0, erst k signifikante Stellen, dann der Punkt,
48 ; dann weitere d-k+1 signifikante Stellen;
49 ; zusammen also d+1 signifikante Stellen. Keine Nullen vorne.
50 ; (Der Defaultwert in FORMAT-EXPONENTIAL-FLOAT ist k=1.)
51 ; Vor der Mantisse das Vorzeichen (ein + nur falls arg>=0 und plus-sign-flag).
52 ; Dann der Exponent, eingeleitet durch exponentchar, dann Vorzeichen des
53 ; Exponenten (stets + oder -), dann e Stellen für den Exponenten.
54 ; Dann wird das Ganze mit padchars auf w Zeichen Breite aufgefüllt.
55 ; Sollte das (auch nach evtl. Unterdrückung einer führenden Null) mehr als
56 ; w Zeichen ergeben, so werden statt dessen w overflowchars ausgegeben, oder
57 ; (falls overflowchar = nil) die Zahl mit so vielen Stellen wie nötig
59 (defun format-float-for-e (w d e k
60 overflowchar padchar exponentchar plus-sign-flag arg stream)
61 (multiple-value-bind (mantissa oldexponent) (format-scale-exponent (abs arg))
62 (let* ((exponent (if (zerop arg) 0 (- oldexponent k))) ; auszugebender Exponent
63 (expdigits (write-to-string (abs exponent) :base 10. :radix nil :readably nil))
64 (expdigitsneed (if e (max (length expdigits) e) (length expdigits)))
65 ; expdigitsneed = Anzahl der Stellen, die für die Ziffern des
66 ; Exponenten nötig sind.
67 (mantd (if d (if (> k 0) (1+ (- d k)) d) nil))
68 ; mantd = Anzahl der Mantissenstellen hinter dem Punkt
69 (dmin (if (minusp k) (- 1 k) nil)) ; nachher: fordere, daß
70 ; nicht in die ersten (+ 1 (abs k)) Stellen hineingerundet wird.
71 (mantwidth (if w (- w 2 expdigitsneed) nil))
72 ; mantwidth = Anzahl der für die Mantisse (inkl. Vorzeichen, Punkt)
73 ; zur Verfügung stehenden Zeichen (oder nil)
75 (declare (simple-string expdigits) (fixnum exponent expdigitsneed))
76 (if (and overflowchar w e (> expdigitsneed e))
77 ; Falls Overflowchar und w und e angegeben, Exponent mehr braucht:
78 (format-padding w overflowchar stream)
81 (if (or plus-sign-flag (minusp arg)) (setq mantwidth (1- mantwidth)))
83 ; mantwidth = Anzahl der für die Mantisse (ohne Vorzeichen,
84 ; inklusive Punkt) zur Verfügung stehenden Zeichen (oder nil)
85 (multiple-value-bind (mantdigits mantdigitslength
86 leadingpoint trailingpoint)
87 (format-float-to-string mantissa mantwidth mantd k dmin)
89 (setq mantwidth (- mantwidth mantdigitslength))
91 (if (or (null mantd) (> mantd 0))
92 (setq mantwidth (- mantwidth 1))
93 (setq trailingpoint nil)
97 (setq mantwidth (- mantwidth 1))
98 (setq leadingpoint nil)
101 ; Es bleiben noch mantwidth Zeichen übrig.
102 (if (and overflowchar w (minusp mantwidth))
103 (format-padding w overflowchar stream) ; Zu wenig Platz -> overflow
105 (when (and w (> mantwidth 0))
106 (format-padding mantwidth padchar stream)
109 (write-char #\- stream)
110 (if plus-sign-flag (write-char #\+ stream))
112 (if leadingpoint (write-char #\0 stream))
113 (write-string mantdigits stream)
114 (if trailingpoint (write-char #\0 stream))
117 ((and (not *PRINT-READABLY*)
118 (typep arg *READ-DEFAULT-FLOAT-FORMAT*)
122 ((short-float-p arg) #\s)
123 ((single-float-p arg) #\f)
124 ((double-float-p arg) #\d)
125 ((long-float-p arg) #\L)
129 (write-char (if (minusp exponent) #\- #\+) stream)
130 (when (and e (> e (length expdigits)))
131 (format-padding (- e (length expdigits)) #\0 stream)
133 (write-string expdigits stream)
138 ; ~F, CLTL S.390-392, CLtL2 S. 588-590
139 (defformat-simple format-fixed-float (stream colon-modifier atsign-modifier
140 (w nil) (d nil) (k 0) (overflowchar nil) (padchar #\Space))
142 (declare (ignore colon-modifier))
143 (when (rationalp arg) (setq arg (float arg)))
145 (format-float-for-f w d k overflowchar padchar atsign-modifier arg stream)
146 (print_rational arg stream 10)
149 ; ~E, CLTL S.392-395, CLtL2 S. 590-593
150 (defformat-simple format-exponential-float (stream colon-modifier atsign-modifier
151 (w nil) (d nil) (e nil) (k 1)
152 (overflowchar nil) (padchar #\Space) (exponentchar nil))
154 (declare (ignore colon-modifier))
155 (when (rationalp arg) (setq arg (float arg)))
157 (format-float-for-e w d e k overflowchar padchar exponentchar
158 atsign-modifier arg stream
160 (print_rational arg stream 10)
163 ; ~G, CLTL S.395-396, CLtL2 S. 594-595
164 (defformat-simple format-general-float (stream colon-modifier atsign-modifier
165 (w nil) (d nil) (e nil) (k 1)
166 (overflowchar nil) (padchar #\Space) (exponentchar nil))
168 (declare (ignore colon-modifier))
169 (if (rationalp arg) (setq arg (float arg)))
171 (multiple-value-bind (mantissa n) (format-scale-exponent (abs arg))
172 (declare (ignore mantissa))
175 (multiple-value-bind (digits digitslength)
176 (format-float-to-string (abs arg) nil nil nil nil)
177 (declare (ignore digits))
178 (max (max (1- digitslength) 1) (min n 7))
180 (let* ((ee (if e (+ 2 e) 4))
187 overflowchar padchar atsign-modifier arg stream
189 (format-padding ee #\Space stream)
191 (format-float-for-e w d e k overflowchar padchar exponentchar
192 atsign-modifier arg stream
194 (print_rational arg stream 10)
197 ; ~$, CLTL S.396-397, CLtL2 S. 595-596
198 (defformat-simple format-dollars-float (stream colon-modifier atsign-modifier
199 (d 2) (n 1) (w 0) (padchar #\Space))
201 (when (rationalp arg) (setq arg (float arg)))
203 (multiple-value-bind (digits digitslength
204 leadingpoint trailingpoint leadings)
205 (format-float-to-string arg nil d 0 nil)
206 (declare (ignore digitslength leadingpoint trailingpoint))
207 (let* ((lefts (max leadings n))
208 (totalwidth (+ (if (or atsign-modifier (minusp arg)) 1 0)
211 (padcount (max (- w totalwidth) 0)))
212 (if (not colon-modifier) (format-padding padcount padchar stream))
214 (write-char #\- stream)
215 (if atsign-modifier (write-char #\+ stream))
217 (if colon-modifier (format-padding padcount padchar stream))
218 (format-padding (- lefts leadings) #\0 stream)
219 (write-string digits stream)
221 (print_rational arg stream 10)