/* Implementation of Fortran symbol manager
- Copyright (C) 1995-1997 Free Software Foundation, Inc.
- Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+ Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley.
This file is part of GNU Fortran.
/* Choose how to handle global symbols here. */
-#if FFECOM_targetCURRENT == FFECOM_targetFFE
-#define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
-#elif FFECOM_targetCURRENT == FFECOM_targetGCC
/* Would be good to understand why PROGUNIT in this case too.
(1995-08-22). */
#define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
-#else
-#error
-#endif
/* Choose how to handle memory pools based on global symbol stuff. */
/* List of state names. */
-static char *ffesymbol_state_name_[] =
+static const char *const ffesymbol_state_name_[] =
{
"?",
"@",
/* List of attribute names. */
-static char *ffesymbol_attr_name_[] =
+static const char *const ffesymbol_attr_name_[] =
{
#define DEFATTR(ATTR,ATTRS,NAME) NAME,
#include "symbol.def"
s->reported = FALSE;
s->explicit_where = FALSE;
s->namelisted = FALSE;
+ s->assigned = FALSE;
ffename_set_symbol (n, s);
/* Returns a string representing the attributes set. */
-char *
+const char *
ffesymbol_attrs_string (ffesymbolAttrs attrs)
{
static char string[FFESYMBOL_attr * 12 + 20];
ffesymbol_drive (fn); */
void
-ffesymbol_drive (ffesymbol (*fn) ())
+ffesymbol_drive (ffesymbol (*fn) (ffesymbol))
{
assert (ffesymbol_sfunc_ == NULL); /* Might be ok, but not for current
uses. */
ffesymbol_drive_sfnames (fn); */
void
-ffesymbol_drive_sfnames (ffesymbol (*fn) ())
+ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol))
{
ffename_space_drive_symbol (ffesymbol_sfunc_, fn);
}
-/* Dump info on the symbol for debugging purposes. */
-
-void
-ffesymbol_dump (ffesymbol s)
-{
- ffeinfoKind k;
- ffeinfoWhere w;
-
- assert (s != NULL);
-
- if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
- fprintf (dmpout, "%s:%d%s%s*%" ffetargetCharacterSize_f "u",
- ffesymbol_text (s),
- (int) ffeinfo_rank (s->info),
- ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
- ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
- ffeinfo_size (s->info));
- else
- fprintf (dmpout, "%s:%d%s%s",
- ffesymbol_text (s),
- (int) ffeinfo_rank (s->info),
- ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
- ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
- if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
- fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
- if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
- fprintf (dmpout, "@%s", ffeinfo_where_string (w));
-
- if ((s->generic != FFEINTRIN_genNONE)
- || (s->specific != FFEINTRIN_specNONE)
- || (s->implementation != FFEINTRIN_impNONE))
- fprintf (dmpout, "{%s:%s:%s}",
- ffeintrin_name_generic (s->generic),
- ffeintrin_name_specific (s->specific),
- ffeintrin_name_implementation (s->implementation));
-}
-
/* Produce generic error message about a symbol.
For now, just output error message using symbol's name and pointing to
ffesymbol_error (s, NULL);
}
-/* Report info on the symbol for debugging purposes. */
-
-ffesymbol
-ffesymbol_report (ffesymbol s)
-{
- ffeinfoKind k;
- ffeinfoWhere w;
-
- assert (s != NULL);
-
- if (s->reported)
- return s;
-
- s->reported = TRUE;
-
- if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
- fprintf (dmpout, "\"%s\": %s %s %d%s%s*%" ffetargetCharacterSize_f "u",
- ffesymbol_text (s),
- ffesymbol_state_string (s->state),
- ffesymbol_attrs_string (s->attrs),
- (int) ffeinfo_rank (s->info),
- ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
- ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
- ffeinfo_size (s->info));
- else
- fprintf (dmpout, "\"%s\": %s %s %d%s%s",
- ffesymbol_text (s),
- ffesymbol_state_string (s->state),
- ffesymbol_attrs_string (s->attrs),
- (int) ffeinfo_rank (s->info),
- ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
- ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
- if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
- fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
- if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
- fprintf (dmpout, "@%s", ffeinfo_where_string (w));
- fputc ('\n', dmpout);
-
- if (s->dims != NULL)
- {
- fprintf (dmpout, " dims: ");
- ffebld_dump (s->dims);
- fputs ("\n", dmpout);
- }
-
- if (s->extents != NULL)
- {
- fprintf (dmpout, " extents: ");
- ffebld_dump (s->extents);
- fputs ("\n", dmpout);
- }
-
- if (s->dim_syms != NULL)
- {
- fprintf (dmpout, " dim syms: ");
- ffebld_dump (s->dim_syms);
- fputs ("\n", dmpout);
- }
-
- if (s->array_size != NULL)
- {
- fprintf (dmpout, " array size: ");
- ffebld_dump (s->array_size);
- fputs ("\n", dmpout);
- }
-
- if (s->init != NULL)
- {
- fprintf (dmpout, " init-value: ");
- if (ffebld_op (s->init) == FFEBLD_opANY)
- fputs ("<any>\n", dmpout);
- else
- {
- ffebld_dump (s->init);
- fputs ("\n", dmpout);
- }
- }
-
- if (s->accretion != NULL)
- {
- fprintf (dmpout, " accretion (%" ffetargetOffset_f "d left): ",
- s->accretes);
- ffebld_dump (s->accretion);
- fputs ("\n", dmpout);
- }
- else if (s->accretes != 0)
- fprintf (dmpout, " accretes!! = %" ffetargetOffset_f "d left\n",
- s->accretes);
-
- if (s->dummy_args != NULL)
- {
- fprintf (dmpout, " dummies: ");
- ffebld_dump (s->dummy_args);
- fputs ("\n", dmpout);
- }
-
- if (s->namelist != NULL)
- {
- fprintf (dmpout, " namelist: ");
- ffebld_dump (s->namelist);
- fputs ("\n", dmpout);
- }
-
- if (s->common_list != NULL)
- {
- fprintf (dmpout, " common-list: ");
- ffebld_dump (s->common_list);
- fputs ("\n", dmpout);
- }
-
- if (s->sfunc_expr != NULL)
- {
- fprintf (dmpout, " sfunc expression: ");
- ffebld_dump (s->sfunc_expr);
- fputs ("\n", dmpout);
- }
-
- if (s->is_save)
- {
- fprintf (dmpout, " SAVEd\n");
- }
-
- if (s->is_init)
- {
- fprintf (dmpout, " initialized\n");
- }
-
- if (s->do_iter)
- {
- fprintf (dmpout, " DO-loop iteration variable (currently)\n");
- }
-
- if (s->explicit_where)
- {
- fprintf (dmpout, " Explicit INTRINSIC/EXTERNAL\n");
- }
-
- if (s->namelisted)
- {
- fprintf (dmpout, " Namelisted\n");
- }
-
- if (s->common != NULL)
- {
- fprintf (dmpout, " COMMON area: %s\n", ffesymbol_text (s->common));
- }
-
- if (s->equiv != NULL)
- {
- fprintf (dmpout, " EQUIVALENCE information: ");
- ffeequiv_dump (s->equiv);
- fputs ("\n", dmpout);
- }
-
- if (s->storage != NULL)
- {
- fprintf (dmpout, " Storage: ");
- ffestorag_dump (s->storage);
- fputs ("\n", dmpout);
- }
-
- return s;
-}
-
-/* Report info on the symbols. */
-
-void
-ffesymbol_report_all ()
-{
- ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_report);
- ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_report);
- ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_report);
-}
-
/* Resolve symbol that has become known intrinsic or non-intrinsic. */
void
/* Returns the string based on the state. */
-char *
+const char *
ffesymbol_state_string (ffesymbolState state)
{
if (state >= ARRAY_SIZE (ffesymbol_state_name_))
OSDN Git Service
