[Ada] Add support for 128-bit fixed-point types on 64-bit platforms

gcc/ada/

	* Makefile.rtl (GNATRTL_NONTASKING_OBJS): Likewise.
	(GNATRTL_128BIT_OBJS): Likewise.
	(GNATRTL_128BIT_PAIRS): Add new 128-bit variants.
	* cstand.adb (Create_Standard): Create Standard_Integer_128.
	* doc/gnat_rm/implementation_defined_characteristics.rst: Document
	new limits on 64-bit platforms in entry for 3.5.9(10).
	* gnat_rm.texi: Regenerate.
	* exp_attr.adb: Add with and use clauses for Urealp.
	(Expand_N_Attribute_Reference) <Attribute_Fore>: Call new routines
	for decimal fixed-point types and common ordinary fixed-point types.
	* exp_ch4.adb (Real_Range_Check): Extend conversion trick to all
	ordinary fixed-point types and use Small_Integer_Type_For.
	* exp_fixd.adb: Add with and use clauses for Ttypes.
	(Build_Divide): Add special case for 32-bit values and deal with
	128-bit types.
	(Build_Double_Divide): Deal with 128-bit types.
	(Build_Double_Divide_Code): Likewise.  Do not apply conversions
	before calling Build_Multiply.
	(Build_Multiply): Likewise.  Add special case for 32-bit values.
	(Build_Scaled_Divide): Deal with 128-bit types.
	(Build_Scaled_Divide_Code): Likewise.  Fix size computation.  Do not
	apply conversions before calling Build_Multiply.
	(Do_Multiply_Fixed_Fixed): Minor tweak.
	(Integer_Literal): Deal with 128-bit values.
	* exp_imgv.adb (Has_Decimal_Small): Delete.
	(Expand_Image_Attribute): Call new routines for common ordinary
	fixed-point types.
	(Expand_Value_Attribute): Likewise.
	(Expand_Width_Attribute): Add new expansion for fixed-point types.
	* freeze.adb (Freeze_Entity): Move error checks for ordinary
	fixed-point types to...
	(Freeze_Fixed_Point_Type): ...here.  Deal with 128-bit types and
	adjust limitations for 32-bnt and 64-bit types.
	* rtsfind.ads (RTU_Id): Add entries for new System_Fore, System_Img,
	and System_Val units and remove them for obsolete units.
	(RE_Id): Add entries for Double_Divide128, Scaled_Divide128, the new
	Fore, Image, Value routines and remove them for obsolete units.
	(RE_Unit_Table): Likewise.
	* sem_ch3.adb (Decimal_Fixed_Point_Type_Declaration): Deal with
	128-bit types.
	* stand.ads (Standard_Entity_Type): Add Standard_Integer_128.
	* uintp.ads (Uint_31): New deferred constant.
	(Uint_Minus_18): Likewise.
	(Uint_Minus_31): Likewise.
	(Uint_Minus_76): Likewise.
	(Uint_Minus_127): Likewise.
	* urealp.ads (Ureal_2_31): New function.
	(Ureal_2_63): Likewise.
	(Ureal_2_127): Likewise.
	(Ureal_2_M_127): Likewise.
	(Ureal_2_10_18): Likewise.
	(Ureal_M_2_10_18): Likewise.
	(Ureal_9_10_36): Likewise.
	(Ureal_M_9_10_36): Likewise.
	(Ureal_10_76): Likewise.
	(Ureal_M_10_76): Likewise.
	(Ureal_10_36): Delete.
	(Ureal_M_10_36): Likewise.
	* urealp.adb (UR_2_10_18): New variable.
	(UR_9_10_36): Likewise.
	(UR_10_76): Likewise.
	(UR_M_2_10_18): Likewise.
	(UR_M_9_10_36): Likewise.
	(UR_M_10_76): Likewise.
	(UR_2_31): Likewise.
	(UR_2_63): Likewise.
	(UR_2_127): Likewise.
	(UR_2_M_127): Likewise.
	(UR_10_36): Delete.
	(UR_M_10_36): Likewise.
	(Initialize): Initialize them.
	(UR_Write): Do not use awkward Ada literal style.
	(Ureal_2_10_18): New function.
	(Ureal_9_10_36): Likewise.
	(Ureal_10_76): Likewise.
	(Ureal_2_31): Likewise.
	(Ureal_2_63): Likewise.
	(Ureal_2_127): Likewise.
	(Ureal_2_M_127): Likewise.
	(Ureal_M_2_10_18): Likewise.
	(Ureal_M_9_10_36): Likewise.
	(Ureal_10_76): Likewise.
	(Ureal_M_10_76): Likewise.
	(Ureal_10_36): Delete.
	(Ureal_M_10_36): Likewise.
	* libgnat/a-decima__128.ads: New file.
	* libgnat/a-tideau.ads, libgnat/a-tideau.adb: Reimplement as
	generic unit.
	* libgnat/a-tideio.adb: Reimplement.
	* libgnat/a-tideio__128.adb: New file.
	* libgnat/a-tifiau.ads, libgnat/a-tifiau.adb: New generic unit.
	* libgnat/a-tifiio.adb: Move bulk of implementation to s-imagef
	and reimplement.
	* libgnat/a-tifiio__128.adb: New file.
	* libgnat/a-tiflau.adb (Get): Minor consistency fix.
	(Gets): Likewise.
	* libgnat/a-wtdeau.ads, libgnat/a-wtdeau.adb: Reimplement as
	generic unit.
	* libgnat/a-wtdeio.adb: Reimplement.
	* libgnat/a-wtdeio__128.adb: New file.
	* libgnat/a-wtfiau.ads, libgnat/a-wtfiau.adb: New generic unit.
	* libgnat/a-wtfiio.adb: Reimplement.
	* libgnat/a-wtfiio__128.adb: New file.
	* libgnat/a-ztdeau.ads, libgnat/a-ztdeau.adb: Reimplement as
	generic unit.
	* libgnat/a-ztdeio.adb: Reimplement.
	* libgnat/a-ztdeio__128.adb: New file.
	* libgnat/a-ztfiau.ads, libgnat/a-ztfiau.adb: New generic unit.
	* libgnat/a-ztfiio.adb: Reimplement.
	* libgnat/a-ztfiio__128.adb: New file.
	* libgnat/g-rannum.adb (Random_Decimal_Fixed): Use a subtype of the
	appropiate size for the instantiation.
	(Random_Ordinary_Fixed): Likewise.
	* libgnat/s-arit32.ads, libgnat/s-arit32.adb: New support unit.
	* libgnat/s-fode128.ads: New instantiation.
	* libgnat/s-fode32.ads: Likewise.
	* libgnat/s-fode64.ads: Likewise.
	* libgnat/s-fofi128.ads: Likewise.
	* libgnat/s-fofi32.ads: Likewise.
	* libgnat/s-fofi64.ads: Likewise.
	* libgnat/s-fore_d.ads, libgnat/s-fore_d.adb: New generic unit.
	* libgnat/s-fore_f.ads, libgnat/s-fore_f.adb: Likewise.
	* libgnat/s-fore.ads, libgnat/s-fore.adb: Rename into...
	* libgnat/s-forrea.ads, libgnat/s-forrea.adb: ...this.
	* libgnat/s-imaged.ads, libgnat/s-imaged.adb: New generic unit.
	* libgnat/s-imagef.ads, libgnat/s-imagef.adb: Likewise, taken
	from a-tifiio.adb.
	* libgnat/s-imde128.ads: New instantiation.
	* libgnat/s-imde32.ads: Likewise.
	* libgnat/s-imde64.ads: Likewise.
	* libgnat/s-imfi128.ads: Likewise.
	* libgnat/s-imfi32.ads: Likewise.
	* libgnat/s-imfi64.ads: Likewise.
	* libgnat/s-imgdec.ads, libgnat/s-imgdec.adb: Delete.
	* libgnat/s-imglld.ads, libgnat/s-imglld.adb: Likewise.
	* libgnat/s-imgrea.adb (Set_Image_Real): Replace Sign local variable
	with Minus local variable for the sake of consistency.
	* libgnat/s-imguti.ads, libgnat/s-imguti.adb: New support unit.
	* libgnat/s-vade128.ads: New instantiation.
	* libgnat/s-vade32.ads: Likewise.
	* libgnat/s-vade64.ads: Likewise.
	* libgnat/s-vafi128.ads: Likewise.
	* libgnat/s-vafi32.ads: Likewise.
	* libgnat/s-vafi64.ads: Likewise.
	* libgnat/s-valdec.ads, libgnat/s-valdec.adb: Delete.
	* libgnat/s-vallld.ads, libgnat/s-vallld.adb: Likewise.
	* libgnat/s-valued.ads, libgnat/s-valued.adb: New generic unit.
	* libgnat/s-valuef.ads, libgnat/s-valuef.adb: Likewise.
	* libgnat/s-valuei.adb: Minor rewording.
	* libgnat/s-valrea.adb: Move bulk of implementation to...
	* libgnat/s-valuer.ads, libgnat/s-valuer.adb: ...here.  New
	generic unit.
	* libgnat/system-aix.ads (Max_Mantissa): Adjust.
	* libgnat/system-darwin-arm.ads (Max_Mantissa): Likewise.
	* libgnat/system-darwin-ppc.ads (Max_Mantissa): Likewise.
	* libgnat/system-darwin-x86.ads (Max_Mantissa): Likewise.
	* libgnat/system-djgpp.ads (Max_Mantissa): Likewise.
	* libgnat/system-dragonfly-x86_64.ads (Max_Mantissa): Likewise.
	* libgnat/system-freebsd.ads (Max_Mantissa): Likewise.
	* libgnat/system-hpux-ia64.ads (Max_Mantissa): Likewise.
	* libgnat/system-hpux.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-alpha.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-arm.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-hppa.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-ia64.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-m68k.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-mips.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-ppc.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-riscv.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-s390.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-sh4.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-sparc.ads (Max_Mantissa): Likewise.
	* libgnat/system-linux-x86.ads (Max_Mantissa): Likewise.
	* libgnat/system-lynxos178-ppc.ads (Max_Mantissa): Likewise.
	* libgnat/system-lynxos178-x86.ads (Max_Mantissa): Likewise.
	* libgnat/system-mingw.ads (Max_Mantissa): Likewise.
	* libgnat/system-qnx-aarch64.ads (Max_Mantissa): Likewise.
	* libgnat/system-rtems.ads (Max_Mantissa): Likewise.
	* libgnat/system-solaris-sparc.ads (Max_Mantissa): Likewise.
	* libgnat/system-solaris-x86.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-arm-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-arm-rtp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-arm.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-e500-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-e500-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-e500-rtp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-e500-vthread.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-ppc-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-ppc-ravenscar.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-ppc-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-ppc-rtp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-ppc-vthread.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-ppc.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-x86-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-x86-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-x86-rtp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-x86-vthread.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks-x86.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-aarch64-rtp-smp.ads (Max_Mantissa):
	Likewise.
	* libgnat/system-vxworks7-aarch64.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-arm-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-arm.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-e500-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-e500-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-e500-rtp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-ppc-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-ppc-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-ppc-rtp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-ppc64-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-ppc64-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-x86-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-x86-rtp-smp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-x86-rtp.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-x86_64-kernel.ads (Max_Mantissa): Likewise.
	* libgnat/system-vxworks7-x86_64-rtp-smp.ads (Max_Mantissa): Likewise.

gcc/testsuite/

	* gnat.dg/multfixed.adb: Robustify.

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;