lex.c

gcc-2.95.3 Linux下最常用的C编译器

   eighth column afterwards.  ALSO, a static var named ffelex_saw_tab_
   is set to TRUE to notify the lexer that a tab was seen.

   Columns are numbered and tab stops set as illustrated below:

   012345670123456701234567...
   x	   y	   z
   xx	   yy	   zz
   ...
   xxxxxxx yyyyyyy zzzzzzz
   xxxxxxxx	   yyyyyyyy...  */

static ffewhereColumnNumber
ffelex_image_char_ (int c, ffewhereColumnNumber column)
{
  ffewhereColumnNumber old_column = column;

  if (column >= ffelex_card_size_)
    {
      ffewhereColumnNumber newmax = ffelex_card_size_ << 1;

      if (ffelex_bad_line_)
	return column;

      if ((newmax >> 1) != ffelex_card_size_)
	{			/* Overflowed column number. */
	overflow:	/* :::::::::::::::::::: */

	  ffelex_bad_line_ = TRUE;
	  strcpy (&ffelex_card_image_[column - 3], "...");
	  ffelex_card_length_ = column;
	  ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG,
			 ffelex_linecount_current_, column + 1);
	  return column;
	}

      ffelex_card_image_
	= malloc_resize_ksr (malloc_pool_image (),
			     ffelex_card_image_,
			     newmax + 9,
			     ffelex_card_size_ + 9);
      ffelex_card_size_ = newmax;
    }

  switch (c)
    {
    case '\r':
      break;

    case '\t':
      ffelex_saw_tab_ = TRUE;
      ffelex_card_image_[column++] = ' ';
      while ((column & 7) != 0)
	ffelex_card_image_[column++] = ' ';
      break;

    case '\0':
      if (!ffelex_bad_line_)
	{
	  ffelex_bad_line_ = TRUE;
	  strcpy (&ffelex_card_image_[column], "[\\0]");
	  ffelex_card_length_ = column + 4;
	  ffebad_start_msg_lex ("Null character at %0 -- line ignored",
				FFEBAD_severityFATAL);
	  ffelex_bad_here_ (0, ffelex_linecount_current_, column + 1);
	  ffebad_finish ();
	  column += 4;
	}
      break;

    default:
      ffelex_card_image_[column++] = c;
      break;
    }

  if (column < old_column)
    {
      column = old_column;
      goto overflow;	/* :::::::::::::::::::: */
    }

  return column;
}

static void
ffelex_include_ ()
{
  ffewhereFile include_wherefile = ffelex_include_wherefile_;
  FILE *include_file = ffelex_include_file_;
  /* The rest of this is to push, and after the INCLUDE file is processed,
     pop, the static lexer state info that pertains to each particular
     input file.  */
  char *card_image;
  ffewhereColumnNumber card_size = ffelex_card_size_;
  ffewhereColumnNumber card_length = ffelex_card_length_;
  ffewhereLine current_wl = ffelex_current_wl_;
  ffewhereColumn current_wc = ffelex_current_wc_;
  bool saw_tab = ffelex_saw_tab_;
  ffewhereColumnNumber final_nontab_column = ffelex_final_nontab_column_;
  ffewhereFile current_wf = ffelex_current_wf_;
  ffewhereLineNumber linecount_current = ffelex_linecount_current_;
  ffewhereLineNumber linecount_offset
    = ffewhere_line_filelinenum (current_wl);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  int old_lineno = lineno;
  char *old_input_filename = input_filename;
#endif

  if (card_length != 0)
    {
      card_image = malloc_new_ks (malloc_pool_image (),
				  "FFELEX saved card image",
				  card_length);
      memcpy (card_image, ffelex_card_image_, card_length);
    }
  else
    card_image = NULL;

  ffelex_set_include_ = FALSE;

  ffelex_next_line_ ();

  ffewhere_file_set (include_wherefile, TRUE, 0);

#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffelex_file_push_ (old_lineno, ffewhere_file_name (include_wherefile));
#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */

  if (ffelex_include_free_form_)
    ffelex_file_free (include_wherefile, include_file);
  else
    ffelex_file_fixed (include_wherefile, include_file);

#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffelex_file_pop_ (ffewhere_file_name (current_wf));
#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */

  ffewhere_file_set (current_wf, TRUE, linecount_offset);

  ffecom_close_include (include_file);

  if (card_length != 0)
    {
#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY	/* Define if occasional large lines. */
#error "need to handle possible reduction of card size here!!"
#endif
      assert (ffelex_card_size_ >= card_length);	/* It shrunk?? */
      memcpy (ffelex_card_image_, card_image, card_length);
    }
  ffelex_card_image_[card_length] = '\0';

#if FFECOM_targetCURRENT == FFECOM_targetGCC
  input_filename = old_input_filename;
  lineno = old_lineno;
#endif
  ffelex_linecount_current_ = linecount_current;
  ffelex_current_wf_ = current_wf;
  ffelex_final_nontab_column_ = final_nontab_column;
  ffelex_saw_tab_ = saw_tab;
  ffelex_current_wc_ = current_wc;
  ffelex_current_wl_ = current_wl;
  ffelex_card_length_ = card_length;
  ffelex_card_size_ = card_size;
}

