Exemple #1
0
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
}
Exemple #2
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;
}