------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- S Y S T E M . V A L U E _ D -- -- -- -- B o d y -- -- -- -- Copyright (C) 2020-2024, 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 -- -- . -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with System.Unsigned_Types; use System.Unsigned_Types; with System.Val_Util; use System.Val_Util; with System.Value_R; package body System.Value_D is pragma Assert (Int'Size <= Uns'Size); -- We need an unsigned type large enough to represent the mantissa package Impl is new Value_R (Uns, 1, 2**(Int'Size - 1), Round => False); -- We do not use the Extra digit for decimal fixed-point types function Integer_to_Decimal (Str : String; Val : Uns; Base : Unsigned; ScaleB : Integer; Minus : Boolean; Scale : Integer) return Int; -- Convert the real value from integer to decimal representation ------------------------ -- Integer_to_Decimal -- ------------------------ function Integer_to_Decimal (Str : String; Val : Uns; Base : Unsigned; ScaleB : Integer; Minus : Boolean; Scale : Integer) return Int is function Safe_Expont (Base : Int; Exp : in out Natural; Factor : Int) return Int; -- Return (Base ** Exp) * Factor if the computation does not overflow, -- or else the number of the form (Base ** K) * Factor with the largest -- magnitude if the former computation overflows. In both cases, Exp is -- updated to contain the remaining power in the computation. Note that -- Factor is expected to be positive in this context. function Unsigned_To_Signed (Val : Uns) return Int; -- Convert an integer value from unsigned to signed representation ----------------- -- Safe_Expont -- ----------------- function Safe_Expont (Base : Int; Exp : in out Natural; Factor : Int) return Int is pragma Assert (Base /= 0 and then Factor > 0); Max : constant Int := Int'Last / Base; Result : Int := Factor; begin while Exp > 0 and then Result <= Max loop Result := Result * Base; Exp := Exp - 1; end loop; return Result; end Safe_Expont; ------------------------ -- Unsigned_To_Signed -- ------------------------ function Unsigned_To_Signed (Val : Uns) return Int is begin -- Deal with overflow cases, and also with largest negative number if Val > Uns (Int'Last) then if Minus and then Val = Uns (-(Int'First)) then return Int'First; else Bad_Value (Str); end if; -- Negative values elsif Minus then return -(Int (Val)); -- Positive values else return Int (Val); end if; end Unsigned_To_Signed; begin -- If the base of the value is 10 or its scaling factor is zero, then -- add the scales (they are defined in the opposite sense) and apply -- the result to the value, checking for overflow in the process. if Base = 10 or else ScaleB = 0 then declare S : Integer := ScaleB + Scale; V : Uns := Val; begin while S < 0 loop V := V / 10; S := S + 1; end loop; while S > 0 loop if V <= Uns'Last / 10 then V := V * 10; S := S - 1; else Bad_Value (Str); end if; end loop; return Unsigned_To_Signed (V); end; -- If the base of the value is not 10, use a scaled divide operation -- to compute Val * (Base ** ScaleB) * (10 ** Scale). else declare B : constant Int := Int (Base); S : constant Integer := ScaleB; V : Uns := Val; Y, Z, Q, R : Int; begin -- If S is too negative, then drop trailing digits if S < 0 then declare LS : Integer := -S; begin Y := 10 ** Integer'Max (0, Scale); Z := Safe_Expont (B, LS, 10 ** Integer'Max (0, -Scale)); for J in 1 .. LS loop V := V / Uns (B); end loop; end; -- If S is too positive, then scale V up, which may then overflow elsif S > 0 then declare LS : Integer := S; begin Y := Safe_Expont (B, LS, 10 ** Integer'Max (0, Scale)); Z := 10 ** Integer'Max (0, -Scale); for J in 1 .. LS loop if V <= Uns'Last / Uns (B) then V := V * Uns (B); else Bad_Value (Str); end if; end loop; end; -- The case S equal to zero should have been handled earlier else raise Program_Error; end if; -- Perform a scale divide operation with rounding to match 'Image Scaled_Divide (Unsigned_To_Signed (V), Y, Z, Q, R, Round => True); return Q; end; end if; exception when Constraint_Error => Bad_Value (Str); end Integer_to_Decimal; ------------------ -- Scan_Decimal -- ------------------ function Scan_Decimal (Str : String; Ptr : not null access Integer; Max : Integer; Scale : Integer) return Int is Base : Unsigned; Scl : Impl.Scale_Array; Extra : Unsigned; Minus : Boolean; Val : Impl.Value_Array; begin Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scl, Extra, Minus); return Integer_to_Decimal (Str, Val (1), Base, Scl (1), Minus, Scale); end Scan_Decimal; ------------------- -- Value_Decimal -- ------------------- function Value_Decimal (Str : String; Scale : Integer) return Int is Base : Unsigned; Scl : Impl.Scale_Array; Extra : Unsigned; Minus : Boolean; Val : Impl.Value_Array; begin Val := Impl.Value_Raw_Real (Str, Base, Scl, Extra, Minus); return Integer_to_Decimal (Str, Val (1), Base, Scl (1), Minus, Scale); end Value_Decimal; end System.Value_D;