diff options
Diffstat (limited to 'gcc/ada/libgnat/s-valrea.adb')
| -rw-r--r-- | gcc/ada/libgnat/s-valrea.adb | 522 |
1 files changed, 52 insertions, 470 deletions
diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb index 1a47dc2..693b261 100644 --- a/gcc/ada/libgnat/s-valrea.adb +++ b/gcc/ada/libgnat/s-valrea.adb @@ -29,282 +29,58 @@ -- -- ------------------------------------------------------------------------------ -with System.Val_Util; use System.Val_Util; with System.Float_Control; +with System.Unsigned_Types; use System.Unsigned_Types; +with System.Val_Util; use System.Val_Util; +with System.Value_R; package body System.Val_Real is - procedure Scan_Integral_Digits - (Str : String; - Index : in out Integer; - Max : Integer; - Value : out Long_Long_Integer; - Scale : out Integer; - Base_Violation : in out Boolean; - Base : Long_Long_Integer := 10; - Base_Specified : Boolean := False); - -- Scan the integral part of a real (i.e: before decimal separator) - -- - -- The string parsed is Str (Index .. Max), and after the call Index will - -- point to the first non parsed character. - -- - -- For each digit parsed either value := value * base + digit, or scale - -- is incremented by 1. - -- - -- Base_Violation will be set to True a digit found is not part of the Base - - procedure Scan_Decimal_Digits - (Str : String; - Index : in out Integer; - Max : Integer; - Value : in out Long_Long_Integer; - Scale : in out Integer; - Base_Violation : in out Boolean; - Base : Long_Long_Integer := 10; - Base_Specified : Boolean := False); - -- Scan the decimal part of a real (i.e: after decimal separator) - -- - -- The string parsed is Str (Index .. Max), and after the call Index will - -- point to the first non parsed character. - -- - -- For each digit parsed value = value * base + digit and scale is - -- decremented by 1. If precision limit is reached remaining digits are - -- still parsed but ignored. - -- - -- Base_Violation will be set to True a digit found is not part of the Base - - subtype Char_As_Digit is Long_Long_Integer range -2 .. 15; - subtype Valid_Digit is Char_As_Digit range 0 .. Char_As_Digit'Last; - Underscore : constant Char_As_Digit := -2; - E_Digit : constant Char_As_Digit := 14; - - function As_Digit (C : Character) return Char_As_Digit; - -- Given a character return the digit it represent. If the character is - -- not a digit then a negative value is returned, -2 for underscore and - -- -1 for any other character. - - Precision_Limit : constant Long_Long_Integer := - 2 ** (Long_Long_Float'Machine_Mantissa - 1) - 1; - -- This is an upper bound for the number of bits used to represent the - -- mantissa. Beyond that number, any digits parsed are useless. - - -------------- - -- As_Digit -- - -------------- - - function As_Digit (C : Character) return Char_As_Digit is - begin - case C is - when '0' .. '9' => - return Character'Pos (C) - Character'Pos ('0'); - when 'a' .. 'f' => - return Character'Pos (C) - (Character'Pos ('a') - 10); - when 'A' .. 'F' => - return Character'Pos (C) - (Character'Pos ('A') - 10); - when '_' => - return Underscore; - when others => - return -1; - end case; - end As_Digit; - - ------------------------- - -- Scan_Decimal_Digits -- - ------------------------- - - procedure Scan_Decimal_Digits - (Str : String; - Index : in out Integer; - Max : Integer; - Value : in out Long_Long_Integer; - Scale : in out Integer; - Base_Violation : in out Boolean; - Base : Long_Long_Integer := 10; - Base_Specified : Boolean := False) - + package Impl is new Value_R (Long_Long_Unsigned, Floating => True); + + function Integer_to_Real + (Str : String; + Val : Long_Long_Unsigned; + Base : Unsigned; + Scale : Integer; + Minus : Boolean) return Long_Long_Float; + -- Convert the real value from integer to real representation + + --------------------- + -- Integer_to_Real -- + --------------------- + + function Integer_to_Real + (Str : String; + Val : Long_Long_Unsigned; + Base : Unsigned; + Scale : Integer; + Minus : Boolean) return Long_Long_Float is - Precision_Limit_Reached : Boolean := False; - -- Set to True if addition of a digit will cause Value to be superior - -- to Precision_Limit. - - Digit : Char_As_Digit; - -- The current digit. + pragma Unsuppress (Range_Check); - Trailing_Zeros : Natural := 0; - -- Number of trailing zeros at a given point. + R_Val : Long_Long_Float; begin - pragma Assert (Base in 2 .. 16); - - -- If initial Scale is not 0 then it means that Precision_Limit was - -- reached during integral part scanning. - if Scale > 0 then - Precision_Limit_Reached := True; - end if; - - -- The function precondition is that the first character is a valid - -- digit. - Digit := As_Digit (Str (Index)); - - loop - -- Check if base is correct. If the base is not specified the digit - -- E or e cannot be considered as a base violation as it can be used - -- for exponentiation. - if Digit >= Base then - if Base_Specified then - Base_Violation := True; - elsif Digit = E_Digit then - return; - else - Base_Violation := True; - end if; - end if; - - -- If precision limit has been reached just ignore any remaining - -- digits for the computation of Value and Scale. The scanning - -- should continue only to assess the validity of the string - if not Precision_Limit_Reached then - if Digit = 0 then - -- Trailing '0' digits are ignored unless a non-zero digit is - -- found. - Trailing_Zeros := Trailing_Zeros + 1; - else - - -- Handle accumulated zeros. - for J in 1 .. Trailing_Zeros loop - if Value > Precision_Limit / Base then - Precision_Limit_Reached := True; - exit; - else - Value := Value * Base; - Scale := Scale - 1; - end if; - end loop; - - -- Reset trailing zero counter - Trailing_Zeros := 0; - - -- Handle current non zero digit - if Value > (Precision_Limit - Digit) / Base then - Precision_Limit_Reached := True; - else - Value := Value * Base + Digit; - Scale := Scale - 1; - end if; - end if; - end if; + -- We call the floating-point processor reset routine so we can be sure + -- that the processor is properly set for conversions. This is notably + -- needed on Windows, where calls to the operating system randomly reset + -- the processor into 64-bit mode. - -- Check next character - Index := Index + 1; - - if Index > Max then - return; - end if; - - Digit := As_Digit (Str (Index)); - - if Digit < 0 then - if Digit = Underscore and Index + 1 <= Max then - -- Underscore is only allowed if followed by a digit - Digit := As_Digit (Str (Index + 1)); - if Digit in Valid_Digit then - Index := Index + 1; - else - return; - end if; - else - -- Neither a valid underscore nor a digit. - return; - end if; - end if; - end loop; - end Scan_Decimal_Digits; - - -------------------------- - -- Scan_Integral_Digits -- - -------------------------- - - procedure Scan_Integral_Digits - (Str : String; - Index : in out Integer; - Max : Integer; - Value : out Long_Long_Integer; - Scale : out Integer; - Base_Violation : in out Boolean; - Base : Long_Long_Integer := 10; - Base_Specified : Boolean := False) - is - Precision_Limit_Reached : Boolean := False; - -- Set to True if addition of a digit will cause Value to be superior - -- to Precision_Limit. - - Digit : Char_As_Digit; - -- The current digit - begin - - -- Initialize Scale and Value - Value := 0; - Scale := 0; - - -- The function precondition is that the first character is a valid - -- digit. - Digit := As_Digit (Str (Index)); - - loop - -- Check if base is correct. If the base is not specified the digit - -- E or e cannot be considered as a base violation as it can be used - -- for exponentiation. - if Digit >= Base then - if Base_Specified then - Base_Violation := True; - elsif Digit = E_Digit then - return; - else - Base_Violation := True; - end if; - end if; - - if Precision_Limit_Reached then - -- Precision limit has been reached so just update the exponent - Scale := Scale + 1; - else - pragma Assert (Base /= 0); + System.Float_Control.Reset; - if Value > (Precision_Limit - Digit) / Base then - -- Updating Value will overflow so ignore this digit and any - -- following ones. Only update the scale - Precision_Limit_Reached := True; - Scale := Scale + 1; - else - Value := Value * Base + Digit; - end if; - end if; + -- Compute the final value - -- Look for the next character - Index := Index + 1; - if Index > Max then - return; - end if; + R_Val := Long_Long_Float (Val) * Long_Long_Float (Base) ** Scale; - Digit := As_Digit (Str (Index)); + -- Finally deal with initial minus sign, note that this processing is + -- done even if Uval is zero, so that -0.0 is correctly interpreted. - if Digit not in Valid_Digit then - -- Next character is not a digit. In that case stop scanning - -- unless the next chracter is an underscore followed by a digit. - if Digit = Underscore and Index + 1 <= Max then - Digit := As_Digit (Str (Index + 1)); - if Digit in Valid_Digit then - Index := Index + 1; - else - return; - end if; - else - return; - end if; - end if; - end loop; + return (if Minus then -R_Val else R_Val); - end Scan_Integral_Digits; + exception + when Constraint_Error => Bad_Value (Str); + end Integer_to_Real; --------------- -- Scan_Real -- @@ -315,197 +91,17 @@ package body System.Val_Real is Ptr : not null access Integer; Max : Integer) return Long_Long_Float - is - Start : Positive; - -- Position of starting non-blank character - + Base : Unsigned; + Scale : Integer; + Extra : Unsigned; Minus : Boolean; - -- Set to True if minus sign is present, otherwise to False - - Index : Integer; - -- Local copy of string pointer - - Int_Value : Long_Long_Integer := -1; - -- Mantissa as an Integer - - Int_Scale : Integer := 0; - -- Exponent value - - Base_Violation : Boolean := False; - -- If True some digits where not in the base. The float is still scan - -- till the end even if an error will be raised. - - Uval : Long_Long_Float := 0.0; - -- Contain the final value at the end of the function - - After_Point : Boolean := False; - -- True if a decimal should be parsed - - Base : Long_Long_Integer := 10; - -- Current base (default: 10) - - Base_Char : Character := ASCII.NUL; - -- Character used to set the base. If Nul this means that default - -- base is used. + Val : Long_Long_Unsigned; begin - -- We do not tolerate strings with Str'Last = Positive'Last - - if Str'Last = Positive'Last then - raise Program_Error with - "string upper bound is Positive'Last, not supported"; - end if; - - -- We call the floating-point processor reset routine so that we can - -- be sure the floating-point processor is properly set for conversion - -- calls. This is notably need on Windows, where calls to the operating - -- system randomly reset the processor into 64-bit mode. - - System.Float_Control.Reset; - - -- Scan the optional sign - Scan_Sign (Str, Ptr, Max, Minus, Start); - Index := Ptr.all; - Ptr.all := Start; - - -- First character can be either a decimal digit or a dot. - if Str (Index) in '0' .. '9' then - pragma Annotate - (CodePeer, Intentional, - "test always true", "defensive code below"); - - -- If this is a digit it can indicates either the float decimal - -- part or the base to use - Scan_Integral_Digits - (Str, - Index, - Max => Max, - Value => Int_Value, - Scale => Int_Scale, - Base_Violation => Base_Violation, - Base => 10); - elsif Str (Index) = '.' and then - -- A dot is only allowed if followed by a digit. - Index < Max and then - Str (Index + 1) in '0' .. '9' - then - -- Initial point, allowed only if followed by digit (RM 3.5(47)) - After_Point := True; - Index := Index + 1; - Int_Value := 0; - else - Bad_Value (Str); - end if; - - -- Check if the first number encountered is a base - if Index < Max and then - (Str (Index) = '#' or else Str (Index) = ':') - then - Base_Char := Str (Index); - Base := Int_Value; - - -- Reset Int_Value to indicate that parsing of integral value should - -- be done - Int_Value := -1; - if Base < 2 or else Base > 16 then - Base_Violation := True; - Base := 16; - end if; - - Index := Index + 1; - - if Str (Index) = '.' and then - Index < Max and then - As_Digit (Str (Index + 1)) in Valid_Digit - then - After_Point := True; - Index := Index + 1; - Int_Value := 0; - end if; - end if; - - -- Does scanning of integral part needed - if Int_Value < 0 then - if Index > Max or else As_Digit (Str (Index)) not in Valid_Digit then - Bad_Value (Str); - end if; - - Scan_Integral_Digits - (Str, - Index, - Max => Max, - Value => Int_Value, - Scale => Int_Scale, - Base_Violation => Base_Violation, - Base => Base, - Base_Specified => Base_Char /= ASCII.NUL); - end if; - - -- Do we have a dot ? - if not After_Point and then - Index <= Max and then - Str (Index) = '.' - then - -- At this stage if After_Point was not set, this means that an - -- integral part has been found. Thus the dot is valid even if not - -- followed by a digit. - if Index < Max and then As_Digit (Str (Index + 1)) in Valid_Digit then - After_Point := True; - end if; - - Index := Index + 1; - end if; - - if After_Point then - -- Parse decimal part - Scan_Decimal_Digits - (Str, - Index, - Max => Max, - Value => Int_Value, - Scale => Int_Scale, - Base_Violation => Base_Violation, - Base => Base, - Base_Specified => Base_Char /= ASCII.NUL); - end if; - - -- If an explicit base was specified ensure that the delimiter is found - if Base_Char /= ASCII.NUL then - if Index > Max or else Str (Index) /= Base_Char then - Bad_Value (Str); - else - Index := Index + 1; - end if; - end if; - - -- Compute the final value - Uval := Long_Long_Float (Int_Value); - - -- Update pointer and scan exponent. - Ptr.all := Index; - - Int_Scale := Int_Scale + Scan_Exponent (Str, - Ptr, - Max, - Real => True); - - Uval := Uval * Long_Long_Float (Base) ** Int_Scale; - - -- Here is where we check for a bad based number - if Base_Violation then - Bad_Value (Str); - - -- If OK, then deal with initial minus sign, note that this processing - -- is done even if Uval is zero, so that -0.0 is correctly interpreted. - else - if Minus then - return -Uval; - else - return Uval; - end if; - end if; + Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scale, Extra, Minus); + return Integer_to_Real (Str, Val, Base, Scale, Minus); end Scan_Real; ---------------- @@ -513,30 +109,16 @@ package body System.Val_Real is ---------------- function Value_Real (Str : String) return Long_Long_Float is - begin - -- We have to special case Str'Last = Positive'Last because the normal - -- circuit ends up setting P to Str'Last + 1 which is out of bounds. We - -- deal with this by converting to a subtype which fixes the bounds. - - if Str'Last = Positive'Last then - declare - subtype NT is String (1 .. Str'Length); - begin - return Value_Real (NT (Str)); - end; + Base : Unsigned; + Scale : Integer; + Extra : Unsigned; + Minus : Boolean; + Val : Long_Long_Unsigned; - -- Normal case where Str'Last < Positive'Last + begin + Val := Impl.Value_Raw_Real (Str, Base, Scale, Extra, Minus); - else - declare - V : Long_Long_Float; - P : aliased Integer := Str'First; - begin - V := Scan_Real (Str, P'Access, Str'Last); - Scan_Trailing_Blanks (Str, P); - return V; - end; - end if; + return Integer_to_Real (Str, Val, Base, Scale, Minus); end Value_Real; end System.Val_Real; |