OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-valrea.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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-2011, 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 Bad_Based_Value;
86
      pragma No_Return (Bad_Based_Value);
87
      --  Raise exception for bad based value
88
 
89
      procedure Scanf;
90
      --  Scans integer literal value starting at current character position.
91
      --  For each digit encountered, Uval is multiplied by 10.0, and the new
92
      --  digit value is incremented. In addition Scale is decremented for each
93
      --  digit encountered if we are after the point (After_Point = 1). The
94
      --  longest possible syntactically valid numeral is scanned out, and on
95
      --  return P points past the last character. On entry, the current
96
      --  character is known to be a digit, so a numeral is definitely present.
97
 
98
      ---------------------
99
      -- Bad_Based_Value --
100
      ---------------------
101
 
102
      procedure Bad_Based_Value is
103
      begin
104
         raise Constraint_Error with
105
           "invalid based literal for 'Value";
106
      end Bad_Based_Value;
107
 
108
      -----------
109
      -- Scanf --
110
      -----------
111
 
112
      procedure Scanf is
113
         Digit : Natural;
114
 
115
      begin
116
         loop
117
            Digit := Character'Pos (Str (P)) - Character'Pos ('0');
118
            P := P + 1;
119
 
120
            --  Save up trailing zeroes after the decimal point
121
 
122
            if Digit = 0 and then After_Point = 1 then
123
               Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
124
 
125
            --  Here for a non-zero digit
126
 
127
            else
128
               --  First deal with any previously saved zeroes
129
 
130
               if Num_Saved_Zeroes /= 0 then
131
                  while Num_Saved_Zeroes > Maxpow loop
132
                     Uval := Uval * Powten (Maxpow);
133
                     Num_Saved_Zeroes := Num_Saved_Zeroes - Maxpow;
134
                     Scale := Scale - Maxpow;
135
                  end loop;
136
 
137
                  Uval := Uval * Powten (Num_Saved_Zeroes);
138
                  Scale := Scale - Num_Saved_Zeroes;
139
 
140
                  Num_Saved_Zeroes := 0;
141
               end if;
142
 
143
               --  Accumulate new digit
144
 
145
               Uval := Uval * 10.0 + Long_Long_Float (Digit);
146
               Scale := Scale - After_Point;
147
            end if;
148
 
149
            --  Done if end of input field
150
 
151
            if P > Max then
152
               return;
153
 
154
            --  Check next character
155
 
156
            elsif Str (P) not in Digs then
157
               if Str (P) = '_' then
158
                  Scan_Underscore (Str, P, Ptr, Max, False);
159
               else
160
                  return;
161
               end if;
162
            end if;
163
         end loop;
164
      end Scanf;
165
 
166
   --  Start of processing for System.Scan_Real
167
 
168
   begin
169
      --  We call the floating-point processor reset routine so that we can
170
      --  be sure the floating-point processor is properly set for conversion
171
      --  calls. This is notably need on Windows, where calls to the operating
172
      --  system randomly reset the processor into 64-bit mode.
173
 
174
      System.Float_Control.Reset;
175
 
176
      Scan_Sign (Str, Ptr, Max, Minus, Start);
177
      P := Ptr.all;
178
      Ptr.all := Start;
179
 
180
      --  If digit, scan numeral before point
181
 
182
      if Str (P) in Digs then
183
         Uval := 0.0;
184
         Scanf;
185
 
186
      --  Initial point, allowed only if followed by digit (RM 3.5(47))
187
 
188
      elsif Str (P) = '.'
189
        and then P < Max
190
        and then Str (P + 1) in Digs
191
      then
192
         Uval := 0.0;
193
 
194
      --  Any other initial character is an error
195
 
196
      else
197
         raise Constraint_Error with
198
           "invalid character in 'Value string";
199
      end if;
200
 
201
      --  Deal with based case
202
 
203
      if P < Max and then (Str (P) = ':' or else Str (P) = '#') then
204
         declare
205
            Base_Char : constant Character := Str (P);
206
            Digit     : Natural;
207
            Fdigit    : Long_Long_Float;
208
 
209
         begin
210
            --  Set bad base if out of range, and use safe base of 16.0,
211
            --  to guard against division by zero in the loop below.
212
 
213
            if Uval < 2.0 or else Uval > 16.0 then
214
               Bad_Base := True;
215
               Uval := 16.0;
216
            end if;
217
 
218
            Base := Uval;
219
            Uval := 0.0;
220
            P := P + 1;
221
 
222
            --  Special check to allow initial point (RM 3.5(49))
223
 
224
            if Str (P) = '.' then
225
               After_Point := 1;
226
               P := P + 1;
227
            end if;
228
 
229
            --  Loop to scan digits of based number. On entry to the loop we
230
            --  must have a valid digit. If we don't, then we have an illegal
231
            --  floating-point value, and we raise Constraint_Error, note that
232
            --  Ptr at this stage was reset to the proper (Start) value.
233
 
234
            loop
235
               if P > Max then
236
                  Bad_Based_Value;
237
 
238
               elsif Str (P) in Digs then
239
                  Digit := Character'Pos (Str (P)) - Character'Pos ('0');
240
 
241
               elsif Str (P) in 'A' .. 'F' then
242
                  Digit :=
