Mark ChangeLog
[official-gcc.git] / gcc / ada / a-tifiio.adb
blob75d46fe98a1852e3a99bf258e341067bf99bacbc
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- A D A . T E X T _ I O . F I X E D _ I O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
10 -- --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
21 -- --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
28 -- --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 -- --
32 ------------------------------------------------------------------------------
34 -- Fixed point I/O
35 -- ---------------
37 -- The following documents implementation details of the fixed point
38 -- input/output routines in the GNAT run time. The first part describes
39 -- general properties of fixed point types as defined by the Ada 95 standard,
40 -- including the Information Systems Annex.
42 -- Subsequently these are reduced to implementation constraints and the impact
43 -- of these constraints on a few possible approaches to I/O are given.
44 -- Based on this analysis, a specific implementation is selected for use in
45 -- the GNAT run time. Finally, the chosen algorithm is analyzed numerically in
46 -- order to provide user-level documentation on limits for range and precision
47 -- of fixed point types as well as accuracy of input/output conversions.
49 -- -------------------------------------------
50 -- - General Properties of Fixed Point Types -
51 -- -------------------------------------------
53 -- Operations on fixed point values, other than input and output, are not
54 -- important for the purposes of this document. Only the set of values that a
55 -- fixed point type can represent and the input and output operations are
56 -- significant.
58 -- Values
59 -- ------
61 -- Set set of values of a fixed point type comprise the integral
62 -- multiples of a number called the small of the type. The small can
63 -- either be a power of ten, a power of two or (if the implementation
64 -- allows) an arbitrary strictly positive real value.
66 -- Implementations need to support fixed-point types with a precision
67 -- of at least 24 bits, and (in order to comply with the Information
68 -- Systems Annex) decimal types need to support at least digits 18.
69 -- For the rest, however, no requirements exist for the minimal small
70 -- and range that need to be supported.
72 -- Operations
73 -- ----------
75 -- 'Image and 'Wide_Image (see RM 3.5(34))
77 -- These attributes return a decimal real literal best approximating
78 -- the value (rounded away from zero if halfway between) with a
79 -- single leading character that is either a minus sign or a space,
80 -- one or more digits before the decimal point (with no redundant
81 -- leading zeros), a decimal point, and N digits after the decimal
82 -- point. For a subtype S, the value of N is S'Aft, the smallest
83 -- positive integer such that (10**N)*S'Delta is greater or equal to
84 -- one, see RM 3.5.10(5).
86 -- For an arbitrary small, this means large number arithmetic needs
87 -- to be performed.
89 -- Put (see RM A.10.9(22-26))
91 -- The requirements for Put add no extra constraints over the image
92 -- attributes, although it would be nice to be able to output more
93 -- than S'Aft digits after the decimal point for values of subtype S.
95 -- 'Value and 'Wide_Value attribute (RM 3.5(40-55))
97 -- Since the input can be given in any base in the range 2..16,
98 -- accurate conversion to a fixed point number may require
99 -- arbitrary precision arithmetic if there is no limit on the
100 -- magnitude of the small of the fixed point type.
102 -- Get (see RM A.10.9(12-21))
104 -- The requirements for Get are identical to those of the Value
105 -- attribute.
107 -- ------------------------------
108 -- - Implementation Constraints -
109 -- ------------------------------
111 -- The requirements listed above for the input/output operations lead to
112 -- significant complexity, if no constraints are put on supported smalls.
114 -- Implementation Strategies
115 -- -------------------------
117 -- * Float arithmetic
118 -- * Arbitrary-precision integer arithmetic
119 -- * Fixed-precision integer arithmetic
121 -- Although it seems convenient to convert fixed point numbers to floating-
122 -- point and then print them, this leads to a number of restrictions.
123 -- The first one is precision. The widest floating-point type generally
124 -- available has 53 bits of mantissa. This means that Fine_Delta cannot
125 -- be less than 2.0**(-53).
127 -- In GNAT, Fine_Delta is 2.0**(-63), and Duration for example is a
128 -- 64-bit type. It would still be possible to use multi-precision
129 -- floating-point to perform calculations using longer mantissas,
130 -- but this is a much harder approach.
132 -- The base conversions needed for input and output of (non-decimal)
133 -- fixed point types can be seen as pairs of integer multiplications
134 -- and divisions.
136 -- Arbitrary-precision integer arithmetic would be suitable for the job
137 -- at hand, but has the draw-back that it is very heavy implementation-wise.
138 -- Especially in embedded systems, where fixed point types are often used,
139 -- it may not be desirable to require large amounts of storage and time
140 -- for fixed I/O operations.
142 -- Fixed-precision integer arithmetic has the advantage of simplicity and
143 -- speed. For the most common fixed point types this would be a perfect
144 -- solution. The downside however may be a too limited set of acceptable
145 -- fixed point types.
147 -- Extra Precision
148 -- ---------------
150 -- Using a scaled divide which truncates and returns a remainder R,
151 -- another E trailing digits can be calculated by computing the value
152 -- (R * (10.0**E)) / Z using another scaled divide. This procedure
153 -- can be repeated to compute an arbitrary number of digits in linear
154 -- time and storage. The last scaled divide should be rounded, with
155 -- a possible carry propagating to the more significant digits, to
156 -- ensure correct rounding of the unit in the last place.
158 -- An extension of this technique is to limit the value of Q to 9 decimal
159 -- digits, since 32-bit integers can be much more efficient than 64-bit
160 -- integers to output.
162 with Interfaces; use Interfaces;
163 with System.Arith_64; use System.Arith_64;
164 with System.Img_Real; use System.Img_Real;
165 with Ada.Text_IO; use Ada.Text_IO;
166 with Ada.Text_IO.Float_Aux;
167 with Ada.Text_IO.Generic_Aux;
169 package body Ada.Text_IO.Fixed_IO is
171 -- Note: we still use the floating-point I/O routines for input of
172 -- ordinary fixed-point and output using exponent format. This will
173 -- result in inaccuracies for fixed point types with a small that is
174 -- not a power of two, and for types that require more precision than
175 -- is available in Long_Long_Float.
177 package Aux renames Ada.Text_IO.Float_Aux;
179 Extra_Layout_Space : constant Field := 5 + Num'Fore;
180 -- Extra space that may be needed for output of sign, decimal point,
181 -- exponent indication and mandatory decimals after and before the
182 -- decimal point. A string with length
184 -- Fore + Aft + Exp + Extra_Layout_Space
186 -- is always long enough for formatting any fixed point number.
188 -- Implementation of Put routines
190 -- The following section describes a specific implementation choice for
191 -- performing base conversions needed for output of values of a fixed
192 -- point type T with small T'Small. The goal is to be able to output
193 -- all values of types with a precision of 64 bits and a delta of at
194 -- least 2.0**(-63), as these are current GNAT limitations already.
196 -- The chosen algorithm uses fixed precision integer arithmetic for
197 -- reasons of simplicity and efficiency. It is important to understand
198 -- in what ways the most simple and accurate approach to fixed point I/O
199 -- is limiting, before considering more complicated schemes.
201 -- Without loss of generality assume T has a range (-2.0**63) * T'Small
202 -- .. (2.0**63 - 1) * T'Small, and is output with Aft digits after the
203 -- decimal point and T'Fore - 1 before. If T'Small is integer, or
204 -- 1.0 / T'Small is integer, let S = T'Small and E = 0. For other T'Small,
205 -- let S and E be integers such that S / 10**E best approximates T'Small
206 -- and S is in the range 10**17 .. 10**18 - 1. The extra decimal scaling
207 -- factor 10**E can be trivially handled during final output, by adjusting
208 -- the decimal point or exponent.
210 -- Convert a value X * S of type T to a 64-bit integer value Q equal
211 -- to 10.0**D * (X * S) rounded to the nearest integer.
212 -- This conversion is a scaled integer divide of the form
214 -- Q := (X * Y) / Z,
216 -- where all variables are 64-bit signed integers using 2's complement,
217 -- and both the multiplication and division are done using full
218 -- intermediate precision. The final decimal value to be output is
220 -- Q * 10**(E-D)
222 -- This value can be written to the output file or to the result string
223 -- according to the format described in RM A.3.10. The details of this
224 -- operation are omitted here.
226 -- A 64-bit value can contain all integers with 18 decimal digits, but
227 -- not all with 19 decimal digits. If the total number of requested output
228 -- digits (Fore - 1) + Aft is greater than 18, for purposes of the
229 -- conversion Aft is adjusted to 18 - (Fore - 1). In that case, or
230 -- when Fore > 19, trailing zeros can complete the output after writing
231 -- the first 18 significant digits, or the technique described in the
232 -- next section can be used.
234 -- The final expression for D is
236 -- D := Integer'Max (-18, Integer'Min (Aft, 18 - (Fore - 1)));
238 -- For Y and Z the following expressions can be derived:
240 -- Q / (10.0**D) = X * S
242 -- Q = X * S * (10.0**D) = (X * Y) / Z
244 -- S * 10.0**D = Y / Z;
246 -- If S is an integer greater than or equal to one, then Fore must be at
247 -- least 20 in order to print T'First, which is at most -2.0**63.
248 -- This means D < 0, so use
250 -- (1) Y = -S and Z = -10**(-D).
252 -- If 1.0 / S is an integer greater than one, use
254 -- (2) Y = -10**D and Z = -(1.0 / S), for D >= 0
256 -- or
258 -- (3) Y = 1 and Z = (1.0 / S) * 10**(-D), for D < 0
260 -- Negative values are used for nominator Y and denominator Z, so that S
261 -- can have a maximum value of 2.0**63 and a minimum of 2.0**(-63).
262 -- For Z in -1 .. -9, Fore will still be 20, and D will be negative, as
263 -- (-2.0**63) / -9 is greater than 10**18. In these cases there is room
264 -- in the denominator for the extra decimal scaling required, so case (3)
265 -- will not overflow.
267 pragma Assert (System.Fine_Delta >= 2.0**(-63));
268 pragma Assert (Num'Small in 2.0**(-63) .. 2.0**63);
269 pragma Assert (Num'Fore <= 37);
270 -- These assertions need to be relaxed to allow for a Small of
271 -- 2.0**(-64) at least, since there is an ACATS test for this ???
273 Max_Digits : constant := 18;
274 -- Maximum number of decimal digits that can be represented in a
275 -- 64-bit signed number, see above
277 -- The constants E0 .. E5 implement a binary search for the appropriate
278 -- power of ten to scale the small so that it has one digit before the
279 -- decimal point.
281 subtype Int is Integer;
282 E0 : constant Int := -20 * Boolean'Pos (Num'Small >= 1.0E1);
283 E1 : constant Int := E0 + 10 * Boolean'Pos (Num'Small * 10.0**E0 < 1.0E-10);
284 E2 : constant Int := E1 + 5 * Boolean'Pos (Num'Small * 10.0**E1 < 1.0E-5);
285 E3 : constant Int := E2 + 3 * Boolean'Pos (Num'Small * 10.0**E2 < 1.0E-3);
286 E4 : constant Int := E3 + 2 * Boolean'Pos (Num'Small * 10.0**E3 < 1.0E-1);
287 E5 : constant Int := E4 + 1 * Boolean'Pos (Num'Small * 10.0**E4 < 1.0E-0);
289 Scale : constant Integer := E5;
291 pragma Assert (Num'Small * 10.0**Scale >= 1.0
292 and then Num'Small * 10.0**Scale < 10.0);
294 Exact : constant Boolean :=
295 Float'Floor (Num'Small) = Float'Ceiling (Num'Small)
296 or Float'Floor (1.0 / Num'Small) = Float'Ceiling (1.0 / Num'Small)
297 or Num'Small >= 10.0**Max_Digits;
298 -- True iff a numerator and denominator can be calculated such that
299 -- their ratio exactly represents the small of Num
301 -- Local Subprograms
303 procedure Put
304 (To : out String;
305 Last : out Natural;
306 Item : Num;
307 Fore : Field;
308 Aft : Field;
309 Exp : Field);
310 -- Actual output function, used internally by all other Put routines
312 ---------
313 -- Get --
314 ---------
316 procedure Get
317 (File : File_Type;
318 Item : out Num;
319 Width : Field := 0)
321 pragma Unsuppress (Range_Check);
323 begin
324 Aux.Get (File, Long_Long_Float (Item), Width);
326 exception
327 when Constraint_Error => raise Data_Error;
328 end Get;
330 procedure Get
331 (Item : out Num;
332 Width : Field := 0)
334 pragma Unsuppress (Range_Check);
336 begin
337 Aux.Get (Current_In, Long_Long_Float (Item), Width);
339 exception
340 when Constraint_Error => raise Data_Error;
341 end Get;
343 procedure Get
344 (From : String;
345 Item : out Num;
346 Last : out Positive)
348 pragma Unsuppress (Range_Check);
350 begin
351 Aux.Gets (From, Long_Long_Float (Item), Last);
353 exception
354 when Constraint_Error => raise Data_Error;
355 end Get;
357 ---------
358 -- Put --
359 ---------
361 procedure Put
362 (File : File_Type;
363 Item : Num;
364 Fore : Field := Default_Fore;
365 Aft : Field := Default_Aft;
366 Exp : Field := Default_Exp)
368 S : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);
369 Last : Natural;
370 begin
371 Put (S, Last, Item, Fore, Aft, Exp);
372 Generic_Aux.Put_Item (File, S (1 .. Last));
373 end Put;
375 procedure Put
376 (Item : Num;
377 Fore : Field := Default_Fore;
378 Aft : Field := Default_Aft;
379 Exp : Field := Default_Exp)
381 S : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);
382 Last : Natural;
383 begin
384 Put (S, Last, Item, Fore, Aft, Exp);
385 Generic_Aux.Put_Item (Text_IO.Current_Out, S (1 .. Last));
386 end Put;
388 procedure Put
389 (To : out String;
390 Item : Num;
391 Aft : Field := Default_Aft;
392 Exp : Field := Default_Exp)
394 Fore : constant Integer := To'Length
395 - 1 -- Decimal point
396 - Field'Max (1, Aft) -- Decimal part
397 - Boolean'Pos (Exp /= 0) -- Exponent indicator
398 - Exp; -- Exponent
399 Last : Natural;
401 begin
402 if Fore < 1 or else Fore > Field'Last then
403 raise Layout_Error;
404 end if;
406 Put (To, Last, Item, Fore, Aft, Exp);
408 if Last /= To'Last then
409 raise Layout_Error;
410 end if;
411 end Put;
413 procedure Put
414 (To : out String;
415 Last : out Natural;
416 Item : Num;
417 Fore : Field;
418 Aft : Field;
419 Exp : Field)
421 subtype Digit is Int64 range 0 .. 9;
423 X : constant Int64 := Int64'Integer_Value (Item);
424 A : constant Field := Field'Max (Aft, 1);
425 Neg : constant Boolean := (Item < 0.0);
426 Pos : Integer; -- Next digit X has value X * 10.0**Pos;
428 Y, Z : Int64;
429 E : constant Integer := Boolean'Pos (not Exact)
430 * (Max_Digits - 1 + Scale);
431 D : constant Integer := Boolean'Pos (Exact)
432 * Integer'Min (A, Max_Digits - (Num'Fore - 1))
433 + Boolean'Pos (not Exact)
434 * (Scale - 1);
436 procedure Put_Character (C : Character);
437 pragma Inline (Put_Character);
438 -- Add C to the output string To, updating Last
440 procedure Put_Digit (X : Digit);
441 -- Add digit X to the output string (going from left to right),
442 -- updating Last and Pos, and inserting the sign, leading zeros
443 -- or a decimal point when necessary. After outputting the first
444 -- digit, Pos must not be changed outside Put_Digit anymore
446 procedure Put_Int64 (X : Int64; Scale : Integer);
447 -- Output the decimal number X * 10**Scale
449 procedure Put_Scaled
450 (X, Y, Z : Int64;
451 A : Field;
452 E : Integer);
453 -- Output the decimal number (X * Y / Z) * 10**E, producing A digits
454 -- after the decimal point and rounding the final digit. The value
455 -- X * Y / Z is computed with full precision, but must be in the
456 -- range of Int64.
458 -------------------
459 -- Put_Character --
460 -------------------
462 procedure Put_Character (C : Character) is
463 begin
464 Last := Last + 1;
465 To (Last) := C;
466 end Put_Character;
468 ---------------
469 -- Put_Digit --
470 ---------------
472 procedure Put_Digit (X : Digit) is
473 Digs : constant array (Digit) of Character := "0123456789";
475 begin
476 if Last = To'First - 1 then
477 if X /= 0 or Pos <= 0 then
478 -- Before outputting first digit, include leading space,
479 -- possible minus sign and, if the first digit is fractional,
480 -- decimal seperator and leading zeros.
482 -- The Fore part has Pos + 1 + Boolean'Pos (Neg) characters,
483 -- if Pos >= 0 and otherwise has a single zero digit plus minus
484 -- sign if negative. Add leading space if necessary.
486 for J in Integer'Max (0, Pos) + 2 + Boolean'Pos (Neg) .. Fore
487 loop
488 Put_Character (' ');
489 end loop;
491 -- Output minus sign, if number is negative
493 if Neg then
494 Put_Character ('-');
495 end if;
497 -- If starting with fractional digit, output leading zeros
499 if Pos < 0 then
500 Put_Character ('0');
501 Put_Character ('.');
503 for J in Pos .. -2 loop
504 Put_Character ('0');
505 end loop;
506 end if;
508 Put_Character (Digs (X));
509 end if;
511 else
512 -- This is not the first digit to be output, so the only
513 -- special handling is that for the decimal point
515 if Pos = -1 then
516 Put_Character ('.');
517 end if;
519 Put_Character (Digs (X));
520 end if;
522 Pos := Pos - 1;
523 end Put_Digit;
525 ---------------
526 -- Put_Int64 --
527 ---------------
529 procedure Put_Int64 (X : Int64; Scale : Integer) is
530 begin
531 if X = 0 then
532 return;
533 end if;
535 Pos := Scale;
537 if X not in -9 .. 9 then
538 Put_Int64 (X / 10, Scale + 1);
539 end if;
541 Put_Digit (abs (X rem 10));
542 end Put_Int64;
544 ----------------
545 -- Put_Scaled --
546 ----------------
548 procedure Put_Scaled
549 (X, Y, Z : Int64;
550 A : Field;
551 E : Integer)
553 N : constant Natural := (A + Max_Digits - 1) / Max_Digits + 1;
554 Q : array (1 .. N) of Int64 := (others => 0);
556 XX : Int64 := X;
557 YY : Int64 := Y;
558 AA : Field := A;
560 begin
561 for J in Q'Range loop
562 exit when XX = 0;
564 Scaled_Divide (XX, YY, Z, Q (J), XX, Round => AA = 0);
566 -- As the last block of digits is rounded, a carry may have to
567 -- be propagated to the more significant digits. Since the last
568 -- block may have less than Max_Digits, the test for this block
569 -- is specialized.
571 -- The absolute value of the left-most digit block may equal
572 -- 10*Max_Digits, as no carry can be propagated from there.
573 -- The final output routines need to be prepared to handle
574 -- this specific case.
576 if (Q (J) = YY or -Q (J) = YY) and then J > Q'First then
577 if Q (J) < 0 then
578 Q (J - 1) := Q (J - 1) + 1;
579 else
580 Q (J - 1) := Q (J - 1) - 1;
581 end if;
583 Q (J) := 0;
585 Propagate_Carry :
586 for J in reverse Q'First + 1 .. Q'Last loop
587 if Q (J) >= 10**Max_Digits then
588 Q (J - 1) := Q (J - 1) + 1;
589 Q (J) := Q (J) - 10**Max_Digits;
591 elsif Q (J) <= -10**Max_Digits then
592 Q (J - 1) := Q (J - 1) - 1;
593 Q (J) := Q (J) + 10**Max_Digits;
594 end if;
595 end loop Propagate_Carry;
596 end if;
598 YY := -10**Integer'Min (Max_Digits, AA);
599 AA := AA - Integer'Min (Max_Digits, AA);
600 end loop;
602 for J in Q'First .. Q'Last - 1 loop
603 Put_Int64 (Q (J), E - (J - Q'First) * Max_Digits);
604 end loop;
606 Put_Int64 (Q (Q'Last), E - A);
607 end Put_Scaled;
609 -- Start of processing for Put
611 begin
612 Last := To'First - 1;
614 if Exp /= 0 then
616 -- With the Exp format, it is not known how many output digits to
617 -- generate, as leading zeros must be ignored. Computing too many
618 -- digits and then truncating the output will not give the closest
619 -- output, it is necessary to round at the correct digit.
621 -- The general approach is as follows: as long as no digits have
622 -- been generated, compute the Aft next digits (without rounding).
623 -- Once a non-zero digit is generated, determine the exact number
624 -- of digits remaining and compute them with rounding.
625 -- Since a large number of iterations might be necessary in case
626 -- of Aft = 1, the following optimization would be desirable.
627 -- Count the number Z of leading zero bits in the integer
628 -- representation of X, and start with producing
629 -- Aft + Z * 1000 / 3322 digits in the first scaled division.
631 -- However, the floating-point routines are still used now ???
633 System.Img_Real.Set_Image_Real (Long_Long_Float (Item), To, Last,
634 Fore, Aft, Exp);
635 return;
636 end if;
638 if Exact then
639 Y := Int64'Min (Int64 (-Num'Small), -1) * 10**Integer'Max (0, D);
640 Z := Int64'Min (Int64 (-1.0 / Num'Small), -1)
641 * 10**Integer'Max (0, -D);
642 else
643 Y := Int64 (-Num'Small * 10.0**E);
644 Z := -10**Max_Digits;
645 end if;
647 Put_Scaled (X, Y, Z, A - D, -D);
649 -- If only zero digits encountered, unit digit has not been output yet
651 if Last < To'First then
652 Pos := 0;
653 end if;
655 -- Always output digits up to the first one after the decimal point
657 while Pos >= -A loop
658 Put_Digit (0);
659 end loop;
660 end Put;
662 end Ada.Text_IO.Fixed_IO;