1 /* Copyright (C) 2002-2003 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
6 Libgfortran is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 Libgfortran is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with Libgfortran; see the file COPYING. If not, write to
18 the Free Software Foundation, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
27 #include "libgfortran.h"
30 /* read.c -- Deal with formatted reads */
32 /* set_integer()-- All of the integer assignments come here to
33 * actually place the value into memory. */
36 set_integer (void *dest, int64_t value, int length)
42 *((int64_t *) dest) = value;
45 *((int32_t *) dest) = value;
48 *((int16_t *) dest) = value;
51 *((int8_t *) dest) = value;
54 internal_error ("Bad integer kind");
59 /* max_value()-- Given a length (kind), return the maximum signed or
63 max_value (int length, int signed_flag)
70 value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff;
73 value = signed_flag ? 0x7fffffff : 0xffffffff;
76 value = signed_flag ? 0x7fff : 0xffff;
79 value = signed_flag ? 0x7f : 0xff;
82 internal_error ("Bad integer kind");
89 /* convert_real()-- Convert a character representation of a floating
90 * point number to the machine number. Returns nonzero if there is a
91 * range problem during conversion. TODO: handle not-a-numbers and
92 * infinities. Handling of kind 4 is probably wrong because of double
96 convert_real (void *dest, const char *buffer, int length)
104 *((float *) dest) = (float) strtod (buffer, NULL);
107 *((double *) dest) = strtod (buffer, NULL);
110 internal_error ("Bad real number kind");
115 generate_error (ERROR_READ_VALUE,
116 "Range error during floating point read");
124 convert_precision_real (void *dest, int sign,
125 char *buffer, int length, int exponent)
127 int w, new_dp_pos, i, slen, k, dp;
137 slen = strlen (buffer);
141 /* for (i = w - 1; i > 0; i --)
143 if (buffer[i] == '0' || buffer[i] == 0)
149 for (i = 0; i < w; i++)
151 if (buffer[i] == '.')
156 new_dp_pos += exponent;
173 fval = fval * 10.0 + c - '0';
194 i = new_dp_pos - slen + dp;
219 *((float *) dest) = (float)fval;
222 *((double *) dest) = fval;
225 internal_error ("Bad real number kind");
232 /* read_l()-- Read a logical value */
235 read_l (fnode * f, char *dest, int length)
263 set_integer (dest, 1, length);
267 set_integer (dest, 0, length);
271 generate_error (ERROR_READ_VALUE, "Bad value on logical read");
277 /* read_a()-- Read a character record. This one is pretty easy. */
280 read_a (fnode * f, char *p, int length)
286 if (w == -1) /* '(A)' edit descriptor */
289 source = read_block (&w);
293 source += (w - length);
295 m = (w > length) ? length : w;
296 memcpy (p, source, m);
300 memset (p + m, ' ', n);
304 /* eat_leading_spaces()-- Given a character pointer and a width,
305 * ignore the leading spaces. */
308 eat_leading_spaces (int *width, char *p)
313 if (*width == 0 || *p != ' ')
325 next_char (char **p, int *w)
340 if (g.blank_status == BLANK_ZERO)
343 /* At this point, the rest of the field has to be trailing blanks */
357 /* read_decimal()-- Read a decimal integer value. The values here are
361 read_decimal (fnode * f, char *dest, int length)
363 unsigned value, maxv, maxv_10;
372 p = eat_leading_spaces (&w, p);
375 set_integer (dest, 0, length);
379 maxv = max_value (length, 1);
401 /* At this point we have a digit-string */
406 c = next_char (&p, &w);
410 if (c < '0' || c > '9')
419 if (value > maxv - c)
424 v = (signed int) value;
428 set_integer (dest, v, length);
432 generate_error (ERROR_READ_VALUE, "Bad value during integer read");
436 generate_error (ERROR_READ_OVERFLOW,
437 "Value overflowed during integer read");
442 /* read_radix()-- This function reads values for non-decimal radixes.
443 * The difference here is that we treat the values here as unsigned
444 * values for the purposes of overflow. If minus sign is present and
445 * the top bit is set, the value will be incorrect. */
448 read_radix (fnode * f, char *dest, int length, int radix)
450 unsigned value, maxv, maxv_r;
459 p = eat_leading_spaces (&w, p);
462 set_integer (dest, 0, length);
466 maxv = max_value (length, 0);
467 maxv_r = maxv / radix;
488 /* At this point we have a digit-string */
493 c = next_char (&p, &w);
500 if (c < '0' || c > '1')
505 if (c < '0' || c > '7')
530 c = c - 'a' + '9' + 1;
539 c = c - 'A' + '9' + 1;
553 value = radix * value;
555 if (maxv - c < value)
560 v = (signed int) value;
564 set_integer (dest, v, length);
568 generate_error (ERROR_READ_VALUE, "Bad value during integer read");
572 generate_error (ERROR_READ_OVERFLOW,
573 "Value overflowed during integer read");
578 /* read_f()-- Read a floating point number with F-style editing, which
579 * is what all of the other floating point descriptors behave as. The
580 * tricky part is that optional spaces are allowed after an E or D,
581 * and the implicit decimal point if a decimal point is not present in
585 read_f (fnode * f, char *dest, int length)
587 int w, seen_dp, exponent;
588 int exponent_sign, val_sign;
589 char *p, *buffer, *n;
598 p = eat_leading_spaces (&w, p);
604 *((float *) dest) = 0.0;
608 *((double *) dest) = 0.0;
615 if (w + 2 < SCRATCH_SIZE)
618 buffer = get_mem (w + 2);
620 memset(buffer, 0, w + 2);
626 if (*p == '-' || *p == '+')
638 /* A digit (or a '.') is required at this point */
640 if (!isdigit (*p) && *p != '.')
671 if (g.blank_status == BLANK_ZERO)
699 /* No exponent has been seen, so we use the current scale factor */
701 exponent = -g.scale_factor;
705 generate_error (ERROR_READ_VALUE, "Bad value during floating point read");
706 if (buffer != scratch)
710 /* At this point the start of an exponent has been found */
713 while (w > 0 && *p == ' ')
734 /* At this point a digit string is required. We calculate the value
735 * of the exponent in order to take account of the scale factor and
736 * the d parameter before explict conversion takes place. */
746 while (w > 0 && isdigit (*p))
748 exponent = 10 * exponent + *p - '0';
749 if (exponent > 999999)
756 /* Only allow trailing blanks */
766 exponent = exponent * exponent_sign;
770 exponent -= f->u.real.d;
772 /* The number is syntactically correct and ready for conversion.
773 * The only thing that can go wrong at this point is overflow or
776 convert_precision_real (dest, val_sign, buffer, length, exponent);
778 if (buffer != scratch)
785 /* read_x()-- Deal with the X/TR descriptor. We just read some data
786 * and never look at it. */