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

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:

   Description:
      Manages information kept across individual program units within a single
      source file.  This includes reporting errors when a name is defined
      multiple times (for example, two program units named FOO) and when a
      COMMON block is given initial data in more than one program unit.

   Modifications:
*/

/* Include files. */

#include "proj.h"
#include "global.h"
#include "info.h"
#include "lex.h"
#include "malloc.h"
#include "name.h"
#include "symbol.h"
#include "top.h"

/* Externals defined here. */


/* Simple definitions and enumerations. */


/* Internal typedefs. */


/* Private include files. */


/* Internal structure definitions. */


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

#if FFEGLOBAL_ENABLED
static ffenameSpace ffeglobal_filewide_ = NULL;
static char *ffeglobal_type_string_[] =
{
  [FFEGLOBAL_typeNONE] "??",
  [FFEGLOBAL_typeMAIN] "main program",
  [FFEGLOBAL_typeEXT] "external",
  [FFEGLOBAL_typeSUBR] "subroutine",
  [FFEGLOBAL_typeFUNC] "function",
  [FFEGLOBAL_typeBDATA] "block data",
  [FFEGLOBAL_typeCOMMON] "common block",
  [FFEGLOBAL_typeANY] "?any?"
};
#endif

/* Static functions (internal). */


/* Internal macros. */


/* Call given fn with all globals

   ffeglobal (*fn)(ffeglobal g);
   ffeglobal_drive(fn);	 */

#if FFEGLOBAL_ENABLED
void
ffeglobal_drive (ffeglobal (*fn) ())
{
  if (ffeglobal_filewide_ != NULL)
    ffename_space_drive_global (ffeglobal_filewide_, fn);
}

#endif
/* ffeglobal_new_ -- Make new global

   ffename n;
   ffeglobal g;
   g = ffeglobal_new_(n);  */

#if FFEGLOBAL_ENABLED
static ffeglobal
ffeglobal_new_ (ffename n)
{
  ffeglobal g;

  assert (n != NULL);

  g = (ffeglobal) malloc_new_ks (malloc_pool_image (), "FFEGLOBAL",
				 sizeof (*g));
  g->n = n;
#ifdef FFECOM_globalHOOK
  g->hook = FFECOM_globalNULL;
#endif
  g->tick = 0;

  ffename_set_global (n, g);

  return g;
}

#endif
/* ffeglobal_init_1 -- Initialize per file

   ffeglobal_init_1();	*/

void
ffeglobal_init_1 ()
{
#if FFEGLOBAL_ENABLED
  if (ffeglobal_filewide_ != NULL)
    ffename_space_kill (ffeglobal_filewide_);
  ffeglobal_filewide_ = ffename_space_new (malloc_pool_image ());
#endif
}

/* ffeglobal_init_common -- Initial value specified for common block

   ffesymbol s;	 // the ffesymbol for the common block
   ffelexToken t;  // the token with the point of initialization
   ffeglobal_init_common(s,t);

   For back ends where file-wide global symbols are not maintained, does
   nothing.  Otherwise, makes sure this common block hasn't already been
   initialized in a previous program unit, and flag that it's been
   initialized in this one.  */

void
ffeglobal_init_common (ffesymbol s, ffelexToken t)
{
#if FFEGLOBAL_ENABLED
  ffeglobal g;

  g = ffesymbol_global (s);

  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
    return;
  if (g->type == FFEGLOBAL_typeANY)
    return;

  if (g->tick == ffe_count_2)
    return;

  if (g->tick != 0)
    {
      if (g->u.common.initt != NULL)
	{
	  ffebad_start (FFEBAD_COMMON_ALREADY_INIT);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->u.common.initt),
		       ffelex_token_where_column (g->u.common.initt));
	  ffebad_finish ();
	}

      /* Complain about just one attempt to reinit per program unit, but
	 continue referring back to the first such successful attempt.  */
    }
  else
    {
      if (g->u.common.blank)
	{
	  ffebad_start (FFEBAD_COMMON_BLANK_INIT);
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_finish ();
	}

      g->u.common.initt = ffelex_token_use (t);
    }

  g->tick = ffe_count_2;
#endif
}

/* ffeglobal_new_common -- New common block

   ffesymbol s;	 // the ffesymbol for the new common block
   ffelexToken t;  // the token with the name of the common block
   bool blank;	// TRUE if blank common
   ffeglobal_new_common(s,t,blank);

   For back ends where file-wide global symbols are not maintained, does
   nothing.  Otherwise, makes sure this symbol hasn't been seen before or
   is known as a common block.	*/

