list_read.c

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

      goto get_integer;

    CASE_SEPARATORS:		/* Single null.  */
      unget_char (dtp, c);
      eat_separator (dtp);
      return;

    CASE_DIGITS:
      push_char (dtp, c);
      break;

    default:
      goto bad_integer;
    }

  /* Take care of what may be a repeat count.  */

  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	CASE_DIGITS:
	  push_char (dtp, c);
	  break;

	case '*':
	  push_char (dtp, '\0');
	  goto repeat;

	CASE_SEPARATORS:	/* Not a repeat count.  */
	  goto done;

	default:
	  goto bad_integer;
	}
    }

 repeat:
  if (convert_integer (dtp, -1, 0))
    return;

  /* Get the real integer.  */

  c = next_char (dtp);
  switch (c)
    {
    CASE_DIGITS:
      break;

    CASE_SEPARATORS:
      unget_char (dtp, c);
      eat_separator (dtp);
      return;

    case '-':
      negative = 1;
      /* Fall through...  */

    case '+':
      c = next_char (dtp);
      break;
    }

 get_integer:
  if (!isdigit (c))
    goto bad_integer;
  push_char (dtp, c);

  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	CASE_DIGITS:
	  push_char (dtp, c);
	  break;

	CASE_SEPARATORS:
	  goto done;

	default:
	  goto bad_integer;
	}
    }

 bad_integer:

  if (nml_bad_return (dtp, c))
    return;

  free_saved (dtp);

  st_sprintf (message, "Bad integer for item %d in list input",
	      dtp->u.p.item_count);
  generate_error (&dtp->common, ERROR_READ_VALUE, message);

  return;

 done:
  unget_char (dtp, c);
  eat_separator (dtp);

  push_char (dtp, '\0');
  if (convert_integer (dtp, length, negative))
    {
       free_saved (dtp);
       return;
    }

  free_saved (dtp);
  dtp->u.p.saved_type = BT_INTEGER;
}


/* Read a character variable.  */

static void
read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
{
  char c, quote, message[100];

  quote = ' ';			/* Space means no quote character.  */

  c = next_char (dtp);
  switch (c)
    {
    CASE_DIGITS:
      push_char (dtp, c);
      break;

    CASE_SEPARATORS:
      unget_char (dtp, c);		/* NULL value.  */
      eat_separator (dtp);
      return;

    case '"':
    case '\'':
      quote = c;
      goto get_string;

    default:
      if (dtp->u.p.namelist_mode)
	{
	  unget_char (dtp,c);
	  return;
	}
      push_char (dtp, c);
      goto get_string;
    }

  /* Deal with a possible repeat count.  */

  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	CASE_DIGITS:
	  push_char (dtp, c);
	  break;

	CASE_SEPARATORS:
	  unget_char (dtp, c);
	  goto done;		/* String was only digits!  */

	case '*':
	  push_char (dtp, '\0');
	  goto got_repeat;

	default:
	  push_char (dtp, c);
	  goto get_string;	/* Not a repeat count after all.  */
	}
    }

 got_repeat:
  if (convert_integer (dtp, -1, 0))
    return;

  /* Now get the real string.  */

  c = next_char (dtp);
  switch (c)
    {
    CASE_SEPARATORS:
      unget_char (dtp, c);		/* Repeated NULL values.  */
      eat_separator (dtp);
      return;

    case '"':
    case '\'':
      quote = c;
      break;

    default:
      push_char (dtp, c);
      break;
    }

 get_string:
  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	case '"':
	case '\'':
	  if (c != quote)
	    {
	      push_char (dtp, c);
	      break;
	    }

	  /* See if we have a doubled quote character or the end of
	     the string.  */

	  c = next_char (dtp);
	  if (c == quote)
	    {
	      push_char (dtp, quote);
	      break;
	    }

	  unget_char (dtp, c);
	  goto done;

	CASE_SEPARATORS:
	  if (quote == ' ')
	    {
	      unget_char (dtp, c);
	      goto done;
	    }

	  if (c != '\n' && c != '\r')
	    push_char (dtp, c);
	  break;

	default:
	  push_char (dtp, c);
	  break;
	}
    }

  /* At this point, we have to have a separator, or else the string is
     invalid.  */
 done:
  c = next_char (dtp);
  if (is_separator (c))
    {
      unget_char (dtp, c);
      eat_separator (dtp);
      dtp->u.p.saved_type = BT_CHARACTER;
    }
  else
    {
      free_saved (dtp);
      st_sprintf (message, "Invalid string input in item %d",
		  dtp->u.p.item_count);
      generate_error (&dtp->common, ERROR_READ_VALUE, message);
    }
}


/* Parse a component of a complex constant or a real number that we
   are sure is already there.  This is a straight real number parser.  */

