stb.c

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

    case FFELEX_typeNAME:
      ffesta_tokens[1] = ffelex_token_use (t);
      return (ffelexHandler) ffestb_decl_typeparams_1_;

    default:
      if (ffestb_local_.decl.lent == NULL)
	return (ffelexHandler) (*((ffelexHandler)
				  ffeexpr_rhs (ffesta_output_pool,
					       FFEEXPR_contextCHARACTERSIZE,
			      (ffeexprCallback) ffestb_decl_typeparams_2_)))
	  (t);
      if (ffestb_local_.decl.kindt != NULL)
	break;
      return (ffelexHandler) (*((ffelexHandler)
				ffeexpr_rhs (ffesta_output_pool,
					     FFEEXPR_contextKINDTYPE,
			      (ffeexprCallback) ffestb_decl_typeparams_3_)))
	(t);
    }

  if (ffestb_local_.decl.recursive != NULL)
    ffelex_token_kill (ffestb_local_.decl.recursive);
  if (ffestb_local_.decl.kindt != NULL)
    ffelex_token_kill (ffestb_local_.decl.kindt);
  if (ffestb_local_.decl.lent != NULL)
    ffelex_token_kill (ffestb_local_.decl.lent);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME

   return ffestb_decl_typeparams_1_;  // to lexer

   Handle "[KIND=]expr)".  */

static ffelexHandler
ffestb_decl_typeparams_1_ (ffelexToken t)
{
  ffelexHandler next;
  ffelexToken nt;

  switch (ffelex_token_type (t))
    {
    case FFELEX_typeEQUALS:
      ffesta_confirmed ();
      switch (ffestr_other (ffesta_tokens[1]))
	{
	case FFESTR_otherLEN:
	  if (ffestb_local_.decl.lent != NULL)
	    break;
	  ffelex_token_kill (ffesta_tokens[1]);
	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
					      FFEEXPR_contextCHARACTERSIZE,
			       (ffeexprCallback) ffestb_decl_typeparams_2_);

	case FFESTR_otherKIND:
	  if (ffestb_local_.decl.kindt != NULL)
	    break;
	  ffelex_token_kill (ffesta_tokens[1]);
	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
					      FFEEXPR_contextKINDTYPE,
			       (ffeexprCallback) ffestb_decl_typeparams_3_);

	default:
	  break;
	}
      break;

    default:
      nt = ffesta_tokens[1];
      if (ffestb_local_.decl.lent == NULL)
	next = (ffelexHandler) (*((ffelexHandler)
				  ffeexpr_rhs (ffesta_output_pool,
					       FFEEXPR_contextCHARACTERSIZE,
			      (ffeexprCallback) ffestb_decl_typeparams_2_)))
	  (nt);
      else if (ffestb_local_.decl.kindt == NULL)
	next = (ffelexHandler) (*((ffelexHandler)
				  ffeexpr_rhs (ffesta_output_pool,
					       FFEEXPR_contextKINDTYPE,
			      (ffeexprCallback) ffestb_decl_typeparams_3_)))
	  (nt);
      else
	{
	  ffesta_tokens[1] = nt;
	  break;
	}
      ffelex_token_kill (nt);
      return (ffelexHandler) (*next) (t);
    }

  if (ffestb_local_.decl.recursive != NULL)
    ffelex_token_kill (ffestb_local_.decl.recursive);
  if (ffestb_local_.decl.kindt != NULL)
    ffelex_token_kill (ffestb_local_.decl.kindt);
  if (ffestb_local_.decl.lent != NULL)
    ffelex_token_kill (ffestb_local_.decl.lent);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    ffesta_tokens[1]);
  ffelex_token_kill (ffesta_tokens[1]);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr

   (ffestb_decl_typeparams_2_)	// to expression handler

   Handle "[LEN=]expr)".  */