void
ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank)
{
#if FFEGLOBAL_ENABLED
  ffename n;
  ffeglobal g;

  if (ffesymbol_global (s) == NULL)
    {
      n = ffename_find (ffeglobal_filewide_, t);
      g = ffename_global (n);
    }
  else
    {
      g = ffesymbol_global (s);
      n = NULL;
    }

  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
    return;

  if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
    {
      if (g->type == FFEGLOBAL_typeCOMMON)
	{
	  assert (g->u.common.blank == blank);
	}
      else
	{
	  if (ffe_is_globals () || ffe_is_warn_globals ())
	    {
	      ffebad_start (ffe_is_globals ()
			    ? FFEBAD_FILEWIDE_ALREADY_SEEN
			    : FFEBAD_FILEWIDE_ALREADY_SEEN_W);
	      ffebad_string (ffelex_token_text (t));
	      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	      ffebad_here (1, ffelex_token_where_line (g->t),
			   ffelex_token_where_column (g->t));
	      ffebad_finish ();
	    }
	  g->type = FFEGLOBAL_typeANY;
	}
    }
  else
    {
      if (g == NULL)
	{
	  g = ffeglobal_new_ (n);
	  g->intrinsic = FALSE;
	}
      else if (g->intrinsic
	       && !g->explicit_intrinsic
	       && ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_string ("common block");
	  ffebad_string ("intrinsic");
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
      g->t = ffelex_token_use (t);
      g->type = FFEGLOBAL_typeCOMMON;
      g->u.common.have_pad = FALSE;
      g->u.common.have_save = FALSE;
      g->u.common.have_size = FALSE;
      g->u.common.blank = blank;
    }

  ffesymbol_set_global (s, g);
#endif
}

/* ffeglobal_new_progunit_ -- New program unit

   ffesymbol s;	 // the ffesymbol for the new unit
   ffelexToken t;  // the token with the name of the unit
   ffeglobalType type;	// the type of the new unit
   ffeglobal_new_progunit_(s,t,type);

   For back ends where file-wide global symbols are not maintained, does
   nothing.  Otherwise, makes sure this symbol hasn't been seen before.	 */

void
ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
{
#if FFEGLOBAL_ENABLED
  ffename n;
  ffeglobal g;

  n = ffename_find (ffeglobal_filewide_, t);
  g = ffename_global (n);
  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
    return;

  if ((g != NULL)
      && ((g->type == FFEGLOBAL_typeMAIN)
	  || (g->type == FFEGLOBAL_typeSUBR)
	  || (g->type == FFEGLOBAL_typeFUNC)
	  || (g->type == FFEGLOBAL_typeBDATA))
      && g->u.proc.defined)
    {
      if (ffe_is_globals () || ffe_is_warn_globals ())
	{
	  ffebad_start (ffe_is_globals ()
			? FFEBAD_FILEWIDE_ALREADY_SEEN
			: FFEBAD_FILEWIDE_ALREADY_SEEN_W);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_here (0, ffelex_token_where_line (t),
		       ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
      g->type = FFEGLOBAL_typeANY;
    }
  else if ((g != NULL)
	   && (g->type != FFEGLOBAL_typeNONE)
	   && (g->type != FFEGLOBAL_typeEXT)
	   && (g->type != type))
    {
      if (ffe_is_globals () || ffe_is_warn_globals ())
	{
	  ffebad_start (ffe_is_globals ()
			? FFEBAD_FILEWIDE_DISAGREEMENT
			: FFEBAD_FILEWIDE_DISAGREEMENT_W);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_string (ffeglobal_type_string_[type]);
	  ffebad_string (ffeglobal_type_string_[g->type]);
	  ffebad_here (0, ffelex_token_where_line (t),
		       ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
      g->type = FFEGLOBAL_typeANY;
    }
  else
    {
      if (g == NULL)
	{
	  g = ffeglobal_new_ (n);
	  g->intrinsic = FALSE;
	  g->u.proc.n_args = -1;
	  g->u.proc.other_t = NULL;
	}
      else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
	       && ((ffesymbol_basictype (s) != g->u.proc.bt)
		   || (ffesymbol_kindtype (s) != g->u.proc.kt)
		   || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE)
		       && (ffesymbol_size (s) != g->u.proc.sz))))
	{
	  if (ffe_is_globals () || ffe_is_warn_globals ())
	    {
	      ffebad_start (ffe_is_globals ()
			    ? FFEBAD_FILEWIDE_TYPE_MISMATCH
			    : FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
	      ffebad_string (ffelex_token_text (t));
	      ffebad_here (0, ffelex_token_where_line (t),
			   ffelex_token_where_column (t));
	      ffebad_here (1, ffelex_token_where_line (g->t),
			   ffelex_token_where_column (g->t));
	      ffebad_finish ();
	    }
	  g->type = FFEGLOBAL_typeANY;
	  return;
	}
      if (g->intrinsic
	  && !g->explicit_intrinsic
	  && ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_string ("global");
	  ffebad_string ("intrinsic");
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
      g->t = ffelex_token_use (t);
      if ((g->tick == 0)
	  || (g->u.proc.bt == FFEINFO_basictypeNONE)
	  || (g->u.proc.kt == FFEINFO_kindtypeNONE))
	{
	  g->u.proc.bt = ffesymbol_basictype (s);
	  g->u.proc.kt = ffesymbol_kindtype (s);
	  g->u.proc.sz = ffesymbol_size (s);
	}
      g->tick = ffe_count_2;
      if ((g->tick != 0)
	  && (g->type != type))
	g->u.proc.n_args = -1;
      g->type = type;
      g->u.proc.defined = TRUE;
    }

  ffesymbol_set_global (s, g);
#endif
}

/* ffeglobal_pad_common -- Check initial padding of common area

   ffesymbol s;	 // the common area
   ffetargetAlign pad;	// the initial padding
   ffeglobal_pad_common(s,pad,ffesymbol_where_line(s),
	 ffesymbol_where_column(s));

   In global-enabled mode, make sure the padding agrees with any existing
   padding established for the common area, otherwise complain.
   In global-disabled mode, warn about nonzero padding.	 */

void
ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
		      ffewhereColumn wc)
{
#if FFEGLOBAL_ENABLED
  ffeglobal g;

  g = ffesymbol_global (s);
  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
    return;			/* Let someone else catch this! */
  if (g->type == FFEGLOBAL_typeANY)
    return;

  if (!g->u.common.have_pad)
    {
      g->u.common.have_pad = TRUE;
      g->u.common.pad = pad;
      g->u.common.pad_where_line = ffewhere_line_use (wl);
      g->u.common.pad_where_col = ffewhere_column_use (wc);

      if (pad != 0)
	{
	  char padding[20];

	  sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
	  ffebad_start (FFEBAD_COMMON_INIT_PAD);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_string (padding);
	  ffebad_string ((pad == 1)
			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
	  ffebad_here (0, wl, wc);
	  ffebad_finish ();
	}
    }
  else
    {
      if (g->u.common.pad != pad)
	{
	  char padding_1[20];
	  char padding_2[20];

	  sprintf (&padding_1[0], "%" ffetargetAlign_f "u", pad);
	  sprintf (&padding_2[0], "%" ffetargetAlign_f "u", g->u.common.pad);
	  ffebad_start (FFEBAD_COMMON_DIFF_PAD);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_string (padding_1);
	  ffebad_here (0, wl, wc);
	  ffebad_string (padding_2);
	  ffebad_string ((pad == 1)
			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
	  ffebad_string ((g->u.common.pad == 1)
			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
	  ffebad_here (1, g->u.common.pad_where_line, g->u.common.pad_where_col);
	  ffebad_finish ();
	}

      if (g->u.common.pad < pad)
	{
	  g->u.common.pad = pad;
	  g->u.common.pad_where_line = ffewhere_line_use (wl);
	  g->u.common.pad_where_col = ffewhere_column_use (wc);
	}
    }
#endif
}

/* Collect info for a global's argument.  */

void
ffeglobal_proc_def_arg (ffesymbol s, int argno, char *name, ffeglobalArgSummary as,
			ffeinfoBasictype bt, ffeinfoKindtype kt,
			bool array)
{
  ffeglobal g = ffesymbol_global (s);
  ffeglobalArgInfo_ ai;

  assert (g != NULL);

  if (g->type == FFEGLOBAL_typeANY)
    return;

  assert (g->u.proc.n_args >= 0);

  if (argno >= g->u.proc.n_args)
    return;	/* Already complained about this discrepancy. */

  ai = &g->u.proc.arg_info[argno];

  /* Maybe warn about previous references.  */

  if ((ai->t != NULL)
      && ffe_is_warn_globals ())
    {
      char *refwhy = NULL;
      char *defwhy = NULL;
      bool warn = FALSE;

      switch (as)
	{
	case FFEGLOBAL_argsummaryREF:
	  if ((ai->as != FFEGLOBAL_argsummaryREF)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
		  || (ai->bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      warn = TRUE;
	      refwhy = "passed by reference";
	    }
	  break;

	case FFEGLOBAL_argsummaryDESCR:
	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
		  || (bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      warn = TRUE;
	      refwhy = "passed by descriptor";
	    }
	  break;

	case FFEGLOBAL_argsummaryPROC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "a procedure";
	    }
	  break;

	case FFEGLOBAL_argsummarySUBR:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "a subroutine";
	    }
	  break;

	case FFEGLOBAL_argsummaryFUNC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "a function";
	    }
	  break;

	case FFEGLOBAL_argsummaryALTRTN:
	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "an alternate-return label";
	    }
	  break;

	default:
	  break;
	}

      if ((refwhy != NULL) && (defwhy == NULL))
	{
	  /* Fill in the def info.  */

	  switch (ai->as)
	    {
	    case FFEGLOBAL_argsummaryNONE:
	      defwhy = "omitted";
	      break;

	    case FFEGLOBAL_argsummaryVAL:
	      defwhy = "passed by value";
	      break;

	    case FFEGLOBAL_argsummaryREF:
	      defwhy = "passed by reference";
	      break;

	    case FFEGLOBAL_argsummaryDESCR:
	      defwhy = "passed by descriptor";
	      break;

	    case FFEGLOBAL_argsummaryPROC:
	      defwhy = "a procedure";
	      break;

	    case FFEGLOBAL_argsummarySUBR:
	      defwhy = "a subroutine";
	      break;

	    case FFEGLOBAL_argsummaryFUNC:
	      defwhy = "a function";
	      break;

	    case FFEGLOBAL_argsummaryALTRTN:
	      defwhy = "an alternate-return label";
	      break;

#if 0
	    case FFEGLOBAL_argsummaryPTR:
	      defwhy = "a pointer";
	      break;
#endif

	    default:
	      defwhy = "???";
	      break;
	    }
	}

      if (!warn
	  && (bt != FFEINFO_basictypeHOLLERITH)
	  && (bt != FFEINFO_basictypeTYPELESS)
	  && (bt != FFEINFO_basictypeNONE)
	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
	  && (ai->bt != FFEINFO_basictypeTYPELESS)
	  && (ai->bt != FFEINFO_basictypeNONE))
	{
	  /* Check types.  */

	  if ((bt != ai->bt)
	      && ((bt != FFEINFO_basictypeREAL)
		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
	      && ((bt != FFEINFO_basictypeCOMPLEX)
		  || (ai->bt != FFEINFO_basictypeREAL)))
	    {
	      warn = TRUE;	/* We can cope with these differences. */
	      refwhy = "one type";
	      defwhy = "some other type";
	    }

	  if (!warn && (kt != ai->kt))
	    {
	      warn = TRUE;
	      refwhy = "one precision";
	      defwhy = "some other precision";
	    }
	}

      if (warn)
	{
	  char num[60];

	  if (name == NULL)
	    sprintf (&num[0], "%d", argno + 1);
	  else
	    {
	      if (strlen (name) < 30)
		sprintf (&num[0], "%d (named `%s')", argno + 1, name);
	      else
		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, name);
	    }
	  ffebad_start (FFEBAD_FILEWIDE_ARG_W);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_string (num);
	  ffebad_string (refwhy);
	  ffebad_string (defwhy);
	  ffebad_here (0, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t));
	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
	  ffebad_finish ();
	}
    }

  /* Define this argument.  */

  if (ai->t != NULL)
    ffelex_token_kill (ai->t);
  if ((as != FFEGLOBAL_argsummaryPROC)
      || (ai->t == NULL))
    ai->as = as;	/* Otherwise leave SUBR/FUNC info intact. */
  ai->t = ffelex_token_use (g->t);
  if (name == NULL)
    ai->name = NULL;
  else
    {
      ai->name = malloc_new_ks (malloc_pool_image (),
				"ffeglobalArgInfo_ name",
				strlen (name) + 1);
      strcpy (ai->name, name);
    }
  ai->bt = bt;
  ai->kt = kt;
  ai->array = array;
}

/* Collect info on #args a global accepts.  */

void
ffeglobal_proc_def_nargs (ffesymbol s, int n_args)
{
  ffeglobal g = ffesymbol_global (s);

  assert (g != NULL);

  if (g->type == FFEGLOBAL_typeANY)
    return;

  if (g->u.proc.n_args >= 0)
    {
      if (g->u.proc.n_args == n_args)
	return;

      if (ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
	  ffebad_string (ffesymbol_text (s));
	  if (g->u.proc.n_args > n_args)
	    ffebad_string ("few");
	  else
	    ffebad_string ("many");
	  ffebad_here (0, ffelex_token_where_line (g->u.proc.other_t),
		       ffelex_token_where_column (g->u.proc.other_t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
    }

  /* This is new info we can use in cross-checking future references
     and a possible future definition.  */

  g->u.proc.n_args = n_args;
  g->u.proc.other_t = NULL;	/* No other reference yet. */

  if (n_args == 0)
    {
      g->u.proc.arg_info = NULL;
      return;
    }

  g->u.proc.arg_info
    = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (),
					 "ffeglobalArgInfo_",
					 n_args * sizeof (g->u.proc.arg_info[0]));
  while (n_args-- > 0)
    g->u.proc.arg_info[n_args].t = NULL;
}

/* Verify that the info for a global's argument is valid.  */

bool
ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
			ffeinfoBasictype bt, ffeinfoKindtype kt,
			bool array, ffelexToken t)
{
  ffeglobal g = ffesymbol_global (s);
  ffeglobalArgInfo_ ai;

  assert (g != NULL);

  if (g->type == FFEGLOBAL_typeANY)
    return FALSE;

  assert (g->u.proc.n_args >= 0);

  if (argno >= g->u.proc.n_args)
    return TRUE;	/* Already complained about this discrepancy. */

  ai = &g->u.proc.arg_info[argno];

  /* Warn about previous references.  */

  if (ai->t != NULL)
    {
      char *refwhy = NULL;
      char *defwhy = NULL;
      bool fail = FALSE;
      bool warn = FALSE;

      switch (as)
	{
	case FFEGLOBAL_argsummaryNONE:
	  if (g->u.proc.defined)
	    {
	      fail = TRUE;
	      refwhy = "omitted";
	      defwhy = "not optional";
	    }
	  break;

	case FFEGLOBAL_argsummaryVAL:
	  if (ai->as != FFEGLOBAL_argsummaryVAL)
	    {
	      fail = TRUE;
	      refwhy = "passed by value";
	    }
	  break;

	case FFEGLOBAL_argsummaryREF:
	  if ((ai->as != FFEGLOBAL_argsummaryREF)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
		  || (ai->bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      fail = TRUE;
	      refwhy = "passed by reference";
	    }
	  break;

	case FFEGLOBAL_argsummaryDESCR:
	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
		  || (bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      fail = TRUE;
	      refwhy = "passed by descriptor";
	    }
	  break;

	case FFEGLOBAL_argsummaryPROC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a procedure";
	    }
	  break;

	case FFEGLOBAL_argsummarySUBR:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a subroutine";
	    }
	  break;

	case FFEGLOBAL_argsummaryFUNC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a function";
	    }
	  break;

	case FFEGLOBAL_argsummaryALTRTN:
	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "an alternate-return label";
	    }
	  break;

#if 0
	case FFEGLOBAL_argsummaryPTR:
	  if ((ai->as != FFEGLOBAL_argsummaryPTR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a pointer";
	    }
	  break;
#endif

	default:
	  break;
	}

      if ((refwhy != NULL) && (defwhy == NULL))
	{
	  /* Fill in the def info.  */

	  switch (ai->as)
	    {
	    case FFEGLOBAL_argsummaryNONE:
	      defwhy = "omitted";
	      break;

	    case FFEGLOBAL_argsummaryVAL:
	      defwhy = "passed by value";
	      break;

	    case FFEGLOBAL_argsummaryREF:
	      defwhy = "passed by reference";
	      break;

	    case FFEGLOBAL_argsummaryDESCR:
	      defwhy = "passed by descriptor";
	      break;

	    case FFEGLOBAL_argsummaryPROC:
	      defwhy = "a procedure";
	      break;

	    case FFEGLOBAL_argsummarySUBR:
	      defwhy = "a subroutine";
	      break;

	    case FFEGLOBAL_argsummaryFUNC:
	      defwhy = "a function";
	      break;

	    case FFEGLOBAL_argsummaryALTRTN:
	      defwhy = "an alternate-return label";
	      break;

#if 0
	    case FFEGLOBAL_argsummaryPTR:
	      defwhy = "a pointer";
	      break;
#endif

	    default:
	      defwhy = "???";
	      break;
	    }
	}

      if (!fail && !warn
	  && (bt != FFEINFO_basictypeHOLLERITH)
	  && (bt != FFEINFO_basictypeTYPELESS)
	  && (bt != FFEINFO_basictypeNONE)
	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
	  && (ai->bt != FFEINFO_basictypeNONE)
	  && (ai->bt != FFEINFO_basictypeTYPELESS))
	{
	  /* Check types.  */

	  if ((bt != ai->bt)
	      && ((bt != FFEINFO_basictypeREAL)
		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
	      && ((bt != FFEINFO_basictypeCOMPLEX)
		  || (ai->bt != FFEINFO_basictypeREAL)))
	    {
	      if (((bt == FFEINFO_basictypeINTEGER)
		   && (ai->bt == FFEINFO_basictypeLOGICAL))
		  || ((bt == FFEINFO_basictypeLOGICAL)
		   && (ai->bt == FFEINFO_basictypeINTEGER)))
		warn = TRUE;	/* We can cope with these differences. */
	      else
		fail = TRUE;
	      refwhy = "one type";
	      defwhy = "some other type";
	    }

	  if (!fail && !warn && (kt != ai->kt))
	    {
	      fail = TRUE;
	      refwhy = "one precision";
	      defwhy = "some other precision";
	    }
	}

      if (fail && ! g->u.proc.defined)
	{
	  /* No point failing if we're worried only about invocations.  */
	  fail = FALSE;
	  warn = TRUE;
	}

      if (fail && ! ffe_is_globals ())
	{
	  warn = TRUE;
	  fail = FALSE;
	}

      if (fail || (warn && ffe_is_warn_globals ()))
	{
	  char num[60];

	  if (ai->name == NULL)
	    sprintf (&num[0], "%d", argno + 1);
	  else
	    {
	      if (strlen (ai->name) < 30)
		sprintf (&num[0], "%d (named `%s')", argno + 1, ai->name);
	      else
		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, ai->name);
	    }
	  ffebad_start (fail ? FFEBAD_FILEWIDE_ARG : FFEBAD_FILEWIDE_ARG_W);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_string (num);
	  ffebad_string (refwhy);
	  ffebad_string (defwhy);
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
	  ffebad_finish ();
	  return (fail ? FALSE : TRUE);
	}

      if (warn)
	return TRUE;
    }

  /* Define this argument.  */

  if (ai->t != NULL)
    ffelex_token_kill (ai->t);
  if ((as != FFEGLOBAL_argsummaryPROC)
      || (ai->t == NULL))
    ai->as = as;
  ai->t = ffelex_token_use (g->t);
  ai->name = NULL;
  ai->bt = bt;
  ai->kt = kt;
  ai->array = array;
  return TRUE;
}

bool
ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t)
{
  ffeglobal g = ffesymbol_global (s);

  assert (g != NULL);

  if (g->type == FFEGLOBAL_typeANY)
    return FALSE;

  if (g->u.proc.n_args >= 0)
    {
      if (g->u.proc.n_args == n_args)
	return TRUE;

      if (g->u.proc.defined && ffe_is_globals ())
	{
	  ffebad_start (FFEBAD_FILEWIDE_NARGS);
	  ffebad_string (ffesymbol_text (s));
	  if (g->u.proc.n_args > n_args)
	    ffebad_string ("few");
	  else
	    ffebad_string ("many");
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	  return FALSE;
	}

      if (ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
	  ffebad_string (ffesymbol_text (s));
	  if (g->u.proc.n_args > n_args)
	    ffebad_string ("few");
	  else
	    ffebad_string ("many");
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}

      return TRUE;		/* Don't replace the info we already have. */
    }

  /* This is new info we can use in cross-checking future references
     and a possible future definition.  */

  g->u.proc.n_args = n_args;
  g->u.proc.other_t = ffelex_token_use (t);

  /* Make this "the" place we found the global, since it has the most info.  */

  if (g->t != NULL)
    ffelex_token_kill (g->t);
  g->t = ffelex_token_use (t);

  if (n_args == 0)
    {
      g->u.proc.arg_info = NULL;
      return TRUE;
    }

  g->u.proc.arg_info
    = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (),
					 "ffeglobalArgInfo_",
					 n_args * sizeof (g->u.proc.arg_info[0]));
  while (n_args-- > 0)
    g->u.proc.arg_info[n_args].t = NULL;

  return TRUE;
}

