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-2012, 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 call the floating-point processor reset routine so that we can 156 -- be sure the floating-point processor is properly set for conversion 157 -- calls. This is notably need on Windows, where calls to the operating 158 -- system randomly reset the processor into 64-bit mode. 159 160 System.Float_Control.Reset; 161 162 Scan_Sign (Str, Ptr, Max, Minus, Start); 163 P := Ptr.all; 164 Ptr.all := Start; 165 166 -- If digit, scan numeral before point 167 168 if Str (P) in Digs then 169 Uval := 0.0; 170 Scanf; 171 172 -- Initial point, allowed only if followed by digit (RM 3.5(47)) 173 174 elsif Str (P) = '.' 175 and then P < Max 176 and then Str (P + 1) in Digs 177 then 178 Uval := 0.0; 179 180 -- Any other initial character is an error 181 182 else 183 Bad_Value (Str); 184 end if; 185 186 -- Deal with based case 187 188 if P < Max and then (Str (P) = ':' or else Str (P) = '#') then 189 declare 190 Base_Char : constant Character := Str (P); 191 Digit : Natural; 192 Fdigit : Long_Long_Float; 193 194 begin 195 -- Set bad base if out of range, and use safe base of 16.0, 196 -- to guard against division by zero in the loop below. 197 198 if Uval < 2.0 or else Uval > 16.0 then 199 Bad_Base := True; 200 Uval := 16.0; 201 end if; 202 203 Base := Uval; 204 Uval := 0.0; 205 P := P + 1; 206 207 -- Special check to allow initial point (RM 3.5(49)) 208 209 if Str (P) = '.' then 210 After_Point := 1; 211 P := P + 1; 212 end if; 213 214 -- Loop to scan digits of based number. On entry to the loop we 215 -- must have a valid digit. If we don't, then we have an illegal 216 -- floating-point value, and we raise Constraint_Error, note that 217 -- Ptr at this stage was reset to the proper (Start) value. 218 219 loop 220 if P > Max then 221 Bad_Value (Str); 222 223 elsif Str (P) in Digs then 224 Digit := Character'Pos (Str (P)) - Character'Pos ('0'); 225 226 elsif Str (P) in 'A' .. 'F' then 227 Digit := 228 Character'Pos (Str (P)) - (Character'Pos ('A') - 10); 229 230 elsif Str (P) in 'a' .. 'f' then 231 Digit := 232 Character'Pos (Str (P)) - (Character'Pos ('a') - 10); 233 234 else 235 Bad_Value (Str); 236 end if; 237 238 -- Save up trailing zeroes after the decimal point 239 240 if Digit = 0 and then After_Point = 1 then 241 Num_Saved_Zeroes := Num_Saved_Zeroes + 1; 242 243 -- Here for a non-zero digit 244 245 else 246 -- First deal with any previously saved zeroes 247 248 if Num_Saved_Zeroes /= 0 then 249 Uval := Uval * Base ** Num_Saved_Zeroes; 250 Scale := Scale - Num_Saved_Zeroes; 251 Num_Saved_Zeroes := 0; 252 end if; 253 254 -- Now accumulate the new digit 255 256 Fdigit := Long_Long_Float (Digit); 257 258 if Fdigit >= Base then 259 Bad_Base := True; 260 else 261 Scale := Scale - After_Point; 262 Uval := Uval * Base + Fdigit; 263 end if; 264 end if; 265 266 P := P + 1; 267 268 if P > Max then 269 Bad_Value (Str); 270 271 elsif Str (P) = '_' then 272 Scan_Underscore (Str, P, Ptr, Max, True); 273 274 else 275 -- Skip past period after digit. Note that the processing 276 -- here will permit either a digit after the period, or the 277 -- terminating base character, as allowed in (RM 3.5(48)) 278 279 if Str (P) = '.' and then After_Point = 0 then 280 P := P + 1; 281 After_Point := 1; 282 283 if P > Max then 284 Bad_Value (Str); 285 end if; 286 end if; 287 288 exit when Str (P) = Base_Char; 289 end if; 290 end loop; 291 292 -- Based number successfully scanned out (point was found) 293 294 Ptr.all := P + 1; 295 end; 296 297 -- Non-based case, check for being at decimal point now. Note that 298 -- in Ada 95, we do not insist on a decimal point being present 299 300 else 301 Base := 10.0; 302 After_Point := 1; 303 304 if P <= Max and then Str (P) = '.' then 305 P := P + 1; 306 307 -- Scan digits after point if any are present (RM 3.5(46)) 308 309 if P <= Max and then Str (P) in Digs then 310 Scanf; 311 end if; 312 end if; 313 314 Ptr.all := P; 315 end if; 316 317 -- At this point, we have Uval containing the digits of the value as 318 -- an integer, and Scale indicates the negative of the number of digits 319 -- after the point. Base contains the base value (an integral value in 320 -- the range 2.0 .. 16.0). Test for exponent, must be at least one 321 -- character after the E for the exponent to be valid. 322 323 Scale := Scale + Scan_Exponent (Str, Ptr, Max, Real => True); 324 325 -- At this point the exponent has been scanned if one is present and 326 -- Scale is adjusted to include the exponent value. Uval contains the 327 -- the integral value which is to be multiplied by Base ** Scale. 328 329 -- If base is not 10, use exponentiation for scaling 330 331 if Base /= 10.0 then 332 Uval := Uval * Base ** Scale; 333 334 -- For base 10, use power of ten table, repeatedly if necessary 335 336 elsif Scale > 0 then 337 while Scale > Maxpow loop 338 Uval := Uval * Powten (Maxpow); 339 Scale := Scale - Maxpow; 340 end loop; 341 342 if Scale > 0 then 343 Uval := Uval * Powten (Scale); 344 end if; 345 346 elsif Scale < 0 then 347 while (-Scale) > Maxpow loop 348 Uval := Uval / Powten (Maxpow); 349 Scale := Scale + Maxpow; 350 end loop; 351 352 if Scale < 0 then 353 Uval := Uval / Powten (-Scale); 354 end if; 355 end if; 356 357 -- Here is where we check for a bad based number 358 359 if Bad_Base then 360 Bad_Value (Str); 361 362 -- If OK, then deal with initial minus sign, note that this processing 363 -- is done even if Uval is zero, so that -0.0 is correctly interpreted. 364 365 else 366 if Minus then 367 return -Uval; 368 else 369 return Uval; 370 end if; 371 end if; 372 end Scan_Real; 373 374 ---------------- 375 -- Value_Real -- 376 ---------------- 377 378 function Value_Real (Str : String) return Long_Long_Float is 379 V : Long_Long_Float; 380 P : aliased Integer := Str'First; 381 begin 382 V := Scan_Real (Str, P'Access, Str'Last); 383 Scan_Trailing_Blanks (Str, P); 384 return V; 385 end Value_Real; 386 387end System.Val_Real; 388