gcc/ada/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-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
  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 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
 387 end System.Val_Real;