storag.c

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

/* storag.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995, 1996 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:
      Maintains information on storage (memory) relationships between
      COMMON, dummy, and local variables, plus their equivalences (dummies
      don't have equivalences, however).

   Modifications:
*/

/* Include files. */

#include "proj.h"
#include "storag.h"
#include "data.h"
#include "malloc.h"
#include "symbol.h"
#include "target.h"

/* Externals defined here. */

ffestoragList_ ffestorag_list_;

/* Simple definitions and enumerations. */


/* Internal typedefs. */


/* Private include files. */


/* Internal structure definitions. */


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

static ffetargetOffset ffestorag_local_size_;	/* #units allocated so far. */
static bool ffestorag_reported_;/* Reports happen only once. */

/* Static functions (internal). */


/* Internal macros. */

#define ffestorag_next_(s) ((s)->next)
#define ffestorag_previous_(s) ((s)->previous)

/* ffestorag_drive -- Drive fn from list of storage objects

   ffestoragList sl;
   void (*fn)(ffestorag mst,ffestorag st);
   ffestorag mst;  // the master ffestorag object (or whatever)
   ffestorag_drive(sl,fn,mst);

   Calls (*fn)(mst,st) for every st in the list sl.  */

void
ffestorag_drive (ffestoragList sl, void (*fn) (ffestorag mst, ffestorag st),
		 ffestorag mst)
{
  ffestorag st;

  for (st = sl->first;
       st != (ffestorag) &sl->first;
       st = st->next)
    (*fn) (mst, st);
}

/* ffestorag_dump -- Dump information on storage object

   ffestorag s;	 // the ffestorag object
   ffestorag_dump(s);

   Dumps information in the storage object.  */

void
ffestorag_dump (ffestorag s)
{
  if (s == NULL)
    {
      fprintf (dmpout, "(no storage object)");
      return;
    }

  switch (s->type)
    {
    case FFESTORAG_typeCBLOCK:
      fprintf (dmpout, "CBLOCK ");
      break;

    case FFESTORAG_typeCOMMON:
      fprintf (dmpout, "COMMON ");
      break;

    case FFESTORAG_typeLOCAL:
      fprintf (dmpout, "LOCAL ");
      break;

    case FFESTORAG_typeEQUIV:
      fprintf (dmpout, "EQUIV ");
      break;

    default:
      fprintf (dmpout, "?%d? ", s->type);
      break;
    }

  if (s->symbol != NULL)
    fprintf (dmpout, "\"%s\" ", ffesymbol_text (s->symbol));

  fprintf (dmpout, "at %" ffetargetOffset_f "d size %" ffetargetOffset_f
	   "d, align loc%%%"
	   ffetargetAlign_f "u=%" ffetargetAlign_f "u, bt=%s, kt=%s",
	   s->offset,
	   s->size, (unsigned int) s->alignment, (unsigned int) s->modulo,
	   ffeinfo_basictype_string (s->basic_type),
	   ffeinfo_kindtype_string (s->kind_type));

  if (s->equivs_.first != (ffestorag) &s->equivs_.first)
    {
      ffestorag sq;

      fprintf (dmpout, " with equivs");
      for (sq = s->equivs_.first;
	   sq != (ffestorag) &s->equivs_.first;
	   sq = ffestorag_next_ (sq))
	{
	  if (ffestorag_previous_ (sq) == (ffestorag) &s->equivs_.first)
	    fputc (' ', dmpout);
	  else
	    fputc (',', dmpout);
	  fprintf (dmpout, "%s", ffesymbol_text (ffestorag_symbol (sq)));
	}
    }
}

/* ffestorag_init_2 -- Initialize for new program unit

   ffestorag_init_2();	*/

void
ffestorag_init_2 ()
{
  ffestorag_list_.first = ffestorag_list_.last
  = (ffestorag) &ffestorag_list_.first;
  ffestorag_local_size_ = 0;
  ffestorag_reported_ = FALSE;
}

