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. */
28 #include "libgfortran.h"
31 /* read.c -- Deal with formatted reads */
33 /* set_integer()-- All of the integer assignments come here to
34 * actually place the value into memory. */
37 set_integer (void *dest, int64_t value, int length)
43 *((int64_t *) dest) = value;
46 *((int32_t *) dest) = value;
49 *((int16_t *) dest) = value;
52 *((int8_t *) dest) = value;
55 internal_error ("Bad integer kind");
60 /* max_value()-- Given a length (kind), return the maximum signed or
64 max_value (int length, int signed_flag)
71 value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff;
74 value = signed_flag ? 0x7fffffff : 0xffffffff;
77 value = signed_flag ? 0x7fff : 0xffff;
80 value = signed_flag ? 0x7f : 0xff;
83 internal_error ("Bad integer kind");
90 /* convert_real()-- Convert a character representation of a floating
91 * point number to the machine number. Returns nonzero if there is a
92 * range problem during conversion. TODO: handle not-a-numbers and
96 convert_real (void *dest, const char *buffer, int length)
105 #if defined(HAVE_STRTOF)
106 strtof (buffer, NULL);
108 (float) strtod (buffer, NULL);
112 *((double *) dest) = strtod (buffer, NULL);
115 internal_error ("Unsupported real kind during IO");
120 generate_error (ERROR_READ_VALUE,
121 "Range error during floating point read");
129 /* read_l()-- Read a logical value */
132 read_l (fnode * f, char *dest, int length)
160 set_integer (dest, 1, length);
164 set_integer (dest, 0, length);
168 generate_error (ERROR_READ_VALUE, "Bad value on logical read");
174 /* read_a()-- Read a character record. This one is pretty easy. */
177 read_a (fnode * f, char *p, int length)
183 if (w == -1) /* '(A)' edit descriptor */
186 source = read_block (&w);
190 source += (w - length);
192 m = (w > length) ? length : w;
193 memcpy (p, source, m);
197 memset (p + m, ' ', n);
201 /* eat_leading_spaces()-- Given a character pointer and a width,
202 * ignore the leading spaces. */
205 eat_leading_spaces (int *width, char *p)
210 if (*width == 0 || *p != ' ')
222 next_char (char **p, int *w)
237 if (g.blank_status == BLANK_ZERO)
240 /* At this point, the rest of the field has to be trailing blanks */
254 /* read_decimal()-- Read a decimal integer value. The values here are
258 read_decimal (fnode * f, char *dest, int length)
260 unsigned value, maxv, maxv_10;
269 p = eat_leading_spaces (&w, p);
272 set_integer (dest, 0, length);
276 maxv = max_value (length, 1);
298 /* At this point we have a digit-string */
303 c = next_char (&p, &w);
307 if (c < '0' || c > '9')
316 if (value > maxv - c)
321 v = (signed int) value;
325 set_integer (dest, v, length);
329 generate_error (ERROR_READ_VALUE, "Bad value during integer read");
333 generate_error (ERROR_READ_OVERFLOW,
334 "Value overflowed during integer read");
339 /* read_radix()-- This function reads values for non-decimal radixes.
340 * The difference here is that we treat the values here as unsigned
341 * values for the purposes of overflow. If minus sign is present and
342 * the top bit is set, the value will be incorrect. */
345 read_radix (fnode * f, char *dest, int length, int radix)
347 unsigned value, maxv, maxv_r;
356 p = eat_leading_spaces (&w, p);
359 set_integer (dest, 0, length);
363 maxv = max_value (length, 0);
364 maxv_r = maxv / radix;
385 /* At this point we have a digit-string */
390 c = next_char (&p, &w);
397 if (c < '0' || c > '1')
402 if (c < '0' || c > '7')
427 c = c - 'a' + '9' + 1;
436 c = c - 'A' + '9' + 1;
450 value = radix * value;
452 if (maxv - c < value)
457 v = (signed int) value;
461 set_integer (dest, v, length);
465 generate_error (ERROR_READ_VALUE, "Bad value during integer read");
469 generate_error (ERROR_READ_OVERFLOW,
470 "Value overflowed during integer read");
475 /* read_f()-- Read a floating point number with F-style editing, which
476 is what all of the other floating point descriptors behave as. The
477 tricky part is that optional spaces are allowed after an E or D,
478 and the implicit decimal point if a decimal point is not present in
482 read_f (fnode * f, char *dest, int length)
484 int w, seen_dp, exponent;
485 int exponent_sign, val_sign;
499 p = eat_leading_spaces (&w, p);
505 *((float *) dest) = 0.0f;
509 *((double *) dest) = 0.0;
513 internal_error ("Unsupported real kind during IO");
521 if (*p == '-' || *p == '+')
533 /* A digit (or a '.') is required at this point */
535 if (!isdigit (*p) && *p != '.')
538 /* Remember the position of the first digit. */
542 /* Scan through the string to find the exponent. */
591 /* No exponent has been seen, so we use the current scale factor */
593 exponent = -g.scale_factor;
597 generate_error (ERROR_READ_VALUE, "Bad value during floating point read");
598 if (buffer != scratch)
602 /* At this point the start of an exponent has been found */
605 while (w > 0 && *p == ' ')
626 /* At this point a digit string is required. We calculate the value
627 of the exponent in order to take account of the scale factor and
628 the d parameter before explict conversion takes place. */
638 while (w > 0 && isdigit (*p))
640 exponent = 10 * exponent + *p - '0';
645 /* Only allow trailing blanks */
655 exponent = exponent * exponent_sign;
658 /* Use the precision specified in the format if no decimal point has been
661 exponent -= f->u.real.d;
680 i = ndigits + edigits + 1;
684 if (i < SCRATCH_SIZE)
687 buffer = get_mem (i);
689 /* Reformat the string into a temporary buffer. As we're using atof it's
690 easiest to just leave the dcimal point in place. */
694 for (; ndigits > 0; ndigits--)
696 if (*digits == ' ' && g.blank_status == BLANK_ZERO)
704 sprintf (p, "%d", exponent);
706 /* Do the actual conversion. */
707 convert_real (dest, buffer, length);
709 if (buffer != scratch)
716 /* read_x()-- Deal with the X/TR descriptor. We just read some data
717 * and never look at it. */