------------------------------------------------------------------------------ | |

-- -- | |

-- GNAT RUN-TIME COMPONENTS -- | |

-- -- | |

-- S Y S T E M . I M A G E _ F -- | |

-- -- | |

-- B o d y -- | |

-- -- | |

-- Copyright (C) 2020-2022, 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. -- | |

-- -- | |

------------------------------------------------------------------------------ | |

with System.Image_I; | |

with System.Img_Util; use System.Img_Util; | |

package body System.Image_F is | |

Maxdigs : constant Natural := Int'Width - 2; | |

-- Maximum number of decimal digits that can be represented in an Int. | |

-- The "-2" accounts for the sign and one extra digit, since we need the | |

-- maximum number of 9's that can be represented, e.g. for the 64-bit case, | |

-- Integer_64'Width is 20 since the maximum value is approximately 9.2E+18 | |

-- and has 19 digits, but the maximum number of 9's that can be represented | |

-- in Integer_64 is only 18. | |

-- The first prerequisite of the implementation is that the first scaled | |

-- divide does not overflow, which means that the absolute value of the | |

-- input X must always be smaller than 10**Maxdigs * 2**(Int'Size - 1). | |

-- Otherwise Constraint_Error is raised by the scaled divide operation. | |

-- The second prerequisite of the implementation is that the computation | |

-- of the operands does not overflow when the small is neither an integer | |

-- nor the reciprocal of an integer, which means that its numerator and | |

-- denominator must be smaller than 10**(2*Maxdigs-1) / 2**(Int'Size - 1) | |

-- if the small is larger than 1, and smaller than 2**(Int'Size - 1) / 10 | |

-- if the small is smaller than 1. | |

package Image_I is new System.Image_I (Int); | |

procedure Set_Image_Integer | |

(V : Int; | |

S : in out String; | |

P : in out Natural) | |

renames Image_I.Set_Image_Integer; | |

-- 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 fixed point types with a precision of 64 bits and a | |

-- small in the range 2.0**(-63) .. 2.0**63. The reasoning can easily | |

-- be adapted to fixed point types with a precision of 32 or 128 bits. | |

-- 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. | |

-- The idea is to 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, using only | |

-- a scaled integer divide of the form | |

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

-- where the variables X, Y, Z are 64-bit integers, and both multiplication | |

-- and division are done using full intermediate precision. Then the final | |

-- decimal value to be output is | |

-- Q * 10**(-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 represent all integers with 18 decimal digits, but | |

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

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

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

-- zeros can complete the output after writing the first 18 significant | |

-- digits, or the technique described in the next section can be used. | |

-- In addition, D cannot be smaller than -18, in order for 10.0**(-D) to | |

-- fit in a 64-bit integer. | |

-- 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 = X * S * (10.0**D) = (X * 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 that 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 | |

-- -(1.0 / S) 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. | |

-- In fact this reasoning can be generalized to most S which are the ratio | |

-- of two integers with bounded magnitude. Let S = Num / Den and rewrite | |

-- case (1) above where Den = 1 into | |

-- (1b) Y = -Num and Z = -Den * 10**(-D) | |

-- Suppose that Num corresponds to the maximum value of -D, i.e. 18 and | |

-- 10**(-D) = 10**18. If you change Den into 10, then S becomes 10 times | |

-- smaller and, therefore, Fore is decremented by 1, which means that -D | |

-- is as well, provided that Fore was initially not larger than 37, so the | |

-- multiplication for Z still does not overflow. But you need to reach 10 | |

-- to trigger this effect, which means that a leeway of 10 is required, so | |

-- let's restrict this to a Num for which 10**(-D) <= 10**17. To summarize | |

-- this case, if S is the ratio of two integers with | |

-- Den < Num <= B1 | |

-- where B1 is a fixed limit, then case (1b) does not overflow. B1 can be | |

-- taken as the largest integer Small such that D = -17, i.e. Fore = 36, | |

-- which means that B1 * 2.0**63 must be smaller than 10**35. | |

-- Let's continue and rewrite case (2) above when Num = 1 into | |

-- (2b) Y = -Num * 10**D and Z = -Den, for D >= 0 | |

-- Note that D <= 18 - (Fore - 1) and Fore >= 2 so D <= 17, thus you can | |

-- safely change Num into 10 in the product, but then S becomes 10 times | |

-- larger and, therefore, Fore is incremented by 1, which means that D is | |

-- decremented by 1 so you again have a product lesser or equal to 10**17. | |

-- To sum up, if S is the ratio of two integers with | |

-- Num <= Den * S0 | |

-- where S0 is the largest Small such that D >= 0, then case (2b) does not | |

-- overflow. | |

-- Let's conclude and rewrite case (3) above when Num = 1 into | |

-- (3b) Y = -Num and Z = -Den * 10**(-D), for D < 0 | |

-- As explained above, this occurs only if both S0 < S < 1 and D = -1 and | |

-- is preserved if you scale up Num and Den simultaneously, what you can | |

-- do until Den * 10 tops the upper bound. To sum up, if S is the ratio of | |

-- two integers with | |

-- Den * S0 < Num < Den <= B2 | |

-- where B2 is a fixed limit, then case (3b) does not overflow. B2 can be | |

-- taken as the largest integer such that B2 * 10 is smaller than 2.0**63. | |

-- The conclusion is that the algorithm works if the small is the ratio of | |

-- two integers in the range 1 .. 2**63 if either is equal to 1, or of two | |

-- integers in the range 1 .. B1 if the small is larger than 1, or of two | |

-- integers in the range 1 .. B2 if the small is smaller than 1. | |

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

-- another K trailing digits can be calculated by computing the value | |

-- (R * (10.0**K)) / 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. | |

----------------- | |

-- Image_Fixed -- | |

----------------- | |

procedure Image_Fixed | |

(V : Int; | |

S : in out String; | |

P : out Natural; | |

Num : Int; | |

Den : Int; | |

For0 : Natural; | |

Aft0 : Natural) | |

is | |

pragma Assert (S'First = 1); | |

begin | |

-- Add space at start for non-negative numbers | |

if V >= 0 then | |

S (1) := ' '; | |

P := 1; | |

else | |

P := 0; | |

end if; | |

Set_Image_Fixed (V, S, P, Num, Den, For0, Aft0, 1, Aft0, 0); | |

end Image_Fixed; | |

--------------------- | |

-- Set_Image_Fixed -- | |

--------------------- | |

procedure Set_Image_Fixed | |

(V : Int; | |

S : in out String; | |

P : in out Natural; | |

Num : Int; | |

Den : Int; | |

For0 : Natural; | |

Aft0 : Natural; | |

Fore : Natural; | |

Aft : Natural; | |

Exp : Natural) | |

is | |

pragma Assert (Num < 0 and then Den < 0); | |

-- Accept only negative numbers to allow -2**(Int'Size - 1) | |

A : constant Natural := | |

Boolean'Pos (Exp > 0) * Aft0 + Natural'Max (Aft, 1) + 1; | |

-- Number of digits after the decimal point to be computed. If Exp is | |

-- positive, we need to compute Aft decimal digits after the first non | |

-- zero digit and we are guaranteed there is at least one in the first | |

-- Aft0 digits (unless V is zero). In both cases, we compute one more | |

-- digit than requested so that Set_Decimal_Digits can round at Aft. | |

D : constant Integer := | |

Integer'Max (-Maxdigs, Integer'Min (A, Maxdigs - (For0 - 1))); | |

Y : constant Int := Num * 10**Integer'Max (0, D); | |

Z : constant Int := Den * 10**Integer'Max (0, -D); | |

-- See the description of the algorithm above | |

AF : constant Natural := A - D; | |

-- Number of remaining digits to be computed after the first round. It | |

-- is larger than A if the first round does not compute all the digits | |

-- before the decimal point, i.e. (For0 - 1) larger than Maxdigs. | |

N : constant Natural := 1 + (AF + Maxdigs - 1) / Maxdigs; | |

-- Number of rounds of scaled divide to be performed | |

Q : Int; | |

-- Quotient of the scaled divide in this round. Only the first round may | |

-- yield more than Maxdigs digits and has a significant sign. | |

Buf : String (1 .. Maxdigs); | |

Len : Natural; | |

-- Buffer for the image of the quotient | |

Digs : String (1 .. 2 + N * Maxdigs); | |

Ndigs : Natural; | |

-- Concatenated image of the successive quotients | |

Scale : Integer := 0; | |

-- Exponent such that the result is Digs (1 .. NDigs) * 10**(-Scale) | |

XX : Int := V; | |

YY : Int := Y; | |

-- First two operands of the scaled divide | |

begin | |

-- Set the first character like Image | |

if V >= 0 then | |

Digs (1) := ' '; | |

Ndigs := 1; | |

else | |

Ndigs := 0; | |

end if; | |

for J in 1 .. N loop | |

exit when XX = 0; | |

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

if J = 1 then | |

if Q /= 0 then | |

Set_Image_Integer (Q, Digs, Ndigs); | |

end if; | |

Scale := Scale + D; | |

-- Prepare for next round, if any | |

YY := 10**Maxdigs; | |

else | |

pragma Assert (-10**Maxdigs < Q and then Q < 10**Maxdigs); | |

Len := 0; | |

Set_Image_Integer (abs Q, Buf, Len); | |

pragma Assert (1 <= Len and then Len <= Maxdigs); | |

-- If no character but the space has been written, write the | |

-- minus if need be, since Set_Image_Integer did not do it. | |

if Ndigs <= 1 then | |

if Q /= 0 then | |

if Ndigs = 0 then | |

Digs (1) := '-'; | |

end if; | |

Digs (2 .. Len + 1) := Buf (1 .. Len); | |

Ndigs := Len + 1; | |

end if; | |

-- Or else pad the output with zeroes up to Maxdigs | |

else | |

for K in 1 .. Maxdigs - Len loop | |

Digs (Ndigs + K) := '0'; | |

end loop; | |

for K in 1 .. Len loop | |

Digs (Ndigs + Maxdigs - Len + K) := Buf (K); | |

end loop; | |

Ndigs := Ndigs + Maxdigs; | |

end if; | |

Scale := Scale + Maxdigs; | |

end if; | |

end loop; | |

-- If no digit was output, this is zero | |

if Ndigs <= 1 then | |

Digs (1 .. 2) := " 0"; | |

Ndigs := 2; | |

end if; | |

Set_Decimal_Digits (Digs, Ndigs, S, P, Scale, Fore, Aft, Exp); | |

end Set_Image_Fixed; | |

end System.Image_F; |