/* ffestorag_end_layout -- Do final layout for symbol

   ffesymbol s;
   ffestorag_end_layout(s);  */

void
ffestorag_end_layout (ffesymbol s)
{
  if (ffesymbol_storage (s) != NULL)
    return;			/* Already laid out. */

  ffestorag_exec_layout (s);	/* Do what we have in common. */
#if 0
  assert (ffesymbol_storage (s) == NULL);	/* I'd like to know what
						   cases miss going through
						   ffecom_sym_learned, and
						   why; I don't think we
						   should have to do the
						   exec_layout thing at all
						   here. */
  /* Now I think I know: we have to do exec_layout here, because equivalence
     handling could encounter an error that takes a variable off of its
     equivalence object (and vice versa), and we should then layout the var
     as a local entity. */
#endif
}

/* ffestorag_exec_layout -- Do initial layout for symbol

   ffesymbol s;
   ffestorag_exec_layout(s);  */

void
ffestorag_exec_layout (ffesymbol s)
{
  ffetargetAlign alignment;
  ffetargetAlign modulo;
  ffetargetOffset size;
  ffetargetOffset num_elements;
  ffetargetAlign pad;
  ffestorag st;
  ffestorag stv;
  ffebld list;
  ffebld item;
  ffesymbol var;
  bool init;

  if (ffesymbol_storage (s) != NULL)
    return;			/* Already laid out. */

  switch (ffesymbol_kind (s))
    {
    default:
      return;			/* Do nothing. */

    case FFEINFO_kindENTITY:
      switch (ffesymbol_where (s))
	{
	case FFEINFO_whereLOCAL:
	  if (ffesymbol_equiv (s) != NULL)
	    return;		/* Let ffeequiv handle this guy. */
	  if (ffesymbol_rank (s) == 0)
	    num_elements = 1;
	  else
	    {
	      if (ffebld_op (ffesymbol_arraysize (s))
		  != FFEBLD_opCONTER)
		return;	/* An adjustable local array, just like a dummy. */
	      num_elements
		= ffebld_constant_integerdefault (ffebld_conter
						  (ffesymbol_arraysize (s)));
	    }
	  ffetarget_layout (ffesymbol_text (s), &alignment, &modulo,
			    &size, ffesymbol_basictype (s),
			    ffesymbol_kindtype (s), ffesymbol_size (s),
			    num_elements);
	  st = ffestorag_new (ffestorag_list_master ());
	  st->parent = NULL;	/* Initializations happen at sym level. */
	  st->init = NULL;
	  st->accretion = NULL;
	  st->symbol = s;
	  st->size = size;
	  st->offset = 0;
	  st->alignment = alignment;
	  st->modulo = modulo;
	  st->type = FFESTORAG_typeLOCAL;
	  st->basic_type = ffesymbol_basictype (s);
	  st->kind_type = ffesymbol_kindtype (s);
	  st->type_symbol = s;
	  st->is_save = ffesymbol_is_save (s);
	  st->is_init = ffesymbol_is_init (s);
	  ffesymbol_set_storage (s, st);
	  if (ffesymbol_is_init (s))
	    ffecom_notify_init_symbol (s);	/* Init completed before, but
						   we didn't have a storage
						   object for it; maybe back
						   end wants to see the sym
						   again now. */
	  ffesymbol_signal_unreported (s);
	  return;

	case FFEINFO_whereCOMMON:
	  return;		/* Allocate storage for entire common block
				   at once. */

	case FFEINFO_whereDUMMY:
	  return;		/* Don't do anything about dummies for now. */

	case FFEINFO_whereRESULT:
	case FFEINFO_whereIMMEDIATE:
	case FFEINFO_whereCONSTANT:
	case FFEINFO_whereNONE:
	  return;		/* These don't get storage (esp. NONE, which
				   is UNCERTAIN). */