diff options
Diffstat (limited to 'contrib/gcc/f/symbol.c')
-rw-r--r-- | contrib/gcc/f/symbol.c | 229 |
1 files changed, 3 insertions, 226 deletions
diff --git a/contrib/gcc/f/symbol.c b/contrib/gcc/f/symbol.c index c4bd14d..816ad19 100644 --- a/contrib/gcc/f/symbol.c +++ b/contrib/gcc/f/symbol.c @@ -1,5 +1,5 @@ /* Implementation of Fortran symbol manager - Copyright (C) 1995-1997 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -47,15 +47,9 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* 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. */ @@ -117,7 +111,7 @@ static ffesymbolRetract_ *ffesymbol_retract_list_; /* List of state names. */ -static const char *ffesymbol_state_name_[] = +static const char *const ffesymbol_state_name_[] = { "?", "@", @@ -127,7 +121,7 @@ static const char *ffesymbol_state_name_[] = /* List of attribute names. */ -static const char *ffesymbol_attr_name_[] = +static const char *const ffesymbol_attr_name_[] = { #define DEFATTR(ATTR,ATTRS,NAME) NAME, #include "symbol.def" @@ -793,45 +787,6 @@ ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol)) ffename_space_drive_symbol (ffesymbol_sfunc_, fn); } -/* Dump info on the symbol for debugging purposes. */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -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)); -} -#endif - /* Produce generic error message about a symbol. For now, just output error message using symbol's name and pointing to @@ -1012,184 +967,6 @@ ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit) ffesymbol_error (s, NULL); } -/* Report info on the symbol for debugging purposes. */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -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; -} -#endif - -/* Report info on the symbols. */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -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); -} -#endif - /* Resolve symbol that has become known intrinsic or non-intrinsic. */ void |