#include "proj.h"
#include "bld.h"
#include "com.h"
#include "equiv.h"
#include "global.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"
static void ffestu_list_exec_transition_ (ffebld list);
static bool ffestu_symter_end_transition_ (ffebld expr);
static bool ffestu_symter_exec_transition_ (ffebld expr);
static bool ffestu_dummies_transition_ (ffesymbol (*symfunc) (ffesymbol),
ffebld list);
#define ffestu_equiv_(s) (((ffesymbol_equiv (s) == NULL) \
|| (ffeequiv_common (ffesymbol_equiv (s)) == NULL)) ? FFEINFO_whereLOCAL \
: FFEINFO_whereCOMMON)
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;
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))
{
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)))
{
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;
const 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;
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)
{
ffesymbol_error (s, ffesta_tokens[0]);
return s;
}
if (ffestu_symter_end_transition_ (ffesymbol_dims (s)))
{
ffesymbol_error (s, NULL);
return s;
}
}
else if ((swh == FFEINFO_whereLOCAL)
&& ffestu_symter_end_transition_ (ffesymbol_dims (s)))
{
ffesymbol_error (s, NULL);
return s;
}
ffestorag_end_layout (s);
ffesymbol_signal_unreported (s);
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;
if (sa & FFESYMBOL_attrsEXTERNAL)
{
assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsEXTERNAL
| FFESYMBOL_attrsTYPE)));
if (sa & FFESYMBOL_attrsTYPE)
nwh = FFEINFO_whereGLOBAL;
else
{
if (sa & FFESYMBOL_attrsDUMMY)
{
ns = FFESYMBOL_stateUNCERTAIN;
needs_type = FALSE;
}
else if (sa & FFESYMBOL_attrsACTUALARG)
{
ns = FFESYMBOL_stateUNCERTAIN;
needs_type = FALSE;
}
else
{
nkd = FFEINFO_kindBLOCKDATA;
nwh = FFEINFO_whereGLOBAL;
needs_type = FALSE;
}
}
}
else if (sa & FFESYMBOL_attrsDUMMY)
{
assert (!(sa & FFESYMBOL_attrsEXTERNAL));
assert (!(sa & ~(FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsEXTERNAL
| FFESYMBOL_attrsTYPE)));
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)
{
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)));
assert (!(sa & ~(FFESYMBOL_attrsTYPE
| FFESYMBOL_attrsADJUSTABLE
| FFESYMBOL_attrsANYLEN
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsEXTERNAL
| FFESYMBOL_attrsSFARG)));
if (sa & FFESYMBOL_attrsANYLEN)
{
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);
return s;
}
nkd = FFEINFO_kindENTITY;
nwh = FFEINFO_whereLOCAL;
}
else
assert ("unexpected attribute set" == NULL);
if (na == FFESYMBOL_attrsetNONE)
ffesymbol_error (s, ffesta_tokens[0]);
else if (!(na & FFESYMBOL_attrsANY))
{
ffesymbol_signal_change (s);
ffesymbol_set_attrs (s, na);
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);
}
return 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;
bool resolve_intrin = TRUE;
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;
case FFESYMBOL_stateSEEN:
break;
case FFESYMBOL_stateUNCERTAIN:
ffestorag_exec_layout (s);
return s;
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);
return s;
default:
assert ("bad status" == NULL);
return s;
}
ns = FFESYMBOL_stateUNDERSTOOD;
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)
{
assert (!(sa & ~(FFESYMBOL_attrsANYLEN
| FFESYMBOL_attrsRESULT
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsTYPE)));
nkd = FFEINFO_kindENTITY;
nwh = FFEINFO_whereRESULT;
}
else if (sa & FFESYMBOL_attrsSFUNC)
{
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;
ns = FFESYMBOL_stateUNCERTAIN;
}
else
nwh = FFEINFO_whereGLOBAL;
}
}
else
{
nkd = FFEINFO_kindNONE;
needs_type = FALSE;
ns = FFESYMBOL_stateUNCERTAIN;
if (sa & FFESYMBOL_attrsDUMMY)
nwh = FFEINFO_whereDUMMY;
else
{
if (ffesta_is_entry_valid)
nwh = FFEINFO_whereNONE;
else
nwh = FFEINFO_whereGLOBAL;
}
}
}
else if (sa & FFESYMBOL_attrsDUMMY)
{
assert (!(sa & FFESYMBOL_attrsEXTERNAL));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
| FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsANYLEN
| FFESYMBOL_attrsANYSIZE
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsEXTERNAL
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsTYPE)));
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)
{
if (!(sa & FFESYMBOL_attrsTYPE))
needs_type = FALSE;
nkd = FFEINFO_kindNONE;
ns = FFESYMBOL_stateUNCERTAIN;
}
}
else if (sa & FFESYMBOL_attrsADJUSTS)
{
assert (!(sa & (FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsDUMMY)));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsINIT
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsTYPE)));
nkd = FFEINFO_kindENTITY;
if (sa & FFESYMBOL_attrsEQUIV)
{
if ((ffesymbol_equiv (s) == NULL)
|| (ffeequiv_common (ffesymbol_equiv (s)) == NULL))
na = FFESYMBOL_attrsetNONE;
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));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsINIT
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsSAVE
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsTYPE)));
nkd = FFEINFO_kindENTITY;
nwh = ffestu_equiv_ (s);
}
else if (sa & FFESYMBOL_attrsNAMELIST)
{
assert (!(sa & (FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsSAVE)));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsINIT
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsSAVE
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsTYPE)));
nkd = FFEINFO_kindENTITY;
nwh = FFEINFO_whereLOCAL;
}
else if (sa & FFESYMBOL_attrsINIT)
{
assert (!(sa & (FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsSAVE)));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsINIT
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsSAVE
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsTYPE)));
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)));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsINIT
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsRESULT
| FFESYMBOL_attrsSAVE
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsTYPE)));
nkd = FFEINFO_kindENTITY;
if (ffesta_is_entry_valid)
{
nwh = FFEINFO_whereNONE;
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))
{
nwh = FFEINFO_whereNONE;
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)));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
| FFESYMBOL_attrsANYLEN
| FFESYMBOL_attrsANYSIZE
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsCOMMON
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsEQUIV
| FFESYMBOL_attrsINIT
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsSAVE
| FFESYMBOL_attrsTYPE)));
nkd = FFEINFO_kindENTITY;
if (sa & FFESYMBOL_attrsANYLEN)
{
assert (ffesta_is_entry_valid);
nwh = FFEINFO_whereDUMMY;
}
else
{
if (ffesta_is_entry_valid)
{
nwh = FFEINFO_whereNONE;
ns = FFESYMBOL_stateUNCERTAIN;
}
else
nwh = FFEINFO_whereLOCAL;
}
}
else if (sa & FFESYMBOL_attrsANYLEN)
{
assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
| FFESYMBOL_attrsANYSIZE
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsRESULT)));
assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
| FFESYMBOL_attrsANYLEN
| FFESYMBOL_attrsANYSIZE
| FFESYMBOL_attrsARRAY
| FFESYMBOL_attrsDUMMY
| FFESYMBOL_attrsRESULT
| FFESYMBOL_attrsTYPE)));
if (ffesta_is_entry_valid)
{
nkd = FFEINFO_kindNONE;
nwh = FFEINFO_whereNONE;
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);
return s;
}
else
{
ffesymbol_signal_change (s);
ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
ffesymbol_resolve_intrin (s);
ffesymbol_reference (s, NULL, FALSE);
ffestorag_exec_layout (s);
ffesymbol_signal_unreported (s);
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
| FFESYMBOL_attrsNAMELIST
| FFESYMBOL_attrsRESULT
| FFESYMBOL_attrsSAVE
| FFESYMBOL_attrsSFARG
| FFESYMBOL_attrsSFUNC
| FFESYMBOL_attrsTYPE)));
nkd = FFEINFO_kindNONE;
nwh = FFEINFO_whereNONE;
ns = FFESYMBOL_stateUNCERTAIN;
resolve_intrin = FALSE;
}
else if (sa & (FFESYMBOL_attrsCBLOCK | FFESYMBOL_attrsSAVECBLOCK))
{
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
{
assert (sa == FFESYMBOL_attrsetNONE);
assert ("Why are we here again?" == NULL);
nkd = FFEINFO_kindNONE;
nwh = FFEINFO_whereNONE;
ns = FFESYMBOL_stateUNCERTAIN;
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);
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);
}
return s;
}
static void
ffestu_list_exec_transition_ (ffebld list)
{
static bool 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;
switch (ffebld_op (item))
{
case FFEBLD_opSTAR:
break;
case FFEBLD_opSYMTER:
symbol = ffebld_symter (item);
if (symbol == NULL)
break;
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;
}
static bool
ffestu_symter_end_transition_ (ffebld expr)
{
ffesymbol symbol;
bool any = FALSE;
tail:
if (expr == NULL)
return any;
switch (ffebld_op (expr))
{
case FFEBLD_opITEM:
while (ffebld_trail (expr) != NULL)
{
if (ffestu_symter_end_transition_ (ffebld_head (expr)))
any = TRUE;
expr = ffebld_trail (expr);
}
expr = ffebld_head (expr);
goto tail;
case FFEBLD_opSYMTER:
symbol = ffecom_sym_end_transition (ffebld_symter (expr));
if ((symbol != NULL)
&& ffesymbol_attr (symbol, FFESYMBOL_attrANY))
any = TRUE;
ffebld_set_info (expr, ffesymbol_info (symbol));
break;
case FFEBLD_opANY:
return TRUE;
default:
break;
}
switch (ffebld_arity (expr))
{
case 2:
if (ffestu_symter_end_transition_ (ffebld_left (expr)))
any = TRUE;
expr = ffebld_right (expr);
goto tail;
case 1:
expr = ffebld_left (expr);
goto tail;
default:
break;
}
return any;
}
static bool
ffestu_symter_exec_transition_ (ffebld expr)
{
ffesymbol symbol;
bool any = FALSE;
tail:
if (expr == NULL)
return any;
switch (ffebld_op (expr))
{
case FFEBLD_opITEM:
while (ffebld_trail (expr) != NULL)
{
if (ffestu_symter_exec_transition_ (ffebld_head (expr)))
any = TRUE;
expr = ffebld_trail (expr);
}
expr = ffebld_head (expr);
goto tail;
case FFEBLD_opSYMTER:
symbol = ffecom_sym_exec_transition (ffebld_symter (expr));
if ((symbol != NULL)
&& ffesymbol_attr (symbol, FFESYMBOL_attrANY))
any = TRUE;
ffebld_set_info (expr, ffesymbol_info (symbol));
break;
case FFEBLD_opANY:
return TRUE;
default:
break;
}
switch (ffebld_arity (expr))
{
case 2:
if (ffestu_symter_exec_transition_ (ffebld_left (expr)))
any = TRUE;
expr = ffebld_right (expr);
goto tail;
case 1:
expr = ffebld_left (expr);
goto tail;
default:
break;
}
return any;
}
static bool
ffestu_dummies_transition_ (ffesymbol (*symfunc) (ffesymbol), ffebld list)
{
static bool 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;
switch (ffebld_op (item))
{
case FFEBLD_opSTAR:
break;
case FFEBLD_opSYMTER:
symbol = ffebld_symter (item);
if (symbol == NULL)
break;
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;
}