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 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2003 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 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. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  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
  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
  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');
 110             P := P + 1;
 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;
 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
 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
 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                   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
 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          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;