read.c

gcc-fortran,linux使用fortran的编译软件。很好用的。

  p = eat_leading_spaces (&w, p);
  if (w == 0)
    {
      set_integer (dest, (GFC_INTEGER_LARGEST) 0, length);
      return;
    }

  maxv = max_value (length, 0);
  maxv_r = maxv / radix;

  negative = 0;
  value = 0;

  switch (*p)
    {
    case '-':
      negative = 1;
      /* Fall through */

    case '+':
      p++;
      if (--w == 0)
	goto bad;
      /* Fall through */

    default:
      break;
    }

  /* At this point we have a digit-string */
  value = 0;

  for (;;)
    {
      c = next_char (dtp, &p, &w);
      if (c == '\0')
	break;
      if (c == ' ')
        {
	  if (dtp->u.p.blank_status == BLANK_NULL) continue;
	  if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
        }

      switch (radix)
	{
	case 2:
	  if (c < '0' || c > '1')
	    goto bad;
	  break;

	case 8:
	  if (c < '0' || c > '7')
	    goto bad;
	  break;

	case 16:
	  switch (c)
	    {
	    case '0':
	    case '1':
	    case '2':
	    case '3':
	    case '4':
	    case '5':
	    case '6':
	    case '7':
	    case '8':
	    case '9':
	      break;

	    case 'a':
	    case 'b':
	    case 'c':
	    case 'd':
	    case 'e':
	    case 'f':
	      c = c - 'a' + '9' + 1;
	      break;

	    case 'A':
	    case 'B':
	    case 'C':
	    case 'D':
	    case 'E':
	    case 'F':
	      c = c - 'A' + '9' + 1;
	      break;

	    default:
	      goto bad;
	    }

	  break;
	}

      if (value > maxv_r)
	goto overflow;

      c -= '0';
      value = radix * value;

      if (maxv - c < value)
	goto overflow;
      value += c;
    }

  v = value;
  if (negative)
    v = -v;

  set_integer (dest, v, length);
  return;

 bad:
  generate_error (&dtp->common, ERROR_READ_VALUE,
		  "Bad value during integer read");
  return;

 overflow:
  generate_error (&dtp->common, ERROR_READ_OVERFLOW,
		  "Value overflowed during integer read");
  return;
}


/* read_f()-- Read a floating point number with F-style editing, which
   is what all of the other floating point descriptors behave as.  The
   tricky part is that optional spaces are allowed after an E or D,
   and the implicit decimal point if a decimal point is not present in
   the input.  */

