/* lex.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995 Free Software Foundation, Inc.
   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).

This file is part of GNU Fortran.

GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Fortran; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

   Related Modules:
      lex.c

   Description:
      Lexer and parse-task manager for Fortran 77.

   Modifications:
*/

/* Include files. */

#include "proj.h"
#include <ctype.h>
#include "top.h"
#include "bad.h"
#include "lex.h"
#include "malloc.h"
#include "src.h"

/* Externals defined here. */


/* Simple definitions and enumerations. */

#define FFELEX_columnINITIAL_SIZE_ 160
#define FFELEX_columnMAX_ERROR_ 80	/* Change ffelex_buncha_spaces_
					   accordingly. */
#define FFELEX_columnTOKEN_SIZE_ 40	/* Must be >= FFEWHERE_indexMAX. */
#define FFELEX_FREE_MAX_COLUMNS_ 132	/* ANSI 90 spec for free-form width. */
#define FFELEX_sizeUNNEEDED_TEXT_ 3	/* Number of useless bytes to
					   allocate. */

/* Internal typedefs. */


/* Private include files. */


/* Internal structure definitions. */


/* Static objects accessed by functions in this module. */

static ffewhereColumnNumber ffelex_final_nontab_column_;	/* 72 or 132. */
static ffelexType ffelex_first_char_[256];
static char *ffelex_card_image_;/* Current size is ffelex_max_columns_. */
static bool ffelex_saw_tab_;	/* True if we saw a tab on the current line. */
static FILE *ffelex_include_file_;	/* File to start reading from. */
static ffewhereFile ffelex_include_wherefile_;
static ffewhereColumnNumber ffelex_max_columns_;	/* Expand these when
							   needed. */
static ffewhereColumnNumber ffelex_card_length_;	/* Active length of card
							   image. */
static ffewhereLineNumber ffelex_linecount_;	/* Master line count. */
static long int ffelex_raw_mode_;	/* -1 means char const, 0 means ignore
					   spaces, >0 means that many chars left in
					   hollerith const. */
static char ffelex_raw_char_;	/* Either apostrophe or double-quote. */
static ffelexToken ffelex_token_ = NULL;	/* Current token being built. */
static ffelexHandler ffelex_handler_;
static bool ffelex_strict_ansi_;
static bool ffelex_names_;	/* Have fixed-form lexer generate NAMES, not
				   NAME. */
static bool ffelex_names_pure_;	/* Have both lexers generate NAMES, not NAME. */
static bool ffelex_raw_include_;/* raw_mode in INCLUDE context. */
static bool ffelex_hollerith_include_;	/* Copy to raw_include if hollerith. */
static bool ffelex_set_include_;/* Set TRUE by ffelex_set_include. */
static bool ffelex_permit_include_;	/* Must be TRUE when _set_include
					   called. */
static bool ffelex_include_free_form_;	/* TRUE means INCLUDE file is
					   free-form. */
static bool ffelex_hexnum_;	/* 0-9 starts NAME (hex number), not NUMBER. */
static long int ffelex_expecting_hollerith_;
static unsigned long int ffelex_number_of_tokens_;
static int ffelex_label_tokens_;/* # labels sent as NUMBERs (either 0 or 1). */
static ffewhereLine ffelex_latest_line_;
static ffewhereColumn ffelex_latest_col_;
static ffelexHandler ffelex_eos_handler_;	/* For
						   ffelex_swallow_tokens(_). */
static ffewhereLine ffelex_raw_where_line_;	/* For CHARACTER/HOLLERITH
						   tokens. */
static ffewhereColumn ffelex_raw_where_col_;	/* " */
static long int ffelex_total_tokens_ = 0;
static long int ffelex_old_total_tokens_ = 1;
static long int ffelex_token_nextid_ = 0;	/* DEBUG ONLY. */

/* Static functions (internal). */

static void ffelex_append_to_token_ (char c);
static void ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0,
			   ffewhereColumnNumber cn0);
static void ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0,
ffewhereColumnNumber cn0, ffewhereLineNumber ln1, ffewhereColumnNumber cn1);
#if 0
static void ffelex_display_token_ (void);
#endif
static void ffelex_finish_statement_ (void);
static ffewhereColumnNumber ffelex_image_char_ (int c,
						ffewhereColumnNumber col);
static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col);
static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col);
static void ffelex_send_token_ (void);
static ffelexHandler ffelex_swallow_tokens_ (ffelexToken t);
static ffelexToken ffelex_token_new_ (void);
#if 0
static char *ffelex_type_string_ (ffelexType t);
#endif

/* Internal macros. */


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_++;	/* DEBUG ONLY. */
  return t;
}

/* 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;		/* Character currently under consideration. */
  register ffewhereColumnNumber column;	/* Not really; 0 means column 1... */
  bool disallow_continuation_line;
  bool ignore_disallowed_continuation;
  int last_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 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);

  disallow_continuation_line = TRUE;
  ignore_disallowed_continuation = FALSE;
  ffelex_token_->type = FFELEX_typeNONE;
  ffelex_number_of_tokens_ = 0;
  ffelex_latest_line_ = ffewhere_line_unknown ();
  ffelex_latest_col_ = ffewhere_column_unknown ();
  c = getc (f);
  if (c == EOF)
    return (ffelexHandler) ffelex_handler_;
  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_max_columns_ != FFELEX_columnINITIAL_SIZE_)
    {
      ffelex_card_image_
	= malloc_resize_ks (malloc_pool_image (),
			    ffelex_card_image_,
			    FFELEX_columnINITIAL_SIZE_ + 1,
			    ffelex_max_columns_ + 1);
      ffelex_max_columns_ = FFELEX_columnINITIAL_SIZE_;
    }
#endif

  ++ffelex_linecount_;

  if (ffelex_set_include_)
    {
      ffewhereFile iwf = ffelex_include_wherefile_;
      FILE *ifi = ffelex_include_file_;

      ffewhere_line_kill (ffelex_latest_line_);
      ffewhere_column_kill (ffelex_latest_col_);

      ffelex_set_include_ = FALSE;
      ffewhere_file_begin (wf, iwf);
      if (ffelex_include_free_form_)
	ffelex_file_free (iwf, ifi);
      else
	ffelex_file_fixed (iwf, ifi);
      ffewhere_file_end (iwf, wf);
      fclose (ifi);

      ffelex_latest_line_ = ffewhere_line_unknown ();
      ffelex_latest_col_ = ffewhere_column_unknown ();
    }

  c = last_char_in_file;
  if ((c == EOF) || ((c = getc (f)) == EOF))
    {

    end_of_file:		/* :::::::::::::::::::: */

      ffelex_finish_statement_ ();
      ffewhere_line_kill (ffelex_latest_line_);
      ffewhere_column_kill (ffelex_latest_col_);
      return (ffelexHandler) ffelex_handler_;
      /* Line ending in EOF instead of \n still counts as a whole line. */
    }

 first_line:			/* :::::::::::::::::::: */

  /* Skip over comment (and otherwise ignored) lines as quickly as possible! */

  while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT)
	 || (lextype == FFELEX_typeERROR)
	 || (lextype == FFELEX_typeSLASH))
    {
      if (lextype == FFELEX_typeERROR)
	{			/* Bad first character, get line and display
				   it with message. */
	  column = ffelex_image_char_ (c, 0);

	bad_first_character:	/* :::::::::::::::::::: */

	  while (((c = getc (f)) != '\n') && (c != EOF))
	    {
	      if (column < FFELEX_columnMAX_ERROR_)
		column = ffelex_image_char_ (c, column);
	    }
	  ffelex_card_image_[column] = '\0';
	  ffelex_card_length_ = column;
	  ffelex_bad_1_ (FFEBAD_FIRST_CHAR_INVALID, ffelex_linecount_, 1);
	}
      else if ((lextype == FFELEX_typeSLASH) && ((c = getc (f)) != '*'))
	{
	  ffelex_card_image_[0] = '/';
	  ffelex_card_image_[1] = c;
	  column = 2;
	  goto bad_first_character;	/* :::::::::::::::::::: */
	}
      else
	/* Typical case (straight comment), just ignore rest of line. */
	{

	 comment_line:		/* :::::::::::::::::::: */

	  while ((c != '\n') && (c != EOF))
	    c = getc (f);
	}

      /* Read past last char in line.  */

      if (c == EOF)
	{
	  ++ffelex_linecount_;
	  ffelex_finish_statement_ ();
	  ffewhere_line_kill (ffelex_latest_line_);
	  ffewhere_column_kill (ffelex_latest_col_);
	  return (ffelexHandler) ffelex_handler_;
	}

      c = getc (f);
      ++ffelex_linecount_;
      if (c == EOF)
	goto end_of_file;	/* :::::::::::::::::::: */
    }				/* while [c, first char, means comment] */

  ffelex_saw_tab_ = FALSE;

  if (lextype == FFELEX_typeDEBUG)
    c = ' ';			/* A 'D' or 'd' in column 1 with the
				   debug-lines option on. */

  column = ffelex_image_char_ (c, 0);

  /* Read the entire line in as is (with whitespace processing).  */

  while (((c = getc (f)) != '\n') && (c != EOF))
    {
      if (column >= ffelex_max_columns_)
	{
	  ffewhereColumnNumber newmax = ffelex_max_columns_ << 1;

	  if (newmax <= ffelex_max_columns_)
	    {			/* Overflowed column number. */
	      ffelex_card_image_[column] = '\0';
	      ffelex_card_length_ = column;
	      ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG, ffelex_linecount_,
			     column + 1);
	      goto comment_line;	/* :::::::::::::::::::: */
	    }

	  ffelex_card_image_
	    = malloc_resize_ksr (malloc_pool_image (),
				 ffelex_card_image_,
				 newmax + 1,
				 ffelex_max_columns_ + 1);
	  ffelex_max_columns_ = newmax;
	}
      column = ffelex_image_char_ (c, column);
    }

  /* If no tab, cut off line after column 72/132.  */

  if (!ffelex_saw_tab_ && (column > ffelex_final_nontab_column_))
    {
      /* Technically, we should now fill ffelex_card_image_ up thru column
         72/132 with spaces, since character/hollerith constants must count
         them in that manner. To save CPU time in several ways (avoid a loop
         here that would be used only when we actually end a line in
         character-constant mode; avoid writing memory unnecessarily; avoid a
         loop later checking spaces when not scanning for character-constant
         characters), we don't do this, and we do the appropriate thing when
         we encounter end-of-line while actually processing a character
         constant. */

      column = ffelex_final_nontab_column_;
    }
  ffelex_card_image_[column] = '\0';
  ffelex_card_length_ = column;

  /* Save next char in file so we can use register-based c while analyzing
     line we just read. */

  last_char_in_file = c;	/* Should be either '\n' or EOF. */

  /* Handle label, if any. */

  labi = 0;
  first_label_char = FFEWHERE_columnUNKNOWN;
  for (column = 0; column < 5; ++column)
    {
      switch (c = ffelex_card_image_[column])
	{
	case '\0':
	case '!':
	  goto stop_looking;	/* :::::::::::::::::::: */

	case ' ':
	  break;

	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	  label_string[labi++] = c;
	  if (first_label_char == FFEWHERE_columnUNKNOWN)
	    first_label_char = column + 1;
	  break;

	case '/':
	  if (ffelex_card_image_[column + 1] == '*')
	    goto stop_looking;	/* :::::::::::::::::::: */
	  /* Fall through. */
	default:
	  ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC, ffelex_linecount_,
			 column + 1);
	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
	}
    }

