1163 lines
32 KiB
C
1163 lines
32 KiB
C
/* stu.c -- Implementation File (module.c template V1.0)
|
||
Copyright (C) 1995, 1996, 1997, 2002 Free Software Foundation, Inc.
|
||
Contributed by James Craig Burley.
|
||
|
||
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 "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"
|
||
|
||
/* 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 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);
|
||
|
||
/* 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;
|
||
}
|
||
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;
|
||
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;
|
||
|
||
/* 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 ()
|
||
/* xgettext:no-c-format */
|
||
&& 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;
|
||
}
|
||
|
||
/* 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]);
|
||
}
|
||
|
||
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;
|
||
}
|
||
|
||
/* 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 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; /* 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_end_transition_ -- Update SYMTERs in expr w/in symbol
|
||
|
||
ffebld expr;
|
||
ffestu_symter_end_transition_(expr);
|
||
|
||
Any SYMTER in expr's tree with whereNONE gets updated to the
|
||
(recursively transitioned) sym it identifies (DUMMY or COMMON). */
|
||
|
||
static bool
|
||
ffestu_symter_end_transition_ (ffebld expr)
|
||
{
|
||
ffesymbol symbol;
|
||
bool any = FALSE;
|
||
|
||
/* Label used for tail recursion (reset expr and go here instead of calling
|
||
self). */
|
||
|
||
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;
|
||
}
|
||
|
||
/* 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). */
|
||
|
||
static bool
|
||
ffestu_symter_exec_transition_ (ffebld expr)
|
||
{
|
||
ffesymbol symbol;
|
||
bool any = FALSE;
|
||
|
||
/* Label used for tail recursion (reset expr and go here instead of calling
|
||
self). */
|
||
|
||
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;
|
||
}
|
||
|
||
/* 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) (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; /* 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;
|
||
}
|