Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT RUN-TIME COMPONENTS                         --

--                                                                          --

--                 A D A . T E X T _ I O . F I X E D _ I O                  --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --

--                                                                          --

-- As a special exception under Section 7 of GPL version 3, you are granted --

-- additional permissions described in the GCC Runtime Library Exception,   --

-- version 3.1, as published by the Free Software Foundation.               --

--                                                                          --

-- You should have received a copy of the GNU General Public License and    --

-- a copy of the GCC Runtime Library Exception along with this program;     --

-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --

-- <http://www.gnu.org/licenses/>.                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

--  Fixed point I/O

--  ---------------

--  The following documents implementation details of the fixed point

--  input/output routines in the GNAT run time. The first part describes

--  general properties of fixed point types as defined by the Ada 95 standard,

--  including the Information Systems Annex.

--  Subsequently these are reduced to implementation constraints and the impact

--  of these constraints on a few possible approaches to I/O are given.

--  Based on this analysis, a specific implementation is selected for use in

--  the GNAT run time. Finally, the chosen algorithm is analyzed numerically in

--  order to provide user-level documentation on limits for range and precision

--  of fixed point types as well as accuracy of input/output conversions.

--  -------------------------------------------

--  - General Properties of Fixed Point Types -

--  -------------------------------------------

--  Operations on fixed point values, other than input and output, are not

--  important for the purposes of this document. Only the set of values that a

--  fixed point type can represent and the input and output operations are

--  significant.

--  Values

--  ------

--  Set set of values of a fixed point type comprise the integral

--  multiples of a number called the small of the type. The small can

--  either be a power of ten, a power of two or (if the implementation

--  allows) an arbitrary strictly positive real value.

--  Implementations need to support fixed-point types with a precision

--  of at least 24 bits, and (in order to comply with the Information

--  Systems Annex) decimal types need to support at least digits 18.

--  For the rest, however, no requirements exist for the minimal small

--  and range that need to be supported.

--  Operations

--  ----------

--  'Image and 'Wide_Image (see RM 3.5(34))

--          These attributes return a decimal real literal best approximating

--          the value (rounded away from zero if halfway between) with a

--          single leading character that is either a minus sign or a space,

--          one or more digits before the decimal point (with no redundant

--          leading zeros), a decimal point, and N digits after the decimal

--          point. For a subtype S, the value of N is S'Aft, the smallest

--          positive integer such that (10**N)*S'Delta is greater or equal to

--          one, see RM 3.5.10(5).

--          For an arbitrary small, this means large number arithmetic needs

--          to be performed.

--  Put (see RM A.10.9(22-26))

--          The requirements for Put add no extra constraints over the image

--          attributes, although it would be nice to be able to output more

--          than S'Aft digits after the decimal point for values of subtype S.

--  'Value and 'Wide_Value attribute (RM 3.5(40-55))

--          Since the input can be given in any base in the range 2..16,

--          accurate conversion to a fixed point number may require

--          arbitrary precision arithmetic if there is no limit on the

--          magnitude of the small of the fixed point type.

--  Get (see RM A.10.9(12-21))

--          The requirements for Get are identical to those of the Value

--          attribute.

--  ------------------------------

--  - Implementation Constraints -

--  ------------------------------

--  The requirements listed above for the input/output operations lead to

--  significant complexity, if no constraints are put on supported smalls.

--  Implementation Strategies

--  -------------------------

--  * Float arithmetic

--  * Arbitrary-precision integer arithmetic

--  * Fixed-precision integer arithmetic

--  Although it seems convenient to convert fixed point numbers to floating-

--  point and then print them, this leads to a number of restrictions.

--  The first one is precision. The widest floating-point type generally

--  available has 53 bits of mantissa. This means that Fine_Delta cannot

--  be less than 2.0**(-53).

--  In GNAT, Fine_Delta is 2.0**(-63), and Duration for example is a

--  64-bit type. It would still be possible to use multi-precision