stop_looking:			/* :::::::::::::::::::: */

  label_string[labi] = '\0';

  /* Find first nonblank char starting with continuation column. */

  if (column == 5)		/* In which case we didn't see end of line in
				   label field. */
    while ((c = ffelex_card_image_[column]) == ' ')
      ++column;

  /* Now we're trying to figure out whether this is a continuation line and
     whether there's anything else of substance on the line.  The cases are
     as follows:

     1. If a line has an explicit continuation character (other than the digit
     zero), then if it also has a label, the label is ignored and an error
     message is printed.  Any remaining text on the line is passed to the
     parser tasks, thus even an all-blank line (possibly with an ignored
     label) aside from a positive continuation character might have meaning
     in the midst of a character or hollerith constant.

     2. If a line has no explicit continuation character (a space in column 6
     and first non-blank character past column 6 is not a digit 0-9), then
     there are two possibilities:

     A. A label is present and/or a non-blank (and non-comment) character
     appears somewhere after column 6.	Terminate processing of the previous
     statement, if any, send the new label for the next statement, if any,
     and start processing a new statement with this non-blank character, if
     any.

     B. The line is essentially blank, except for a possible comment character.
     Don't terminate processing of the previous statement and don't pass any
     characters to the parser tasks, since the line is not flagged as a
     continuation line.	 We treat it just like a completely blank line.

     3. If a line has a continuation character of zero (0), then we terminate
     processing of the previous statement, if any, send the new label for the
     next statement, if any, and start processing a new statement, if any
     non-blank characters are present.

     If, when checking to see if we should terminate the previous statement, it
     is found that there is no previous statement but that there is an
     outstanding label, substitute CONTINUE as the statement for the label
     and display an error message. */

  just_do_label = FALSE;
  switch (c)
    {
    case '!':			/* ANSI Fortran 90 says ! in column 6 is
				   continuation. */
      /* VXT Fortran says ! anywhere is comment, even column 6. */
      if (ffe_is_vxt_not_90 () || (column != 5))
	goto no_tokens_on_line;	/* :::::::::::::::::::: */
      goto got_a_continuation;	/* :::::::::::::::::::: */

    case '/':
      if (ffelex_card_image_[column + 1] != '*')
	goto some_other_character;	/* :::::::::::::::::::: */
      /* Fall through. */
      if (column == 5)
	goto got_a_continuation;/* :::::::::::::::::::: */
      /* This seems right to do. But it is close to call, since / * starting
         in column 6 will thus be interpreted as a continuation line
         beginning with '*'. */
      /* Fall through. */
    case '\0':
      /* End of line.  Therefore may be continued-through line, so handle
         pending label as possible to-be-continued and drive end-of-statement
         for any previous statement, else treat as blank line. */

    no_tokens_on_line:		/* :::::::::::::::::::: */

      if (first_label_char != FFEWHERE_columnUNKNOWN)
	{			/* Can't be a continued-through line if it
				   has a label. */
	  ffelex_finish_statement_ ();
	  if (ffelex_strict_ansi_ && (c == '/'))
	    ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ffelex_linecount_,
			   column + 1);
	  just_do_label = TRUE;
	  break;
	}
      if (ffelex_strict_ansi_ && (c == '/'))
	ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ffelex_linecount_,
		       column + 1);
      goto beginning_of_line_again;	/* :::::::::::::::::::: */

    case '0':
      ffelex_finish_statement_ ();
      if (ffelex_strict_ansi_ && (column != 5))
	ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, ffelex_linecount_,
		       column + 1);
      while ((c = ffelex_card_image_[++column]) == ' ')
	;
      if ((c == '\0')
	  || (c == '!')
	  || ((c == '/')
	      && (ffelex_card_image_[column + 1] == '*')))
	{
	  if (ffelex_strict_ansi_ && (c == '/'))
	    ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ffelex_linecount_,
			   column + 1);
	  just_do_label = TRUE;
	}
      break;

    case '1':
    case '2':
    case '3':
    case '4':
    case '5':
    case '6':
    case '7':
    case '8':
    case '9':
      if (first_label_char != FFEWHERE_columnUNKNOWN)
	{
	  ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION, ffelex_linecount_,
			 first_label_char, ffelex_linecount_, column + 1);
	  first_label_char = FFEWHERE_columnUNKNOWN;
	}
      if (disallow_continuation_line)
	{
	  if (!ignore_disallowed_continuation)
	    ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION, ffelex_linecount_,
			   column + 1);
	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
	}
      if (ffelex_strict_ansi_ && (column != 5))
	ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, ffelex_linecount_,
		       column + 1);
      if ((ffelex_raw_mode_ != 0)
	  && (((c = ffelex_card_image_[column + 1]) != '\0')
	      || !ffelex_saw_tab_))
	{
	  ++column;
	  break;
	}
      while ((c = ffelex_card_image_[++column]) == ' ')
	;
      if ((c == '\0')
	  || (c == '!')
	  || ((c == '/')
	      && (ffelex_card_image_[column + 1] == '*')))
	{
	  if (ffelex_strict_ansi_ && (c == '/'))
	    ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ffelex_linecount_,
			   column + 1);
	  just_do_label = TRUE;
	}
      break;

    default:

    some_other_character:	/* :::::::::::::::::::: */

      if (column == 5)
	{

	got_a_continuation:	/* :::::::::::::::::::: */

	  if (first_label_char != FFEWHERE_columnUNKNOWN)
	    {
	      ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION, ffelex_linecount_,
			   first_label_char, ffelex_linecount_, column + 1);
	      first_label_char = FFEWHERE_columnUNKNOWN;
	    }
	  if (disallow_continuation_line)
	    {
	      if (!ignore_disallowed_continuation)
		ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION, ffelex_linecount_,
			       column + 1);
	      goto beginning_of_line;	/* :::::::::::::::::::: */
	    }
	  if ((ffelex_raw_mode_ != 0)
	      && (((c = ffelex_card_image_[column + 1]) != '\0')
		  || !ffelex_saw_tab_))
	    {
	      ++column;
	      break;
	    }
	  while ((c = ffelex_card_image_[++column]) == ' ')
	    ;
	  if ((c == '\0')
	      || (c == '!')
	      || ((c == '/')
		  && (ffelex_card_image_[column + 1] == '*')))
	    {
	      if (ffelex_strict_ansi_ && (c == '/'))
		ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT, ffelex_linecount_,
			       column + 1);
	      just_do_label = TRUE;
	    }
	  break;
	}

      /* Here is the very normal case of a regular character starting in
         column 7 or beyond with a blank in column 6. */

      ffelex_finish_statement_ ();
      break;
    }

  /* If label is present, enclose it in a NUMBER token and send it along. */

  if (first_label_char != FFEWHERE_columnUNKNOWN)
    {
      assert (ffelex_token_->type == FFELEX_typeNONE);
      ffelex_token_->type = FFELEX_typeNUMBER;
      strcpy (ffelex_token_->text, label_string);
      ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
      ffelex_token_->where_col = ffewhere_column_new (first_label_char);
      ffelex_token_->length = labi;
      ffelex_send_token_ ();
      ++ffelex_label_tokens_;
    }

  /* The line definitely has content of some kind, install new end-statement
     point for error messages. */

  ffewhere_line_kill (ffelex_latest_line_);
  ffewhere_column_kill (ffelex_latest_col_);
  ffelex_latest_line_ = ffewhere_line_new (ffelex_linecount_);
  ffelex_latest_col_ = ffewhere_column_new (ffelex_card_length_ + 1);

  if (just_do_label)
    goto beginning_of_line;	/* :::::::::::::::::::: */

  /* Here is the main engine for parsing.  c holds the character at column.
     It is already known that c is not a blank, end of line, or shriek,
     unless ffelex_raw_mode_ is not 0 (indicating we are in a
     character/hollerith constant). A partially filled token may already
     exist in ffelex_token_.  One special case: if, when the end of the line
     is reached, continuation_line is FALSE and the only token on the line is
     END, then it is indeed the last statement. We don't look for
     continuation lines during this program unit in that case. This is
     according to ANSI. */

  if (ffelex_raw_mode_ != 0)
    {

    parse_raw_character:	/* :::::::::::::::::::: */

      if (c == '\0')
	{
	  ffewhereColumnNumber i;

	  if (ffelex_saw_tab_ || (column >= ffelex_final_nontab_column_))
	    {
	      if (!ffelex_raw_include_)
		goto beginning_of_line;	/* :::::::::::::::::::: */
	      ffelex_permit_include_ = TRUE;
	      ffelex_finish_statement_ ();
	      ffelex_permit_include_ = FALSE;
	      disallow_continuation_line = TRUE;
	      ignore_disallowed_continuation = FALSE;
	      goto beginning_of_line_again;	/* :::::::::::::::::::: */
	    }

	  /* Pad out line with "virtual" spaces. */

	  for (i = column; i < ffelex_final_nontab_column_; ++i)
	    ffelex_card_image_[i] = ' ';
	  ffelex_card_image_[i] = '\0';
	  ffelex_card_length_ = i;
	  c = ' ';
	}

      switch (ffelex_raw_mode_)
	{
	case -2:
	  if (c == ffelex_raw_char_)
	    {
	      ffelex_raw_mode_ = -1;
	      ffelex_append_to_token_ (c);
	    }
	  else
	    {
	      ffelex_raw_mode_ = 0;
	      if (!ffe_is_90 () && (ffelex_token_->length == 0))
		{
		  ffelex_append_to_token_ (' ');
		  ffebad_start_lex (FFEBAD_NULL_CHAR_CONST);
		  ffebad_here (0, ffelex_token_->where_line,
			       ffelex_token_->where_col);
		  ffebad_finish ();
		}
	      ffelex_send_token_ ();
	      assert (ffelex_raw_mode_ == 0);
	      while (c == ' ')
		c = ffelex_card_image_[++column];
	      if ((c == '\0') || (c == '!') || ((c == '/')
				&& (ffelex_card_image_[column + 1] == '*')))
		{
		  if (!ffelex_raw_include_)
		    goto beginning_of_line;	/* :::::::::::::::::::: */
		  ffelex_permit_include_ = TRUE;
		  ffelex_finish_statement_ ();
		  ffelex_permit_include_ = FALSE;
		  disallow_continuation_line = TRUE;
		  ignore_disallowed_continuation = FALSE;
		  goto beginning_of_line_again;	/* :::::::::::::::::::: */
		}
	      goto parse_nonraw_character;	/* :::::::::::::::::::: */
	    }
	  break;

	case -1:
	  if (c == ffelex_raw_char_)
	    ffelex_raw_mode_ = -2;
	  else
	    ffelex_append_to_token_ (c);
	  break;

	default:
	  ffelex_append_to_token_ (c);
	  if (--ffelex_raw_mode_ == 0)
	    {
	      ffelex_send_token_ ();
	      c = ffelex_card_image_[++column];
	      assert (ffelex_raw_mode_ == 0);
	      while (c == ' ')
		c = ffelex_card_image_[++column];
	      if ((c == '\0') || (c == '!') || ((c == '/')
				&& (ffelex_card_image_[column + 1] == '*')))
		{
		  if (!ffelex_raw_include_)
		    goto beginning_of_line;	/* :::::::::::::::::::: */
		  ffelex_permit_include_ = TRUE;
		  ffelex_finish_statement_ ();
		  ffelex_permit_include_ = FALSE;
		  disallow_continuation_line = TRUE;
		  ignore_disallowed_continuation = FALSE;
		  goto beginning_of_line_again;	/* :::::::::::::::::::: */
		}
	      goto parse_nonraw_character;	/* :::::::::::::::::::: */
	    }
	  break;
	}
      c = ffelex_card_image_[++column];
      goto parse_raw_character;	/* :::::::::::::::::::: */
    }

