equiv.c

来自「gcc-2.95.3 Linux下最常用的C编译器」· C语言 代码 · 共 1,499 行 · 第 1/3 页

/* equiv.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995-1998 Free Software Foundation, Inc.
   Contributed by James Craig Burley.

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:
      None

   Description:
      Handles the EQUIVALENCE relationships in a program unit.

   Modifications:
*/

#define FFEEQUIV_DEBUG 0

/* Include files. */

#include "proj.h"
#include "equiv.h"
#include "bad.h"
#include "bld.h"
#include "com.h"
#include "data.h"
#include "global.h"
#include "lex.h"
#include "malloc.h"
#include "symbol.h"

/* Externals defined here. */


/* Simple definitions and enumerations. */


/* Internal typedefs. */


/* Private include files. */


/* Internal structure definitions. */

struct _ffeequiv_list_
  {
    ffeequiv first;
    ffeequiv last;
  };

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

static struct _ffeequiv_list_ ffeequiv_list_;

/* Static functions (internal). */

static void ffeequiv_destroy_ (ffeequiv eq);
static void ffeequiv_layout_local_ (ffeequiv eq);
static bool ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s,
			      ffebld expr, bool subtract,
			      ffetargetOffset adjust, bool no_precede);

/* Internal macros. */


static void
ffeequiv_destroy_ (ffeequiv victim)
{
  ffebld list;
  ffebld item;
  ffebld expr;

  for (list = victim->list; list != NULL; list = ffebld_trail (list))
    {
      for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
	{
	  ffesymbol sym;

	  expr = ffebld_head (item);
	  sym = ffeequiv_symbol (expr);
	  if (sym == NULL)
	    continue;
	  if (ffesymbol_equiv (sym) != NULL)
	    ffesymbol_set_equiv (sym, NULL);
	}
    }
  ffeequiv_kill (victim);
}

/* ffeequiv_layout_local_ -- Lay out storage for local equivalenced vars

   ffeequiv eq;
   ffeequiv_layout_local_(eq);

   Makes a single master ffestorag object that contains all the vars
   in the equivalence, and makes subordinate ffestorag objects for the
   vars with the correct offsets.

   The resulting var offsets are relative not necessarily to 0 -- the
   are relative to the offset of the master area, which might be 0 or
   negative, but should never be positive.  */

