From: Eric Botcazou Date: Wed, 6 Jan 2021 14:27:15 +0000 (+0100) Subject: [Ada] Implement tiered support for floating-point output operations X-Git-Tag: basepoints/gcc-13~7832 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ec80b416554d3f41b5fd23cc86287af9b9a7d2d2;p=thirdparty%2Fgcc.git [Ada] Implement tiered support for floating-point output operations gcc/ada/ * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add s-dourea, s-imager, s-imgflt, s-imglfl and s-imgllf. (LIBGNAT_TARGET_PAIRS) [PowerPC/VxWorks]: Use s-dorepr__fma.adb. (LIBGNAT_TARGET_PAIRS) [PowerPC/VxWorksAE]: Likewise. (LIBGNAT_TARGET_PAIRS) [Aarch64/VxWorks]: Likewise. (LIBGNAT_TARGET_PAIRS) [Aarch64/QNX]: Likewise. (LIBGNAT_TARGET_PAIRS) [Aarch64/FreeBSD]: Likewise. (LIBGNAT_TARGET_PAIRS) [PowerPC/Linux]: Likewise. (LIBGNAT_TARGET_PAIRS) [Aarch64/Linux]: Likewise. (LIBGNAT_TARGET_PAIRS) [IA-64/Linux]: Likewise. (LIBGNAT_TARGET_PAIRS) [IA-64/HP-UX]: Likewise. (LIBGNAT_TARGET_PAIRS) [RISC-V/Linux]: Likewise. (LIBGNAT_TARGET_PAIRS) [PowerPC/Darwin]: Likewise. * exp_attr.adb (Expand_N_Attribute_Reference) [Attribute_Fore]: Use Fixed suffix and Long_Float type. * exp_imgv.adb (Expand_Image_Attribute): For floating-point types, use the routine of the corresponding root type. For ordinary fixed point types, use Fixed suffix and Long_Float type. (Expand_Value_Attribute): Revert latest change for Long_Long_Float. * gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Remove libgnat units g-hesora.o and s-imgenu.o, add g-heasor.o, g-table.o and s-pehage.o. (GNATBIND_OBJS): Remove libgnat unit s-imgenu.o. * rtsfind.ads (RTU_Id): Add System_Img_Flt, System_Img_LFlt and System_Img_LLF. Remove System_Img_Real. (RE_Id): Rename RE_Fore_Real to RE_Fore_Fixed. Add RE_Image_Float, RE_Image_Long_Float and RE_Image_Long_Long_Float. Rename RE_Image_Ordinary_Fixed_Point to RE_Image_Fixed. (RE_Unit_Table): Adjust to above changes. * libgnat/a-nbnbre.adb (Fixed_Conversions): Use Long_Float instead of Long_Long_Float. * libgnat/a-textio.ads (Field): Remove obsolete comment. * libgnat/a-ticoau.ads (Aux): Adjust ancestor package. * libgnat/a-ticoau.adb: Remove with/use clause for System.Img_Real. (Puts): Call Aux.Set_Image instead of Set_Image_Real. * libgnat/a-ticoio.adb: Add with/use clauses for System.Img_Flt, System.Img_LFlt and System.Img_LLF. (Scalar_Float): Add third actual parameter. (Scalar_Long_Float): Likewise. (Scalar_Long_Long_Float): Likewise. * libgnat/a-tifiio.adb: Add with/use clauses for System.Img_LFlt and System.Val_LFlt. Remove the one for System.Val_LLF. Replace Long_Long_Float with Long_Float throughout. * libgnat/a-tifiio__128.adb: Likewise. * libgnat/a-tiflau.ads: Add Set_Image formal parameter. * libgnat/a-tiflau.adb: Add with/use clause for System.Img_Util, remove the one for System.Img_Real. (Put): Call Set_Image instead of Set_Image_Real. (Puts): Likewise. * libgnat/a-tiflio.adb: Add with/use clause for System.Img_Flt, System.Img_LFlt and System.Img_LLF. (Aux_Float): Add third actual parameter. (Aux_Long_Float): Likewise. (Aux_Long_Long_Float): Likewise. * libgnat/a-witeio.ads (Field): Remove obsolete comment. * libgnat/a-wtcoau.ads (Aux): Adjust ancestor package. * libgnat/a-wtcoau.adb: Remove with/use clause for System.Img_Real. (Puts): Call Aux.Set_Image instead of Set_Image_Real. * libgnat/a-wtcoio.adb: Add with/use clauses for System.Img_Flt, System.Img_LFlt and System.Img_LLF. (Scalar_Float): Add third actual parameter. (Scalar_Long_Float): Likewise. (Scalar_Long_Long_Float): Likewise. * libgnat/a-wtfiio.adb: Add with/use clauses for System.Img_LFlt and System.Val_LFlt. Remove the one for System.Val_LLF. Replace Long_Long_Float with Long_Float throughout. * libgnat/a-wtfiio__128.adb: Likewise. * libgnat/a-wtflau.ads: Add Set_Image formal parameter. * libgnat/a-wtflau.adb: Add with/use clause for System.Img_Util, remove the one for System.Img_Real. (Put): Call Set_Image instead of Set_Image_Real. (Puts): Likewise. * libgnat/a-wtflio.adb: Add with/use clause for System.Img_Flt, System.Img_LFlt and System.Img_LLF. (Aux_Float): Add third actual parameter. (Aux_Long_Float): Likewise. (Aux_Long_Long_Float): Likewise. * libgnat/a-ztexio.ads (Field): Remove obsolete comment. * libgnat/a-ztcoau.ads (Aux): Adjust ancestor package. * libgnat/a-ztcoau.adb: Remove with/use clause for System.Img_Real. (Puts): Call Aux.Set_Image instead of Set_Image_Real. * libgnat/a-ztcoio.adb: Add with/use clauses for System.Img_Flt, System.Img_LFlt and System.Img_LLF. (Scalar_Float): Add third actual parameter. (Scalar_Long_Float): Likewise. (Scalar_Long_Long_Float): Likewise. * libgnat/a-ztfiio.adb: Add with/use clauses for System.Img_LFlt and System.Val_LFlt. Remove the one for System.Val_LLF. Replace Long_Long_Float with Long_Float throughout. * libgnat/a-ztfiio__128.adb: Likewise. * libgnat/a-ztflau.ads: Add Set_Image formal parameter. * libgnat/a-ztflau.adb: Add with/use clause for System.Img_Util, remove the one for System.Img_Real. (Put): Call Set_Image instead of Set_Image_Real. (Puts): Likewise. * libgnat/a-ztflio.adb: Add with/use clause for System.Img_Flt, System.Img_LFlt and System.Img_LLF. (Aux_Float): Add third actual parameter. (Aux_Long_Float): Likewise. (Aux_Long_Long_Float): Likewise. * libgnat/s-dorepr.adb: New file. * libgnat/s-dorepr__fma.adb: Likewise. * libgnat/s-dourea.ads: Likewise. * libgnat/s-dourea.adb: Likewise. * libgnat/s-forrea.ads (Fore_Real): Rename into... (Fore_Fixed): ...this and take Long_Float parameters. * libgnat/s-forrea.adb (Fore_Real): Likewise. (Fore_Fixed): Likewise. * libgnat/s-imgrea.ads: Move to... (Set_Image_Real): Turn into mere renaming. * libgnat/s-imager.ads: ...here. (Image_Ordinary_Fixed_Point): Turn into... (Image_Fixed_Point): ...this. * libgnat/s-imgrea.adb: Add pragma No_Body. Move to... * libgnat/s-imager.adb: ...here. (Image_Ordinary_Fixed_Point): Turn into... (Image_Fixed_Point): ...this. (Is_Negative): Replace Long_Long_Float with Num. (Set_Image_Real): Likewise. Use Double_T instead of single Num throughout the algorithm. * libgnat/s-imgflt.ads: New file. * libgnat/s-imglfl.ads: Likewise. * libgnat/s-imgllf.ads: Likewise. * libgnat/s-imagef.ads: Adjust comment. * libgnat/s-imguti.ads (Max_Real_Image_Length): New named number. * libgnat/s-powflt.ads (Maxpow): Adjust. (Powten): Turn into an exact table of double Float. * libgnat/s-powlfl.ads (Maxpow): Adjust. (Powten): Turn into an exact table of double Long_Float. * libgnat/s-powllf.ads (Maxpow): Adjust. (Powten): Turn into an exact table of double Long_Long_Float. * libgnat/s-valrea.ads: Change order of formal parameters. * libgnat/s-valrea.adb: Add with clause for System.Double_Real. (Double_Real): New instantiation. (Fast2Sum): Delete. (Large_Powten): New function. (Integer_to_Real): Use Quick_Two_Sum instead of Fast2Sum. Convert the value to Double_T. Do the scaling in Double_T for base 10. * libgnat/s-valflt.ads: Remove with/use clasue for Interfaces, add it for System.Unsigned_Types. Use Unsigned. * libgnat/s-vallfl.ads: Remove with/use clasue for Interfaces, add it for System.Unsigned_Types. Use Long_Unsigned. * libgnat/s-valllf.ads: Remove with/use clasue for Interfaces, add it for System.Unsigned_Types. Use Long_Long_Unsigned. --- diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 0ba8e5332ce9..d42579d5f0d1 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -575,6 +575,7 @@ GNATRTL_NONTASKING_OBJS= \ s-dlmkio$(objext) \ s-dlmopr$(objext) \ s-dmotpr$(objext) \ + s-dourea$(objext) \ s-dsaser$(objext) \ s-elaall$(objext) \ s-excdeb$(objext) \ @@ -618,6 +619,7 @@ GNATRTL_NONTASKING_OBJS= \ s-imaged$(objext) \ s-imagef$(objext) \ s-imagei$(objext) \ + s-imager$(objext) \ s-imageu$(objext) \ s-imagew$(objext) \ s-imde32$(objext) \ @@ -629,7 +631,10 @@ GNATRTL_NONTASKING_OBJS= \ s-imgboo$(objext) \ s-imgcha$(objext) \ s-imgenu$(objext) \ + s-imgflt$(objext) \ s-imgint$(objext) \ + s-imglfl$(objext) \ + s-imgllf$(objext) \ s-imgllb$(objext) \ s-imglli$(objext) \ s-imgllu$(objext) \ @@ -1069,6 +1074,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks vxworksspe vxworks7% vxworks7spe a-naliop.ads LLLU'Last or else Num'Small_Denominator > LLLU'Last; -- True if the Small is too large for Long_Long_Long_Unsigned, in which - -- case we convert to/from Long_Long_Float as an intermediate step. + -- case we convert to/from Long_Float as an intermediate step. package Conv_I is new Big_Integers.Signed_Conversions (LLLI); package Conv_U is new Big_Integers.Unsigned_Conversions (LLLU); @@ -334,7 +334,7 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is begin if Too_Large then - return Float_Aux.To_Big_Real (Long_Long_Float (Arg)); + return Float_Aux.To_Big_Real (Long_Float (Arg)); end if; N := Conv_U.To_Big_Integer (Num'Small_Numerator); diff --git a/gcc/ada/libgnat/a-textio.ads b/gcc/ada/libgnat/a-textio.ads index 9d6baea584cd..f6c0a8aec65e 100644 --- a/gcc/ada/libgnat/a-textio.ads +++ b/gcc/ada/libgnat/a-textio.ads @@ -85,9 +85,6 @@ is -- Line and page length subtype Field is Integer range 0 .. 255; - -- Note: if for any reason, there is a need to increase this value, then it - -- will be necessary to change the corresponding value in System.Img_Real - -- in file s-imgrea.adb. subtype Number_Base is Integer range 2 .. 16; diff --git a/gcc/ada/libgnat/a-ticoau.adb b/gcc/ada/libgnat/a-ticoau.adb index 391b7d86dca1..1fa9364d12a0 100644 --- a/gcc/ada/libgnat/a-ticoau.adb +++ b/gcc/ada/libgnat/a-ticoau.adb @@ -31,8 +31,6 @@ with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux; -with System.Img_Real; use System.Img_Real; - package body Ada.Text_IO.Complex_Aux is --------- @@ -171,9 +169,9 @@ package body Ada.Text_IO.Complex_Aux is -- Both parts are initially converted with a Fore of 0 Rptr := 0; - Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp); + Aux.Set_Image (ItemR, R_String, Rptr, 0, Aft, Exp); Iptr := 0; - Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp); + Aux.Set_Image (ItemI, I_String, Iptr, 0, Aft, Exp); -- Check room for both parts plus parens plus comma (RM G.1.3(34)) diff --git a/gcc/ada/libgnat/a-ticoau.ads b/gcc/ada/libgnat/a-ticoau.ads index 30372c8bd313..2b5ea66f992a 100644 --- a/gcc/ada/libgnat/a-ticoau.ads +++ b/gcc/ada/libgnat/a-ticoau.ads @@ -42,7 +42,7 @@ private generic type Num is digits <>; - with package Aux is new Ada.Text_IO.Float_Aux (Num, <>); + with package Aux is new Ada.Text_IO.Float_Aux (Num, <>, <>); package Ada.Text_IO.Complex_Aux is diff --git a/gcc/ada/libgnat/a-ticoio.adb b/gcc/ada/libgnat/a-ticoio.adb index c4b9eba628fc..a94c82689ea6 100644 --- a/gcc/ada/libgnat/a-ticoio.adb +++ b/gcc/ada/libgnat/a-ticoio.adb @@ -31,6 +31,9 @@ with Ada.Text_IO.Complex_Aux; with Ada.Text_IO.Float_Aux; +with System.Img_Flt; use System.Img_Flt; +with System.Img_LFlt; use System.Img_LFlt; +with System.Img_LLF; use System.Img_LLF; with System.Val_Flt; use System.Val_Flt; with System.Val_LFlt; use System.Val_LFlt; with System.Val_LLF; use System.Val_LLF; @@ -40,22 +43,24 @@ package body Ada.Text_IO.Complex_IO is use Complex_Types; package Scalar_Float is new - Ada.Text_IO.Float_Aux (Float, Scan_Float); + Ada.Text_IO.Float_Aux (Float, Scan_Float, Set_Image_Float); package Scalar_Long_Float is new - Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float); + Ada.Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); package Scalar_Long_Long_Float is new - Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + Ada.Text_IO.Float_Aux + (Long_Long_Float, Scan_Long_Long_Float, Set_Image_Long_Long_Float); package Aux_Float is new - Ada.Text_IO.Complex_Aux (Float, Scalar_Float); + Ada.Text_IO.Complex_Aux (Float, Scalar_Float); package Aux_Long_Float is new - Ada.Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float); + Ada.Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float); package Aux_Long_Long_Float is new - Ada.Text_IO.Complex_Aux (Long_Long_Float, Scalar_Long_Long_Float); + Ada.Text_IO.Complex_Aux (Long_Long_Float, Scalar_Long_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Float is OK, where type Long_Float is OK and where type Long_Long_Float diff --git a/gcc/ada/libgnat/a-tifiio.adb b/gcc/ada/libgnat/a-tifiio.adb index c11ebecf8b15..d51abb4b38fb 100644 --- a/gcc/ada/libgnat/a-tifiio.adb +++ b/gcc/ada/libgnat/a-tifiio.adb @@ -158,16 +158,17 @@ with Ada.Text_IO.Fixed_Aux; with Ada.Text_IO.Float_Aux; with System.Img_Fixed_32; use System.Img_Fixed_32; with System.Img_Fixed_64; use System.Img_Fixed_64; +with System.Img_LFlt; use System.Img_LFlt; with System.Val_Fixed_32; use System.Val_Fixed_32; with System.Val_Fixed_64; use System.Val_Fixed_64; -with System.Val_LLF; use System.Val_LLF; +with System.Val_LFlt; use System.Val_LFlt; package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -- Note: we still use the floating-point I/O routines for types whose small -- is not the ratio of two sufficiently small integers. This will result in -- inaccuracies for fixed point types that require more precision than is - -- available in Long_Long_Float. + -- available in Long_Float. subtype Int32 is Interfaces.Integer_32; use type Int32; subtype Int64 is Interfaces.Integer_64; use type Int64; @@ -178,8 +179,8 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is package Aux64 is new Ada.Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64); - package Aux_Long_Long_Float is new - Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + package Aux_Long_Float is new + Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float, Set_Image_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Int32 is OK and where type Int64 is OK. These boolean constants are used @@ -283,7 +284,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width); + Aux_Long_Float.Get (File, Long_Float (Item), Width); end if; exception @@ -317,7 +318,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last); + Aux_Long_Float.Gets (From, Long_Float (Item), Last); end if; exception @@ -345,8 +346,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Put - (File, Long_Long_Float (Item), Fore, Aft, Exp); + Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp); end if; end Put; @@ -376,7 +376,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp); + Aux_Long_Float.Puts (To, Long_Float (Item), Aft, Exp); end if; end Put; diff --git a/gcc/ada/libgnat/a-tifiio__128.adb b/gcc/ada/libgnat/a-tifiio__128.adb index be3b47b48ee6..b161e89f712d 100644 --- a/gcc/ada/libgnat/a-tifiio__128.adb +++ b/gcc/ada/libgnat/a-tifiio__128.adb @@ -159,17 +159,18 @@ with Ada.Text_IO.Float_Aux; with System.Img_Fixed_32; use System.Img_Fixed_32; with System.Img_Fixed_64; use System.Img_Fixed_64; with System.Img_Fixed_128; use System.Img_Fixed_128; +with System.Img_LFlt; use System.Img_LFlt; with System.Val_Fixed_32; use System.Val_Fixed_32; with System.Val_Fixed_64; use System.Val_Fixed_64; with System.Val_Fixed_128; use System.Val_Fixed_128; -with System.Val_LLF; use System.Val_LLF; +with System.Val_LFlt; use System.Val_LFlt; package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -- Note: we still use the floating-point I/O routines for types whose small -- is not the ratio of two sufficiently small integers. This will result in -- inaccuracies for fixed point types that require more precision than is - -- available in Long_Long_Float. + -- available in Long_Float. subtype Int32 is Interfaces.Integer_32; use type Int32; subtype Int64 is Interfaces.Integer_64; use type Int64; @@ -184,8 +185,8 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is package Aux128 is new Ada.Text_IO.Fixed_Aux (Int128, Scan_Fixed128, Set_Image_Fixed128); - package Aux_Long_Long_Float is new - Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + package Aux_Long_Float is new + Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float, Set_Image_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Int32 is OK, where type Int64 is OK and where type Int128 is OK. These @@ -323,7 +324,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width); + Aux_Long_Float.Get (File, Long_Float (Item), Width); end if; exception @@ -362,7 +363,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last); + Aux_Long_Float.Gets (From, Long_Float (Item), Last); end if; exception @@ -394,8 +395,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Put - (File, Long_Long_Float (Item), Fore, Aft, Exp); + Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp); end if; end Put; @@ -429,7 +429,7 @@ package body Ada.Text_IO.Fixed_IO with SPARK_Mode => Off is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp); + Aux_Long_Float.Puts (To, Long_Float (Item), Aft, Exp); end if; end Put; diff --git a/gcc/ada/libgnat/a-tiflau.adb b/gcc/ada/libgnat/a-tiflau.adb index e4dc259cb785..fa10f3fa5e08 100644 --- a/gcc/ada/libgnat/a-tiflau.adb +++ b/gcc/ada/libgnat/a-tiflau.adb @@ -31,7 +31,7 @@ with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux; -with System.Img_Real; use System.Img_Real; +with System.Img_Util; use System.Img_Util; package body Ada.Text_IO.Float_Aux is @@ -96,7 +96,7 @@ package body Ada.Text_IO.Float_Aux is Ptr : Natural := 0; begin - Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp); + Set_Image (Item, Buf, Ptr, Fore, Aft, Exp); Put_Item (File, Buf (1 .. Ptr)); end Put; @@ -114,8 +114,7 @@ package body Ada.Text_IO.Float_Aux is Ptr : Natural := 0; begin - Set_Image_Real - (Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp); + Set_Image (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp); if Ptr > To'Length then raise Layout_Error; diff --git a/gcc/ada/libgnat/a-tiflau.ads b/gcc/ada/libgnat/a-tiflau.ads index 741acab77cee..a095846e3cd0 100644 --- a/gcc/ada/libgnat/a-tiflau.ads +++ b/gcc/ada/libgnat/a-tiflau.ads @@ -45,6 +45,14 @@ private generic Ptr : not null access Integer; Max : Integer) return Num; + with procedure Set_Image + (V : Num; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural); + package Ada.Text_IO.Float_Aux is procedure Get diff --git a/gcc/ada/libgnat/a-tiflio.adb b/gcc/ada/libgnat/a-tiflio.adb index ab6ca9fc9db4..1df359058d0d 100644 --- a/gcc/ada/libgnat/a-tiflio.adb +++ b/gcc/ada/libgnat/a-tiflio.adb @@ -30,6 +30,9 @@ ------------------------------------------------------------------------------ with Ada.Text_IO.Float_Aux; +with System.Img_Flt; use System.Img_Flt; +with System.Img_LFlt; use System.Img_LFlt; +with System.Img_LLF; use System.Img_LLF; with System.Val_Flt; use System.Val_Flt; with System.Val_LFlt; use System.Val_LFlt; with System.Val_LLF; use System.Val_LLF; @@ -37,13 +40,15 @@ with System.Val_LLF; use System.Val_LLF; package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is package Aux_Float is new - Ada.Text_IO.Float_Aux (Float, Scan_Float); + Ada.Text_IO.Float_Aux (Float, Scan_Float, Set_Image_Float); package Aux_Long_Float is new - Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float); + Ada.Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); package Aux_Long_Long_Float is new - Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + Ada.Text_IO.Float_Aux + (Long_Long_Float, Scan_Long_Long_Float, Set_Image_Long_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Float is OK, where type Long_Float is OK and where type Long_Long_Float diff --git a/gcc/ada/libgnat/a-witeio.ads b/gcc/ada/libgnat/a-witeio.ads index 096bb0a4d8a9..910154d6e6f1 100644 --- a/gcc/ada/libgnat/a-witeio.ads +++ b/gcc/ada/libgnat/a-witeio.ads @@ -73,9 +73,6 @@ package Ada.Wide_Text_IO is -- Line and page length subtype Field is Integer range 0 .. 255; - -- Note: if for any reason, there is a need to increase this value, then it - -- will be necessary to change the corresponding value in System.Img_Real - -- in file s-imgrea.adb. subtype Number_Base is Integer range 2 .. 16; diff --git a/gcc/ada/libgnat/a-wtcoau.adb b/gcc/ada/libgnat/a-wtcoau.adb index 7b82f73bca15..d8dd79f8342a 100644 --- a/gcc/ada/libgnat/a-wtcoau.adb +++ b/gcc/ada/libgnat/a-wtcoau.adb @@ -31,8 +31,6 @@ with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux; -with System.Img_Real; use System.Img_Real; - package body Ada.Wide_Text_IO.Complex_Aux is --------- @@ -171,9 +169,9 @@ package body Ada.Wide_Text_IO.Complex_Aux is -- Both parts are initially converted with a Fore of 0 Rptr := 0; - Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp); + Aux.Set_Image (ItemR, R_String, Rptr, 0, Aft, Exp); Iptr := 0; - Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp); + Aux.Set_Image (ItemI, I_String, Iptr, 0, Aft, Exp); -- Check room for both parts plus parens plus comma (RM G.1.3(34)) diff --git a/gcc/ada/libgnat/a-wtcoau.ads b/gcc/ada/libgnat/a-wtcoau.ads index 7de0925a16ca..5541983611ab 100644 --- a/gcc/ada/libgnat/a-wtcoau.ads +++ b/gcc/ada/libgnat/a-wtcoau.ads @@ -42,7 +42,7 @@ private generic type Num is digits <>; - with package Aux is new Ada.Wide_Text_IO.Float_Aux (Num, <>); + with package Aux is new Ada.Wide_Text_IO.Float_Aux (Num, <>, <>); package Ada.Wide_Text_IO.Complex_Aux is diff --git a/gcc/ada/libgnat/a-wtcoio.adb b/gcc/ada/libgnat/a-wtcoio.adb index 501405d40b82..fcca1bb7a71b 100644 --- a/gcc/ada/libgnat/a-wtcoio.adb +++ b/gcc/ada/libgnat/a-wtcoio.adb @@ -31,6 +31,9 @@ with Ada.Wide_Text_IO.Complex_Aux; with Ada.Wide_Text_IO.Float_Aux; +with System.Img_Flt; use System.Img_Flt; +with System.Img_LFlt; use System.Img_LFlt; +with System.Img_LLF; use System.Img_LLF; with System.Val_Flt; use System.Val_Flt; with System.Val_LFlt; use System.Val_LFlt; with System.Val_LLF; use System.Val_LLF; @@ -42,22 +45,24 @@ package body Ada.Wide_Text_IO.Complex_IO is use Complex_Types; package Scalar_Float is new - Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float); + Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float, Set_Image_Float); package Scalar_Long_Float is new - Ada.Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float); + Ada.Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); package Scalar_Long_Long_Float is new - Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + Ada.Wide_Text_IO.Float_Aux + (Long_Long_Float, Scan_Long_Long_Float, Set_Image_Long_Long_Float); package Aux_Float is new - Ada.Wide_Text_IO.Complex_Aux (Float, Scalar_Float); + Ada.Wide_Text_IO.Complex_Aux (Float, Scalar_Float); package Aux_Long_Float is new - Ada.Wide_Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float); + Ada.Wide_Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float); package Aux_Long_Long_Float is new - Ada.Wide_Text_IO.Complex_Aux (Long_Long_Float, Scalar_Long_Long_Float); + Ada.Wide_Text_IO.Complex_Aux (Long_Long_Float, Scalar_Long_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Float is OK, where type Long_Float is OK and where type Long_Long_Float diff --git a/gcc/ada/libgnat/a-wtfiio.adb b/gcc/ada/libgnat/a-wtfiio.adb index e80f4249a5c1..954ab959808f 100644 --- a/gcc/ada/libgnat/a-wtfiio.adb +++ b/gcc/ada/libgnat/a-wtfiio.adb @@ -34,9 +34,10 @@ with Ada.Wide_Text_IO.Fixed_Aux; with Ada.Wide_Text_IO.Float_Aux; with System.Img_Fixed_32; use System.Img_Fixed_32; with System.Img_Fixed_64; use System.Img_Fixed_64; +with System.Img_LFlt; use System.Img_LFlt; with System.Val_Fixed_32; use System.Val_Fixed_32; with System.Val_Fixed_64; use System.Val_Fixed_64; -with System.Val_LLF; use System.Val_LLF; +with System.Val_LFlt; use System.Val_LFlt; with System.WCh_Con; use System.WCh_Con; with System.WCh_WtS; use System.WCh_WtS; @@ -45,7 +46,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -- Note: we still use the floating-point I/O routines for types whose small -- is not the ratio of two sufficiently small integers. This will result in -- inaccuracies for fixed point types that require more precision than is - -- available in Long_Long_Float. + -- available in Long_Float. subtype Int32 is Interfaces.Integer_32; use type Int32; subtype Int64 is Interfaces.Integer_64; use type Int64; @@ -56,8 +57,9 @@ package body Ada.Wide_Text_IO.Fixed_IO is package Aux64 is new Ada.Wide_Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64); - package Aux_Long_Long_Float is new - Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + package Aux_Long_Float is new + Ada.Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Int32 is OK and where type Int64 is OK. These boolean constants are used @@ -161,7 +163,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width); + Aux_Long_Float.Get (File, Long_Float (Item), Width); end if; exception @@ -201,7 +203,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last); + Aux_Long_Float.Gets (S, Long_Float (Item), Last); end if; exception @@ -229,8 +231,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Put - (File, Long_Long_Float (Item), Fore, Aft, Exp); + Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp); end if; end Put; @@ -262,7 +263,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp); + Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp); end if; for J in S'Range loop diff --git a/gcc/ada/libgnat/a-wtfiio__128.adb b/gcc/ada/libgnat/a-wtfiio__128.adb index 61d8cca2537a..d74902e8b30b 100644 --- a/gcc/ada/libgnat/a-wtfiio__128.adb +++ b/gcc/ada/libgnat/a-wtfiio__128.adb @@ -35,10 +35,11 @@ with Ada.Wide_Text_IO.Float_Aux; with System.Img_Fixed_32; use System.Img_Fixed_32; with System.Img_Fixed_64; use System.Img_Fixed_64; with System.Img_Fixed_128; use System.Img_Fixed_128; +with System.Img_LFlt; use System.Img_LFlt; with System.Val_Fixed_32; use System.Val_Fixed_32; with System.Val_Fixed_64; use System.Val_Fixed_64; with System.Val_Fixed_128; use System.Val_Fixed_128; -with System.Val_LLF; use System.Val_LLF; +with System.Val_LFlt; use System.Val_LFlt; with System.WCh_Con; use System.WCh_Con; with System.WCh_WtS; use System.WCh_WtS; @@ -47,7 +48,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -- Note: we still use the floating-point I/O routines for types whose small -- is not the ratio of two sufficiently small integers. This will result in -- inaccuracies for fixed point types that require more precision than is - -- available in Long_Long_Float. + -- available in Long_Float. subtype Int32 is Interfaces.Integer_32; use type Int32; subtype Int64 is Interfaces.Integer_64; use type Int64; @@ -62,8 +63,9 @@ package body Ada.Wide_Text_IO.Fixed_IO is package Aux128 is new Ada.Wide_Text_IO.Fixed_Aux (Int128, Scan_Fixed128, Set_Image_Fixed128); - package Aux_Long_Long_Float is new - Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + package Aux_Long_Float is new + Ada.Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Int32 is OK, where type Int64 is OK and where type Int128 is OK. These @@ -201,7 +203,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width); + Aux_Long_Float.Get (File, Long_Float (Item), Width); end if; exception @@ -246,7 +248,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last); + Aux_Long_Float.Gets (S, Long_Float (Item), Last); end if; exception @@ -278,8 +280,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Put - (File, Long_Long_Float (Item), Fore, Aft, Exp); + Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp); end if; end Put; @@ -315,7 +316,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp); + Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp); end if; for J in S'Range loop diff --git a/gcc/ada/libgnat/a-wtflau.adb b/gcc/ada/libgnat/a-wtflau.adb index 84f43d3c24d1..6f486b700316 100644 --- a/gcc/ada/libgnat/a-wtflau.adb +++ b/gcc/ada/libgnat/a-wtflau.adb @@ -31,7 +31,7 @@ with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux; -with System.Img_Real; use System.Img_Real; +with System.Img_Util; use System.Img_Util; package body Ada.Wide_Text_IO.Float_Aux is @@ -96,7 +96,7 @@ package body Ada.Wide_Text_IO.Float_Aux is Ptr : Natural := 0; begin - Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp); + Set_Image (Item, Buf, Ptr, Fore, Aft, Exp); Put_Item (File, Buf (1 .. Ptr)); end Put; @@ -114,8 +114,7 @@ package body Ada.Wide_Text_IO.Float_Aux is Ptr : Natural := 0; begin - Set_Image_Real - (Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp); + Set_Image (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp); if Ptr > To'Length then raise Layout_Error; diff --git a/gcc/ada/libgnat/a-wtflau.ads b/gcc/ada/libgnat/a-wtflau.ads index 6ce4b12cf609..0303b6323b27 100644 --- a/gcc/ada/libgnat/a-wtflau.ads +++ b/gcc/ada/libgnat/a-wtflau.ads @@ -45,6 +45,14 @@ private generic Ptr : not null access Integer; Max : Integer) return Num; + with procedure Set_Image + (V : Num; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural); + package Ada.Wide_Text_IO.Float_Aux is procedure Get diff --git a/gcc/ada/libgnat/a-wtflio.adb b/gcc/ada/libgnat/a-wtflio.adb index 3d20a8c147ab..acbe1f526598 100644 --- a/gcc/ada/libgnat/a-wtflio.adb +++ b/gcc/ada/libgnat/a-wtflio.adb @@ -30,6 +30,9 @@ ------------------------------------------------------------------------------ with Ada.Wide_Text_IO.Float_Aux; +with System.Img_Flt; use System.Img_Flt; +with System.Img_LFlt; use System.Img_LFlt; +with System.Img_LLF; use System.Img_LLF; with System.Val_Flt; use System.Val_Flt; with System.Val_LFlt; use System.Val_LFlt; with System.Val_LLF; use System.Val_LLF; @@ -39,13 +42,15 @@ with System.WCh_WtS; use System.WCh_WtS; package body Ada.Wide_Text_IO.Float_IO is package Aux_Float is new - Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float); + Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float, Set_Image_Float); package Aux_Long_Float is new - Ada.Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float); + Ada.Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); package Aux_Long_Long_Float is new - Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + Ada.Wide_Text_IO.Float_Aux + (Long_Long_Float, Scan_Long_Long_Float, Set_Image_Long_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Float is OK, where type Long_Float is OK and where type Long_Long_Float diff --git a/gcc/ada/libgnat/a-ztcoau.adb b/gcc/ada/libgnat/a-ztcoau.adb index 4de877d0b58e..a36782787d4c 100644 --- a/gcc/ada/libgnat/a-ztcoau.adb +++ b/gcc/ada/libgnat/a-ztcoau.adb @@ -31,8 +31,6 @@ with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux; -with System.Img_Real; use System.Img_Real; - package body Ada.Wide_Wide_Text_IO.Complex_Aux is --------- @@ -171,9 +169,9 @@ package body Ada.Wide_Wide_Text_IO.Complex_Aux is -- Both parts are initially converted with a Fore of 0 Rptr := 0; - Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp); + Aux.Set_Image (ItemR, R_String, Rptr, 0, Aft, Exp); Iptr := 0; - Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp); + Aux.Set_Image (ItemI, I_String, Iptr, 0, Aft, Exp); -- Check room for both parts plus parens plus comma (RM G.1.3(34)) diff --git a/gcc/ada/libgnat/a-ztcoau.ads b/gcc/ada/libgnat/a-ztcoau.ads index 43546d804dfc..953ed5d9a184 100644 --- a/gcc/ada/libgnat/a-ztcoau.ads +++ b/gcc/ada/libgnat/a-ztcoau.ads @@ -26,7 +26,7 @@ private generic type Num is digits <>; - with package Aux is new Ada.Wide_Wide_Text_IO.Float_Aux (Num, <>); + with package Aux is new Ada.Wide_Wide_Text_IO.Float_Aux (Num, <>, <>); package Ada.Wide_Wide_Text_IO.Complex_Aux is diff --git a/gcc/ada/libgnat/a-ztcoio.adb b/gcc/ada/libgnat/a-ztcoio.adb index bb027c7da032..9ec590a9423b 100644 --- a/gcc/ada/libgnat/a-ztcoio.adb +++ b/gcc/ada/libgnat/a-ztcoio.adb @@ -31,6 +31,9 @@ with Ada.Wide_Wide_Text_IO.Complex_Aux; with Ada.Wide_Wide_Text_IO.Float_Aux; +with System.Img_Flt; use System.Img_Flt; +with System.Img_LFlt; use System.Img_LFlt; +with System.Img_LLF; use System.Img_LLF; with System.Val_Flt; use System.Val_Flt; with System.Val_LFlt; use System.Val_LFlt; with System.Val_LLF; use System.Val_LLF; @@ -42,23 +45,25 @@ package body Ada.Wide_Wide_Text_IO.Complex_IO is use Complex_Types; package Scalar_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float); + Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float, Set_Image_Float); package Scalar_Long_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float); + Ada.Wide_Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); package Scalar_Long_Long_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + Ada.Wide_Wide_Text_IO.Float_Aux + (Long_Long_Float, Scan_Long_Long_Float, Set_Image_Long_Long_Float); package Aux_Float is new - Ada.Wide_Wide_Text_IO.Complex_Aux (Float, Scalar_Float); + Ada.Wide_Wide_Text_IO.Complex_Aux (Float, Scalar_Float); package Aux_Long_Float is new - Ada.Wide_Wide_Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float); + Ada.Wide_Wide_Text_IO.Complex_Aux (Long_Float, Scalar_Long_Float); package Aux_Long_Long_Float is new - Ada.Wide_Wide_Text_IO.Complex_Aux - (Long_Long_Float, Scalar_Long_Long_Float); + Ada.Wide_Wide_Text_IO.Complex_Aux + (Long_Long_Float, Scalar_Long_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Float is OK, where type Long_Float is OK and where type Long_Long_Float diff --git a/gcc/ada/libgnat/a-ztexio.ads b/gcc/ada/libgnat/a-ztexio.ads index 8a817d5f9b61..5983e0ed6b16 100644 --- a/gcc/ada/libgnat/a-ztexio.ads +++ b/gcc/ada/libgnat/a-ztexio.ads @@ -73,9 +73,6 @@ package Ada.Wide_Wide_Text_IO is -- Line and page length subtype Field is Integer range 0 .. 255; - -- Note: if for any reason, there is a need to increase this value, then it - -- will be necessary to change the corresponding value in System.Img_Real - -- in file s-imgrea.adb. subtype Number_Base is Integer range 2 .. 16; diff --git a/gcc/ada/libgnat/a-ztfiio.adb b/gcc/ada/libgnat/a-ztfiio.adb index 8ac3c1fb85ed..5c12e2a0768c 100644 --- a/gcc/ada/libgnat/a-ztfiio.adb +++ b/gcc/ada/libgnat/a-ztfiio.adb @@ -34,9 +34,10 @@ with Ada.Wide_Wide_Text_IO.Fixed_Aux; with Ada.Wide_Wide_Text_IO.Float_Aux; with System.Img_Fixed_32; use System.Img_Fixed_32; with System.Img_Fixed_64; use System.Img_Fixed_64; +with System.Img_LFlt; use System.Img_LFlt; with System.Val_Fixed_32; use System.Val_Fixed_32; with System.Val_Fixed_64; use System.Val_Fixed_64; -with System.Val_LLF; use System.Val_LLF; +with System.Val_LFlt; use System.Val_LFlt; with System.WCh_Con; use System.WCh_Con; with System.WCh_WtS; use System.WCh_WtS; @@ -45,7 +46,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -- Note: we still use the floating-point I/O routines for types whose small -- is not the ratio of two sufficiently small integers. This will result in -- inaccuracies for fixed point types that require more precision than is - -- available in Long_Long_Float. + -- available in Long_Float. subtype Int32 is Interfaces.Integer_32; use type Int32; subtype Int64 is Interfaces.Integer_64; use type Int64; @@ -56,8 +57,9 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is package Aux64 is new Ada.Wide_Wide_Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64); - package Aux_Long_Long_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + package Aux_Long_Float is new + Ada.Wide_Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Int32 is OK and where type Int64 is OK. These boolean constants are used @@ -161,7 +163,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width); + Aux_Long_Float.Get (File, Long_Float (Item), Width); end if; exception @@ -201,7 +203,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last); + Aux_Long_Float.Gets (S, Long_Float (Item), Last); end if; exception @@ -229,8 +231,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Put - (File, Long_Long_Float (Item), Fore, Aft, Exp); + Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp); end if; end Put; @@ -262,7 +263,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp); + Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp); end if; for J in S'Range loop diff --git a/gcc/ada/libgnat/a-ztfiio__128.adb b/gcc/ada/libgnat/a-ztfiio__128.adb index 0b97bee9fcef..f089fd64922f 100644 --- a/gcc/ada/libgnat/a-ztfiio__128.adb +++ b/gcc/ada/libgnat/a-ztfiio__128.adb @@ -35,10 +35,11 @@ with Ada.Wide_Wide_Text_IO.Float_Aux; with System.Img_Fixed_32; use System.Img_Fixed_32; with System.Img_Fixed_64; use System.Img_Fixed_64; with System.Img_Fixed_128; use System.Img_Fixed_128; +with System.Img_LFlt; use System.Img_LFlt; with System.Val_Fixed_32; use System.Val_Fixed_32; with System.Val_Fixed_64; use System.Val_Fixed_64; with System.Val_Fixed_128; use System.Val_Fixed_128; -with System.Val_LLF; use System.Val_LLF; +with System.Val_LFlt; use System.Val_LFlt; with System.WCh_Con; use System.WCh_Con; with System.WCh_WtS; use System.WCh_WtS; @@ -47,7 +48,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -- Note: we still use the floating-point I/O routines for types whose small -- is not the ratio of two sufficiently small integers. This will result in -- inaccuracies for fixed point types that require more precision than is - -- available in Long_Long_Float. + -- available in Long_Float. subtype Int32 is Interfaces.Integer_32; use type Int32; subtype Int64 is Interfaces.Integer_64; use type Int64; @@ -63,8 +64,9 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is Ada.Wide_Wide_Text_IO.Fixed_Aux (Int128, Scan_Fixed128, Set_Image_Fixed128); - package Aux_Long_Long_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + package Aux_Long_Float is new + Ada.Wide_Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Int32 is OK, where type Int64 is OK and where type Int128 is OK. These @@ -202,7 +204,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width); + Aux_Long_Float.Get (File, Long_Float (Item), Width); end if; exception @@ -247,7 +249,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator)); else - Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last); + Aux_Long_Float.Gets (S, Long_Float (Item), Last); end if; exception @@ -279,8 +281,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Put - (File, Long_Long_Float (Item), Fore, Aft, Exp); + Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp); end if; end Put; @@ -316,7 +317,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is -Num'Small_Numerator, -Num'Small_Denominator, For0, Num'Aft); else - Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp); + Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp); end if; for J in S'Range loop diff --git a/gcc/ada/libgnat/a-ztflau.adb b/gcc/ada/libgnat/a-ztflau.adb index 2fefeb6cb6ad..d7dd9e22319e 100644 --- a/gcc/ada/libgnat/a-ztflau.adb +++ b/gcc/ada/libgnat/a-ztflau.adb @@ -31,7 +31,7 @@ with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux; -with System.Img_Real; use System.Img_Real; +with System.Img_Util; use System.Img_Util; package body Ada.Wide_Wide_Text_IO.Float_Aux is @@ -96,7 +96,7 @@ package body Ada.Wide_Wide_Text_IO.Float_Aux is Ptr : Natural := 0; begin - Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp); + Set_Image (Item, Buf, Ptr, Fore, Aft, Exp); Put_Item (File, Buf (1 .. Ptr)); end Put; @@ -114,8 +114,7 @@ package body Ada.Wide_Wide_Text_IO.Float_Aux is Ptr : Natural := 0; begin - Set_Image_Real - (Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp); + Set_Image (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp); if Ptr > To'Length then raise Layout_Error; diff --git a/gcc/ada/libgnat/a-ztflau.ads b/gcc/ada/libgnat/a-ztflau.ads index c34c185799e2..769e20ec5578 100644 --- a/gcc/ada/libgnat/a-ztflau.ads +++ b/gcc/ada/libgnat/a-ztflau.ads @@ -45,6 +45,14 @@ private generic Ptr : not null access Integer; Max : Integer) return Num; + with procedure Set_Image + (V : Num; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural); + package Ada.Wide_Wide_Text_IO.Float_Aux is procedure Get diff --git a/gcc/ada/libgnat/a-ztflio.adb b/gcc/ada/libgnat/a-ztflio.adb index 83ec13053f78..755069569e7c 100644 --- a/gcc/ada/libgnat/a-ztflio.adb +++ b/gcc/ada/libgnat/a-ztflio.adb @@ -30,6 +30,9 @@ ------------------------------------------------------------------------------ with Ada.Wide_Wide_Text_IO.Float_Aux; +with System.Img_Flt; use System.Img_Flt; +with System.Img_LFlt; use System.Img_LFlt; +with System.Img_LLF; use System.Img_LLF; with System.Val_Flt; use System.Val_Flt; with System.Val_LFlt; use System.Val_LFlt; with System.Val_LLF; use System.Val_LLF; @@ -39,13 +42,15 @@ with System.WCh_WtS; use System.WCh_WtS; package body Ada.Wide_Wide_Text_IO.Float_IO is package Aux_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float); + Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float, Set_Image_Float); package Aux_Long_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float); + Ada.Wide_Wide_Text_IO.Float_Aux + (Long_Float, Scan_Long_Float, Set_Image_Long_Float); package Aux_Long_Long_Float is new - Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float); + Ada.Wide_Wide_Text_IO.Float_Aux + (Long_Long_Float, Scan_Long_Long_Float, Set_Image_Long_Long_Float); -- Throughout this generic body, we distinguish between the case where type -- Float is OK, where type Long_Float is OK and where type Long_Long_Float diff --git a/gcc/ada/libgnat/s-dorepr.adb b/gcc/ada/libgnat/s-dorepr.adb new file mode 100644 index 000000000000..6ae163219894 --- /dev/null +++ b/gcc/ada/libgnat/s-dorepr.adb @@ -0,0 +1,154 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . D O U B L E _ R E A L . P R O D U C T -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the default version of the separate package body + +with Interfaces; use Interfaces; + +separate (System.Double_Real) + +package body Product is + + procedure Split (N : Num; Hi : out Num; Lo : out Num); + -- Compute high word and low word of N + + ----------- + -- Split -- + ----------- + + -- We use a bit manipulation algorithm instead of Veltkamp's splitting + -- because it is faster and has the property that the magnitude of the + -- high part is never larger than that of the input number, which will + -- avoid spurious overflows in the Two_Prod algorithm. + + -- See the recent paper by Claude-Pierre Jeannerod, Jean-Michel Muller + -- and Paul Zimmermann: On various ways to split a floating-point number + -- ARITH 2018 - 25th IEEE Symposium on Computer Arithmetic, Jun 2018, + -- Amherst (MA), United States. pp.53-60. + + procedure Split (N : Num; Hi : out Num; Lo : out Num) is + M : constant Positive := Num'Machine_Mantissa; + + Rep32 : Interfaces.Unsigned_32; + Rep64 : Interfaces.Unsigned_64; + Rep80 : array (1 .. 2) of Interfaces.Unsigned_64; + + X : Num; + for X'Address use (case M is when 24 => Rep32'Address, + when 53 => Rep64'Address, + when 64 => Rep80'Address, + when others => raise Program_Error); + + begin + X := N; + + case M is + when 24 => + -- Mask out the low 12 bits + + Rep32 := Rep32 and 16#FFFFF000#; + + when 53 => + -- Mask out the low 27 bits + + Rep64 := Rep64 and 16#FFFFFFFFF8000000#; + + when 64 => + -- Mask out the low 32 bits + + if System.Default_Bit_Order = High_Order_First then + Rep80 (1) := Rep80 (1) and 16#FFFFFFFFFFFF0000#; + Rep80 (2) := Rep80 (2) and 16#0000FFFFFFFFFFFF#; + else + Rep80 (1) := Rep80 (1) and 16#FFFFFFFF00000000#; + end if; + + when others => + raise Program_Error; + end case; + + -- Deal with denormalized numbers + + if X = 0.0 then + Hi := N; + Lo := 0.0; + else + Hi := X; + Lo := N - X; + end if; + end Split; + + -------------- + -- Two_Prod -- + -------------- + + function Two_Prod (A, B : Num) return Double_T is + P : constant Num := A * B; + + Ahi, Alo, Bhi, Blo, E : Num; + + begin + if Is_Infinity (P) or else Is_Zero (P) then + return (P, 0.0); + + else + Split (A, Ahi, Alo); + Split (B, Bhi, Blo); + + E := ((Ahi * Bhi - P) + Ahi * Blo + Alo * Bhi) + Alo * Blo; + + return (P, E); + end if; + end Two_Prod; + + ------------- + -- Two_Sqr -- + ------------- + + function Two_Sqr (A : Num) return Double_T is + Q : constant Num := A * A; + + Hi, Lo, E : Num; + + begin + if Is_Infinity (Q) or else Is_Zero (Q) then + return (Q, 0.0); + + else + Split (A, Hi, Lo); + + E := ((Hi * Hi - Q) + 2.0 * Hi * Lo) + Lo * Lo; + + return (Q, E); + end if; + end Two_Sqr; + +end Product; diff --git a/gcc/ada/libgnat/s-dorepr__fma.adb b/gcc/ada/libgnat/s-dorepr__fma.adb new file mode 100644 index 000000000000..56d4dbb82859 --- /dev/null +++ b/gcc/ada/libgnat/s-dorepr__fma.adb @@ -0,0 +1,97 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . D O U B L E _ R E A L . P R O D U C T -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version of the separate package body for targets with an FMA + +separate (System.Double_Real) + +package body Product is + + function Fused_Multiply_Add (A, B, C : Num) return Num; + -- Return the result of A * B + C without intermediate rounding + + ------------------------ + -- Fused_Multiply_Add -- + ------------------------ + + function Fused_Multiply_Add (A, B, C : Num) return Num is + begin + case Num'Size is + when 32 => + declare + function Do_FMA (A, B, C : Num) return Num; + pragma Import (Intrinsic, Do_FMA, "__builtin_fmaf"); + + begin + return Do_FMA (A, B, C); + end; + + when 64 => + declare + function Do_FMA (A, B, C : Num) return Num; + pragma Import (Intrinsic, Do_FMA, "__builtin_fma"); + + begin + return Do_FMA (A, B, C); + end; + + when others => + raise Program_Error; + end case; + end Fused_Multiply_Add; + + -------------- + -- Two_Prod -- + -------------- + + function Two_Prod (A, B : Num) return Double_T is + P : constant Num := A * B; + + E : Num; + + begin + if Is_Infinity (P) or else Is_Zero (P) then + return (P, 0.0); + + else + E := Fused_Multiply_Add (A, B, -P); + + return (P, E); + end if; + end Two_Prod; + + ------------- + -- Two_Sqr -- + ------------- + + function Two_Sqr (A : Num) return Double_T is (Two_Prod (A, A)); + +end Product; diff --git a/gcc/ada/libgnat/s-dourea.adb b/gcc/ada/libgnat/s-dourea.adb new file mode 100644 index 000000000000..53bed1db4b39 --- /dev/null +++ b/gcc/ada/libgnat/s-dourea.adb @@ -0,0 +1,258 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . D O U B L E _ R E A L -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +package body System.Double_Real is + + function Is_NaN (N : Num) return Boolean is (N /= N); + -- Return True if N is a NaN + + function Is_Infinity (N : Num) return Boolean is (Is_NaN (N - N)); + -- Return True if N is an infinity. Used to avoid propagating meaningless + -- errors when the result of a product is an infinity. + + function Is_Zero (N : Num) return Boolean is (N = -N); + -- Return True if N is a Zero. Used to preserve the sign when the result of + -- a product is a zero. + + package Product is + function Two_Prod (A, B : Num) return Double_T; + function Two_Sqr (A : Num) return Double_T; + end Product; + -- The low-level implementation of multiplicative operations + + package body Product is separate; + -- This is a separate body because the implementation depends on whether a + -- Fused Multiply-Add instruction is available on the target. + + ------------------- + -- Quick_Two_Sum -- + ------------------- + + function Quick_Two_Sum (A, B : Num) return Double_T is + S : constant Num := A + B; + V : constant Num := S - A; + E : constant Num := B - V; + + begin + return (S, E); + end Quick_Two_Sum; + + ------------- + -- Two_Sum -- + ------------- + + function Two_Sum (A, B : Num) return Double_T is + S : constant Num := A + B; + V : constant Num := S - A; + E : constant Num := (A - (S - V)) + (B - V); + + begin + return (S, E); + end Two_Sum; + + -------------- + -- Two_Diff -- + -------------- + + function Two_Diff (A, B : Num) return Double_T is + S : constant Num := A - B; + V : constant Num := S - A; + E : constant Num := (A - (S - V)) - (B + V); + + begin + return (S, E); + end Two_Diff; + + -------------- + -- Two_Prod -- + -------------- + + function Two_Prod (A, B : Num) return Double_T renames Product.Two_Prod; + + ------------- + -- Two_Sqr -- + ------------- + + function Two_Sqr (A : Num) return Double_T renames Product.Two_Sqr; + + --------- + -- "+" -- + --------- + + function "+" (A : Double_T; B : Num) return Double_T is + S : constant Double_T := Two_Sum (A.Hi, B); + + begin + return Quick_Two_Sum (S.Hi, S.Lo + A.Lo); + end "+"; + + function "+" (A, B : Double_T) return Double_T is + S1 : constant Double_T := Two_Sum (A.Hi, B.Hi); + S2 : constant Double_T := Two_Sum (A.Lo, B.Lo); + S3 : constant Double_T := Quick_Two_Sum (S1.Hi, S1.Lo + S2.Hi); + + begin + return Quick_Two_Sum (S3.Hi, S3.Lo + S2.Lo); + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (A : Double_T; B : Num) return Double_T is + D : constant Double_T := Two_Diff (A.Hi, B); + + begin + return Quick_Two_Sum (D.Hi, D.Lo + A.Lo); + end "-"; + + function "-" (A, B : Double_T) return Double_T is + D1 : constant Double_T := Two_Diff (A.Hi, B.Hi); + D2 : constant Double_T := Two_Diff (A.Lo, B.Lo); + D3 : constant Double_T := Quick_Two_Sum (D1.Hi, D1.Lo + D2.Hi); + + begin + return Quick_Two_Sum (D3.Hi, D3.Lo + D2.Lo); + end "-"; + + --------- + -- "*" -- + --------- + + function "*" (A : Double_T; B : Num) return Double_T is + P : constant Double_T := Two_Prod (A.Hi, B); + + begin + if Is_Infinity (P.Hi) or else Is_Zero (P.Hi) then + return (P.Hi, 0.0); + else + return Quick_Two_Sum (P.Hi, P.Lo + A.Lo * B); + end if; + end "*"; + + function "*" (A, B : Double_T) return Double_T is + P : constant Double_T := Two_Prod (A.Hi, B.Hi); + + begin + if Is_Infinity (P.Hi) or else Is_Zero (P.Hi) then + return (P.Hi, 0.0); + else + return Quick_Two_Sum (P.Hi, P.Lo + A.Hi * B.Lo + A.Lo * B.Hi); + end if; + end "*"; + + --------- + -- "/" -- + --------- + + function "/" (A : Double_T; B : Num) return Double_T is + Q1, Q2 : Num; + P, R : Double_T; + + begin + Q1 := A.Hi / B; + + -- Compute R = A - B * Q1 + + P := Two_Prod (B, Q1); + R := Two_Diff (A.Hi, P.Hi); + R.Lo := (R.Lo + A.Lo) - P.Lo; + + Q2 := (R.Hi + R.Lo) / B; + + return Quick_Two_Sum (Q1, Q2); + end "/"; + + function "/" (A, B : Double_T) return Double_T is + Q1, Q2, Q3 : Num; + R, S : Double_T; + + begin + Q1 := A.Hi / B.Hi; + R := A - B * Q1; + + Q2 := R.Hi / B.Hi; + R := R - B * Q2; + + Q3 := R.Hi / B.Hi; + + S := Quick_Two_Sum (Q1, Q2); + return Quick_Two_Sum (S.Hi, S.Lo + Q3); + end "/"; + + --------- + -- Sqr -- + --------- + + function Sqr (A : Double_T) return Double_T is + Q : constant Double_T := Two_Sqr (A.Hi); + + begin + if Is_Infinity (Q.Hi) or else Is_Zero (Q.Hi) then + return (Q.Hi, 0.0); + else + return Quick_Two_Sum (Q.Hi, Q.Lo + 2.0 * A.Hi * A.Lo + A.Lo * A.Lo); + end if; + end Sqr; + + ------------------- + -- From_Unsigned -- + ------------------- + + function From_Unsigned (U : Uns) return Double_T is + begin + return To_Double (Num (U)); + end From_Unsigned; + + ----------------- + -- To_Unsigned -- + ----------------- + + function To_Unsigned (D : Double_T) return Uns is + Hi : constant Num := Num'Truncation (D.Hi); + + begin + -- If the high part is already an integer, add Floor of the low part, + -- which means subtract Ceiling of its opposite if it is negative. + + if Hi = D.Hi then + if D.Lo < 0.0 then + return Uns (Hi) - Uns (Num'Ceiling (-D.Lo)); + else + return Uns (Hi) + Uns (Num'Floor (D.Lo)); + end if; + + else + return Uns (Hi); + end if; + end To_Unsigned; + +end System.Double_Real; diff --git a/gcc/ada/libgnat/s-dourea.ads b/gcc/ada/libgnat/s-dourea.ads new file mode 100644 index 000000000000..0c97f346bbd0 --- /dev/null +++ b/gcc/ada/libgnat/s-dourea.ads @@ -0,0 +1,123 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . D O U B L E _ R E A L -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains routines for supporting floating-point computations +-- in double precision, i.e. using a second number to estimate the error due +-- to rounding and more generally performing computations with twice as many +-- bits of mantissa. It is based on the Double-Double library available at +-- https://www.davidhbailey.com/dhbsoftware written by David H.Bailey et al. + +generic + + type Num is digits <>; + +package System.Double_Real is + pragma Pure; + + type Double_T is record + Hi, Lo : Num; + end record; + + function To_Double (N : Num) return Double_T is ((Hi => N, Lo => 0.0)); + -- Convert a single to a double real + + function To_Single (D : Double_T) return Num is (D.Hi); + -- Convert a double to a single real + + function Quick_Two_Sum (A, B : Num) return Double_T + with Pre => A = 0.0 or else abs (A) >= abs (B); + -- Compute A + B and its rounding error exactly, but assume |A| >= |B| + + function Two_Sum (A, B : Num) return Double_T; + -- Compute A + B and its rounding error exactly + + function Two_Diff (A, B : Num) return Double_T; + -- Compute A - B and its rounding error exactly + + function Two_Prod (A, B : Num) return Double_T; + -- Compute A * B and its rounding error exactly + + function Two_Sqr (A : Num) return Double_T; + -- Compute A * A and its rounding error exactly + + function "+" (A : Double_T; B : Num) return Double_T; + function "-" (A : Double_T; B : Num) return Double_T; + function "*" (A : Double_T; B : Num) return Double_T; + function "/" (A : Double_T; B : Num) return Double_T + with Pre => B /= 0.0; + -- Mixed precision arithmetic operations + + function "+" (A, B : Double_T) return Double_T; + function "-" (A, B : Double_T) return Double_T; + function "*" (A, B : Double_T) return Double_T; + function "/" (A, B : Double_T) return Double_T + with Pre => B.Hi /= 0.0; + -- Double precision arithmetic operations + + function Sqr (A : Double_T) return Double_T; + -- Faster version of A * A + + function "=" (A : Double_T; B : Num) return Boolean is + (A.Hi = B and then A.Lo = 0.0); + function "<" (A : Double_T; B : Num) return Boolean is + (A.Hi < B or else (A.Hi = B and then A.Lo < 0.0)); + function "<=" (A : Double_T; B : Num) return Boolean is + (A.Hi < B or else (A.Hi = B and then A.Lo <= 0.0)); + function ">" (A : Double_T; B : Num) return Boolean is + (A.Hi > B or else (A.Hi = B and then A.Lo > 0.0)); + function ">=" (A : Double_T; B : Num) return Boolean is + (A.Hi > B or else (A.Hi = B and then A.Lo >= 0.0)); + -- Mixed precision comparisons + + function "=" (A, B : Double_T) return Boolean is + (A.Hi = B.Hi and then A.Lo = B.Lo); + function "<" (A, B : Double_T) return Boolean is + (A.Hi < B.Hi or else (A.Hi = B.Hi and then A.Lo < B.Lo)); + function "<=" (A, B : Double_T) return Boolean is + (A.Hi < B.Hi or else (A.Hi = B.Hi and then A.Lo <= B.Lo)); + function ">" (A, B : Double_T) return Boolean is + (A.Hi > B.Hi or else (A.Hi = B.Hi and then A.Lo > B.Lo)); + function ">=" (A, B : Double_T) return Boolean is + (A.Hi > B.Hi or else (A.Hi = B.Hi and then A.Lo >= B.Lo)); + -- Double precision comparisons + + generic + type Uns is mod <>; + function From_Unsigned (U : Uns) return Double_T; + -- Convert Uns to Double_T + + generic + type Uns is mod <>; + function To_Unsigned (D : Double_T) return Uns + with Pre => D >= 0.0; + -- Convert Double_T to Uns with truncation + +end System.Double_Real; diff --git a/gcc/ada/libgnat/s-forrea.adb b/gcc/ada/libgnat/s-forrea.adb index 37707bae156d..739ac921302b 100644 --- a/gcc/ada/libgnat/s-forrea.adb +++ b/gcc/ada/libgnat/s-forrea.adb @@ -31,12 +31,12 @@ package body System.Fore_Real is - --------------- - -- Fore_Real -- - --------------- + ---------------- + -- Fore_Fixed -- + ---------------- - function Fore_Real (Lo, Hi : Long_Long_Float) return Natural is - T : Long_Long_Float := Long_Long_Float'Max (abs Lo, abs Hi); + function Fore_Fixed (Lo, Hi : Long_Float) return Natural is + T : Long_Float := Long_Float'Max (abs Lo, abs Hi); F : Natural; begin @@ -52,6 +52,6 @@ package body System.Fore_Real is end loop; return F; - end Fore_Real; + end Fore_Fixed; end System.Fore_Real; diff --git a/gcc/ada/libgnat/s-forrea.ads b/gcc/ada/libgnat/s-forrea.ads index 72aa91ef5793..73784c0a93aa 100644 --- a/gcc/ada/libgnat/s-forrea.ads +++ b/gcc/ada/libgnat/s-forrea.ads @@ -29,14 +29,14 @@ -- -- ------------------------------------------------------------------------------ --- This package contains the routine used for the Fore attribute of ordinary --- fixed point types whose Small is neither an integer nor its reciprocal. +-- This package contains the routine for the Fore attribute of ordinary fixed +-- point types whose Small is not a ratio of two sufficiently small integers. package System.Fore_Real is pragma Pure; - function Fore_Real (Lo, Hi : Long_Long_Float) return Natural; + function Fore_Fixed (Lo, Hi : Long_Float) return Natural; -- Compute Fore attribute value for a fixed point type. The parameters - -- are the low and high bounds, converted to Long_Long_Float. + -- are the low and high bounds, converted to Long_Float. end System.Fore_Real; diff --git a/gcc/ada/libgnat/s-imagef.ads b/gcc/ada/libgnat/s-imagef.ads index e5547fec7a9a..cac268a753dd 100644 --- a/gcc/ada/libgnat/s-imagef.ads +++ b/gcc/ada/libgnat/s-imagef.ads @@ -60,7 +60,7 @@ package System.Image_F is -- For0 and Aft0 are the values of the Fore and Aft attributes for the -- fixed point type whose mantissa type is Int and whose small is Num/Den. -- This function is used only for fixed point whose Small is an integer or - -- its reciprocal (see package System.Img_Real for the handling of other + -- its reciprocal (see package System.Image_R for the handling of other -- ordinary fixed-point types). The caller guarantees that S is long enough -- to hold the result and has a lower bound of 1. diff --git a/gcc/ada/libgnat/s-imager.adb b/gcc/ada/libgnat/s-imager.adb new file mode 100644 index 000000000000..882bb27a60c7 --- /dev/null +++ b/gcc/ada/libgnat/s-imager.adb @@ -0,0 +1,464 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M A G E _ R -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2021, 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.Double_Real; +with System.Float_Control; +with System.Img_Util; use System.Img_Util; + +package body System.Image_R is + + -- The following defines the maximum number of digits that we can convert + -- accurately. This is limited by the precision of the Num type, and also + -- by the number of digits that can be held in the Uns type, which is the + -- integer type we use as an intermediate in the computation. But, in both + -- cases, we can work with a double value in these types. + + -- Note that in the following, the "-2" accounts for the space and one + -- extra digit, since we need the maximum number of 9's that can be + -- represented, e.g. for the 64-bit case, Long_Long_Unsigned'Width is + -- 21, since the maximum value (approx 1.8E+19) has 20 digits, but the + -- maximum number of 9's that can be represented is only 19. + + Maxdigs : constant Natural := 2 * Natural'Min (Uns'Width - 2, Num'Digits); + + Maxscaling : constant := 5000; + -- Max decimal scaling required during conversion of floating-point + -- numbers to decimal. This is used to defend against infinite + -- looping in the conversion, as can be caused by erroneous executions. + -- The largest exponent used on any current system is 2**16383, which + -- is approximately 10**4932, and the highest number of decimal digits + -- is about 35 for 128-bit floating-point formats, so 5000 leaves + -- enough room for scaling such values + + 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 From_Unsigned is new Double_Real.From_Unsigned (Uns); + function To_Unsigned is new Double_Real.To_Unsigned (Uns); + -- Convert betwwen a double Num and a single Uns + + function Is_Negative (V : Num) return Boolean; + -- Return True if V is negative for the purpose of the output, i.e. return + -- True for negative zeros only if Signed_Zeros is True. + + ----------------------- + -- Image_Fixed_Point -- + ----------------------- + + procedure Image_Fixed_Point + (V : Num; + S : in out String; + P : out Natural; + Aft : Natural) + is + pragma Assert (S'First = 1); + + begin + -- Output space at start if non-negative + + if V >= 0.0 then + S (1) := ' '; + P := 1; + else + P := 0; + end if; + + Set_Image_Real (V, S, P, 1, Aft, 0); + end Image_Fixed_Point; + + -------------------------- + -- Image_Floating_Point -- + -------------------------- + + procedure Image_Floating_Point + (V : Num; + S : in out String; + P : out Natural; + Digs : Natural) + is + pragma Assert (S'First = 1); + + begin + -- Decide whether a blank should be prepended before the call to + -- Set_Image_Real. We generate a blank for positive values, and + -- also for positive zeros. For negative zeros, we generate a + -- blank only if Signed_Zeros is False (the RM only permits the + -- output of -0.0 when Signed_Zeros is True). We do not generate + -- a blank for positive infinity, since we output an explicit +. + + if not Is_Negative (V) and then V <= Num'Last then + pragma Annotate (CodePeer, False_Positive, "condition predetermined", + "CodePeer analysis ignores NaN and Inf values"); + pragma Assert (S'Last > 1); + -- The caller is responsible for S to be large enough for all + -- Image_Floating_Point operation. + S (1) := ' '; + P := 1; + else + P := 0; + end if; + + Set_Image_Real (V, S, P, 1, Digs - 1, 3); + end Image_Floating_Point; + + ----------------- + -- Is_Negative -- + ----------------- + + function Is_Negative (V : Num) return Boolean is + begin + if V < 0.0 then + return True; + + elsif V > 0.0 then + return False; + + elsif not Num'Signed_Zeros then + return False; + + else + return Num'Copy_Sign (1.0, V) < 0.0; + end if; + end Is_Negative; + + -------------------- + -- Set_Image_Real -- + -------------------- + + procedure Set_Image_Real + (V : Num; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural) + is + Powten : constant array (0 .. Maxpow) of Double_T; + pragma Import (Ada, Powten); + for Powten'Address use Powten_Address; + + NFrac : constant Natural := Natural'Max (Aft, 1); + -- Number of digits after the decimal point + + Digs : String (1 .. 3 + Maxdigs); + -- Array used to hold digits of converted integer value + + Ndigs : Natural; + -- Number of digits stored in Digs (and also subscript of last digit) + + Scale : Integer := 0; + -- Exponent such that the result is Digs (1 .. NDigs) * 10**(-Scale) + + X : Double_T; + -- Current absolute value of the input after scaling + + procedure Adjust_Scale (S : Natural); + -- Adjusts the value in X by multiplying or dividing by a power of + -- ten so that it is in the range 10**(S-1) <= X < 10**S. Scale is + -- adjusted to reflect the power of ten used to divide the result, + -- i.e. one is added to the scale value for each multiplication by + -- 10.0 and one is subtracted for each division by 10.0. + + ------------------ + -- Adjust_Scale -- + ------------------ + + procedure Adjust_Scale (S : Natural) is + Lo, Mid, Hi : Natural; + XP : Double_T; + + begin + -- Cases where scaling up is required + + if X < Powten (S - 1) then + + -- What we are looking for is a power of ten to multiply X by + -- so that the result lies within the required range. + + loop + XP := X * Powten (Maxpow); + exit when XP >= Powten (S - 1) or else Scale > Maxscaling; + X := XP; + Scale := Scale + Maxpow; + end loop; + + -- The following exception is only raised in case of erroneous + -- execution, where a number was considered valid but still + -- fails to scale up. One situation where this can happen is + -- when a system which is supposed to be IEEE-compliant, but + -- has been reconfigured to flush denormals to zero. + + if Scale > Maxscaling then + raise Constraint_Error; + end if; + + -- Here we know that we must multiply by at least 10**1 and that + -- 10**Maxpow takes us too far: binary search to find right one. + + -- Because of roundoff errors, it is possible for the value + -- of XP to be just outside of the interval when Lo >= Hi. In + -- that case we adjust explicitly by a factor of 10. This + -- can only happen with a value that is very close to an + -- exact power of 10. + + Lo := 1; + Hi := Maxpow; + + loop + Mid := (Lo + Hi) / 2; + XP := X * Powten (Mid); + + if XP < Powten (S - 1) then + + if Lo >= Hi then + Mid := Mid + 1; + XP := XP * 10.0; + exit; + + else + Lo := Mid + 1; + end if; + + elsif XP >= Powten (S) then + + if Lo >= Hi then + Mid := Mid - 1; + XP := XP / 10.0; + exit; + + else + Hi := Mid - 1; + end if; + + else + exit; + end if; + end loop; + + X := XP; + Scale := Scale + Mid; + + -- Cases where scaling down is required + + elsif X >= Powten (S) then + + -- What we are looking for is a power of ten to divide X by + -- so that the result lies within the required range. + + loop + XP := X / Powten (Maxpow); + exit when XP < Powten (S) or else Scale < -Maxscaling; + X := XP; + Scale := Scale - Maxpow; + end loop; + + -- The following exception is only raised in case of erroneous + -- execution, where a number was considered valid but still + -- fails to scale up. One situation where this can happen is + -- when a system which is supposed to be IEEE-compliant, but + -- has been reconfigured to flush denormals to zero. + + if Scale < -Maxscaling then + raise Constraint_Error; + end if; + + -- Here we know that we must divide by at least 10**1 and that + -- 10**Maxpow takes us too far, binary search to find right one. + + Lo := 1; + Hi := Maxpow; + + loop + Mid := (Lo + Hi) / 2; + XP := X / Powten (Mid); + + if XP < Powten (S - 1) then + + if Lo >= Hi then + XP := XP * 10.0; + Mid := Mid - 1; + exit; + + else + Hi := Mid - 1; + end if; + + elsif XP >= Powten (S) then + + if Lo >= Hi then + XP := XP / 10.0; + Mid := Mid + 1; + exit; + + else + Lo := Mid + 1; + end if; + + else + exit; + end if; + end loop; + + X := XP; + Scale := Scale - Mid; + + -- Here we are already scaled right + + else + null; + end if; + end Adjust_Scale; + + -- Start of processing for Set_Image_Real + + begin + -- 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. + + if Num'Machine_Mantissa = 64 then + System.Float_Control.Reset; + end if; + + -- Deal with invalid values first + + if not V'Valid then + + -- Note that we're taking our chances here, as V might be + -- an invalid bit pattern resulting from erroneous execution + -- (caused by using uninitialized variables for example). + + -- No matter what, we'll at least get reasonable behavior, + -- converting to infinity or some other value, or causing an + -- exception to be raised is fine. + + -- If the following two tests succeed, then we definitely have + -- an infinite value, so we print +Inf or -Inf. + + if V > Num'Last then + pragma Annotate (CodePeer, False_Positive, "dead code", + "CodePeer analysis ignores NaN and Inf values"); + pragma Annotate (CodePeer, False_Positive, "test always true", + "CodePeer analysis ignores NaN and Inf values"); + + Set_Floating_Invalid_Value (Infinity, S, P, Fore, Aft, Exp); + + elsif V < Num'First then + Set_Floating_Invalid_Value (Minus_Infinity, S, P, Fore, Aft, Exp); + + -- In all other cases we print NaN + + else + Set_Floating_Invalid_Value (Not_A_Number, S, P, Fore, Aft, Exp); + end if; + + return; + end if; + + -- Set the first character like Image + + Digs (1) := (if Is_Negative (V) then '-' else ' '); + Ndigs := 1; + + X := Double_Real.To_Double (abs (V)); + + -- If X is zero, we are done + + if X = 0.0 then + Digs (2) := '0'; + Ndigs := 2; + + -- Otherwise, scale X and convert it to an integer + + else + -- In exponent notation, we need exactly NFrac + 1 digits and always + -- round the last one. + + if Exp > 0 then + Adjust_Scale (Natural'Min (NFrac + 1, Maxdigs)); + X := X + 0.5; + + -- In straight notation, we compute the maximum number of digits and + -- compare how many of them will be put after the decimal point with + -- Nfrac, in order to find out whether we need to round the last one + -- here or whether the rounding is performed by Set_Decimal_Digits. + + else + Adjust_Scale (Maxdigs); + if Scale <= NFrac then + X := X + 0.5; + end if; + end if; + + -- If X fits in an Uns, do the conversion directly. Note that this is + -- always the case for the Image attribute. + + if X <= Num (Uns'Last) then + Set_Image_Unsigned (To_Unsigned (X), Digs, Ndigs); + + -- Otherwise, do the conversion in two steps + + else pragma Assert (X <= 10.0 ** Num'Digits * Num (Uns'Last)); + declare + Y : constant Uns := To_Unsigned (X / Powten (Num'Digits)); + + Buf : String (1 .. Num'Digits); + Len : Natural; + + begin + Set_Image_Unsigned (Y, Digs, Ndigs); + + X := X - From_Unsigned (Y) * Powten (Num'Digits); + + Len := 0; + Set_Image_Unsigned (To_Unsigned (X), Buf, Len); + + for J in 1 .. Num'Digits - Len loop + Digs (Ndigs + J) := '0'; + end loop; + + for J in 1 .. Len loop + Digs (Ndigs + Num'Digits - Len + J) := Buf (J); + end loop; + + Ndigs := Ndigs + Num'Digits; + end; + end if; + end if; + + Set_Decimal_Digits (Digs, Ndigs, S, P, Scale, Fore, Aft, Exp); + end Set_Image_Real; + +end System.Image_R; diff --git a/gcc/ada/libgnat/s-imager.ads b/gcc/ada/libgnat/s-imager.ads new file mode 100644 index 000000000000..1aa868775604 --- /dev/null +++ b/gcc/ada/libgnat/s-imager.ads @@ -0,0 +1,92 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M A G E _ R -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains routines for the Image attribute of real types, and +-- is also for Float_IO/Fixed_IO output. + +generic + + type Num is digits <>; + + Maxpow : Positive; + + Powten_Address : System.Address; + + type Uns is mod <>; + + with procedure Set_Image_Unsigned + (V : Uns; + S : in out String; + P : in out Natural); + +package System.Image_R is + pragma Pure; + + procedure Image_Fixed_Point + (V : Num; + S : in out String; + P : out Natural; + Aft : Natural); + -- Computes fixed_type'Image (V) and returns the result in S (1 .. P) + -- updating P on return. The result is computed according to the rules for + -- image for fixed-point types (RM 3.5(34)), where Aft is the value of the + -- Aft attribute for the fixed-point type. The caller guarantees that S is + -- long enough to hold the result and has a lower bound of 1. + -- + -- Note: this procedure should NOT be called with V = -0.0 or V = +/-Inf. + + procedure Image_Floating_Point + (V : Num; + S : in out String; + P : out Natural; + Digs : Natural); + -- Computes Uns'Image (V) and returns the result in S (1 .. P) updating P + -- on return. The result is computed according to the rules for image for + -- floating-point types (RM 3.5(33)), where Digs is the value of the Digits + -- attribute for the floating-point type. The caller guarantees that S is + -- long enough to hold the result and has a lower bound of 1. + + procedure Set_Image_Real + (V : Num; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural); + -- Sets the image of V starting at S (P + 1), updating P to point to the + -- last character stored, the caller promises that the buffer is large + -- enough and no check is made for this. Constraint_Error will not + -- necessarily be raised if this is violated, since it is perfectly valid + -- to compile this unit with checks off). The Fore, Aft and Exp values + -- can be set to any valid values for the case of use from Text_IO. Note + -- that no space is stored at the start for non-negative values. + +end System.Image_R; diff --git a/gcc/ada/libgnat/s-imgflt.ads b/gcc/ada/libgnat/s-imgflt.ads new file mode 100644 index 000000000000..44f00b828383 --- /dev/null +++ b/gcc/ada/libgnat/s-imgflt.ads @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ F L T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains routines for the Image attribute of floating point +-- types based on Float, also used for Float_IO output. + +with System.Image_R; +with System.Img_Uns; +with System.Powten_Flt; +with System.Unsigned_Types; + +package System.Img_Flt is + pragma Pure; + + package Impl is new Image_R + (Float, + System.Powten_Flt.Maxpow, + System.Powten_Flt.Powten'Address, + Unsigned_Types.Unsigned, + System.Img_Uns.Set_Image_Unsigned); + + procedure Image_Float + (V : Float; + S : in out String; + P : out Natural; + Digs : Natural) + renames Impl.Image_Floating_Point; + + procedure Set_Image_Float + (V : Float; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural) + renames Impl.Set_Image_Real; + +end System.Img_Flt; diff --git a/gcc/ada/libgnat/s-imglfl.ads b/gcc/ada/libgnat/s-imglfl.ads new file mode 100644 index 000000000000..48f7fc05a12b --- /dev/null +++ b/gcc/ada/libgnat/s-imglfl.ads @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ L F L T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains routines for the Image attribute of fixed or floating +-- point types based on Long_Float, also used for Float_IO/Fixed_IO output. + +with System.Img_LLU; +with System.Image_R; +with System.Powten_LFlt; +with System.Unsigned_Types; + +package System.Img_LFlt is + pragma Pure; + + -- Note that the following instantiation is really for a 32-bit target, + -- where 128-bit integer types are not available. For a 64-bit targaet, + -- it is possible to use Long_Long_Unsigned and Long_Long_Long_Unsigned + -- instead of Unsigned and Long_Long_Unsigned, in order to double the + -- number of significant digits. But we do not do it by default to avoid + -- dragging 128-bit integer types for the sake of backward compatibility. + + package Impl is new Image_R + (Long_Float, + System.Powten_LFlt.Maxpow, + System.Powten_LFlt.Powten'Address, + Unsigned_Types.Long_Long_Unsigned, + System.Img_LLU.Set_Image_Long_Long_Unsigned); + + procedure Image_Fixed + (V : Long_Float; + S : in out String; + P : out Natural; + Aft : Natural) + renames Impl.Image_Fixed_Point; + + procedure Image_Long_Float + (V : Long_Float; + S : in out String; + P : out Natural; + Digs : Natural) + renames Impl.Image_Floating_Point; + + procedure Set_Image_Long_Float + (V : Long_Float; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural) + renames Impl.Set_Image_Real; + +end System.Img_LFlt; diff --git a/gcc/ada/libgnat/s-imgllf.ads b/gcc/ada/libgnat/s-imgllf.ads new file mode 100644 index 000000000000..2a5a3e284775 --- /dev/null +++ b/gcc/ada/libgnat/s-imgllf.ads @@ -0,0 +1,73 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ L L F -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2021, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains routines for the Image attribute of floating point +-- types based on Long_Long_Float, also used for Float_IO output. + +with System.Img_LLU; +with System.Image_R; +with System.Powten_LLF; +with System.Unsigned_Types; + +package System.Img_LLF is + pragma Pure; + + -- Note that the following instantiation is really for a 32-bit target, + -- where 128-bit integer types are not available. For a 64-bit targaet, + -- it is possible to use Long_Long_Unsigned and Long_Long_Long_Unsigned + -- instead of Unsigned and Long_Long_Unsigned, in order to double the + -- number of significant digits. But we do not do it by default to avoid + -- dragging 128-bit integer types for the sake of backward compatibility. + + package Impl is new Image_R + (Long_Long_Float, + System.Powten_LLF.Maxpow, + System.Powten_LLF.Powten'Address, + Unsigned_Types.Long_Long_Unsigned, + System.Img_LLU.Set_Image_Long_Long_Unsigned); + + procedure Image_Long_Long_Float + (V : Long_Long_Float; + S : in out String; + P : out Natural; + Digs : Natural) + renames Impl.Image_Floating_Point; + + procedure Set_Image_Long_Long_Float + (V : Long_Long_Float; + S : in out String; + P : in out Natural; + Fore : Natural; + Aft : Natural; + Exp : Natural) + renames Impl.Set_Image_Real; + +end System.Img_LLF; diff --git a/gcc/ada/libgnat/s-imgrea.adb b/gcc/ada/libgnat/s-imgrea.adb index 3ec41561b12b..255e65906f09 100644 --- a/gcc/ada/libgnat/s-imgrea.adb +++ b/gcc/ada/libgnat/s-imgrea.adb @@ -29,418 +29,8 @@ -- -- ------------------------------------------------------------------------------ -with System.Img_LLU; use System.Img_LLU; -with System.Img_Uns; use System.Img_Uns; -with System.Img_Util; use System.Img_Util; -with System.Powten_LLF; use System.Powten_LLF; +-- This package does not require a body, since it is a package renaming. We +-- provide a dummy file containing a No_Body pragma so that previous versions +-- of the body (which did exist) will not interfere. -with System.Float_Control; - -package body System.Img_Real is - - subtype LLU is Long_Long_Unsigned; - - -- The following defines the maximum number of digits that we can convert - -- accurately. This is limited by the precision of Long_Long_Float, and - -- also by the number of digits we can hold in Long_Long_Unsigned, which - -- is the integer type we use as an intermediate for the result. - - -- We assume that in practice, the limitation will come from the digits - -- value, rather than the integer value. This is true for typical IEEE - -- implementations, and at worst, the only loss is for some precision - -- in very high precision floating-point output. - - -- Note that in the following, the "-2" accounts for the space and one - -- extra digit, since we need the maximum number of 9's that can be - -- represented, e.g. for the 64-bit case, Long_Long_Unsigned'Width is - -- 21, since the maximum value (approx 1.8E+19) has 20 digits, but the - -- maximum number of 9's that can be represented is only 19. - - Maxdigs : constant := Natural'Min (LLU'Width - 2, Long_Long_Float'Digits); - - Maxscaling : constant := 5000; - -- Max decimal scaling required during conversion of floating-point - -- numbers to decimal. This is used to defend against infinite - -- looping in the conversion, as can be caused by erroneous executions. - -- The largest exponent used on any current system is 2**16383, which - -- is approximately 10**4932, and the highest number of decimal digits - -- is about 35 for 128-bit floating-point formats, so 5000 leaves - -- enough room for scaling such values - - function Is_Negative (V : Long_Long_Float) return Boolean; - -- Return True if V is negative for the purpose of the output, i.e. return - -- True for negative zeros only if Signed_Zeros is True. - - -------------------------- - -- Image_Floating_Point -- - -------------------------- - - procedure Image_Floating_Point - (V : Long_Long_Float; - S : in out String; - P : out Natural; - Digs : Natural) - is - pragma Assert (S'First = 1); - - begin - -- Decide whether a blank should be prepended before the call to - -- Set_Image_Real. We generate a blank for positive values, and - -- also for positive zeros. For negative zeros, we generate a - -- blank only if Signed_Zeros is False (the RM only permits the - -- output of -0.0 when Signed_Zeros is True). We do not generate - -- a blank for positive infinity, since we output an explicit +. - - if not Is_Negative (V) and then V <= Long_Long_Float'Last then - pragma Annotate (CodePeer, False_Positive, "condition predetermined", - "CodePeer analysis ignores NaN and Inf values"); - pragma Assert (S'Last > 1); - -- The caller is responsible for S to be large enough for all - -- Image_Floating_Point operation. - S (1) := ' '; - P := 1; - else - P := 0; - end if; - - Set_Image_Real (V, S, P, 1, Digs - 1, 3); - end Image_Floating_Point; - - -------------------------------- - -- Image_Ordinary_Fixed_Point -- - -------------------------------- - - procedure Image_Ordinary_Fixed_Point - (V : Long_Long_Float; - S : in out String; - P : out Natural; - Aft : Natural) - is - pragma Assert (S'First = 1); - - begin - -- Output space at start if non-negative - - if V >= 0.0 then - S (1) := ' '; - P := 1; - else - P := 0; - end if; - - Set_Image_Real (V, S, P, 1, Aft, 0); - end Image_Ordinary_Fixed_Point; - - ----------------- - -- Is_Negative -- - ----------------- - - function Is_Negative (V : Long_Long_Float) return Boolean is - begin - if V < 0.0 then - return True; - - elsif V > 0.0 then - return False; - - elsif not Long_Long_Float'Signed_Zeros then - return False; - - else - return Long_Long_Float'Copy_Sign (1.0, V) < 0.0; - end if; - end Is_Negative; - - -------------------- - -- Set_Image_Real -- - -------------------- - - procedure Set_Image_Real - (V : Long_Long_Float; - S : in out String; - P : in out Natural; - Fore : Natural; - Aft : Natural; - Exp : Natural) - is - NFrac : constant Natural := Natural'Max (Aft, 1); - -- Number of digits after the decimal point - - Digs : String (1 .. 3 + Maxdigs); - -- Array used to hold digits of converted integer value - - Ndigs : Natural; - -- Number of digits stored in Digs (and also subscript of last digit) - - Scale : Integer := 0; - -- Exponent such that the result is Digs (1 .. NDigs) * 10**(-Scale) - - X : Long_Long_Float; - -- Current absolute value of the input after scaling - - procedure Adjust_Scale (S : Natural); - -- Adjusts the value in X by multiplying or dividing by a power of - -- ten so that it is in the range 10**(S-1) <= X < 10**S. Scale is - -- adjusted to reflect the power of ten used to divide the result, - -- i.e. one is added to the scale value for each multiplication by - -- 10.0 and one is subtracted for each division by 10.0. - - ------------------ - -- Adjust_Scale -- - ------------------ - - procedure Adjust_Scale (S : Natural) is - Lo : Natural; - Hi : Natural; - Mid : Natural; - XP : Long_Long_Float; - - begin - -- Cases where scaling up is required - - if X < Powten (S - 1) then - - -- What we are looking for is a power of ten to multiply X by - -- so that the result lies within the required range. - - loop - XP := X * Powten (Maxpow); - exit when XP >= Powten (S - 1) or else Scale > Maxscaling; - X := XP; - Scale := Scale + Maxpow; - end loop; - - -- The following exception is only raised in case of erroneous - -- execution, where a number was considered valid but still - -- fails to scale up. One situation where this can happen is - -- when a system which is supposed to be IEEE-compliant, but - -- has been reconfigured to flush denormals to zero. - - if Scale > Maxscaling then - raise Constraint_Error; - end if; - - -- Here we know that we must multiply by at least 10**1 and that - -- 10**Maxpow takes us too far: binary search to find right one. - - -- Because of roundoff errors, it is possible for the value - -- of XP to be just outside of the interval when Lo >= Hi. In - -- that case we adjust explicitly by a factor of 10. This - -- can only happen with a value that is very close to an - -- exact power of 10. - - Lo := 1; - Hi := Maxpow; - - loop - Mid := (Lo + Hi) / 2; - XP := X * Powten (Mid); - - if XP < Powten (S - 1) then - - if Lo >= Hi then - Mid := Mid + 1; - XP := XP * 10.0; - exit; - - else - Lo := Mid + 1; - end if; - - elsif XP >= Powten (S) then - - if Lo >= Hi then - Mid := Mid - 1; - XP := XP / 10.0; - exit; - - else - Hi := Mid - 1; - end if; - - else - exit; - end if; - end loop; - - X := XP; - Scale := Scale + Mid; - - -- Cases where scaling down is required - - elsif X >= Powten (S) then - - -- What we are looking for is a power of ten to divide X by - -- so that the result lies within the required range. - - pragma Assert (Powten (Maxpow) /= 0.0); - - loop - XP := X / Powten (Maxpow); - exit when XP < Powten (S) or else Scale < -Maxscaling; - X := XP; - Scale := Scale - Maxpow; - end loop; - - -- The following exception is only raised in case of erroneous - -- execution, where a number was considered valid but still - -- fails to scale up. One situation where this can happen is - -- when a system which is supposed to be IEEE-compliant, but - -- has been reconfigured to flush denormals to zero. - - if Scale < -Maxscaling then - raise Constraint_Error; - end if; - - -- Here we know that we must divide by at least 10**1 and that - -- 10**Maxpow takes us too far, binary search to find right one. - - Lo := 1; - Hi := Maxpow; - - loop - Mid := (Lo + Hi) / 2; - XP := X / Powten (Mid); - - if XP < Powten (S - 1) then - - if Lo >= Hi then - XP := XP * 10.0; - Mid := Mid - 1; - exit; - - else - Hi := Mid - 1; - end if; - - elsif XP >= Powten (S) then - - if Lo >= Hi then - XP := XP / 10.0; - Mid := Mid + 1; - exit; - - else - Lo := Mid + 1; - end if; - - else - exit; - end if; - end loop; - - X := XP; - Scale := Scale - Mid; - - -- Here we are already scaled right - - else - null; - end if; - end Adjust_Scale; - - -- Start of processing for Set_Image_Real - - begin - -- 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. - - System.Float_Control.Reset; - - -- Deal with invalid values first - - if not V'Valid then - - -- Note that we're taking our chances here, as V might be - -- an invalid bit pattern resulting from erroneous execution - -- (caused by using uninitialized variables for example). - - -- No matter what, we'll at least get reasonable behavior, - -- converting to infinity or some other value, or causing an - -- exception to be raised is fine. - - -- If the following two tests succeed, then we definitely have - -- an infinite value, so we print +Inf or -Inf. - - if V > Long_Long_Float'Last then - pragma Annotate (CodePeer, False_Positive, "dead code", - "CodePeer analysis ignores NaN and Inf values"); - pragma Annotate (CodePeer, False_Positive, "test always true", - "CodePeer analysis ignores NaN and Inf values"); - - Set_Floating_Invalid_Value (Infinity, S, P, Fore, Aft, Exp); - - elsif V < Long_Long_Float'First then - Set_Floating_Invalid_Value (Minus_Infinity, S, P, Fore, Aft, Exp); - - -- In all other cases we print NaN - - else - Set_Floating_Invalid_Value (Not_A_Number, S, P, Fore, Aft, Exp); - end if; - - return; - end if; - - -- Set the first character like Image - - Digs (1) := (if Is_Negative (V) then '-' else ' '); - Ndigs := 1; - - X := abs (V); - - -- If X is zero, we are done - - if X = 0.0 then - Digs (2) := '0'; - Ndigs := 2; - - -- Otherwise, scale X and convert it to an integer - - else - -- In exponent notation, we need exactly NFrac + 1 digits and always - -- round the last one. - - if Exp > 0 then - Adjust_Scale (Natural'Min (NFrac + 1, Maxdigs)); - X := X + 0.5; - - -- In straight notation, we compute the maximum number of digits and - -- compare how many of them will be put after the decimal point with - -- Nfrac, in order to find out whether we need to round the last one - -- here or whether the rounding is performed by Set_Decimal_Digits. - - else - Adjust_Scale (Maxdigs); - if Scale <= NFrac then - X := X + 0.5; - end if; - end if; - - -- Use Unsigned routine if possible, since on 32-bit machines it will - -- be significantly more efficient than the Long_Long_Unsigned one. - - if X <= Long_Long_Float (Unsigned'Last) then - declare - I : constant Unsigned := - Unsigned (Long_Long_Float'Truncation (X)); - begin - Set_Image_Unsigned (I, Digs, Ndigs); - end; - - else pragma Assert (X <= Long_Long_Float (LLU'Last)); - declare - I : constant LLU := - LLU (Long_Long_Float'Truncation (X)); - begin - Set_Image_Long_Long_Unsigned (I, Digs, Ndigs); - end; - end if; - end if; - - Set_Decimal_Digits (Digs, Ndigs, S, P, Scale, Fore, Aft, Exp); - end Set_Image_Real; - -end System.Img_Real; +pragma No_Body; diff --git a/gcc/ada/libgnat/s-imgrea.ads b/gcc/ada/libgnat/s-imgrea.ads index 2da869bdbeec..45abac1fd4b4 100644 --- a/gcc/ada/libgnat/s-imgrea.ads +++ b/gcc/ada/libgnat/s-imgrea.ads @@ -29,56 +29,20 @@ -- -- ------------------------------------------------------------------------------ --- Image for fixed and float types (also used for Float_IO/Fixed_IO output) +-- This obsolete package is preserved for the sake of backward compatibility + +with System.Img_LLF; package System.Img_Real is pragma Pure; - procedure Image_Ordinary_Fixed_Point - (V : Long_Long_Float; - S : in out String; - P : out Natural; - Aft : Natural); - -- Computes fixed_type'Image (V) and returns the result in S (1 .. P) - -- updating P on return. The result is computed according to the rules for - -- image for fixed-point types (RM 3.5(34)), where Aft is the value of the - -- Aft attribute for the fixed-point type. This function is used only for - -- ordinary fixed point (see package System.Img_Dec for handling of decimal - -- fixed point). The caller guarantees that S is long enough to hold the - -- result and has a lower bound of 1. - -- - -- Remark: This procedure should NOT be called with V = -0.0 or V = +/-Inf, - -- The result is irrelevant. - - procedure Image_Floating_Point - (V : Long_Long_Float; - S : in out String; - P : out Natural; - Digs : Natural); - -- Computes float_type'Image (V) and returns the result in S (1 .. P) - -- updating P on return. The result is computed according to the rules for - -- image for floating-point types (RM 3.5(33)), where Digs is the value of - -- the Digits attribute for the floating-point type. The caller guarantees - -- that S is long enough to hold the result and has a lower bound of 1. - procedure Set_Image_Real (V : Long_Long_Float; S : in out String; P : in out Natural; Fore : Natural; Aft : Natural; - Exp : Natural); - -- Sets the image of V starting at S (P + 1), updating P to point to the - -- last character stored, the caller promises that the buffer is large - -- enough and no check is made for this. Constraint_Error will not - -- necessarily be raised if this is violated, since it is perfectly valid - -- to compile this unit with checks off). The Fore, Aft and Exp values - -- can be set to any valid values for the case of use from Text_IO. Note - -- that no space is stored at the start for non-negative values. - - Max_Real_Image_Length : constant := 5200; - -- If Exp is set to zero and Aft is set to Text_IO.Field'Last (i.e., 255) - -- then Long_Long_Float'Last generates an image whose length is - -- slightly less than 5200. + Exp : Natural) + renames System.Img_LLF.Set_Image_Long_Long_Float; end System.Img_Real; diff --git a/gcc/ada/libgnat/s-imguti.ads b/gcc/ada/libgnat/s-imguti.ads index 680c0bb8eafd..68e8e2a611ba 100644 --- a/gcc/ada/libgnat/s-imguti.ads +++ b/gcc/ada/libgnat/s-imguti.ads @@ -34,6 +34,11 @@ package System.Img_Util is pragma Pure; + Max_Real_Image_Length : constant := 5200; + -- If Exp is set to zero and Aft is set to Text_IO.Field'Last (i.e., 255) + -- then Long_Long_Float'Last generates an image whose length is slightly + -- less than 5200. + procedure Set_Decimal_Digits (Digs : in out String; NDigs : Natural; diff --git a/gcc/ada/libgnat/s-powflt.ads b/gcc/ada/libgnat/s-powflt.ads index fb4177bc4b0c..0967403a9739 100644 --- a/gcc/ada/libgnat/s-powflt.ads +++ b/gcc/ada/libgnat/s-powflt.ads @@ -34,52 +34,34 @@ package System.Powten_Flt is pragma Pure; - Maxpow : constant := 38; - -- Largest power of ten representable with Float - Maxpow_Exact : constant := 10; -- Largest power of ten exactly representable with Float. It is equal to -- floor (M * log 2 / log 5), when M is the size of the mantissa (24). - Powten : constant array (0 .. Maxpow) of Float := - (00 => 1.0E+00, - 01 => 1.0E+01, - 02 => 1.0E+02, - 03 => 1.0E+03, - 04 => 1.0E+04, - 05 => 1.0E+05, - 06 => 1.0E+06, - 07 => 1.0E+07, - 08 => 1.0E+08, - 09 => 1.0E+09, - 10 => 1.0E+10, - 11 => 1.0E+11, - 12 => 1.0E+12, - 13 => 1.0E+13, - 14 => 1.0E+14, - 15 => 1.0E+15, - 16 => 1.0E+16, - 17 => 1.0E+17, - 18 => 1.0E+18, - 19 => 1.0E+19, - 20 => 1.0E+20, - 21 => 1.0E+21, - 22 => 1.0E+22, - 23 => 1.0E+23, - 24 => 1.0E+24, - 25 => 1.0E+25, - 26 => 1.0E+26, - 27 => 1.0E+27, - 28 => 1.0E+28, - 29 => 1.0E+29, - 30 => 1.0E+30, - 31 => 1.0E+31, - 32 => 1.0E+32, - 33 => 1.0E+33, - 34 => 1.0E+34, - 35 => 1.0E+35, - 36 => 1.0E+36, - 37 => 1.0E+37, - 38 => 1.0E+38); + Maxpow : constant := Maxpow_Exact * 2; + -- Largest power of ten exactly representable with a double Float + + Powten : constant array (0 .. Maxpow, 1 .. 2) of Float := + (00 => (1.0E+00, 0.0), + 01 => (1.0E+01, 0.0), + 02 => (1.0E+02, 0.0), + 03 => (1.0E+03, 0.0), + 04 => (1.0E+04, 0.0), + 05 => (1.0E+05, 0.0), + 06 => (1.0E+06, 0.0), + 07 => (1.0E+07, 0.0), + 08 => (1.0E+08, 0.0), + 09 => (1.0E+09, 0.0), + 10 => (1.0E+10, 0.0), + 11 => (1.0E+11, 1.0E+11 - Float'Machine (1.0E+11)), + 12 => (1.0E+12, 1.0E+12 - Float'Machine (1.0E+12)), + 13 => (1.0E+13, 1.0E+13 - Float'Machine (1.0E+13)), + 14 => (1.0E+14, 1.0E+14 - Float'Machine (1.0E+14)), + 15 => (1.0E+15, 1.0E+15 - Float'Machine (1.0E+15)), + 16 => (1.0E+16, 1.0E+16 - Float'Machine (1.0E+16)), + 17 => (1.0E+17, 1.0E+17 - Float'Machine (1.0E+17)), + 18 => (1.0E+18, 1.0E+18 - Float'Machine (1.0E+18)), + 19 => (1.0E+19, 1.0E+19 - Float'Machine (1.0E+19)), + 20 => (1.0E+20, 1.0E+20 - Float'Machine (1.0E+20))); end System.Powten_Flt; diff --git a/gcc/ada/libgnat/s-powlfl.ads b/gcc/ada/libgnat/s-powlfl.ads index 8b0125491d18..7800f2ff57aa 100644 --- a/gcc/ada/libgnat/s-powlfl.ads +++ b/gcc/ada/libgnat/s-powlfl.ads @@ -34,322 +34,58 @@ package System.Powten_LFlt is pragma Pure; - Maxpow : constant := 308; - -- Largest power of ten representable with Long_Float - Maxpow_Exact : constant := 22; -- Largest power of ten exactly representable with Long_Float. It is equal -- to floor (M * log 2 / log 5), when M is the size of the mantissa (53). - Powten : constant array (0 .. Maxpow) of Long_Float := - (00 => 1.0E+00, - 01 => 1.0E+01, - 02 => 1.0E+02, - 03 => 1.0E+03, - 04 => 1.0E+04, - 05 => 1.0E+05, - 06 => 1.0E+06, - 07 => 1.0E+07, - 08 => 1.0E+08, - 09 => 1.0E+09, - 10 => 1.0E+10, - 11 => 1.0E+11, - 12 => 1.0E+12, - 13 => 1.0E+13, - 14 => 1.0E+14, - 15 => 1.0E+15, - 16 => 1.0E+16, - 17 => 1.0E+17, - 18 => 1.0E+18, - 19 => 1.0E+19, - 20 => 1.0E+20, - 21 => 1.0E+21, - 22 => 1.0E+22, - 23 => 1.0E+23, - 24 => 1.0E+24, - 25 => 1.0E+25, - 26 => 1.0E+26, - 27 => 1.0E+27, - 28 => 1.0E+28, - 29 => 1.0E+29, - 30 => 1.0E+30, - 31 => 1.0E+31, - 32 => 1.0E+32, - 33 => 1.0E+33, - 34 => 1.0E+34, - 35 => 1.0E+35, - 36 => 1.0E+36, - 37 => 1.0E+37, - 38 => 1.0E+38, - 39 => 1.0E+39, - 40 => 1.0E+40, - 41 => 1.0E+41, - 42 => 1.0E+42, - 43 => 1.0E+43, - 44 => 1.0E+44, - 45 => 1.0E+45, - 46 => 1.0E+46, - 47 => 1.0E+47, - 48 => 1.0E+48, - 49 => 1.0E+49, - 50 => 1.0E+50, - 51 => 1.0E+51, - 52 => 1.0E+52, - 53 => 1.0E+53, - 54 => 1.0E+54, - 55 => 1.0E+55, - 56 => 1.0E+56, - 57 => 1.0E+57, - 58 => 1.0E+58, - 59 => 1.0E+59, - 60 => 1.0E+60, - 61 => 1.0E+61, - 62 => 1.0E+62, - 63 => 1.0E+63, - 64 => 1.0E+64, - 65 => 1.0E+65, - 66 => 1.0E+66, - 67 => 1.0E+67, - 68 => 1.0E+68, - 69 => 1.0E+69, - 70 => 1.0E+70, - 71 => 1.0E+71, - 72 => 1.0E+72, - 73 => 1.0E+73, - 74 => 1.0E+74, - 75 => 1.0E+75, - 76 => 1.0E+76, - 77 => 1.0E+77, - 78 => 1.0E+78, - 79 => 1.0E+79, - 80 => 1.0E+80, - 81 => 1.0E+81, - 82 => 1.0E+82, - 83 => 1.0E+83, - 84 => 1.0E+84, - 85 => 1.0E+85, - 86 => 1.0E+86, - 87 => 1.0E+87, - 88 => 1.0E+88, - 89 => 1.0E+89, - 90 => 1.0E+90, - 91 => 1.0E+91, - 92 => 1.0E+92, - 93 => 1.0E+93, - 94 => 1.0E+94, - 95 => 1.0E+95, - 96 => 1.0E+96, - 97 => 1.0E+97, - 98 => 1.0E+98, - 99 => 1.0E+99, - 100 => 1.0E+100, - 101 => 1.0E+101, - 102 => 1.0E+102, - 103 => 1.0E+103, - 104 => 1.0E+104, - 105 => 1.0E+105, - 106 => 1.0E+106, - 107 => 1.0E+107, - 108 => 1.0E+108, - 109 => 1.0E+109, - 110 => 1.0E+110, - 111 => 1.0E+111, - 112 => 1.0E+112, - 113 => 1.0E+113, - 114 => 1.0E+114, - 115 => 1.0E+115, - 116 => 1.0E+116, - 117 => 1.0E+117, - 118 => 1.0E+118, - 119 => 1.0E+119, - 120 => 1.0E+120, - 121 => 1.0E+121, - 122 => 1.0E+122, - 123 => 1.0E+123, - 124 => 1.0E+124, - 125 => 1.0E+125, - 126 => 1.0E+126, - 127 => 1.0E+127, - 128 => 1.0E+128, - 129 => 1.0E+129, - 130 => 1.0E+130, - 131 => 1.0E+131, - 132 => 1.0E+132, - 133 => 1.0E+133, - 134 => 1.0E+134, - 135 => 1.0E+135, - 136 => 1.0E+136, - 137 => 1.0E+137, - 138 => 1.0E+138, - 139 => 1.0E+139, - 140 => 1.0E+140, - 141 => 1.0E+141, - 142 => 1.0E+142, - 143 => 1.0E+143, - 144 => 1.0E+144, - 145 => 1.0E+145, - 146 => 1.0E+146, - 147 => 1.0E+147, - 148 => 1.0E+148, - 149 => 1.0E+149, - 150 => 1.0E+150, - 151 => 1.0E+151, - 152 => 1.0E+152, - 153 => 1.0E+153, - 154 => 1.0E+154, - 155 => 1.0E+155, - 156 => 1.0E+156, - 157 => 1.0E+157, - 158 => 1.0E+158, - 159 => 1.0E+159, - 160 => 1.0E+160, - 161 => 1.0E+161, - 162 => 1.0E+162, - 163 => 1.0E+163, - 164 => 1.0E+164, - 165 => 1.0E+165, - 166 => 1.0E+166, - 167 => 1.0E+167, - 168 => 1.0E+168, - 169 => 1.0E+169, - 170 => 1.0E+170, - 171 => 1.0E+171, - 172 => 1.0E+172, - 173 => 1.0E+173, - 174 => 1.0E+174, - 175 => 1.0E+175, - 176 => 1.0E+176, - 177 => 1.0E+177, - 178 => 1.0E+178, - 179 => 1.0E+179, - 180 => 1.0E+180, - 181 => 1.0E+181, - 182 => 1.0E+182, - 183 => 1.0E+183, - 184 => 1.0E+184, - 185 => 1.0E+185, - 186 => 1.0E+186, - 187 => 1.0E+187, - 188 => 1.0E+188, - 189 => 1.0E+189, - 190 => 1.0E+190, - 191 => 1.0E+191, - 192 => 1.0E+192, - 193 => 1.0E+193, - 194 => 1.0E+194, - 195 => 1.0E+195, - 196 => 1.0E+196, - 197 => 1.0E+197, - 198 => 1.0E+198, - 199 => 1.0E+199, - 200 => 1.0E+200, - 201 => 1.0E+201, - 202 => 1.0E+202, - 203 => 1.0E+203, - 204 => 1.0E+204, - 205 => 1.0E+205, - 206 => 1.0E+206, - 207 => 1.0E+207, - 208 => 1.0E+208, - 209 => 1.0E+209, - 210 => 1.0E+210, - 211 => 1.0E+211, - 212 => 1.0E+212, - 213 => 1.0E+213, - 214 => 1.0E+214, - 215 => 1.0E+215, - 216 => 1.0E+216, - 217 => 1.0E+217, - 218 => 1.0E+218, - 219 => 1.0E+219, - 220 => 1.0E+220, - 221 => 1.0E+221, - 222 => 1.0E+222, - 223 => 1.0E+223, - 224 => 1.0E+224, - 225 => 1.0E+225, - 226 => 1.0E+226, - 227 => 1.0E+227, - 228 => 1.0E+228, - 229 => 1.0E+229, - 230 => 1.0E+230, - 231 => 1.0E+231, - 232 => 1.0E+232, - 233 => 1.0E+233, - 234 => 1.0E+234, - 235 => 1.0E+235, - 236 => 1.0E+236, - 237 => 1.0E+237, - 238 => 1.0E+238, - 239 => 1.0E+239, - 240 => 1.0E+240, - 241 => 1.0E+241, - 242 => 1.0E+242, - 243 => 1.0E+243, - 244 => 1.0E+244, - 245 => 1.0E+245, - 246 => 1.0E+246, - 247 => 1.0E+247, - 248 => 1.0E+248, - 249 => 1.0E+249, - 250 => 1.0E+250, - 251 => 1.0E+251, - 252 => 1.0E+252, - 253 => 1.0E+253, - 254 => 1.0E+254, - 255 => 1.0E+255, - 256 => 1.0E+256, - 257 => 1.0E+257, - 258 => 1.0E+258, - 259 => 1.0E+259, - 260 => 1.0E+260, - 261 => 1.0E+261, - 262 => 1.0E+262, - 263 => 1.0E+263, - 264 => 1.0E+264, - 265 => 1.0E+265, - 266 => 1.0E+266, - 267 => 1.0E+267, - 268 => 1.0E+268, - 269 => 1.0E+269, - 270 => 1.0E+270, - 271 => 1.0E+271, - 272 => 1.0E+272, - 273 => 1.0E+273, - 274 => 1.0E+274, - 275 => 1.0E+275, - 276 => 1.0E+276, - 277 => 1.0E+277, - 278 => 1.0E+278, - 279 => 1.0E+279, - 280 => 1.0E+280, - 281 => 1.0E+281, - 282 => 1.0E+282, - 283 => 1.0E+283, - 284 => 1.0E+284, - 285 => 1.0E+285, - 286 => 1.0E+286, - 287 => 1.0E+287, - 288 => 1.0E+288, - 289 => 1.0E+289, - 290 => 1.0E+290, - 291 => 1.0E+291, - 292 => 1.0E+292, - 293 => 1.0E+293, - 294 => 1.0E+294, - 295 => 1.0E+295, - 296 => 1.0E+296, - 297 => 1.0E+297, - 298 => 1.0E+298, - 299 => 1.0E+299, - 300 => 1.0E+300, - 301 => 1.0E+301, - 302 => 1.0E+302, - 303 => 1.0E+303, - 304 => 1.0E+304, - 305 => 1.0E+305, - 306 => 1.0E+306, - 307 => 1.0E+307, - 308 => 1.0E+308); + Maxpow : constant := Maxpow_Exact * 2; + -- Largest power of ten exactly representable with a double Long_Float + + Powten : constant array (0 .. Maxpow, 1 .. 2) of Long_Float := + (00 => (1.0E+00, 0.0), + 01 => (1.0E+01, 0.0), + 02 => (1.0E+02, 0.0), + 03 => (1.0E+03, 0.0), + 04 => (1.0E+04, 0.0), + 05 => (1.0E+05, 0.0), + 06 => (1.0E+06, 0.0), + 07 => (1.0E+07, 0.0), + 08 => (1.0E+08, 0.0), + 09 => (1.0E+09, 0.0), + 10 => (1.0E+10, 0.0), + 11 => (1.0E+11, 0.0), + 12 => (1.0E+12, 0.0), + 13 => (1.0E+13, 0.0), + 14 => (1.0E+14, 0.0), + 15 => (1.0E+15, 0.0), + 16 => (1.0E+16, 0.0), + 17 => (1.0E+17, 0.0), + 18 => (1.0E+18, 0.0), + 19 => (1.0E+19, 0.0), + 20 => (1.0E+20, 0.0), + 21 => (1.0E+21, 0.0), + 22 => (1.0E+22, 0.0), + 23 => (1.0E+23, 1.0E+23 - Long_Float'Machine (1.0E+23)), + 24 => (1.0E+24, 1.0E+24 - Long_Float'Machine (1.0E+24)), + 25 => (1.0E+25, 1.0E+25 - Long_Float'Machine (1.0E+25)), + 26 => (1.0E+26, 1.0E+26 - Long_Float'Machine (1.0E+26)), + 27 => (1.0E+27, 1.0E+27 - Long_Float'Machine (1.0E+27)), + 28 => (1.0E+28, 1.0E+28 - Long_Float'Machine (1.0E+28)), + 29 => (1.0E+29, 1.0E+29 - Long_Float'Machine (1.0E+29)), + 30 => (1.0E+30, 1.0E+30 - Long_Float'Machine (1.0E+30)), + 31 => (1.0E+31, 1.0E+31 - Long_Float'Machine (1.0E+31)), + 32 => (1.0E+32, 1.0E+32 - Long_Float'Machine (1.0E+32)), + 33 => (1.0E+33, 1.0E+33 - Long_Float'Machine (1.0E+33)), + 34 => (1.0E+34, 1.0E+34 - Long_Float'Machine (1.0E+34)), + 35 => (1.0E+35, 1.0E+35 - Long_Float'Machine (1.0E+35)), + 36 => (1.0E+36, 1.0E+36 - Long_Float'Machine (1.0E+36)), + 37 => (1.0E+37, 1.0E+37 - Long_Float'Machine (1.0E+37)), + 38 => (1.0E+38, 1.0E+38 - Long_Float'Machine (1.0E+38)), + 39 => (1.0E+39, 1.0E+39 - Long_Float'Machine (1.0E+39)), + 40 => (1.0E+40, 1.0E+40 - Long_Float'Machine (1.0E+40)), + 41 => (1.0E+41, 1.0E+41 - Long_Float'Machine (1.0E+41)), + 42 => (1.0E+42, 1.0E+42 - Long_Float'Machine (1.0E+42)), + 43 => (1.0E+43, 1.0E+43 - Long_Float'Machine (1.0E+43)), + 44 => (1.0E+44, 1.0E+44 - Long_Float'Machine (1.0E+44))); end System.Powten_LFlt; diff --git a/gcc/ada/libgnat/s-powllf.ads b/gcc/ada/libgnat/s-powllf.ads index d8544754d19b..b1f8ae995acc 100644 --- a/gcc/ada/libgnat/s-powllf.ads +++ b/gcc/ada/libgnat/s-powllf.ads @@ -34,37 +34,70 @@ package System.Powten_LLF is pragma Pure; - Maxpow : constant := 22; - -- The number of entries in this table is chosen to include powers of ten - -- that are exactly representable with Long_Long_Float. Assuming that on - -- all targets we have 53 bits of mantissa for the type, the upper bound - -- is given by 53 * log 2 / log 5. If the scaling factor is greater than - -- Maxpow, it can be obtained by several multiplications, which is less - -- efficient than with a bigger table, but avoids anomalies at end points. + Maxpow_Exact : constant := + (if Long_Long_Float'Machine_Mantissa = 64 then 27 else 22); + -- Largest power of ten exactly representable with Long_Long_Float. It is + -- equal to floor (M * log 2 / log 5), when M is the size of the mantissa + -- assumed to be either 64 for IEEE Extended or 53 for IEEE Double. - Powten : constant array (0 .. Maxpow) of Long_Long_Float := - (00 => 1.0E+00, - 01 => 1.0E+01, - 02 => 1.0E+02, - 03 => 1.0E+03, - 04 => 1.0E+04, - 05 => 1.0E+05, - 06 => 1.0E+06, - 07 => 1.0E+07, - 08 => 1.0E+08, - 09 => 1.0E+09, - 10 => 1.0E+10, - 11 => 1.0E+11, - 12 => 1.0E+12, - 13 => 1.0E+13, - 14 => 1.0E+14, - 15 => 1.0E+15, - 16 => 1.0E+16, - 17 => 1.0E+17, - 18 => 1.0E+18, - 19 => 1.0E+19, - 20 => 1.0E+20, - 21 => 1.0E+21, - 22 => 1.0E+22); + Maxpow : constant := Maxpow_Exact * 2; + -- Largest power of ten exactly representable with a double Long_Long_Float + + Powten : constant array (0 .. 54, 1 .. 2) of Long_Long_Float := + (00 => (1.0E+00, 0.0), + 01 => (1.0E+01, 0.0), + 02 => (1.0E+02, 0.0), + 03 => (1.0E+03, 0.0), + 04 => (1.0E+04, 0.0), + 05 => (1.0E+05, 0.0), + 06 => (1.0E+06, 0.0), + 07 => (1.0E+07, 0.0), + 08 => (1.0E+08, 0.0), + 09 => (1.0E+09, 0.0), + 10 => (1.0E+10, 0.0), + 11 => (1.0E+11, 0.0), + 12 => (1.0E+12, 0.0), + 13 => (1.0E+13, 0.0), + 14 => (1.0E+14, 0.0), + 15 => (1.0E+15, 0.0), + 16 => (1.0E+16, 0.0), + 17 => (1.0E+17, 0.0), + 18 => (1.0E+18, 0.0), + 19 => (1.0E+19, 0.0), + 20 => (1.0E+20, 0.0), + 21 => (1.0E+21, 0.0), + 22 => (1.0E+22, 0.0), + 23 => (1.0E+23, 1.0E+23 - Long_Long_Float'Machine (1.0E+23)), + 24 => (1.0E+24, 1.0E+24 - Long_Long_Float'Machine (1.0E+24)), + 25 => (1.0E+25, 1.0E+25 - Long_Long_Float'Machine (1.0E+25)), + 26 => (1.0E+26, 1.0E+26 - Long_Long_Float'Machine (1.0E+26)), + 27 => (1.0E+27, 1.0E+27 - Long_Long_Float'Machine (1.0E+27)), + 28 => (1.0E+28, 1.0E+28 - Long_Long_Float'Machine (1.0E+28)), + 29 => (1.0E+29, 1.0E+29 - Long_Long_Float'Machine (1.0E+29)), + 30 => (1.0E+30, 1.0E+30 - Long_Long_Float'Machine (1.0E+30)), + 31 => (1.0E+31, 1.0E+31 - Long_Long_Float'Machine (1.0E+31)), + 32 => (1.0E+32, 1.0E+32 - Long_Long_Float'Machine (1.0E+32)), + 33 => (1.0E+33, 1.0E+33 - Long_Long_Float'Machine (1.0E+33)), + 34 => (1.0E+34, 1.0E+34 - Long_Long_Float'Machine (1.0E+34)), + 35 => (1.0E+35, 1.0E+35 - Long_Long_Float'Machine (1.0E+35)), + 36 => (1.0E+36, 1.0E+36 - Long_Long_Float'Machine (1.0E+36)), + 37 => (1.0E+37, 1.0E+37 - Long_Long_Float'Machine (1.0E+37)), + 38 => (1.0E+38, 1.0E+38 - Long_Long_Float'Machine (1.0E+38)), + 39 => (1.0E+39, 1.0E+39 - Long_Long_Float'Machine (1.0E+39)), + 40 => (1.0E+40, 1.0E+40 - Long_Long_Float'Machine (1.0E+40)), + 41 => (1.0E+41, 1.0E+41 - Long_Long_Float'Machine (1.0E+41)), + 42 => (1.0E+42, 1.0E+42 - Long_Long_Float'Machine (1.0E+42)), + 43 => (1.0E+43, 1.0E+43 - Long_Long_Float'Machine (1.0E+43)), + 44 => (1.0E+44, 1.0E+44 - Long_Long_Float'Machine (1.0E+44)), + 45 => (1.0E+45, 1.0E+45 - Long_Long_Float'Machine (1.0E+45)), + 46 => (1.0E+46, 1.0E+46 - Long_Long_Float'Machine (1.0E+46)), + 47 => (1.0E+47, 1.0E+47 - Long_Long_Float'Machine (1.0E+47)), + 48 => (1.0E+48, 1.0E+48 - Long_Long_Float'Machine (1.0E+48)), + 49 => (1.0E+49, 1.0E+49 - Long_Long_Float'Machine (1.0E+49)), + 50 => (1.0E+50, 1.0E+50 - Long_Long_Float'Machine (1.0E+50)), + 51 => (1.0E+51, 1.0E+51 - Long_Long_Float'Machine (1.0E+51)), + 52 => (1.0E+52, 1.0E+52 - Long_Long_Float'Machine (1.0E+52)), + 53 => (1.0E+53, 1.0E+53 - Long_Long_Float'Machine (1.0E+53)), + 54 => (1.0E+54, 1.0E+54 - Long_Long_Float'Machine (1.0E+54))); end System.Powten_LLF; diff --git a/gcc/ada/libgnat/s-valflt.ads b/gcc/ada/libgnat/s-valflt.ads index 2a4a4595aa41..04ffb7117eaf 100644 --- a/gcc/ada/libgnat/s-valflt.ads +++ b/gcc/ada/libgnat/s-valflt.ads @@ -32,8 +32,8 @@ -- This package contains routines for scanning real values for floating point -- type Float, for use in Text_IO.Float_IO and the Value attribute. -with Interfaces; with System.Powten_Flt; +with System.Unsigned_Types; with System.Val_Real; package System.Val_Flt is @@ -41,9 +41,9 @@ package System.Val_Flt is package Impl is new Val_Real (Float, - Interfaces.Unsigned_32, System.Powten_Flt.Maxpow, - System.Powten_Flt.Powten'Address); + System.Powten_Flt.Powten'Address, + Unsigned_Types.Unsigned); function Scan_Float (Str : String; diff --git a/gcc/ada/libgnat/s-vallfl.ads b/gcc/ada/libgnat/s-vallfl.ads index 9f5c8a3b5f91..71da12ab97a5 100644 --- a/gcc/ada/libgnat/s-vallfl.ads +++ b/gcc/ada/libgnat/s-vallfl.ads @@ -32,8 +32,8 @@ -- This package contains routines for scanning real values for floating point -- type Long_Float, for use in Text_IO.Float_IO and the Value attribute. -with Interfaces; with System.Powten_LFlt; +with System.Unsigned_Types; with System.Val_Real; package System.Val_LFlt is @@ -41,9 +41,9 @@ package System.Val_LFlt is package Impl is new Val_Real (Long_Float, - Interfaces.Unsigned_64, System.Powten_LFlt.Maxpow, - System.Powten_LFlt.Powten'Address); + System.Powten_LFlt.Powten'Address, + Unsigned_Types.Long_Long_Unsigned); function Scan_Long_Float (Str : String; diff --git a/gcc/ada/libgnat/s-valllf.ads b/gcc/ada/libgnat/s-valllf.ads index f540bcb981cc..477ed4ed8d01 100644 --- a/gcc/ada/libgnat/s-valllf.ads +++ b/gcc/ada/libgnat/s-valllf.ads @@ -32,8 +32,8 @@ -- This package contains routines for scanning real values for floating point -- type Long_Long_Float, for use in Text_IO.Float_IO and the Value attribute. -with Interfaces; with System.Powten_LLF; +with System.Unsigned_Types; with System.Val_Real; package System.Val_LLF is @@ -41,9 +41,9 @@ package System.Val_LLF is package Impl is new Val_Real (Long_Long_Float, - Interfaces.Unsigned_64, System.Powten_LLF.Maxpow, - System.Powten_LLF.Powten'Address); + System.Powten_LLF.Powten'Address, + System.Unsigned_Types.Long_Long_Unsigned); function Scan_Long_Long_Float (Str : String; diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb index 5d09d35ddf64..bc5465cf4b9f 100644 --- a/gcc/ada/libgnat/s-valrea.adb +++ b/gcc/ada/libgnat/s-valrea.adb @@ -29,6 +29,7 @@ -- -- ------------------------------------------------------------------------------ +with System.Double_Real; with System.Float_Control; with System.Unsigned_Types; use System.Unsigned_Types; with System.Val_Util; use System.Val_Util; @@ -76,9 +77,11 @@ package body System.Val_Real is 7 => 5836, 8 => 5461, 9 => 5168, 10 => 4932, 11 => 4736, 12 => 4570, 13 => 4427, 14 => 4303, 15 => 4193, 16 => 4095); - function Fast2Sum (A, B : Num; Err : in out Num) return Num; - -- This is the classical Fast2Sum function assuming round to nearest, - -- with the error accumulated into Err. + 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 Integer_to_Real (Str : String; @@ -89,24 +92,8 @@ package body System.Val_Real is Minus : Boolean) return Num; -- Convert the real value from integer to real representation - -------------- - -- Fast2Sum -- - -------------- - - function Fast2Sum (A, B : Num; Err : in out Num) return Num is - S, Z : Num; - - begin - pragma Assert (abs (A) >= abs (B)); - - S := A + B; - Z := S - A; - Z := B - Z; - - Err := Err + Z; - - return S; - end Fast2Sum; + function Large_Powten (Exp : Natural) return Double_T; + -- Return 10.0**Exp as a double number, where Exp > Maxpow --------------------- -- Integer_to_Real -- @@ -134,6 +121,7 @@ package body System.Val_Real is -- Maximum exponent of the base that can fit in Num R_Val : Num; + D_Val : Double_T; S : Integer := Scale; begin @@ -146,10 +134,6 @@ package body System.Val_Real is System.Float_Control.Reset; end if; - -- Do the conversion - - R_Val := Num (Val); - -- Take into account the extra digit, i.e. do the two computations -- (1) R_Val := R_Val * Num (B) + Num (Extra) @@ -163,11 +147,11 @@ package body System.Val_Real is if Need_Extra and then Extra > 0 then declare - B : Unsigned := Base; - - Acc : Num := 0.0; - Err : Num := 0.0; - Fac : Num := R_Val; + B : Unsigned := Base; + Acc : Num := 0.0; + Err : Num := 0.0; + Fac : Num := Num (Val); + DS : Double_T; begin loop @@ -176,7 +160,13 @@ package body System.Val_Real is -- never larger than the factor minus the initial value). if B rem 2 /= 0 then - Acc := (if Acc = 0.0 then Fac else Fast2Sum (Fac, Acc, Err)); + if Acc = 0.0 then + Acc := Fac; + else + DS := Double_Real.Quick_Two_Sum (Fac, Acc); + Acc := DS.Hi; + Err := Err + DS.Lo; + end if; exit when B = 1; end if; @@ -189,75 +179,106 @@ package body System.Val_Real is -- Add Extra to the error, which are both small integers - Err := Err + Num (Extra); + D_Val := Double_Real.Quick_Two_Sum (Acc, Err + Num (Extra)); + + S := S - 1; + end; + + -- Or else, if the Extra digit is zero, do the exact conversion - -- Acc + Err is the exact result before rounding + elsif Need_Extra then + D_Val := Double_Real.To_Double (Num (Val)); - R_Val := Acc + Err; + -- Otherwise, the value contains more bits than the mantissa so do the + -- conversion in two steps. - S := S - 1; + else + declare + Mask : constant Uns := 2**(Uns'Size - Num'Machine_Mantissa) - 1; + Hi : constant Uns := Val and not Mask; + Lo : constant Uns := Val and Mask; + + begin + if Hi = 0 then + D_Val := Double_Real.To_Double (Num (Lo)); + else + D_Val := Double_Real.Quick_Two_Sum (Num (Hi), Num (Lo)); + end if; end; end if; - -- Compute the final value + -- Compute the final value by applying the scaling, if any - if R_Val /= 0.0 and then S /= 0 then + if Val = 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 => - R_Val := Num'Scaling (R_Val, S); + R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S); when 4 => if Integer'First / 2 <= S and then S <= Integer'Last / 2 then S := S * 2; end if; - R_Val := Num'Scaling (R_Val, S); + R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S); when 8 => if Integer'First / 3 <= S and then S <= Integer'Last / 3 then S := S * 3; end if; - R_Val := Num'Scaling (R_Val, S); + R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S); when 16 => if Integer'First / 4 <= S and then S <= Integer'Last / 4 then S := S * 4; end if; - R_Val := Num'Scaling (R_Val, S); + R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S); + + -- If the base is 10, use a double implementation for the sake + -- of accuracy, to be removed when exponentiation is improved. - -- If the base is 10, we use a table of powers for accuracy's sake + -- 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 10 => declare - subtype Pow_Num is Num range 1.0 .. Num'Last; - - Powten : constant array (0 .. Maxpow) of Pow_Num; + Powten : constant array (0 .. Maxpow) of Double_T; pragma Import (Ada, Powten); for Powten'Address use Powten_Address; begin if S > 0 then - while S > Maxpow loop - R_Val := R_Val * Powten (Maxpow); - S := S - Maxpow; - end loop; - - R_Val := R_Val * Powten (S); + if S <= Maxpow then + D_Val := D_Val * Powten (S); + else + D_Val := D_Val * Large_Powten (S); + end if; else - while S < -Maxpow loop - R_Val := R_Val / Powten (Maxpow); - S := S + Maxpow; - end loop; + if S < -Maxexp then + D_Val := D_Val / Large_Powten (Maxexp); + S := S + Maxexp; + end if; - R_Val := R_Val / Powten (-S); + if S >= -Maxpow then + D_Val := D_Val / Powten (-S); + else + D_Val := D_Val / Large_Powten (-S); + end if; end if; + + R_Val := Double_Real.To_Single (D_Val); end; -- Implementation for other bases with exponentiation @@ -273,6 +294,7 @@ package body System.Val_Real is B : constant Num := Num (Base); begin + R_Val := Double_Real.To_Single (D_Val); if S > 0 then R_Val := R_Val * B ** S; @@ -298,6 +320,34 @@ package body System.Val_Real is when Constraint_Error => Bad_Value (Str); end Integer_to_Real; + ------------------ + -- Large_Powten -- + ------------------ + + function Large_Powten (Exp : Natural) return Double_T is + Powten : constant array (0 .. Maxpow) of Double_T; + pragma Import (Ada, Powten); + for Powten'Address use Powten_Address; + + R : Double_T; + E : Natural; + + begin + pragma Assert (Exp > Maxpow); + + R := Powten (Maxpow); + E := Exp - Maxpow; + + while E > Maxpow loop + R := R * Powten (Maxpow); + E := E - Maxpow; + end loop; + + R := R * Powten (E); + + return R; + end Large_Powten; + --------------- -- Scan_Real -- --------------- diff --git a/gcc/ada/libgnat/s-valrea.ads b/gcc/ada/libgnat/s-valrea.ads index b2b28c25ec9f..e2613e030613 100644 --- a/gcc/ada/libgnat/s-valrea.ads +++ b/gcc/ada/libgnat/s-valrea.ads @@ -36,12 +36,12 @@ generic type Num is digits <>; - type Uns is mod <>; - Maxpow : Positive; Powten_Address : System.Address; + type Uns is mod <>; + package System.Val_Real is pragma Preelaborate; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 3bc36a148a9e..07820dba88aa 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -264,13 +264,15 @@ package Rtsfind is System_Img_Fixed_32, System_Img_Fixed_64, System_Img_Fixed_128, + System_Img_Flt, System_Img_Int, + System_Img_LFlt, + System_Img_LLF, System_Img_LLI, System_Img_LLLI, System_Img_LLU, System_Img_LLLU, System_Img_Name, - System_Img_Real, System_Img_Uns, System_Img_WChar, System_Interrupts, @@ -956,14 +958,14 @@ package Rtsfind is RE_Fore_Decimal128, -- System.Fore_Decimal_128 + RE_Fore_Fixed, -- System.Fore_Real + RE_Fore_Fixed32, -- System.Fore_Fixed_32 RE_Fore_Fixed64, -- System.Fore_Fixed_64 RE_Fore_Fixed128, -- System.Fore_Fixed_128 - RE_Fore_Real, -- System.Fore_Real - RE_Image_Boolean, -- System.Img_Bool RE_Image_Character, -- System.Img_Char @@ -979,8 +981,14 @@ package Rtsfind is RE_Image_Enumeration_16, -- System.Img_Enum_New RE_Image_Enumeration_32, -- System.Img_Enum_New + RE_Image_Float, -- System_Img_Flt + RE_Image_Integer, -- System.Img_Int + RE_Image_Long_Float, -- System_Img_LFlt + + RE_Image_Long_Long_Float, -- System_Img_LLF + RE_Image_Long_Long_Integer, -- System.Img_LLI RE_Image_Long_Long_Long_Integer, -- System.Img_LLLI @@ -989,12 +997,13 @@ package Rtsfind is RE_Image_Long_Long_Long_Unsigned, -- System.Img_LLLU + RE_Image_Fixed, -- System.Img_LFlt + RE_Image_Fixed32, -- System.Img_Fixed_32 + RE_Image_Fixed64, -- System.Img_Fixed_64 - RE_Image_Fixed128, -- System.Img_Fixed_128 - RE_Image_Ordinary_Fixed_Point, -- System.Img_Real - RE_Image_Floating_Point, -- System.Img_Real + RE_Image_Fixed128, -- System.Img_Fixed_128 RE_Image_Unsigned, -- System.Img_Uns @@ -2635,14 +2644,14 @@ package Rtsfind is RE_Fore_Decimal128 => System_Fore_Decimal_128, + RE_Fore_Fixed => System_Fore_Real, + RE_Fore_Fixed32 => System_Fore_Fixed_32, RE_Fore_Fixed64 => System_Fore_Fixed_64, RE_Fore_Fixed128 => System_Fore_Fixed_128, - RE_Fore_Real => System_Fore_Real, - RE_Image_Boolean => System_Img_Bool, RE_Image_Character => System_Img_Char, @@ -2658,8 +2667,14 @@ package Rtsfind is RE_Image_Enumeration_16 => System_Img_Enum_New, RE_Image_Enumeration_32 => System_Img_Enum_New, + RE_Image_Float => System_Img_Flt, + RE_Image_Integer => System_Img_Int, + RE_Image_Long_Float => System_Img_LFlt, + + RE_Image_Long_Long_Float => System_Img_LLF, + RE_Image_Long_Long_Integer => System_Img_LLI, RE_Image_Long_Long_Long_Integer => System_Img_LLLI, @@ -2668,12 +2683,13 @@ package Rtsfind is RE_Image_Long_Long_Long_Unsigned => System_Img_LLLU, + RE_Image_Fixed => System_Img_LFlt, + RE_Image_Fixed32 => System_Img_Fixed_32, + RE_Image_Fixed64 => System_Img_Fixed_64, - RE_Image_Fixed128 => System_Img_Fixed_128, - RE_Image_Ordinary_Fixed_Point => System_Img_Real, - RE_Image_Floating_Point => System_Img_Real, + RE_Image_Fixed128 => System_Img_Fixed_128, RE_Image_Unsigned => System_Img_Uns,