parse_nonraw_character:	/* :::::::::::::::::::: */

  switch (ffelex_token_->type)
    {
    case FFELEX_typeNONE:
      switch (c)
	{
	case '\"':
	  ffelex_token_->type = FFELEX_typeQUOTE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '$':
	  ffelex_token_->type = FFELEX_typeDOLLAR;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '%':
	  ffelex_token_->type = FFELEX_typePERCENT;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '&':
	  ffelex_token_->type = FFELEX_typeAMPERSAND;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '\'':
	  ffelex_token_->type = FFELEX_typeAPOSTROPHE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '(':
	  ffelex_token_->type = FFELEX_typeOPEN_PAREN;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case ')':
	  ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '*':
	  ffelex_token_->type = FFELEX_typeASTERISK;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '+':
	  ffelex_token_->type = FFELEX_typePLUS;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case ',':
	  ffelex_token_->type = FFELEX_typeCOMMA;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '-':
	  ffelex_token_->type = FFELEX_typeMINUS;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '.':
	  ffelex_token_->type = FFELEX_typePERIOD;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '/':
	  ffelex_token_->type = FFELEX_typeSLASH;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	  ffelex_token_->text[0] = c;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_token_->length = 1;
	  ffelex_token_->type
	    = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
	  break;

	case ':':
	  ffelex_token_->type = FFELEX_typeCOLON;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case ';':
	  ffelex_token_->type = FFELEX_typeSEMICOLON;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '<':
	  ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '=':
	  ffelex_token_->type = FFELEX_typeEQUALS;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '>':
	  ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '?':
	  ffelex_token_->type = FFELEX_typeQUESTION;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '_':
	  if (ffe_is_90 ())
	    {
	      ffelex_token_->type = FFELEX_typeUNDERSCORE;
	      ffelex_token_->where_line
		= ffewhere_line_new (ffelex_linecount_);
	      ffelex_token_->where_col
		= ffewhere_column_new (column + 1);
	      ffelex_send_token_ ();
	      break;
	    }
	  /* Fall through. */
	case 'A':
	case 'B':
	case 'C':
	case 'D':
	case 'E':
	case 'F':
	case 'G':
	case 'H':
	case 'I':
	case 'J':
	case 'K':
	case 'L':
	case 'M':
	case 'N':
	case 'O':
	case 'P':
	case 'Q':
	case 'R':
	case 'S':
	case 'T':
	case 'U':
	case 'V':
	case 'W':
	case 'X':
	case 'Y':
	case 'Z':
	case 'a':
	case 'b':
	case 'c':
	case 'd':
	case 'e':
	case 'f':
	case 'g':
	case 'h':
	case 'i':
	case 'j':
	case 'k':
	case 'l':
	case 'm':
	case 'n':
	case 'o':
	case 'p':
	case 'q':
	case 'r':
	case 's':
	case 't':
	case 'u':
	case 'v':
	case 'w':
	case 'x':
	case 'y':
	case 'z':
	  c = ffesrc_char_source (c);

	  if (ffesrc_char_match_init (c, 'H', 'h')
	      && ffelex_expecting_hollerith_ != 0)
	    {
	      ffelex_raw_mode_ = ffelex_expecting_hollerith_;
	      ffelex_raw_include_ = ffelex_hollerith_include_;
	      ffelex_token_->type = FFELEX_typeHOLLERITH;
	      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 ();
	      c = ffelex_card_image_[++column];
	      goto parse_raw_character;	/* :::::::::::::::::::: */
	    }

	  ffelex_token_->text[0] = c;
	  ffelex_token_->length = 1;
	  if (ffelex_names_)
	    {
	      ffelex_token_->where_line = ffewhere_line_use
		(ffelex_token_->currentnames_line = ffewhere_line_new
		 (ffelex_linecount_));
	      ffelex_token_->where_col = ffewhere_column_use
		(ffelex_token_->currentnames_col = ffewhere_column_new
		 (column + 1));
	      ffelex_token_->type = FFELEX_typeNAMES;
	    }
	  else
	    {
	      ffelex_token_->where_line
		= ffewhere_line_new (ffelex_linecount_);
	      ffelex_token_->where_col = ffewhere_column_new (column + 1);
	      ffelex_token_->type = FFELEX_typeNAME;
	    }
	  break;

	default:
	  ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER, ffelex_linecount_,
			 column + 1);
	  ffelex_permit_include_ = TRUE;
	  ffelex_finish_statement_ ();
	  ffelex_permit_include_ = FALSE;
	  disallow_continuation_line = TRUE;
	  ignore_disallowed_continuation = TRUE;
	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeNAME:
      switch (c)
	{
	case 'A':
	case 'B':
	case 'C':
	case 'D':
	case 'E':
	case 'F':
	case 'G':
	case 'H':
	case 'I':
	case 'J':
	case 'K':
	case 'L':
	case 'M':
	case 'N':
	case 'O':
	case 'P':
	case 'Q':
	case 'R':
	case 'S':
	case 'T':
	case 'U':
	case 'V':
	case 'W':
	case 'X':
	case 'Y':
	case 'Z':
	case 'a':
	case 'b':
	case 'c':
	case 'd':
	case 'e':
	case 'f':
	case 'g':
	case 'h':
	case 'i':
	case 'j':
	case 'k':
	case 'l':
	case 'm':
	case 'n':
	case 'o':
	case 'p':
	case 'q':
	case 'r':
	case 's':
	case 't':
	case 'u':
	case 'v':
	case 'w':
	case 'x':
	case 'y':
	case 'z':
	  c = ffesrc_char_source (c);
	  /* Fall through.  */
	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	case '_':
	case '$':
	  if ((c == '$')
	      && !ffe_is_dollar_ok ())
	    {
	      ffelex_send_token_ ();
	      goto parse_next_character;	/* :::::::::::::::::::: */
	    }
	  ffelex_append_to_token_ (c);
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeNAMES:
      switch (c)
	{
	case 'A':
	case 'B':
	case 'C':
	case 'D':
	case 'E':
	case 'F':
	case 'G':
	case 'H':
	case 'I':
	case 'J':
	case 'K':
	case 'L':
	case 'M':
	case 'N':
	case 'O':
	case 'P':
	case 'Q':
	case 'R':
	case 'S':
	case 'T':
	case 'U':
	case 'V':
	case 'W':
	case 'X':
	case 'Y':
	case 'Z':
	case 'a':
	case 'b':
	case 'c':
	case 'd':
	case 'e':
	case 'f':
	case 'g':
	case 'h':
	case 'i':
	case 'j':
	case 'k':
	case 'l':
	case 'm':
	case 'n':
	case 'o':
	case 'p':
	case 'q':
	case 'r':
	case 's':
	case 't':
	case 'u':
	case 'v':
	case 'w':
	case 'x':
	case 'y':
	case 'z':
	  c = ffesrc_char_source (c);
	  /* Fall through.  */
	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	case '_':
	case '$':
	  if ((c == '$')
	      && !ffe_is_dollar_ok ())
	    {
	      ffelex_send_token_ ();
	      goto parse_next_character;	/* :::::::::::::::::::: */
	    }
	  if (ffelex_token_->length < FFEWHERE_indexMAX)
	    {
	      ffewhere_track (&ffelex_token_->currentnames_line,
			      &ffelex_token_->currentnames_col,
			      ffelex_token_->wheretrack,
		      ffelex_token_->length, ffelex_linecount_, column + 1);
	      ffelex_token_->text[ffelex_token_->length++] = c;
	    }
	  else
	    ffelex_append_to_token_ (c);
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

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

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeASTERISK:
      switch (c)
	{
	case '*':		/* ** */
	  ffelex_token_->type = FFELEX_typePOWER;
	  ffelex_send_token_ ();
	  break;

	default:		/* * not followed by another *. */
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeCOLON:
      switch (c)
	{
	case ':':		/* :: */
	  ffelex_token_->type = FFELEX_typeCOLONCOLON;
	  ffelex_send_token_ ();
	  break;

	default:		/* : not followed by another :. */
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeSLASH:
      switch (c)
	{
	case '/':		/* // */
	  ffelex_token_->type = FFELEX_typeCONCAT;
	  ffelex_send_token_ ();
	  break;

	case ')':		/* /) */
	  ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
	  ffelex_send_token_ ();
	  break;

	case '=':		/* /= */
	  ffelex_token_->type = FFELEX_typeREL_NE;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeOPEN_PAREN:
      switch (c)
	{
	case '/':		/* (/ */
	  ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeOPEN_ANGLE:
      switch (c)
	{
	case '=':		/* <= */
	  ffelex_token_->type = FFELEX_typeREL_LE;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeEQUALS:
      switch (c)
	{
	case '=':		/* == */
	  ffelex_token_->type = FFELEX_typeREL_EQ;
	  ffelex_send_token_ ();
	  break;

	case '>':		/* => */
	  ffelex_token_->type = FFELEX_typePOINTS;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeCLOSE_ANGLE:
      switch (c)
	{
	case '=':		/* >= */
	  ffelex_token_->type = FFELEX_typeREL_GE;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    default:
      assert ("Serious error!!" == NULL);
      abort ();
      break;
    }

  c = ffelex_card_image_[++column];

parse_next_character:		/* :::::::::::::::::::: */

  if (ffelex_raw_mode_ != 0)
    goto parse_raw_character;	/* :::::::::::::::::::: */

  while (c == ' ')
    c = ffelex_card_image_[++column];

  if ((c == '\0') || (c == '!') || ((c == '/')
				&& (ffelex_card_image_[column + 1] == '*')))
    {
      if ((ffelex_number_of_tokens_ == ffelex_label_tokens_)
	  && (ffelex_token_->type == FFELEX_typeNAMES)
	  && (ffelex_token_->length == 3)
       && (ffesrc_strncmp_2c (ffe_case_match (), ffelex_token_->text, "END",
			      "end", "End", 3)
	   == 0))
	{
	  ffelex_finish_statement_ ();
	  disallow_continuation_line = TRUE;
	  ignore_disallowed_continuation = FALSE;
	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
	}
      goto beginning_of_line;	/* :::::::::::::::::::: */
    }
  goto parse_nonraw_character;	/* :::::::::::::::::::: */
}

/* ffelex_file_free -- Lex a given file in free source form

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

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

ffelexHandler
ffelex_file_free (ffewhereFile wf, FILE *f)
{
  register int c;		/* Character currently under consideration. */
  register ffewhereColumnNumber column;	/* Not really; 0 means column 1... */
  bool continuation_line;
  ffewhereColumnNumber continuation_column;
  int last_char_in_file;	/* For getting back into comment-skipping
				   code. */

  /* 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);

  continuation_line = FALSE;
  ffelex_token_->type = FFELEX_typeNONE;
  ffelex_number_of_tokens_ = 0;
  ffelex_latest_line_ = ffewhere_line_unknown ();
  ffelex_latest_col_ = ffewhere_column_unknown ();
  c = getc (f);
  if (c == EOF)
    return (ffelexHandler) ffelex_handler_;
  goto first_line;		/* :::::::::::::::::::: */

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

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

  ++ffelex_linecount_;

  if (ffelex_set_include_)
    {
      ffewhereFile iwf = ffelex_include_wherefile_;
      FILE *ifi = ffelex_include_file_;

      ffewhere_line_kill (ffelex_latest_line_);
      ffewhere_column_kill (ffelex_latest_col_);

      ffelex_set_include_ = FALSE;
      ffewhere_file_begin (wf, iwf);
      if (ffelex_include_free_form_)
	ffelex_file_free (iwf, ifi);
      else
	ffelex_file_fixed (iwf, ifi);
      ffewhere_file_end (iwf, wf);
      fclose (ifi);

      ffelex_latest_line_ = ffewhere_line_unknown ();
      ffelex_latest_col_ = ffewhere_column_unknown ();
      continuation_line = FALSE;
    }

  c = last_char_in_file;
  if ((c == EOF) || ((c = getc (f)) == EOF))
    {

    end_of_file:		/* :::::::::::::::::::: */

      ffelex_finish_statement_ ();
      ffewhere_line_kill (ffelex_latest_line_);
      ffewhere_column_kill (ffelex_latest_col_);
      return (ffelexHandler) ffelex_handler_;
      /* Line ending in EOF instead of \n still counts as a whole line. */
    }

first_line:			/* :::::::::::::::::::: */

  /* Skip over initial-comment and empty lines as quickly as possible! */

  while ((c == '\n') || (c == '!'))
    {

    comment_line:		/* :::::::::::::::::::: */

      while ((c != '\n') && (c != EOF))
	c = getc (f);
      if (c == EOF)
	{
	  ++ffelex_linecount_;
	  ffelex_finish_statement_ ();
	  ffewhere_line_kill (ffelex_latest_line_);
	  ffewhere_column_kill (ffelex_latest_col_);
	  return (ffelexHandler) ffelex_handler_;
	}
      c = getc (f);
      ++ffelex_linecount_;
      if (c == EOF)
	goto end_of_file;	/* :::::::::::::::::::: */
    }

  ffelex_saw_tab_ = FALSE;

  column = ffelex_image_char_ (c, 0);

  /* Read the entire line in as is (with whitespace processing).  */

  while (((c = getc (f)) != '\n') && (c != EOF))
    {
      if (column >= ffelex_max_columns_)
	{
	  ffewhereColumnNumber newmax = ffelex_max_columns_ << 1;

	  if (newmax <= ffelex_max_columns_)
	    {			/* Overflowed column number. */
	      ffelex_card_image_[column] = '\0';
	      ffelex_card_length_ = column;
	      ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG, ffelex_linecount_,
			     column + 1);
	      goto comment_line;	/* :::::::::::::::::::: */
	    }

	  ffelex_card_image_
	    = malloc_resize_ksr (malloc_pool_image (),
				 ffelex_card_image_,
				 newmax + 1,
				 ffelex_max_columns_ + 1);
	  ffelex_max_columns_ = newmax;
	}
      column = ffelex_image_char_ (c, column);
    }

  /* If no tab, cut off line after column 132.  */

  if (!ffelex_saw_tab_ && (column > FFELEX_FREE_MAX_COLUMNS_))
    column = FFELEX_FREE_MAX_COLUMNS_;

  ffelex_card_image_[column] = '\0';
  ffelex_card_length_ = column;

  /* Save next char in file so we can use register-based c while analyzing
     line we just read. */

  last_char_in_file = c;	/* Should be either '\n' or EOF. */

  column = 0;
  continuation_column = 0;

  /* Skip over initial spaces to see if the first nonblank character
     is exclamation point, newline, or EOF (line is therefore a comment) or
     ampersand (line is therefore a continuation line). */

  while ((c = ffelex_card_image_[column]) == ' ')
    ++column;

  switch (c)
    {
    case '!':
    case '\0':
      goto beginning_of_line;	/* :::::::::::::::::::: */

    case '&':
      continuation_column = column + 1;
      /* Fall through. */
    default:
      break;
    }

  /* The line definitely has content of some kind, install new end-statement
     point for error messages. */

  ffewhere_line_kill (ffelex_latest_line_);
  ffewhere_column_kill (ffelex_latest_col_);
  ffelex_latest_line_ = ffewhere_line_new (ffelex_linecount_);
  ffelex_latest_col_ = ffewhere_column_new (ffelex_card_length_ + 1);

  /* Figure out which column to start parsing at. */

  if (continuation_line)
    {
      if (continuation_column == 0)
	{
	  if (ffelex_raw_mode_ != 0)
	    {
	      ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE, ffelex_linecount_,
			     column + 1);
	    }
	  else if (ffelex_token_->type != FFELEX_typeNONE)
	    {
	      ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE, ffelex_linecount_,
			     column + 1);
	    }
	}
      else if (ffelex_is_free_char_ctx_contin_ (continuation_column))
	{			/* Line contains only a single "&" as only
				   nonblank character. */
	  ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE, ffelex_linecount_,
			 continuation_column);
	  goto beginning_of_line;	/* :::::::::::::::::::: */
	}
      column = continuation_column;
    }
  else
    column = 0;

  c = ffelex_card_image_[column];
  continuation_line = FALSE;

  /* Here is the main engine for parsing.  c holds the character at column.
     It is already known that c is not a blank, end of line, or shriek,
     unless ffelex_raw_mode_ is not 0 (indicating we are in a
     character/hollerith constant).  A partially filled token may already
     exist in ffelex_token_. */

  if (ffelex_raw_mode_ != 0)
    {

    parse_raw_character:	/* :::::::::::::::::::: */

      switch (c)
	{
	case '&':
	  if (ffelex_is_free_char_ctx_contin_ (column + 1))
	    {
	      if (ffelex_raw_include_)
		{
		  ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
				 ffelex_linecount_, column + 1);
		  ffelex_permit_include_ = TRUE;
		  ffelex_finish_statement_ ();
		  ffelex_permit_include_ = FALSE;
		}
	      else
		continuation_line = TRUE;
	      goto beginning_of_line;	/* :::::::::::::::::::: */
	    }
	  break;

	case '\0':
	  ffelex_permit_include_ = TRUE;
	  ffelex_finish_statement_ ();
	  ffelex_permit_include_ = FALSE;
	  goto beginning_of_line;	/* :::::::::::::::::::: */

	default:
	  break;
	}

      switch (ffelex_raw_mode_)
	{
	case -2:
	  if (c == ffelex_raw_char_)
	    {
	      ffelex_raw_mode_ = -1;
	      ffelex_append_to_token_ (c);
	    }
	  else
	    {
	      ffelex_raw_mode_ = 0;
	      if (!ffe_is_90 () && (ffelex_token_->length == 0))
		{
		  ffelex_append_to_token_ (' ');
		  ffebad_start_lex (FFEBAD_NULL_CHAR_CONST);
		  ffebad_here (0, ffelex_token_->where_line,
			       ffelex_token_->where_col);
		  ffebad_finish ();
		}
	      ffelex_send_token_ ();
	      assert (ffelex_raw_mode_ == 0);

	      while (c == ' ')
		c = ffelex_card_image_[++column];
	      if ((c == '\0') || (c == '!'))
		{
		  ffelex_permit_include_ = TRUE;
		  ffelex_finish_statement_ ();
		  ffelex_permit_include_ = FALSE;
		  goto beginning_of_line;	/* :::::::::::::::::::: */
		}
	      if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
		{
		  if (ffelex_raw_include_)
		    {
		      ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
				     ffelex_linecount_, column + 1);
		      ffelex_permit_include_ = TRUE;
		      ffelex_finish_statement_ ();
		      ffelex_permit_include_ = FALSE;
		    }
		  else
		    continuation_line = TRUE;
		  goto beginning_of_line;	/* :::::::::::::::::::: */
		}
	      goto parse_nonraw_character_noncontin;	/* :::::::::::::::::::: */
	    }
	  break;

	case -1:
	  if (c == ffelex_raw_char_)
	    ffelex_raw_mode_ = -2;
	  else
	    ffelex_append_to_token_ (c);
	  break;

	default:
	  ffelex_append_to_token_ (c);
	  if (--ffelex_raw_mode_ == 0)
	    {
	      ffelex_send_token_ ();
	      c = ffelex_card_image_[++column];
	      assert (ffelex_raw_mode_ == 0);
	      while (c == ' ')
		c = ffelex_card_image_[++column];
	      if ((c == '\0') || (c == '!'))
		{
		  ffelex_permit_include_ = TRUE;
		  ffelex_finish_statement_ ();
		  ffelex_permit_include_ = FALSE;
		  goto beginning_of_line;	/* :::::::::::::::::::: */
		}
	      if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
		{
		  if (ffelex_raw_include_)
		    {
		      ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
				     ffelex_linecount_, column + 1);
		      ffelex_permit_include_ = TRUE;
		      ffelex_finish_statement_ ();
		      ffelex_permit_include_ = FALSE;
		    }
		  else
		    continuation_line = TRUE;
		  goto beginning_of_line;	/* :::::::::::::::::::: */
		}
	      goto parse_nonraw_character_noncontin;	/* :::::::::::::::::::: */
	    }
	}
      c = ffelex_card_image_[++column];
      goto parse_raw_character;	/* :::::::::::::::::::: */
    }

parse_nonraw_character:	/* :::::::::::::::::::: */

  if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
    {
      continuation_line = TRUE;
      goto beginning_of_line;	/* :::::::::::::::::::: */
    }

parse_nonraw_character_noncontin:	/* :::::::::::::::::::: */

  switch (ffelex_token_->type)
    {
    case FFELEX_typeNONE:
      if (c == ' ')
	{			/* Otherwise
				   finish-statement/continue-statement
				   already checked. */
	  while (c == ' ')
	    c = ffelex_card_image_[++column];
	  if ((c == '\0') || (c == '!'))
	    {
	      ffelex_permit_include_ = TRUE;
	      ffelex_finish_statement_ ();
	      ffelex_permit_include_ = FALSE;
	      goto beginning_of_line;	/* :::::::::::::::::::: */
	    }
	  if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
	    {
	      continuation_line = TRUE;
	      goto beginning_of_line;	/* :::::::::::::::::::: */
	    }
	}

      switch (c)
	{
	case '\"':
	  ffelex_token_->type = FFELEX_typeQUOTE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '$':
	  ffelex_token_->type = FFELEX_typeDOLLAR;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '%':
	  ffelex_token_->type = FFELEX_typePERCENT;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '&':
	  ffelex_token_->type = FFELEX_typeAMPERSAND;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '\'':
	  ffelex_token_->type = FFELEX_typeAPOSTROPHE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '(':
	  ffelex_token_->type = FFELEX_typeOPEN_PAREN;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case ')':
	  ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '*':
	  ffelex_token_->type = FFELEX_typeASTERISK;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '+':
	  ffelex_token_->type = FFELEX_typePLUS;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case ',':
	  ffelex_token_->type = FFELEX_typeCOMMA;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '-':
	  ffelex_token_->type = FFELEX_typeMINUS;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '.':
	  ffelex_token_->type = FFELEX_typePERIOD;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '/':
	  ffelex_token_->type = FFELEX_typeSLASH;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	  ffelex_token_->text[0] = c;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_token_->length = 1;
	  ffelex_token_->type
	    = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
	  break;

	case ':':
	  ffelex_token_->type = FFELEX_typeCOLON;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case ';':
	  ffelex_token_->type = FFELEX_typeSEMICOLON;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '<':
	  ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '=':
	  ffelex_token_->type = FFELEX_typeEQUALS;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '>':
	  ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  break;

	case '?':
	  ffelex_token_->type = FFELEX_typeQUESTION;
	  ffelex_token_->where_line = ffewhere_line_new (ffelex_linecount_);
	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
	  ffelex_send_token_ ();
	  break;

	case '_':
	  if (ffe_is_90 ())
	    {
	      ffelex_token_->type = FFELEX_typeUNDERSCORE;
	      ffelex_token_->where_line
		= ffewhere_line_new (ffelex_linecount_);
	      ffelex_token_->where_col
		= ffewhere_column_new (column + 1);
	      ffelex_send_token_ ();
	      break;
	    }
	  /* Fall through. */
	case 'A':
	case 'B':
	case 'C':
	case 'D':
	case 'E':
	case 'F':
	case 'G':
	case 'H':
	case 'I':
	case 'J':
	case 'K':
	case 'L':
	case 'M':
	case 'N':
	case 'O':
	case 'P':
	case 'Q':
	case 'R':
	case 'S':
	case 'T':
	case 'U':
	case 'V':
	case 'W':
	case 'X':
	case 'Y':
	case 'Z':
	case 'a':
	case 'b':
	case 'c':
	case 'd':
	case 'e':
	case 'f':
	case 'g':
	case 'h':
	case 'i':
	case 'j':
	case 'k':
	case 'l':
	case 'm':
	case 'n':
	case 'o':
	case 'p':
	case 'q':
	case 'r':
	case 's':
	case 't':
	case 'u':
	case 'v':
	case 'w':
	case 'x':
	case 'y':
	case 'z':
	  c = ffesrc_char_source (c);

	  if (ffesrc_char_match_init (c, 'H', 'h')
	      && ffelex_expecting_hollerith_ != 0)
	    {
	      ffelex_raw_mode_ = ffelex_expecting_hollerith_;
	      ffelex_raw_include_ = ffelex_hollerith_include_;
	      ffelex_token_->type = FFELEX_typeHOLLERITH;
	      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 ();
	      c = ffelex_card_image_[++column];
	      goto parse_raw_character;	/* :::::::::::::::::::: */
	    }

	  ffelex_token_->text[0] = c;
	  ffelex_token_->length = 1;
	  if (ffelex_names_pure_)
	    {
	      ffelex_token_->where_line = ffewhere_line_use
		(ffelex_token_->currentnames_line = ffewhere_line_new
		 (ffelex_linecount_));
	      ffelex_token_->where_col = ffewhere_column_use
		(ffelex_token_->currentnames_col = ffewhere_column_new
		 (column + 1));
	      ffelex_token_->type = FFELEX_typeNAMES;
	    }
	  else
	    {
	      ffelex_token_->where_line
		= ffewhere_line_new (ffelex_linecount_);
	      ffelex_token_->where_col = ffewhere_column_new (column + 1);
	      ffelex_token_->type = FFELEX_typeNAME;
	    }
	  break;

	default:
	  ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER, ffelex_linecount_,
			 column + 1);
	  ffelex_permit_include_ = TRUE;
	  ffelex_finish_statement_ ();
	  ffelex_permit_include_ = FALSE;
	  goto beginning_of_line;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeNAME:
      switch (c)
	{
	case 'A':
	case 'B':
	case 'C':
	case 'D':
	case 'E':
	case 'F':
	case 'G':
	case 'H':
	case 'I':
	case 'J':
	case 'K':
	case 'L':
	case 'M':
	case 'N':
	case 'O':
	case 'P':
	case 'Q':
	case 'R':
	case 'S':
	case 'T':
	case 'U':
	case 'V':
	case 'W':
	case 'X':
	case 'Y':
	case 'Z':
	case 'a':
	case 'b':
	case 'c':
	case 'd':
	case 'e':
	case 'f':
	case 'g':
	case 'h':
	case 'i':
	case 'j':
	case 'k':
	case 'l':
	case 'm':
	case 'n':
	case 'o':
	case 'p':
	case 'q':
	case 'r':
	case 's':
	case 't':
	case 'u':
	case 'v':
	case 'w':
	case 'x':
	case 'y':
	case 'z':
	  c = ffesrc_char_source (c);
	  /* Fall through.  */
	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	case '_':
	case '$':
	  if ((c == '$')
	      && !ffe_is_dollar_ok ())
	    {
	      ffelex_send_token_ ();
	      goto parse_next_character;	/* :::::::::::::::::::: */
	    }
	  ffelex_append_to_token_ (c);
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeNAMES:
      switch (c)
	{
	case 'A':
	case 'B':
	case 'C':
	case 'D':
	case 'E':
	case 'F':
	case 'G':
	case 'H':
	case 'I':
	case 'J':
	case 'K':
	case 'L':
	case 'M':
	case 'N':
	case 'O':
	case 'P':
	case 'Q':
	case 'R':
	case 'S':
	case 'T':
	case 'U':
	case 'V':
	case 'W':
	case 'X':
	case 'Y':
	case 'Z':
	case 'a':
	case 'b':
	case 'c':
	case 'd':
	case 'e':
	case 'f':
	case 'g':
	case 'h':
	case 'i':
	case 'j':
	case 'k':
	case 'l':
	case 'm':
	case 'n':
	case 'o':
	case 'p':
	case 'q':
	case 'r':
	case 's':
	case 't':
	case 'u':
	case 'v':
	case 'w':
	case 'x':
	case 'y':
	case 'z':
	  c = ffesrc_char_source (c);
	  /* Fall through.  */
	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	case '_':
	case '$':
	  if ((c == '$')
	      && !ffe_is_dollar_ok ())
	    {
	      ffelex_send_token_ ();
	      goto parse_next_character;	/* :::::::::::::::::::: */
	    }
	  if (ffelex_token_->length < FFEWHERE_indexMAX)
	    {
	      ffewhere_track (&ffelex_token_->currentnames_line,
			      &ffelex_token_->currentnames_col,
			      ffelex_token_->wheretrack,
		      ffelex_token_->length, ffelex_linecount_, column + 1);
	      ffelex_token_->text[ffelex_token_->length++] = c;
	    }
	  else
	    ffelex_append_to_token_ (c);
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

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

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeASTERISK:
      switch (c)
	{
	case '*':		/* ** */
	  ffelex_token_->type = FFELEX_typePOWER;
	  ffelex_send_token_ ();
	  break;

	default:		/* * not followed by another *. */
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeCOLON:
      switch (c)
	{
	case ':':		/* :: */
	  ffelex_token_->type = FFELEX_typeCOLONCOLON;
	  ffelex_send_token_ ();
	  break;

	default:		/* : not followed by another :. */
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeSLASH:
      switch (c)
	{
	case '/':		/* // */
	  ffelex_token_->type = FFELEX_typeCONCAT;
	  ffelex_send_token_ ();
	  break;

	case ')':		/* /) */
	  ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
	  ffelex_send_token_ ();
	  break;

	case '=':		/* /= */
	  ffelex_token_->type = FFELEX_typeREL_NE;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeOPEN_PAREN:
      switch (c)
	{
	case '/':		/* (/ */
	  ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeOPEN_ANGLE:
      switch (c)
	{
	case '=':		/* <= */
	  ffelex_token_->type = FFELEX_typeREL_LE;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeEQUALS:
      switch (c)
	{
	case '=':		/* == */
	  ffelex_token_->type = FFELEX_typeREL_EQ;
	  ffelex_send_token_ ();
	  break;

	case '>':		/* => */
	  ffelex_token_->type = FFELEX_typePOINTS;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    case FFELEX_typeCLOSE_ANGLE:
      switch (c)
	{
	case '=':		/* >= */
	  ffelex_token_->type = FFELEX_typeREL_GE;
	  ffelex_send_token_ ();
	  break;

	default:
	  ffelex_send_token_ ();
	  goto parse_next_character;	/* :::::::::::::::::::: */
	}
      break;

    default:
      assert ("Serious error!" == NULL);
      abort ();
      break;
    }

  c = ffelex_card_image_[++column];

parse_next_character:		/* :::::::::::::::::::: */

  if (ffelex_raw_mode_ != 0)
    goto parse_raw_character;	/* :::::::::::::::::::: */

  if ((c == '\0') || (c == '!'))
    {
      ffelex_permit_include_ = TRUE;
      ffelex_finish_statement_ ();
      ffelex_permit_include_ = FALSE;
      goto beginning_of_line;	/* :::::::::::::::::::: */
    }
  goto parse_nonraw_character;	/* :::::::::::::::::::: */
}

/* ffelex_init_1 -- Initialize for subsequent call to ffelex_file_fixed/free

   ffelex_init_1();  */

void
ffelex_init_1 ()
{
  unsigned int i;

  ffelex_final_nontab_column_ = 72;
  ffelex_max_columns_ = FFELEX_columnINITIAL_SIZE_;
  ffelex_card_image_ = malloc_new_ksr (malloc_pool_image (),
				       "FFELEX card image",
				       FFELEX_columnINITIAL_SIZE_ + 1);
  ffelex_card_image_[0] = '\0';

  for (i = 0; i < 256; ++i)
    ffelex_first_char_[i] = FFELEX_typeERROR;

  ffelex_first_char_['\t'] = FFELEX_typeRAW;
  ffelex_first_char_['\n'] = FFELEX_typeCOMMENT;
  ffelex_first_char_['\v'] = FFELEX_typeCOMMENT;
  ffelex_first_char_['\f'] = FFELEX_typeCOMMENT;
  ffelex_first_char_['\r'] = FFELEX_typeRAW;
  ffelex_first_char_[' '] = FFELEX_typeRAW;
  ffelex_first_char_['!'] = FFELEX_typeCOMMENT;
  ffelex_first_char_['*'] = FFELEX_typeCOMMENT;
  ffelex_first_char_['/'] = FFELEX_typeSLASH;

  for (i = '0'; i <= '9'; ++i)
    ffelex_first_char_[i] = FFELEX_typeRAW;

  if ((ffe_case_match () == FFE_caseNONE)
      || ((ffe_case_match () == FFE_caseUPPER)
	  && (ffe_case_source () != FFE_caseLOWER))	/* Idiot!  :-) */
      || ((ffe_case_match () == FFE_caseLOWER)
	  && (ffe_case_source () == FFE_caseLOWER)))
    {
      ffelex_first_char_['C'] = FFELEX_typeCOMMENT;
      ffelex_first_char_['D'] = FFELEX_typeCOMMENT;
    }
  if ((ffe_case_match () == FFE_caseNONE)
      || ((ffe_case_match () == FFE_caseLOWER)
	  && (ffe_case_source () != FFE_caseUPPER))	/* Idiot!  :-) */
      || ((ffe_case_match () == FFE_caseUPPER)
	  && (ffe_case_source () == FFE_caseUPPER)))
    {
      ffelex_first_char_['c'] = FFELEX_typeCOMMENT;
      ffelex_first_char_['d'] = FFELEX_typeCOMMENT;
    }

  ffelex_linecount_ = 1;
  ffelex_raw_mode_ = 0;
  ffelex_raw_include_ = FALSE;
  ffelex_strict_ansi_ = ffe_is_pedantic ();
  ffelex_set_include_ = FALSE;
  ffelex_permit_include_ = FALSE;
  ffelex_names_ = TRUE;		/* First token in program is a names. */
  ffelex_names_pure_ = FALSE;	/* Free-form lexer does NAMES only for
				   FORMAT. */
  ffelex_hexnum_ = FALSE;
  ffelex_expecting_hollerith_ = 0;
  ffelex_number_of_tokens_ = 0;
  ffelex_label_tokens_ = 0;
  ffelex_raw_where_line_ = ffewhere_line_unknown ();
  ffelex_raw_where_col_ = ffewhere_column_unknown ();

  if (ffelex_token_ == NULL)
    {
      ffelex_token_ = ffelex_token_new_ ();
      ffelex_token_->type = FFELEX_typeNONE;
      ffelex_token_->size = FFELEX_columnTOKEN_SIZE_;
      ffelex_token_->length = 0;
      ffelex_token_->uses = 1;
      ffelex_token_->where_line = ffewhere_line_unknown ();
      ffelex_token_->where_col = ffewhere_column_unknown ();
      ffelex_token_->text
	= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			  FFELEX_columnTOKEN_SIZE_ + 1);
    }

  ffelex_handler_ = NULL;
}

/* ffelex_is_names_expected -- Is the current parser expecting NAMES vs. NAME?

   if (ffelex_is_names_expected())
       // Deliver NAMES token
     else
       // Deliver NAME token

   Must be called while lexer is active, obviously.  */

bool
ffelex_is_names_expected ()
{
  return ffelex_names_;
}

/* ffelex_line -- Return current lexer line

   puts(ffelex_line());

   Must be called while lexer is active, obviously.  */

char *
ffelex_line ()
{
  return ffelex_card_image_;
}

/* ffelex_line_length -- Return length of current lexer line

   printf("Length is %lu\n",ffelex_line_length());

   Must be called while lexer is active, obviously.  */

ffewhereColumnNumber
ffelex_line_length ()
{
  return ffelex_card_length_;
}

/* ffelex_line_number -- Return master line number of current lexer line

   printf("Line number is %lu\n",ffelex_line_number());

   Must be called while lexer is active, obviously.  */

ffewhereLineNumber
ffelex_line_number ()
{
  return ffelex_linecount_;
}

/* ffelex_set_expecting_hollerith -- Set hollerith expectation status

   ffelex_set_expecting_hollerith(0);

   Lex initially assumes no hollerith constant is about to show up.  If
   syntactic analysis expects one, it should call this function with the
   number of characters expected in the constant immediately after recognizing
   the decimal number preceding the "H" and the constant itself.  Then, if
   the next character is indeed H, the lexer will interpret it as beginning
   a hollerith constant and ship the token formed by reading the specified
   number of characters (interpreting blanks and otherwise-comments too)
   from the input file.	 It is up to syntactic analysis to call this routine
   again with 0 to turn hollerith detection off immediately upon receiving
   the token that might or might not be HOLLERITH.

   Also call this after seeing an APOSTROPHE or QUOTE token that begins a
   character constant.	Pass the expected termination character (apostrophe
   or quote).

   Pass for length either the length of the hollerith (must be > 0), -1
   meaning expecting a character constant, or 0 to cancel expectation of
   a hollerith only after calling it with a length of > 0 and receiving the
   next token (which may or may not have been a HOLLERITH token).

   Pass for which either an apostrophe or quote when passing length of -1.
   Else which is a don't-care.

   Pass for line and column the line/column info for the token beginning the
   character or hollerith constant, for use in error messages, when passing
   a length of -1 -- this function will invoke ffewhere_line/column_use to
   make its own copies.	 Else line and column are don't-cares (when length
   is 0) and the outstanding copies of the previous line/column info, if
   still around, are killed.

   21-Feb-90  JCB  3.1
      When called with length of 0, also zero ffelex_raw_mode_.	 This is
      so ffest_save_ can undo the effects of replaying tokens like
      APOSTROPHE and QUOTE.
   25-Jan-90  JCB  3.0
      New line, column arguments allow error messages to point to the true
      beginning of a character/hollerith constant, rather than the beginning
      of the content part, which makes them more consistent and helpful.
   05-Nov-89  JCB  2.0
      New "which" argument allows caller to specify termination character,
      which should be apostrophe or double-quote, to support Fortran 90.  */

void
ffelex_set_expecting_hollerith (long length, bool include, char which,
				ffewhereLine line, ffewhereColumn column)
{

  /* First kill the pending line/col info, if any (should only be pending
     when this call has length==0, the previous call had length>0, and a
     non-HOLLERITH token was sent in between the calls, but play it safe). */

  if (!ffewhere_line_is_unknown (ffelex_raw_where_line_))
    ffewhere_line_kill (ffelex_raw_where_line_);
  if (!ffewhere_column_is_unknown (ffelex_raw_where_col_))
    ffewhere_column_kill (ffelex_raw_where_col_);

  /* Now handle the length function. */
  switch (length)
    {
    case 0:
      ffelex_expecting_hollerith_ = 0;
      ffelex_raw_mode_ = 0;
      ffelex_raw_include_ = FALSE;
      ffelex_raw_where_line_ = ffewhere_line_unknown ();
      ffelex_raw_where_col_ = ffewhere_column_unknown ();
      return;			/* Don't set new line/column info from args. */

    case -1:
      ffelex_raw_mode_ = -1;
      ffelex_raw_include_ = include;
      ffelex_raw_char_ = which;
      break;

    default:			/* length > 0 */
      ffelex_hollerith_include_ = include;
      ffelex_expecting_hollerith_ = length;
      break;
    }

  /* Now set new line/column information from passed args. */

  ffelex_raw_where_line_ = ffewhere_line_use (line);
  ffelex_raw_where_col_ = ffewhere_column_use (column);
}

/* ffelex_set_handler -- Set handler for tokens before calling _fixed or _free

   ffelex_set_handler((ffelexHandler) my_first_handler);

   Must be called before calling ffelex_file_fixed or ffelex_file_free or
   after they return, but not while they are active.  */

void
ffelex_set_handler (ffelexHandler first)
{
  ffelex_handler_ = first;
}

/* ffelex_set_hexnum -- Set hexnum flag

   ffelex_set_hexnum(TRUE);

   Lex normally interprets a token starting with [0-9] as a NUMBER token,
   so if it sees a [A-Za-z] in it, it stops parsing the NUMBER and leaves
   the character as the first of the next token.  But when parsing a
   hexadecimal number, by calling this function with TRUE before starting
   the parse of the token itself, lex will interpret [0-9] as the start
   of a NAME token.  */

void
ffelex_set_hexnum (bool f)
{
  ffelex_hexnum_ = f;
}

/* ffelex_set_include -- Set INCLUDE file to be processed next

   ffewhereFile wf;  // The ffewhereFile object for the file.
   bool free_form;  // TRUE means read free-form file, FALSE fixed-form.
   FILE *fi;  // The file to INCLUDE.
   ffelex_set_include(wf,free_form,fi);

   Must be called only after receiving the EOS token following a valid
   INCLUDE statement specifying a file that has already been successfully
   opened.  */

void
ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi)
{
  assert (ffelex_permit_include_);
  assert (!ffelex_set_include_);
  ffelex_set_include_ = TRUE;
  ffelex_include_free_form_ = free_form;
  ffelex_include_file_ = fi;
  ffelex_include_wherefile_ = wf;
}

/* ffelex_set_names -- Set names/name flag, names = TRUE

   ffelex_set_names(FALSE);

   Lex initially assumes multiple names should be formed.  If this function is
   called with FALSE, then single names are formed instead.  The differences
   are a difference in the token type (FFELEX_typeNAMES vs. FFELEX_typeNAME)
   and in whether full source-location tracking is performed (it is for
   multiple names, not for single names), which is more expensive in terms of
   CPU time.  */

void
ffelex_set_names (bool f)
{
  ffelex_names_ = f;
  if (!f)
    ffelex_names_pure_ = FALSE;
}

/* ffelex_set_names_pure -- Set names/name (pure) flag, names = TRUE

   ffelex_set_names_pure(FALSE);

   Like ffelex_set_names, except affects both lexers.  Normally, the
   free-form lexer need not generate NAMES tokens because adjacent NAME
   tokens must be separated by spaces which causes the lexer to generate
   separate tokens for analysis (whereas in fixed-form the spaces are
   ignored resulting in one long token).  But in FORMAT statements, for
   some reason, the Fortran 90 standard specifies that spaces can occur
   anywhere within a format-item-list with no effect on the format spec
   (except of course within character string edit descriptors), which means
   that "1PE14.2" and "1 P E 1 4 . 2" are equivalent.  For the FORMAT
   statement handling, the existence of spaces makes it hard to deal with,
   because each token is seen distinctly (i.e. seven tokens in the latter
   example).  But when no spaces are provided, as in the former example,
   then only four tokens are generated, NUMBER("1"), NAME("PE14"), PERIOD,
   NUMBER ("2").  By generating a NAMES instead of NAME, three things happen:
   One, ffest_kw_format_ does a substring rather than full-string match,
   and thus matches "PE14" to "PE"; two, ffelex_token_xyz_from_names functions
   may be used to pull NAME/NAMES and NUMBER tokens out of the NAMES token;
   and three, error reporting can point to the actual character rather than
   at or prior to it.  The first two things could be resolved by providing
   alternate functions fairly easy, thus allowing FORMAT handling to expect
   both lexers to generate NAME tokens instead of NAMES (with otherwise minor
   changes to FORMAT parsing), but the third, error reporting, would suffer,
   and when one makes mistakes in a FORMAT, believe me, one wants a pointer
   to exactly where the compilers thinks the problem is, to even begin to get
   a handle on it.  So there.  */

void
ffelex_set_names_pure (bool f)
{
  ffelex_names_pure_ = f;
  ffelex_names_ = f;
}

/* ffelex_splice_tokens -- Splice off and send tokens from a NAMES

   return (ffelexHandler) ffelex_splice_tokens(first_handler,master_token,
	 start_char_index);

   Returns first_handler if start_char_index chars into master_token (which
   must be a NAMES token) is '\0'. Else, creates a subtoken from that
   char, either NUMBER (if it is a digit), a NAME (if a valid firstnamechar),
   an UNDERSCORE (if an underscore), or DOLLAR (if a dollar sign)
   and sends it to first_handler. If anything other than NAME is sent, the
   character at the end of it in the master token is examined to see if it
   begins a NAME, NUMBER, UNDERSCORE, or DOLLAR, and, if so,
   the handler returned by first_handler is invoked with that token, and
   this process is repeated until the end of the master token or a NAME
   token is reached.  */

ffelexHandler
ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
		      ffeTokenLength start)
{
  char *p;
  ffeTokenLength i;
  ffelexToken t;

  p = ffelex_token_text (master) + (i = start);

  while (*p != '\0')
    {
      if (isdigit (*p))
	{
	  t = ffelex_token_number_from_names (master, i);
	  p += ffelex_token_length (t);
	  i += ffelex_token_length (t);
	}
      else if (ffesrc_is_name_init (*p))
	{
	  t = ffelex_token_name_from_names (master, i, 0);
	  p += ffelex_token_length (t);
	  i += ffelex_token_length (t);
	}
      else if ((*p == '$')
	       && !ffe_is_dollar_ok ())
	{
	  t = ffelex_token_dollar_from_names (master, i);
	  ++p;
	  ++i;
	}
      else if (*p == '_')
	{
	  t = ffelex_token_uscore_from_names (master, i);
	  ++p;
	  ++i;
	}
      else
	{
	  assert ("not a valid NAMES character" == NULL);
	  t = NULL;
	}
      assert (first != NULL);
      first = (ffelexHandler) (*first) (t);
      ffelex_token_kill (t);
    }

  return first;
}

/* 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.  */

ffelexHandler
ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler)
{
  assert (handler != NULL);

  if ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeEOS)
		      || (ffelex_token_type (t) == FFELEX_typeSEMICOLON)))
    return (ffelexHandler) (*handler) (t);

  ffelex_eos_handler_ = handler;
  return (ffelexHandler) ffelex_swallow_tokens_;
}

/* ffelex_token_dollar_from_names -- Return a dollar from within a names token

   ffelexToken t;
   t = ffelex_token_dollar_from_names(t,6);

   It's as if you made a new token of dollar type having the dollar
   at, in the example above, the sixth character of the NAMES token.  */

ffelexToken
ffelex_token_dollar_from_names (ffelexToken t, ffeTokenLength start)
{
  ffelexToken nt;

  assert (t != NULL);
  ffelex_total_tokens_++;
  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  assert (start < t->length);
  assert (t->text[start] == '$');

  /* Now make the token. */

  nt = ffelex_token_new_ ();
  nt->type = FFELEX_typeDOLLAR;
  nt->size = FFELEX_sizeUNNEEDED_TEXT_;	/* Assume nobody's gonna fiddle with
					   token text. */
  nt->length = 0;
  nt->uses = 1;
  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
			   t->where_col, t->wheretrack, start);
  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			     nt->size + 1);
  nt->text[0] = '\0';
  return nt;
}

