sta.c

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

/* sta.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995-1997 Free Software Foundation, Inc.
   Contributed by James Craig Burley.

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, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.

   Related Modules:
      None

   Description:
      Analyzes the first two tokens, figures out what statements are
      possible, tries parsing the possible statements by calling on
      the ffestb functions.

   Modifications:
*/

/* Include files. */

#include "proj.h"
#include "sta.h"
#include "bad.h"
#include "implic.h"
#include "lex.h"
#include "malloc.h"
#include "stb.h"
#include "stc.h"
#include "std.h"
#include "str.h"
#include "storag.h"
#include "symbol.h"

/* Externals defined here. */

ffelexToken ffesta_tokens[FFESTA_tokensMAX];	/* For use by a possible. */
ffestrFirst ffesta_first_kw;	/* First NAME(S) looked up. */
ffestrSecond ffesta_second_kw;	/* Second NAME(S) looked up. */
mallocPool ffesta_output_pool;	/* Pool for results of stmt handling. */
mallocPool ffesta_scratch_pool;	/* Pool for stmt scratch handling. */
ffelexToken ffesta_construct_name;
ffelexToken ffesta_label_token;	/* Pending label stuff. */
bool ffesta_seen_first_exec;
bool ffesta_is_entry_valid = FALSE;	/* TRUE only in SUBROUTINE/FUNCTION. */
bool ffesta_line_has_semicolons = FALSE;

/* Simple definitions and enumerations. */

#define FFESTA_ABORT_ON_CONFIRM_ 1	/* 0=slow, tested way; 1=faster way
					   that might not always work. Here's
					   the old description of what used
					   to not work with ==1: (try
					   "CONTINUE\10
					   FORMAT('hi',I11)\END").  Problem
					   is that the "topology" of the
					   confirmed stmt's tokens with
					   regard to CHARACTER, HOLLERITH,
					   NAME/NAMES/NUMBER tokens (like hex
					   numbers), isn't traced if we abort
					   early, then other stmts might get
					   their grubby hands on those
					   unprocessed tokens and commit them
					   improperly.	Ideal fix is to rerun
					   the confirmed stmt and forget the
					   rest.  */

#define FFESTA_maxPOSSIBLES_ 8/* Never more than this # of possibles. */

/* Internal typedefs. */

typedef struct _ffesta_possible_ *ffestaPossible_;

/* Private include files. */


/* Internal structure definitions. */

struct _ffesta_possible_
  {
    ffestaPossible_ next;
    ffestaPossible_ previous;
    ffelexHandler handler;
    bool named;
  };

struct _ffesta_possible_root_
  {
    ffestaPossible_ first;
    ffestaPossible_ last;
    ffelexHandler nil;
  };

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

static bool ffesta_is_inhibited_ = FALSE;
static ffelexToken ffesta_token_0_;	/* For use by ffest possibility
					   handling. */
static ffestaPossible_ ffesta_possibles_[FFESTA_maxPOSSIBLES_];
static int ffesta_num_possibles_ = 0;	/* Number of possibilities. */
static struct _ffesta_possible_root_ ffesta_possible_nonexecs_;
static struct _ffesta_possible_root_ ffesta_possible_execs_;
static ffestaPossible_ ffesta_current_possible_;
static ffelexHandler ffesta_current_handler_;
static bool ffesta_confirmed_current_ = FALSE;
static bool ffesta_confirmed_other_ = FALSE;
static ffestaPossible_ ffesta_confirmed_possible_;
static bool ffesta_current_shutdown_ = FALSE;
#if !FFESTA_ABORT_ON_CONFIRM_
static bool ffesta_is_two_into_statement_ = FALSE;	/* For IF, WHERE stmts. */
static ffelexToken ffesta_twotokens_1_;	/* For IF, WHERE stmts. */
static ffelexToken ffesta_twotokens_2_;	/* For IF, WHERE stmts. */
#endif
static ffestaPooldisp ffesta_outpooldisp_;	/* After statement dealt
						   with. */
static bool ffesta_inhibit_confirmation_ = FALSE;

/* Static functions (internal). */

static void ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named);
static bool ffesta_inhibited_exec_transition_ (void);
static void ffesta_reset_possibles_ (void);
static ffelexHandler ffesta_save_ (ffelexToken t);
static ffelexHandler ffesta_second_ (ffelexToken t);
#if !FFESTA_ABORT_ON_CONFIRM_
static ffelexHandler ffesta_send_two_ (ffelexToken t);
#endif