243
                    Character'Pos (Str (P)) - (Character'Pos ('A') - 10);
244
 
245
               elsif Str (P) in 'a' .. 'f' then
246
                  Digit :=
247
                    Character'Pos (Str (P)) - (Character'Pos ('a') - 10);
248
 
249
               else
250
                  Bad_Based_Value;
251
               end if;
252
 
253
               --  Save up trailing zeroes after the decimal point
254
 
255
               if Digit = 0 and then After_Point = 1 then
256
                  Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
257
 
258
               --  Here for a non-zero digit
259
 
260
               else
261
                  --  First deal with any previously saved zeroes
262
 
263
                  if Num_Saved_Zeroes /= 0 then
264
                     Uval := Uval * Base ** Num_Saved_Zeroes;
265
                     Scale := Scale - Num_Saved_Zeroes;
266
                     Num_Saved_Zeroes := 0;
267
                  end if;
268
 
269
                  --  Now accumulate the new digit
270
 
271
                  Fdigit := Long_Long_Float (Digit);
272
 
273
                  if Fdigit >= Base then
274
                     Bad_Base := True;
275
                  else
276
                     Scale := Scale - After_Point;
277
                     Uval := Uval * Base + Fdigit;
278
                  end if;
279
               end if;
280
 
281
               P := P + 1;
282
 
283
               if P > Max then
284
                  Bad_Based_Value;
285
 
286
               elsif Str (P) = '_' then
287
                  Scan_Underscore (Str, P, Ptr, Max, True);
288
 
289
               else
290
                  --  Skip past period after digit. Note that the processing
291
                  --  here will permit either a digit after the period, or the
292
                  --  terminating base character, as allowed in (RM 3.5(48))
293
 
294
                  if Str (P) = '.' and then After_Point = 0 then
295
                     P := P + 1;
296
                     After_Point := 1;
297
 
298
                     if P > Max then
299
                        Bad_Based_Value;
300
                     end if;
301
                  end if;
302
 
303
                  exit when Str (P) = Base_Char;
304
               end if;
305
            end loop;
306
 
307
            --  Based number successfully scanned out (point was found)
308
 
309
            Ptr.all := P + 1;
310
         end;
311
 
312
      --  Non-based case, check for being at decimal point now. Note that
313
      --  in Ada 95, we do not insist on a decimal point being present
314
 
315
      else
316
         Base := 10.0;
317
         After_Point := 1;
318
 
319
         if P <= Max and then Str (P) = '.' then
320
            P := P + 1;
321
 
322
            --  Scan digits after point if any are present (RM 3.5(46))
323
 
324
            if P <= Max and then Str (P) in Digs then
325
               Scanf;
326
            end if;
327
         end if;
328
 
329
         Ptr.all := P;
330
      end if;
331
 
332
      --  At this point, we have Uval containing the digits of the value as
333
      --  an integer, and Scale indicates the negative of the number of digits
334
      --  after the point. Base contains the base value (an integral value in
335
      --  the range 2.0 .. 16.0). Test for exponent, must be at least one
336
      --  character after the E for the exponent to be valid.
337
 
338
      Scale := Scale + Scan_Exponent (Str, Ptr, Max, Real => True);
339
 
340
      --  At this point the exponent has been scanned if one is present and
341
      --  Scale is adjusted to include the exponent value. Uval contains the
342
      --  the integral value which is to be multiplied by Base ** Scale.
343
 
344
      --  If base is not 10, use exponentiation for scaling
345
 
346
      if Base /= 10.0 then
347
         Uval := Uval * Base ** Scale;
348
 
349
      --  For base 10, use power of ten table, repeatedly if necessary
350
 
351
      elsif Scale > 0 then
352
         while Scale > Maxpow loop
353
            Uval := Uval * Powten (Maxpow);
354
            Scale := Scale - Maxpow;
355
         end loop;
356
 
357
         if Scale > 0 then
358
            Uval := Uval * Powten (Scale);
359
         end if;
360
 
361
      elsif Scale < 0 then
362
         while (-Scale) > Maxpow loop
363
            Uval := Uval / Powten (Maxpow);
364
            Scale := Scale + Maxpow;
365
         end loop;
366
 
367
         if Scale < 0 then
368
            Uval := Uval / Powten (-Scale);
369
         end if;
370
      end if;
371
 
372
      --  Here is where we check for a bad based number
373
 
374
      if Bad_Base then
375
         Bad_Based_Value;
376
 
377
      --  If OK, then deal with initial minus sign, note that this processing
378
      --  is done even if Uval is zero, so that -0.0 is correctly interpreted.
379
 
380
      else
381
         if Minus then
382
            return -Uval;
383
         else
384
            return Uval;
385
         end if;
386
      end if;
387
   end Scan_Real;
388
 
389
   ----------------
390
   -- Value_Real --
391
   ----------------
392
 
393
   function Value_Real (Str : String) return Long_Long_Float is
394
      V : Long_Long_Float;
395
      P : aliased Integer := Str'First;
396
   begin
397
      V := Scan_Real (Str, P'Access, Str'Last);
398
      Scan_Trailing_Blanks (Str, P);
399
      return V;
400
   end Value_Real;
401
 
402
end System.Val_Real;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.