/* ffelex_is_free_char_ctx_contin_ -- Character Context Continuation?

   ffewhereColumnNumber col;
   int c;  // Char at col.
   if ((c == '&') && ffelex_is_free_char_ctx_contin_(col + 1))
       // We have a continuation indicator.

   If there are <n> spaces starting at ffelex_card_image_[col] up through
   the null character, where <n> is 0 or greater, returns TRUE.	 */

static bool
ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col)
{
  while (ffelex_card_image_[col] != '\0')
    {
      if (ffelex_card_image_[col++] != ' ')
	return FALSE;
    }
  return TRUE;
}

/* ffelex_is_free_nonc_ctx_contin_ -- Noncharacter Context Continuation?

   ffewhereColumnNumber col;
   int c;  // Char at col.
   if ((c == '&') && ffelex_is_free_nonc_ctx_contin_(col + 1))
       // We have a continuation indicator.

   If there are <n> spaces starting at ffelex_card_image_[col] up through
   the null character or '!', where <n> is 0 or greater, returns TRUE.	*/

static bool
ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col)
{
  while ((ffelex_card_image_[col] != '\0') && (ffelex_card_image_[col] != '!'))
    {
      if (ffelex_card_image_[col++] != ' ')
	return FALSE;
    }
  return TRUE;
}

static void
ffelex_next_line_ ()
{
  ffelex_linecount_current_ = ffelex_linecount_next_;
  ++ffelex_linecount_next_;
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ++lineno;
#endif
}

static void
ffelex_send_token_ ()
{
  ++ffelex_number_of_tokens_;

  ffelex_backslash_ (EOF, 0);

  if (ffelex_token_->text == NULL)
    {
      if (ffelex_token_->type == FFELEX_typeCHARACTER)
	{
	  ffelex_append_to_token_ ('\0');
	  ffelex_token_->length = 0;
	}
    }
  else
    ffelex_token_->text[ffelex_token_->length] = '\0';

  assert (ffelex_raw_mode_ == 0);

  if (ffelex_token_->type == FFELEX_typeNAMES)
    {
      ffewhere_line_kill (ffelex_token_->currentnames_line);
      ffewhere_column_kill (ffelex_token_->currentnames_col);
    }

  assert (ffelex_handler_ != NULL);
  ffelex_handler_ = (ffelexHandler) (*ffelex_handler_) (ffelex_token_);
  assert (ffelex_handler_ != NULL);

  ffelex_token_kill (ffelex_token_);

  ffelex_token_ = ffelex_token_new_ ();
  ffelex_token_->uses = 1;
  ffelex_token_->text = NULL;
  if (ffelex_raw_mode_ < 0)
    {
      ffelex_token_->type = FFELEX_typeCHARACTER;
      ffelex_token_->where_line = ffelex_raw_where_line_;
      ffelex_token_->where_col = ffelex_raw_where_col_;
      ffelex_raw_where_line_ = ffewhere_line_unknown ();
      ffelex_raw_where_col_ = ffewhere_column_unknown ();
    }
  else
    {
      ffelex_token_->type = FFELEX_typeNONE;
      ffelex_token_->where_line = ffewhere_line_unknown ();
      ffelex_token_->where_col = ffewhere_column_unknown ();
    }

  if (ffelex_set_include_)
    ffelex_include_ ();
}