/* ffelex_token_kill -- Decrement use count for token, kill if no uses left

   ffelexToken t;
   ffelex_token_kill(t);

   Complements a call to ffelex_token_use or ffelex_token_new_....  */

void
ffelex_token_kill (ffelexToken t)
{
  assert (t != NULL);
  ffelex_total_tokens_--;

  assert (t->uses > 0);

  if (--t->uses != 0)
    return;

  if (t->type == FFELEX_typeNAMES)
    ffewhere_track_kill (t->where_line, t->where_col,
			 t->wheretrack, t->length);
  ffewhere_line_kill (t->where_line);
  ffewhere_column_kill (t->where_col);
  malloc_kill_ksr (malloc_pool_image (), t->text, t->size + 1);
  malloc_kill_ks (malloc_pool_image (), t, sizeof (*t));
}

/* Make a new NAME token that is a substring of a NAMES token.  */

ffelexToken
ffelex_token_name_from_names (ffelexToken t, ffeTokenLength start,
			      ffeTokenLength len)
{
  ffelexToken nt;

  assert (t != NULL);
  ffelex_total_tokens_++;
  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  assert (start < t->length);
  if (len == 0)
    len = t->length - start;
  else
    {
      assert (len > 0);
      assert ((start + len) <= t->length);
    }
  assert (ffelex_is_firstnamechar (t->text[start]));

  nt = ffelex_token_new_ ();
  nt->type = FFELEX_typeNAME;
  nt->size = len;		/* Assume nobody's gonna fiddle with token
				   text. */
  nt->length = len;
  nt->uses = 1;
  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
			   t->where_col, t->wheretrack, start);
  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			     len + 1);
  strncpy (nt->text, t->text + start, len);
  nt->text[len] = '\0';
  return nt;
}

