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-- 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/>. -- 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 32with System.Powten_Table; use System.Powten_Table; 33with System.Val_Util; use System.Val_Util; 34with System.Float_Control; 35 36package 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 415end System.Val_Real; 416