| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- S Y S T E M . V A L _ R E A L -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2023, 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.Double_Real; |
| with System.Float_Control; |
| with System.Unsigned_Types; use System.Unsigned_Types; |
| with System.Val_Util; use System.Val_Util; |
| with System.Value_R; |
| |
| pragma Warnings (Off, "non-static constant in preelaborated unit"); |
| -- Every constant is static given our instantiation model |
| |
| package body System.Val_Real is |
| |
| pragma Assert (Num'Machine_Mantissa <= Uns'Size); |
| -- We need an unsigned type large enough to represent the mantissa |
| |
| Is_Large_Type : constant Boolean := Num'Machine_Mantissa >= 53; |
| -- True if the floating-point type is at least IEEE Double |
| |
| Precision_Limit : constant Uns := 2**Num'Machine_Mantissa - 1; |
| -- See below for the rationale |
| |
| package Impl is new Value_R (Uns, 2, Precision_Limit, Round => False); |
| |
| subtype Base_T is Unsigned range 2 .. 16; |
| |
| -- The following tables compute the maximum exponent of the base that can |
| -- fit in the given floating-point format, that is to say the element at |
| -- index N is the largest K such that N**K <= Num'Last. |
| |
| Maxexp32 : constant array (Base_T) of Positive := |
| [2 => 127, 3 => 80, 4 => 63, 5 => 55, 6 => 49, |
| 7 => 45, 8 => 42, 9 => 40, 10 => 55, 11 => 37, |
| 12 => 35, 13 => 34, 14 => 33, 15 => 32, 16 => 31]; |
| -- The actual value for 10 is 38 but we also use scaling for 10 |
| |
| Maxexp64 : constant array (Base_T) of Positive := |
| [2 => 1023, 3 => 646, 4 => 511, 5 => 441, 6 => 396, |
| 7 => 364, 8 => 341, 9 => 323, 10 => 441, 11 => 296, |
| 12 => 285, 13 => 276, 14 => 268, 15 => 262, 16 => 255]; |
| -- The actual value for 10 is 308 but we also use scaling for 10 |
| |
| Maxexp80 : constant array (Base_T) of Positive := |
| [2 => 16383, 3 => 10337, 4 => 8191, 5 => 7056, 6 => 6338, |
| 7 => 5836, 8 => 5461, 9 => 5168, 10 => 7056, 11 => 4736, |
| 12 => 4570, 13 => 4427, 14 => 4303, 15 => 4193, 16 => 4095]; |
| -- The actual value for 10 is 4932 but we also use scaling for 10 |
| |
| package Double_Real is new System.Double_Real (Num); |
| use type Double_Real.Double_T; |
| |
| subtype Double_T is Double_Real.Double_T; |
| -- The double floating-point type |
| |
| function Exact_Log2 (N : Unsigned) return Positive is |
| (case N is |
| when 2 => 1, |
| when 4 => 2, |
| when 8 => 3, |
| when 16 => 4, |
| when others => raise Program_Error); |
| -- Return the exponent of a power of 2 |
| |
| function Integer_to_Real |
| (Str : String; |
| Val : Impl.Value_Array; |
| Base : Unsigned; |
| Scale : Impl.Scale_Array; |
| Minus : Boolean) return Num; |
| -- Convert the real value from integer to real representation |
| |
| function Large_Powfive (Exp : Natural) return Double_T; |
| -- Return 5.0**Exp as a double number, where Exp > Maxpow |
| |
| function Large_Powfive (Exp : Natural; S : out Natural) return Double_T; |
| -- Return Num'Scaling (5.0**Exp, -S) as a double number where Exp > Maxexp |
| |
| --------------------- |
| -- Integer_to_Real -- |
| --------------------- |
| |
| function Integer_to_Real |
| (Str : String; |
| Val : Impl.Value_Array; |
| Base : Unsigned; |
| Scale : Impl.Scale_Array; |
| Minus : Boolean) return Num |
| is |
| pragma Assert (Base in 2 .. 16); |
| |
| pragma Assert (Num'Machine_Radix = 2); |
| |
| pragma Unsuppress (Range_Check); |
| |
| Maxexp : constant Positive := |
| (if Num'Size = 32 then Maxexp32 (Base) |
| elsif Num'Size = 64 then Maxexp64 (Base) |
| elsif Num'Machine_Mantissa = 64 then Maxexp80 (Base) |
| else raise Program_Error); |
| -- Maximum exponent of the base that can fit in Num |
| |
| D_Val : Double_T; |
| R_Val : Num; |
| S : Integer; |
| |
| begin |
| -- We call the floating-point processor reset routine so we can be sure |
| -- that the x87 FPU is properly set for conversions. This is especially |
| -- needed on Windows, where calls to the operating system randomly reset |
| -- the processor into 64-bit mode. |
| |
| if Num'Machine_Mantissa = 64 then |
| System.Float_Control.Reset; |
| end if; |
| |
| -- First convert the integer mantissa into a double real. The conversion |
| -- of each part is exact, given the precision limit we used above. Then, |
| -- if the contribution of the low part might be nonnull, scale the high |
| -- part appropriately and add the low part to the result. |
| |
| if Val (2) = 0 then |
| D_Val := Double_Real.To_Double (Num (Val (1))); |
| S := Scale (1); |
| |
| else |
| declare |
| V1 : constant Num := Num (Val (1)); |
| V2 : constant Num := Num (Val (2)); |
| |
| DS : Positive; |
| |
| begin |
| DS := Scale (1) - Scale (2); |
| |
| case Base is |
| -- If the base is a power of two, we use the efficient Scaling |
| -- attribute up to an amount worth a double mantissa. |
| |
| when 2 | 4 | 8 | 16 => |
| declare |
| L : constant Positive := Exact_Log2 (Base); |
| |
| begin |
| if DS <= 2 * Num'Machine_Mantissa / L then |
| DS := DS * L; |
| D_Val := |
| Double_Real.Quick_Two_Sum (Num'Scaling (V1, DS), V2); |
| S := Scale (2); |
| |
| else |
| D_Val := Double_Real.To_Double (V1); |
| S := Scale (1); |
| end if; |
| end; |
| |
| -- If the base is 10, we also scale up to an amount worth a |
| -- double mantissa. |
| |
| when 10 => |
| declare |
| Powfive : constant array (0 .. Maxpow) of Double_T; |
| pragma Import (Ada, Powfive); |
| for Powfive'Address use Powfive_Address; |
| |
| begin |
| if DS <= Maxpow then |
| D_Val := Powfive (DS) * Num'Scaling (V1, DS) + V2; |
| S := Scale (2); |
| |
| else |
| D_Val := Double_Real.To_Double (V1); |
| S := Scale (1); |
| end if; |
| end; |
| |
| -- Inaccurate implementation for other bases |
| |
| when others => |
| D_Val := Double_Real.To_Double (V1); |
| S := Scale (1); |
| end case; |
| end; |
| end if; |
| |
| -- Compute the final value by applying the scaling, if any |
| |
| if (Val (1) = 0 and then Val (2) = 0) or else S = 0 then |
| R_Val := Double_Real.To_Single (D_Val); |
| |
| else |
| case Base is |
| -- If the base is a power of two, we use the efficient Scaling |
| -- attribute with an overflow check, if it is not 2, to catch |
| -- ludicrous exponents that would result in an infinity or zero. |
| |
| when 2 | 4 | 8 | 16 => |
| declare |
| L : constant Positive := Exact_Log2 (Base); |
| |
| begin |
| if Integer'First / L <= S and then S <= Integer'Last / L then |
| S := S * L; |
| end if; |
| |
| R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S); |
| end; |
| |
| -- If the base is 10, we use a double implementation for the sake |
| -- of accuracy combining powers of 5 and scaling attribute. Using |
| -- this combination is better than using powers of 10 only because |
| -- the Large_Powfive function may overflow only if the final value |
| -- will also either overflow or underflow, thus making it possible |
| -- to use a single division for the case of negative powers of 10. |
| |
| when 10 => |
| declare |
| Powfive : constant array (0 .. Maxpow) of Double_T; |
| pragma Import (Ada, Powfive); |
| for Powfive'Address use Powfive_Address; |
| |
| RS : Natural; |
| |
| begin |
| if S > 0 then |
| if S <= Maxpow then |
| D_Val := D_Val * Powfive (S); |
| else |
| D_Val := D_Val * Large_Powfive (S); |
| end if; |
| |
| else |
| if S >= -Maxpow then |
| D_Val := D_Val / Powfive (-S); |
| |
| -- For small types, typically IEEE Single, the trick |
| -- described above does not fully work. |
| |
| elsif not Is_Large_Type and then S < -Maxexp then |
| D_Val := D_Val / Large_Powfive (-S, RS); |
| S := S - RS; |
| |
| else |
| D_Val := D_Val / Large_Powfive (-S); |
| end if; |
| end if; |
| |
| R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S); |
| end; |
| |
| -- Implementation for other bases with exponentiation |
| |
| -- When the exponent is positive, we can do the computation |
| -- directly because, if the exponentiation overflows, then |
| -- the final value overflows as well. But when the exponent |
| -- is negative, we may need to do it in two steps to avoid |
| -- an artificial underflow. |
| |
| when others => |
| declare |
| B : constant Num := Num (Base); |
| |
| begin |
| R_Val := Double_Real.To_Single (D_Val); |
| |
| if S > 0 then |
| R_Val := R_Val * B ** S; |
| |
| else |
| if S < -Maxexp then |
| R_Val := R_Val / B ** Maxexp; |
| S := S + Maxexp; |
| end if; |
| |
| R_Val := R_Val / B ** (-S); |
| end if; |
| end; |
| end case; |
| end if; |
| |
| -- Finally deal with initial minus sign, note that this processing is |
| -- done even if Uval is zero, so that -0.0 is correctly interpreted. |
| |
| return (if Minus then -R_Val else R_Val); |
| |
| exception |
| when Constraint_Error => Bad_Value (Str); |
| end Integer_to_Real; |
| |
| ------------------- |
| -- Large_Powfive -- |
| ------------------- |
| |
| function Large_Powfive (Exp : Natural) return Double_T is |
| Powfive : constant array (0 .. Maxpow) of Double_T; |
| pragma Import (Ada, Powfive); |
| for Powfive'Address use Powfive_Address; |
| |
| Powfive_100 : constant Double_T; |
| pragma Import (Ada, Powfive_100); |
| for Powfive_100'Address use Powfive_100_Address; |
| |
| Powfive_200 : constant Double_T; |
| pragma Import (Ada, Powfive_200); |
| for Powfive_200'Address use Powfive_200_Address; |
| |
| Powfive_300 : constant Double_T; |
| pragma Import (Ada, Powfive_300); |
| for Powfive_300'Address use Powfive_300_Address; |
| |
| R : Double_T; |
| E : Natural; |
| |
| begin |
| pragma Assert (Exp > Maxpow); |
| |
| if Is_Large_Type and then Exp >= 300 then |
| R := Powfive_300; |
| E := Exp - 300; |
| |
| elsif Is_Large_Type and then Exp >= 200 then |
| R := Powfive_200; |
| E := Exp - 200; |
| |
| elsif Is_Large_Type and then Exp >= 100 then |
| R := Powfive_100; |
| E := Exp - 100; |
| |
| else |
| R := Powfive (Maxpow); |
| E := Exp - Maxpow; |
| end if; |
| |
| while E > Maxpow loop |
| R := R * Powfive (Maxpow); |
| E := E - Maxpow; |
| end loop; |
| |
| R := R * Powfive (E); |
| |
| return R; |
| end Large_Powfive; |
| |
| function Large_Powfive (Exp : Natural; S : out Natural) return Double_T is |
| Maxexp : constant Positive := |
| (if Num'Size = 32 then Maxexp32 (5) |
| elsif Num'Size = 64 then Maxexp64 (5) |
| elsif Num'Machine_Mantissa = 64 then Maxexp80 (5) |
| else raise Program_Error); |
| -- Maximum exponent of 5 that can fit in Num |
| |
| Powfive : constant array (0 .. Maxpow) of Double_T; |
| pragma Import (Ada, Powfive); |
| for Powfive'Address use Powfive_Address; |
| |
| R : Double_T; |
| E : Natural; |
| |
| begin |
| pragma Assert (Exp > Maxexp); |
| |
| pragma Warnings (Off, "-gnatw.a"); |
| pragma Assert (not Is_Large_Type); |
| pragma Warnings (On, "-gnatw.a"); |
| |
| R := Powfive (Maxpow); |
| E := Exp - Maxpow; |
| |
| -- If the exponent is not too large, then scale down the result so that |
| -- its final value does not overflow but, if it's too large, then do not |
| -- bother doing it since overflow is just fine. The scaling factor is -3 |
| -- for every power of 5 above the maximum, in other words division by 8. |
| |
| if Exp - Maxexp <= Maxpow then |
| S := 3 * (Exp - Maxexp); |
| R.Hi := Num'Scaling (R.Hi, -S); |
| R.Lo := Num'Scaling (R.Lo, -S); |
| else |
| S := 0; |
| end if; |
| |
| while E > Maxpow loop |
| R := R * Powfive (Maxpow); |
| E := E - Maxpow; |
| end loop; |
| |
| R := R * Powfive (E); |
| |
| return R; |
| end Large_Powfive; |
| |
| --------------- |
| -- Scan_Real -- |
| --------------- |
| |
| function Scan_Real |
| (Str : String; |
| Ptr : not null access Integer; |
| Max : Integer) return Num |
| is |
| Base : Unsigned; |
| Scale : Impl.Scale_Array; |
| Extra : Unsigned; |
| Minus : Boolean; |
| Val : Impl.Value_Array; |
| |
| begin |
| Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scale, Extra, Minus); |
| |
| return Integer_to_Real (Str, Val, Base, Scale, Minus); |
| end Scan_Real; |
| |
| ---------------- |
| -- Value_Real -- |
| ---------------- |
| |
| function Value_Real (Str : String) return Num is |
| Base : Unsigned; |
| Scale : Impl.Scale_Array; |
| Extra : Unsigned; |
| Minus : Boolean; |
| Val : Impl.Value_Array; |
| |
| begin |
| Val := Impl.Value_Raw_Real (Str, Base, Scale, Extra, Minus); |
| |
| return Integer_to_Real (Str, Val, Base, Scale, Minus); |
| end Value_Real; |
| |
| end System.Val_Real; |
