[Ada] Implement tiered support for floating-point input operations
gcc/ada/ * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Remove s-fatsfl$(objext) and add s-valflt$(objext), s-vallfl$(objext), s-valllf$(objext). * exp_attr.adb (Find_Fat_Info): Merge Short_Float and Float cases. * exp_imgv.adb (Expand_Value_Attribute): Replace RE_Value_Real with RE_Value_Long_Long_Float for fixed-point types and use appropriate base type for floating-point types. * rtsfind.ads (RTU_Id): Remove System_Fat_IEEE_Long_Float, System_Fat_IEEE_Short_Float and System_Val_Real, add System_Val_Flt, System_Val_LFlt and System_Val_LLF. (RE_Id): Remove RE_Attr_IEEE_Long, RE_Fat_IEEE_Long, RE_Attr_IEEE_Short, RE_Fat_IEEE_Short, RE_Attr_Short_Float, add RE_Value_Float, RE_Value_Long_Float, RE_Value_Long_Long_Float, (RE_Unit_Table): Likewise. * libgnat/a-ticoau.ads: Add with clause for Float_Aux and make the package generic. (Get): Change parameter types to Num. (Put): Likewise. (Gets): Likewise. (Puts): Likewise. * libgnat/a-ticoau.adb: Remove clause and renaming for Float_Aux. (Get): Change parameter types to Num. (Gets): Likewise. (Put): Likewise. (Puts): Likewise. Add conversion to Long_Long_Float. * libgnat/a-ticoio.adb: Remove with clause for Ada.Text_IO, add with clause for Float_Aux, add with and use clauses for System.Val_Flt, System.Val_LFlt and System.Val_LLF. Instantiate Float_Aux and Complex_Aux on Float, Long_Float, and Long_Long_Float. (OK_Float): New boolean constant. (OK_Long_Float): Likewise. (Get): Call appropriate Get routine from auxiliary package. (Get): Call appropriate Gets routine from auxiliary package. (Put): Call appropriate Put routine from auxiliary package. (Put): Call appropriate Puts routine from auxiliary package. * libgnat/a-tideau.adb: Remove with and use clause for Float_Aux. * libgnat/a-tifiau.adb: Likewise. * libgnat/a-tifiio.adb: Add with and use clause for System.Val_LLF. Instantiate Float_Aux on Long_Long_Float. (Get): Adjust call to Get routine from auxiliary package. (Get): Adjust call to Gets routine from auxiliary package. (Put): Adjust call to Put routine from auxiliary package. (Put): Adjust call to Puts routine from auxiliary package. * libgnat/a-tifiio__128.adb: Likewise. (Get): Likewise. (Get): Likewise. (Put): Likewise. (Put): Likewise. * libgnat/a-tiflau.ads: Make the package generic. (Get): Change parameter type to Num. (Put): Likewise. (Gets): Likewise. (Puts): Likewise. * libgnat/a-tiflau.adb: Remove clauses for System.Val_Real. (Get): Change parameter type to Num and call Scan routine. (Gets): Likewise. (Load_Real): Move to... (Put): Change parameter type and add conversion to Long_Long_Float. (Puts): Likewise. * libgnat/a-tiflio.adb: Add with and use clauses for System.Val_Flt, System.Val_LFlt and System.Val_LLF. Instantiate Float_Aux on Float, Long_Float and Long_Long_Float. (OK_Float): New boolean constant. (OK_Long_Float): Likewise. (Get): Call appropriate Get routine from auxiliary package. (Get): Call previous variant. (Get): Call appropriate Gets routine from auxiliary package. (Put): Call appropriate Put routine from auxiliary package. (Put): Call previous variant. (Put): Call appropriate Puts routine from auxiliary package. * libgnat/a-tigeau.ads (Load_Real): New procedure. * libgnat/a-tigeau.adb (Load_Real): ...here. * libgnat/a-wtcoau.ads: Add with clause for Float_Aux and make the package generic. (Get): Change parameter types to Num. (Put): Likewise. (Gets): Likewise. (Puts): Likewise. * libgnat/a-wtcoau.adb: Remove clause and renaming for Float_Aux. (Get): Change parameter types to Num. (Gets): Likewise. (Put): Likewise. (Puts): Likewise. Add conversion to Long_Long_Float. * libgnat/a-wtcoio.ads: Remove use clause for Complex_Types and use qualified names throughout accordingly. * libgnat/a-wtcoio.adb: Remove clause for Ada.Unchecked_Conversion, add with clause for Float_Aux, add clauses for System.Val_Flt, System.Val_LFlt and System.Val_LLF. Add clause for Complex_Types. Instantiate Float_Aux and Complex_Aux on Float, Long_Float, and Long_Long_Float. Remove LLF subtype and TFT instantiation. (OK_Float): New boolean constant. (OK_Long_Float): Likewise. (Get): Call appropriate Get routine from auxiliary package. (Get): Call appropriate Gets routine from auxiliary package. (Put): Call appropriate Put routine from auxiliary package. (Put): Call appropriate Puts routine from auxiliary package. * libgnat/a-wtdeau.adb: Remove with and use clause for Float_Aux. * libgnat/a-wtfiau.adb: Likewise. * libgnat/a-wtfiio.adb: Add with and use clause for System.Val_LLF. Instantiate Float_Aux on Long_Long_Float. (Get): Adjust call to Get routine from auxiliary package. (Get): Adjust call to Gets routine from auxiliary package. (Put): Adjust call to Put routine from auxiliary package. (Put): Adjust call to Puts routine from auxiliary package. * libgnat/a-wtfiio__128.adb: Likewise. (Get): Likewise. (Get): Likewise. (Put): Likewise. (Put): Likewise. * libgnat/a-wtflau.ads: Make the package generic. (Get): Change parameter type to Num. (Put): Likewise. (Gets): Likewise. (Puts): Likewise. * libgnat/a-wtflau.adb: Remove clauses for System.Val_Real. (Get): Change parameter type to Num and call Scan routine. Set Ptr parameter lazily. (Gets): Likewise. (Load_Real): Move to... (Put): Change parameter type and add conversion to Long_Long_Float. Bump buffer length to Max_Real_Image_Length. (Puts): Likewise. * libgnat/a-wtflio.adb: Add with and use clauses for System.Val_Flt, System.Val_LFlt and System.Val_LLF. Instantiate Float_Aux on Float, Long_Float and Long_Long_Float. (OK_Float): New boolean constant. (OK_Long_Float): Likewise. (Get): Call appropriate Get routine from auxiliary package. Add pragma Unsuppress (Range_Check) and manual validity check. (Get): Call appropriate Gets routine from auxiliary package. Add pragma Unsuppress (Range_Check) and manual validity check. (Put): Call appropriate Put routine from auxiliary package. (Put): Call appropriate Puts routine from auxiliary package. * libgnat/a-wtgeau.ads (Load_Real): New procedure. * libgnat/a-wtgeau.adb (Load_Real): ...here. * libgnat/a-ztcoau.ads: Add with clause for Float_Aux and make the package generic. (Get): Change parameter types to Num. (Put): Likewise. (Gets): Likewise. (Puts): Likewise. * libgnat/a-ztcoau.adb: Remove clause and renaming for Float_Aux. (Get): Change parameter types to Num. (Gets): Likewise. (Put): Likewise. (Puts): Likewise. Add conversion to Long_Long_Float. * libgnat/a-ztcoio.ads: Remove use clause for Complex_Types and use qualified names throughout accordingly. * libgnat/a-ztcoio.adb: Remove clause for Ada.Unchecked_Conversion, add with clause for Float_Aux, add clauses for System.Val_Flt, System.Val_LFlt and System.Val_LLF. Add clause for Complex_Types. Instantiate Float_Aux and Complex_Aux on Float, Long_Float, and Long_Long_Float. Remove LLF subtype and TFT instantiation. (OK_Float): New boolean constant. (OK_Long_Float): Likewise. (Get): Call appropriate Get routine from auxiliary package. (Get): Call appropriate Gets routine from auxiliary package. (Put): Call appropriate Put routine from auxiliary package. (Put): Call appropriate Puts routine from auxiliary package. * libgnat/a-ztdeau.adb: Remove with and use clause for Float_Aux. * libgnat/a-ztfiau.adb: Likewise. * libgnat/a-ztfiio.adb: Add with and use clause for System.Val_LLF. Instantiate Float_Aux on Long_Long_Float. (Get): Adjust call to Get routine from auxiliary package. (Get): Adjust call to Gets routine from auxiliary package. (Put): Adjust call to Put routine from auxiliary package. (Put): Adjust call to Puts routine from auxiliary package. * libgnat/a-ztfiio__128.adb: Likewise. (Get): Likewise. (Get): Likewise. (Put): Likewise. (Put): Likewise. * libgnat/a-ztflau.ads: Make the package generic. (Get): Change parameter type to Num. (Put): Likewise. (Gets): Likewise. (Puts): Likewise. * libgnat/a-ztflau.adb: Remove clauses for System.Val_Real. (Get): Change parameter type to Num and call Scan routine. Set Ptr parameter lazily. (Gets): Likewise. (Load_Real): Move to... (Put): Change parameter type and add conversion to Long_Long_Float. Bump buffer length to Max_Real_Image_Length. (Puts): Likewise. * libgnat/a-ztflio.adb: Add with and use clauses for System.Val_Flt, System.Val_LFlt and System.Val_LLF. Instantiate Float_Aux on Float, Long_Float and Long_Long_Float. (OK_Float): New boolean constant. (OK_Long_Float): Likewise. (Get): Call appropriate Get routine from auxiliary package. Add pragma Unsuppress (Range_Check) and manual validity check. (Get): Call appropriate Gets routine from auxiliary package. Add pragma Unsuppress (Range_Check) and manual validity check. (Put): Call appropriate Put routine from auxiliary package. (Put): Call appropriate Puts routine from auxiliary package. * libgnat/a-ztgeau.ads (Load_Real): New procedure. * libgnat/a-ztgeau.adb (Load_Real): ...here. * libgnat/s-fatsfl.ads: Delete. * libgnat/s-valflt.ads: New package. * libgnat/s-vallfl.ads: Likewise. * libgnat/s-valllf.ads: Likewise. * libgnat/s-valrea.ads: Make generic. Add assertions, defensive code and clarify intent. (Scan_Real): Change parameter type to Num. (Value_Real): Likewise. * libgnat/s-valrea.adb: Instantiate Value_R on Uns. (Integer_to_Real): Change parameter and result to Num. Call Float_Control.Reset only if the mantissa is 64 bits. Use a divide to compute the final value if the scale is negative. (Scan_Real): Change result to Num. (Value_Real): Likewise. * libgnat/s-valuer.adb: Add assertions, defensive code and clarify intent. (F_Limit): Delete. (I_Limit): Likewise. (Precision_Limit): Always use the integer limit. * libgnat/s-fatgen.adb: Add pragma Annotate.
This commit is contained in:
Eric Botcazou
Pierre-Marie de Rodat
parent
1851d3cef2
commit
338e513351
49 changed files with 1266 additions and 707 deletions
|
|
@ -596,7 +596,6 @@ GNATRTL_NONTASKING_OBJS= \
|
|||
s-fatgen$(objext) \
|
||||
s-fatlfl$(objext) \
|
||||
s-fatllf$(objext) \
|
||||
s-fatsfl$(objext) \
|
||||
s-ficobl$(objext) \
|
||||
s-filatt$(objext) \
|
||||
s-fileio$(objext) \
|
||||
|
|
@ -756,7 +755,10 @@ GNATRTL_NONTASKING_OBJS= \
|
|||
s-vafi32$(objext) \
|
||||
s-vafi64$(objext) \
|
||||
s-valenu$(objext) \
|
||||
s-valflt$(objext) \
|
||||
s-valint$(objext) \
|
||||
s-vallfl$(objext) \
|
||||
s-valllf$(objext) \
|
||||
s-vallli$(objext) \
|
||||
s-valllu$(objext) \
|
||||
s-valrea$(objext) \
|
||||
|
|
|
|||
|
|
@ -8311,27 +8311,25 @@ package body Exp_Attr is
|
|||
-- All we do is use the root type (historically this dealt with
|
||||
-- VAX-float .. to be cleaned up further later ???)
|
||||
|
||||
Fat_Type := Rtyp;
|
||||
if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
|
||||
Fat_Type := Standard_Float;
|
||||
Fat_Pkg := RE_Attr_Float;
|
||||
|
||||
if Fat_Type = Standard_Short_Float then
|
||||
Fat_Pkg := RE_Attr_Short_Float;
|
||||
elsif Rtyp = Standard_Long_Float then
|
||||
Fat_Type := Standard_Long_Float;
|
||||
Fat_Pkg := RE_Attr_Long_Float;
|
||||
|
||||
elsif Fat_Type = Standard_Float then
|
||||
Fat_Pkg := RE_Attr_Float;
|
||||
|
||||
elsif Fat_Type = Standard_Long_Float then
|
||||
Fat_Pkg := RE_Attr_Long_Float;
|
||||
|
||||
elsif Fat_Type = Standard_Long_Long_Float then
|
||||
Fat_Pkg := RE_Attr_Long_Long_Float;
|
||||
elsif Rtyp = Standard_Long_Long_Float then
|
||||
Fat_Type := Standard_Long_Long_Float;
|
||||
Fat_Pkg := RE_Attr_Long_Long_Float;
|
||||
|
||||
-- Universal real (which is its own root type) is treated as being
|
||||
-- equivalent to Standard.Long_Long_Float, since it is defined to
|
||||
-- have the same precision as the longest Float type.
|
||||
|
||||
elsif Fat_Type = Universal_Real then
|
||||
elsif Rtyp = Universal_Real then
|
||||
Fat_Type := Standard_Long_Long_Float;
|
||||
Fat_Pkg := RE_Attr_Long_Long_Float;
|
||||
Fat_Pkg := RE_Attr_Long_Long_Float;
|
||||
|
||||
else
|
||||
raise Program_Error;
|
||||
|
|
|
|||
|
|
@ -1008,10 +1008,10 @@ package body Exp_Imgv is
|
|||
then
|
||||
Vid := RE_Value_Fixed128;
|
||||
else
|
||||
Vid := RE_Value_Real;
|
||||
Vid := RE_Value_Long_Long_Float;
|
||||
end if;
|
||||
|
||||
if Vid /= RE_Value_Real then
|
||||
if Vid /= RE_Value_Long_Long_Float then
|
||||
Append_To (Args,
|
||||
Make_Integer_Literal (Loc, -Norm_Num (Small_Value (Rtyp))));
|
||||
|
||||
|
|
@ -1031,7 +1031,18 @@ package body Exp_Imgv is
|
|||
end;
|
||||
|
||||
elsif Is_Floating_Point_Type (Rtyp) then
|
||||
Vid := RE_Value_Real;
|
||||
if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
|
||||
Vid := RE_Value_Float;
|
||||
|
||||
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;
|
||||
end if;
|
||||
|
||||
-- Only other possibility is user-defined enumeration type
|
||||
|
||||
|
|
|
|||
|
|
@ -30,22 +30,19 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
|
||||
with Ada.Text_IO.Float_Aux;
|
||||
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
|
||||
package body Ada.Text_IO.Complex_Aux is
|
||||
|
||||
package Aux renames Ada.Text_IO.Float_Aux;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
---------
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Width : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
|
|
@ -95,8 +92,8 @@ package body Ada.Text_IO.Complex_Aux is
|
|||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
Paren : Boolean;
|
||||
|
|
@ -139,8 +136,8 @@ package body Ada.Text_IO.Complex_Aux is
|
|||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
|
|
@ -159,8 +156,8 @@ package body Ada.Text_IO.Complex_Aux is
|
|||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
|
|
@ -174,9 +171,9 @@ package body Ada.Text_IO.Complex_Aux is
|
|||
-- Both parts are initially converted with a Fore of 0
|
||||
|
||||
Rptr := 0;
|
||||
Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp);
|
||||
Iptr := 0;
|
||||
Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp);
|
||||
|
||||
-- Check room for both parts plus parens plus comma (RM G.1.3(34))
|
||||
|
||||
|
|
|
|||
|
|
@ -30,39 +30,46 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains the routines for Ada.Text_IO.Complex_IO that are
|
||||
-- shared among separate instantiations of this package. The routines in
|
||||
-- this package are identical semantically to those in Complex_IO itself,
|
||||
-- except that the generic parameter Complex has been replaced by separate
|
||||
-- real and imaginary values of type Long_Long_Float, and default parameters
|
||||
-- have been removed because they are supplied explicitly by the calls from
|
||||
-- within the generic template.
|
||||
-- shared among separate instantiations of this package. The routines in this
|
||||
-- package are identical semantically to those in Complex_IO, except that the
|
||||
-- generic parameter Complex has been replaced by separate real and imaginary
|
||||
-- parameters, and default parameters have been removed because they are
|
||||
-- supplied explicitly by the calls from within the generic template.
|
||||
|
||||
with Ada.Text_IO.Float_Aux;
|
||||
|
||||
private generic
|
||||
|
||||
type Num is digits <>;
|
||||
|
||||
with package Aux is new Ada.Text_IO.Float_Aux (Num, <>);
|
||||
|
||||
package Ada.Text_IO.Complex_Aux is
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Width : Field);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
|
|
|
|||
|
|
@ -29,18 +29,42 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Text_IO;
|
||||
|
||||
with Ada.Text_IO.Complex_Aux;
|
||||
with Ada.Text_IO.Float_Aux;
|
||||
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.Complex_IO is
|
||||
|
||||
use Complex_Types;
|
||||
|
||||
package Aux renames Ada.Text_IO.Complex_Aux;
|
||||
package Scalar_Float is new
|
||||
Ada.Text_IO.Float_Aux (Float, Scan_Float);
|
||||
|
||||
subtype LLF is Long_Long_Float;
|
||||
-- Type used for calls to routines in Aux
|
||||
package Scalar_Long_Float is new
|
||||
Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
|
||||
|
||||
package Scalar_Long_Long_Float is new
|
||||
Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
package Aux_Float is new
|
||||
Ada.Text_IO.Complex_Aux (Float, Scalar_Float);
|
||||
|
||||
package Aux_Long_Float is new
|
||||
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);
|
||||
|
||||
-- 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
|
||||
-- is needed. These boolean constants are used to test for this, such that
|
||||
-- only code for the relevant case is included in the instance.
|
||||
|
||||
OK_Float : constant Boolean := Real'Base'Digits <= Float'Digits;
|
||||
|
||||
OK_Long_Float : constant Boolean := Real'Base'Digits <= Long_Float'Digits;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
@ -48,14 +72,24 @@ package body Ada.Text_IO.Complex_IO is
|
|||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Complex_Types.Complex;
|
||||
Item : out Complex;
|
||||
Width : Field := 0)
|
||||
is
|
||||
Real_Item : Real'Base;
|
||||
Imag_Item : Real'Base;
|
||||
|
||||
begin
|
||||
Aux.Get (File, LLF (Real_Item), LLF (Imag_Item), Width);
|
||||
if OK_Float then
|
||||
Aux_Float.Get (File, Float (Real_Item), Float (Imag_Item), Width);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Get
|
||||
(File, Long_Float (Real_Item), Long_Float (Imag_Item), Width);
|
||||
else
|
||||
Aux_Long_Long_Float.Get
|
||||
(File, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
|
||||
Width);
|
||||
end if;
|
||||
|
||||
Item := (Real_Item, Imag_Item);
|
||||
|
||||
exception
|
||||
|
|
@ -67,7 +101,7 @@ package body Ada.Text_IO.Complex_IO is
|
|||
---------
|
||||
|
||||
procedure Get
|
||||
(Item : out Complex_Types.Complex;
|
||||
(Item : out Complex;
|
||||
Width : Field := 0)
|
||||
is
|
||||
begin
|
||||
|
|
@ -80,14 +114,24 @@ package body Ada.Text_IO.Complex_IO is
|
|||
|
||||
procedure Get
|
||||
(From : String;
|
||||
Item : out Complex_Types.Complex;
|
||||
Item : out Complex;
|
||||
Last : out Positive)
|
||||
is
|
||||
Real_Item : Real'Base;
|
||||
Imag_Item : Real'Base;
|
||||
|
||||
begin
|
||||
Aux.Gets (From, LLF (Real_Item), LLF (Imag_Item), Last);
|
||||
if OK_Float then
|
||||
Aux_Float.Gets (From, Float (Real_Item), Float (Imag_Item), Last);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Gets
|
||||
(From, Long_Float (Real_Item), Long_Float (Imag_Item), Last);
|
||||
else
|
||||
Aux_Long_Long_Float.Gets
|
||||
(From, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
|
||||
Last);
|
||||
end if;
|
||||
|
||||
Item := (Real_Item, Imag_Item);
|
||||
|
||||
exception
|
||||
|
|
@ -100,13 +144,24 @@ package body Ada.Text_IO.Complex_IO is
|
|||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Complex_Types.Complex;
|
||||
Item : Complex;
|
||||
Fore : Field := Default_Fore;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Put (File, LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Put
|
||||
(File, Float (Re (Item)), Float (Im (Item)), Fore, Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Put
|
||||
(File, Long_Float (Re (Item)), Long_Float (Im (Item)), Fore, Aft,
|
||||
Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
|
||||
Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
---------
|
||||
|
|
@ -114,7 +169,7 @@ package body Ada.Text_IO.Complex_IO is
|
|||
---------
|
||||
|
||||
procedure Put
|
||||
(Item : Complex_Types.Complex;
|
||||
(Item : Complex;
|
||||
Fore : Field := Default_Fore;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp)
|
||||
|
|
@ -129,12 +184,21 @@ package body Ada.Text_IO.Complex_IO is
|
|||
|
||||
procedure Put
|
||||
(To : out String;
|
||||
Item : Complex_Types.Complex;
|
||||
Item : Complex;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Puts (To, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Puts (To, Float (Re (Item)), Float (Im (Item)), Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Puts
|
||||
(To, Long_Float (Re (Item)), Long_Float (Im (Item)), Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Puts
|
||||
(To, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
|
||||
Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
end Ada.Text_IO.Complex_IO;
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
|
||||
with Ada.Text_IO.Float_Aux; use Ada.Text_IO.Float_Aux;
|
||||
|
||||
package body Ada.Text_IO.Decimal_Aux is
|
||||
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
|
||||
with Ada.Text_IO.Float_Aux; use Ada.Text_IO.Float_Aux;
|
||||
|
||||
package body Ada.Text_IO.Fixed_Aux is
|
||||
|
||||
|
|
|
|||
|
|
@ -160,6 +160,7 @@ with System.Img_Fixed_32; use System.Img_Fixed_32;
|
|||
with System.Img_Fixed_64; use System.Img_Fixed_64;
|
||||
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;
|
||||
|
||||
package body Ada.Text_IO.Fixed_IO is
|
||||
|
||||
|
|
@ -177,6 +178,9 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
package Aux64 is new
|
||||
Ada.Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
-- 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
|
||||
-- to test for this, such that only code for the relevant case is included
|
||||
|
|
@ -279,7 +283,7 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -313,7 +317,7 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Gets (From, Long_Long_Float (Item), Last);
|
||||
Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -341,7 +345,8 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
@ -371,7 +376,7 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Puts (To, Long_Long_Float (Item), Aft, Exp);
|
||||
Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
|
|||
|
|
@ -162,6 +162,7 @@ with System.Img_Fixed_128; use System.Img_Fixed_128;
|
|||
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;
|
||||
|
||||
package body Ada.Text_IO.Fixed_IO is
|
||||
|
||||
|
|
@ -183,6 +184,9 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
package Aux128 is new
|
||||
Ada.Text_IO.Fixed_Aux (Int128, Scan_Fixed128, Set_Image_Fixed128);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
-- 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
|
||||
-- boolean constants are used to test for this, such that only code for the
|
||||
|
|
@ -319,7 +323,7 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -358,7 +362,7 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Gets (From, Long_Long_Float (Item), Last);
|
||||
Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -390,7 +394,8 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
@ -424,7 +429,7 @@ package body Ada.Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Puts (To, Long_Long_Float (Item), Aft, Exp);
|
||||
Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
|
|||
|
|
@ -32,7 +32,6 @@
|
|||
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
|
||||
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
with System.Val_Real; use System.Val_Real;
|
||||
|
||||
package body Ada.Text_IO.Float_Aux is
|
||||
|
||||
|
|
@ -42,7 +41,7 @@ package body Ada.Text_IO.Float_Aux is
|
|||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Width : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
|
|
@ -58,7 +57,7 @@ package body Ada.Text_IO.Float_Aux is
|
|||
Ptr := 1;
|
||||
end if;
|
||||
|
||||
Item := Scan_Real (Buf, Ptr'Access, Stop);
|
||||
Item := Scan (Buf, Ptr'Access, Stop);
|
||||
Check_End_Of_Field (Buf, Stop, Ptr, Width);
|
||||
end Get;
|
||||
|
||||
|
|
@ -68,127 +67,27 @@ package body Ada.Text_IO.Float_Aux is
|
|||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
Pos : aliased Integer;
|
||||
|
||||
begin
|
||||
String_Skip (From, Pos);
|
||||
Item := Scan_Real (From, Pos'Access, From'Last);
|
||||
Item := Scan (From, Pos'Access, From'Last);
|
||||
Last := Pos - 1;
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
end Gets;
|
||||
|
||||
---------------
|
||||
-- Load_Real --
|
||||
---------------
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural)
|
||||
is
|
||||
Loaded : Boolean;
|
||||
|
||||
begin
|
||||
-- Skip initial blanks, and load possible sign
|
||||
|
||||
Load_Skip (File);
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
|
||||
-- Case of .nnnn
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise must have digits to start
|
||||
|
||||
else
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Based cases. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Case of nnn#.xxx#
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
|
||||
-- Case of nnn#xxx.[xxx]# or nnn#xxx#
|
||||
|
||||
else
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
|
||||
-- As usual, it seems strange to allow mixed base characters,
|
||||
-- but that is what ACVC tests expect, see CE3804M, case (3).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
end if;
|
||||
|
||||
-- Case of nnn.[nnn] or nnn
|
||||
|
||||
else
|
||||
-- Prevent the potential processing of '.' in cases where the
|
||||
-- initial digits have a trailing underscore.
|
||||
|
||||
if Buf (Ptr) = '_' then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with exponent
|
||||
|
||||
Load (File, Buf, Ptr, 'E', 'e', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end Load_Real;
|
||||
|
||||
---------
|
||||
-- Put --
|
||||
---------
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
|
|
@ -197,7 +96,7 @@ package body Ada.Text_IO.Float_Aux is
|
|||
Ptr : Natural := 0;
|
||||
|
||||
begin
|
||||
Set_Image_Real (Item, Buf, Ptr, Fore, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp);
|
||||
Put_Item (File, Buf (1 .. Ptr));
|
||||
end Put;
|
||||
|
||||
|
|
@ -207,7 +106,7 @@ package body Ada.Text_IO.Float_Aux is
|
|||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
|
|
@ -215,7 +114,8 @@ package body Ada.Text_IO.Float_Aux is
|
|||
Ptr : Natural := 0;
|
||||
|
||||
begin
|
||||
Set_Image_Real (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
|
||||
Set_Image_Real
|
||||
(Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
|
||||
|
||||
if Ptr > To'Length then
|
||||
raise Layout_Error;
|
||||
|
|
|
|||
|
|
@ -31,41 +31,42 @@
|
|||
|
||||
-- This package contains the routines for Ada.Text_IO.Float_IO that are
|
||||
-- shared among separate instantiations of this package. The routines in
|
||||
-- this package are identical semantically to those in Float_IO itself,
|
||||
-- except that generic parameter Num has been replaced by Long_Long_Float,
|
||||
-- and the default parameters have been removed because they are supplied
|
||||
-- this package are identical semantically to those in Float_IO, except
|
||||
-- that the default parameters have been removed because they are supplied
|
||||
-- explicitly by the calls from within the generic template. This package
|
||||
-- is also used by Ada.Text_IO.Fixed_IO, and Ada.Text_IO.Decimal_IO.
|
||||
-- is also used by Ada.Text_IO.Fixed_IO and Ada.Text_IO.Decimal_IO.
|
||||
|
||||
private package Ada.Text_IO.Float_Aux is
|
||||
private generic
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural);
|
||||
-- This is an auxiliary routine that is used to load a possibly signed
|
||||
-- real literal value from the input file into Buf, starting at Ptr + 1.
|
||||
type Num is digits <>;
|
||||
|
||||
with function Scan
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Num;
|
||||
|
||||
package Ada.Text_IO.Float_Aux is
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Width : Field);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
|
|
|
|||
|
|
@ -30,10 +30,29 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Text_IO.Float_Aux;
|
||||
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 renames Ada.Text_IO.Float_Aux;
|
||||
package Aux_Float is new
|
||||
Ada.Text_IO.Float_Aux (Float, Scan_Float);
|
||||
|
||||
package Aux_Long_Float is new
|
||||
Ada.Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Text_IO.Float_Aux (Long_Long_Float, Scan_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
|
||||
-- is needed. These boolean constants are used to test for this, such that
|
||||
-- only code for the relevant case is included in the instance.
|
||||
|
||||
OK_Float : constant Boolean := Num'Base'Digits <= Float'Digits;
|
||||
|
||||
OK_Long_Float : constant Boolean := Num'Base'Digits <= Long_Float'Digits;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
@ -47,7 +66,13 @@ package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is
|
|||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
if OK_Float then
|
||||
Aux_Float.Get (File, Float (Item), Width);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Get (File, Long_Float (Item), Width);
|
||||
else
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
-- In the case where the type is unconstrained (e.g. Standard'Float),
|
||||
-- the above conversion may result in an infinite value, which is
|
||||
|
|
@ -66,22 +91,8 @@ package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is
|
|||
(Item : out Num;
|
||||
Width : Field := 0)
|
||||
is
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
Aux.Get (Current_In, Long_Long_Float (Item), Width);
|
||||
|
||||
-- In the case where the type is unconstrained (e.g. Standard'Float),
|
||||
-- the above conversion may result in an infinite value, which is
|
||||
-- normally fine for a conversion, but in this case, we want to treat
|
||||
-- that as a data error.
|
||||
|
||||
if not Item'Valid then
|
||||
raise Data_Error;
|
||||
end if;
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
Get (Current_In, Item, Width);
|
||||
end Get;
|
||||
|
||||
procedure Get
|
||||
|
|
@ -92,7 +103,13 @@ package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is
|
|||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
Aux.Gets (From, Long_Long_Float (Item), Last);
|
||||
if OK_Float then
|
||||
Aux_Float.Gets (From, Float (Item), Last);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Gets (From, Long_Float (Item), Last);
|
||||
else
|
||||
Aux_Long_Long_Float.Gets (From, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
-- In the case where the type is unconstrained (e.g. Standard'Float),
|
||||
-- the above conversion may result in an infinite value, which is
|
||||
|
|
@ -119,7 +136,14 @@ package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is
|
|||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Put (File, Float (Item), Fore, Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
procedure Put
|
||||
|
|
@ -129,7 +153,7 @@ package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is
|
|||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Put (Current_Out, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
Put (Current_Out, Item, Fore, Aft, Exp);
|
||||
end Put;
|
||||
|
||||
procedure Put
|
||||
|
|
@ -139,7 +163,13 @@ package body Ada.Text_IO.Float_IO with SPARK_Mode => Off is
|
|||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Puts (To, Long_Long_Float (Item), Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Puts (To, Float (Item), Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Puts (To, Long_Float (Item), Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Puts (To, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
end Ada.Text_IO.Float_IO;
|
||||
|
|
|
|||
|
|
@ -376,6 +376,106 @@ package body Ada.Text_IO.Generic_Aux is
|
|||
end if;
|
||||
end Load_Integer;
|
||||
|
||||
---------------
|
||||
-- Load_Real --
|
||||
---------------
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural)
|
||||
is
|
||||
Loaded : Boolean;
|
||||
|
||||
begin
|
||||
-- Skip initial blanks, and load possible sign
|
||||
|
||||
Load_Skip (File);
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
|
||||
-- Case of .nnnn
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise must have digits to start
|
||||
|
||||
else
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Based cases. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Case of nnn#.xxx#
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
|
||||
-- Case of nnn#xxx.[xxx]# or nnn#xxx#
|
||||
|
||||
else
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
|
||||
-- As usual, it seems strange to allow mixed base characters,
|
||||
-- but that is what ACVC tests expect, see CE3804M, case (3).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
end if;
|
||||
|
||||
-- Case of nnn.[nnn] or nnn
|
||||
|
||||
else
|
||||
-- Prevent the potential processing of '.' in cases where the
|
||||
-- initial digits have a trailing underscore.
|
||||
|
||||
if Buf (Ptr) = '_' then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with exponent
|
||||
|
||||
Load (File, Buf, Ptr, 'E', 'e', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end Load_Real;
|
||||
|
||||
---------------
|
||||
-- Load_Skip --
|
||||
---------------
|
||||
|
|
|
|||
|
|
@ -156,6 +156,12 @@ private package Ada.Text_IO.Generic_Aux is
|
|||
Ptr : in out Natural);
|
||||
-- Loads a possibly signed integer literal value
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural);
|
||||
-- Loads a possibly signed real literal value
|
||||
|
||||
function Nextc (File : File_Type) return Integer;
|
||||
-- Like Getc, but includes a call to Ungetc, so that the file
|
||||
-- pointer is not moved by the call.
|
||||
|
|
|
|||
|
|
@ -30,22 +30,19 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
|
||||
with Ada.Wide_Text_IO.Float_Aux;
|
||||
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
|
||||
package body Ada.Wide_Text_IO.Complex_Aux is
|
||||
|
||||
package Aux renames Ada.Wide_Text_IO.Float_Aux;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
---------
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Width : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
|
|
@ -95,8 +92,8 @@ package body Ada.Wide_Text_IO.Complex_Aux is
|
|||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
Paren : Boolean;
|
||||
|
|
@ -139,8 +136,8 @@ package body Ada.Wide_Text_IO.Complex_Aux is
|
|||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
|
|
@ -159,8 +156,8 @@ package body Ada.Wide_Text_IO.Complex_Aux is
|
|||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
|
|
@ -174,9 +171,9 @@ package body Ada.Wide_Text_IO.Complex_Aux is
|
|||
-- Both parts are initially converted with a Fore of 0
|
||||
|
||||
Rptr := 0;
|
||||
Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp);
|
||||
Iptr := 0;
|
||||
Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp);
|
||||
|
||||
-- Check room for both parts plus parens plus comma (RM G.1.3(34))
|
||||
|
||||
|
|
|
|||
|
|
@ -29,40 +29,47 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains the routines for Ada.Wide_Text_IO.Complex_IO that
|
||||
-- are shared among separate instantiations of this package. The routines
|
||||
-- in this package are identical semantically to those in Complex_IO itself,
|
||||
-- except that the generic parameter Complex has been replaced by separate
|
||||
-- real and imaginary values of type Long_Long_Float, and default parameters
|
||||
-- have been removed because they are supplied explicitly by the calls from
|
||||
-- within the generic template.
|
||||
-- This package contains the routines for Ada.Wide_Text_IO.Complex_IO that are
|
||||
-- shared among separate instantiations of this package. The routines in this
|
||||
-- package are identical semantically to those in Complex_IO, except that the
|
||||
-- generic parameter Complex has been replaced by separate real and imaginary
|
||||
-- parameters, and default parameters have been removed because they are
|
||||
-- supplied explicitly by the calls from within the generic template.
|
||||
|
||||
with Ada.Wide_Text_IO.Float_Aux;
|
||||
|
||||
private generic
|
||||
|
||||
type Num is digits <>;
|
||||
|
||||
with package Aux is new Ada.Wide_Text_IO.Float_Aux (Num, <>);
|
||||
|
||||
package Ada.Wide_Text_IO.Complex_Aux is
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Width : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
|
|
|
|||
|
|
@ -30,24 +30,43 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Text_IO.Complex_Aux;
|
||||
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
with Ada.Unchecked_Conversion;
|
||||
with Ada.Wide_Text_IO.Float_Aux;
|
||||
with System.Val_Flt; use System.Val_Flt;
|
||||
with System.Val_LFlt; use System.Val_LFlt;
|
||||
with System.Val_LLF; use System.Val_LLF;
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
package body Ada.Wide_Text_IO.Complex_IO is
|
||||
|
||||
package Aux renames Ada.Wide_Text_IO.Complex_Aux;
|
||||
use Complex_Types;
|
||||
|
||||
subtype LLF is Long_Long_Float;
|
||||
-- Type used for calls to routines in Aux
|
||||
package Scalar_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float);
|
||||
|
||||
function TFT is new
|
||||
Ada.Unchecked_Conversion (File_Type, Ada.Wide_Text_IO.File_Type);
|
||||
-- This unchecked conversion is to get around a visibility bug in
|
||||
-- GNAT version 2.04w. It should be possible to simply use the
|
||||
-- subtype declared above and do normal checked conversions.
|
||||
package Scalar_Long_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
|
||||
|
||||
package Scalar_Long_Long_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
package Aux_Float is new
|
||||
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);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
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
|
||||
-- is needed. These boolean constants are used to test for this, such that
|
||||
-- only code for the relevant case is included in the instance.
|
||||
|
||||
OK_Float : constant Boolean := Real'Base'Digits <= Float'Digits;
|
||||
|
||||
OK_Long_Float : constant Boolean := Real'Base'Digits <= Long_Float'Digits;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
@ -62,7 +81,17 @@ package body Ada.Wide_Text_IO.Complex_IO is
|
|||
Imag_Item : Real'Base;
|
||||
|
||||
begin
|
||||
Aux.Get (TFT (File), LLF (Real_Item), LLF (Imag_Item), Width);
|
||||
if OK_Float then
|
||||
Aux_Float.Get (File, Float (Real_Item), Float (Imag_Item), Width);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Get
|
||||
(File, Long_Float (Real_Item), Long_Float (Imag_Item), Width);
|
||||
else
|
||||
Aux_Long_Long_Float.Get
|
||||
(File, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
|
||||
Width);
|
||||
end if;
|
||||
|
||||
Item := (Real_Item, Imag_Item);
|
||||
|
||||
exception
|
||||
|
|
@ -100,7 +129,17 @@ package body Ada.Wide_Text_IO.Complex_IO is
|
|||
-- Aux.Gets will raise Data_Error in any case.
|
||||
|
||||
begin
|
||||
Aux.Gets (S, LLF (Real_Item), LLF (Imag_Item), Last);
|
||||
if OK_Float then
|
||||
Aux_Float.Gets (S, Float (Real_Item), Float (Imag_Item), Last);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Gets
|
||||
(S, Long_Float (Real_Item), Long_Float (Imag_Item), Last);
|
||||
else
|
||||
Aux_Long_Long_Float.Gets
|
||||
(S, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
|
||||
Last);
|
||||
end if;
|
||||
|
||||
Item := (Real_Item, Imag_Item);
|
||||
|
||||
exception
|
||||
|
|
@ -119,7 +158,18 @@ package body Ada.Wide_Text_IO.Complex_IO is
|
|||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Put (TFT (File), LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Put
|
||||
(File, Float (Re (Item)), Float (Im (Item)), Fore, Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Put
|
||||
(File, Long_Float (Re (Item)), Long_Float (Im (Item)), Fore, Aft,
|
||||
Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
|
||||
Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
---------
|
||||
|
|
@ -149,7 +199,16 @@ package body Ada.Wide_Text_IO.Complex_IO is
|
|||
S : String (To'First .. To'Last);
|
||||
|
||||
begin
|
||||
Aux.Puts (S, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Puts (S, Float (Re (Item)), Float (Im (Item)), Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Puts
|
||||
(S, Long_Float (Re (Item)), Long_Float (Im (Item)), Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Puts
|
||||
(S, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
|
||||
Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
To (J) := Wide_Character'Val (Character'Pos (S (J)));
|
||||
|
|
|
|||
|
|
@ -20,42 +20,40 @@ generic
|
|||
|
||||
package Ada.Wide_Text_IO.Complex_IO is
|
||||
|
||||
use Complex_Types;
|
||||
|
||||
Default_Fore : Field := 2;
|
||||
Default_Aft : Field := Real'Digits - 1;
|
||||
Default_Aft : Field := Complex_Types.Real'Digits - 1;
|
||||
Default_Exp : Field := 3;
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Complex;
|
||||
Item : out Complex_Types.Complex;
|
||||
Width : Field := 0);
|
||||
|
||||
procedure Get
|
||||
(Item : out Complex;
|
||||
(Item : out Complex_Types.Complex;
|
||||
Width : Field := 0);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Complex;
|
||||
Item : Complex_Types.Complex;
|
||||
Fore : Field := Default_Fore;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp);
|
||||
|
||||
procedure Put
|
||||
(Item : Complex;
|
||||
(Item : Complex_Types.Complex;
|
||||
Fore : Field := Default_Fore;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp);
|
||||
|
||||
procedure Get
|
||||
(From : Wide_String;
|
||||
Item : out Complex;
|
||||
Item : out Complex_Types.Complex;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Put
|
||||
(To : out Wide_String;
|
||||
Item : Complex;
|
||||
Item : Complex_Types.Complex;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp);
|
||||
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
|
||||
with Ada.Wide_Text_IO.Float_Aux; use Ada.Wide_Text_IO.Float_Aux;
|
||||
|
||||
package body Ada.Wide_Text_IO.Decimal_Aux is
|
||||
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
|
||||
with Ada.Wide_Text_IO.Float_Aux; use Ada.Wide_Text_IO.Float_Aux;
|
||||
|
||||
package body Ada.Wide_Text_IO.Fixed_Aux is
|
||||
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@ with System.Img_Fixed_32; use System.Img_Fixed_32;
|
|||
with System.Img_Fixed_64; use System.Img_Fixed_64;
|
||||
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.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
|
|
@ -55,6 +56,9 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
package Aux64 is new
|
||||
Ada.Wide_Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
-- 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
|
||||
-- to test for this, such that only code for the relevant case is included
|
||||
|
|
@ -157,7 +161,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -197,7 +201,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Gets (S, Long_Long_Float (Item), Last);
|
||||
Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -225,7 +229,8 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
@ -257,7 +262,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@ with System.Img_Fixed_128; use System.Img_Fixed_128;
|
|||
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.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
|
|
@ -61,6 +62,9 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
package Aux128 is new
|
||||
Ada.Wide_Text_IO.Fixed_Aux (Int128, Scan_Fixed128, Set_Image_Fixed128);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
-- 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
|
||||
-- boolean constants are used to test for this, such that only code for the
|
||||
|
|
@ -197,7 +201,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -242,7 +246,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Gets (S, Long_Long_Float (Item), Last);
|
||||
Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -274,7 +278,8 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
@ -310,7 +315,7 @@ package body Ada.Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
|
|
|
|||
|
|
@ -31,8 +31,7 @@
|
|||
|
||||
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
|
||||
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
with System.Val_Real; use System.Val_Real;
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
|
||||
package body Ada.Wide_Text_IO.Float_Aux is
|
||||
|
||||
|
|
@ -42,12 +41,12 @@ package body Ada.Wide_Text_IO.Float_Aux is
|
|||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Width : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
Stop : Integer := 0;
|
||||
Ptr : aliased Integer := 1;
|
||||
Ptr : aliased Integer;
|
||||
|
||||
begin
|
||||
if Width /= 0 then
|
||||
|
|
@ -55,10 +54,10 @@ package body Ada.Wide_Text_IO.Float_Aux is
|
|||
String_Skip (Buf, Ptr);
|
||||
else
|
||||
Load_Real (File, Buf, Stop);
|
||||
Ptr := 1;
|
||||
end if;
|
||||
|
||||
Item := Scan_Real (Buf, Ptr'Access, Stop);
|
||||
|
||||
Item := Scan (Buf, Ptr'Access, Stop);
|
||||
Check_End_Of_Field (Buf, Stop, Ptr, Width);
|
||||
end Get;
|
||||
|
||||
|
|
@ -68,137 +67,36 @@ package body Ada.Wide_Text_IO.Float_Aux is
|
|||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
Pos : aliased Integer;
|
||||
|
||||
begin
|
||||
String_Skip (From, Pos);
|
||||
Item := Scan_Real (From, Pos'Access, From'Last);
|
||||
Item := Scan (From, Pos'Access, From'Last);
|
||||
Last := Pos - 1;
|
||||
|
||||
exception
|
||||
when Constraint_Error =>
|
||||
raise Data_Error;
|
||||
when Constraint_Error => raise Data_Error;
|
||||
end Gets;
|
||||
|
||||
---------------
|
||||
-- Load_Real --
|
||||
---------------
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural)
|
||||
is
|
||||
Loaded : Boolean;
|
||||
|
||||
begin
|
||||
-- Skip initial blanks and load possible sign
|
||||
|
||||
Load_Skip (File);
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
|
||||
-- Case of .nnnn
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise must have digits to start
|
||||
|
||||
else
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Case of nnn#.xxx#
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
|
||||
-- Case of nnn#xxx.[xxx]# or nnn#xxx#
|
||||
|
||||
else
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
|
||||
-- As usual, it seems strange to allow mixed base characters,
|
||||
-- but that is what ACVC tests expect, see CE3804M, case (3).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
end if;
|
||||
|
||||
-- Case of nnn.[nnn] or nnn
|
||||
|
||||
else
|
||||
-- Prevent the potential processing of '.' in cases where the
|
||||
-- initial digits have a trailing underscore.
|
||||
|
||||
if Buf (Ptr) = '_' then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with exponent
|
||||
|
||||
Load (File, Buf, Ptr, 'E', 'e', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end Load_Real;
|
||||
|
||||
---------
|
||||
-- Put --
|
||||
---------
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
Buf : String (1 .. Max_Real_Image_Length);
|
||||
Ptr : Natural := 0;
|
||||
|
||||
begin
|
||||
Set_Image_Real (Item, Buf, Ptr, Fore, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp);
|
||||
Put_Item (File, Buf (1 .. Ptr));
|
||||
end Put;
|
||||
|
||||
|
|
@ -208,15 +106,16 @@ package body Ada.Wide_Text_IO.Float_Aux is
|
|||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
Buf : String (1 .. Max_Real_Image_Length);
|
||||
Ptr : Natural := 0;
|
||||
|
||||
begin
|
||||
Set_Image_Real (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
|
||||
Set_Image_Real
|
||||
(Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
|
||||
|
||||
if Ptr > To'Length then
|
||||
raise Layout_Error;
|
||||
|
|
|
|||
|
|
@ -31,41 +31,42 @@
|
|||
|
||||
-- This package contains the routines for Ada.Wide_Text_IO.Float_IO that
|
||||
-- are shared among separate instantiations of this package. The routines
|
||||
-- in this package are identical semantically to those in Float_IO itself,
|
||||
-- except that generic parameter Num has been replaced by Long_Long_Float,
|
||||
-- and the default parameters have been removed because they are supplied
|
||||
-- in this package are identical semantically to those in Float_IO, except
|
||||
-- that the default parameters have been removed because they are supplied
|
||||
-- explicitly by the calls from within the generic template. This package
|
||||
-- is also used by Ada.Wide_Text_IO.Fixed_IO, Ada.Wide_Text_IO.Decimal_IO.
|
||||
-- is also used by Ada.Wide_Text_IO.Fixed_IO and Ada.Wide_Text_IO.Decimal_IO.
|
||||
|
||||
private package Ada.Wide_Text_IO.Float_Aux is
|
||||
private generic
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural);
|
||||
-- This is an auxiliary routine that is used to load a possibly signed
|
||||
-- real literal value from the input file into Buf, starting at Ptr + 1.
|
||||
type Num is digits <>;
|
||||
|
||||
with function Scan
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Num;
|
||||
|
||||
package Ada.Wide_Text_IO.Float_Aux is
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Width : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Long_Long_Float;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Num;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
|
|
|
|||
|
|
@ -30,13 +30,31 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Text_IO.Float_Aux;
|
||||
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
with System.Val_Flt; use System.Val_Flt;
|
||||
with System.Val_LFlt; use System.Val_LFlt;
|
||||
with System.Val_LLF; use System.Val_LLF;
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
package body Ada.Wide_Text_IO.Float_IO is
|
||||
|
||||
package Aux renames Ada.Wide_Text_IO.Float_Aux;
|
||||
package Aux_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Float, Scan_Float);
|
||||
|
||||
package Aux_Long_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_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
|
||||
-- is needed. These boolean constants are used to test for this, such that
|
||||
-- only code for the relevant case is included in the instance.
|
||||
|
||||
OK_Float : constant Boolean := Num'Base'Digits <= Float'Digits;
|
||||
|
||||
OK_Long_Float : constant Boolean := Num'Base'Digits <= Long_Float'Digits;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
@ -47,8 +65,25 @@ package body Ada.Wide_Text_IO.Float_IO is
|
|||
Item : out Num;
|
||||
Width : Field := 0)
|
||||
is
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
if OK_Float then
|
||||
Aux_Float.Get (File, Float (Item), Width);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Get (File, Long_Float (Item), Width);
|
||||
else
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
-- In the case where the type is unconstrained (e.g. Standard'Float),
|
||||
-- the above conversion may result in an infinite value, which is
|
||||
-- normally fine for a conversion, but in this case, we want to treat
|
||||
-- that as a data error.
|
||||
|
||||
if not Item'Valid then
|
||||
raise Data_Error;
|
||||
end if;
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
|
|
@ -67,6 +102,8 @@ package body Ada.Wide_Text_IO.Float_IO is
|
|||
Item : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
S : constant String := Wide_String_To_String (From, WCEM_Upper);
|
||||
-- String on which we do the actual conversion. Note that the method
|
||||
-- used for wide character encoding is irrelevant, since if there is
|
||||
|
|
@ -74,7 +111,22 @@ package body Ada.Wide_Text_IO.Float_IO is
|
|||
-- Aux.Gets will raise Data_Error in any case.
|
||||
|
||||
begin
|
||||
Aux.Gets (S, Long_Long_Float (Item), Last);
|
||||
if OK_Float then
|
||||
Aux_Float.Gets (S, Float (Item), Last);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Gets (S, Long_Float (Item), Last);
|
||||
else
|
||||
Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
-- In the case where the type is unconstrained (e.g. Standard'Float),
|
||||
-- the above conversion may result in an infinite value, which is
|
||||
-- normally fine for a conversion, but in this case, we want to treat
|
||||
-- that as a data error.
|
||||
|
||||
if not Item'Valid then
|
||||
raise Data_Error;
|
||||
end if;
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
|
|
@ -92,7 +144,14 @@ package body Ada.Wide_Text_IO.Float_IO is
|
|||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Put (File, Float (Item), Fore, Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
procedure Put
|
||||
|
|
@ -114,7 +173,13 @@ package body Ada.Wide_Text_IO.Float_IO is
|
|||
S : String (To'First .. To'Last);
|
||||
|
||||
begin
|
||||
Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Puts (S, Float (Item), Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
To (J) := Wide_Character'Val (Character'Pos (S (J)));
|
||||
|
|
|
|||
|
|
@ -402,6 +402,106 @@ package body Ada.Wide_Text_IO.Generic_Aux is
|
|||
end if;
|
||||
end Load_Integer;
|
||||
|
||||
---------------
|
||||
-- Load_Real --
|
||||
---------------
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural)
|
||||
is
|
||||
Loaded : Boolean;
|
||||
|
||||
begin
|
||||
-- Skip initial blanks and load possible sign
|
||||
|
||||
Load_Skip (File);
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
|
||||
-- Case of .nnnn
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise must have digits to start
|
||||
|
||||
else
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Case of nnn#.xxx#
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
|
||||
-- Case of nnn#xxx.[xxx]# or nnn#xxx#
|
||||
|
||||
else
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
|
||||
-- As usual, it seems strange to allow mixed base characters,
|
||||
-- but that is what ACVC tests expect, see CE3804M, case (3).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
end if;
|
||||
|
||||
-- Case of nnn.[nnn] or nnn
|
||||
|
||||
else
|
||||
-- Prevent the potential processing of '.' in cases where the
|
||||
-- initial digits have a trailing underscore.
|
||||
|
||||
if Buf (Ptr) = '_' then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with exponent
|
||||
|
||||
Load (File, Buf, Ptr, 'E', 'e', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end Load_Real;
|
||||
|
||||
---------------
|
||||
-- Load_Skip --
|
||||
---------------
|
||||
|
|
|
|||
|
|
@ -155,6 +155,12 @@ package Ada.Wide_Text_IO.Generic_Aux is
|
|||
Ptr : in out Natural);
|
||||
-- Loads a possibly signed integer literal value
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural);
|
||||
-- Loads a possibly signed real literal value
|
||||
|
||||
procedure Put_Item (File : File_Type; Str : String);
|
||||
-- This routine is like Wide_Text_IO.Put, except that it checks for
|
||||
-- overflow of bounded lines, as described in (RM A.10.6(8)). It is used
|
||||
|
|
|
|||
|
|
@ -30,22 +30,19 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
|
||||
with Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
|
||||
package body Ada.Wide_Wide_Text_IO.Complex_Aux is
|
||||
|
||||
package Aux renames Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
---------
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Width : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
|
|
@ -95,8 +92,8 @@ package body Ada.Wide_Wide_Text_IO.Complex_Aux is
|
|||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
Paren : Boolean;
|
||||
|
|
@ -139,8 +136,8 @@ package body Ada.Wide_Wide_Text_IO.Complex_Aux is
|
|||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
|
|
@ -159,8 +156,8 @@ package body Ada.Wide_Wide_Text_IO.Complex_Aux is
|
|||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
|
|
@ -174,9 +171,9 @@ package body Ada.Wide_Wide_Text_IO.Complex_Aux is
|
|||
-- Both parts are initially converted with a Fore of 0
|
||||
|
||||
Rptr := 0;
|
||||
Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (ItemR), R_String, Rptr, 0, Aft, Exp);
|
||||
Iptr := 0;
|
||||
Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (ItemI), I_String, Iptr, 0, Aft, Exp);
|
||||
|
||||
-- Check room for both parts plus parens plus comma (RM G.1.3(34))
|
||||
|
||||
|
|
|
|||
|
|
@ -15,38 +15,45 @@
|
|||
|
||||
-- This package contains the routines for Ada.Wide_Wide_Text_IO.Complex_IO
|
||||
-- that are shared among separate instantiations of this package. The routines
|
||||
-- in this package are identical semantically to those in Complex_IO itself,
|
||||
-- except that the generic parameter Complex has been replaced by separate
|
||||
-- real and imaginary values of type Long_Long_Float, and default parameters
|
||||
-- have been removed because they are supplied explicitly by the calls from
|
||||
-- within the generic template.
|
||||
-- in this package are identical semantically to those in Complex_IO, except
|
||||
-- that the generic parameter Complex has been replaced by separate real and
|
||||
-- imaginary parameters, and default parameters have been removed because they
|
||||
-- are supplied explicitly by the calls from within the generic template.
|
||||
|
||||
with Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
|
||||
private generic
|
||||
|
||||
type Num is digits <>;
|
||||
|
||||
with package Aux is new Ada.Wide_Wide_Text_IO.Float_Aux (Num, <>);
|
||||
|
||||
package Ada.Wide_Wide_Text_IO.Complex_Aux is
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Width : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Long_Long_Float;
|
||||
ItemI : out Long_Long_Float;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
ItemR : out Num;
|
||||
ItemI : out Num;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
ItemR : Long_Long_Float;
|
||||
ItemI : Long_Long_Float;
|
||||
ItemR : Num;
|
||||
ItemI : Num;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
|
|
|
|||
|
|
@ -30,24 +30,46 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Wide_Text_IO.Complex_Aux;
|
||||
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
with Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
with System.Val_Flt; use System.Val_Flt;
|
||||
with System.Val_LFlt; use System.Val_LFlt;
|
||||
with System.Val_LLF; use System.Val_LLF;
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
package body Ada.Wide_Wide_Text_IO.Complex_IO is
|
||||
|
||||
package Aux renames Ada.Wide_Wide_Text_IO.Complex_Aux;
|
||||
use Complex_Types;
|
||||
|
||||
subtype LLF is Long_Long_Float;
|
||||
-- Type used for calls to routines in Aux
|
||||
package Scalar_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float);
|
||||
|
||||
function TFT is new
|
||||
Ada.Unchecked_Conversion (File_Type, Ada.Wide_Wide_Text_IO.File_Type);
|
||||
-- This unchecked conversion is to get around a visibility bug in
|
||||
-- GNAT version 2.04w. It should be possible to simply use the
|
||||
-- subtype declared above and do normal checked conversions.
|
||||
package Scalar_Long_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
|
||||
|
||||
package Scalar_Long_Long_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
package Aux_Float is new
|
||||
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);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
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
|
||||
-- is needed. These boolean constants are used to test for this, such that
|
||||
-- only code for the relevant case is included in the instance.
|
||||
|
||||
OK_Float : constant Boolean := Real'Base'Digits <= Float'Digits;
|
||||
|
||||
OK_Long_Float : constant Boolean := Real'Base'Digits <= Long_Float'Digits;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
@ -62,7 +84,17 @@ package body Ada.Wide_Wide_Text_IO.Complex_IO is
|
|||
Imag_Item : Real'Base;
|
||||
|
||||
begin
|
||||
Aux.Get (TFT (File), LLF (Real_Item), LLF (Imag_Item), Width);
|
||||
if OK_Float then
|
||||
Aux_Float.Get (File, Float (Real_Item), Float (Imag_Item), Width);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Get
|
||||
(File, Long_Float (Real_Item), Long_Float (Imag_Item), Width);
|
||||
else
|
||||
Aux_Long_Long_Float.Get
|
||||
(File, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
|
||||
Width);
|
||||
end if;
|
||||
|
||||
Item := (Real_Item, Imag_Item);
|
||||
|
||||
exception
|
||||
|
|
@ -100,7 +132,17 @@ package body Ada.Wide_Wide_Text_IO.Complex_IO is
|
|||
-- Aux.Gets will raise Data_Error in any case.
|
||||
|
||||
begin
|
||||
Aux.Gets (S, LLF (Real_Item), LLF (Imag_Item), Last);
|
||||
if OK_Float then
|
||||
Aux_Float.Gets (S, Float (Real_Item), Float (Imag_Item), Last);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Gets
|
||||
(S, Long_Float (Real_Item), Long_Float (Imag_Item), Last);
|
||||
else
|
||||
Aux_Long_Long_Float.Gets
|
||||
(S, Long_Long_Float (Real_Item), Long_Long_Float (Imag_Item),
|
||||
Last);
|
||||
end if;
|
||||
|
||||
Item := (Real_Item, Imag_Item);
|
||||
|
||||
exception
|
||||
|
|
@ -119,7 +161,18 @@ package body Ada.Wide_Wide_Text_IO.Complex_IO is
|
|||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Put (TFT (File), LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Put
|
||||
(File, Float (Re (Item)), Float (Im (Item)), Fore, Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Put
|
||||
(File, Long_Float (Re (Item)), Long_Float (Im (Item)), Fore, Aft,
|
||||
Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
|
||||
Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
---------
|
||||
|
|
@ -149,7 +202,16 @@ package body Ada.Wide_Wide_Text_IO.Complex_IO is
|
|||
S : String (To'First .. To'Last);
|
||||
|
||||
begin
|
||||
Aux.Puts (S, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Puts (S, Float (Re (Item)), Float (Im (Item)), Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Puts
|
||||
(S, Long_Float (Re (Item)), Long_Float (Im (Item)), Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Puts
|
||||
(S, Long_Long_Float (Re (Item)), Long_Long_Float (Im (Item)),
|
||||
Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
To (J) := Wide_Wide_Character'Val (Character'Pos (S (J)));
|
||||
|
|
|
|||
|
|
@ -23,39 +23,39 @@ package Ada.Wide_Wide_Text_IO.Complex_IO is
|
|||
use Complex_Types;
|
||||
|
||||
Default_Fore : Field := 2;
|
||||
Default_Aft : Field := Real'Digits - 1;
|
||||
Default_Aft : Field := Complex_Types.Real'Digits - 1;
|
||||
Default_Exp : Field := 3;
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Complex;
|
||||
Item : out Complex_Types.Complex;
|
||||
Width : Field := 0);
|
||||
|
||||
procedure Get
|
||||
(Item : out Complex;
|
||||
(Item : out Complex_Types.Complex;
|
||||
Width : Field := 0);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Complex;
|
||||
Item : Complex_Types.Complex;
|
||||
Fore : Field := Default_Fore;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp);
|
||||
|
||||
procedure Put
|
||||
(Item : Complex;
|
||||
(Item : Complex_Types.Complex;
|
||||
Fore : Field := Default_Fore;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp);
|
||||
|
||||
procedure Get
|
||||
(From : Wide_Wide_String;
|
||||
Item : out Complex;
|
||||
Item : out Complex_Types.Complex;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Put
|
||||
(To : out Wide_Wide_String;
|
||||
Item : Complex;
|
||||
Item : Complex_Types.Complex;
|
||||
Aft : Field := Default_Aft;
|
||||
Exp : Field := Default_Exp);
|
||||
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
|
||||
with Ada.Wide_Wide_Text_IO.Float_Aux; use Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
|
||||
package body Ada.Wide_Wide_Text_IO.Decimal_Aux is
|
||||
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
|
||||
with Ada.Wide_Wide_Text_IO.Float_Aux; use Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
|
||||
package body Ada.Wide_Wide_Text_IO.Fixed_Aux is
|
||||
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@ with System.Img_Fixed_32; use System.Img_Fixed_32;
|
|||
with System.Img_Fixed_64; use System.Img_Fixed_64;
|
||||
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.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
|
|
@ -55,6 +56,9 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
package Aux64 is new
|
||||
Ada.Wide_Wide_Text_IO.Fixed_Aux (Int64, Scan_Fixed64, Set_Image_Fixed64);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
-- 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
|
||||
-- to test for this, such that only code for the relevant case is included
|
||||
|
|
@ -157,7 +161,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -197,7 +201,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Gets (S, Long_Long_Float (Item), Last);
|
||||
Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -225,7 +229,8 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
@ -257,7 +262,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@ with System.Img_Fixed_128; use System.Img_Fixed_128;
|
|||
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.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
|
|
@ -62,6 +63,9 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
Ada.Wide_Wide_Text_IO.Fixed_Aux
|
||||
(Int128, Scan_Fixed128, Set_Image_Fixed128);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_Long_Long_Float);
|
||||
|
||||
-- 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
|
||||
-- boolean constants are used to test for this, such that only code for the
|
||||
|
|
@ -198,7 +202,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -243,7 +247,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator,
|
||||
-Num'Small_Denominator));
|
||||
else
|
||||
Float_Aux.Gets (S, Long_Long_Float (Item), Last);
|
||||
Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
exception
|
||||
|
|
@ -275,7 +279,8 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
|
|
@ -311,7 +316,7 @@ package body Ada.Wide_Wide_Text_IO.Fixed_IO is
|
|||
-Num'Small_Numerator, -Num'Small_Denominator,
|
||||
For0, Num'Aft);
|
||||
else
|
||||
Float_Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
|
|
|
|||
|
|
@ -31,8 +31,7 @@
|
|||
|
||||
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
|
||||
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
with System.Val_Real; use System.Val_Real;
|
||||
with System.Img_Real; use System.Img_Real;
|
||||
|
||||
package body Ada.Wide_Wide_Text_IO.Float_Aux is
|
||||
|
||||
|
|
@ -42,12 +41,12 @@ package body Ada.Wide_Wide_Text_IO.Float_Aux is
|
|||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Width : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
Stop : Integer := 0;
|
||||
Ptr : aliased Integer := 1;
|
||||
Ptr : aliased Integer;
|
||||
|
||||
begin
|
||||
if Width /= 0 then
|
||||
|
|
@ -55,10 +54,10 @@ package body Ada.Wide_Wide_Text_IO.Float_Aux is
|
|||
String_Skip (Buf, Ptr);
|
||||
else
|
||||
Load_Real (File, Buf, Stop);
|
||||
Ptr := 1;
|
||||
end if;
|
||||
|
||||
Item := Scan_Real (Buf, Ptr'Access, Stop);
|
||||
|
||||
Item := Scan (Buf, Ptr'Access, Stop);
|
||||
Check_End_Of_Field (Buf, Stop, Ptr, Width);
|
||||
end Get;
|
||||
|
||||
|
|
@ -68,137 +67,36 @@ package body Ada.Wide_Wide_Text_IO.Float_Aux is
|
|||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
Pos : aliased Integer;
|
||||
|
||||
begin
|
||||
String_Skip (From, Pos);
|
||||
Item := Scan_Real (From, Pos'Access, From'Last);
|
||||
Item := Scan (From, Pos'Access, From'Last);
|
||||
Last := Pos - 1;
|
||||
|
||||
exception
|
||||
when Constraint_Error =>
|
||||
raise Data_Error;
|
||||
when Constraint_Error => raise Data_Error;
|
||||
end Gets;
|
||||
|
||||
---------------
|
||||
-- Load_Real --
|
||||
---------------
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural)
|
||||
is
|
||||
Loaded : Boolean;
|
||||
|
||||
begin
|
||||
-- Skip initial blanks and load possible sign
|
||||
|
||||
Load_Skip (File);
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
|
||||
-- Case of .nnnn
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise must have digits to start
|
||||
|
||||
else
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Case of nnn#.xxx#
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
|
||||
-- Case of nnn#xxx.[xxx]# or nnn#xxx#
|
||||
|
||||
else
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
|
||||
-- As usual, it seems strange to allow mixed base characters,
|
||||
-- but that is what ACVC tests expect, see CE3804M, case (3).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
end if;
|
||||
|
||||
-- Case of nnn.[nnn] or nnn
|
||||
|
||||
else
|
||||
-- Prevent the potential processing of '.' in cases where the
|
||||
-- initial digits have a trailing underscore.
|
||||
|
||||
if Buf (Ptr) = '_' then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with exponent
|
||||
|
||||
Load (File, Buf, Ptr, 'E', 'e', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end Load_Real;
|
||||
|
||||
---------
|
||||
-- Put --
|
||||
---------
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
Buf : String (1 .. Max_Real_Image_Length);
|
||||
Ptr : Natural := 0;
|
||||
|
||||
begin
|
||||
Set_Image_Real (Item, Buf, Ptr, Fore, Aft, Exp);
|
||||
Set_Image_Real (Long_Long_Float (Item), Buf, Ptr, Fore, Aft, Exp);
|
||||
Put_Item (File, Buf (1 .. Ptr));
|
||||
end Put;
|
||||
|
||||
|
|
@ -208,15 +106,16 @@ package body Ada.Wide_Wide_Text_IO.Float_Aux is
|
|||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Aft : Field;
|
||||
Exp : Field)
|
||||
is
|
||||
Buf : String (1 .. Field'Last);
|
||||
Ptr : Natural := 0;
|
||||
Buf : String (1 .. Max_Real_Image_Length);
|
||||
Ptr : Natural := 0;
|
||||
|
||||
begin
|
||||
Set_Image_Real (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
|
||||
Set_Image_Real
|
||||
(Long_Long_Float (Item), Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
|
||||
|
||||
if Ptr > To'Length then
|
||||
raise Layout_Error;
|
||||
|
|
|
|||
|
|
@ -31,41 +31,42 @@
|
|||
|
||||
-- This package contains the routines for Ada.Wide_Wide_Text_IO.Float_IO that
|
||||
-- are shared among separate instantiations of this package. The routines
|
||||
-- in this package are identical semantically to those in Float_IO itself,
|
||||
-- except that generic parameter Num has been replaced by Long_Long_Float,
|
||||
-- and the default parameters have been removed because they are supplied
|
||||
-- in this package are identical semantically to those in Float_IO, except
|
||||
-- that the default parameters have been removed because they are supplied
|
||||
-- explicitly by the calls from within the generic template. Also used by
|
||||
-- Ada.Wide_Wide_Text_IO.Fixed_IO, and by Ada.Wide_Wide_Text_IO.Decimal_IO.
|
||||
-- Ada.Wide_Wide_Text_IO.Fixed_IO and by Ada.Wide_Wide_Text_IO.Decimal_IO.
|
||||
|
||||
private package Ada.Wide_Wide_Text_IO.Float_Aux is
|
||||
private generic
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural);
|
||||
-- This is an auxiliary routine that is used to load a possibly signed
|
||||
-- real literal value from the input file into Buf, starting at Ptr + 1.
|
||||
type Num is digits <>;
|
||||
|
||||
with function Scan
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Num;
|
||||
|
||||
package Ada.Wide_Wide_Text_IO.Float_Aux is
|
||||
|
||||
procedure Get
|
||||
(File : File_Type;
|
||||
Item : out Long_Long_Float;
|
||||
Item : out Num;
|
||||
Width : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Long_Long_Float;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Put
|
||||
(File : File_Type;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Fore : Field;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
procedure Gets
|
||||
(From : String;
|
||||
Item : out Num;
|
||||
Last : out Positive);
|
||||
|
||||
procedure Puts
|
||||
(To : out String;
|
||||
Item : Long_Long_Float;
|
||||
Item : Num;
|
||||
Aft : Field;
|
||||
Exp : Field);
|
||||
|
||||
|
|
|
|||
|
|
@ -30,12 +30,31 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
with System.Val_Flt; use System.Val_Flt;
|
||||
with System.Val_LFlt; use System.Val_LFlt;
|
||||
with System.Val_LLF; use System.Val_LLF;
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_WtS; use System.WCh_WtS;
|
||||
|
||||
package body Ada.Wide_Wide_Text_IO.Float_IO is
|
||||
|
||||
package Aux renames Ada.Wide_Wide_Text_IO.Float_Aux;
|
||||
package Aux_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Float, Scan_Float);
|
||||
|
||||
package Aux_Long_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Long_Float, Scan_Long_Float);
|
||||
|
||||
package Aux_Long_Long_Float is new
|
||||
Ada.Wide_Wide_Text_IO.Float_Aux (Long_Long_Float, Scan_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
|
||||
-- is needed. These boolean constants are used to test for this, such that
|
||||
-- only code for the relevant case is included in the instance.
|
||||
|
||||
OK_Float : constant Boolean := Num'Base'Digits <= Float'Digits;
|
||||
|
||||
OK_Long_Float : constant Boolean := Num'Base'Digits <= Long_Float'Digits;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
@ -46,8 +65,25 @@ package body Ada.Wide_Wide_Text_IO.Float_IO is
|
|||
Item : out Num;
|
||||
Width : Field := 0)
|
||||
is
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
Aux.Get (File, Long_Long_Float (Item), Width);
|
||||
if OK_Float then
|
||||
Aux_Float.Get (File, Float (Item), Width);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Get (File, Long_Float (Item), Width);
|
||||
else
|
||||
Aux_Long_Long_Float.Get (File, Long_Long_Float (Item), Width);
|
||||
end if;
|
||||
|
||||
-- In the case where the type is unconstrained (e.g. Standard'Float),
|
||||
-- the above conversion may result in an infinite value, which is
|
||||
-- normally fine for a conversion, but in this case, we want to treat
|
||||
-- that as a data error.
|
||||
|
||||
if not Item'Valid then
|
||||
raise Data_Error;
|
||||
end if;
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
|
|
@ -66,6 +102,8 @@ package body Ada.Wide_Wide_Text_IO.Float_IO is
|
|||
Item : out Num;
|
||||
Last : out Positive)
|
||||
is
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
S : constant String := Wide_Wide_String_To_String (From, WCEM_Upper);
|
||||
-- String on which we do the actual conversion. Note that the method
|
||||
-- used for wide character encoding is irrelevant, since if there is
|
||||
|
|
@ -73,7 +111,22 @@ package body Ada.Wide_Wide_Text_IO.Float_IO is
|
|||
-- Aux.Gets will raise Data_Error in any case.
|
||||
|
||||
begin
|
||||
Aux.Gets (S, Long_Long_Float (Item), Last);
|
||||
if OK_Float then
|
||||
Aux_Float.Gets (S, Float (Item), Last);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Gets (S, Long_Float (Item), Last);
|
||||
else
|
||||
Aux_Long_Long_Float.Gets (S, Long_Long_Float (Item), Last);
|
||||
end if;
|
||||
|
||||
-- In the case where the type is unconstrained (e.g. Standard'Float),
|
||||
-- the above conversion may result in an infinite value, which is
|
||||
-- normally fine for a conversion, but in this case, we want to treat
|
||||
-- that as a data error.
|
||||
|
||||
if not Item'Valid then
|
||||
raise Data_Error;
|
||||
end if;
|
||||
|
||||
exception
|
||||
when Constraint_Error => raise Data_Error;
|
||||
|
|
@ -91,7 +144,14 @@ package body Ada.Wide_Wide_Text_IO.Float_IO is
|
|||
Exp : Field := Default_Exp)
|
||||
is
|
||||
begin
|
||||
Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Put (File, Float (Item), Fore, Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Put (File, Long_Float (Item), Fore, Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Put
|
||||
(File, Long_Long_Float (Item), Fore, Aft, Exp);
|
||||
end if;
|
||||
end Put;
|
||||
|
||||
procedure Put
|
||||
|
|
@ -113,7 +173,13 @@ package body Ada.Wide_Wide_Text_IO.Float_IO is
|
|||
S : String (To'First .. To'Last);
|
||||
|
||||
begin
|
||||
Aux.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
if OK_Float then
|
||||
Aux_Float.Puts (S, Float (Item), Aft, Exp);
|
||||
elsif OK_Long_Float then
|
||||
Aux_Long_Float.Puts (S, Long_Float (Item), Aft, Exp);
|
||||
else
|
||||
Aux_Long_Long_Float.Puts (S, Long_Long_Float (Item), Aft, Exp);
|
||||
end if;
|
||||
|
||||
for J in S'Range loop
|
||||
To (J) := Wide_Wide_Character'Val (Character'Pos (S (J)));
|
||||
|
|
|
|||
|
|
@ -402,6 +402,106 @@ package body Ada.Wide_Wide_Text_IO.Generic_Aux is
|
|||
end if;
|
||||
end Load_Integer;
|
||||
|
||||
---------------
|
||||
-- Load_Real --
|
||||
---------------
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural)
|
||||
is
|
||||
Loaded : Boolean;
|
||||
|
||||
begin
|
||||
-- Skip initial blanks and load possible sign
|
||||
|
||||
Load_Skip (File);
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
|
||||
-- Case of .nnnn
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise must have digits to start
|
||||
|
||||
else
|
||||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
-- Hopeless junk if no digits loaded
|
||||
|
||||
if not Loaded then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Case of nnn#.xxx#
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
|
||||
-- Case of nnn#xxx.[xxx]# or nnn#xxx#
|
||||
|
||||
else
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Extended_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
|
||||
-- As usual, it seems strange to allow mixed base characters,
|
||||
-- but that is what ACVC tests expect, see CE3804M, case (3).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':');
|
||||
end if;
|
||||
|
||||
-- Case of nnn.[nnn] or nnn
|
||||
|
||||
else
|
||||
-- Prevent the potential processing of '.' in cases where the
|
||||
-- initial digits have a trailing underscore.
|
||||
|
||||
if Buf (Ptr) = '_' then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Load (File, Buf, Ptr, '.', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with exponent
|
||||
|
||||
Load (File, Buf, Ptr, 'E', 'e', Loaded);
|
||||
|
||||
if Loaded then
|
||||
Load (File, Buf, Ptr, '+', '-');
|
||||
Load_Digits (File, Buf, Ptr);
|
||||
end if;
|
||||
end Load_Real;
|
||||
|
||||
---------------
|
||||
-- Load_Skip --
|
||||
---------------
|
||||
|
|
|
|||
|
|
@ -155,6 +155,12 @@ package Ada.Wide_Wide_Text_IO.Generic_Aux is
|
|||
Ptr : in out Natural);
|
||||
-- Loads a possibly signed integer literal value
|
||||
|
||||
procedure Load_Real
|
||||
(File : File_Type;
|
||||
Buf : out String;
|
||||
Ptr : in out Natural);
|
||||
-- Loads a possibly signed real literal value
|
||||
|
||||
procedure Put_Item (File : File_Type; Str : String);
|
||||
-- This routine is like Wide_Wide_Text_IO.Put, except that it checks for
|
||||
-- overflow of bounded lines, as described in (RM A.10.6(8)). It is used
|
||||
|
|
|
|||
|
|
@ -654,6 +654,8 @@ package body System.Fat_Gen is
|
|||
if Adjustment > IEEE_Emax - Exp then
|
||||
XX := 0.0;
|
||||
return (if Minus then -1.0 / XX else 1.0 / XX);
|
||||
pragma Annotate
|
||||
(CodePeer, Intentional, "overflow check", "Infinity produced");
|
||||
pragma Annotate
|
||||
(CodePeer, Intentional, "divide by zero", "Infinity produced");
|
||||
|
||||
|
|
|
|||
|
|
@ -2,11 +2,11 @@
|
|||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . F A T _ S F L T --
|
||||
-- S Y S T E M . V A L _ F L T --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2020, 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- --
|
||||
|
|
@ -29,19 +29,24 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains an instantiation of the floating-point attribute
|
||||
-- runtime routines for the type Short_Float.
|
||||
-- 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 System.Fat_Gen;
|
||||
with Interfaces;
|
||||
with System.Val_Real;
|
||||
|
||||
package System.Fat_SFlt is
|
||||
pragma Pure;
|
||||
package System.Val_Flt is
|
||||
pragma Preelaborate;
|
||||
|
||||
-- Note the only entity from this package that is accessed by Rtsfind
|
||||
-- is the name of the package instantiation. Entities within this package
|
||||
-- (i.e. the individual floating-point attribute routines) are accessed
|
||||
-- by name using selected notation.
|
||||
package Impl is new Val_Real (Float, Interfaces.Unsigned_32);
|
||||
|
||||
package Attr_Short_Float is new System.Fat_Gen (Short_Float);
|
||||
function Scan_Float
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Float
|
||||
renames Impl.Scan_Real;
|
||||
|
||||
end System.Fat_SFlt;
|
||||
function Value_Float (Str : String) return Float
|
||||
renames Impl.Value_Real;
|
||||
|
||||
end System.Val_Flt;
|
||||
52
gcc/ada/libgnat/s-vallfl.ads
Normal file
52
gcc/ada/libgnat/s-vallfl.ads
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . V A L _ L F L T --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2020, 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 scanning real values for floating point
|
||||
-- type Long_Float, for use in Text_IO.Float_IO and the Value attribute.
|
||||
|
||||
with Interfaces;
|
||||
with System.Val_Real;
|
||||
|
||||
package System.Val_LFlt is
|
||||
pragma Preelaborate;
|
||||
|
||||
package Impl is new Val_Real (Long_Float, Interfaces.Unsigned_64);
|
||||
|
||||
function Scan_Long_Float
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Long_Float
|
||||
renames Impl.Scan_Real;
|
||||
|
||||
function Value_Long_Float (Str : String) return Long_Float
|
||||
renames Impl.Value_Real;
|
||||
|
||||
end System.Val_LFlt;
|
||||
52
gcc/ada/libgnat/s-valllf.ads
Normal file
52
gcc/ada/libgnat/s-valllf.ads
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . V A L _ L L F --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2020, 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 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.Val_Real;
|
||||
|
||||
package System.Val_LLF is
|
||||
pragma Preelaborate;
|
||||
|
||||
package Impl is new Val_Real (Long_Long_Float, Interfaces.Unsigned_64);
|
||||
|
||||
function Scan_Long_Long_Float
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Long_Long_Float
|
||||
renames Impl.Scan_Real;
|
||||
|
||||
function Value_Long_Long_Float (Str : String) return Long_Long_Float
|
||||
renames Impl.Value_Real;
|
||||
|
||||
end System.Val_LLF;
|
||||
|
|
@ -36,14 +36,14 @@ with System.Value_R;
|
|||
|
||||
package body System.Val_Real is
|
||||
|
||||
package Impl is new Value_R (Long_Long_Unsigned, Floating => True);
|
||||
package Impl is new Value_R (Uns, Floating => True);
|
||||
|
||||
function Integer_to_Real
|
||||
(Str : String;
|
||||
Val : Long_Long_Unsigned;
|
||||
Val : Uns;
|
||||
Base : Unsigned;
|
||||
Scale : Integer;
|
||||
Minus : Boolean) return Long_Long_Float;
|
||||
Minus : Boolean) return Num;
|
||||
-- Convert the real value from integer to real representation
|
||||
|
||||
---------------------
|
||||
|
|
@ -52,26 +52,34 @@ package body System.Val_Real is
|
|||
|
||||
function Integer_to_Real
|
||||
(Str : String;
|
||||
Val : Long_Long_Unsigned;
|
||||
Val : Uns;
|
||||
Base : Unsigned;
|
||||
Scale : Integer;
|
||||
Minus : Boolean) return Long_Long_Float
|
||||
Minus : Boolean) return Num
|
||||
is
|
||||
pragma Assert (Base in 2 .. 16);
|
||||
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
R_Val : Long_Long_Float;
|
||||
R_Val : Num;
|
||||
|
||||
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
|
||||
-- that the x87 FPU is properly set for conversions. This is especially
|
||||
-- needed on Windows, where calls to the operating system randomly reset
|
||||
-- the processor into 64-bit mode.
|
||||
|
||||
System.Float_Control.Reset;
|
||||
if Num'Machine_Mantissa = 64 then
|
||||
System.Float_Control.Reset;
|
||||
end if;
|
||||
|
||||
-- Compute the final value
|
||||
-- Compute the final value with a single rounding if possible
|
||||
|
||||
R_Val := Long_Long_Float (Val) * Long_Long_Float (Base) ** Scale;
|
||||
if Scale < 0 then
|
||||
R_Val := Num (Val) / Num (Base) ** (-Scale);
|
||||
else
|
||||
R_Val := Num (Val) * Num (Base) ** Scale;
|
||||
end if;
|
||||
|
||||
-- Finally deal with initial minus sign, note that this processing is
|
||||
-- done even if Uval is zero, so that -0.0 is correctly interpreted.
|
||||
|
|
@ -87,16 +95,16 @@ package body System.Val_Real is
|
|||
---------------
|
||||
|
||||
function Scan_Real
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer)
|
||||
return Long_Long_Float
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Num
|
||||
is
|
||||
Base : Unsigned;
|
||||
Scale : Integer;
|
||||
Extra : Unsigned;
|
||||
pragma Unreferenced (Extra);
|
||||
Minus : Boolean;
|
||||
Val : Long_Long_Unsigned;
|
||||
Val : Uns;
|
||||
|
||||
begin
|
||||
Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scale, Extra, Minus);
|
||||
|
|
@ -108,12 +116,13 @@ package body System.Val_Real is
|
|||
-- Value_Real --
|
||||
----------------
|
||||
|
||||
function Value_Real (Str : String) return Long_Long_Float is
|
||||
function Value_Real (Str : String) return Num is
|
||||
Base : Unsigned;
|
||||
Scale : Integer;
|
||||
Extra : Unsigned;
|
||||
pragma Unreferenced (Extra);
|
||||
Minus : Boolean;
|
||||
Val : Long_Long_Unsigned;
|
||||
Val : Uns;
|
||||
|
||||
begin
|
||||
Val := Impl.Value_Raw_Real (Str, Base, Scale, Extra, Minus);
|
||||
|
|
|
|||
|
|
@ -29,13 +29,22 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains routines for scanning real values for use in
|
||||
-- Text_IO.Float_IO and the Value attribute.
|
||||
|
||||
generic
|
||||
|
||||
type Num is digits <>;
|
||||
|
||||
type Uns is mod <>;
|
||||
|
||||
package System.Val_Real is
|
||||
pragma Preelaborate;
|
||||
|
||||
function Scan_Real
|
||||
(Str : String;
|
||||
Ptr : not null access Integer;
|
||||
Max : Integer) return Long_Long_Float;
|
||||
Max : Integer) return Num;
|
||||
-- This function scans the string starting at Str (Ptr.all) for a valid
|
||||
-- real literal according to the syntax described in (RM 3.5(43)). The
|
||||
-- substring scanned extends no further than Str (Max). There are three
|
||||
|
|
@ -65,10 +74,10 @@ package System.Val_Real is
|
|||
-- If this occurs Program_Error is raised with a message noting that this
|
||||
-- case is not supported. Most such cases are eliminated by the caller.
|
||||
|
||||
function Value_Real (Str : String) return Long_Long_Float;
|
||||
function Value_Real (Str : String) return Num;
|
||||
-- Used in computing X'Value (Str) where X is a floating-point type or an
|
||||
-- ordinary fixed-point type. Str is the string argument of the attribute.
|
||||
-- Constraint_Error is raised if the string is malformed, or if the value
|
||||
-- out of range of Long_Long_Float.
|
||||
-- out of range of Num.
|
||||
|
||||
end System.Val_Real;
|
||||
|
|
|
|||
|
|
@ -33,11 +33,7 @@ with System.Val_Util; use System.Val_Util;
|
|||
|
||||
package body System.Value_R is
|
||||
|
||||
F_Limit : constant Uns := 2 ** (Long_Long_Float'Machine_Mantissa - 1);
|
||||
I_Limit : constant Uns := 2 ** (Uns'Size - 1);
|
||||
-- Absolute value of largest representable signed integer
|
||||
|
||||
Precision_Limit : constant Uns := (if Floating then F_Limit else I_Limit);
|
||||
Precision_Limit : constant Uns := 2 ** (Uns'Size - 1);
|
||||
-- Limit beyond which additional digits are dropped
|
||||
|
||||
subtype Char_As_Digit is Unsigned range 0 .. 17;
|
||||
|
|
@ -133,6 +129,8 @@ package body System.Value_R is
|
|||
|
||||
is
|
||||
pragma Assert (Base in 2 .. 16);
|
||||
pragma Assert (Index in Str'Range);
|
||||
pragma Assert (Max <= Str'Last);
|
||||
|
||||
Umax : constant Uns := (Precision_Limit - Uns (Base) + 1) / Uns (Base);
|
||||
-- Max value which cannot overflow on accumulating next digit
|
||||
|
|
@ -144,8 +142,9 @@ package body System.Value_R is
|
|||
-- Set to True if addition of a digit will cause Value to be superior
|
||||
-- to Precision_Limit.
|
||||
|
||||
Precision_Limit_Just_Reached : Boolean := False;
|
||||
Precision_Limit_Just_Reached : Boolean;
|
||||
-- Set to True if Precision_Limit_Reached was just set to True
|
||||
-- Only used when Floating = False.
|
||||
|
||||
Digit : Char_As_Digit;
|
||||
-- The current digit
|
||||
|
|
@ -166,6 +165,10 @@ package body System.Value_R is
|
|||
Extra := 0;
|
||||
end if;
|
||||
|
||||
if not Floating then
|
||||
Precision_Limit_Just_Reached := False;
|
||||
end if;
|
||||
|
||||
-- The function precondition is that the first character is a valid
|
||||
-- digit.
|
||||
|
||||
|
|
@ -194,7 +197,7 @@ package body System.Value_R is
|
|||
-- continue only to assess the validity of the string.
|
||||
|
||||
if Precision_Limit_Reached then
|
||||
if Precision_Limit_Just_Reached and then not Floating then
|
||||
if not Floating and then Precision_Limit_Just_Reached then
|
||||
if Digit >= Base / 2 then
|
||||
if Extra = Base - 1 then
|
||||
Extra := 0;
|
||||
|
|
@ -244,7 +247,10 @@ package body System.Value_R is
|
|||
else
|
||||
Extra := Digit;
|
||||
Precision_Limit_Reached := True;
|
||||
Precision_Limit_Just_Reached := True;
|
||||
|
||||
if not Floating then
|
||||
Precision_Limit_Just_Reached := True;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -308,8 +314,9 @@ package body System.Value_R is
|
|||
-- Set to True if addition of a digit will cause Value to be superior
|
||||
-- to Precision_Limit.
|
||||
|
||||
Precision_Limit_Just_Reached : Boolean := False;
|
||||
-- Set to True if Precision_Limit_Reached was just set to True
|
||||
Precision_Limit_Just_Reached : Boolean;
|
||||
-- Set to True if Precision_Limit_Reached was just set to True.
|
||||
-- Only used when Floating = False.
|
||||
|
||||
Digit : Char_As_Digit;
|
||||
-- The current digit
|
||||
|
|
@ -324,6 +331,12 @@ package body System.Value_R is
|
|||
Scale := 0;
|
||||
Extra := 0;
|
||||
|
||||
if not Floating then
|
||||
Precision_Limit_Just_Reached := False;
|
||||
end if;
|
||||
|
||||
pragma Assert (Max <= Str'Last);
|
||||
|
||||
-- The function precondition is that the first character is a valid
|
||||
-- digit.
|
||||
|
||||
|
|
@ -354,7 +367,7 @@ package body System.Value_R is
|
|||
if Precision_Limit_Reached then
|
||||
Scale := Scale + 1;
|
||||
|
||||
if Precision_Limit_Just_Reached and then not Floating then
|
||||
if not Floating and then Precision_Limit_Just_Reached then
|
||||
if Digit >= Base / 2 then
|
||||
if Extra = Base - 1 then
|
||||
Extra := 0;
|
||||
|
|
@ -378,7 +391,11 @@ package body System.Value_R is
|
|||
else
|
||||
Extra := Digit;
|
||||
Precision_Limit_Reached := True;
|
||||
Precision_Limit_Just_Reached := True;
|
||||
|
||||
if not Floating then
|
||||
Precision_Limit_Just_Reached := True;
|
||||
end if;
|
||||
|
||||
Scale := Scale + 1;
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -409,7 +426,6 @@ package body System.Value_R is
|
|||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
end Scan_Integral_Digits;
|
||||
|
||||
-------------------
|
||||
|
|
@ -425,6 +441,8 @@ package body System.Value_R is
|
|||
Extra : out Unsigned;
|
||||
Minus : out Boolean) return Uns
|
||||
is
|
||||
pragma Assert (Max <= Str'Last);
|
||||
|
||||
After_Point : Boolean;
|
||||
-- True if a decimal should be parsed
|
||||
|
||||
|
|
@ -440,7 +458,7 @@ package body System.Value_R is
|
|||
-- Local copy of string pointer
|
||||
|
||||
Start : Positive;
|
||||
-- Position of starting non-blank character
|
||||
pragma Unreferenced (Start);
|
||||
|
||||
Value : Uns;
|
||||
-- Mantissa as an Integer
|
||||
|
|
@ -461,14 +479,15 @@ package body System.Value_R is
|
|||
|
||||
Scan_Sign (Str, Ptr, Max, Minus, Start);
|
||||
Index := Ptr.all;
|
||||
Ptr.all := Start;
|
||||
|
||||
-- First character can be either a decimal digit or a dot
|
||||
pragma Assert (Index >= Str'First);
|
||||
|
||||
pragma Annotate (CodePeer, Modified, Str (Index));
|
||||
|
||||
-- First character can be either a decimal digit or a dot and for some
|
||||
-- reason CodePeer incorrectly thinks it is always a digit.
|
||||
|
||||
if Str (Index) in '0' .. '9' then
|
||||
pragma Annotate
|
||||
(CodePeer, False_Positive, "test always true", "defensive code");
|
||||
|
||||
After_Point := False;
|
||||
|
||||
-- If this is a digit it can indicates either the float decimal
|
||||
|
|
@ -496,13 +515,16 @@ package body System.Value_R is
|
|||
|
||||
-- Check if the first number encountered is a base
|
||||
|
||||
pragma Assert (Index >= Str'First);
|
||||
|
||||
if Index < Max
|
||||
and then (Str (Index) = '#' or else Str (Index) = ':')
|
||||
then
|
||||
Base_Char := Str (Index);
|
||||
Base := Unsigned (Value);
|
||||
|
||||
if Base < 2 or else Base > 16 then
|
||||
if Value in 2 .. 16 then
|
||||
Base := Unsigned (Value);
|
||||
else
|
||||
Base_Violation := True;
|
||||
Base := 16;
|
||||
end if;
|
||||
|
|
@ -533,6 +555,8 @@ package body System.Value_R is
|
|||
|
||||
-- Do we have a dot?
|
||||
|
||||
pragma Assert (Index >= Str'First);
|
||||
|
||||
if not After_Point and then Index <= Max and then Str (Index) = '.' then
|
||||
|
||||
-- At this stage if After_Point was not set, this means that an
|
||||
|
|
@ -549,6 +573,8 @@ package body System.Value_R is
|
|||
-- Scan the decimal part
|
||||
|
||||
if After_Point then
|
||||
pragma Assert (Index <= Max);
|
||||
|
||||
Scan_Decimal_Digits
|
||||
(Str, Index, Max, Value, Scale, Char_As_Digit (Extra),
|
||||
Base_Violation, Base, Base_Specified => Base_Char /= ASCII.NUL);
|
||||
|
|
@ -557,6 +583,8 @@ package body System.Value_R is
|
|||
-- If an explicit base was specified ensure that the delimiter is found
|
||||
|
||||
if Base_Char /= ASCII.NUL then
|
||||
pragma Assert (Index > Max or else Index in Str'Range);
|
||||
|
||||
if Index > Max or else Str (Index) /= Base_Char then
|
||||
Bad_Value (Str);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -239,8 +239,6 @@ package Rtsfind is
|
|||
System_Exp_Mod,
|
||||
System_Exp_Uns,
|
||||
System_Fat_Flt,
|
||||
System_Fat_IEEE_Long_Float,
|
||||
System_Fat_IEEE_Short_Float,
|
||||
System_Fat_LFlt,
|
||||
System_Fat_LLF,
|
||||
System_Fat_SFlt,
|
||||
|
|
@ -434,13 +432,15 @@ package Rtsfind is
|
|||
System_Val_Fixed_32,
|
||||
System_Val_Fixed_64,
|
||||
System_Val_Fixed_128,
|
||||
System_Val_Flt,
|
||||
System_Val_Int,
|
||||
System_Val_LFlt,
|
||||
System_Val_LLF,
|
||||
System_Val_LLI,
|
||||
System_Val_LLLI,
|
||||
System_Val_LLU,
|
||||
System_Val_LLLU,
|
||||
System_Val_Name,
|
||||
System_Val_Real,
|
||||
System_Val_Uns,
|
||||
System_Val_WChar,
|
||||
System_Version_Control,
|
||||
|
|
@ -925,18 +925,10 @@ package Rtsfind is
|
|||
|
||||
RE_Attr_Float, -- System.Fat_Flt
|
||||
|
||||
RE_Attr_IEEE_Long, -- System.Fat_IEEE_Long_Float
|
||||
RE_Fat_IEEE_Long, -- System.Fat_IEEE_Long_Float
|
||||
|
||||
RE_Attr_IEEE_Short, -- System.Fat_IEEE_Short_Float
|
||||
RE_Fat_IEEE_Short, -- System.Fat_IEEE_Short_Float
|
||||
|
||||
RE_Attr_Long_Float, -- System.Fat_LFlt
|
||||
|
||||
RE_Attr_Long_Long_Float, -- System.Fat_LLF
|
||||
|
||||
RE_Attr_Short_Float, -- System.Fat_SFlt
|
||||
|
||||
RE_Attr_VAX_D_Float, -- System.Fat_VAX_D_Float
|
||||
RE_Fat_VAX_D, -- System.Fat_VAX_D_Float
|
||||
|
||||
|
|
@ -2045,8 +2037,14 @@ package Rtsfind is
|
|||
|
||||
RE_Value_Fixed128, -- System_Val_Fixed_128
|
||||
|
||||
RE_Value_Float, -- System_Val_Flt
|
||||
|
||||
RE_Value_Integer, -- System.Val_Int
|
||||
|
||||
RE_Value_Long_Float, -- System_Val_LFlt
|
||||
|
||||
RE_Value_Long_Long_Float, -- System_Val_LLF
|
||||
|
||||
RE_Value_Long_Long_Integer, -- System.Val_LLI
|
||||
|
||||
RE_Value_Long_Long_Long_Integer, -- System.Val_LLLI
|
||||
|
|
@ -2055,8 +2053,6 @@ package Rtsfind is
|
|||
|
||||
RE_Value_Long_Long_Long_Unsigned, -- System.Val_LLLU
|
||||
|
||||
RE_Value_Real, -- System.Val_Real
|
||||
|
||||
RE_Value_Unsigned, -- System.Val_Uns
|
||||
|
||||
RE_Value_Wide_Character, -- System.Val_WChar
|
||||
|
|
@ -2610,18 +2606,10 @@ package Rtsfind is
|
|||
|
||||
RE_Attr_Float => System_Fat_Flt,
|
||||
|
||||
RE_Attr_IEEE_Long => System_Fat_IEEE_Long_Float,
|
||||
RE_Fat_IEEE_Long => System_Fat_IEEE_Long_Float,
|
||||
|
||||
RE_Attr_IEEE_Short => System_Fat_IEEE_Short_Float,
|
||||
RE_Fat_IEEE_Short => System_Fat_IEEE_Short_Float,
|
||||
|
||||
RE_Attr_Long_Float => System_Fat_LFlt,
|
||||
|
||||
RE_Attr_Long_Long_Float => System_Fat_LLF,
|
||||
|
||||
RE_Attr_Short_Float => System_Fat_SFlt,
|
||||
|
||||
RE_Attr_VAX_D_Float => System_Fat_VAX_D_Float,
|
||||
RE_Fat_VAX_D => System_Fat_VAX_D_Float,
|
||||
|
||||
|
|
@ -3730,8 +3718,14 @@ package Rtsfind is
|
|||
|
||||
RE_Value_Fixed128 => System_Val_Fixed_128,
|
||||
|
||||
RE_Value_Float => System_Val_Flt,
|
||||
|
||||
RE_Value_Integer => System_Val_Int,
|
||||
|
||||
RE_Value_Long_Float => System_Val_LFlt,
|
||||
|
||||
RE_Value_Long_Long_Float => System_Val_LLF,
|
||||
|
||||
RE_Value_Long_Long_Integer => System_Val_LLI,
|
||||
|
||||
RE_Value_Long_Long_Long_Integer => System_Val_LLLI,
|
||||
|
|
@ -3740,8 +3734,6 @@ package Rtsfind is
|
|||
|
||||
RE_Value_Long_Long_Long_Unsigned => System_Val_LLLU,
|
||||
|
||||
RE_Value_Real => System_Val_Real,
|
||||
|
||||
RE_Value_Unsigned => System_Val_Uns,
|
||||
|
||||
RE_Value_Wide_Character => System_Val_WChar,
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue