1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ T E X T _ I O . D E C I M A L _ I O --
9 -- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Wide_Text_IO
.Decimal_Aux
;
33 with System
.Img_Decimal_32
; use System
.Img_Decimal_32
;
34 with System
.Img_Decimal_64
; use System
.Img_Decimal_64
;
35 with System
.Val_Decimal_32
; use System
.Val_Decimal_32
;
36 with System
.Val_Decimal_64
; use System
.Val_Decimal_64
;
37 with System
.WCh_Con
; use System
.WCh_Con
;
38 with System
.WCh_WtS
; use System
.WCh_WtS
;
40 package body Ada
.Wide_Text_IO
.Decimal_IO
is
42 subtype Int32
is Interfaces
.Integer_32
;
43 subtype Int64
is Interfaces
.Integer_64
;
46 Ada
.Wide_Text_IO
.Decimal_Aux
52 Ada
.Wide_Text_IO
.Decimal_Aux
57 Need64
: constant Boolean := Num
'Size > 32;
58 -- Throughout this generic body, we distinguish between the case where type
59 -- Int32 is acceptable and where type Int64 is needed. This Boolean is used
60 -- to test for these cases and since it is a constant, only code for the
61 -- relevant case will be included in the instance.
63 Scale
: constant Integer := Num
'Scale;
74 pragma Unsuppress
(Range_Check
);
78 Item
:= Num
'Fixed_Value (Aux64
.Get
(File
, Width
, Scale
));
80 Item
:= Num
'Fixed_Value (Aux32
.Get
(File
, Width
, Scale
));
84 when Constraint_Error
=> raise Data_Error
;
92 Get
(Current_In
, Item
, Width
);
100 pragma Unsuppress
(Range_Check
);
102 S
: constant String := Wide_String_To_String
(From
, WCEM_Upper
);
103 -- String on which we do the actual conversion. Note that the method
104 -- used for wide character encoding is irrelevant, since if there is
105 -- a character outside the Standard.Character range then the call to
106 -- Aux.Gets will raise Data_Error in any case.
110 Item
:= Num
'Fixed_Value (Aux64
.Gets
(S
, Last
, Scale
));
112 Item
:= Num
'Fixed_Value (Aux32
.Gets
(S
, Last
, Scale
));
116 when Constraint_Error
=> raise Data_Error
;
126 Fore
: Field
:= Default_Fore
;
127 Aft
: Field
:= Default_Aft
;
128 Exp
: Field
:= Default_Exp
)
133 (File
, Int64
'Integer_Value (Item
), Fore
, Aft
, Exp
, Scale
);
136 (File
, Int32
'Integer_Value (Item
), Fore
, Aft
, Exp
, Scale
);
142 Fore
: Field
:= Default_Fore
;
143 Aft
: Field
:= Default_Aft
;
144 Exp
: Field
:= Default_Exp
)
147 Put
(Current_Out
, Item
, Fore
, Aft
, Exp
);
151 (To
: out Wide_String;
153 Aft
: Field
:= Default_Aft
;
154 Exp
: Field
:= Default_Exp
)
156 S
: String (To
'First .. To
'Last);
160 Aux64
.Puts
(S
, Int64
'Integer_Value (Item
), Aft
, Exp
, Scale
);
162 Aux32
.Puts
(S
, Int32
'Integer_Value (Item
), Aft
, Exp
, Scale
);
165 for J
in S
'Range loop
166 To
(J
) := Wide_Character'Val (Character'Pos (S
(J
)));
170 end Ada
.Wide_Text_IO
.Decimal_IO
;