sta.c

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

    case FFESTR_firstUNION:
      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V009);
      break;
#endif

#if FFESTR_F90
    case FFESTR_firstUSE:
      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1107);
      break;
#endif

    case FFESTR_firstVIRTUAL:
      ffestb_args.R524.len = FFESTR_firstlVIRTUAL;
      ffestb_args.R524.badname = "VIRTUAL";
      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524);
      break;

    case FFESTR_firstVOLATILE:
      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V014);
      break;

#if HARD_F90
    case FFESTR_firstWHERE:
      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_where);
      break;
#endif

    case FFESTR_firstWORD:
      ffestb_args.decl.len = FFESTR_firstlWORD;
      ffestb_args.decl.type = FFESTP_typeWORD;
      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
      break;

    case FFESTR_firstWRITE:
      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R910);
      break;

    default:
      break;
    }

  /* Now check the default cases, which are always "live" (meaning that no
     other possibility can override them).  These are where the second token
     is OPEN_PAREN, PERCENT, EQUALS, POINTS, or COLON. */

  switch (ffelex_token_type (t))
    {
    case FFELEX_typeOPEN_PAREN:
      s = ffesymbol_lookup_local (ffesta_token_0_);
      if (((s == NULL) || (ffesymbol_dims (s) == NULL))
	  && !ffesta_seen_first_exec)
	{			/* Not known as array; may be stmt function. */
	  ffesta_add_possible_unnamed_nonexec_ ((ffelexHandler) ffestb_R1229);

	  /* If the symbol is (or will be due to implicit typing) of
	     CHARACTER type, then the statement might be an assignment
	     statement.	 If so, since it can't be a function invocation nor
	     an array element reference, the open paren following the symbol
	     name must be followed by an expression and a colon.  Without the
	     colon (which cannot appear in a stmt function definition), the
	     let stmt rejects.	So CHARACTER_NAME(...)=expr, unlike any other
	     type, is not ambiguous alone. */

	  if (ffeimplic_peek_symbol_type (s,
					ffelex_token_text (ffesta_token_0_))
	      == FFEINFO_basictypeCHARACTER)
	    ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
	}
      else			/* Not statement function if known as an
				   array. */
	ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
      break;

#if FFESTR_F90
    case FFELEX_typePERCENT:
#endif
    case FFELEX_typeEQUALS:
#if FFESTR_F90
    case FFELEX_typePOINTS:
#endif
      ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
      break;

    case FFELEX_typeCOLON:
      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_construct);
      break;

    default:
      ;
    }

  /* Now see how many possibilities are on the list. */

  switch (ffesta_num_possibles_)
    {
    case 0:			/* None, so invalid statement. */
    no_stmts:			/* :::::::::::::::::::: */
      ffesta_tokens[0] = ffesta_token_0_;
      ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_token_0_, t);
      next = (ffelexHandler) ffelex_swallow_tokens (NULL,
					       (ffelexHandler) ffesta_zero);
      break;

    case 1:			/* One, so just do it! */
      ffesta_tokens[0] = ffesta_token_0_;
      next = ffesta_possible_execs_.first->handler;
      if (next == NULL)
	{			/* Have a nonexec stmt. */
	  next = ffesta_possible_nonexecs_.first->handler;
	  assert (next != NULL);
	}
      else if (ffesta_seen_first_exec)
	;			/* Have an exec stmt after exec transition. */
      else if (!ffestc_exec_transition ())
	/* 1 exec stmt only, but not valid in context, so pretend as though
	   statement is unrecognized. */
	goto no_stmts;		/* :::::::::::::::::::: */
      break;

    default:			/* More than one, so try them in order. */
      ffesta_confirmed_possible_ = NULL;
      ffesta_current_possible_ = ffesta_possible_nonexecs_.first;
      ffesta_current_handler_ = ffesta_current_possible_->handler;
      if (ffesta_current_handler_ == NULL)
	{
	  ffesta_current_possible_ = ffesta_possible_execs_.first;
	  ffesta_current_handler_ = ffesta_current_possible_->handler;
	  assert (ffesta_current_handler_ != NULL);
	  if (!ffesta_seen_first_exec)
	    {			/* Need to do exec transition now. */
	      ffesta_tokens[0] = ffesta_token_0_;
	      if (!ffestc_exec_transition ())
		goto no_stmts;	/* :::::::::::::::::::: */
	    }
	}
      ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_);
      next = (ffelexHandler) ffesta_save_;
      ffebad_set_inhibit (TRUE);
      ffesta_is_inhibited_ = TRUE;
      break;
    }

  ffesta_output_pool
    = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024);
  ffesta_scratch_pool
    = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024);
  ffesta_outpooldisp_ = FFESTA_pooldispDISCARD;

  if (ffesta_is_inhibited_)
    ffesymbol_set_retractable (ffesta_scratch_pool);

  ffelex_set_names (FALSE);	/* Most handlers will want this.  If not,
				   they have to set it TRUE again (its value
				   at the beginning of a statement). */

  return (ffelexHandler) (*next) (t);
}