--  floating-point to perform calculations using longer mantissas,

--  but this is a much harder approach.

--  The base conversions needed for input and output of (non-decimal)

--  fixed point types can be seen as pairs of integer multiplications

--  and divisions.

--  Arbitrary-precision integer arithmetic would be suitable for the job

--  at hand, but has the draw-back that it is very heavy implementation-wise.

--  Especially in embedded systems, where fixed point types are often used,

--  it may not be desirable to require large amounts of storage and time

--  for fixed I/O operations.

--  Fixed-precision integer arithmetic has the advantage of simplicity and

--  speed. For the most common fixed point types this would be a perfect

--  solution. The downside however may be a too limited set of acceptable

--  fixed point types.

--  Extra Precision

--  ---------------

--  Using a scaled divide which truncates and returns a remainder R,

--  another E trailing digits can be calculated by computing the value

--  (R * (10.0**E)) / Z using another scaled divide. This procedure

--  can be repeated to compute an arbitrary number of digits in linear

--  time and storage. The last scaled divide should be rounded, with

--  a possible carry propagating to the more significant digits, to

--  ensure correct rounding of the unit in the last place.

--  An extension of this technique is to limit the value of Q to 9 decimal

--  digits, since 32-bit integers can be much more efficient than 64-bit

--  integers to output.

with Interfaces;                        use Interfaces;

with System.Arith_64;                   use System.Arith_64;

with System.Img_Real;                   use System.Img_Real;

with Ada.Text_IO;                       use Ada.Text_IO;

with Ada.Text_IO.Float_Aux;

with Ada.Text_IO.Generic_Aux;