/* Make a new NAMES token that is a substring of another NAMES token.  */

ffelexToken
ffelex_token_names_from_names (ffelexToken t, ffeTokenLength start,
			       ffeTokenLength len)
{
  ffelexToken nt;

  assert (t != NULL);
  ffelex_total_tokens_++;
  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  assert (start < t->length);
  if (len == 0)
    len = t->length - start;
  else
    {
      assert (len > 0);
      assert ((start + len) <= t->length);
    }
  assert (ffelex_is_firstnamechar (t->text[start]));

  nt = ffelex_token_new_ ();
  nt->type = FFELEX_typeNAMES;
  nt->size = len;		/* Assume nobody's gonna fiddle with token
				   text. */
  nt->length = len;
  nt->uses = 1;
  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
			   t->where_col, t->wheretrack, start);
  ffewhere_track_copy (nt->wheretrack, t->wheretrack, start, len);
  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			     len + 1);
  strncpy (nt->text, t->text + start, len);
  nt->text[len] = '\0';
  return nt;
}

/* Make a new CHARACTER token.  */

ffelexToken
ffelex_token_new_character (char *s, ffewhereLine l, ffewhereColumn c)
{
  ffelexToken t;

  ffelex_total_tokens_++;

  t = ffelex_token_new_ ();
  t->type = FFELEX_typeCHARACTER;
  t->length = t->size = strlen (s);	/* Assume it won't get bigger. */
  t->uses = 1;
  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			    t->size + 1);
  strcpy (t->text, s);
  t->where_line = ffewhere_line_use (l);
  t->where_col = ffewhere_column_new (c);
  return t;
}