/* ffesta_send_two_ -- Send the two tokens saved by ffesta_two after all

   return ffesta_send_two_;  // to lexer.

   Currently, if this function gets called, it means that the two tokens
   saved by ffesta_two did not have their handlers derailed by
   ffesta_save_, which probably means they weren't sent by ffesta_save_
   but directly by the lexer, which probably means the original statement
   (which should be IF (expr) or WHERE (expr)) somehow evaluated to only
   one possibility in ffesta_second_ or somebody optimized FFEST to
   immediately revert to one possibility upon confirmation but forgot to
   change this function (and thus perhaps the entire resubmission
   mechanism).	*/

#if !FFESTA_ABORT_ON_CONFIRM_
static ffelexHandler
ffesta_send_two_ (ffelexToken t)
{
  assert ("what am I doing here?" == NULL);
  return NULL;
}

#endif
/* ffesta_confirmed -- Confirm current possibility as only one

   ffesta_confirmed();

   Sets the confirmation flag.	During debugging for ambiguous constructs,
   asserts that the confirmation flag for a previous possibility has not
   yet been set.  */

void
ffesta_confirmed ()
{
  if (ffesta_inhibit_confirmation_)
    return;
  ffesta_confirmed_current_ = TRUE;
  assert (!ffesta_confirmed_other_
	  || (ffesta_confirmed_possible_ == ffesta_current_possible_));
  ffesta_confirmed_possible_ = ffesta_current_possible_;
}

/* ffesta_eof -- End of (non-INCLUDEd) source file

   ffesta_eof();

   Call after piping tokens through ffest_first, where the most recent
   token sent through must be EOS.

   20-Feb-91  JCB  1.1
      Put new EOF token in ffesta_tokens[0], not NULL, because too much
      code expects something there for error reporting and the like.  Also,
      do basically the same things ffest_second and ffesta_zero do for
      processing a statement (make and destroy pools, et cetera).  */

void
ffesta_eof ()
{
  ffesta_tokens[0] = ffelex_token_new_eof ();

  ffesta_output_pool
    = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024);
  ffesta_scratch_pool
    = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024);
  ffesta_outpooldisp_ = FFESTA_pooldispDISCARD;

  ffestc_eof ();

  if (ffesta_tokens[0] != NULL)
    ffelex_token_kill (ffesta_tokens[0]);

  if (ffesta_output_pool != NULL)
    {
      if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
	malloc_pool_kill (ffesta_output_pool);
      ffesta_output_pool = NULL;
    }

  if (ffesta_scratch_pool != NULL)
    {
      malloc_pool_kill (ffesta_scratch_pool);
      ffesta_scratch_pool = NULL;
    }

  if (ffesta_label_token != NULL)
    {
      ffelex_token_kill (ffesta_label_token);
      ffesta_label_token = NULL;
    }

  if (ffe_is_ffedebug ())
    {
      ffestorag_report ();
#if FFECOM_targetCURRENT == FFECOM_targetFFE
      ffesymbol_report_all ();
#endif
    }
}

/* ffesta_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt

   ffesta_ffebad_here_current_stmt(0);

   Outsiders can call this fn if they have no more convenient place to
   point to (via a token or pair of ffewhere objects) and they know a
   current, useful statement is being evaluted by ffest (i.e. they are
   being called from ffestb, ffestc, ffestd, ... functions).  */