/* Return a global for a promoted symbol (one that has heretofore
   been assumed to be local, but since discovered to be global).  */

ffeglobal
ffeglobal_promoted (ffesymbol s)
{
#if FFEGLOBAL_ENABLED
  ffename n;
  ffeglobal g;

  assert (ffesymbol_global (s) == NULL);

  n = ffename_find (ffeglobal_filewide_, ffename_token (ffesymbol_name (s)));
  g = ffename_global (n);

  return g;
#else
  return NULL;
#endif
}

/* Register a reference to an intrinsic.  Such a reference is always
   valid, though a warning might be in order if the same name has
   already been used for a global.  */

void
ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit)
{
#if FFEGLOBAL_ENABLED
  ffename n;
  ffeglobal g;

  if (ffesymbol_global (s) == NULL)
    {
      n = ffename_find (ffeglobal_filewide_, t);
      g = ffename_global (n);
    }
  else
    {
      g = ffesymbol_global (s);
      n = NULL;
    }

  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
    return;

  if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
    {
      if (! explicit
	  && ! g->intrinsic
	  && ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_string ("intrinsic");
	  ffebad_string ("global");
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
    }
  else
    {
      if (g == NULL)
	{
	  g = ffeglobal_new_ (n);
	  g->tick = ffe_count_2;
	  g->type = FFEGLOBAL_typeNONE;
	  g->intrinsic = TRUE;
	  g->explicit_intrinsic = explicit;
	  g->t = ffelex_token_use (t);
	}
      else if (g->intrinsic
	       && (explicit != g->explicit_intrinsic)
	       && (g->tick != ffe_count_2)
	       && ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_INTRINSIC_EXPIMP);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_string (explicit ? "explicit" : "implicit");
	  ffebad_string (explicit ? "implicit" : "explicit");
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
    }

  g->intrinsic = TRUE;
  if (explicit)
    g->explicit_intrinsic = TRUE;

  ffesymbol_set_global (s, g);
#endif
}

/* Register a reference to a global.  Returns TRUE if the reference
   is valid.  */

bool
ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
{
#if FFEGLOBAL_ENABLED
  ffename n = NULL;
  ffeglobal g;

  /* It is never really _known_ that an EXTERNAL statement
     names a BLOCK DATA by just looking at the program unit,
     so override a different notion here.  */
  if (type == FFEGLOBAL_typeBDATA)
    type = FFEGLOBAL_typeEXT;

  g = ffesymbol_global (s);
  if (g == NULL)
    {
      n = ffename_find (ffeglobal_filewide_, t);
      g = ffename_global (n);
      if (g != NULL)
	ffesymbol_set_global (s, g);
    }

  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
    return TRUE;

  if ((g != NULL)
      && (g->type != FFEGLOBAL_typeNONE)
      && (g->type != type)
      && (g->type != FFEGLOBAL_typeEXT)
      && (type != FFEGLOBAL_typeEXT))
    {
      if ((((type == FFEGLOBAL_typeBDATA)
	    && (g->type != FFEGLOBAL_typeCOMMON))
	   || ((g->type == FFEGLOBAL_typeBDATA)
	       && (type != FFEGLOBAL_typeCOMMON)
	       && ! g->u.proc.defined)))
	{
#if 0	/* This is likely to just annoy people. */
	  if (ffe_is_warn_globals ())
	    {
	      ffebad_start (FFEBAD_FILEWIDE_TIFF);
	      ffebad_string (ffelex_token_text (t));
	      ffebad_string (ffeglobal_type_string_[type]);
	      ffebad_string (ffeglobal_type_string_[g->type]);
	      ffebad_here (0, ffelex_token_where_line (t),
			   ffelex_token_where_column (t));
	      ffebad_here (1, ffelex_token_where_line (g->t),
			   ffelex_token_where_column (g->t));
	      ffebad_finish ();
	    }
#endif
	}
      else if (ffe_is_globals ())
	{
	  ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_string (ffeglobal_type_string_[type]);
	  ffebad_string (ffeglobal_type_string_[g->type]);
	  ffebad_here (0, ffelex_token_where_line (t),
		       ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	  g->type = FFEGLOBAL_typeANY;
	  return FALSE;
	}
      else if (ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT_W);
	  ffebad_string (ffelex_token_text (t));
	  ffebad_string (ffeglobal_type_string_[type]);
	  ffebad_string (ffeglobal_type_string_[g->type]);
	  ffebad_here (0, ffelex_token_where_line (t),
		       ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	  g->type = FFEGLOBAL_typeANY;
	  return TRUE;
	}
    }

  if ((g != NULL)
      && (type == FFEGLOBAL_typeFUNC))
    {
      /* If just filling in this function's type, do so.  */
      if ((g->tick == ffe_count_2)
	  && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
	  && (ffesymbol_kindtype (s) != FFEINFO_kindtypeNONE))
	{
	  g->u.proc.bt = ffesymbol_basictype (s);
	  g->u.proc.kt = ffesymbol_kindtype (s);
	  g->u.proc.sz = ffesymbol_size (s);
	}
      /* Else, make sure there is type agreement.  */
      else if ((g->u.proc.bt != FFEINFO_basictypeNONE)
	       && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
	       && ((ffesymbol_basictype (s) != g->u.proc.bt)
		   || (ffesymbol_kindtype (s) != g->u.proc.kt)
		   || ((ffesymbol_size (s) != g->u.proc.sz)
		       && g->u.proc.defined
		       && (g->u.proc.sz != FFETARGET_charactersizeNONE))))
	{
	  if (ffe_is_globals ())
	    {
	      ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH);
	      ffebad_string (ffelex_token_text (t));
	      ffebad_here (0, ffelex_token_where_line (t),
			   ffelex_token_where_column (t));
	      ffebad_here (1, ffelex_token_where_line (g->t),
			   ffelex_token_where_column (g->t));
	      ffebad_finish ();
	      g->type = FFEGLOBAL_typeANY;
	      return FALSE;
	    }
	  if (ffe_is_warn_globals ())
	    {
	      ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
	      ffebad_string (ffelex_token_text (t));
	      ffebad_here (0, ffelex_token_where_line (t),
			   ffelex_token_where_column (t));
	      ffebad_here (1, ffelex_token_where_line (g->t),
			   ffelex_token_where_column (g->t));
	      ffebad_finish ();
	    }
	  g->type = FFEGLOBAL_typeANY;
	  return TRUE;
	}
    }

  if (g == NULL)
    {
      g = ffeglobal_new_ (n);
      g->t = ffelex_token_use (t);
      g->tick = ffe_count_2;
      g->intrinsic = FALSE;
      g->type = type;
      g->u.proc.defined = FALSE;
      g->u.proc.bt = ffesymbol_basictype (s);
      g->u.proc.kt = ffesymbol_kindtype (s);
      g->u.proc.sz = ffesymbol_size (s);
      g->u.proc.n_args = -1;
      ffesymbol_set_global (s, g);
    }
  else if (g->intrinsic
	   && !g->explicit_intrinsic
	   && (g->tick != ffe_count_2)
	   && ffe_is_warn_globals ())
    {
      ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
      ffebad_string (ffelex_token_text (t));
      ffebad_string ("global");
      ffebad_string ("intrinsic");
      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
      ffebad_here (1, ffelex_token_where_line (g->t),
		   ffelex_token_where_column (g->t));
      ffebad_finish ();
    }

  if ((g->type != type)
      && (type != FFEGLOBAL_typeEXT))
    {
      /* We've learned more, so point to where we learned it.  */
      g->t = ffelex_token_use (t);
      g->type = type;
#ifdef FFECOM_globalHOOK
      g->hook = FFECOM_globalNULL;	/* Discard previous _DECL. */
#endif
      g->u.proc.n_args = -1;
    }

  return TRUE;
#endif
}

/* ffeglobal_save_common -- Check SAVE status of common area

   ffesymbol s;	 // the common area
   bool save;  // TRUE if SAVEd, FALSE otherwise
   ffeglobal_save_common(s,save,ffesymbol_where_line(s),
	 ffesymbol_where_column(s));

   In global-enabled mode, make sure the save info agrees with any existing
   info established for the common area, otherwise complain.
   In global-disabled mode, do nothing.	 */

void
ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
		       ffewhereColumn wc)
{
#if FFEGLOBAL_ENABLED
  ffeglobal g;

  g = ffesymbol_global (s);
  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
    return;			/* Let someone else catch this! */
  if (g->type == FFEGLOBAL_typeANY)
    return;

  if (!g->u.common.have_save)
    {
      g->u.common.have_save = TRUE;
      g->u.common.save = save;
      g->u.common.save_where_line = ffewhere_line_use (wl);
      g->u.common.save_where_col = ffewhere_column_use (wc);
    }
  else
    {
      if ((g->u.common.save != save) && ffe_is_pedantic ())
	{
	  ffebad_start (FFEBAD_COMMON_DIFF_SAVE);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_here (save ? 0 : 1, wl, wc);
	  ffebad_here (save ? 1 : 0, g->u.common.pad_where_line, g->u.common.pad_where_col);
	  ffebad_finish ();
	}
    }
#endif
}

