s-dlmkio$(objext) \
s-dlmopr$(objext) \
s-dmotpr$(objext) \
+ s-dourea$(objext) \
s-dsaser$(objext) \
s-elaall$(objext) \
s-excdeb$(objext) \
s-imaged$(objext) \
s-imagef$(objext) \
s-imagei$(objext) \
+ s-imager$(objext) \
s-imageu$(objext) \
s-imagew$(objext) \
s-imde32$(objext) \
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) \
a-naliop.ads<libgnat/a-naliop__nolibm.ads \
a-nuaufl.ads<libgnat/a-nuaufl__wraplf.ads \
a-nashfl.ads<libgnat/a-nashfl__wraplf.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \
s-intman.ads<libgnarl/s-intman__vxworks.ads \
s-intman.adb<libgnarl/s-intman__vxworks.adb \
a-nuaufl.ads<libgnat/a-nuaufl__wraplf.ads \
a-nashfl.ads<libgnat/a-nashfl__wraplf.ads \
g-io.adb<hie/g-io__vxworks-cert.adb \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \
s-interr.adb<libgnarl/s-interr__vxworks.adb \
s-intman.ads<libgnarl/s-intman__vxworks.ads \
s-vxwext.adb<libgnarl/s-vxwext__noints.adb \
s-vxwext.ads<libgnarl/s-vxwext__vthreads.ads \
s-vxwork.ads<libgnarl/s-vxwork__ppc.ads \
- system.ads<libgnat/system-vxworks-$(ARCH_STR)-vthread.ads \
$(ATOMICS_TARGET_PAIRS) \
- $(ATOMICS_BUILTINS_TARGET_PAIRS)
+ $(ATOMICS_BUILTINS_TARGET_PAIRS) \
+ system.ads<libgnat/system-vxworks-$(ARCH_STR)-vthread.ads
EH_MECHANISM=-gcc
EH_MECHANISM=-gcc
SIGTRAMP_OBJ=sigtramp-vxworks.o
LIBGNAT_TARGET_PAIRS += $(GNATRTL_128BIT_PAIRS) \
- a-nallfl.ads<libgnat/a-nallfl__wraplf.ads
+ a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb
EXTRA_GNATRTL_NONTASKING_OBJS += $(GNATRTL_128BIT_OBJS)
else
ifeq ($(strip $(filter-out arm%, $(target_cpu))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<libgnarl/a-intnam__qnx.ads \
a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__qnx.adb \
s-osinte.adb<libgnarl/s-osinte__qnx.adb \
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<libgnarl/a-intnam__freebsd.ads \
a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__posix.adb \
s-mudido.adb<libgnarl/s-mudido__affinity.adb \
a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
a-synbar.adb<libgnarl/a-synbar__posix.adb \
a-synbar.ads<libgnarl/a-synbar__posix.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__posix.adb \
s-linux.ads<libgnarl/s-linux.ads \
a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
a-synbar.adb<libgnarl/a-synbar__posix.adb \
a-synbar.ads<libgnarl/a-synbar__posix.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__posix.adb \
s-linux.ads<libgnarl/s-linux.ads \
a-nuauco.ads<libgnat/a-nuauco__x86.ads \
a-synbar.adb<libgnarl/a-synbar__posix.adb \
a-synbar.ads<libgnarl/a-synbar__posix.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__posix.adb \
s-linux.ads<libgnarl/s-linux.ads \
ifeq ($(strip $(filter-out ia64% hp hpux%,$(target_cpu) $(target_vendor) $(target_os))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<libgnarl/a-intnam__hpux.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__posix.adb \
s-osinte.adb<libgnarl/s-osinte__posix.adb \
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<libgnarl/a-intnam__linux.ads \
a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__posix.adb \
s-linux.ads<libgnarl/s-linux__riscv.ads \
LIBGNAT_TARGET_PAIRS += \
a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
s-intman.adb<libgnarl/s-intman__susv3.adb \
+ s-dorepr.adb<libgnat/s-dorepr__fma.adb \
s-osprim.adb<libgnat/s-osprim__darwin.adb \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS) \
-- min (scale of Typ'Small, 0)
-- For other ordinary fixed-point types
- -- xx = Real
- -- ftyp = Universal_Real
+ -- xx = Fixed
+ -- ftyp = Long_Float
-- pm = none
-- Note that we know that the type is a nonstatic subtype, or Fore would
Fid := RE_Fore_Fixed128;
Ftyp := RTE (RE_Integer_128);
else
- Fid := RE_Fore_Real;
- Ftyp := Universal_Real;
+ Fid := RE_Fore_Fixed;
+ Ftyp := Standard_Long_Float;
end if;
end;
end if;
-- For ordinary fixed-point types, append Num, Den and Scale
-- parameters and also set to do literal conversion
- elsif Fid /= RE_Fore_Real then
+ elsif Fid /= RE_Fore_Fixed then
Set_Conversion_OK (First (Arg_List));
Set_Conversion_OK (Next (First (Arg_List)));
-- For floating-point types
-- xx = Floating_Point
- -- tv = Long_Long_Float (Expr)
+ -- tv = [Long_[Long_]]Float (Expr)
-- pm = typ'Digits (typ = subtype of expression)
-- For decimal fixed-point types
-- typ'Aft
-- For other ordinary fixed-point types
- -- xx = Ordinary_Fixed_Point
- -- tv = Long_Long_Float (Expr)
+ -- xx = Fixed
+ -- tv = Long_Float (Expr)
-- pm = typ'Aft (typ = subtype of expression)
-- For enumeration types other than those declared in package Standard
-- Ada 2020 allows 'Image on private types, so fetch the underlying
-- type to obtain the structure of the type. We use the base type,
- -- not the root type, to handle properly derived types, but we use
- -- the root type for enumeration types, because the literal map is
- -- attached to the root. Should be inherited ???
+ -- not the root type for discrete types, to handle properly derived
+ -- types, but we use the root type for enumeration types, because the
+ -- literal map is attached to the root. Should be inherited ???
- if Is_Enumeration_Type (Ptyp) then
+ if Is_Real_Type (Ptyp) or else Is_Enumeration_Type (Ptyp) then
Rtyp := Underlying_Type (Root_Type (Ptyp));
else
Rtyp := Underlying_Type (Base_Type (Ptyp));
Imid := RE_Image_Fixed128;
Tent := RTE (RE_Integer_128);
else
- Imid := RE_Image_Ordinary_Fixed_Point;
- Tent := Standard_Long_Long_Float;
+ Imid := RE_Image_Fixed;
+ Tent := Standard_Long_Float;
end if;
end;
elsif Is_Floating_Point_Type (Rtyp) then
- Imid := RE_Image_Floating_Point;
- Tent := Standard_Long_Long_Float;
+ -- Short_Float and Float are the same type for GNAT
+
+ if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
+ Imid := RE_Image_Float;
+ Tent := Standard_Float;
+
+ elsif Rtyp = Standard_Long_Float then
+ Imid := RE_Image_Long_Float;
+ Tent := Standard_Long_Float;
+
+ else
+ Imid := RE_Image_Long_Long_Float;
+ Tent := Standard_Long_Long_Float;
+ end if;
-- Only other possibility is user-defined enumeration type
-- and also set to do literal conversion.
elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
- if Imid /= RE_Image_Ordinary_Fixed_Point then
+ if Imid /= RE_Image_Fixed then
Set_Conversion_OK (First (Arg_List));
Append_To (Arg_List,
-- btyp?(Value_Decimal{32,64,128} (X, typ'Scale));
- -- For the most common ordinary fixed-point types
+ -- For the most common ordinary fixed-point types, it expands into
-- btyp?(Value_Fixed{32,64,128} (X, numerator of S, denominator of S));
-- where S = typ'Small
- -- For Wide_[Wide_]Character types, typ'Value (X) expands into:
+ -- For other ordinary fixed-point types, it expands into
+
+ -- btyp (Value_Long_Float (X))
+
+ -- For Wide_[Wide_]Character types, typ'Value (X) expands into
-- btyp (Value_xx (X, EM))
if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
Vid := RE_Value_Float;
- -- If Long_Float and Long_Long_Float are the same type, then use the
- -- implementation of the former, which is faster and more accurate.
-
- elsif Rtyp = Standard_Long_Float
- or else (Rtyp = Standard_Long_Long_Float
- and then
- Standard_Long_Long_Float_Size = Standard_Long_Float_Size)
- then
+ elsif Rtyp = Standard_Long_Float then
Vid := RE_Value_Long_Float;
- elsif Rtyp = Standard_Long_Long_Float then
- Vid := RE_Value_Long_Long_Float;
-
else
- raise Program_Error;
+ Vid := RE_Value_Long_Long_Float;
end if;
-- Only other possibility is user-defined enumeration type
ada/libgnat/g-byorma.o \
ada/libgnat/g-dynhta.o \
ada/libgnat/g-graphs.o \
- ada/libgnat/g-hesora.o \
+ ada/libgnat/g-heasor.o \
ada/libgnat/g-htable.o \
ada/libgnat/g-lists.o \
ada/libgnat/g-sets.o \
ada/libgnat/g-spchge.o \
ada/libgnat/g-speche.o \
+ ada/libgnat/g-table.o \
ada/libgnat/g-u3spch.o \
ada/get_targ.o \
ada/ghost.o \
ada/libgnat/s-crtl.o \
ada/libgnat/s-excdeb.o \
ada/libgnat/s-except.o \
+ ada/libgnat/s-excmac.o \
ada/libgnat/s-exctab.o \
- ada/libgnat/s-excmac.o \
ada/libgnat/s-htable.o \
ada/libgnat/s-imenne.o \
- ada/libgnat/s-imgenu.o \
- ada/libgnat/s-imgint.o \
+ ada/libgnat/s-imgint.o \
ada/libgnat/s-mastop.o \
ada/libgnat/s-memory.o \
ada/libgnat/s-os_lib.o \
package body Fixed_Conversions is
- package Float_Aux is new Float_Conversions (Long_Long_Float);
+ package Float_Aux is new Float_Conversions (Long_Float);
subtype LLLI is Long_Long_Long_Integer;
subtype LLLU is Long_Long_Long_Unsigned;
Num'Small_Numerator > 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);
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);
-- 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;
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
---------
-- 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))
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
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;
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
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;
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
-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
-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
-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;
-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;
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;
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
-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
-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
-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;
-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;
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
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;
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;
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
------------------------------------------------------------------------------
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;
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
-- 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;
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
---------
-- 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))
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
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;
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
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;
-- 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;
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
-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
-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
-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;
-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
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;
-- 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;
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
-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
-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
-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;
-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
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
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;
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;
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
------------------------------------------------------------------------------
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;
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
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
---------
-- 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))
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
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;
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
-- 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;
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;
-- 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;
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
-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
-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
-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;
-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
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;
-- 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;
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
-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
-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
-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;
-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
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
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;
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;
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
------------------------------------------------------------------------------
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;
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
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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;
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
end loop;
return F;
- end Fore_Real;
+ end Fore_Fixed;
end System.Fore_Real;
-- --
------------------------------------------------------------------------------
--- 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;
-- 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.
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Double_Real;
+with System.Float_Control;
+with System.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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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;
-- --
------------------------------------------------------------------------------
-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;
-- --
------------------------------------------------------------------------------
--- 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;
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;
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;
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;
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;
-- 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
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;
-- 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
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;
-- 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
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;
-- --
------------------------------------------------------------------------------
+with System.Double_Real;
with System.Float_Control;
with System.Unsigned_Types; use System.Unsigned_Types;
with System.Val_Util; use System.Val_Util;
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;
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 --
-- Maximum exponent of the base that can fit in Num
R_Val : Num;
+ D_Val : Double_T;
S : Integer := Scale;
begin
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)
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
-- 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;
-- 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
B : constant Num := Num (Base);
begin
+ R_Val := Double_Real.To_Single (D_Val);
if S > 0 then
R_Val := R_Val * B ** S;
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 --
---------------
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;
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,
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
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
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
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,
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,
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,
projects / thirdparty / gcc.git / commitdiff