void
ffesta_ffebad_here_current_stmt (ffebadIndex i)
{
  assert (ffesta_tokens[0] != NULL);
  ffebad_here (i, ffelex_token_where_line (ffesta_tokens[0]),
	       ffelex_token_where_column (ffesta_tokens[0]));
}

/* ffesta_ffebad_start -- Start a possibly inhibited error report

   if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))
       {
       ffebad_here, ffebad_string ...;
       ffebad_finish();
       }

   Call if the error might indicate that ffest is evaluating the wrong
   statement form, instead of calling ffebad_start directly.  If ffest
   is choosing between forms, it will return FALSE, send an EOS/SEMICOLON
   token through as the next token (if the current one isn't already one
   of those), and try another possible form.  Otherwise, ffebad_start is
   called with the argument and TRUE returned.	*/

bool
ffesta_ffebad_start (ffebad errnum)
{
  if (!ffesta_is_inhibited_)
    {
      ffebad_start (errnum);
      return TRUE;
    }

  if (!ffesta_confirmed_current_)
    ffesta_current_shutdown_ = TRUE;

  return FALSE;
}

/* ffesta_first -- Parse the first token in a statement

   return ffesta_first;	 // to lexer.  */

ffelexHandler
ffesta_first (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeSEMICOLON:
    case FFELEX_typeEOS:
      ffesta_tokens[0] = ffelex_token_use (t);
      if (ffesta_label_token != NULL)
	{
	  ffebad_start (FFEBAD_LABEL_WITHOUT_STMT);
	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
		       ffelex_token_where_column (ffesta_label_token));
	  ffebad_string (ffelex_token_text (ffesta_label_token));
	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_finish ();
	}
      return (ffelexHandler) ffesta_zero (t);

    case FFELEX_typeNAME:
    case FFELEX_typeNAMES:
      ffesta_token_0_ = ffelex_token_use (t);
      ffesta_first_kw = ffestr_first (t);
      return (ffelexHandler) ffesta_second_;

    case FFELEX_typeNUMBER:
      if (ffesta_line_has_semicolons
	  && !ffe_is_free_form ()
	  && ffe_is_pedantic ())
	{
	  ffebad_start (FFEBAD_LABEL_WRONG_PLACE);
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_string (ffelex_token_text (t));
	  ffebad_finish ();
	}
      if (ffesta_label_token == NULL)
	{
	  ffesta_label_token = ffelex_token_use (t);
	  return (ffelexHandler) ffesta_first;
	}
      else
	{
	  ffebad_start (FFEBAD_EXTRA_LABEL_DEF);
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_string (ffelex_token_text (t));
	  ffebad_here (1, ffelex_token_where_line (ffesta_label_token),
		       ffelex_token_where_column (ffesta_label_token));
	  ffebad_string (ffelex_token_text (ffesta_label_token));
	  ffebad_finish ();

	  return (ffelexHandler) ffesta_first;
	}

    default:			/* Invalid first token. */
      ffesta_tokens[0] = ffelex_token_use (t);
      ffebad_start (FFEBAD_STMT_BEGINS_BAD);
      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
      ffebad_finish ();
      return (ffelexHandler) ffelex_swallow_tokens (t,
					       (ffelexHandler) ffesta_zero);
    }
}

/* ffesta_init_0 -- Initialize for entire image invocation

   ffesta_init_0();

   Call just once per invocation of the compiler (not once per invocation
   of the front end).

   Gets memory for the list of possibles once and for all, since this
   list never gets larger than a certain size (FFESTA_maxPOSSIBLES_)
   and is not particularly large.  Initializes the array of pointers to
   this list.  Initializes the executable and nonexecutable lists.  */

void
ffesta_init_0 ()
{
  ffestaPossible_ ptr;
  int i;

  ptr = (ffestaPossible_) malloc_new_kp (malloc_pool_image (),
					 "FFEST possibles",
					 FFESTA_maxPOSSIBLES_
					 * sizeof (*ptr));

  for (i = 0; i < FFESTA_maxPOSSIBLES_; ++i)
    ffesta_possibles_[i] = ptr++;

  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;