| c32d0452 |
1 | ------------------------------------------------------------------------------ |
| 2 | -- -- |
| 3 | -- GNAT COMPILER COMPONENTS -- |
| 4 | -- -- |
| 5 | -- S Y S T E M . V A L _ R E A L -- |
| 6 | -- -- |
| 7 | -- S p e c -- |
| 8 | -- -- |
| 9dfe12ae |
9 | -- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- |
| c32d0452 |
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 2, 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. See the GNU General Public License -- |
| 17 | -- for more details. You should have received a copy of the GNU General -- |
| 18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| 19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| 20 | -- MA 02111-1307, USA. -- |
| 21 | -- -- |
| 22 | -- As a special exception, if other files instantiate generics from this -- |
| 23 | -- unit, or you link this unit with other files to produce an executable, -- |
| 24 | -- this unit does not by itself cause the resulting executable to be -- |
| 25 | -- covered by the GNU General Public License. This exception does not -- |
| 26 | -- however invalidate any other reasons why the executable file might be -- |
| 27 | -- covered by the GNU Public License. -- |
| 28 | -- -- |
| 29 | -- GNAT was originally developed by the GNAT team at New York University. -- |
| e78e8c8e |
30 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| c32d0452 |
31 | -- -- |
| 32 | ------------------------------------------------------------------------------ |
| 33 | |
| 34 | with System.Powten_Table; use System.Powten_Table; |
| 35 | with System.Val_Util; use System.Val_Util; |
| 36 | |
| 37 | package body System.Val_Real is |
| 38 | |
| 39 | --------------- |
| 40 | -- Scan_Real -- |
| 41 | --------------- |
| 42 | |
| 43 | function Scan_Real |
| 44 | (Str : String; |
| 45 | Ptr : access Integer; |
| 46 | Max : Integer) |
| 47 | return Long_Long_Float |
| 48 | is |
| 49 | procedure Reset; |
| 50 | pragma Import (C, Reset, "__gnat_init_float"); |
| 51 | -- We import the floating-point processor reset routine so that we can |
| 52 | -- be sure the floating-point processor is properly set for conversion |
| 53 | -- calls (see description of Reset in GNAT.Float_Control (g-flocon.ads). |
| 54 | -- This is notably need on Windows, where calls to the operating system |
| 55 | -- randomly reset the processor into 64-bit mode. |
| 56 | |
| 57 | P : Integer; |
| 58 | -- Local copy of string pointer |
| 59 | |
| 60 | Base : Long_Long_Float; |
| 61 | -- Base value |
| 62 | |
| 63 | Uval : Long_Long_Float; |
| 64 | -- Accumulated float result |
| 65 | |
| 66 | subtype Digs is Character range '0' .. '9'; |
| 67 | -- Used to check for decimal digit |
| 68 | |
| 69 | Scale : Integer := 0; |
| 70 | -- Power of Base to multiply result by |
| 71 | |
| 72 | Start : Positive; |
| 73 | -- Position of starting non-blank character |
| 74 | |
| 75 | Minus : Boolean; |
| 76 | -- Set to True if minus sign is present, otherwise to False |
| 77 | |
| 78 | Bad_Base : Boolean := False; |
| 79 | -- Set True if Base out of range or if out of range digit |
| 80 | |
| 81 | After_Point : Natural := 0; |
| 82 | -- Set to 1 after the point |
| 83 | |
| 9dfe12ae |
84 | Num_Saved_Zeroes : Natural := 0; |
| 85 | -- This counts zeroes after the decimal point. A non-zero value means |
| 86 | -- that this number of previously scanned digits are zero. if the end |
| 87 | -- of the number is reached, these zeroes are simply discarded, which |
| 88 | -- ensures that trailing zeroes after the point never affect the value |
| 89 | -- (which might otherwise happen as a result of rounding). With this |
| 90 | -- processing in place, we can ensure that, for example, we get the |
| 91 | -- same exact result from 1.0E+49 and 1.0000000E+49. This is not |
| 92 | -- necessarily required in a case like this where the result is not |
| 93 | -- a machine number, but it is certainly a desirable behavior. |
| 94 | |
| c32d0452 |
95 | procedure Scanf; |
| 96 | -- Scans integer literal value starting at current character position. |
| 97 | -- For each digit encountered, Uval is multiplied by 10.0, and the new |
| 98 | -- digit value is incremented. In addition Scale is decremented for each |
| 99 | -- digit encountered if we are after the point (After_Point = 1). The |
| 100 | -- longest possible syntactically valid numeral is scanned out, and on |
| 101 | -- return P points past the last character. On entry, the current |
| 102 | -- character is known to be a digit, so a numeral is definitely present. |
| 103 | |
| 104 | procedure Scanf is |
| 105 | Digit : Natural; |
| 106 | |
| 107 | begin |
| 108 | loop |
| 109 | Digit := Character'Pos (Str (P)) - Character'Pos ('0'); |
| c32d0452 |
110 | P := P + 1; |
| 9dfe12ae |
111 | |
| 112 | -- Save up trailing zeroes after the decimal point |
| 113 | |
| 114 | if Digit = 0 and After_Point = 1 then |
| 115 | Num_Saved_Zeroes := Num_Saved_Zeroes + 1; |
| 116 | |
| 117 | -- Here for a non-zero digit |
| 118 | |
| 119 | else |
| 120 | -- First deal with any previously saved zeroes |
| 121 | |
| 122 | if Num_Saved_Zeroes /= 0 then |
| 123 | while Num_Saved_Zeroes > Maxpow loop |
| 124 | Uval := Uval * Powten (Maxpow); |
| 125 | Num_Saved_Zeroes := Num_Saved_Zeroes - Maxpow; |
| 126 | Scale := Scale - Maxpow; |
| 127 | end loop; |
| 128 | |
| 129 | Uval := Uval * Powten (Num_Saved_Zeroes); |
| 130 | Scale := Scale - Num_Saved_Zeroes; |
| 131 | |
| 132 | Num_Saved_Zeroes := 0; |
| 133 | end if; |
| 134 | |
| 135 | -- Accumulate new digit |
| 136 | |
| 137 | Uval := Uval * 10.0 + Long_Long_Float (Digit); |
| 138 | Scale := Scale - After_Point; |
| 139 | end if; |
| c32d0452 |
140 | |
| 141 | -- Done if end of input field |
| 142 | |
| 143 | if P > Max then |
| 144 | return; |
| 145 | |
| 146 | -- Check next character |
| 147 | |
| 148 | elsif Str (P) not in Digs then |
| 149 | if Str (P) = '_' then |
| 150 | Scan_Underscore (Str, P, Ptr, Max, False); |
| 151 | else |
| 152 | return; |
| 153 | end if; |
| 154 | end if; |
| 155 | end loop; |
| 156 | end Scanf; |
| 157 | |
| 158 | -- Start of processing for System.Scan_Real |
| 159 | |
| 160 | begin |
| 161 | Reset; |
| 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 | raise Constraint_Error; |
| 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 | raise Constraint_Error; |
| 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 | raise Constraint_Error; |
| 236 | end if; |
| 237 | |
| 9dfe12ae |
238 | -- Save up trailing zeroes after the decimal point |
| 239 | |
| 240 | if Digit = 0 and After_Point = 1 then |
| 241 | Num_Saved_Zeroes := Num_Saved_Zeroes + 1; |
| 242 | |
| 243 | -- Here for a non-zero digit |
| c32d0452 |
244 | |
| c32d0452 |
245 | else |
| 9dfe12ae |
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; |
| c32d0452 |
264 | end if; |
| 265 | |
| 9dfe12ae |
266 | P := P + 1; |
| 267 | |
| c32d0452 |
268 | if P > Max then |
| 269 | raise Constraint_Error; |
| 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 | raise Constraint_Error; |
| 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 |
| c32d0452 |
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 |
| c32d0452 |
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 | raise Constraint_Error; |
| 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 | |
| 373 | end Scan_Real; |
| 374 | |
| 375 | ---------------- |
| 376 | -- Value_Real -- |
| 377 | ---------------- |
| 378 | |
| 379 | function Value_Real (Str : String) return Long_Long_Float is |
| 380 | V : Long_Long_Float; |
| 381 | P : aliased Integer := Str'First; |
| 382 | |
| 383 | begin |
| 384 | V := Scan_Real (Str, P'Access, Str'Last); |
| 385 | Scan_Trailing_Blanks (Str, P); |
| 386 | return V; |
| 387 | |
| 388 | end Value_Real; |
| 389 | |
| 390 | end System.Val_Real; |
projects / thirdparty / gcc.git / blame