]>
Commit | Line | Data |
---|---|---|
d23b8f57 RK |
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 | -- -- | |
748086b7 | 9 | -- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- |
d23b8f57 RK |
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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
d23b8f57 RK |
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 -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
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. -- | |
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/>. -- | |
d23b8f57 RK |
26 | -- -- |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
d23b8f57 RK |
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 | |
0ae9f22f | 50 | (File : File_Type; |
d23b8f57 RK |
51 | Buf : out String; |
52 | Ptr : in out Natural); | |
84fdd8a3 | 53 | -- This is an auxiliary routine that is used to load a possibly signed |
d23b8f57 RK |
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 | |
0ae9f22f | 62 | (File : File_Type; |
d23b8f57 | 63 | Item : out Integer; |
0ae9f22f | 64 | Width : Field) |
d23b8f57 RK |
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); | |
07fc65c4 | 79 | Check_End_Of_Field (Buf, Stop, Ptr, Width); |
d23b8f57 RK |
80 | end Get_Int; |
81 | ||
82 | ------------- | |
83 | -- Get_LLI -- | |
84 | ------------- | |
85 | ||
86 | procedure Get_LLI | |
0ae9f22f | 87 | (File : File_Type; |
d23b8f57 | 88 | Item : out Long_Long_Integer; |
0ae9f22f | 89 | Width : Field) |
d23b8f57 RK |
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); | |
07fc65c4 | 104 | Check_End_Of_Field (Buf, Stop, Ptr, Width); |
d23b8f57 RK |
105 | end Get_LLI; |
106 | ||
107 | -------------- | |
108 | -- Gets_Int -- | |
109 | -------------- | |
110 | ||
111 | procedure Gets_Int | |
0ae9f22f | 112 | (From : String; |
d23b8f57 RK |
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 => | |
d23b8f57 RK |
125 | raise Data_Error; |
126 | end Gets_Int; | |
127 | ||
128 | -------------- | |
129 | -- Gets_LLI -- | |
130 | -------------- | |
131 | ||
132 | procedure Gets_LLI | |
0ae9f22f | 133 | (From : String; |
d23b8f57 RK |
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 => | |
d23b8f57 RK |
146 | raise Data_Error; |
147 | end Gets_LLI; | |
148 | ||
149 | ------------------ | |
150 | -- Load_Integer -- | |
151 | ------------------ | |
152 | ||
153 | procedure Load_Integer | |
0ae9f22f | 154 | (File : File_Type; |
d23b8f57 RK |
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 | |
a9f4e3d2 AC |
168 | |
169 | -- Deal with based literal (note : is ok replacement for #) | |
170 | ||
d23b8f57 RK |
171 | Load (File, Buf, Ptr, '#', ':', Loaded); |
172 | ||
173 | if Loaded then | |
174 | Hash_Loc := Ptr; | |
175 | Load_Extended_Digits (File, Buf, Ptr); | |
176 | Load (File, Buf, Ptr, Buf (Hash_Loc)); | |
177 | end if; | |
178 | ||
a9f4e3d2 AC |
179 | -- Deal with exponent |
180 | ||
d23b8f57 RK |
181 | Load (File, Buf, Ptr, 'E', 'e', Loaded); |
182 | ||
183 | if Loaded then | |
184 | ||
185 | -- Note: it is strange to allow a minus sign, since the syntax | |
186 | -- does not, but that is what ACVC test CE3704F, case (6) wants. | |
187 | ||
188 | Load (File, Buf, Ptr, '+', '-'); | |
189 | Load_Digits (File, Buf, Ptr); | |
190 | end if; | |
191 | end if; | |
192 | end Load_Integer; | |
193 | ||
194 | ------------- | |
195 | -- Put_Int -- | |
196 | ------------- | |
197 | ||
198 | procedure Put_Int | |
0ae9f22f RD |
199 | (File : File_Type; |
200 | Item : Integer; | |
201 | Width : Field; | |
202 | Base : Number_Base) | |
d23b8f57 RK |
203 | is |
204 | Buf : String (1 .. Integer'Max (Field'Last, Width)); | |
205 | Ptr : Natural := 0; | |
206 | ||
207 | begin | |
208 | if Base = 10 and then Width = 0 then | |
209 | Set_Image_Integer (Item, Buf, Ptr); | |
210 | elsif Base = 10 then | |
211 | Set_Image_Width_Integer (Item, Width, Buf, Ptr); | |
212 | else | |
213 | Set_Image_Based_Integer (Item, Base, Width, Buf, Ptr); | |
214 | end if; | |
215 | ||
216 | Put_Item (File, Buf (1 .. Ptr)); | |
217 | end Put_Int; | |
218 | ||
219 | ------------- | |
220 | -- Put_LLI -- | |
221 | ------------- | |
222 | ||
223 | procedure Put_LLI | |
0ae9f22f RD |
224 | (File : File_Type; |
225 | Item : Long_Long_Integer; | |
226 | Width : Field; | |
227 | Base : Number_Base) | |
d23b8f57 RK |
228 | is |
229 | Buf : String (1 .. Integer'Max (Field'Last, Width)); | |
230 | Ptr : Natural := 0; | |
231 | ||
232 | begin | |
233 | if Base = 10 and then Width = 0 then | |
234 | Set_Image_Long_Long_Integer (Item, Buf, Ptr); | |
235 | elsif Base = 10 then | |
236 | Set_Image_Width_Long_Long_Integer (Item, Width, Buf, Ptr); | |
237 | else | |
238 | Set_Image_Based_Long_Long_Integer (Item, Base, Width, Buf, Ptr); | |
239 | end if; | |
240 | ||
241 | Put_Item (File, Buf (1 .. Ptr)); | |
242 | end Put_LLI; | |
243 | ||
244 | -------------- | |
245 | -- Puts_Int -- | |
246 | -------------- | |
247 | ||
248 | procedure Puts_Int | |
249 | (To : out String; | |
0ae9f22f RD |
250 | Item : Integer; |
251 | Base : Number_Base) | |
d23b8f57 RK |
252 | is |
253 | Buf : String (1 .. Integer'Max (Field'Last, To'Length)); | |
254 | Ptr : Natural := 0; | |
255 | ||
256 | begin | |
257 | if Base = 10 then | |
258 | Set_Image_Width_Integer (Item, To'Length, Buf, Ptr); | |
259 | else | |
260 | Set_Image_Based_Integer (Item, Base, To'Length, Buf, Ptr); | |
261 | end if; | |
262 | ||
263 | if Ptr > To'Length then | |
264 | raise Layout_Error; | |
265 | else | |
266 | To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr); | |
267 | end if; | |
268 | end Puts_Int; | |
269 | ||
270 | -------------- | |
271 | -- Puts_LLI -- | |
272 | -------------- | |
273 | ||
274 | procedure Puts_LLI | |
275 | (To : out String; | |
0ae9f22f RD |
276 | Item : Long_Long_Integer; |
277 | Base : Number_Base) | |
d23b8f57 RK |
278 | is |
279 | Buf : String (1 .. Integer'Max (Field'Last, To'Length)); | |
280 | Ptr : Natural := 0; | |
281 | ||
282 | begin | |
283 | if Base = 10 then | |
284 | Set_Image_Width_Long_Long_Integer (Item, To'Length, Buf, Ptr); | |
285 | else | |
286 | Set_Image_Based_Long_Long_Integer (Item, Base, To'Length, Buf, Ptr); | |
287 | end if; | |
288 | ||
289 | if Ptr > To'Length then | |
290 | raise Layout_Error; | |
291 | else | |
292 | To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr); | |
293 | end if; | |
294 | end Puts_LLI; | |
295 | ||
296 | end Ada.Text_IO.Integer_Aux; |