/* Make a new EOF token right after end of file.  */

ffelexToken
ffelex_token_new_eof ()
{
  ffelexToken t;

  ffelex_total_tokens_++;

  t = ffelex_token_new_ ();
  t->type = FFELEX_typeEOF;
  t->size = FFELEX_sizeUNNEEDED_TEXT_;	/* Assume it won't get bigger. */
  t->length = 0;
  t->uses = 1;
  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			    t->size + 1);
  t->text[0] = '\0';
  t->where_line = ffewhere_line_new (ffelex_linecount_);
  t->where_col = ffewhere_column_new (1);
  return t;
}

/* Make a new NAME token.  */

ffelexToken
ffelex_token_new_name (char *s, ffewhereLine l, ffewhereColumn c)
{
  ffelexToken t;

  ffelex_total_tokens_++;

  assert (ffelex_is_firstnamechar (*s));

  t = ffelex_token_new_ ();
  t->type = FFELEX_typeNAME;
  t->length = t->size = strlen (s);	/* Assume it won't get bigger. */
  t->uses = 1;
  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			    t->size + 1);
  strcpy (t->text, s);
  t->where_line = ffewhere_line_use (l);
  t->where_col = ffewhere_column_new (c);
  return t;
}

/* Make a new NAMES token.  */

ffelexToken
ffelex_token_new_names (char *s, ffewhereLine l, ffewhereColumn c)
{
  ffelexToken t;

  ffelex_total_tokens_++;

  assert (ffelex_is_firstnamechar (*s));

  t = ffelex_token_new_ ();
  t->type = FFELEX_typeNAMES;
  t->length = t->size = strlen (s);	/* Assume it won't get bigger. */
  t->uses = 1;
  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			    t->size + 1);
  strcpy (t->text, s);
  t->where_line = ffewhere_line_use (l);
  t->where_col = ffewhere_column_new (c);
  ffewhere_track_clear (t->wheretrack, t->length);	/* Assume contiguous
							   names. */
  return t;
}

