File : a-tiinau.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . T E X T _ I O . I N T E G E R _ A U X --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
33
34 with System.Img_BIU; use System.Img_BIU;
35 with System.Img_Int; use System.Img_Int;
36 with System.Img_LLB; use System.Img_LLB;
37 with System.Img_LLI; use System.Img_LLI;
38 with System.Img_LLW; use System.Img_LLW;
39 with System.Img_WIU; use System.Img_WIU;
40 with System.Val_Int; use System.Val_Int;
41 with System.Val_LLI; use System.Val_LLI;
42
43 package body Ada.Text_IO.Integer_Aux is
44
45 -----------------------
46 -- Local Subprograms --
47 -----------------------
48
49 procedure Load_Integer
50 (File : File_Type;
51 Buf : out String;
52 Ptr : in out Natural);
53 -- This is an auxiliary routine that is used to load a possibly signed
54 -- integer literal value from the input file into Buf, starting at Ptr + 1.
55 -- On return, Ptr is set to the last character stored.
56
57 -------------
58 -- Get_Int --
59 -------------
60
61 procedure Get_Int
62 (File : File_Type;
63 Item : out Integer;
64 Width : Field)
65 is
66 Buf : String (1 .. Field'Last);
67 Ptr : aliased Integer := 1;
68 Stop : Integer := 0;
69
70 begin
71 if Width /= 0 then
72 Load_Width (File, Width, Buf, Stop);
73 String_Skip (Buf, Ptr);
74 else
75 Load_Integer (File, Buf, Stop);
76 end if;
77
78 Item := Scan_Integer (Buf, Ptr'Access, Stop);
79 Check_End_Of_Field (Buf, Stop, Ptr, Width);
80 end Get_Int;
81
82 -------------
83 -- Get_LLI --
84 -------------
85
86 procedure Get_LLI
87 (File : File_Type;
88 Item : out Long_Long_Integer;
89 Width : Field)
90 is
91 Buf : String (1 .. Field'Last);
92 Ptr : aliased Integer := 1;
93 Stop : Integer := 0;
94
95 begin
96 if Width /= 0 then
97 Load_Width (File, Width, Buf, Stop);
98 String_Skip (Buf, Ptr);
99 else
100 Load_Integer (File, Buf, Stop);
101 end if;
102
103 Item := Scan_Long_Long_Integer (Buf, Ptr'Access, Stop);
104 Check_End_Of_Field (Buf, Stop, Ptr, Width);
105 end Get_LLI;
106
107 --------------
108 -- Gets_Int --
109 --------------
110
111 procedure Gets_Int
112 (From : String;
113 Item : out Integer;
114 Last : out Positive)
115 is
116 Pos : aliased Integer;
117
118 begin
119 String_Skip (From, Pos);
120 Item := Scan_Integer (From, Pos'Access, From'Last);
121 Last := Pos - 1;
122
123 exception
124 when Constraint_Error =>
125 raise Data_Error;
126 end Gets_Int;
127
128 --------------
129 -- Gets_LLI --
130 --------------
131
132 procedure Gets_LLI
133 (From : String;
134 Item : out Long_Long_Integer;
135 Last : out Positive)
136 is
137 Pos : aliased Integer;
138
139 begin
140 String_Skip (From, Pos);
141 Item := Scan_Long_Long_Integer (From, Pos'Access, From'Last);
142 Last := Pos - 1;
143
144 exception
145 when Constraint_Error =>
146 raise Data_Error;
147 end Gets_LLI;
148
149 ------------------
150 -- Load_Integer --
151 ------------------
152
153 procedure Load_Integer
154 (File : File_Type;
155 Buf : out String;
156 Ptr : in out Natural)
157 is
158 Hash_Loc : Natural;
159 Loaded : Boolean;
160
161 begin
162 Load_Skip (File);
163 Load (File, Buf, Ptr, '+', '-');
164
165 Load_Digits (File, Buf, Ptr, Loaded);
166
167 if Loaded then
168
169 -- Deal with based literal. We recognize either the standard '#' or
170 -- the allowed alternative replacement ':' (see RM J.2(3)).
171
172 Load (File, Buf, Ptr, '#', ':', Loaded);
173
174 if Loaded then
175 Hash_Loc := Ptr;
176 Load_Extended_Digits (File, Buf, Ptr);
177 Load (File, Buf, Ptr, Buf (Hash_Loc));
178 end if;
179
180 -- Deal with exponent
181
182 Load (File, Buf, Ptr, 'E', 'e', Loaded);
183
184 if Loaded then
185
186 -- Note: it is strange to allow a minus sign, since the syntax
187 -- does not, but that is what ACVC test CE3704F, case (6) wants.
188
189 Load (File, Buf, Ptr, '+', '-');
190 Load_Digits (File, Buf, Ptr);
191 end if;
192 end if;
193 end Load_Integer;
194
195 -------------
196 -- Put_Int --
197 -------------
198
199 procedure Put_Int
200 (File : File_Type;
201 Item : Integer;
202 Width : Field;
203 Base : Number_Base)
204 is
205 Buf : String (1 .. Integer'Max (Field'Last, Width));
206 Ptr : Natural := 0;
207
208 begin
209 if Base = 10 and then Width = 0 then
210 Set_Image_Integer (Item, Buf, Ptr);
211 elsif Base = 10 then
212 Set_Image_Width_Integer (Item, Width, Buf, Ptr);
213 else
214 Set_Image_Based_Integer (Item, Base, Width, Buf, Ptr);
215 end if;
216
217 Put_Item (File, Buf (1 .. Ptr));
218 end Put_Int;
219
220 -------------
221 -- Put_LLI --
222 -------------
223
224 procedure Put_LLI
225 (File : File_Type;
226 Item : Long_Long_Integer;
227 Width : Field;
228 Base : Number_Base)
229 is
230 Buf : String (1 .. Integer'Max (Field'Last, Width));
231 Ptr : Natural := 0;
232
233 begin
234 if Base = 10 and then Width = 0 then
235 Set_Image_Long_Long_Integer (Item, Buf, Ptr);
236 elsif Base = 10 then
237 Set_Image_Width_Long_Long_Integer (Item, Width, Buf, Ptr);
238 else
239 Set_Image_Based_Long_Long_Integer (Item, Base, Width, Buf, Ptr);
240 end if;
241
242 Put_Item (File, Buf (1 .. Ptr));
243 end Put_LLI;
244
245 --------------
246 -- Puts_Int --
247 --------------
248
249 procedure Puts_Int
250 (To : out String;
251 Item : Integer;
252 Base : Number_Base)
253 is
254 Buf : String (1 .. Integer'Max (Field'Last, To'Length));
255 Ptr : Natural := 0;
256
257 begin
258 if Base = 10 then
259 Set_Image_Width_Integer (Item, To'Length, Buf, Ptr);
260 else
261 Set_Image_Based_Integer (Item, Base, To'Length, Buf, Ptr);
262 end if;
263
264 if Ptr > To'Length then
265 raise Layout_Error;
266 else
267 To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
268 end if;
269 end Puts_Int;
270
271 --------------
272 -- Puts_LLI --
273 --------------
274
275 procedure Puts_LLI
276 (To : out String;
277 Item : Long_Long_Integer;
278 Base : Number_Base)
279 is
280 Buf : String (1 .. Integer'Max (Field'Last, To'Length));
281 Ptr : Natural := 0;
282
283 begin
284 if Base = 10 then
285 Set_Image_Width_Long_Long_Integer (Item, To'Length, Buf, Ptr);
286 else
287 Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr);
288 end if;
289
290 if Ptr > To'Length then
291 raise Layout_Error;
292 else
293 To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr);
294 end if;
295 end Puts_LLI;
296
297 end Ada.Text_IO.Integer_Aux;