/* ffelex_swallow_tokens_ -- Eat all tokens delivered to me

   return ffelex_swallow_tokens_;

   Return this handler when you don't want to look at any more tokens in the
   statement because you've encountered an unrecoverable error in the
   statement.  */

static ffelexHandler
ffelex_swallow_tokens_ (ffelexToken t)
{
  assert (ffelex_eos_handler_ != NULL);

  if ((ffelex_token_type (t) == FFELEX_typeEOS)
      || (ffelex_token_type (t) == FFELEX_typeSEMICOLON))
    return (ffelexHandler) (*ffelex_eos_handler_) (t);

  return (ffelexHandler) ffelex_swallow_tokens_;
}

static ffelexToken
ffelex_token_new_ ()
{
  ffelexToken t;

  ++ffelex_total_tokens_;

  t = (ffelexToken) malloc_new_ks (malloc_pool_image (),
				   "FFELEX token", sizeof (*t));
  t->id_ = ffelex_token_nextid_++;
  return t;
}

static const char *
ffelex_type_string_ (ffelexType type)
{
  static const char *types[] = {
    "FFELEX_typeNONE",
    "FFELEX_typeCOMMENT",
    "FFELEX_typeEOS",
    "FFELEX_typeEOF",
    "FFELEX_typeERROR",
    "FFELEX_typeRAW",
    "FFELEX_typeQUOTE",
    "FFELEX_typeDOLLAR",
    "FFELEX_typeHASH",
    "FFELEX_typePERCENT",
    "FFELEX_typeAMPERSAND",
    "FFELEX_typeAPOSTROPHE",
    "FFELEX_typeOPEN_PAREN",
    "FFELEX_typeCLOSE_PAREN",
    "FFELEX_typeASTERISK",
    "FFELEX_typePLUS",
    "FFELEX_typeMINUS",
    "FFELEX_typePERIOD",
    "FFELEX_typeSLASH",
    "FFELEX_typeNUMBER",
    "FFELEX_typeOPEN_ANGLE",
    "FFELEX_typeEQUALS",
    "FFELEX_typeCLOSE_ANGLE",
    "FFELEX_typeNAME",
    "FFELEX_typeCOMMA",
    "FFELEX_typePOWER",
    "FFELEX_typeCONCAT",
    "FFELEX_typeDEBUG",
    "FFELEX_typeNAMES",
    "FFELEX_typeHOLLERITH",
    "FFELEX_typeCHARACTER",
    "FFELEX_typeCOLON",
    "FFELEX_typeSEMICOLON",
    "FFELEX_typeUNDERSCORE",
    "FFELEX_typeQUESTION",
    "FFELEX_typeOPEN_ARRAY",
    "FFELEX_typeCLOSE_ARRAY",
    "FFELEX_typeCOLONCOLON",
    "FFELEX_typeREL_LE",
    "FFELEX_typeREL_NE",
    "FFELEX_typeREL_EQ",
    "FFELEX_typePOINTS",
    "FFELEX_typeREL_GE"
  };

  if (type >= ARRAY_SIZE (types))
    return "???";
  return types[type];
}