/* Make a new NUMBER token.

   The first character of the string must be a digit, and only the digits
   are copied into the new number.  So this may be used to easily extract
   a NUMBER token from within any text string.  Then the length of the
   resulting token may be used to calculate where the digits stopped
   in the original string.  */

ffelexToken
ffelex_token_new_number (char *s, ffewhereLine l, ffewhereColumn c)
{
  ffelexToken t;
  ffeTokenLength len;

  ffelex_total_tokens_++;

  /* How long is the string of decimal digits at s? */

  len = strspn (s, "0123456789");

  /* Make sure there is at least one digit. */

  assert (len != 0);

  /* Now make the token. */

  t = ffelex_token_new_ ();
  t->type = FFELEX_typeNUMBER;
  t->length = t->size = len;	/* Assume it won't get bigger. */
  t->uses = 1;
  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			    len + 1);
  strncpy (t->text, s, len);
  t->text[len] = '\0';
  t->where_line = ffewhere_line_use (l);
  t->where_col = ffewhere_column_new (c);
  return t;
}

/* Make a new token of any type that doesn't contain text.  A private
   function that is used by public macros in the interface file.  */

ffelexToken
ffelex_token_new_simple_ (ffelexType type, ffewhereLine l, ffewhereColumn c)
{
  ffelexToken t;

  t = ffelex_token_new_ ();
  t->type = type;
  t->size = FFELEX_sizeUNNEEDED_TEXT_;	/* Assume it won't get bigger. */
  t->length = 0;
  t->uses = 1;
  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text", t->size + 1);
  t->text[0] = '\0';
  t->where_line = ffewhere_line_use (l);
  t->where_col = ffewhere_column_new (c);
  return t;
}

/* Make a new NUMBER token from an existing NAMES token.

   Like ffelex_token_new_number, this function calculates the length
   of the digit string itself.  */