void
read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
  int w, seen_dp, exponent;
  int exponent_sign, val_sign;
  int ndigits;
  int edigits;
  int i;
  char *p, *buffer;
  char *digits;
  char scratch[SCRATCH_SIZE];

  val_sign = 1;
  seen_dp = 0;
  w = f->u.w;
  p = read_block (dtp, &w);
  if (p == NULL)
    return;

  p = eat_leading_spaces (&w, p);
  if (w == 0)
    goto zero;

  /* Optional sign */

  if (*p == '-' || *p == '+')
    {
      if (*p == '-')
        val_sign = -1;
      p++;
      w--;
    }

  exponent_sign = 1;
  p = eat_leading_spaces (&w, p);
  if (w == 0)
    goto zero;

  /* A digit, a '.' or a exponent character ('e', 'E', 'd' or 'D')
     is required at this point */

  if (!isdigit (*p) && *p != '.' && *p != 'd' && *p != 'D'
      && *p != 'e' && *p != 'E')
    goto bad_float;

  /* Remember the position of the first digit.  */
  digits = p;
  ndigits = 0;

  /* Scan through the string to find the exponent.  */
  while (w > 0)
    {
      switch (*p)
	{
	case '.':
	  if (seen_dp)
	    goto bad_float;
	  seen_dp = 1;
	  /* Fall through */

	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	case ' ':
	  ndigits++;
	  p++;
	  w--;
	  break;

	case '-':
	  exponent_sign = -1;
	  /* Fall through */

	case '+':
	  p++;
	  w--;
	  goto exp2;

	case 'd':
	case 'e':
	case 'D':
	case 'E':
	  p++;
	  w--;
	  goto exp1;

	default:
	  goto bad_float;
	}
    }

  /* No exponent has been seen, so we use the current scale factor */
  exponent = -dtp->u.p.scale_factor;
  goto done;

 bad_float:
  generate_error (&dtp->common, ERROR_READ_VALUE,
		  "Bad value during floating point read");
  return;

  /* The value read is zero */
 zero:
  switch (length)
    {
      case 4:
	*((GFC_REAL_4 *) dest) = 0;
	break;

      case 8:
	*((GFC_REAL_8 *) dest) = 0;
	break;

#ifdef HAVE_GFC_REAL_10
      case 10:
	*((GFC_REAL_10 *) dest) = 0;
	break;
#endif

#ifdef HAVE_GFC_REAL_16
      case 16:
	*((GFC_REAL_16 *) dest) = 0;
	break;
#endif

      default:
	internal_error (&dtp->common, "Unsupported real kind during IO");
    }
  return;

  /* At this point the start of an exponent has been found */
 exp1:
  while (w > 0 && *p == ' ')
    {
      w--;
      p++;
    }

  switch (*p)
    {
    case '-':
      exponent_sign = -1;
      /* Fall through */

    case '+':
      p++;
      w--;
      break;
    }

  if (w == 0)
    goto bad_float;

  /* At this point a digit string is required.  We calculate the value
     of the exponent in order to take account of the scale factor and
     the d parameter before explict conversion takes place. */
 exp2:
  if (!isdigit (*p))
    goto bad_float;

  exponent = *p - '0';
  p++;
  w--;

  if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) /* Normal processing of exponent */
    {
      while (w > 0 && isdigit (*p))
        {
          exponent = 10 * exponent + *p - '0';
          p++;
          w--;
        }
        
      /* Only allow trailing blanks */

      while (w > 0)
        {
          if (*p != ' ')
  	  goto bad_float;
          p++;
          w--;
        }
    }    
  else  /* BZ or BN status is enabled */
    {
      while (w > 0)
        {
          if (*p == ' ')
            {
	      if (dtp->u.p.blank_status == BLANK_ZERO) *p = '0';
	      if (dtp->u.p.blank_status == BLANK_NULL)
                {
                  p++;
                  w--;
                  continue;
                }
            }
          else if (!isdigit (*p))
            goto bad_float;

          exponent = 10 * exponent + *p - '0';
          p++;
          w--;
        }
    }

  exponent = exponent * exponent_sign;

 done:
  /* Use the precision specified in the format if no decimal point has been
     seen.  */
  if (!seen_dp)
    exponent -= f->u.real.d;

  if (exponent > 0)
    {
      edigits = 2;
      i = exponent;
    }
  else
    {
      edigits = 3;
      i = -exponent;
    }

  while (i >= 10)
    {
      i /= 10;
      edigits++;
    }

  i = ndigits + edigits + 1;
  if (val_sign < 0)
    i++;

  if (i < SCRATCH_SIZE) 
    buffer = scratch;
  else
    buffer = get_mem (i);

  /* Reformat the string into a temporary buffer.  As we're using atof it's
     easiest to just leave the decimal point in place.  */
  p = buffer;
  if (val_sign < 0)
    *(p++) = '-';
  for (; ndigits > 0; ndigits--)
    {
      if (*digits == ' ')
        {
	  if (dtp->u.p.blank_status == BLANK_ZERO) *digits = '0';
	  if (dtp->u.p.blank_status == BLANK_NULL)
            {
              digits++;
              continue;
            } 
        }
      *p = *digits;
      p++;
      digits++;
    }
  *(p++) = 'e';
  sprintf (p, "%d", exponent);

  /* Do the actual conversion.  */
  convert_real (dtp, dest, buffer, length);

  if (buffer != scratch)
     free_mem (buffer);

  return;
}


/* read_x()-- Deal with the X/TR descriptor.  We just read some data
 * and never look at it. */

void
read_x (st_parameter_dt *dtp, int n)
{
  if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp))
      && dtp->u.p.current_unit->bytes_left < n)
    n = dtp->u.p.current_unit->bytes_left;

  dtp->u.p.sf_read_comma = 0;
  if (n > 0)
    read_block (dtp, &n);
  dtp->u.p.sf_read_comma = 1;

}