/* ffeglobal_size_common -- Establish size of COMMON area

   ffesymbol s;	 // the common area
   ffetargetOffset size;  // size in units
   if (ffeglobal_size_common(s,size))  // new size is largest seen

   In global-enabled mode, set the size if it current size isn't known or is
   smaller than new size, and for non-blank common, complain if old size
   is different from new.  Return TRUE if the new size is the largest seen
   for this COMMON area (or if no size was known for it previously).
   In global-disabled mode, do nothing.	 */

#if FFEGLOBAL_ENABLED
bool
ffeglobal_size_common (ffesymbol s, ffetargetOffset size)
{
  ffeglobal g;

  g = ffesymbol_global (s);
  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
    return FALSE;
  if (g->type == FFEGLOBAL_typeANY)
    return FALSE;

  if (!g->u.common.have_size)
    {
      g->u.common.have_size = TRUE;
      g->u.common.size = size;
      return TRUE;
    }

  if ((g->tick > 0) && (g->tick < ffe_count_2)
      && (g->u.common.size < size))
    {
      char oldsize[40];
      char newsize[40];

      /* Common block initialized in a previous program unit, which
	 effectively freezes its size, but now the program is trying
	 to enlarge it.  */

      sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
      sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);

      ffebad_start (FFEBAD_COMMON_ENLARGED);
      ffebad_string (ffesymbol_text (s));
      ffebad_string (oldsize);
      ffebad_string (newsize);
      ffebad_string ((g->u.common.size == 1)
		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
      ffebad_string ((size == 1)
		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
      ffebad_here (0, ffelex_token_where_line (g->u.common.initt),
		   ffelex_token_where_column (g->u.common.initt));
      ffebad_here (1, ffesymbol_where_line (s),
		   ffesymbol_where_column (s));
      ffebad_finish ();
    }
  else if ((g->u.common.size != size) && !g->u.common.blank)
    {
      char oldsize[40];
      char newsize[40];

      /* Warn about this even if not -pedantic, because putting all
	 program units in a single source file is the only way to
	 detect this.  Apparently UNIX-model linkers neither handle
	 nor report when they make a common unit smaller than
	 requested, such as when the smaller-declared version is
	 initialized and the larger-declared version is not.  So
	 if people complain about strange overwriting, we can tell
	 them to put all their code in a single file and compile
	 that way.  Warnings about differing sizes must therefore
	 always be issued.  */

      sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
      sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);

      ffebad_start (FFEBAD_COMMON_DIFF_SIZE);
      ffebad_string (ffesymbol_text (s));
      ffebad_string (oldsize);
      ffebad_string (newsize);
      ffebad_string ((g->u.common.size == 1)
		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
      ffebad_string ((size == 1)
		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
      ffebad_here (0, ffelex_token_where_line (g->t),
		   ffelex_token_where_column (g->t));
      ffebad_here (1, ffesymbol_where_line (s),
		   ffesymbol_where_column (s));
      ffebad_finish ();
    }

  if (size > g->u.common.size)
    {
      g->u.common.size = size;
      return TRUE;
    }

  return FALSE;
}

#endif
void
ffeglobal_terminate_1 ()
{
}