1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- S Y S T E M . I M G _ R E A L --
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with System.Img_LLU; use System.Img_LLU;
33 with System.Img_Uns; use System.Img_Uns;
34 with System.Powten_Table; use System.Powten_Table;
35 with System.Unsigned_Types; use System.Unsigned_Types;
36 with System.Float_Control;
38 package body System.Img_Real is
40 -- The following defines the maximum number of digits that we can convert
41 -- accurately. This is limited by the precision of Long_Long_Float, and
42 -- also by the number of digits we can hold in Long_Long_Unsigned, which
43 -- is the integer type we use as an intermediate for the result.
45 -- We assume that in practice, the limitation will come from the digits
46 -- value, rather than the integer value. This is true for typical IEEE
47 -- implementations, and at worst, the only loss is for some precision
48 -- in very high precision floating-point output.
50 -- Note that in the following, the "-2" accounts for the sign and one
51 -- extra digits, since we need the maximum number of 9's that can be
52 -- supported, e.g. for the normal 64 bit case, Long_Long_Integer'Width
53 -- is 21, since the maximum value (approx 1.6 * 10**19) has 20 digits,
54 -- but the maximum number of 9's that can be supported is 19.
58 (Long_Long_Unsigned'Width - 2, Long_Long_Float'Digits);
60 Unsdigs : constant := Unsigned'Width - 2;
61 -- Number of digits that can be converted using type Unsigned
62 -- See above for the explanation of the -2.
64 Maxscaling : constant := 5000;
65 -- Max decimal scaling required during conversion of floating-point
66 -- numbers to decimal. This is used to defend against infinite
67 -- looping in the conversion, as can be caused by erroneous executions.
68 -- The largest exponent used on any current system is 2**16383, which
69 -- is approximately 10**4932, and the highest number of decimal digits
70 -- is about 35 for 128-bit floating-point formats, so 5000 leaves
71 -- enough room for scaling such values
73 function Is_Negative (V : Long_Long_Float) return Boolean;
74 pragma Import (Intrinsic, Is_Negative);
76 --------------------------
77 -- Image_Floating_Point --
78 --------------------------
80 procedure Image_Floating_Point
86 pragma Assert (S'First = 1);
89 -- Decide whether a blank should be prepended before the call to
90 -- Set_Image_Real. We generate a blank for positive values, and
91 -- also for positive zeroes. For negative zeroes, we generate a
92 -- space only if Signed_Zeroes is True (the RM only permits the
93 -- output of -0.0 on targets where this is the case). We can of
94 -- course still see a -0.0 on a target where Signed_Zeroes is
95 -- False (since this attribute refers to the proper handling of
96 -- negative zeroes, not to their existence).
98 if not Is_Negative (V)
99 or else (not Long_Long_Float'Signed_Zeros and then V = -0.0)
107 Set_Image_Real (V, S, P, 1, Digs - 1, 3);
108 end Image_Floating_Point;
110 --------------------------------
111 -- Image_Ordinary_Fixed_Point --
112 --------------------------------
114 procedure Image_Ordinary_Fixed_Point
115 (V : Long_Long_Float;
120 pragma Assert (S'First = 1);
123 -- Output space at start if non-negative
132 Set_Image_Real (V, S, P, 1, Aft, 0);
133 end Image_Ordinary_Fixed_Point;
139 procedure Set_Image_Real
140 (V : Long_Long_Float;
147 NFrac : constant Natural := Natural'Max (Aft, 1);
149 X : aliased Long_Long_Float;
150 -- This is declared aliased because the expansion of X'Valid passes
151 -- X by access and JGNAT requires all access parameters to be aliased.
152 -- The Valid attribute probably needs to be handled via a different
153 -- expansion for JGNAT, and this use of aliased should be removed
154 -- once Valid is handled properly. ???
158 Field_Max : constant := 255;
159 -- This should be the same value as Ada.[Wide_]Text_IO.Field'Last.
160 -- It is not worth dragging in Ada.Text_IO to pick up this value,
161 -- since it really should never be necessary to change it!
163 Digs : String (1 .. 2 * Field_Max + 16);
164 -- Array used to hold digits of converted integer value. This is a
165 -- large enough buffer to accommodate ludicrous values of Fore and Aft.
168 -- Number of digits stored in Digs (and also subscript of last digit)
170 procedure Adjust_Scale (S : Natural);
171 -- Adjusts the value in X by multiplying or dividing by a power of
172 -- ten so that it is in the range 10**(S-1) <= X < 10**S. Includes
173 -- adding 0.5 to round the result, readjusting if the rounding causes
174 -- the result to wander out of the range. Scale is adjusted to reflect
175 -- the power of ten used to divide the result (i.e. one is added to
176 -- the scale value for each division by 10.0, or one is subtracted
177 -- for each multiplication by 10.0).
179 procedure Convert_Integer;
180 -- Takes the value in X, outputs integer digits into Digs. On return,
181 -- Ndigs is set to the number of digits stored. The digits are stored
182 -- in Digs (1 .. Ndigs),
184 procedure Set (C : Character);
185 -- Sets character C in output buffer
187 procedure Set_Blanks_And_Sign (N : Integer);
188 -- Sets leading blanks and minus sign if needed. N is the number of
189 -- positions to be filled (a minus sign is output even if N is zero
190 -- or negative, but for a positive value, if N is non-positive, then
191 -- the call has no effect).
193 procedure Set_Digs (S, E : Natural);
194 -- Set digits S through E from Digs buffer. No effect if S > E
196 procedure Set_Special_Fill (N : Natural);
197 -- After outputting +Inf, -Inf or NaN, this routine fills out the
198 -- rest of the field with * characters. The argument is the number
199 -- of characters output so far (either 3 or 4)
201 procedure Set_Zeros (N : Integer);
202 -- Set N zeros, no effect if N is negative
205 pragma Inline (Set_Digs);
206 pragma Inline (Set_Zeros);
212 procedure Adjust_Scale (S : Natural) is
216 XP : Long_Long_Float;
219 -- Cases where scaling up is required
221 if X < Powten (S - 1) then
223 -- What we are looking for is a power of ten to multiply X by
224 -- so that the result lies within the required range.
227 XP := X * Powten (Maxpow);
228 exit when XP >= Powten (S - 1) or else Scale < -Maxscaling;
230 Scale := Scale - Maxpow;
233 -- The following exception is only raised in case of erroneous
234 -- execution, where a number was considered valid but still
235 -- fails to scale up. One situation where this can happen is
236 -- when a system which is supposed to be IEEE-compliant, but
237 -- has been reconfigured to flush denormals to zero.
239 if Scale < -Maxscaling then
240 raise Constraint_Error;
243 -- Here we know that we must multiply by at least 10**1 and that
244 -- 10**Maxpow takes us too far: binary search to find right one.
246 -- Because of roundoff errors, it is possible for the value
247 -- of XP to be just outside of the interval when Lo >= Hi. In
248 -- that case we adjust explicitly by a factor of 10. This
249 -- can only happen with a value that is very close to an
250 -- exact power of 10.
256 Mid := (Lo + Hi) / 2;
257 XP := X * Powten (Mid);
259 if XP < Powten (S - 1) then
270 elsif XP >= Powten (S) then
287 Scale := Scale - Mid;
289 -- Cases where scaling down is required
291 elsif X >= Powten (S) then
293 -- What we are looking for is a power of ten to divide X by
294 -- so that the result lies within the required range.
297 XP := X / Powten (Maxpow);
298 exit when XP < Powten (S) or else Scale > Maxscaling;
300 Scale := Scale + Maxpow;
303 -- The following exception is only raised in case of erroneous
304 -- execution, where a number was considered valid but still
305 -- fails to scale up. One situation where this can happen is
306 -- when a system which is supposed to be IEEE-compliant, but
307 -- has been reconfigured to flush denormals to zero.
309 if Scale > Maxscaling then
310 raise Constraint_Error;
313 -- Here we know that we must divide by at least 10**1 and that
314 -- 10**Maxpow takes us too far, binary search to find right one.
320 Mid := (Lo + Hi) / 2;
321 XP := X / Powten (Mid);
323 if XP < Powten (S - 1) then
334 elsif XP >= Powten (S) then
351 Scale := Scale + Mid;
353 -- Here we are already scaled right
359 -- Round, readjusting scale if needed. Note that if a readjustment
360 -- occurs, then it is never necessary to round again, because there
361 -- is no possibility of such a second rounding causing a change.
365 if X >= Powten (S) then
372 ---------------------
373 -- Convert_Integer --
374 ---------------------
376 procedure Convert_Integer is
378 -- Use Unsigned routine if possible, since on many machines it will
379 -- be significantly more efficient than the Long_Long_Unsigned one.
381 if X < Powten (Unsdigs) then
384 (Unsigned (Long_Long_Float'Truncation (X)),
387 -- But if we want more digits than fit in Unsigned, we have to use
388 -- the Long_Long_Unsigned routine after all.
392 Set_Image_Long_Long_Unsigned
393 (Long_Long_Unsigned (Long_Long_Float'Truncation (X)),
402 procedure Set (C : Character) is
408 -------------------------
409 -- Set_Blanks_And_Sign --
410 -------------------------
412 procedure Set_Blanks_And_Sign (N : Integer) is
415 for J in 1 .. N - 1 loop
426 end Set_Blanks_And_Sign;
432 procedure Set_Digs (S, E : Natural) is
439 ----------------------
440 -- Set_Special_Fill --
441 ----------------------
443 procedure Set_Special_Fill (N : Natural) is
447 F := Fore + 1 + Aft - N;
456 end Set_Special_Fill;
462 procedure Set_Zeros (N : Integer) is
469 -- Start of processing for Set_Image_Real
472 -- We call the floating-point processor reset routine so that we can
473 -- be sure the floating-point processor is properly set for conversion
474 -- calls. This is notably need on Windows, where calls to the operating
475 -- system randomly reset the processor into 64-bit mode.
477 System.Float_Control.Reset;
481 -- Deal with invalid values first,
485 -- Note that we're taking our chances here, as V might be
486 -- an invalid bit pattern resulting from erroneous execution
487 -- (caused by using uninitialized variables for example).
489 -- No matter what, we'll at least get reasonable behaviour,
490 -- converting to infinity or some other value, or causing an
491 -- exception to be raised is fine.
493 -- If the following test succeeds, then we definitely have
494 -- an infinite value, so we print Inf.
496 if V > Long_Long_Float'Last then
501 Set_Special_Fill (4);
503 -- In all other cases we print NaN
505 elsif V < Long_Long_Float'First then
510 Set_Special_Fill (4);
516 Set_Special_Fill (3);
537 if Long_Long_Float'Signed_Zeros and then Is_Negative (V) then
543 Set_Blanks_And_Sign (Fore - 1);
551 Set_Zeros (Natural'Max (1, Exp - 1));
557 -- It should not be possible for a NaN to end up here.
558 -- Either the 'Valid test has failed, or we have some form
559 -- of erroneous execution. Raise Constraint_Error instead of
560 -- attempting to go ahead printing the value.
562 raise Constraint_Error;
565 -- X and Sign are set here, and X is known to be a valid,
566 -- non-zero floating-point number.
568 -- Case of non-zero value with Exp = 0
572 -- First step is to multiply by 10 ** Nfrac to get an integer
573 -- value to be output, an then add 0.5 to round the result.
576 NF : Natural := NFrac;
580 -- If we are larger than Powten (Maxdigs) now, then
581 -- we have too many significant digits, and we have
582 -- not even finished multiplying by NFrac (NF shows
583 -- the number of unaccounted-for digits).
585 if X >= Powten (Maxdigs) then
587 -- In this situation, we only to generate a reasonable
588 -- number of significant digits, and then zeroes after.
589 -- So first we rescale to get:
591 -- 10 ** (Maxdigs - 1) <= X < 10 ** Maxdigs
593 -- and then convert the resulting integer
595 Adjust_Scale (Maxdigs);
598 -- If that caused rescaling, then add zeros to the end
599 -- of the number to account for this scaling. Also add
600 -- zeroes to account for the undone multiplications
602 for J in 1 .. Scale + NF loop
609 -- If multiplication is complete, then convert the resulting
610 -- integer after rounding (note that X is non-negative)
617 -- Otherwise we can go ahead with the multiplication. If it
618 -- can be done in one step, then do it in one step.
620 elsif NF < Maxpow then
621 X := X * Powten (NF);
624 -- If it cannot be done in one step, then do partial scaling
627 X := X * Powten (Maxpow);
633 -- If number of available digits is less or equal to NFrac,
634 -- then we need an extra zero before the decimal point.
636 if Ndigs <= NFrac then
637 Set_Blanks_And_Sign (Fore - 1);
640 Set_Zeros (NFrac - Ndigs);
643 -- Normal case with some digits before the decimal point
646 Set_Blanks_And_Sign (Fore - (Ndigs - NFrac));
647 Set_Digs (1, Ndigs - NFrac);
649 Set_Digs (Ndigs - NFrac + 1, Ndigs);
652 -- Case of non-zero value with non-zero Exp value
655 -- If NFrac is less than Maxdigs, then all the fraction digits are
656 -- significant, so we can scale the resulting integer accordingly.
658 if NFrac < Maxdigs then
659 Adjust_Scale (NFrac + 1);
662 -- Otherwise, we get the maximum number of digits available
665 Adjust_Scale (Maxdigs);
668 for J in 1 .. NFrac - Maxdigs + 1 loop
675 Set_Blanks_And_Sign (Fore - 1);
680 -- The exponent is the scaling factor adjusted for the digits
681 -- that we output after the decimal point, since these were
682 -- included in the scaled digits that we output.
684 Expon := Scale + NFrac;
691 Set_Image_Unsigned (Unsigned (Expon), Digs, Ndigs);
694 Set_Image_Unsigned (Unsigned (-Expon), Digs, Ndigs);
697 Set_Zeros (Exp - Ndigs - 1);