/* Internal macros. */

#define ffesta_add_possible_exec_(fn) (ffesta_add_possible_ (fn, TRUE, TRUE))
#define ffesta_add_possible_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, TRUE))
#define ffesta_add_possible_unnamed_exec_(fn) (ffesta_add_possible_ (fn, TRUE, FALSE))
#define ffesta_add_possible_unnamed_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, FALSE))

/* Add possible statement to appropriate list.  */

static void
ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named)
{
  ffestaPossible_ p;

  assert (ffesta_num_possibles_ < FFESTA_maxPOSSIBLES_);

  p = ffesta_possibles_[ffesta_num_possibles_++];

  if (exec)
    {
      p->next = (ffestaPossible_) &ffesta_possible_execs_.first;
      p->previous = ffesta_possible_execs_.last;
    }
  else
    {
      p->next = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
      p->previous = ffesta_possible_nonexecs_.last;
    }
  p->next->previous = p;
  p->previous->next = p;

  p->handler = fn;
  p->named = named;
}

/* ffesta_inhibited_exec_transition_ -- Do exec transition while inhibited

   if (!ffesta_inhibited_exec_transition_())  // couldn't transition...

   Invokes ffestc_exec_transition, but first enables ffebad and ffesta and
   afterwards disables them again.  Then returns the result of the
   invocation of ffestc_exec_transition.  */

static bool
ffesta_inhibited_exec_transition_ ()
{
  bool result;

  assert (ffebad_inhibit ());
  assert (ffesta_is_inhibited_);

  ffebad_set_inhibit (FALSE);
  ffesta_is_inhibited_ = FALSE;

  result = ffestc_exec_transition ();

  ffebad_set_inhibit (TRUE);
  ffesta_is_inhibited_ = TRUE;

  return result;
}

/* ffesta_reset_possibles_ -- Reset (clear) lists of possible statements

   ffesta_reset_possibles_();

   Clears the lists of executable and nonexecutable statements.	 */

static void
ffesta_reset_possibles_ ()
{
  ffesta_num_possibles_ = 0;

  ffesta_possible_execs_.first = ffesta_possible_execs_.last
    = (ffestaPossible_) &ffesta_possible_execs_.first;
  ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last
    = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
}

/* ffesta_save_ -- Save token on list, pass thru to current handler

   return ffesta_save_;	 // to lexer.

   Receives a token from the lexer.  Saves it in the list of tokens.  Calls
   the current handler with the token.

   If no shutdown error occurred (via
   ffest_ffebad_start), then if the token was EOS or SEMICOLON, mark the
   current possible as successful and confirmed but try the next possible
   anyway until ambiguities in the form handling are ironed out.  */