static void
ffeequiv_layout_local_ (ffeequiv eq)
{
  ffestorag st;			/* Equivalence storage area. */
  ffebld list;			/* List of list of equivalences. */
  ffebld item;			/* List of equivalences. */
  ffebld root_exp;		/* Expression for root sym. */
  ffestorag root_st;		/* Storage for root. */
  ffesymbol root_sym;		/* Root itself. */
  ffebld rooted_exp;		/* Expression for rooted sym in an eqlist. */
  ffestorag rooted_st;		/* Storage for rooted. */
  ffesymbol rooted_sym;		/* Rooted symbol itself. */
  ffetargetOffset eqlist_offset;/* Offset for eqlist from rooted sym. */
  ffetargetAlign alignment;
  ffetargetAlign modulo;
  ffetargetAlign pad;
  ffetargetOffset size;
  ffetargetOffset num_elements;
  bool new_storage;		/* Established new storage info. */
  bool need_storage;		/* Have need for more storage info. */
  bool init;

  assert (eq != NULL);

  if (ffeequiv_common (eq) != NULL)
    {				/* Put in common due to programmer error. */
      ffeequiv_destroy_ (eq);
      return;
    }

  /* Find the symbol for the first valid item in the list of lists, use that
     as the root symbol.  Doesn't matter if it won't end up at the beginning
     of the list, though.  */

#if FFEEQUIV_DEBUG
  fprintf (stderr, "Equiv1:\n");
#endif

  root_sym = NULL;
  root_exp = NULL;

  for (list = ffeequiv_list (eq);
       list != NULL;
       list = ffebld_trail (list))
    {				/* For every equivalence list in the list of
				   equivs */
      for (item = ffebld_head (list);
	   item != NULL;
	   item = ffebld_trail (item))
	{			/* For every equivalence item in the list */
	  ffetargetOffset ign;	/* Ignored. */

	  root_exp = ffebld_head (item);
	  root_sym = ffeequiv_symbol (root_exp);
	  if (root_sym == NULL)
	    continue;		/* Ignore me. */

	  assert (ffesymbol_storage (root_sym) == NULL);	/* No storage yet. */

	  if (!ffeequiv_offset_ (&ign, root_sym, root_exp, FALSE, 0, FALSE))
	    {
	      /* We can't just eliminate this one symbol from the list
		 of candidates, because it might be the only one that
		 ties all these equivs together.  So just destroy the
		 whole list.  */

	      ffeequiv_destroy_ (eq);
	      return;
	    }

	  break;	/* Use first valid eqv expr for root exp/sym. */
	}
      if (root_sym != NULL)
	break;
    }

  if (root_sym == NULL)
    {
      ffeequiv_destroy_ (eq);
      return;
    }


#if FFEEQUIV_DEBUG
  fprintf (stderr, "  Root: `%s'\n", ffesymbol_text (root_sym));
#endif

  /* We've got work to do, so make the LOCAL storage object that'll hold all
     the equivalenced vars inside it. */

  st = ffestorag_new (ffestorag_list_master ());
  ffestorag_set_parent (st, NULL);	/* Initializations happen here. */
  ffestorag_set_init (st, NULL);
  ffestorag_set_accretion (st, NULL);
  ffestorag_set_offset (st, 0);		/* Assume equiv will be at root offset 0 for now. */
  ffestorag_set_alignment (st, 1);
  ffestorag_set_modulo (st, 0);
  ffestorag_set_type (st, FFESTORAG_typeLOCAL);
  ffestorag_set_basictype (st, ffesymbol_basictype (root_sym));
  ffestorag_set_kindtype (st, ffesymbol_kindtype (root_sym));
  ffestorag_set_typesymbol (st, root_sym);
  ffestorag_set_is_save (st, ffeequiv_is_save (eq));
  if (ffesymbol_is_save (root_sym))
    ffestorag_update_save (st);
  ffestorag_set_is_init (st, ffeequiv_is_init (eq));
  if (ffesymbol_is_init (root_sym))
    ffestorag_update_init (st);
  ffestorag_set_symbol (st, root_sym);	/* Assume this will be the root until
					   we know better (used only to generate
					   the internal name for the aggregate area,
					   e.g. for debugging). */

  /* Make the EQUIV storage object for the root symbol. */

  if (ffesymbol_rank (root_sym) == 0)
    num_elements = 1;
  else
    num_elements = ffebld_constant_integerdefault (ffebld_conter
						(ffesymbol_arraysize (root_sym)));
  ffetarget_layout (ffesymbol_text (root_sym), &alignment, &modulo, &size,
		    ffesymbol_basictype (root_sym), ffesymbol_kindtype (root_sym),
		    ffesymbol_size (root_sym), num_elements);
  ffestorag_set_size (st, size);	/* Set initial size of aggregate area. */

  pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
			 ffestorag_ptr_to_modulo (st), 0, alignment,
			 modulo);
  assert (pad == 0);

  root_st = ffestorag_new (ffestorag_list_equivs (st));
  ffestorag_set_parent (root_st, st);	/* Initializations happen there. */
  ffestorag_set_init (root_st, NULL);
  ffestorag_set_accretion (root_st, NULL);
  ffestorag_set_symbol (root_st, root_sym);
  ffestorag_set_size (root_st, size);
  ffestorag_set_offset (root_st, 0);	/* Will not change; always 0 relative to itself! */
  ffestorag_set_alignment (root_st, alignment);
  ffestorag_set_modulo (root_st, modulo);
  ffestorag_set_type (root_st, FFESTORAG_typeEQUIV);
  ffestorag_set_basictype (root_st, ffesymbol_basictype (root_sym));
  ffestorag_set_kindtype (root_st, ffesymbol_kindtype (root_sym));
  ffestorag_set_typesymbol (root_st, root_sym);
  ffestorag_set_is_save (root_st, FALSE);	/* Assume FALSE, then... */
  if (ffestorag_is_save (st))	/* ...update to TRUE if needed. */
    ffestorag_update_save (root_st);
  ffestorag_set_is_init (root_st, FALSE);	/* Assume FALSE, then... */
  if (ffestorag_is_init (st))	/* ...update to TRUE if needed. */
    ffestorag_update_init (root_st);
  ffesymbol_set_storage (root_sym, root_st);
  ffesymbol_signal_unreported (root_sym);
  init = ffesymbol_is_init (root_sym);

  /* Now that we know the root (offset=0) symbol, revisit all the lists and
     do the actual storage allocation.	Keep doing this until we've gone
     through them all without making any new storage objects. */

  do
    {
      new_storage = FALSE;
      need_storage = FALSE;
      for (list = ffeequiv_list (eq);
	   list != NULL;
	   list = ffebld_trail (list))
	{			/* For every equivalence list in the list of
				   equivs */
	  /* Now find a "rooted" symbol in this list.  That is, find the
	     first item we can that is valid and whose symbol already
	     has a storage area, because that means we know where it
	     belongs in the equivalence area and can then allocate the
	     rest of the items in the list accordingly.  */

	  rooted_sym = NULL;
	  rooted_exp = NULL;
	  eqlist_offset = 0;

	  for (item = ffebld_head (list);
	       item != NULL;
	       item = ffebld_trail (item))
	    {			/* For every equivalence item in the list */
	      rooted_exp = ffebld_head (item);
	      rooted_sym = ffeequiv_symbol (rooted_exp);
	      if ((rooted_sym == NULL)
		  || ((rooted_st = ffesymbol_storage (rooted_sym)) == NULL))
		{
		  rooted_sym = NULL;
		  continue;	/* Ignore me. */
		}

	      need_storage = TRUE;	/* Somebody is likely to need
					   storage. */

#if FFEEQUIV_DEBUG
	      fprintf (stderr, "  Rooted: `%s' at %" ffetargetOffset_f "d\n",
		       ffesymbol_text (rooted_sym),
		       ffestorag_offset (rooted_st));
#endif

	      /* The offset of this symbol from the equiv's root symbol
		 is already known, and the size of this symbol is already
		 incorporated in the size of the equiv's aggregate area.
		 What we now determine is the offset of this equivalence
		 _list_ from the equiv's root symbol.

		 For example, if we know that A is at offset 16 from the
		 root symbol, given EQUIVALENCE (B(24),A(2)), we're looking
		 at A(2), meaning that the offset for this equivalence list
		 is 20 (4 bytes beyond the beginning of A, assuming typical
		 array types, dimensions, and type info).  */

	      if (!ffeequiv_offset_ (&eqlist_offset, rooted_sym, rooted_exp, FALSE,
				     ffestorag_offset (rooted_st), FALSE))

		{	/* Can't use this one. */
		  ffesymbol_set_equiv (rooted_sym, NULL);/* Equiv area slated for
							    death. */
		  rooted_sym = NULL;
		  continue;		/* Something's wrong with eqv expr, try another. */
		}

#if FFEEQUIV_DEBUG
	      fprintf (stderr, "  Eqlist offset: %" ffetargetOffset_f "d\n",
		       eqlist_offset);
#endif

	      break;
	    }

	  /* If no rooted symbol, it means this list has no roots -- yet.
	     So, forget this list this time around, but we'll get back
	     to it after the outer loop iterates at least one more time,
	     and, ultimately, it will have a root.  */

	  if (rooted_sym == NULL)
	    {
#if FFEEQUIV_DEBUG
	      fprintf (stderr, "No roots.\n");
#endif
	      continue;
	    }

	  /* We now have a rooted symbol/expr and the offset of this equivalence
	     list from the root symbol.  The other expressions in this
	     list all identify an initial storage unit that must have the
	     same offset. */

	  for (item = ffebld_head (list);
	       item != NULL;
	       item = ffebld_trail (item))
	    {			/* For every equivalence item in the list */
	      ffebld item_exp;			/* Expression for equivalence. */
	      ffestorag item_st;		/* Storage for var. */
	      ffesymbol item_sym;		/* Var itself. */
	      ffetargetOffset item_offset;	/* Offset for var from root. */
	      ffetargetOffset new_size;

	      item_exp = ffebld_head (item);
	      item_sym = ffeequiv_symbol (item_exp);
	      if ((item_sym == NULL)
		  || (ffesymbol_equiv (item_sym) == NULL))
		continue;	/* Ignore me. */

	      if (item_sym == rooted_sym)
		continue;	/* Rooted sym already set up. */

	      if (!ffeequiv_offset_ (&item_offset, item_sym, item_exp, TRUE,
				     eqlist_offset, FALSE))
		{
		  ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
		  continue;
		}

#if FFEEQUIV_DEBUG
	      fprintf (stderr, "  Item `%s' at %" ffetargetOffset_f "d",
		       ffesymbol_text (item_sym), item_offset);
#endif

	      if (ffesymbol_rank (item_sym) == 0)
		num_elements = 1;
	      else
		num_elements = ffebld_constant_integerdefault (ffebld_conter
						(ffesymbol_arraysize (item_sym)));
	      ffetarget_layout (ffesymbol_text (item_sym), &alignment, &modulo,
				&size, ffesymbol_basictype (item_sym),
				ffesymbol_kindtype (item_sym), ffesymbol_size (item_sym),
				num_elements);
	      pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
				     ffestorag_ptr_to_modulo (st),
				     item_offset, alignment, modulo);
	      if (pad != 0)
		{
		  ffebad_start (FFEBAD_EQUIV_ALIGN);
		  ffebad_string (ffesymbol_text (item_sym));
		  ffebad_finish ();
		  ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
		  continue;
		}

	      /* If the variable's offset is less than the offset for the
		 aggregate storage area, it means it has to expand backwards
		 -- i.e. the new known starting point of the area precedes the
		 old one.  This can't happen with COMMON areas (the standard,
		 and common sense, disallow it), but it is normal for local
		 EQUIVALENCE areas.

		 Also handle choosing the "documented" rooted symbol for this
		 area here.  It's the symbol at the bottom (lowest offset)
		 of the aggregate area, with ties going to the name that would
		 sort to the top of the list of ties.  */

	      if (item_offset == ffestorag_offset (st))
		{
		  if ((item_sym != ffestorag_symbol (st))
		      && (strcmp (ffesymbol_text (item_sym),
				  ffesymbol_text (ffestorag_symbol (st)))
			  < 0))
		    ffestorag_set_symbol (st, item_sym);
		}
	      else if (item_offset < ffestorag_offset (st))
		{
		  /* Increase size of equiv area to start for lower offset
		     relative to root symbol.  */
		  if (! ffetarget_offset_add (&new_size,
					      ffestorag_offset (st)
					      - item_offset,
					      ffestorag_size (st)))
		    ffetarget_offset_overflow (ffesymbol_text (s));
		  else
		    ffestorag_set_size (st, new_size);

		  ffestorag_set_symbol (st, item_sym);
		  ffestorag_set_offset (st, item_offset);

#if FFEEQUIV_DEBUG
		  fprintf (stderr, " [eq offset=%" ffetargetOffset_f
			   "d, size=%" ffetargetOffset_f "d]",
			   item_offset, new_size);
#endif
		}

	      if ((item_st = ffesymbol_storage (item_sym)) == NULL)
		{		/* Create new ffestorag object, extend equiv
				   area. */
#if FFEEQUIV_DEBUG
		  fprintf (stderr, ".\n");
#endif
		  new_storage = TRUE;
		  item_st = ffestorag_new (ffestorag_list_equivs (st));
		  ffestorag_set_parent (item_st, st);	/* Initializations
							   happen there. */
		  ffestorag_set_init (item_st, NULL);
		  ffestorag_set_accretion (item_st, NULL);
		  ffestorag_set_symbol (item_st, item_sym);
		  ffestorag_set_size (item_st, size);
		  ffestorag_set_offset (item_st, item_offset);
		  ffestorag_set_alignment (item_st, alignment);
		  ffestorag_set_modulo (item_st, modulo);
		  ffestorag_set_type (item_st, FFESTORAG_typeEQUIV);
		  ffestorag_set_basictype (item_st, ffesymbol_basictype (item_sym));
		  ffestorag_set_kindtype (item_st, ffesymbol_kindtype (item_sym));
		  ffestorag_set_typesymbol (item_st, item_sym);
		  ffestorag_set_is_save (item_st, FALSE);	/* Assume FALSE... */
		  if (ffestorag_is_save (st))	/* ...update TRUE */
		    ffestorag_update_save (item_st);	/* if needed. */
		  ffestorag_set_is_init (item_st, FALSE);	/* Assume FALSE... */
		  if (ffestorag_is_init (st))	/* ...update TRUE */
		    ffestorag_update_init (item_st);	/* if needed. */
		  ffesymbol_set_storage (item_sym, item_st);
		  ffesymbol_signal_unreported (item_sym);
		  if (ffesymbol_is_init (item_sym))
		    init = TRUE;

		  /* Determine new size of equiv area, complain if overflow.  */

		  if (!ffetarget_offset_add (&size, item_offset, size)
		      || !ffetarget_offset_add (&size, -ffestorag_offset (st), size))
		    ffetarget_offset_overflow (ffesymbol_text (s));
		  else if (size > ffestorag_size (st))
		    ffestorag_set_size (st, size);
		  ffestorag_update (st, item_sym, ffesymbol_basictype (item_sym),
				    ffesymbol_kindtype (item_sym));
		}
	      else
		{