if (((g = ffesymbol_global (fn)) != NULL) && (ffeglobal_type (g) == gt)) { ffeglobal_set_hook (g, current_function_decl); }
ffecom_do_entry_ (ffesymbol fn, int entrynum){  ffebld item;  tree type;			/* Type of function. */  tree multi_retval;		/* Var holding return value (union). */  tree result;			/* Var holding result. */  ffeinfoBasictype bt;  ffeinfoKindtype kt;  bool charfunc;		/* All entry points return same type				   CHARACTER. */  bool cmplxfunc;		/* Use f2c way of returning COMPLEX. */  bool multi;			/* Master fn has multiple return types. */  bool altreturning = FALSE;	/* This entry point has alternate returns. */  int yes;  /* c-parse.y indeed does call suspend_momentary and not only ignores the     return value, but also never calls resume_momentary, when starting an     outer function (see "fndef:", "setspecs:", and so on).  So g77 does the     same thing.  It shouldn't be a problem since start_function calls     temporary_allocation, but it might be necessary.  If it causes a problem     here, then maybe there's a bug lurking in gcc.  NOTE: This identical     comment appears twice in thist file.  */  suspend_momentary ();  ffecom_doing_entry_ = TRUE;	/* Don't bother with array dimensions. */  switch (ffecom_primary_entry_kind_)    {    case FFEINFO_kindFUNCTION:      /* Determine actual return type for function. */      bt = ffesymbol_basictype (fn);      kt = ffesymbol_kindtype (fn);      if (bt == FFEINFO_basictypeNONE)	{	  ffeimplic_establish_symbol (fn);	  if (ffesymbol_funcresult (fn) != NULL)	    ffeimplic_establish_symbol (ffesymbol_funcresult (fn));	  bt = ffesymbol_basictype (fn);	  kt = ffesymbol_kindtype (fn);	}      if (bt == FFEINFO_basictypeCHARACTER)	charfunc = TRUE, cmplxfunc = FALSE;      else if ((bt == FFEINFO_basictypeCOMPLEX)	       && ffesymbol_is_f2c (fn))	charfunc = FALSE, cmplxfunc = TRUE;      else	charfunc = cmplxfunc = FALSE;      if (charfunc)	type = ffecom_tree_fun_type_void;      else if (ffesymbol_is_f2c (fn))	type = ffecom_tree_fun_type[bt][kt];      else	type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);      if ((type == NULL_TREE)	  || (TREE_TYPE (type) == NULL_TREE))	type = ffecom_tree_fun_type_void;	/* _sym_exec_transition. */      multi = (ffecom_master_bt_ == FFEINFO_basictypeNONE);      break;    case FFEINFO_kindSUBROUTINE:      bt = FFEINFO_basictypeNONE;      kt = FFEINFO_kindtypeNONE;      if (ffecom_is_altreturning_)	{			/* Am _I_ altreturning? */	  for (item = ffesymbol_dummyargs (fn);	       item != NULL;	       item = ffebld_trail (item))	    {	      if (ffebld_op (ffebld_head (item)) == FFEBLD_opSTAR)		{		  altreturning = TRUE;		  break;		}	    }	  if (altreturning)	    type = ffecom_tree_subr_type;	  else	    type = ffecom_tree_fun_type_void;	}      else	type = ffecom_tree_fun_type_void;      charfunc = FALSE;      cmplxfunc = FALSE;      multi = FALSE;      break;    default:      assert ("say what??" == NULL);      /* Fall through. */    case FFEINFO_kindANY:      bt = FFEINFO_basictypeNONE;      kt = FFEINFO_kindtypeNONE;      type = error_mark_node;      charfunc = FALSE;      cmplxfunc = FALSE;      multi = FALSE;      break;    }  /* build_decl uses the current lineno and input_filename to set the decl     source info.  So, I've putzed with ffestd and ffeste code to update that     source info to point to the appropriate statement just before calling     ffecom_do_entrypoint (which calls this fn).  */  start_function (ffecom_get_external_identifier_ (fn),		  type,		  0,		/* nested/inline */		  1);		/* TREE_PUBLIC */  /* Reset args in master arg list so they get retransitioned. */  for (item = ffecom_master_arglist_;       item != NULL;       item = ffebld_trail (item))    {      ffebld arg;      ffesymbol s;      arg = ffebld_head (item);      if (ffebld_op (arg) != FFEBLD_opSYMTER)	continue;		/* Alternate return or some such thing. */      s = ffebld_symter (arg);      ffesymbol_hook (s).decl_tree = NULL_TREE;      ffesymbol_hook (s).length_tree = NULL_TREE;    }  /* Build dummy arg list for this entry point. */  yes = suspend_momentary ();  if (charfunc || cmplxfunc)    {				/* Prepend arg for where result goes. */      tree type;      tree length;      if (charfunc)	type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];      else	type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];      result = ffecom_get_invented_identifier ("__g77_%s",					       "result", 0);      /* Make length arg _and_ enhance type info for CHAR arg itself.  */      if (charfunc)	length = ffecom_char_enhance_arg_ (&type, fn);      else	length = NULL_TREE;	/* Not ref'd if !charfunc. */      type = build_pointer_type (type);      result = build_decl (PARM_DECL, result, type);      push_parm_decl (result);      ffecom_func_result_ = result;      if (charfunc)	{	  push_parm_decl (length);	  ffecom_func_length_ = length;	}    }  else    result = DECL_RESULT (current_function_decl);  ffecom_push_dummy_decls_ (ffesymbol_dummyargs (fn), FALSE);  resume_momentary (yes);  store_parm_decls (0);  ffecom_start_compstmt_ ();  /* Make local var to hold return type for multi-type master fn. */  if (multi)    {      yes = suspend_momentary ();      multi_retval = ffecom_get_invented_identifier ("__g77_%s",						     "multi_retval", 0);      multi_retval = build_decl (VAR_DECL, multi_retval,				 ffecom_multi_type_node_);      multi_retval = start_decl (multi_retval, FALSE);      finish_decl (multi_retval, NULL_TREE, FALSE);      resume_momentary (yes);    }  else    multi_retval = NULL_TREE;	/* Not actually ref'd if !multi. */  /* Here we emit the actual code for the entry point. */  {    ffebld list;    ffebld arg;    ffesymbol s;    tree arglist = NULL_TREE;    tree *plist = &arglist;    tree prepend;    tree call;    tree actarg;    tree master_fn;    /* Prepare actual arg list based on master arg list. */    for (list = ffecom_master_arglist_;	 list != NULL;	 list = ffebld_trail (list))      {	arg = ffebld_head (list);	if (ffebld_op (arg) != FFEBLD_opSYMTER)	  continue;	s = ffebld_symter (arg);	if (ffesymbol_hook (s).decl_tree == NULL_TREE)	  actarg = null_pointer_node;	/* We don't have this arg. */	else	  actarg = ffesymbol_hook (s).decl_tree;	*plist = build_tree_list (NULL_TREE, actarg);	plist = &TREE_CHAIN (*plist);      }    /* This code appends the length arguments for character       variables/arrays.  */    for (list = ffecom_master_arglist_;	 list != NULL;	 list = ffebld_trail (list))      {	arg = ffebld_head (list);	if (ffebld_op (arg) != FFEBLD_opSYMTER)	  continue;	s = ffebld_symter (arg);	if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER)	  continue;		/* Only looking for CHARACTER arguments. */	if (ffesymbol_kind (s) != FFEINFO_kindENTITY)	  continue;		/* Only looking for variables and arrays. */	if (ffesymbol_hook (s).length_tree == NULL_TREE)	  actarg = ffecom_f2c_ftnlen_zero_node;	/* We don't have this arg. */	else	  actarg = ffesymbol_hook (s).length_tree;	*plist = build_tree_list (NULL_TREE, actarg);	plist = &TREE_CHAIN (*plist);      }    /* Prepend character-value return info to actual arg list. */    if (charfunc)      {	prepend = build_tree_list (NULL_TREE, ffecom_func_result_);	TREE_CHAIN (prepend)	  = build_tree_list (NULL_TREE, ffecom_func_length_);	TREE_CHAIN (TREE_CHAIN (prepend)) = arglist;	arglist = prepend;      }    /* Prepend multi-type return value to actual arg list. */    if (multi)      {	prepend	  = build_tree_list (NULL_TREE,			     ffecom_1 (ADDR_EXPR,			      build_pointer_type (TREE_TYPE (multi_retval)),				       multi_retval));	TREE_CHAIN (prepend) = arglist;	arglist = prepend;      }    /* Prepend my entry-point number to the actual arg list. */    prepend = build_tree_list (NULL_TREE, build_int_2 (entrynum, 0));    TREE_CHAIN (prepend) = arglist;    arglist = prepend;    /* Build the call to the master function. */    master_fn = ffecom_1_fn (ffecom_previous_function_decl_);    call = ffecom_3s (CALL_EXPR,		      TREE_TYPE (TREE_TYPE (TREE_TYPE (master_fn))),		      master_fn, arglist, NULL_TREE);    /* Decide whether the master function is a function or subroutine, and       handle the return value for my entry point. */    if (charfunc || ((ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)		     && !altreturning))      {	expand_expr_stmt (call);	expand_null_return ();      }    else if (multi && cmplxfunc)      {	expand_expr_stmt (call);	result	  = ffecom_1 (INDIRECT_REF,		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),		      result);	result = ffecom_modify (NULL_TREE, result,				ffecom_2 (COMPONENT_REF, TREE_TYPE (result),					  multi_retval,					  ffecom_multi_fields_[bt][kt]));	expand_expr_stmt (result);	expand_null_return ();      }    else if (multi)      {	expand_expr_stmt (call);	result	  = ffecom_modify (NULL_TREE, result,			   convert (TREE_TYPE (result),				    ffecom_2 (COMPONENT_REF,					      ffecom_tree_type[bt][kt],					      multi_retval,					      ffecom_multi_fields_[bt][kt])));	expand_return (result);      }    else if (cmplxfunc)      {	result	  = ffecom_1 (INDIRECT_REF,		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),		      result);	result = ffecom_modify (NULL_TREE, result, call);	expand_expr_stmt (result);	expand_null_return ();      }    else      {	result = ffecom_modify (NULL_TREE,				result,				convert (TREE_TYPE (result),					 call));	expand_return (result);      }    clear_momentary ();  }  ffecom_end_compstmt_ ();  finish_function (0);  ffecom_doing_entry_ = FALSE;}