static ffelexHandler
ffesta_save_ (ffelexToken t)
{
  static ffelexToken *saved_tokens = NULL;	/* A variable-sized array. */
  static unsigned int num_saved_tokens = 0;	/* Number currently saved. */
  static unsigned int max_saved_tokens = 0;	/* Maximum to be saved. */
  unsigned int toknum;		/* Index into saved_tokens array. */
  ffelexToken eos;		/* EOS created on-the-fly for shutdown
				   purposes. */
  ffelexToken t2;		/* Another temporary token (no intersect with
				   eos, btw). */

  /* Save the current token. */

  if (saved_tokens == NULL)
    {
      saved_tokens
	= (ffelexToken *) malloc_new_ksr (malloc_pool_image (),
					  "FFEST Saved Tokens",
			     (max_saved_tokens = 8) * sizeof (ffelexToken));
      /* Start off with 8. */
    }
  else if (num_saved_tokens >= max_saved_tokens)
    {
      toknum = max_saved_tokens;
      max_saved_tokens <<= 1;	/* Multiply by two. */
      assert (max_saved_tokens > toknum);
      saved_tokens
	= (ffelexToken *) malloc_resize_ksr (malloc_pool_image (),
					     saved_tokens,
				    max_saved_tokens * sizeof (ffelexToken),
					     toknum * sizeof (ffelexToken));
    }

  *(saved_tokens + num_saved_tokens++) = ffelex_token_use (t);

  /* Transmit the current token to the current handler. */

  ffesta_current_handler_ = (ffelexHandler) (*ffesta_current_handler_) (t);

  /* See if this possible has been shut down, or confirmed in which case we
     might as well shut it down anyway to save time. */

  if ((ffesta_current_shutdown_ || (FFESTA_ABORT_ON_CONFIRM_
				    && ffesta_confirmed_current_))
      && !ffelex_expecting_character ())
    {
      switch (ffelex_token_type (t))
	{
	case FFELEX_typeEOS:
	case FFELEX_typeSEMICOLON:
	  break;

	default:
	  eos = ffelex_token_new_eos (ffelex_token_where_line (t),
				      ffelex_token_where_column (t));
	  ffesta_inhibit_confirmation_ = ffesta_current_shutdown_;
	  (*ffesta_current_handler_) (eos);
	  ffesta_inhibit_confirmation_ = FALSE;
	  ffelex_token_kill (eos);
	  break;
	}
    }
  else
    {

      /* If this is an EOS or SEMICOLON token, switch to next handler, else
	 return self as next handler for lexer. */

      switch (ffelex_token_type (t))
	{
	case FFELEX_typeEOS:
	case FFELEX_typeSEMICOLON:
	  break;

	default:
	  return (ffelexHandler) ffesta_save_;
	}
    }

 next_handler:			/* :::::::::::::::::::: */

  /* Note that a shutdown also happens after seeing the first two tokens
     after "IF (expr)" or "WHERE (expr)" where a statement follows, even
     though there is no error.	This causes the IF or WHERE form to be
     implemented first before ffest_first is called for the first token in
     the following statement. */

  if (ffesta_current_shutdown_)
    ffesta_current_shutdown_ = FALSE;	/* Only after sending EOS! */
  else
    assert (ffesta_confirmed_current_);

  if (ffesta_confirmed_current_)
    {
      ffesta_confirmed_current_ = FALSE;
      ffesta_confirmed_other_ = TRUE;
    }

  /* Pick next handler. */

  ffesta_current_possible_ = ffesta_current_possible_->next;
  ffesta_current_handler_ = ffesta_current_possible_->handler;
  if (ffesta_current_handler_ == NULL)
    {				/* No handler in this list, try exec list if
				   not tried yet. */
      if (ffesta_current_possible_
	  == (ffestaPossible_) &ffesta_possible_nonexecs_)
	{
	  ffesta_current_possible_ = ffesta_possible_execs_.first;
	  ffesta_current_handler_ = ffesta_current_possible_->handler;
	}
      if ((ffesta_current_handler_ == NULL)
	  || (!ffesta_seen_first_exec
	      && ((ffesta_confirmed_possible_ != NULL)
		  || !ffesta_inhibited_exec_transition_ ())))
	/* Don't run execs if:	  (decoding the "if" ^^^ up here ^^^) - we
	   have no exec handler available, or - we haven't seen the first
	   executable statement yet, and - we've confirmed a nonexec
	   (otherwise even a nonexec would cause a transition), or - a
	   nonexec-to-exec transition can't be made at the statement context
	   level (as in an executable statement in the middle of a STRUCTURE
	   definition); if it can be made, ffestc_exec_transition makes the
	   corresponding transition at the statement state level so
	   specification statements are no longer accepted following an
	   unrecognized statement.  (Note: it is valid for f_e_t_ to decide
	   to always return TRUE by "shrieking" away the statement state
	   stack until a transitionable state is reached.  Or it can leave
	   the stack as is and return FALSE.)

	   If we decide not to run execs, enter this block to rerun the
	   confirmed statement, if any. */
	{			/* At end of both lists!  Pick confirmed or
				   first possible. */
	  ffebad_set_inhibit (FALSE);
	  ffesta_is_inhibited_ = FALSE;
	  ffesta_confirmed_other_ = FALSE;
	  ffesta_tokens[0] = ffesta_token_0_;
	  if (ffesta_confirmed_possible_ == NULL)
	    {			/* No confirmed success, just use first
				   named possible, or first possible if
				   no named possibles. */
	      ffestaPossible_ possible = ffesta_possible_nonexecs_.first;
	      ffestaPossible_ first = NULL;
	      ffestaPossible_ first_named = NULL;
	      ffestaPossible_ first_exec = NULL;

	      for (;;)
		{
		  if (possible->handler == NULL)
		    {
		      if (possible == (ffestaPossible_) &ffesta_possible_nonexecs_)
			{
			  possible = first_exec = ffesta_possible_execs_.first;
			  continue;
			}
		      else
			break;
		    }
		  if (first == NULL)
		    first = possible;
		  if (possible->named
		      && (first_named == NULL))
		    first_named = possible;

		  possible = possible->next;
		}

	      if (first_named != NULL)