ffelexToken
ffelex_token_number_from_names (ffelexToken t, ffeTokenLength start)
{
  ffelexToken nt;
  ffeTokenLength len;

  assert (t != NULL);
  ffelex_total_tokens_++;
  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  assert (start < t->length);

  /* How long is the string of decimal digits at s? */

  len = strspn (t->text + start, "0123456789");

  /* Make sure there is at least one digit. */

  assert (len != 0);

  /* Now make the token. */

  nt = ffelex_token_new_ ();
  nt->type = FFELEX_typeNUMBER;
  nt->size = len;		/* Assume nobody's gonna fiddle with token
				   text. */
  nt->length = len;
  nt->uses = 1;
  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
			   t->where_col, t->wheretrack, start);
  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			     len + 1);
  strncpy (nt->text, t->text + start, len);
  nt->text[len] = '\0';
  return nt;
}

/* Make a new UNDERSCORE token from a NAMES token.  */

ffelexToken
ffelex_token_uscore_from_names (ffelexToken t, ffeTokenLength start)
{
  ffelexToken nt;

  assert (t != NULL);
  ffelex_total_tokens_++;
  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
  assert (start < t->length);
  assert (t->text[start] == '_');

  /* Now make the token. */

  nt = ffelex_token_new_ ();
  nt->type = FFELEX_typeUNDERSCORE;
  nt->size = FFELEX_sizeUNNEEDED_TEXT_;	/* Assume nobody's gonna fiddle with
					   token text. */
  nt->length = 0;
  nt->uses = 1;
  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
			   t->where_col, t->wheretrack, start);
  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
			     nt->size + 1);
  nt->text[0] = '\0';
  return nt;
}

/* ffelex_token_use -- Return another instance of a token

   ffelexToken t;
   t = ffelex_token_use(t);

   In a sense, the new token is a copy of the old, though it might be the
   same with just a new use count.

   We use the use count method (easy).	*/

ffelexToken
ffelex_token_use (ffelexToken t)
{
  if (t == NULL)
    assert ("_token_use: null token" == NULL);
  ffelex_total_tokens_++;
  t->uses++;
  return t;
}

/* ffelex_append_to_token_ -- Append a character to the current token

   ffelex_append_to_token_(char c);

   Call this to append another character to the current token.	If it isn't
   currently big enough for it, it will be enlarged.  */

static void
ffelex_append_to_token_ (char c)
{
  if (ffelex_token_->length >= ffelex_token_->size)
    {
      ffelex_token_->text = malloc_resize_ksr (malloc_pool_image (),
			ffelex_token_->text, (ffelex_token_->size << 1) + 1,
					       ffelex_token_->size + 1);
      ffelex_token_->size <<= 1;
      assert (ffelex_token_->length < ffelex_token_->size);
    }
  ffelex_token_->text[ffelex_token_->length++] = c;
}

/* ffelex_bad_1_ -- Issue diagnostic with one source point

   ffelex_bad_1_(FFEBAD_SOME_ERROR,ffelex_linecount_,column + 1);

   Creates ffewhere line and column objects for the source point, sends them
   along with the error code to ffebad, then kills the line and column
   objects before returning.  */

static void
ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0)
{
  ffewhereLine wl0;
  ffewhereColumn wc0;

  wl0 = ffewhere_line_new (ln0);
  wc0 = ffewhere_column_new (cn0);
  ffebad_start_lex (errnum);
  ffebad_here (0, wl0, wc0);
  ffebad_finish ();
  ffewhere_line_kill (wl0);
  ffewhere_column_kill (wc0);
}

/* ffelex_bad_2_ -- Issue diagnostic with two source points

   ffelex_bad_2_(FFEBAD_SOME_ERROR,ffelex_linecount_,column + 1,otherline,
	 othercolumn);

   Creates ffewhere line and column objects for the source points, sends them
   along with the error code to ffebad, then kills the line and column
   objects before returning.  */

static void
ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0,
	       ffewhereLineNumber ln1, ffewhereColumnNumber cn1)
{
  ffewhereLine wl0, wl1;
  ffewhereColumn wc0, wc1;

  wl0 = ffewhere_line_new (ln0);
  wc0 = ffewhere_column_new (cn0);
  wl1 = ffewhere_line_new (ln1);
  wc1 = ffewhere_column_new (cn1);
  ffebad_start_lex (errnum);
  ffebad_here (0, wl0, wc0);
  ffebad_here (1, wl1, wc1);
  ffebad_finish ();
  ffewhere_line_kill (wl0);
  ffewhere_column_kill (wc0);
  ffewhere_line_kill (wl1);
  ffewhere_column_kill (wc1);
}

/* ffelex_display_token_ -- Display current token

   ffelex_display_token_();

   Call this to display current token for debugging/testing purposes.  */

#if 0
static void
ffelex_display_token_ ()
{
  fprintf (stdout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %"
	   ffewhereColumnNumber_f "u)",
	   (unsigned long) ffelex_number_of_tokens_,
	   ffelex_type_string_ (ffelex_token_->type),
	   ffewhere_line_number (ffelex_token_->where_line),
	   ffewhere_column_number (ffelex_token_->where_col));

  switch (ffelex_token_->type)
    {
    case FFELEX_typeNUMBER:
    case FFELEX_typeNAME:
    case FFELEX_typeNAMES:
    case FFELEX_typeHOLLERITH:
    case FFELEX_typeCHARACTER:
      fprintf (stdout, ": \"%.*s\"\n", (unsigned int) ffelex_token_->length,
	       ffelex_token_->text);
      break;

    default:
      fprintf (stdout, ".\n");
    }
}

#endif
/* ffelex_finish_statement_ -- Send end-statement message to all parse tasks

   ffelex_finish_statement_();

   Call this when end of statement is detected and if any tokens have been
   sent for the current statement.

   For all parse tasks, send the end-statement token message, then make
   sure only one task remains.	*/

static void
ffelex_finish_statement_ ()
{
  if ((ffelex_number_of_tokens_ == 0)
      && (ffelex_token_->type == FFELEX_typeNONE))
    return;			/* Don't have a statement pending. */

  if (ffelex_token_->type != FFELEX_typeNONE)
    {
      switch (ffelex_raw_mode_)
	{
	case -2:
	  if (!ffe_is_90 () && (ffelex_token_->length == 0))
	    {
	      ffelex_append_to_token_ (' ');
	      ffebad_start_lex (FFEBAD_NULL_CHAR_CONST);
	      ffebad_here (0, ffelex_token_->where_line,
			   ffelex_token_->where_col);
	      ffebad_finish ();
	    }
	  ffelex_raw_mode_ = 0;
	  ffelex_raw_include_ = FALSE;
	  break;

	case -1:
	  ffebad_start_lex ((ffelex_raw_char_ == '\'') ? FFEBAD_NO_CLOSING_APOSTROPHE
			    : FFEBAD_NO_CLOSING_QUOTE);
	  ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
	  ffebad_here (1, ffelex_latest_line_, ffelex_latest_col_);
	  ffebad_finish ();
	  if (!ffe_is_90 () && (ffelex_token_->length == 0))
	    ffelex_append_to_token_ (' ');
	  ffelex_raw_mode_ = 0;
	  ffelex_raw_include_ = FALSE;
	  break;

	case 0:
	  break;

	default:
	  {
	    char num[20];

	    ffebad_start_lex (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS);
	    ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
	    ffebad_here (1, ffelex_latest_line_, ffelex_latest_col_);
	    sprintf (num, "%lu", (unsigned long) ffelex_raw_mode_);
	    ffebad_string (num);
	    ffebad_finish ();
	    ffelex_raw_mode_ = 0;
	    ffelex_raw_include_ = FALSE;
	    break;
	  }
	}
      ffelex_send_token_ ();
    }
  ffelex_token_->type = FFELEX_typeEOS;
  ffelex_token_->where_line = ffewhere_line_use (ffelex_latest_line_);
  ffelex_token_->where_col = ffewhere_column_use (ffelex_latest_col_);
  ffelex_send_token_ ();
  ffelex_number_of_tokens_ = 0;
  ffelex_label_tokens_ = 0;
  ffelex_names_ = TRUE;
  ffelex_names_pure_ = FALSE;	/* Probably not necessary. */
  ffelex_hexnum_ = FALSE;

  if (!ffe_is_ffedebug ())
    return;

  /* For debugging purposes only. */

  if (ffelex_total_tokens_ != ffelex_old_total_tokens_)
    {
      fprintf (stdout, "; token_track had %ld tokens, now have %ld.\n",
	       ffelex_old_total_tokens_, ffelex_total_tokens_);
      ffelex_old_total_tokens_ = ffelex_total_tokens_;
    }
}

/* "Image" a character onto the card image, return incremented column number.

   Normally invoking this function as in
     column = ffelex_image_char_ (c, column);
   is the same as doing:
     ffelex_card_image_[column++] = c;

   However, tabs and carriage returns are handled specially, to preserve
   the visual "image" of the input line (in most editors) in the card
   image.

   Carriage returns are ignored, as they are assumed to be followed
   by newlines.

   A tab is handled by first doing:
     ffelex_card_image_[column++] = ' ';
   That is, it translates to at least one space.  Then, as many spaces
   are imaged as necessary to bring the column number to the next tab
   position, where tab positions start in the ninth column and each
   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)
{
  switch (c)
    {
    case '\r':
      break;

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

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

  return column;
}

/* 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;
}

/* ffelex_send_token_ -- Send current token to all parse tasks

   ffelex_send_token_();

   Call this when the current token is built.

   For all parse tasks, send the current token.	 */

static void
ffelex_send_token_ ()
{
  ++ffelex_number_of_tokens_;

  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_->size = FFELEX_columnTOKEN_SIZE_;
  ffelex_token_->length = 0;
  ffelex_token_->uses = 1;
  ffelex_token_->text
    = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
		      FFELEX_columnTOKEN_SIZE_ + 1);
  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 ();
    }
}

/* 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_;
}

/* ffelex_type_string_ -- Return string describing token type

   ffelex_type_string_();

   Returns a displayable string describing token type.	*/

#if 0
static char *
ffelex_type_string_ (ffelexType t)
{
  static char *types[]
  =
  {
    "NONE",
    "COMMENT",
    "EOS",
    "ERROR",
    "RAW",
    "QUOTE",
    "DOLLAR",
    "PERCENT",
    "AMPERSAND",
    "APOSTROPHE",
    "OPEN_PAREN",
    "CLOSE_PAREN",
    "ASTERISK",
    "PLUS",
    "MINUS",
    "PERIOD",
    "SLASH",
    "NUMBER",
    "OPEN_ANGLE",
    "EQUALS",
    "CLOSE_ANGLE",
    "NAME",
    "COMMA",
    "POWER",
    "CONCAT",
    "DEBUG",
    "NAMES",
    "HOLLERITH",
    "CHARACTER",
    "COLON",
    "SEMICOLON",
    "UNDERSCORE",
    "QUESTION",
    "OPEN_ARRAY",
    "CLOSE_ARRAY",
    "COLONCOLON",
    "REL_LE",
    "REL_NE",
    "REL_EQ",
    "POINTS",
    "REL_GE",
  };

  if ((t < 0) || (t > ARRAY_SIZE (types)))
    return NULL;
  return types[t];
}

#endif