package body Ada.Text_IO.Fixed_IO is

   --  Note: we still use the floating-point I/O routines for input of

   --  ordinary fixed-point and output using exponent format. This will

   --  result in inaccuracies for fixed point types with a small that is

   --  not a power of two, and for types that require more precision than

   --  is available in Long_Long_Float.

   package Aux renames Ada.Text_IO.Float_Aux;

   Extra_Layout_Space : constant Field := 5 + Num'Fore;

   --  Extra space that may be needed for output of sign, decimal point,

   --  exponent indication and mandatory decimals after and before the

   --  decimal point. A string with length

   --    Fore + Aft + Exp + Extra_Layout_Space

   --  is always long enough for formatting any fixed point number

   --  Implementation of Put routines

   --  The following section describes a specific implementation choice for

   --  performing base conversions needed for output of values of a fixed

   --  point type T with small T'Small. The goal is to be able to output

   --  all values of types with a precision of 64 bits and a delta of at

   --  least 2.0**(-63), as these are current GNAT limitations already.

   --  The chosen algorithm uses fixed precision integer arithmetic for

   --  reasons of simplicity and efficiency. It is important to understand

   --  in what ways the most simple and accurate approach to fixed point I/O

   --  is limiting, before considering more complicated schemes.

   --  Without loss of generality assume T has a range (-2.0**63) * T'Small

   --  .. (2.0**63 - 1) * T'Small, and is output with Aft digits after the

   --  decimal point and T'Fore - 1 before. If T'Small is integer, or

   --  1.0 / T'Small is integer, let S = T'Small and E = 0. For other T'Small,

   --  let S and E be integers such that S / 10**E best approximates T'Small

   --  and S is in the range 10**17 .. 10**18 - 1. The extra decimal scaling

   --  factor 10**E can be trivially handled during final output, by adjusting

   --  the decimal point or exponent.

   --  Convert a value X * S of type T to a 64-bit integer value Q equal

   --  to 10.0**D * (X * S) rounded to the nearest integer.

   --  This conversion is a scaled integer divide of the form

   --     Q := (X * Y) / Z,

   --  where all variables are 64-bit signed integers using 2's complement,

   --  and both the multiplication and division are done using full

   --  intermediate precision. The final decimal value to be output is

   --     Q * 10**(E-D)

   --  This value can be written to the output file or to the result string

   --  according to the format described in RM A.3.10. The details of this

   --  operation are omitted here.

   --  A 64-bit value can contain all integers with 18 decimal digits, but

   --  not all with 19 decimal digits. If the total number of requested output

   --  digits (Fore - 1) + Aft is greater than 18, for purposes of the

   --  conversion Aft is adjusted to 18 - (Fore - 1). In that case, or

   --  when Fore > 19, trailing zeros can complete the output after writing

   --  the first 18 significant digits, or the technique described in the

   --  next section can be used.

   --  The final expression for D is

   --     D :=  Integer'Max (-18, Integer'Min (Aft, 18 - (Fore - 1)));

   --  For Y and Z the following expressions can be derived:

   --     Q / (10.0**D) = X * S

   --     Q = X * S * (10.0**D) = (X * Y) / Z

   --     S * 10.0**D = Y / Z;

   --  If S is an integer greater than or equal to one, then Fore must be at

   --  least 20 in order to print T'First, which is at most -2.0**63.

   --  This means D < 0, so use

   --    (1)   Y = -S and Z = -10**(-D)

   --  If 1.0 / S is an integer greater than one, use

   --    (2)   Y = -10**D and Z = -(1.0 / S), for D >= 0

   --  or

   --    (3)   Y = 1 and Z = (1.0 / S) * 10**(-D), for D < 0

   --  Negative values are used for nominator Y and denominator Z, so that S

   --  can have a maximum value of 2.0**63 and a minimum of 2.0**(-63).

   --  For Z in -1 .. -9, Fore will still be 20, and D will be negative, as

   --  (-2.0**63) / -9 is greater than 10**18. In these cases there is room

   --  in the denominator for the extra decimal scaling required, so case (3)

   --  will not overflow.

   pragma Assert (System.Fine_Delta >= 2.0**(-63));

   pragma Assert (Num'Small in 2.0**(-63) .. 2.0**63);

   pragma Assert (Num'Fore <= 37);

   --  These assertions need to be relaxed to allow for a Small of

   --  2.0**(-64) at least, since there is an ACATS test for this ???

   Max_Digits : constant := 18;

   --  Maximum number of decimal digits that can be represented in a

   --  64-bit signed number, see above

   --  The constants E0 .. E5 implement a binary search for the appropriate

   --  power of ten to scale the small so that it has one digit before the

   --  decimal point.

   subtype Int is Integer;

   E0 : constant Int := -(20 * Boolean'Pos (Num'Small >= 1.0E1));

   E1 : constant Int := E0 + 10 * Boolean'Pos (Num'Small * 10.0**E0 < 1.0E-10);

   E2 : constant Int := E1 +  5 * Boolean'Pos (Num'Small * 10.0**E1 < 1.0E-5);

   E3 : constant Int := E2 +  3 * Boolean'Pos (Num'Small * 10.0**E2 < 1.0E-3);

   E4 : constant Int := E3 +  2 * Boolean'Pos (Num'Small * 10.0**E3 < 1.0E-1);

   E5 : constant Int := E4 +  1 * Boolean'Pos (Num'Small * 10.0**E4 < 1.0E-0);

   Scale : constant Integer := E5;

   pragma Assert (Num'Small * 10.0**Scale >= 1.0

                   and then Num'Small * 10.0**Scale < 10.0);

   Exact : constant Boolean :=

            Float'Floor (Num'Small) = Float'Ceiling (Num'Small)

              or else Float'Floor (1.0 / Num'Small) =

                                Float'Ceiling (1.0 / Num'Small)

              or else Num'Small >= 10.0**Max_Digits;

   --  True iff a numerator and denominator can be calculated such that

   --  their ratio exactly represents the small of Num.

   procedure Put

     (To   : out String;

      Last : out Natural;

      Item : Num;

      Fore : Integer;

      Aft  : Field;

      Exp  : Field);

   --  Actual output function, used internally by all other Put routines.

   --  The formal Fore is an Integer, not a Field, because the routine is

   --  also called from the version of Put that performs I/O to a string,

   --  where the starting position depends on the size of the String, and

   --  bears no relation to the bounds of Field.

   ---------

   -- Get --

   ---------

   procedure Get

     (File  : File_Type;

      Item  : out Num;

      Width : Field := 0)

   is

      pragma Unsuppress (Range_Check);

   begin

      Aux.Get (File, Long_Long_Float (Item), Width);

   exception

      when Constraint_Error => raise Data_Error;

   end Get;

   procedure Get

     (Item  : out Num;

      Width : Field := 0)

   is

      pragma Unsuppress (Range_Check);

   begin

      Aux.Get (Current_In, Long_Long_Float (Item), Width);

   exception

      when Constraint_Error => raise Data_Error;

   end Get;

   procedure Get

     (From : String;

      Item : out Num;

      Last : out Positive)

   is

      pragma Unsuppress (Range_Check);

   begin

      Aux.Gets (From, Long_Long_Float (Item), Last);

   exception

      when Constraint_Error => raise Data_Error;

   end Get;

   ---------

   -- Put --

   ---------

   procedure Put

     (File : File_Type;

      Item : Num;

      Fore : Field := Default_Fore;

      Aft  : Field := Default_Aft;

      Exp  : Field := Default_Exp)

   is

      S    : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);

      Last : Natural;

   begin

      Put (S, Last, Item, Fore, Aft, Exp);

      Generic_Aux.Put_Item (File, S (1 .. Last));

   end Put;

   procedure Put

     (Item : Num;

      Fore : Field := Default_Fore;

      Aft  : Field := Default_Aft;

      Exp  : Field := Default_Exp)

   is

      S    : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);

      Last : Natural;

   begin

      Put (S, Last, Item, Fore, Aft, Exp);

      Generic_Aux.Put_Item (Text_IO.Current_Out, S (1 .. Last));

   end Put;

   procedure Put

     (To   : out String;

      Item : Num;

      Aft  : Field := Default_Aft;

      Exp  : Field := Default_Exp)

   is

      Fore : constant Integer :=

               To'Length

                 - 1                      -- Decimal point

                 - Field'Max (1, Aft)     -- Decimal part

                 - Boolean'Pos (Exp /= 0) -- Exponent indicator

                 - Exp;                   -- Exponent

      Last : Natural;

   begin

      if Fore - Boolean'Pos (Item < 0.0) < 1 then

         raise Layout_Error;

      end if;

      Put (To, Last, Item, Fore, Aft, Exp);

      if Last /= To'Last then

         raise Layout_Error;

      end if;

   end Put;

   procedure Put

     (To   : out String;

      Last : out Natural;

      Item : Num;

      Fore : Integer;

      Aft  : Field;

      Exp  : Field)

   is

      subtype Digit is Int64 range 0 .. 9;

      X   : constant Int64   := Int64'Integer_Value (Item);

      A   : constant Field   := Field'Max (Aft, 1);

      Neg : constant Boolean := (Item < 0.0);

      Pos : Integer := 0;  -- Next digit X has value X * 10.0**Pos;

      procedure Put_Character (C : Character);

      pragma Inline (Put_Character);

      --  Add C to the output string To, updating Last

      procedure Put_Digit (X : Digit);

      --  Add digit X to the output string (going from left to right), updating

      --  Last and Pos, and inserting the sign, leading zeros or a decimal

      --  point when necessary. After outputting the first digit, Pos must not

      --  be changed outside Put_Digit anymore.

      procedure Put_Int64 (X : Int64; Scale : Integer);

      --  Output the decimal number abs X * 10**Scale

      procedure Put_Scaled

        (X, Y, Z : Int64;

         A       : Field;

         E       : Integer);

      --  Output the decimal number (X * Y / Z) * 10**E, producing A digits

      --  after the decimal point and rounding the final digit. The value

      --  X * Y / Z is computed with full precision, but must be in the

      --  range of Int64.

      -------------------

      -- Put_Character --

      -------------------

      procedure Put_Character (C : Character) is

      begin

         Last := Last + 1;

         --  Never put a character outside of string To. Exception Layout_Error

         --  will be raised later if Last is greater than To'Last.

         if Last <= To'Last then

            To (Last) := C;

         end if;

      end Put_Character;

      ---------------

      -- Put_Digit --

      ---------------

      procedure Put_Digit (X : Digit) is

         Digs : constant array (Digit) of Character := "0123456789";

      begin

         if Last = To'First - 1 then

            if X /= 0 or else Pos <= 0 then

               --  Before outputting first digit, include leading space,

               --  possible minus sign and, if the first digit is fractional,

               --  decimal seperator and leading zeros.

               --  The Fore part has Pos + 1 + Boolean'Pos (Neg) characters,

               --  if Pos >= 0 and otherwise has a single zero digit plus minus

               --  sign if negative. Add leading space if necessary.

               for J in Integer'Max (0, Pos) + 2 + Boolean'Pos (Neg) .. Fore

               loop

                  Put_Character (' ');

               end loop;

               --  Output minus sign, if number is negative

               if Neg then

                  Put_Character ('-');

               end if;

               --  If starting with fractional digit, output leading zeros

               if Pos < 0 then

                  Put_Character ('0');

                  Put_Character ('.');

                  for J in Pos .. -2 loop

                     Put_Character ('0');

                  end loop;

               end if;

               Put_Character (Digs (X));

            end if;

         else

            --  This is not the first digit to be output, so the only

            --  special handling is that for the decimal point

            if Pos = -1 then

               Put_Character ('.');

            end if;

            Put_Character (Digs (X));

         end if;

         Pos := Pos - 1;

      end Put_Digit;

      ---------------

      -- Put_Int64 --

      ---------------

      procedure Put_Int64 (X : Int64; Scale : Integer) is

      begin

         if X = 0 then

            return;

         end if;

         if X not in -9 .. 9 then

            Put_Int64 (X / 10, Scale + 1);

         end if;

         --  Use Put_Digit to advance Pos. This fixes a case where the second

         --  or later Scaled_Divide would omit leading zeroes, resulting in

         --  too few digits produced and a Layout_Error as result.

         while Pos > Scale loop

            Put_Digit (0);

         end loop;

         --  If and only if more than one digit is output before the decimal

         --  point, pos will be unequal to scale when outputting the first

         --  digit.

         pragma Assert (Pos = Scale or else Last = To'First - 1);

         Pos := Scale;

         Put_Digit (abs (X rem 10));

      end Put_Int64;

      ----------------

      -- Put_Scaled --

      ----------------

      procedure Put_Scaled

        (X, Y, Z : Int64;

         A       : Field;

         E       : Integer)

      is

         pragma Assert (E >= -Max_Digits);

         AA : constant Field := E + A;

         N  : constant Natural := (AA + Max_Digits - 1) / Max_Digits + 1;

         Q  : array (0 .. N - 1) of Int64 := (others => 0);

         --  Each element of Q has Max_Digits decimal digits, except the

         --  last, which has eAA rem Max_Digits. Only Q (Q'First) may have an

         --  absolute value equal to or larger than 10**Max_Digits. Only the

         --  absolute value of the elements is not significant, not the sign.

         XX : Int64 := X;

         YY : Int64 := Y;

      begin

         for J in Q'Range loop

            exit when XX = 0;

            if J > 0 then

               YY := 10**(Integer'Min (Max_Digits, AA - (J - 1) * Max_Digits));

            end if;

            Scaled_Divide (XX, YY, Z, Q (J), R => XX, Round => False);

         end loop;

         if -E > A then

            pragma Assert (N = 1);

            Discard_Extra_Digits : declare

               Factor : constant Int64 := 10**(-E - A);

            begin

               --  The scaling factors were such that the first division

               --  produced more digits than requested. So divide away extra

               --  digits and compute new remainder for later rounding.

               if abs (Q (0) rem Factor) >= Factor / 2 then

                  Q (0) := abs (Q (0) / Factor) + 1;

               else

                  Q (0) := Q (0) / Factor;

               end if;

               XX := 0;

            end Discard_Extra_Digits;

         end if;

         --  At this point XX is a remainder and we need to determine if the

         --  quotient in Q must be rounded away from zero.

         --  As XX is less than the divisor, it is safe to take its absolute

         --  without chance of overflow. The check to see if XX is at least

         --  half the absolute value of the divisor must be done carefully to

         --  avoid overflow or lose precision.

         XX := abs XX;

         if XX >= 2**62

            or else (Z < 0 and then (-XX) * 2 <= Z)

            or else (Z >= 0 and then XX * 2 >= Z)

         then

            --  OK, rounding is necessary. As the sign is not significant,

            --  take advantage of the fact that an extra negative value will

            --  always be available when propagating the carry.

            Q (Q'Last) := -abs Q (Q'Last) - 1;

            Propagate_Carry :

            for J in reverse 1 .. Q'Last loop

               if Q (J) = YY or else Q (J) = -YY then

                  Q (J) := 0;

                  Q (J - 1) := -abs Q (J - 1) - 1;

               else

                  exit Propagate_Carry;

               end if;

            end loop Propagate_Carry;

         end if;

         for J in Q'First .. Q'Last - 1 loop

            Put_Int64 (Q (J), E - J * Max_Digits);

         end loop;

         Put_Int64 (Q (Q'Last), -A);

      end Put_Scaled;

   --  Start of processing for Put

   begin

      Last := To'First - 1;

      if Exp /= 0 then

         --  With the Exp format, it is not known how many output digits to

         --  generate, as leading zeros must be ignored. Computing too many

         --  digits and then truncating the output will not give the closest

         --  output, it is necessary to round at the correct digit.

         --  The general approach is as follows: as long as no digits have

         --  been generated, compute the Aft next digits (without rounding).

         --  Once a non-zero digit is generated, determine the exact number

         --  of digits remaining and compute them with rounding.

         --  Since a large number of iterations might be necessary in case

         --  of Aft = 1, the following optimization would be desirable.

         --  Count the number Z of leading zero bits in the integer

         --  representation of X, and start with producing Aft + Z * 1000 /

         --  3322 digits in the first scaled division.

         --  However, the floating-point routines are still used now ???

         System.Img_Real.Set_Image_Real (Long_Long_Float (Item), To, Last,

            Fore, Aft, Exp);

         return;

      end if;

      if Exact then

         declare

            D : constant Integer := Integer'Min (A, Max_Digits

                                                            - (Num'Fore - 1));

            Y : constant Int64   := Int64'Min (Int64 (-Num'Small), -1)

                                     * 10**Integer'Max (0, D);

            Z : constant Int64   := Int64'Min (Int64 (-(1.0 / Num'Small)), -1)

                                     * 10**Integer'Max (0, -D);

         begin

            Put_Scaled (X, Y, Z, A, -D);

         end;

      else -- not Exact

         declare

            E : constant Integer := Max_Digits - 1 + Scale;

            D : constant Integer := Scale - 1;

            Y : constant Int64   := Int64 (-Num'Small * 10.0**E);

            Z : constant Int64   := -10**Max_Digits;

         begin

            Put_Scaled (X, Y, Z, A, -D);

         end;

      end if;

      --  If only zero digits encountered, unit digit has not been output yet

      if Last < To'First then

         Pos := 0;

      elsif Last > To'Last then

         raise Layout_Error; -- Not enough room in the output variable

      end if;

      --  Always output digits up to the first one after the decimal point

      while Pos >= -A loop

         Put_Digit (0);

      end loop;

   end Put;

end Ada.Text_IO.Fixed_IO;