Initial integration of G77.

Please do a make cleandir before rebuilding gcc!

1 files changed, 981 insertions, 0 deletions

diff --git a/gnu/usr.bin/gcc/f/stu.c b/gnu/usr.bin/gcc/f/stu.c
new file mode 100644
index 00000000000..056b302fa31
--- /dev/null
+++ b/gnu/usr.bin/gcc/f/stu.c
@@ -0,0 +1,981 @@
+/* stu.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "bld.h"
+#include "com.h"
+#include "equiv.h"
+#include "info.h"
+#include "implic.h"
+#include "intrin.h"
+#include "stu.h"
+#include "storag.h"
+#include "sta.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+static void ffestu_list_exec_transition_ (ffebld list);
+static void ffestu_symter_exec_transition_ (ffebld expr);
+static bool ffestu_dummies_transition_ (ffesymbol (*symfunc) (),
+					ffebld list);
+
+/* Internal macros. */
+
+#define ffestu_equiv_(s) (((ffesymbol_equiv (s) == NULL)		      \
+  || (ffeequiv_common (ffesymbol_equiv (s)) == NULL)) ? FFEINFO_whereLOCAL    \
+  : FFEINFO_whereCOMMON)
+
+/* Update symbol info just before end of unit.  */
+
+ffesymbol
+ffestu_sym_end_transition (ffesymbol s)
+{
+  ffeinfoKind skd;
+  ffeinfoWhere swh;
+  ffeinfoKind nkd;
+  ffeinfoWhere nwh;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffesymbolState ss;
+  ffesymbolState ns;
+  bool needs_type = TRUE;	/* Implicit type assignment might be
+				   necessary. */
+
+  assert (s != NULL);
+  ss = ffesymbol_state (s);
+  sa = ffesymbol_attrs (s);
+  skd = ffesymbol_kind (s);
+  swh = ffesymbol_where (s);
+
+  switch (ss)
+    {
+    case FFESYMBOL_stateUNCERTAIN:
+      if ((swh == FFEINFO_whereDUMMY)
+	  && (ffesymbol_numentries (s) == 0))
+	{			/* Not actually in any dummy list! */
+	  ffesymbol_error (s, ffesta_tokens[0]);
+	  return s;
+	}
+      break;
+
+    case FFESYMBOL_stateUNDERSTOOD:
+      if ((swh == FFEINFO_whereLOCAL)
+	  && ((skd == FFEINFO_kindFUNCTION)
+	      || (skd == FFEINFO_kindSUBROUTINE)))
+	ffestu_dummies_transition_ (ffecom_sym_end_transition,
+				    ffesymbol_dummyargs (s));
+      else if ((swh == FFEINFO_whereDUMMY)
+	       && (ffesymbol_numentries (s) == 0))
+	{			/* Not actually in any dummy list! */
+	  ffesymbol_error (s, ffesta_tokens[0]);
+	  return s;
+	}
+
+      ffestorag_end_layout (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+      return s;
+
+    default:
+      assert ("bad status" == NULL);
+      return s;
+    }
+  ns = FFESYMBOL_stateUNDERSTOOD;
+
+  na = sa = ffesymbol_attrs (s);
+
+  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		   | FFESYMBOL_attrsADJUSTABLE
+		   | FFESYMBOL_attrsANYLEN
+		   | FFESYMBOL_attrsARRAY
+		   | FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsEXTERNAL
+		   | FFESYMBOL_attrsSFARG
+		   | FFESYMBOL_attrsTYPE)));
+
+  nkd = skd;
+  nwh = swh;
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsTYPE)
+	nwh = FFEINFO_whereGLOBAL;
+      else
+	/* Not TYPE. */
+	{
+	  if (sa & FFESYMBOL_attrsDUMMY)
+	    {			/* Not TYPE. */
+	      ns = FFESYMBOL_stateUNCERTAIN;	/* FUNCTION/SUBROUTINE. */
+	      needs_type = FALSE;	/* Don't assign type to SUBROUTINE! */
+	    }
+	  else if (sa & FFESYMBOL_attrsACTUALARG)
+	    {			/* Not DUMMY or TYPE. */
+	      ns = FFESYMBOL_stateUNCERTAIN;	/* FUNCTION/SUBROUTINE. */
+	      needs_type = FALSE;	/* Don't assign type to SUBROUTINE! */
+	    }
+	  else
+	    /* Not ACTUALARG, DUMMY, or TYPE. */
+	    {			/* This is an assumption, essentially. */
+	      nkd = FFEINFO_kindBLOCKDATA;
+	      nwh = FFEINFO_whereGLOBAL;
+	      needs_type = FALSE;
+	    }
+	}
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      /* Honestly, this appears to be a guess.  I can't find anyplace in the
+	 standard that makes clear whether this unreferenced dummy argument
+	 is an ENTITY or a FUNCTION.  And yet, for the f2c interface, picking
+	 one is critical for CHARACTER entities because it determines whether
+	 to expect an additional argument specifying the length of an ENTITY
+	 that is not expected (or needed) for a FUNCTION.  HOWEVER, F90 makes
+	 this guess a correct one, and it does seem that the Section 18 Notes
+	 in Appendix B of F77 make it clear the F77 standard at least
+	 intended to make this guess correct as well, so this seems ok.  */
+
+      nkd = FFEINFO_kindENTITY;
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsADJUSTABLE)
+	{			/* Not actually in any dummy list! */
+	  if (ffe_is_pedantic ()
+	      && ffebad_start_msg ("Local adjustable symbol `%A' at %0",
+				   FFEBAD_severityPEDANTIC))
+	    {
+	      ffebad_string (ffesymbol_text (s));
+	      ffebad_here (0, ffesymbol_where_line (s),
+			   ffesymbol_where_column (s));
+	      ffebad_finish ();
+	    }
+	}
+      nwh = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      nwh = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG)));
+
+      if (sa & FFESYMBOL_attrsANYLEN)
+	{			/* Can't touch this. */
+	  ffesymbol_signal_change (s);
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_resolve_intrin (s);
+	  s = ffecom_sym_learned (s);
+	  ffestorag_end_layout (s);
+	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+	  return s;
+	}
+
+      nkd = FFEINFO_kindENTITY;
+      nwh = FFEINFO_whereLOCAL;
+    }
+  else
+    assert ("unexpected attribute set" == NULL);
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, ffesta_tokens[0]);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);
+      ffesymbol_set_attrs (s, na);	/* Establish new info. */
+      ffesymbol_set_state (s, ns);
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       nkd,
+				       nwh,
+				       ffesymbol_size (s)));
+      if (needs_type && !ffeimplic_establish_symbol (s))
+	ffesymbol_error (s, ffesta_tokens[0]);
+      else
+	ffesymbol_resolve_intrin (s);
+      s = ffecom_sym_learned (s);
+      ffestorag_end_layout (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* ffestu_sym_exec_transition -- Update symbol just before first exec stmt
+
+   ffesymbol s;
+   ffestu_sym_exec_transition(s);  */
+
+ffesymbol
+ffestu_sym_exec_transition (ffesymbol s)
+{
+  ffeinfoKind skd;
+  ffeinfoWhere swh;
+  ffeinfoKind nkd;
+  ffeinfoWhere nwh;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffesymbolState ss;
+  ffesymbolState ns;
+  ffeintrinGen gen;
+  ffeintrinSpec spec;
+  ffeintrinImp imp;
+  bool needs_type = TRUE;	/* Implicit type assignment might be
+				   necessary. */
+  bool resolve_intrin = TRUE;	/* Might need to resolve intrinsic. */
+
+  assert (s != NULL);
+
+  sa = ffesymbol_attrs (s);
+  skd = ffesymbol_kind (s);
+  swh = ffesymbol_where (s);
+  ss = ffesymbol_state (s);
+
+  switch (ss)
+    {
+    case FFESYMBOL_stateNONE:
+      return s;			/* Assume caller will handle it. */
+
+    case FFESYMBOL_stateSEEN:
+      break;
+
+    case FFESYMBOL_stateUNCERTAIN:
+      ffestorag_exec_layout (s);
+      return s;			/* Already processed this one, or not
+				   necessary. */
+
+    case FFESYMBOL_stateUNDERSTOOD:
+      if (skd == FFEINFO_kindNAMELIST)
+	{
+	  ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
+	  ffestu_list_exec_transition_ (ffesymbol_namelist (s));
+	}
+      else if ((swh == FFEINFO_whereLOCAL)
+	       && ((skd == FFEINFO_kindFUNCTION)
+		   || (skd == FFEINFO_kindSUBROUTINE)))
+	{
+	  ffestu_dummies_transition_ (ffecom_sym_exec_transition,
+				      ffesymbol_dummyargs (s));
+	  if ((skd == FFEINFO_kindFUNCTION)
+	      && !ffeimplic_establish_symbol (s))
+	    ffesymbol_error (s, ffesta_tokens[0]);
+	}
+
+      ffestorag_exec_layout (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+      return s;
+
+    default:
+      assert ("bad status" == NULL);
+      return s;
+    }
+
+  ns = FFESYMBOL_stateUNDERSTOOD;	/* Only a few UNCERTAIN exceptions. */
+
+  na = sa;
+  nkd = skd;
+  nwh = swh;
+
+  assert (!(sa & FFESYMBOL_attrsANY));
+
+  if (sa & FFESYMBOL_attrsCOMMON)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsEQUIV
+		       | FFESYMBOL_attrsINIT
+		       | FFESYMBOL_attrsNAMELIST
+		       | FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      nkd = FFEINFO_kindENTITY;
+      nwh = FFEINFO_whereCOMMON;
+    }
+  else if (sa & FFESYMBOL_attrsRESULT)
+    {				/* Result variable for function. */
+      assert (!(sa & ~(FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsRESULT
+		       | FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      nkd = FFEINFO_kindENTITY;
+      nwh = FFEINFO_whereRESULT;
+    }
+  else if (sa & FFESYMBOL_attrsSFUNC)
+    {				/* Statement function. */
+      assert (!(sa & ~(FFESYMBOL_attrsSFUNC
+		       | FFESYMBOL_attrsTYPE)));
+
+      nkd = FFEINFO_kindFUNCTION;
+      nwh = FFEINFO_whereCONSTANT;
+    }
+  else if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsTYPE)
+	{
+	  nkd = FFEINFO_kindFUNCTION;
+
+	  if (sa & FFESYMBOL_attrsDUMMY)
+	    nwh = FFEINFO_whereDUMMY;
+	  else
+	    {
+	      if (ffesta_is_entry_valid)
+		{
+		  nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL. */
+		  ns = FFESYMBOL_stateUNCERTAIN;
+		}
+	      else
+		nwh = FFEINFO_whereGLOBAL;
+	    }
+	}
+      else
+	/* No TYPE. */
+	{
+	  nkd = FFEINFO_kindNONE;	/* FUNCTION, SUBROUTINE, BLOCKDATA. */
+	  needs_type = FALSE;	/* Only gets type if FUNCTION. */
+	  ns = FFESYMBOL_stateUNCERTAIN;
+
+	  if (sa & FFESYMBOL_attrsDUMMY)
+	    nwh = FFEINFO_whereDUMMY;	/* Not BLOCKDATA. */
+	  else
+	    {
+	      if (ffesta_is_entry_valid)
+		nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL. */
+	      else
+		nwh = FFEINFO_whereGLOBAL;
+	    }
+	}
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE	/* Possible. */
+		       | FFESYMBOL_attrsADJUSTS	/* Possible. */
+		       | FFESYMBOL_attrsANYLEN	/* Possible. */
+		       | FFESYMBOL_attrsANYSIZE	/* Possible. */
+		       | FFESYMBOL_attrsARRAY	/* Possible. */
+		       | FFESYMBOL_attrsDUMMY	/* Have it. */
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG	/* Possible. */
+		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
+
+      nwh = FFEINFO_whereDUMMY;
+
+      if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYSIZE))
+	ffestu_symter_exec_transition_ (ffesymbol_dims (s));
+      if (sa & (FFESYMBOL_attrsADJUSTS
+		| FFESYMBOL_attrsARRAY
+		| FFESYMBOL_attrsANYLEN
+		| FFESYMBOL_attrsNAMELIST
+		| FFESYMBOL_attrsSFARG))
+	nkd = FFEINFO_kindENTITY;
+      else
+	{
+	  if (!(sa & FFESYMBOL_attrsTYPE))
+	    needs_type = FALSE;	/* Don't assign type to SUBROUTINE! */
+	  nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION, SUBROUTINE. */
+	  ns = FFESYMBOL_stateUNCERTAIN;
+	}
+    }
+  else if (sa & FFESYMBOL_attrsADJUSTS)
+    {				/* Must be DUMMY or COMMON at some point. */
+      assert (!(sa & (FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsDUMMY)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS	/* Have it. */
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEQUIV	/* Possible. */
+		       | FFESYMBOL_attrsINIT	/* Possible. */
+		       | FFESYMBOL_attrsNAMELIST	/* Possible. */
+		       | FFESYMBOL_attrsSFARG	/* Possible. */
+		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
+
+      nkd = FFEINFO_kindENTITY;
+
+      if (sa & FFESYMBOL_attrsEQUIV)
+	{
+	  if ((ffesymbol_equiv (s) == NULL)
+	      || (ffeequiv_common (ffesymbol_equiv (s)) == NULL))
+	    na = FFESYMBOL_attrsetNONE;	/* Not equiv'd into COMMON. */
+	  else
+	    nwh = FFEINFO_whereCOMMON;
+	}
+      else if (!ffesta_is_entry_valid
+	       || (sa & (FFESYMBOL_attrsINIT
+			 | FFESYMBOL_attrsNAMELIST)))
+	na = FFESYMBOL_attrsetNONE;
+      else
+	nwh = FFEINFO_whereDUMMY;
+    }
+  else if (sa & FFESYMBOL_attrsSAVE)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsEQUIV
+		       | FFESYMBOL_attrsINIT
+		       | FFESYMBOL_attrsNAMELIST
+		       | FFESYMBOL_attrsSAVE
+		       | FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      nkd = FFEINFO_kindENTITY;
+      nwh = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsEQUIV)
+    {
+      assert (!(sa & FFESYMBOL_attrsCOMMON));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS	/* Possible. */
+		       | FFESYMBOL_attrsARRAY	/* Possible. */
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsEQUIV	/* Have it. */
+		       | FFESYMBOL_attrsINIT	/* Possible. */
+		       | FFESYMBOL_attrsNAMELIST	/* Possible. */
+		       | FFESYMBOL_attrsSAVE	/* Possible. */
+		       | FFESYMBOL_attrsSFARG	/* Possible. */
+		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
+
+      nkd = FFEINFO_kindENTITY;
+      nwh = ffestu_equiv_ (s);
+    }
+  else if (sa & FFESYMBOL_attrsNAMELIST)
+    {
+      assert (!(sa & (FFESYMBOL_attrsADJUSTS
+		      | FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsEQUIV
+		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+		       | FFESYMBOL_attrsARRAY	/* Possible. */
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsEQUIV
+		       | FFESYMBOL_attrsINIT	/* Possible. */
+		       | FFESYMBOL_attrsNAMELIST	/* Have it. */
+		       | FFESYMBOL_attrsSAVE
+		       | FFESYMBOL_attrsSFARG	/* Possible. */
+		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
+
+      nkd = FFEINFO_kindENTITY;
+      nwh = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsINIT)
+    {
+      assert (!(sa & (FFESYMBOL_attrsADJUSTS
+		      | FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsEQUIV
+		      | FFESYMBOL_attrsNAMELIST
+		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+		       | FFESYMBOL_attrsARRAY	/* Possible. */
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsEQUIV
+		       | FFESYMBOL_attrsINIT	/* Have it. */
+		       | FFESYMBOL_attrsNAMELIST
+		       | FFESYMBOL_attrsSAVE
+		       | FFESYMBOL_attrsSFARG	/* Possible. */
+		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
+
+      nkd = FFEINFO_kindENTITY;
+      nwh = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & (FFESYMBOL_attrsADJUSTS
+		      | FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEQUIV
+		      | FFESYMBOL_attrsINIT
+		      | FFESYMBOL_attrsNAMELIST
+		      | FFESYMBOL_attrsRESULT
+		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEQUIV
+		       | FFESYMBOL_attrsINIT
+		       | FFESYMBOL_attrsNAMELIST
+		       | FFESYMBOL_attrsRESULT
+		       | FFESYMBOL_attrsSAVE
+		       | FFESYMBOL_attrsSFARG	/* Have it. */
+		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
+
+      nkd = FFEINFO_kindENTITY;
+
+      if (ffesta_is_entry_valid)
+	{
+	  nwh = FFEINFO_whereNONE;	/* DUMMY, LOCAL. */
+	  ns = FFESYMBOL_stateUNCERTAIN;
+	}
+      else
+	nwh = FFEINFO_whereLOCAL;
+    }
+  else if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYSIZE))
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsANYSIZE
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsTYPE)));
+
+      nkd = FFEINFO_kindENTITY;
+
+      if (sa & FFESYMBOL_attrsADJUSTABLE)
+	  ffestu_symter_exec_transition_ (ffesymbol_dims (s));
+
+      if (sa & (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsANYSIZE))
+	nwh = FFEINFO_whereDUMMY;
+      else
+	{
+	  nwh = FFEINFO_whereNONE;	/* DUMMY, LOCAL. */
+	  ns = FFESYMBOL_stateUNCERTAIN;
+	}
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
+		      | FFESYMBOL_attrsANYSIZE
+		      | FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEQUIV
+		      | FFESYMBOL_attrsINIT
+		      | FFESYMBOL_attrsNAMELIST
+		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN	/* Possible. */
+		       | FFESYMBOL_attrsANYSIZE
+		       | FFESYMBOL_attrsARRAY	/* Have it. */
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEQUIV
+		       | FFESYMBOL_attrsINIT
+		       | FFESYMBOL_attrsNAMELIST
+		       | FFESYMBOL_attrsSAVE
+		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
+
+      nkd = FFEINFO_kindENTITY;
+
+      if (sa & FFESYMBOL_attrsANYLEN)
+	{
+	  assert (ffesta_is_entry_valid);	/* Already diagnosed. */
+	  nwh = FFEINFO_whereDUMMY;
+	}
+      else
+	{
+	  if (ffesta_is_entry_valid)
+	    {
+	      nwh = FFEINFO_whereNONE;	/* DUMMY, LOCAL. */
+	      ns = FFESYMBOL_stateUNCERTAIN;
+	    }
+	  else
+	    nwh = FFEINFO_whereLOCAL;
+	}
+    }
+  else if (sa & FFESYMBOL_attrsANYLEN)
+    {
+      assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
+		      | FFESYMBOL_attrsANYSIZE
+		      | FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsRESULT)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN	/* Have it. */
+		       | FFESYMBOL_attrsANYSIZE
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsRESULT
+		       | FFESYMBOL_attrsTYPE)));	/* Have it too. */
+
+      if (ffesta_is_entry_valid)
+	{
+	  nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION. */
+	  nwh = FFEINFO_whereNONE;	/* DUMMY, INTRINSIC, RESULT. */
+	  ns = FFESYMBOL_stateUNCERTAIN;
+	  resolve_intrin = FALSE;
+	}
+      else if (ffeintrin_is_intrinsic (ffesymbol_text (s), NULL, FALSE,
+				       &gen, &spec, &imp, &nkd))
+	{
+	  ffesymbol_signal_change (s);
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_generic (s, gen);
+	  ffesymbol_set_specific (s, spec);
+	  ffesymbol_set_implementation (s, imp);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   nkd,
+					   FFEINFO_whereINTRINSIC,
+					   FFETARGET_charactersizeNONE));
+	  ffesymbol_resolve_intrin (s);
+	  ffestorag_exec_layout (s);
+	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+	  return s;
+	}
+      else
+	{			/* SPECIAL: can't have CHAR*(*) var in
+				   PROGRAM/BLOCKDATA, unless it isn't
+				   referenced anywhere in the code. */
+	  ffesymbol_signal_change (s);	/* Can't touch this. */
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_resolve_intrin (s);
+	  ffestorag_exec_layout (s);
+	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+	  return s;
+	}
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
+		      | FFESYMBOL_attrsADJUSTS
+		      | FFESYMBOL_attrsANYLEN
+		      | FFESYMBOL_attrsANYSIZE
+		      | FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEQUIV
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsINIT
+		      | FFESYMBOL_attrsNAMELIST
+		      | FFESYMBOL_attrsRESULT
+		      | FFESYMBOL_attrsSAVE
+		      | FFESYMBOL_attrsSFARG
+		      | FFESYMBOL_attrsSFUNC)));
+      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsADJUSTS
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsANYSIZE
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsCOMMON
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEQUIV
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsINIT
+		       | FFESYMBOL_attrsINTRINSIC	/* UNDERSTOOD. */
+		       | FFESYMBOL_attrsNAMELIST
+		       | FFESYMBOL_attrsRESULT
+		       | FFESYMBOL_attrsSAVE
+		       | FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsSFUNC
+		       | FFESYMBOL_attrsTYPE)));	/* Have it. */
+
+      nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION. */
+      nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL, INTRINSIC, LOCAL, RESULT. */
+      ns = FFESYMBOL_stateUNCERTAIN;
+      resolve_intrin = FALSE;
+    }
+  else if (sa & (FFESYMBOL_attrsCBLOCK | FFESYMBOL_attrsSAVECBLOCK))
+    {				/* COMMON block. */
+      assert (!(sa & ~(FFESYMBOL_attrsCBLOCK
+		       | FFESYMBOL_attrsSAVECBLOCK)));
+
+      if (sa & FFESYMBOL_attrsCBLOCK)
+	ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
+      else
+	ffesymbol_set_commonlist (s, NULL);
+      ffestu_list_exec_transition_ (ffesymbol_commonlist (s));
+      nkd = FFEINFO_kindCOMMON;
+      nwh = FFEINFO_whereLOCAL;
+      needs_type = FALSE;
+    }
+  else
+    {				/* First seen in stmt func definition. */
+      assert (sa == FFESYMBOL_attrsetNONE);
+      assert ("Why are we here again?" == NULL);	/* ~~~~~ */
+
+      nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION. */
+      nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL, LOCAL. */
+      ns = FFESYMBOL_stateUNCERTAIN;	/* Will get repromoted by caller. */
+      needs_type = FALSE;
+    }
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, ffesta_tokens[0]);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);
+      ffesymbol_set_attrs (s, na);	/* Establish new info. */
+      ffesymbol_set_state (s, ns);
+      if ((ffesymbol_common (s) == NULL)
+	  && (ffesymbol_equiv (s) != NULL))
+	ffesymbol_set_common (s, ffeequiv_common (ffesymbol_equiv (s)));
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       nkd,
+				       nwh,
+				       ffesymbol_size (s)));
+      if (needs_type && !ffeimplic_establish_symbol (s))
+	ffesymbol_error (s, ffesta_tokens[0]);
+      else if (resolve_intrin)
+	ffesymbol_resolve_intrin (s);
+      ffestorag_exec_layout (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* ffestu_list_exec_transition_ -- Update SYMTERs in ITEM list w/in symbol
+
+   ffebld list;
+   ffestu_list_exec_transition_(list);
+
+   list contains an FFEBLD_opITEM list of SYMTERs (possibly STARs and
+   other things, too, but we'll ignore the known ones).	 For each SYMTER,
+   we run sym_exec_transition_ on the corresponding ffesymbol (a recursive
+   call, since that's the function that's calling us) to update it's
+   information.	 Then we copy that information into the SYMTER.
+
+   Make sure we don't get called recursively ourselves!	 */
+
+static void
+ffestu_list_exec_transition_ (ffebld list)
+{
+  static in_progress = FALSE;
+  ffebld item;
+  ffesymbol symbol;
+
+  assert (!in_progress);
+  in_progress = TRUE;
+
+  for (; list != NULL; list = ffebld_trail (list))
+    {
+      if ((item = ffebld_head (list)) == NULL)
+	continue;		/* Try next item. */
+
+      switch (ffebld_op (item))
+	{
+	case FFEBLD_opSTAR:
+	  break;
+
+	case FFEBLD_opSYMTER:
+	  symbol = ffebld_symter (item);
+	  if (symbol == NULL)
+	    break;		/* Detached from stmt func dummy list. */
+	  symbol = ffecom_sym_exec_transition (symbol);
+	  assert (ffesymbol_kind (symbol) != FFEINFO_kindNONE);
+	  assert (ffesymbol_where (symbol) != FFEINFO_whereNONE);
+	  ffebld_set_info (item, ffesymbol_info (symbol));
+	  break;
+
+	default:
+	  assert ("Unexpected item on list" == NULL);
+	  break;
+	}
+    }
+
+  in_progress = FALSE;
+}
+
+/* ffestu_symter_exec_transition_ -- Update SYMTERs in expr w/in symbol
+
+   ffebld expr;
+   ffestu_symter_exec_transition_(expr);
+
+   Any SYMTER in expr's tree with whereNONE gets updated to the
+   (recursively transitioned) sym it identifies (DUMMY or COMMON).
+
+   Make sure we don't get called recursively ourselves!	 */
+
+static void
+ffestu_symter_exec_transition_ (ffebld expr)
+{
+  ffesymbol symbol;
+
+  /* Label used for tail recursion (reset expr and go here instead of calling
+     self). */
+
+tail:				/* :::::::::::::::::::: */
+
+  if (expr == NULL)
+    return;
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opITEM:
+      while (ffebld_trail (expr) != NULL)
+	{
+	  ffestu_symter_exec_transition_ (ffebld_head (expr));
+	  expr = ffebld_trail (expr);
+	}
+      expr = ffebld_head (expr);
+      goto tail;		/* :::::::::::::::::::: */
+
+    default:
+      break;
+    }
+
+  switch (ffebld_arity (expr))
+    {
+    case 2:
+      ffestu_symter_exec_transition_ (ffebld_left (expr));
+      expr = ffebld_right (expr);
+      goto tail;		/* :::::::::::::::::::: */
+
+    case 1:
+      expr = ffebld_left (expr);
+      goto tail;		/* :::::::::::::::::::: */
+
+    default:
+      switch (ffebld_op (expr))
+	{
+	case FFEBLD_opSYMTER:
+	  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereNONE)
+	    break;		/* Already have needed info. */
+	  symbol = ffecom_sym_exec_transition (ffebld_symter (expr));
+	  ffebld_set_info (expr, ffesymbol_info (symbol));
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+    }
+
+  return;
+}
+
+/* ffestu_dummies_transition_ -- Update SYMTERs in ITEM list w/in entry
+
+   ffebld list;
+   ffesymbol symfunc(ffesymbol s);
+   if (ffestu_dummies_transition_(symfunc,list))
+       // One or more items are still UNCERTAIN.
+
+   list contains an FFEBLD_opITEM list of SYMTERs (possibly STARs and
+   other things, too, but we'll ignore the known ones).	 For each SYMTER,
+   we run symfunc on the corresponding ffesymbol (a recursive
+   call, since that's the function that's calling us) to update it's
+   information.	 Then we copy that information into the SYMTER.
+
+   Return TRUE if any of the SYMTER's has incomplete information.
+
+   Make sure we don't get called recursively ourselves!	 */
+
+static bool
+ffestu_dummies_transition_ (ffesymbol (*symfunc) (), ffebld list)
+{
+  static in_progress = FALSE;
+  ffebld item;
+  ffesymbol symbol;
+  bool uncertain = FALSE;
+
+  assert (!in_progress);
+  in_progress = TRUE;
+
+  for (; list != NULL; list = ffebld_trail (list))
+    {
+      if ((item = ffebld_head (list)) == NULL)
+	continue;		/* Try next item. */
+
+      switch (ffebld_op (item))
+	{
+	case FFEBLD_opSTAR:
+	  break;
+
+	case FFEBLD_opSYMTER:
+	  symbol = ffebld_symter (item);
+	  if (symbol == NULL)
+	    break;		/* Detached from stmt func dummy list. */
+	  symbol = (*symfunc) (symbol);
+	  if (ffesymbol_state (symbol) == FFESYMBOL_stateUNCERTAIN)
+	    uncertain = TRUE;
+	  else
+	    {
+	      assert (ffesymbol_kind (symbol) != FFEINFO_kindNONE);
+	      assert (ffesymbol_where (symbol) != FFEINFO_whereNONE);
+	    }
+	  ffebld_set_info (item, ffesymbol_info (symbol));
+	  break;
+
+	default:
+	  assert ("Unexpected item on list" == NULL);
+	  break;
+	}
+    }
+
+  in_progress = FALSE;
+
+  return uncertain;
+}