Exemple #1
0
void
ffesymbol_error (ffesymbol s, ffelexToken t)
{
  if ((t != NULL)
      && ffest_ffebad_start (FFEBAD_SYMERR))
    {
      ffebad_string (ffesymbol_text (s));
      ffebad_here (0, ffelex_token_where_line (t),
		   ffelex_token_where_column (t));
      ffebad_here (1, ffesymbol_where_line (s), ffesymbol_where_column (s));
      ffebad_finish ();
    }

  if (ffesymbol_attr (s, FFESYMBOL_attrANY))
    return;

  ffesymbol_signal_change (s);	/* May need to back up to previous version. */
  if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
      || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
    ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
  ffesymbol_set_attr (s, FFESYMBOL_attrANY);
  ffesymbol_set_info (s, ffeinfo_new_any ());
  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
  if (s->check_state == FFESYMBOL_checkstatePENDING_)
    ffelex_token_kill (s->check_token);
  s->check_state = FFESYMBOL_checkstateCHECKED_;
  s = ffecom_sym_learned (s);
  ffesymbol_signal_unreported (s);
}
Exemple #2
0
static ffesymbol
ffesymbol_unhook_ (ffesymbol s)
{
  s->other_space_name = s->name = NULL;
  if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
      || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
    ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
  if (s->check_state == FFESYMBOL_checkstatePENDING_)
    ffelex_token_kill (s->check_token);

  return s;
}
Exemple #3
0
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;
	}
      else if (((swh == FFEINFO_whereLOCAL)
		|| (swh == FFEINFO_whereNONE))
	       && (skd == FFEINFO_kindENTITY)
	       && ffestu_symter_end_transition_ (ffesymbol_dims (s)))
	{			/* Bad dimension expressions. */
	  ffesymbol_error (s, NULL);
	  return s;
	}
      break;

    case FFESYMBOL_stateUNDERSTOOD:
      if ((swh == FFEINFO_whereLOCAL)
	  && ((skd == FFEINFO_kindFUNCTION)
	      || (skd == FFEINFO_kindSUBROUTINE)))
	{
	  int n_args;
	  ffebld list;
	  ffebld item;
	  ffeglobalArgSummary as;
	  ffeinfoBasictype bt;
	  ffeinfoKindtype kt;
	  bool array;
	  char *name = NULL;

	  ffestu_dummies_transition_ (ffecom_sym_end_transition,
				      ffesymbol_dummyargs (s));

	  n_args = ffebld_list_length (ffesymbol_dummyargs (s));
	  ffeglobal_proc_def_nargs (s, n_args);
	  for (list = ffesymbol_dummyargs (s), n_args = 0;
	       list != NULL;
	       list = ffebld_trail (list), ++n_args)
	    {
	      item = ffebld_head (list);
	      array = FALSE;
	      if (item != NULL)
		{
		  bt = ffeinfo_basictype (ffebld_info (item));
		  kt = ffeinfo_kindtype (ffebld_info (item));
		  array = (ffeinfo_rank (ffebld_info (item)) > 0);
		  switch (ffebld_op (item))
		    {
		    case FFEBLD_opSTAR:
		      as = FFEGLOBAL_argsummaryALTRTN;
		      break;

		    case FFEBLD_opSYMTER:
		      name = ffesymbol_text (ffebld_symter (item));
		      as = FFEGLOBAL_argsummaryNONE;

		      switch (ffeinfo_kind (ffebld_info (item)))
			{
			case FFEINFO_kindFUNCTION:
			  as = FFEGLOBAL_argsummaryFUNC;
			  break;

			case FFEINFO_kindSUBROUTINE:
			  as = FFEGLOBAL_argsummarySUBR;
			  break;

			case FFEINFO_kindNONE:
			  as = FFEGLOBAL_argsummaryPROC;
			  break;

			default:
			  break;
			}

		      if (as != FFEGLOBAL_argsummaryNONE)
			break;

		      /* Fall through.  */
		    default:
		      if (bt == FFEINFO_basictypeCHARACTER)
			as = FFEGLOBAL_argsummaryDESCR;
		      else
			as = FFEGLOBAL_argsummaryREF;
		      break;
		    }
		}
	      else
		{
		  as = FFEGLOBAL_argsummaryNONE;
		  bt = FFEINFO_basictypeNONE;
		  kt = FFEINFO_kindtypeNONE;
		}
	      ffeglobal_proc_def_arg (s, n_args, name, as, bt, kt, array);
	    }
	}
      else if (swh == FFEINFO_whereDUMMY)
	{
	  if (ffesymbol_numentries (s) == 0)
	    {			/* Not actually in any dummy list! */
	      ffesymbol_error (s, ffesta_tokens[0]);
	      return s;
	    }
	  if (ffestu_symter_end_transition_ (ffesymbol_dims (s)))
	    {			/* Bad dimension expressions. */
	      ffesymbol_error (s, NULL);
	      return s;
	    }
	}
      else if ((swh == FFEINFO_whereLOCAL)
	       && ffestu_symter_end_transition_ (ffesymbol_dims (s)))
	{			/* Bad dimension expressions. */
	  ffesymbol_error (s, NULL);
	  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 (ffestu_symter_end_transition_ (ffesymbol_dims (s)))
	{
	  ffesymbol_error (s, NULL);
	  return s;
	}

      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);
	  ffesymbol_reference (s, NULL, FALSE);
	  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);
      ffesymbol_reference (s, NULL, FALSE);
      ffestorag_end_layout (s);
      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
    }

  return s;
}
Exemple #4
0
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]);
	}

      ffesymbol_reference (s, NULL, FALSE);
      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 (ffestu_symter_exec_transition_ (ffesymbol_dims (s)))
	na = FFESYMBOL_attrsetNONE;

      if (sa & (FFESYMBOL_attrsADJUSTS
		| FFESYMBOL_attrsARRAY
		| FFESYMBOL_attrsANYLEN
		| FFESYMBOL_attrsNAMELIST
		| FFESYMBOL_attrsSFARG))
	nkd = FFEINFO_kindENTITY;
      else if (sa & FFESYMBOL_attrsDUMMY)	/* Still okay. */
	{
	  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 (ffestu_symter_exec_transition_ (ffesymbol_dims (s)))
	na = FFESYMBOL_attrsetNONE;

      if (sa & (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsANYSIZE))
	nwh = FFEINFO_whereDUMMY;
      else if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYSIZE))
	/* Still okay.  */
	{
	  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))
	{
	  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,
					   FFEINFO_kindNONE,
					   FFEINFO_whereINTRINSIC,
					   FFETARGET_charactersizeNONE));
	  ffesymbol_resolve_intrin (s);
	  ffesymbol_reference (s, NULL, FALSE);
	  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);
	  ffesymbol_reference (s, NULL, FALSE);
	  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)
	   && (needs_type || (nkd != skd) || (nwh != swh)
	       || (na != sa) || (ns != ss)))
    {
      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);
      ffesymbol_reference (s, NULL, FALSE);
      ffestorag_exec_layout (s);
      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
    }

  return s;
}