File : s-valrea.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S Y S T E M . V A L _ R E A L --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2015, 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 System.Powten_Table; use System.Powten_Table;
33 with System.Val_Util; use System.Val_Util;
34 with System.Float_Control;
35
36 package body System.Val_Real is
37
38 ---------------
39 -- Scan_Real --
40 ---------------
41
42 function Scan_Real
43 (Str : String;
44 Ptr : not null access Integer;
45 Max : Integer) return Long_Long_Float
46 is
47 P : Integer;
48 -- Local copy of string pointer
49
50 Base : Long_Long_Float;
51 -- Base value
52
53 Uval : Long_Long_Float;
54 -- Accumulated float result
55
56 subtype Digs is Character range '0' .. '9';
57 -- Used to check for decimal digit
58
59 Scale : Integer := 0;
60 -- Power of Base to multiply result by
61
62 Start : Positive;
63 -- Position of starting non-blank character
64
65 Minus : Boolean;
66 -- Set to True if minus sign is present, otherwise to False
67
68 Bad_Base : Boolean := False;
69 -- Set True if Base out of range or if out of range digit
70
71 After_Point : Natural := 0;
72 -- Set to 1 after the point
73
74 Num_Saved_Zeroes : Natural := 0;
75 -- This counts zeroes after the decimal point. A non-zero value means
76 -- that this number of previously scanned digits are zero. If the end
77 -- of the number is reached, these zeroes are simply discarded, which
78 -- ensures that trailing zeroes after the point never affect the value
79 -- (which might otherwise happen as a result of rounding). With this
80 -- processing in place, we can ensure that, for example, we get the
81 -- same exact result from 1.0E+49 and 1.0000000E+49. This is not
82 -- necessarily required in a case like this where the result is not
83 -- a machine number, but it is certainly a desirable behavior.
84
85 procedure Scanf;
86 -- Scans integer literal value starting at current character position.
87 -- For each digit encountered, Uval is multiplied by 10.0, and the new
88 -- digit value is incremented. In addition Scale is decremented for each
89 -- digit encountered if we are after the point (After_Point = 1). The
90 -- longest possible syntactically valid numeral is scanned out, and on
91 -- return P points past the last character. On entry, the current
92 -- character is known to be a digit, so a numeral is definitely present.
93
94 -----------
95 -- Scanf --
96 -----------
97
98 procedure Scanf is
99 Digit : Natural;
100
101 begin
102 loop
103 Digit := Character'Pos (Str (P)) - Character'Pos ('0');
104 P := P + 1;
105
106 -- Save up trailing zeroes after the decimal point
107
108 if Digit = 0 and then After_Point = 1 then
109 Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
110
111 -- Here for a non-zero digit
112
113 else
114 -- First deal with any previously saved zeroes
115
116 if Num_Saved_Zeroes /= 0 then
117 while Num_Saved_Zeroes > Maxpow loop
118 Uval := Uval * Powten (Maxpow);
119 Num_Saved_Zeroes := Num_Saved_Zeroes - Maxpow;
120 Scale := Scale - Maxpow;
121 end loop;
122
123 Uval := Uval * Powten (Num_Saved_Zeroes);
124 Scale := Scale - Num_Saved_Zeroes;
125
126 Num_Saved_Zeroes := 0;
127 end if;
128
129 -- Accumulate new digit
130
131 Uval := Uval * 10.0 + Long_Long_Float (Digit);
132 Scale := Scale - After_Point;
133 end if;
134
135 -- Done if end of input field
136
137 if P > Max then
138 return;
139
140 -- Check next character
141
142 elsif Str (P) not in Digs then
143 if Str (P) = '_' then
144 Scan_Underscore (Str, P, Ptr, Max, False);
145 else
146 return;
147 end if;
148 end if;
149 end loop;
150 end Scanf;
151
152 -- Start of processing for System.Scan_Real
153
154 begin
155 -- We do not tolerate strings with Str'Last = Positive'Last
156
157 if Str'Last = Positive'Last then
158 raise Program_Error with
159 "string upper bound is Positive'Last, not supported";
160 end if;
161
162 -- We call the floating-point processor reset routine so that we can
163 -- be sure the floating-point processor is properly set for conversion
164 -- calls. This is notably need on Windows, where calls to the operating
165 -- system randomly reset the processor into 64-bit mode.
166
167 System.Float_Control.Reset;
168
169 Scan_Sign (Str, Ptr, Max, Minus, Start);
170 P := Ptr.all;
171 Ptr.all := Start;
172
173 -- If digit, scan numeral before point
174
175 if Str (P) in Digs then
176 Uval := 0.0;
177 Scanf;
178
179 -- Initial point, allowed only if followed by digit (RM 3.5(47))
180
181 elsif Str (P) = '.'
182 and then P < Max
183 and then Str (P + 1) in Digs
184 then
185 Uval := 0.0;
186
187 -- Any other initial character is an error
188
189 else
190 Bad_Value (Str);
191 end if;
192
193 -- Deal with based case. We reognize either the standard '#' or the
194 -- allowed alternative replacement ':' (see RM J.2(3)).
195
196 if P < Max and then (Str (P) = '#' or else Str (P) = ':') then
197 declare
198 Base_Char : constant Character := Str (P);
199 Digit : Natural;
200 Fdigit : Long_Long_Float;
201
202 begin
203 -- Set bad base if out of range, and use safe base of 16.0,
204 -- to guard against division by zero in the loop below.
205
206 if Uval < 2.0 or else Uval > 16.0 then
207 Bad_Base := True;
208 Uval := 16.0;
209 end if;
210
211 Base := Uval;
212 Uval := 0.0;
213 P := P + 1;
214
215 -- Special check to allow initial point (RM 3.5(49))
216
217 if Str (P) = '.' then
218 After_Point := 1;
219 P := P + 1;
220 end if;
221
222 -- Loop to scan digits of based number. On entry to the loop we
223 -- must have a valid digit. If we don't, then we have an illegal
224 -- floating-point value, and we raise Constraint_Error, note that
225 -- Ptr at this stage was reset to the proper (Start) value.
226
227 loop
228 if P > Max then
229 Bad_Value (Str);
230
231 elsif Str (P) in Digs then
232 Digit := Character'Pos (Str (P)) - Character'Pos ('0');
233
234 elsif Str (P) in 'A' .. 'F' then
235 Digit :=
236 Character'Pos (Str (P)) - (Character'Pos ('A') - 10);
237
238 elsif Str (P) in 'a' .. 'f' then
239 Digit :=
240 Character'Pos (Str (P)) - (Character'Pos ('a') - 10);
241
242 else
243 Bad_Value (Str);
244 end if;
245
246 -- Save up trailing zeroes after the decimal point
247
248 if Digit = 0 and then After_Point = 1 then
249 Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
250
251 -- Here for a non-zero digit
252
253 else
254 -- First deal with any previously saved zeroes
255
256 if Num_Saved_Zeroes /= 0 then
257 Uval := Uval * Base ** Num_Saved_Zeroes;
258 Scale := Scale - Num_Saved_Zeroes;
259 Num_Saved_Zeroes := 0;
260 end if;
261
262 -- Now accumulate the new digit
263
264 Fdigit := Long_Long_Float (Digit);
265
266 if Fdigit >= Base then
267 Bad_Base := True;
268 else
269 Scale := Scale - After_Point;
270 Uval := Uval * Base + Fdigit;
271 end if;
272 end if;
273
274 P := P + 1;
275
276 if P > Max then
277 Bad_Value (Str);
278
279 elsif Str (P) = '_' then
280 Scan_Underscore (Str, P, Ptr, Max, True);
281
282 else
283 -- Skip past period after digit. Note that the processing
284 -- here will permit either a digit after the period, or the
285 -- terminating base character, as allowed in (RM 3.5(48))
286
287 if Str (P) = '.' and then After_Point = 0 then
288 P := P + 1;
289 After_Point := 1;
290
291 if P > Max then
292 Bad_Value (Str);
293 end if;
294 end if;
295
296 exit when Str (P) = Base_Char;
297 end if;
298 end loop;
299
300 -- Based number successfully scanned out (point was found)
301
302 Ptr.all := P + 1;
303 end;
304
305 -- Non-based case, check for being at decimal point now. Note that
306 -- in Ada 95, we do not insist on a decimal point being present
307
308 else
309 Base := 10.0;
310 After_Point := 1;
311
312 if P <= Max and then Str (P) = '.' then
313 P := P + 1;
314
315 -- Scan digits after point if any are present (RM 3.5(46))
316
317 if P <= Max and then Str (P) in Digs then
318 Scanf;
319 end if;
320 end if;
321
322 Ptr.all := P;
323 end if;
324
325 -- At this point, we have Uval containing the digits of the value as
326 -- an integer, and Scale indicates the negative of the number of digits
327 -- after the point. Base contains the base value (an integral value in
328 -- the range 2.0 .. 16.0). Test for exponent, must be at least one
329 -- character after the E for the exponent to be valid.
330
331 Scale := Scale + Scan_Exponent (Str, Ptr, Max, Real => True);
332
333 -- At this point the exponent has been scanned if one is present and
334 -- Scale is adjusted to include the exponent value. Uval contains the
335 -- the integral value which is to be multiplied by Base ** Scale.
336
337 -- If base is not 10, use exponentiation for scaling
338
339 if Base /= 10.0 then
340 Uval := Uval * Base ** Scale;
341
342 -- For base 10, use power of ten table, repeatedly if necessary
343
344 elsif Scale > 0 then
345 while Scale > Maxpow loop
346 Uval := Uval * Powten (Maxpow);
347 Scale := Scale - Maxpow;
348 end loop;
349
350 -- Note that we still know that Scale > 0, since the loop
351 -- above leaves Scale in the range 1 .. Maxpow.
352
353 Uval := Uval * Powten (Scale);
354
355 elsif Scale < 0 then
356 while (-Scale) > Maxpow loop
357 Uval := Uval / Powten (Maxpow);
358 Scale := Scale + Maxpow;
359 end loop;
360
361 -- Note that we still know that Scale < 0, since the loop
362 -- above leaves Scale in the range -Maxpow .. -1.
363
364 Uval := Uval / Powten (-Scale);
365 end if;
366
367 -- Here is where we check for a bad based number
368
369 if Bad_Base then
370 Bad_Value (Str);
371
372 -- If OK, then deal with initial minus sign, note that this processing
373 -- is done even if Uval is zero, so that -0.0 is correctly interpreted.
374
375 else
376 if Minus then
377 return -Uval;
378 else
379 return Uval;
380 end if;
381 end if;
382 end Scan_Real;
383
384 ----------------
385 -- Value_Real --
386 ----------------
387
388 function Value_Real (Str : String) return Long_Long_Float is
389 begin
390 -- We have to special case Str'Last = Positive'Last because the normal
391 -- circuit ends up setting P to Str'Last + 1 which is out of bounds. We
392 -- deal with this by converting to a subtype which fixes the bounds.
393
394 if Str'Last = Positive'Last then
395 declare
396 subtype NT is String (1 .. Str'Length);
397 begin
398 return Value_Real (NT (Str));
399 end;
400
401 -- Normal case where Str'Last < Positive'Last
402
403 else
404 declare
405 V : Long_Long_Float;
406 P : aliased Integer := Str'First;
407 begin
408 V := Scan_Real (Str, P'Access, Str'Last);
409 Scan_Trailing_Blanks (Str, P);
410 return V;
411 end;
412 end if;
413 end Value_Real;
414
415 end System.Val_Real;