static ffelexHandler
ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCLOSE_PAREN:
      ffestb_local_.decl.len = expr;
      ffestb_local_.decl.lent = ffelex_token_use (ft);
      ffelex_set_names (TRUE);
      return (ffelexHandler) ffestb_local_.decl.handler;

    case FFELEX_typeCOMMA:
      ffestb_local_.decl.len = expr;
      ffestb_local_.decl.lent = ffelex_token_use (ft);
      return (ffelexHandler) ffestb_decl_typeparams_;

    default:
      break;
    }

  if (ffestb_local_.decl.recursive != NULL)
    ffelex_token_kill (ffestb_local_.decl.recursive);
  if (ffestb_local_.decl.kindt != NULL)
    ffelex_token_kill (ffestb_local_.decl.kindt);
  if (ffestb_local_.decl.lent != NULL)
    ffelex_token_kill (ffestb_local_.decl.lent);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr

   (ffestb_decl_typeparams_3_)	// to expression handler

   Handle "[KIND=]expr)".  */

static ffelexHandler
ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCLOSE_PAREN:
      ffestb_local_.decl.kind = expr;
      ffestb_local_.decl.kindt = ffelex_token_use (ft);
      ffelex_set_names (TRUE);
      return (ffelexHandler) ffestb_local_.decl.handler;

    case FFELEX_typeCOMMA:
      ffestb_local_.decl.kind = expr;
      ffestb_local_.decl.kindt = ffelex_token_use (ft);
      return (ffelexHandler) ffestb_decl_typeparams_;

    default:
      break;
    }

  if (ffestb_local_.decl.recursive != NULL)
    ffelex_token_kill (ffestb_local_.decl.recursive);
  if (ffestb_local_.decl.kindt != NULL)
    ffelex_token_kill (ffestb_local_.decl.kindt);
  if (ffestb_local_.decl.lent != NULL)
    ffelex_token_kill (ffestb_local_.decl.lent);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN

   return ffestb_decl_typetype1_;  // to lexer

   Handle NAME.	 */

#if FFESTR_F90
static ffelexHandler
ffestb_decl_typetype1_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeNAME:
      ffestb_local_.decl.kindt = ffelex_token_use (t);
      return (ffelexHandler) ffestb_decl_typetype2_;

    default:
      break;
    }

  if (ffestb_local_.decl.recursive != NULL)
    ffelex_token_kill (ffestb_local_.decl.recursive);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME

   return ffestb_decl_typetype2_;  // to lexer

   Handle CLOSE_PAREN.	*/

static ffelexHandler
ffestb_decl_typetype2_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCLOSE_PAREN:
      ffestb_local_.decl.type = FFESTP_typeTYPE;
      ffestb_local_.decl.kind = NULL;
      ffestb_local_.decl.len = NULL;
      ffestb_local_.decl.lent = NULL;
      ffelex_set_names (TRUE);
      return (ffelexHandler) ffestb_local_.decl.handler;

    default:
      break;
    }

  if (ffestb_local_.decl.recursive != NULL)
    ffelex_token_kill (ffestb_local_.decl.recursive);
  ffelex_token_kill (ffestb_local_.decl.kindt);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

#endif
/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren

   return ffestb_subr_label_list_;  // to lexer after seeing OPEN_PAREN

   First token must be a NUMBER.  Must be followed by zero or more COMMA
   NUMBER pairs.  Must then be followed by a CLOSE_PAREN.  If all ok, put
   the NUMBER tokens in a token list and return via the handler for the
   token after CLOSE_PAREN.  Else return via
   same handler, but with the ok return value set FALSE.  */

static ffelexHandler
ffestb_subr_label_list_ (ffelexToken t)
{
  if (ffelex_token_type (t) == FFELEX_typeNUMBER)
    {
      ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
			       ffelex_token_use (t));
      return (ffelexHandler) ffestb_subr_label_list_1_;
    }

  ffestb_subrargs_.label_list.ok = FALSE;
  return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
}

