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
}
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;
}