stb.c

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

#ifdef FFECOM_dimensionsMAX
      if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
	{
	  ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
	  return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
					      ffestb_subrargs_.dim_list.ctx,
				  (ffeexprCallback) ffestb_subr_dimlist_2_);
	}
#endif
      ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
			     ffelex_token_use (t));	/* NULL second expr for
							   now, just plug in. */
      return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
					  ffestb_subrargs_.dim_list.ctx,
				  (ffeexprCallback) ffestb_subr_dimlist_1_);

    default:
      break;
    }

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

/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr

   (ffestb_subr_dimlist_1_)  // to expression handler

   Get the upper bound.	 */

static ffelexHandler
ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCLOSE_PAREN:
      ffestb_subrargs_.dim_list.dims->previous->upper = expr;
      ffestb_subrargs_.dim_list.ok = TRUE;
      return (ffelexHandler) ffestb_subrargs_.dim_list.handler;

    case FFELEX_typeCOMMA:
      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
	break;
      ffestb_subrargs_.dim_list.dims->previous->upper = expr;
      return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
      ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);

    default:
      break;
    }

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

/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs

   (ffestb_subr_dimlist_2_)  // to expression handler

   Get the upper bound.	 */

static ffelexHandler
ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCLOSE_PAREN:
      ffestb_subrargs_.dim_list.ok = TRUE;	/* Not a parse error, really. */
      return (ffelexHandler) ffestb_subrargs_.dim_list.handler;

    case FFELEX_typeCOMMA:
    case FFELEX_typeCOLON:
      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
	break;
      return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
					  ffestb_subrargs_.dim_list.ctx,
				  (ffeexprCallback) ffestb_subr_dimlist_2_);

    default:
      break;
    }

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

/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren

   return ffestb_subr_name_list_;  // to lexer after seeing OPEN_PAREN

   This implements R1224 in the Fortran 90 spec.  The arg list may be
   empty, or be a comma-separated list (an optional trailing comma currently
   results in a warning but no other effect) of arguments.  For functions,
   however, "*" is invalid (we implement dummy-arg-name, rather than R1224
   dummy-arg, which itself is either dummy-arg-name or "*").  */

static ffelexHandler
ffestb_subr_name_list_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCLOSE_PAREN:
      if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
	{			/* Trailing comma, warn. */
	  ffebad_start (FFEBAD_TRAILING_COMMA);
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_finish ();
	}
      ffestb_subrargs_.name_list.ok = TRUE;
      ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
      if (ffestb_subrargs_.name_list.names)
	ffelex_set_names (TRUE);
      return (ffelexHandler) ffestb_subrargs_.name_list.handler;

    case FFELEX_typeASTERISK:
      if (!ffestb_subrargs_.name_list.is_subr)
	break;

    case FFELEX_typeNAME:
      ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
			       ffelex_token_use (t));
      return (ffelexHandler) ffestb_subr_name_list_1_;

    default:
      break;
    }

  ffestb_subrargs_.name_list.ok = FALSE;
  ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
  if (ffestb_subrargs_.name_list.names)
    ffelex_set_names (TRUE);
  return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
}

/* ffestb_subr_name_list_1_ -- NAME or ASTERISK

   return ffestb_subr_name_list_1_;  // to lexer

   The next token must be COMMA or CLOSE_PAREN, either way go to original
   state, but only after adding the appropriate name list item.	 */

static ffelexHandler
ffestb_subr_name_list_1_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCOMMA:
      return (ffelexHandler) ffestb_subr_name_list_;

    case FFELEX_typeCLOSE_PAREN:
      ffestb_subrargs_.name_list.ok = TRUE;
      ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
      if (ffestb_subrargs_.name_list.names)
	ffelex_set_names (TRUE);
      return (ffelexHandler) ffestb_subrargs_.name_list.handler;

    default:
      ffestb_subrargs_.name_list.ok = FALSE;
      ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
      if (ffestb_subrargs_.name_list.names)
	ffelex_set_names (TRUE);
      return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
    }
}

static void
ffestb_subr_R1001_append_p_ (void)
{
  ffesttFormatList f;

  if (!ffestb_local_.format.pre.present)
    {
      ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
      ffelex_token_kill (ffestb_local_.format.t);
      return;
    }

  f = ffestt_formatlist_append (ffestb_local_.format.f);
  f->type = FFESTP_formattypeP;
  f->t = ffestb_local_.format.t;
  f->u.R1010.val = ffestb_local_.format.pre;
}

/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN

   return ffestb_decl_kindparam_;  // to lexer

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

static ffelexHandler
ffestb_decl_kindparam_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeNAME:
      ffesta_tokens[1] = ffelex_token_use (t);
      return (ffelexHandler) ffestb_decl_kindparam_1_;

    default:
      return (ffelexHandler) (*((ffelexHandler)
				ffeexpr_rhs (ffesta_output_pool,
					     FFEEXPR_contextKINDTYPE,
			       (ffeexprCallback) ffestb_decl_kindparam_2_)))
	(t);
    }
}

/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME

   return ffestb_decl_kindparam_1_;  // to lexer

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

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

  switch (ffelex_token_type (t))
    {
    case FFELEX_typeEQUALS:
      ffesta_confirmed ();
      if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
	break;
      ffelex_token_kill (ffesta_tokens[1]);
      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
       FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);

    default:
      nt = ffesta_tokens[1];
      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
      FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
	(nt);
      ffelex_token_kill (nt);
      return (ffelexHandler) (*next) (t);
    }

  if (ffestb_local_.decl.recursive != NULL)
    ffelex_token_kill (ffestb_local_.decl.recursive);
  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_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr

   (ffestb_decl_kindparam_2_)  // to expression handler

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

static ffelexHandler
ffestb_decl_kindparam_2_ (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);
      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);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_starkind_ -- "type" ASTERISK

   return ffestb_decl_starkind_;  // to lexer

   Handle NUMBER.  */

static ffelexHandler
ffestb_decl_starkind_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeNUMBER:
      ffestb_local_.decl.kindt = ffelex_token_use (t);
      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);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK

   return ffestb_decl_starlen_;	 // to lexer

   Handle NUMBER.  */

static ffelexHandler
ffestb_decl_starlen_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeNUMBER:
      ffestb_local_.decl.kind = NULL;
      ffestb_local_.decl.kindt = NULL;
      ffestb_local_.decl.len = NULL;
      ffestb_local_.decl.lent = ffelex_token_use (t);
      ffelex_set_names (TRUE);
      return (ffelexHandler) ffestb_local_.decl.handler;

    case FFELEX_typeOPEN_PAREN:
      ffestb_local_.decl.kind = NULL;
      ffestb_local_.decl.kindt = NULL;
      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
					  FFEEXPR_contextCHARACTERSIZE,
				  (ffeexprCallback) ffestb_decl_starlen_1_);

    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_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr

   (ffestb_decl_starlen_1_)  // to expression handler

   Handle CLOSE_PAREN.	*/

static ffelexHandler
ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
  switch (ffelex_token_type (t))
    {
    case FFELEX_typeCLOSE_PAREN:
      if (expr == NULL)
	break;
      ffestb_local_.decl.len = expr;
      ffestb_local_.decl.lent = ffelex_token_use (ft);
      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);
  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
		    ffestb_local_.decl.badname,
		    t);
  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}

/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN

   return ffestb_decl_typeparams_;  // to lexer

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

static ffelexHandler
ffestb_decl_typeparams_ (ffelexToken t)
{
  switch (ffelex_token_type (t))
    {