void
ffelex_display_token (ffelexToken t)
{
  if (t == NULL)
    t = ffelex_token_;

  fprintf (dmpout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %"
	   ffewhereColumnNumber_f "u)",
	   t->id_,
	   ffelex_type_string_ (t->type),
	   ffewhere_line_number (t->where_line),
	   ffewhere_column_number (t->where_col));

  if (t->text != NULL)
    fprintf (dmpout, ": \"%.*s\"\n",
	     (int) t->length,
	     t->text);
  else
    fprintf (dmpout, ".\n");
}

/* ffelex_expecting_character -- Tells if next token expected to be CHARACTER

   if (ffelex_expecting_character())
       // next token delivered by lexer will be CHARACTER.

   If the most recent call to ffelex_set_expecting_hollerith since the last
   token was delivered by the lexer passed a length of -1, then we return
   TRUE, because the next token we deliver will be typeCHARACTER, else we
   return FALSE.  */

bool
ffelex_expecting_character ()
{
  return (ffelex_raw_mode_ != 0);
}

/* ffelex_file_fixed -- Lex a given file in fixed source form

   ffewhere wf;
   FILE *f;
   ffelex_file_fixed(wf,f);

   Lexes the file according to Fortran 90 ANSI + VXT specifications.  */

ffelexHandler
ffelex_file_fixed (ffewhereFile wf, FILE *f)
{
  register int c = 0;		/* Character currently under consideration. */
  register ffewhereColumnNumber column = 0;	/* Not really; 0 means column 1... */
  bool disallow_continuation_line;
  bool ignore_disallowed_continuation = FALSE;
  int latest_char_in_file = 0;	/* For getting back into comment-skipping
				   code. */
  ffelexType lextype;
  ffewhereColumnNumber first_label_char;	/* First char of label --
						   column number. */
  char label_string[6];		/* Text of label. */
  int labi;			/* Length of label text. */
  bool finish_statement;	/* Previous statement finished? */
  bool have_content;		/* This line have content? */
  bool just_do_label;		/* Nothing but label (and continuation?) on
				   line. */

  /* Lex is called for a particular file, not for a particular program unit.
     Yet the two events do share common characteristics.  The first line in a
     file or in a program unit cannot be a continuation line.  No token can
     be in mid-formation.  No current label for the statement exists, since
     there is no current statement. */

  assert (ffelex_handler_ != NULL);

#if FFECOM_targetCURRENT == FFECOM_targetGCC
  lineno = 0;
  input_filename = ffewhere_file_name (wf);
#endif
  ffelex_current_wf_ = wf;
  disallow_continuation_line = TRUE;
  ignore_disallowed_continuation = FALSE;
  ffelex_token_->type = FFELEX_typeNONE;
  ffelex_number_of_tokens_ = 0;
  ffelex_label_tokens_ = 0;
  ffelex_current_wl_ = ffewhere_line_unknown ();
  ffelex_current_wc_ = ffewhere_column_unknown ();
  latest_char_in_file = '\n';

  if (ffe_is_null_version ())
    {
      /* Just substitute a "program" directly here.  */

      char line[] = "      call g77__fvers;call g77__ivers;call g77__uvers;end";
      char *p;

      column = 0;
      for (p = &line[0]; *p != '\0'; ++p)
	column = ffelex_image_char_ (*p, column);

      c = EOF;

      goto have_line;		/* :::::::::::::::::::: */
    }

  goto first_line;		/* :::::::::::::::::::: */

  /* Come here to get a new line. */

 beginning_of_line:		/* :::::::::::::::::::: */

  disallow_continuation_line = FALSE;

  /* Come here directly when last line didn't clarify the continuation issue. */

 beginning_of_line_again:	/* :::::::::::::::::::: */

#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY	/* Define if occasional large lines. */
  if (ffelex_card_size_ != FFELEX_columnINITIAL_SIZE_)
    {
      ffelex_card_image_
	= malloc_resize_ks (malloc_pool_image (),
			    ffelex_card_image_,
			    FFELEX_columnINITIAL_SIZE_ + 9,
			    ffelex_card_size_ + 9);
      ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
    }
#endif