/* ffestb_subr_label_list_1_ -- NUMBER

   return ffestb_subr_label_list_1_;  // to lexer after seeing NUMBER

   The next token must be COMMA, in which case go back to
   ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
   and go to the handler.  */

static ffelexHandler
ffestb_subr_label_list_1_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCOMMA:
      return (ffelexHandler) ffestb_subr_label_list_;

    case FFELEX_typeCLOSE_PAREN:
      ffestb_subrargs_.label_list.ok = TRUE;
      return (ffelexHandler) ffestb_subrargs_.label_list.handler;

    default:
      ffestb_subrargs_.label_list.ok = FALSE;
      return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
    }
}

/* ffestb_do -- Parse the DO statement

   return ffestb_do;  // to lexer

   Make sure the statement has a valid form for the DO statement.  If it
   does, implement the statement.  */

ffelexHandler
ffestb_do (ffelexToken t)
{
  ffeTokenLength i;
  unsigned const char *p;
  ffelexHandler next;
  ffelexToken nt;
  ffestrSecond kw;

  switch (ffelex_token_type (ffesta_tokens[0]))
    {
    case FFELEX_typeNAME:
      if (ffesta_first_kw != FFESTR_firstDO)
	goto bad_0;		/* :::::::::::::::::::: */
      switch (ffelex_token_type (t))
	{
	case FFELEX_typeNUMBER:
	  ffesta_confirmed ();
	  ffesta_tokens[1] = ffelex_token_use (t);
	  return (ffelexHandler) ffestb_do1_;

	case FFELEX_typeCOMMA:
	  ffesta_confirmed ();
	  ffesta_tokens[1] = NULL;
	  return (ffelexHandler) ffestb_do2_;

	case FFELEX_typeNAME:
	  ffesta_confirmed ();
	  ffesta_tokens[1] = NULL;
	  ffesta_tokens[2] = ffelex_token_use (t);
	  return (ffelexHandler) ffestb_do3_;

	case FFELEX_typeEOS:
	case FFELEX_typeSEMICOLON:
	  ffesta_confirmed ();
	  ffesta_tokens[1] = NULL;
	  return (ffelexHandler) ffestb_do1_ (t);

	case FFELEX_typeCOLONCOLON:
	  ffesta_confirmed ();	/* Error, but clearly intended. */
	  goto bad_1;		/* :::::::::::::::::::: */

	default:
	  goto bad_1;		/* :::::::::::::::::::: */
	}

    case FFELEX_typeNAMES:
      if (ffesta_first_kw != FFESTR_firstDO)
	goto bad_0;		/* :::::::::::::::::::: */
      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO);
      switch (ffelex_token_type (t))
	{
	case FFELEX_typeCOLONCOLON:
	  ffesta_confirmed ();	/* Error, but clearly intended. */
	  goto bad_1;		/* :::::::::::::::::::: */

	default:
	  goto bad_1;		/* :::::::::::::::::::: */

	case FFELEX_typeOPEN_PAREN:	/* Must be "DO" label "WHILE". */
	  if (! ISDIGIT (*p))
	    goto bad_i;		/* :::::::::::::::::::: */
	  ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
							     i);
	  p += ffelex_token_length (ffesta_tokens[1]);
	  i += ffelex_token_length (ffesta_tokens[1]);
	  if (((*p) != 'W') && ((*p) != 'w'))
	    goto bad_i1;	/* :::::::::::::::::::: */
	  nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
	  kw = ffestr_second (nt);
	  ffelex_token_kill (nt);
	  if (kw != FFESTR_secondWHILE)
	    goto bad_i1;	/* :::::::::::::::::::: */
	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
		     FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);

	case FFELEX_typeCOMMA:
	  ffesta_confirmed ();
	  if (*p == '\0')
	    {
	      ffesta_tokens[1] = NULL;
	      return (ffelexHandler) ffestb_do2_;
	    }
	  if (! ISDIGIT (*p))
	    goto bad_i;		/* ::::::::