static int
parse_real (st_parameter_dt *dtp, void *buffer, int length)
{
  char c, message[100];
  int m, seen_dp;

  c = next_char (dtp);
  if (c == '-' || c == '+')
    {
      push_char (dtp, c);
      c = next_char (dtp);
    }

  if (!isdigit (c) && c != '.')
    goto bad;

  push_char (dtp, c);

  seen_dp = (c == '.') ? 1 : 0;

  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	CASE_DIGITS:
	  push_char (dtp, c);
	  break;

	case '.':
	  if (seen_dp)
	    goto bad;

	  seen_dp = 1;
	  push_char (dtp, c);
	  break;

	case 'e':
	case 'E':
	case 'd':
	case 'D':
	  push_char (dtp, 'e');
	  goto exp1;

	case '-':
	case '+':
	  push_char (dtp, 'e');
	  push_char (dtp, c);
	  c = next_char (dtp);
	  goto exp2;

	CASE_SEPARATORS:
	  unget_char (dtp, c);
	  goto done;

	default:
	  goto done;
	}
    }

 exp1:
  c = next_char (dtp);
  if (c != '-' && c != '+')
    push_char (dtp, '+');
  else
    {
      push_char (dtp, c);
      c = next_char (dtp);
    }

 exp2:
  if (!isdigit (c))
    goto bad;
  push_char (dtp, c);

  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	CASE_DIGITS:
	  push_char (dtp, c);
	  break;

	CASE_SEPARATORS:
	  unget_char (dtp, c);
	  goto done;

	default:
	  goto done;
	}
    }

 done:
  unget_char (dtp, c);
  push_char (dtp, '\0');

  m = convert_real (dtp, buffer, dtp->u.p.saved_string, length);
  free_saved (dtp);

  return m;

 bad:
  free_saved (dtp);
  st_sprintf (message, "Bad floating point number for item %d",
	      dtp->u.p.item_count);
  generate_error (&dtp->common, ERROR_READ_VALUE, message);

  return 1;
}


/* Reading a complex number is straightforward because we can tell
   what it is right away.  */

static void
read_complex (st_parameter_dt *dtp, int kind, size_t size)
{
  char message[100];
  char c;

  if (parse_repeat (dtp))
    return;

  c = next_char (dtp);
  switch (c)
    {
    case '(':
      break;

    CASE_SEPARATORS:
      unget_char (dtp, c);
      eat_separator (dtp);
      return;

    default:
      goto bad_complex;
    }

  eat_spaces (dtp);
  if (parse_real (dtp, dtp->u.p.value, kind))
    return;

eol_1:
  eat_spaces (dtp);
  c = next_char (dtp);
  if (c == '\n' || c== '\r')
    goto eol_1;
  else
    unget_char (dtp, c);

  if (next_char (dtp) != ',')
    goto bad_complex;

eol_2:
  eat_spaces (dtp);
  c = next_char (dtp);
  if (c == '\n' || c== '\r')
    goto eol_2;
  else
    unget_char (dtp, c);

  if (parse_real (dtp, dtp->u.p.value + size / 2, kind))
    return;

  eat_spaces (dtp);
  if (next_char (dtp) != ')')
    goto bad_complex;

  c = next_char (dtp);
  if (!is_separator (c))
    goto bad_complex;

  unget_char (dtp, c);
  eat_separator (dtp);

  free_saved (dtp);
  dtp->u.p.saved_type = BT_COMPLEX;
  return;

 bad_complex:

  if (nml_bad_return (dtp, c))
    return;

  st_sprintf (message, "Bad complex value in item %d of list input",
	      dtp->u.p.item_count);

  generate_error (&dtp->common, ERROR_READ_VALUE, message);
}


/* Parse a real number with a possible repeat count.  */

static void
read_real (st_parameter_dt *dtp, int length)
{
  char c, message[100];
  int seen_dp;

  seen_dp = 0;

  c = next_char (dtp);
  switch (c)
    {
    CASE_DIGITS:
      push_char (dtp, c);
      break;

    case '.':
      push_char (dtp, c);
      seen_dp = 1;
      break;

    case '+':
    case '-':
      goto got_sign;

    CASE_SEPARATORS:
      unget_char (dtp, c);		/* Single null.  */
      eat_separator (dtp);
      return;

    default:
      goto bad_real;
    }

  /* Get the digit string that might be a repeat count.  */

  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	CASE_DIGITS:
	  push_char (dtp, c);
	  break;

	case '.':
          if (seen_dp)
            goto bad_real;

	  seen_dp = 1;
	  push_char (dtp, c);
	  goto real_loop;

	case 'E':
	case 'e':
	case 'D':
	case 'd':
	  goto exp1;

	case '+':
	case '-':
	  push_char (dtp, 'e');
	  push_char (dtp, c);
	  c = next_char (dtp);
	  goto exp2;

	case '*':
	  push_char (dtp, '\0');
	  goto got_repeat;

	CASE_SEPARATORS:
          if (c != '\n' &&  c != ',' && c != '\r')
	    unget_char (dtp, c);
	  goto done;

	default:
	  goto bad_real;
	}
    }

 got_repeat:
  if (convert_integer (dtp, -1, 0))
    return;

  /* Now get the number itself.  */

  c = next_char (dtp);
  if (is_separator (c))
    {				/* Repeated null value.  */
      unget_char (dtp, c);
      eat_separator (dtp);
      return;
    }

  if (c != '-' && c != '+')
    push_char (dtp, '+');
  else
    {
    got_sign:
      push_char (dtp, c);
      c = next_char (dtp);
    }

  if (!isdigit (c) && c != '.')
    goto bad_real;

  if (c == '.')
    {
      if (seen_dp)
        goto bad_real;
      else
        seen_dp = 1;
    }

  push_char (dtp, c);

 real_loop:
  for (;;)
    {
      c = next_char (dtp);
      switch (c)
	{
	CASE_DIGITS:
	  push_char (dtp, c);
	  break;

	CASE_SEPARATORS:
	  goto done;

	case '.':
	  if (seen_dp)
	    goto bad_real;

	  seen_dp = 1;
	  push_char (dtp, c);
	  break;

	case 'E':
	case 'e':
	case 'D':
	case 'd':
	  goto exp1;

	case '+':
	case '-':
	  push_char (dtp, 'e');
	  push_char (dtp, c);
	  c = next_char (dtp);
	  goto exp2;

	default:
	  goto bad_real;
	}