OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

com.h: Remove FFECOM_targetCURRENT... 

* com.h: Remove FFECOM_targetCURRENT, FFECOM_ONEPASS, BUILT_FOR_270,
        BUILT_FOR_280, FFECOM_GCC_INCLUDE, all derivitive defines, and all
        related conditional compilation directives.
        * bad.c, bld.c, bld.h, com.c, equiv.c, equiv.h, global.h, intdoc.c,
        intrin.c, intrin.h, lex.c, parse.c, sta.c, std.c, ste.c, ste.h, stt.c,
        stt.h, stw.h, symbol.c, symbol.h, target.h, top.c: Likewise.

From-SVN: r46324
This commit is contained in:
Richard Henderson 2001-10-17 15:34:54 -07:00 committed by Richard Henderson
parent 5bed56d982
commit 516b69ff81
25 changed files with 1573 additions and 6567 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/f/ChangeLog
View File

@ -1,3 +1,12 @@
2001-10-17 Richard Henderson <rth@redhat.com>
* com.h: Remove FFECOM_targetCURRENT, FFECOM_ONEPASS, BUILT_FOR_270,
BUILT_FOR_280, FFECOM_GCC_INCLUDE, all derivitive defines, and all
related conditional compilation directives.
* bad.c, bld.c, bld.h, com.c, equiv.c, equiv.h, global.h, intdoc.c,
intrin.c, intrin.h, lex.c, parse.c, sta.c, std.c, ste.c, ste.h, stt.c,
stt.h, stw.h, symbol.c, symbol.h, target.h, top.c: Likewise.
2001-10-17 Richard Henderson <rth@redhat.com>
* Make-lang.in (f/com.o): Depend on langhooks.h.

77
gcc/f/bad.c
View File

@ -182,44 +182,40 @@ ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
ffebad_message_ = message;
}
#if FFECOM_targetCURRENT == FFECOM_targetGCC
{
switch (ffebad_severity_)
{ /* Tell toplev.c about this message. */
case FFEBAD_severityINFORMATIONAL:
case FFEBAD_severityTRIVIAL:
if (inhibit_warnings)
{ /* User wants no warnings. */
ffebad_is_temp_inhibited_ = TRUE;
return FALSE;
}
/* Fall through. */
case FFEBAD_severityWARNING:
case FFEBAD_severityPECULIAR:
case FFEBAD_severityPEDANTIC:
if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
|| !flag_pedantic_errors)
{
if (count_error (1) == 0)
{ /* User wants no warnings. */
ffebad_is_temp_inhibited_ = TRUE;
return FALSE;
}
break;
}
/* Fall through (PEDANTIC && flag_pedantic_errors). */
case FFEBAD_severityFATAL:
case FFEBAD_severityWEIRD:
case FFEBAD_severitySEVERE:
case FFEBAD_severityDISASTER:
count_error (0);
break;
switch (ffebad_severity_)
{ /* Tell toplev.c about this message. */
case FFEBAD_severityINFORMATIONAL:
case FFEBAD_severityTRIVIAL:
if (inhibit_warnings)
{ /* User wants no warnings. */
ffebad_is_temp_inhibited_ = TRUE;
return FALSE;
}
/* Fall through. */
case FFEBAD_severityWARNING:
case FFEBAD_severityPECULIAR:
case FFEBAD_severityPEDANTIC:
if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
|| !flag_pedantic_errors)
{
if (count_error (1) == 0)
{ /* User wants no warnings. */
ffebad_is_temp_inhibited_ = TRUE;
return FALSE;
}
break;
}
/* Fall through (PEDANTIC && flag_pedantic_errors). */
case FFEBAD_severityFATAL:
case FFEBAD_severityWEIRD:
case FFEBAD_severitySEVERE:
case FFEBAD_severityDISASTER:
count_error (0);
break;
default:
break;
}
}
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
default:
break;
}
ffebad_is_temp_inhibited_ = FALSE;
ffebad_errnum_ = errnum;
@ -420,20 +416,13 @@ ffebad_finish ()
{
if (bi != 0)
fputc ('\n', stderr);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
report_error_function (fn);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
fprintf (stderr,
#if 0
"Line %" ffewhereLineNumber_f "u of %s:\n %s\n %s%c",
rn, fn,
#else
/* the trailing space on the <file>:<line>: line
fools emacs19 compilation mode into finding the
report */
"%s:%" ffewhereLineNumber_f "u: %s\n %s\n %s%c",
fn, rn,
#endif
s,
ffewhere_line_content (l),
&spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],

1271
gcc/f/bld.c
View File

File diff suppressed because it is too large Load Diff

19
gcc/f/bld.h
View File

@ -124,13 +124,7 @@ typedef struct _ffebld_pool_stack_ *ffebldPoolstack_;
#define FFEBLD_whereconstPROGUNIT_ 1
#define FFEBLD_whereconstFILE_ 2
#if FFECOM_targetCURRENT == FFECOM_targetFFE
#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstPROGUNIT_
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_
#else
#error
#endif
/* Structure definitions. */
@ -486,9 +480,6 @@ extern struct _ffebld_pool_stack_ ffebld_pool_stack_;
/* Declare functions with prototypes. */
int ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffebld_constant_dump (ffebldConstant c);
#endif
bool ffebld_constant_is_magical (ffebldConstant c);
bool ffebld_constant_is_zero (ffebldConstant c);
#if FFETARGET_okCHARACTER1
@ -691,10 +682,6 @@ ffebldConstant ffebld_constant_new_typeless_ov (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_val (ffebldConst type,
ffetargetTypeless val);
ffebldConstant ffebld_constant_negated (ffebldConstant c);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
ffeinfoKindtype kt, ffetargetOffset size, ffebit bits);
#endif
ffebldConstantUnion ffebld_constantarray_get (ffebldConstantArray array,
ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetOffset offset);
void ffebld_constantarray_kill (ffebldConstantArray array, ffeinfoBasictype bt,
@ -711,12 +698,6 @@ void ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
ffeinfoBasictype cbt, ffeinfoKindtype ckt);
void ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
ffeinfoKindtype kt);
void ffebld_dump (ffebld b);
void ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt);
#endif
void ffebld_init_0 (void);
void ffebld_init_1 (void);
void ffebld_init_2 (void);

419
gcc/f/com.c
View File

File diff suppressed because it is too large Load Diff

63
gcc/f/com.h
View File

@ -34,27 +34,9 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#define FFECOM_dimensionsMAX 7 /* Max # dimensions (quick hack). */
#define FFECOM_targetFFE 1
#define FFECOM_targetGCC 2
#ifndef FFE_STANDALONE
#define FFECOM_targetCURRENT FFECOM_targetGCC /* Backend! */
#define FFECOM_ONEPASS 0
#else
#define FFECOM_targetCURRENT FFECOM_targetFFE
#define FFECOM_ONEPASS 0
#endif
#if FFECOM_ONEPASS
#define FFECOM_TWOPASS 0
#else
#define FFECOM_TWOPASS 1
#endif
#define FFECOM_SIZE_UNIT "byte" /* Singular form. */
#define FFECOM_SIZE_UNITS "bytes" /* Plural form. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define FFECOM_constantNULL NULL_TREE
#define FFECOM_nonterNULL NULL_TREE
#define FFECOM_globalNULL NULL_TREE
@ -139,31 +121,12 @@ typedef enum
FFECOM_gfrt
} ffecomGfrt;
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Typedefs. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#ifndef TREE_CODE
#include "tree.h"
#endif
#ifndef BUILT_FOR_270
#ifdef DECL_STATIC_CONSTRUCTOR /* In gcc/tree.h. */
#define BUILT_FOR_270 1
#else
#define BUILT_FOR_270 0
#endif
#endif /* !defined (BUILT_FOR_270) */
#ifndef BUILT_FOR_280
#ifdef DECL_ONE_ONLY /* In gcc/tree.h. */
#define BUILT_FOR_280 1
#else
#define BUILT_FOR_280 0
#endif
#endif /* !defined (BUILT_FOR_280) */
typedef tree ffecomConstant;
#define FFECOM_constantHOOK
typedef tree ffecomNonter;
@ -185,7 +148,6 @@ struct _ffecom_symbol_
tree assign_tree; /* For ASSIGN'ed vars. */
bool addr; /* Is address of item instead of item. */
};
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Include files needed by this one. */
@ -200,7 +162,6 @@ struct _ffecom_symbol_
/* Global objects accessed by users of this module. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
extern tree string_type_node;
extern tree ffecom_integer_type_node;
extern tree ffecom_integer_zero_node;
@ -227,11 +188,9 @@ extern tree ffecom_f2c_ftnlen_two_node;
extern tree ffecom_f2c_ptr_to_ftnlen_type_node;
extern tree ffecom_f2c_ftnint_type_node;
extern tree ffecom_f2c_ptr_to_ftnint_type_node;
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Declare functions with prototypes. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
tree ffecom_1 (enum tree_code code, tree type, tree node);
tree ffecom_1_fn (tree node);
tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2);
@ -251,16 +210,12 @@ tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
tree ffecom_const_expr (ffebld expr);
tree ffecom_decl_field (tree context, tree prevfield, const char *name,
tree type);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
void ffecom_close_include (FILE *f);
int ffecom_decode_include_option (char *spec);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
tree ffecom_end_compstmt (void);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
void ffecom_end_transition (void);
void ffecom_exec_transition (void);
void ffecom_expand_let_stmt (ffebld dest, ffebld source);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
tree ffecom_expr (ffebld expr);
tree ffecom_expr_assign (ffebld expr);
tree ffecom_expr_assign_w (ffebld expr);
@ -282,13 +237,11 @@ tree ffecom_make_tempvar (const char *commentary, tree type,
ffetargetCharacterSize size, int elements);
tree ffecom_modify (tree newtype, tree lhs, tree rhs);
void ffecom_save_tree_forever (tree t);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
void ffecom_file (const char *name);
void ffecom_notify_init_storage (ffestorag st);
void ffecom_notify_init_symbol (ffesymbol s);
void ffecom_notify_primary_entry (ffesymbol fn);
FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
void ffecom_prepare_arg_ptr_to_expr (ffebld expr);
bool ffecom_prepare_end (void);
void ffecom_prepare_expr_ (ffebld expr, ffebld dest);
@ -303,38 +256,22 @@ tree ffecom_save_tree (tree t);
void ffecom_start_compstmt (void);
tree ffecom_start_decl (tree decl, bool is_init);
void ffecom_sym_commit (ffesymbol s);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
ffesymbol ffecom_sym_end_transition (ffesymbol s);
ffesymbol ffecom_sym_exec_transition (ffesymbol s);
ffesymbol ffecom_sym_learned (ffesymbol s);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
void ffecom_sym_retract (ffesymbol s);
tree ffecom_temp_label (void);
tree ffecom_truth_value (tree expr);
tree ffecom_truth_value_invert (tree expr);
tree ffecom_type_expr (ffebld expr);
tree ffecom_which_entrypoint_decl (void);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* Define macros. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
#define ffecom_expr(e) (e)
#define ffecom_init_0()
#define ffecom_init_2()
#define ffecom_label_kind() FFEINFO_kindtypeINTEGERDEFAULT
#define ffecom_pointer_kind() FFEINFO_kindtypeINTEGERDEFAULT
#define ffecom_ptr_to_expr(e) (e)
#define ffecom_sym_commit(s)
#define ffecom_sym_retract(s)
#endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
#define ffecom_label_kind() ffecom_label_kind_
#define ffecom_pointer_kind() ffecom_pointer_kind_
#define ffecom_prepare_expr(e) ffecom_prepare_expr_ ((e), NULL)
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
#define ffecom_init_1()
#define ffecom_init_3()

15
gcc/f/equiv.c
View File

@ -913,21 +913,6 @@ ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t)
ffeequiv_set_list (eq, ffebld_new_item (list, ffeequiv_list (eq)));
}
/* ffeequiv_dump -- Dump info on equivalence object
ffeequiv eq;
ffeequiv_dump(eq); */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
ffeequiv_dump (ffeequiv eq)
{
if (ffeequiv_common (eq) != NULL)
fprintf (dmpout, "(common %s) ", ffesymbol_text (ffeequiv_common (eq)));
ffebld_dump (ffeequiv_list (eq));
}
#endif
/* ffeequiv_exec_transition -- Do the hard work on all the equivalence objects
ffeequiv_exec_transition(); */

3
gcc/f/equiv.h
View File

@ -62,9 +62,6 @@ struct _ffeequiv_
/* Declare functions with prototypes. */
void ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffeequiv_dump (ffeequiv eq);
#endif
void ffeequiv_exec_transition (void);
void ffeequiv_init_2 (void);
void ffeequiv_kill (ffeequiv victim);

8
gcc/f/global.h
View File

@ -153,13 +153,7 @@ void ffeglobal_terminate_1 (void);
/* Define macros. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
#define FFEGLOBAL_ENABLED 0
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#define FFEGLOBAL_ENABLED 1
#else
#error
#endif
#define ffeglobal_common_init(g) ((g)->tick != 0)
#define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad)
@ -198,4 +192,4 @@ void ffeglobal_terminate_1 (void);
/* End of #include file. */
#endif /* ! GCC_F_GLOBAL_H */

12
gcc/f/intdoc.c
View File

@ -96,9 +96,6 @@ struct _ffeintrin_spec_
struct _ffeintrin_imp_
{
const char *const name; /* Name of implementation. */
#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
const ffecomGfrt gfrt; /* gfrt index in library. */
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
const char *const control;
};
@ -136,19 +133,10 @@ static const struct _ffeintrin_imp_ imps[] = {
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
{ NAME, FFECOM_gfrt ## GFRT, CONTROL },
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
{ NAME, FFECOM_gfrt ## GFRT, CONTROL },
#elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
{ NAME, CONTROL },
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
{ NAME, CONTROL },
#else
#error
#endif
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN

19
gcc/f/intrin.c
View File

@ -58,11 +58,9 @@ struct _ffeintrin_spec_
struct _ffeintrin_imp_
{
const char *const name; /* Name of implementation. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
const ffecomGfrt gfrt_direct;/* library routine, direct-callable form. */
const ffecomGfrt gfrt_f2c; /* library routine, f2c-callable form. */
const ffecomGfrt gfrt_gnu; /* library routine, gnu-callable form. */
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
const char *const control;
const char y2kbad;
};
@ -117,21 +115,12 @@ static const struct _ffeintrin_imp_ ffeintrin_imps_[]
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
{ NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
FFECOM_gfrt ## GFRTGNU, CONTROL, FALSE },
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
{ NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
FFECOM_gfrt ## GFRTGNU, CONTROL, Y2KBAD },
#elif FFECOM_targetCURRENT == FFECOM_targetFFE
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
{ NAME, CONTROL, FALSE },
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
{ NAME, CONTROL, Y2KBAD },
#else
#error
#endif
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
@ -1195,7 +1184,7 @@ ffeintrin_basictype (ffeintrinSpec spec)
if (ffe_is_f2c ())
gfrt = ffeintrin_imps_[imp].gfrt_f2c;
else
else
gfrt = ffeintrin_imps_[imp].gfrt_gnu;
assert (gfrt != FFECOM_gfrt);
@ -1523,7 +1512,6 @@ ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
/* Return run-time index of intrinsic implementation as direct call. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffecomGfrt
ffeintrin_gfrt_direct (ffeintrinImp imp)
{
@ -1531,11 +1519,9 @@ ffeintrin_gfrt_direct (ffeintrinImp imp)
return ffeintrin_imps_[imp].gfrt_direct;
}
#endif
/* Return run-time index of intrinsic implementation as actual argument. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffecomGfrt
ffeintrin_gfrt_indirect (ffeintrinImp imp)
{
@ -1545,7 +1531,6 @@ ffeintrin_gfrt_indirect (ffeintrinImp imp)
return ffeintrin_imps_[imp].gfrt_gnu;
return ffeintrin_imps_[imp].gfrt_f2c;
}
#endif
void
ffeintrin_init_0 ()
@ -1758,13 +1743,11 @@ ffeintrin_is_actualarg (ffeintrinSpec spec)
state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
return (!ffe_is_pedantic () || ffeintrin_specs_[spec].is_actualarg)
#if FFECOM_targetCURRENT == FFECOM_targetGCC
&& (ffe_is_f2c ()
? (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_f2c
!= FFECOM_gfrt)
: (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_gnu
!= FFECOM_gfrt))
#endif
&& ((state == FFE_intrinsicstateENABLED)
|| (state == FFE_intrinsicstateHIDDEN));
}

2
gcc/f/intrin.h
View File

@ -105,10 +105,8 @@ ffeintrinFamily ffeintrin_family (ffeintrinSpec spec);
void ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t);
void ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
bool *check_intrin, ffelexToken t);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffecomGfrt ffeintrin_gfrt_direct (ffeintrinImp imp);
ffecomGfrt ffeintrin_gfrt_indirect (ffeintrinImp imp);
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
void ffeintrin_init_0 (void);
#define ffeintrin_init_1()
#define ffeintrin_init_2()

50
gcc/f/lex.c
View File

@ -27,13 +27,11 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#include "malloc.h"
#include "src.h"
#include "debug.h"
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#include "flags.h"
#include "input.h"
#include "toplev.h"
#include "output.h"
#include "ggc.h"
#endif
static void ffelex_append_to_token_ (char c);
static int ffelex_backslash_ (int c, ffewhereColumnNumber col);
@ -45,10 +43,8 @@ static void ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0,
static void ffelex_bad_here_ (int num, ffewhereLineNumber ln0,
ffewhereColumnNumber cn0);
static void ffelex_finish_statement_ (void);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static int ffelex_get_directive_line_ (char **text, FILE *finput);
static int ffelex_hash_ (FILE *f);
#endif
static ffewhereColumnNumber ffelex_image_char_ (int c,
ffewhereColumnNumber col);
static void ffelex_include_ (void);
@ -561,7 +557,6 @@ ffelex_bad_here_ (int n, ffewhereLineNumber ln0,
ffewhere_column_kill (wc0);
}
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static int
ffelex_getc_ (FILE *finput)
{
@ -578,8 +573,6 @@ ffelex_getc_ (FILE *finput)
return getc (finput);
}
#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static int
ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput)
{
@ -725,10 +718,8 @@ ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput)
return c;
}
#endif
/* A miniature version of the C front-end lexer. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static int
ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c)
{
@ -845,9 +836,7 @@ ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c)
*xtoken = token;
return c;
}
#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static void
ffelex_file_pop_ (const char *input_filename)
{
@ -868,8 +857,6 @@ ffelex_file_pop_ (const char *input_filename)
input_file_stack->name = input_filename;
}
#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static void
ffelex_file_push_ (int old_lineno, const char *input_filename)
{
@ -889,7 +876,6 @@ ffelex_file_push_ (int old_lineno, const char *input_filename)
if (input_file_stack)
input_file_stack->name = input_filename;
}
#endif
/* Prepare to finish a statement-in-progress by sending the current
token, if any, then setting up EOS as the current token with the
@ -980,7 +966,6 @@ ffelex_finish_statement_ ()
/* Copied from gcc/c-common.c get_directive_line. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static int
ffelex_get_directive_line_ (char **text, FILE *finput)
{
@ -1052,7 +1037,6 @@ ffelex_get_directive_line_ (char **text, FILE *finput)
char_escaped = (c == '\\' && ! char_escaped);
}
}
#endif
/* Handle # directives that make it through (or are generated by) the
preprocessor. As much as reasonably possible, emulate the behavior
@ -1063,8 +1047,6 @@ ffelex_get_directive_line_ (char **text, FILE *finput)
Returns the next character unhandled, which is always newline or EOF. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#if defined HANDLE_PRAGMA
/* Local versions of these macros, that can be passed as function pointers. */
static int
@ -1117,7 +1099,7 @@ ffelex_hash_ (FILE *finput)
ISSPACE() may evaluate its argument more than once! */
while (((c = getc (finput)), ISSPACE(c)))
continue;
do
{
* buff ++ = c;
@ -1127,7 +1109,7 @@ ffelex_hash_ (FILE *finput)
&& buff < buffer + 128);
pragma_ungetc (c);
* -- buff = 0;
#ifdef HANDLE_PRAGMA
if (HANDLE_PRAGMA (pragma_getc, pragma_ungetc, buffer))
@ -1414,7 +1396,6 @@ ffelex_hash_ (FILE *finput)
;
return c;
}
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* "Image" a character onto the card image, return incremented column number.
@ -1538,10 +1519,8 @@ ffelex_include_ ()
ffewhereLineNumber linecount_current = ffelex_linecount_current_;
ffewhereLineNumber linecount_offset
= ffewhere_line_filelinenum (current_wl);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
int old_lineno = lineno;
const char *old_input_filename = input_filename;
#endif
if (card_length != 0)
{
@ -1559,18 +1538,14 @@ ffelex_include_ ()
ffewhere_file_set (include_wherefile, TRUE, 0);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffelex_file_push_ (old_lineno, ffewhere_file_name (include_wherefile));
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
if (ffelex_include_free_form_)
ffelex_file_free (include_wherefile, include_file);
else
ffelex_file_fixed (include_wherefile, include_file);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffelex_file_pop_ (ffewhere_file_name (current_wf));
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
ffewhere_file_set (current_wf, TRUE, linecount_offset);
@ -1586,10 +1561,8 @@ ffelex_include_ ()
}
ffelex_card_image_[card_length] = '\0';
#if FFECOM_targetCURRENT == FFECOM_targetGCC
input_filename = old_input_filename;
lineno = old_lineno;
#endif
ffelex_linecount_current_ = linecount_current;
ffelex_current_wf_ = current_wf;
ffelex_final_nontab_column_ = final_nontab_column;
@ -1647,9 +1620,7 @@ ffelex_next_line_ ()
{
ffelex_linecount_current_ = ffelex_linecount_next_;
++ffelex_linecount_next_;
#if FFECOM_targetCURRENT == FFECOM_targetGCC
++lineno;
#endif
}
static void
@ -1865,10 +1836,8 @@ ffelex_file_fixed (ffewhereFile wf, FILE *f)
assert (ffelex_handler_ != NULL);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
lineno = 0;
input_filename = ffewhere_file_name (wf);
#endif
ffelex_current_wf_ = wf;
disallow_continuation_line = TRUE;
ignore_disallowed_continuation = FALSE;
@ -1957,10 +1926,8 @@ ffelex_file_fixed (ffewhereFile wf, FILE *f)
while ((c != '\n') && (c != EOF))
c = getc (f);
}
#if FFECOM_targetCURRENT == FFECOM_targetGCC
else if (lextype == FFELEX_typeHASH)
c = ffelex_hash_ (f);
#endif
else if (lextype == FFELEX_typeSLASH)
{
/* SIDE-EFFECT ABOVE HAS HAPPENED. */
@ -3077,10 +3044,8 @@ ffelex_file_free (ffewhereFile wf, FILE *f)
assert (ffelex_handler_ != NULL);
#if FFECOM_targetCURRENT == FFECOM_targetGCC
lineno = 0;
input_filename = ffewhere_file_name (wf);
#endif
ffelex_current_wf_ = wf;
continuation_line = FALSE;
ffelex_token_->type = FFELEX_typeNONE;
@ -3118,14 +3083,7 @@ ffelex_file_free (ffewhereFile wf, FILE *f)
|| (c == '#'))
{
if (c == '#')
{
#if FFECOM_targetCURRENT == FFECOM_targetGCC
c = ffelex_hash_ (f);
#else
/* Don't skip over # line after all. */
break;
#endif
}
c = ffelex_hash_ (f);
comment_line: /* :::::::::::::::::::: */
@ -3968,7 +3926,6 @@ ffelex_file_free (ffewhereFile wf, FILE *f)
/* See the code in com.c that calls this to understand why. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
void
ffelex_hash_kludge (FILE *finput)
{
@ -4005,7 +3962,6 @@ ffelex_hash_kludge (FILE *finput)
}
}
#endif
void
ffelex_init_1 ()
{

44
gcc/f/parse.c
View File

@ -24,72 +24,28 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#include "com.h"
#include "where.h"
#include "version.h"
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#include "flags.h"
#endif
#define NAME_OF_STDIN "<stdin>"
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
main (int argc, char *argv[])
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
extern FILE *finput;
int
yyparse ()
#else
#error
#endif
{
ffewhereFile wf;
if (ffe_is_version ())
fprintf (stderr, "GNU Fortran Front End version %s\n", ffe_version_string);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
ffe_init_0 ();
{
int strings_processed;
for (--argc, ++argv; argc > 0; argc -= strings_processed, argv += strings_processed)
{
strings_processed = ffe_decode_option (argc, argv);
if (strings_processed == 0)
{
fprintf (stderr, "Unrecognized option: %s\n", argv[0]);
strings_processed = 1;
}
}
}
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
if (!ffe_is_pedantic ())
ffe_set_is_pedantic (pedantic);
#else
#error
#endif
#if FFECOM_targetCURRENT == FFECOM_targetFFE
wf = ffewhere_file_new (NAME_OF_STDIN, strlen (NAME_OF_STDIN));
ffecom_file (NAME_OF_STDIN);
ffe_file (wf, stdin);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
wf = ffewhere_file_new (main_input_filename, strlen (main_input_filename));
ffecom_file (main_input_filename);
ffe_file (wf, finput);
#else
#error
#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffecom_finish_compile ();
return 0;
#elif FFECOM_targetCURRENT == FFECOM_targetFFE
ffe_terminate_0 ();
exit (0);
#else
#error
#endif
}

6
gcc/f/sta.c
View File

@ -1452,9 +1452,6 @@ ffesta_eof ()
if (ffe_is_ffedebug ())
{
ffestorag_report ();
#if FFECOM_targetCURRENT == FFECOM_targetFFE
ffesymbol_report_all ();
#endif
}
}
@ -1990,9 +1987,6 @@ ffesta_zero (ffelexToken t)
if (ffe_is_ffedebug ())
{
ffestorag_report ();
#if FFECOM_targetCURRENT == FFECOM_targetFFE
ffesymbol_report_all ();
#endif
}
ffelex_set_names (TRUE);

2411
gcc/f/std.c
View File

File diff suppressed because it is too large Load Diff

3300
gcc/f/ste.c
View File

File diff suppressed because it is too large Load Diff

6
gcc/f/ste.h
View File

@ -147,16 +147,10 @@ void ffeste_V026 (ffestpFindStmt *info);
#define ffeste_init_2()
#define ffeste_init_3()
#define ffeste_init_4()
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define ffeste_filename() input_filename
#define ffeste_filelinenum() lineno
#define ffeste_set_line(name,num) \
(input_filename = (name), lineno = (num))
#elif FFECOM_targetCURRENT == FFECOM_targetFFE
#define ffeste_set_line(name,num)
#else
#error
#endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */
#define ffeste_terminate_0()
#define ffeste_terminate_1()
#ifdef ENABLE_CHECKING

144
gcc/f/stt.c
View File

@ -114,35 +114,6 @@ ffestt_caselist_create ()
return new;
}
/* ffestt_caselist_dump -- Dump list of cases
ffesttCaseList list;
ffestt_caselist_dump(list);
The cases in the list are dumped with commas separating them. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
ffestt_caselist_dump (ffesttCaseList list)
{
ffesttCaseList next;
for (next = list->next; next != list; next = next->next)
{
if (next != list->next)
fputc (',', dmpout);
if (next->expr1 != NULL)
ffebld_dump (next->expr1);
if (next->range)
{
fputc (':', dmpout);
if (next->expr2 != NULL)
ffebld_dump (next->expr2);
}
}
}
#endif
/* ffestt_caselist_kill -- Kill list of cases
ffesttCaseList list;
@ -438,32 +409,6 @@ ffestt_dimlist_create ()
return new;
}
/* ffestt_dimlist_dump -- Dump list of dims
ffesttDimList list;
ffestt_dimlist_dump(list);
The dims in the list are dumped with commas separating them. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
ffestt_dimlist_dump (ffesttDimList list)
{
ffesttDimList next;
for (next = list->next; next != list; next = next->next)
{
if (next != list->next)
fputc (',', dmpout);
if (next->lower != NULL)
ffebld_dump (next->lower);
fputc (':', dmpout);
if (next->upper != NULL)
ffebld_dump (next->upper);
}
}
#endif
/* ffestt_dimlist_kill -- Kill list of dims
ffesttDimList list;
@ -611,28 +556,6 @@ ffestt_exprlist_drive (ffesttExprList list, void (*fn) (ffebld, ffelexToken))
}
}
/* ffestt_exprlist_dump -- Dump list of exprs
ffesttExprList list;
ffestt_exprlist_dump(list);
The exprs in the list are dumped with commas separating them. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
ffestt_exprlist_dump (ffesttExprList list)
{
ffesttExprList next;
for (next = list->next; next != list; next = next->next)
{
if (next != list->next)
fputc (',', dmpout);
ffebld_dump (next->expr);
}
}
#endif
/* ffestt_exprlist_kill -- Kill list of exprs
ffesttExprList list;
@ -850,35 +773,6 @@ ffestt_implist_drive (ffesttImpList list, void (*fn) (ffelexToken, ffelexToken))
}
}
/* ffestt_implist_dump -- Dump list of token pairs
ffesttImpList list;
ffestt_implist_dump(list);
The token pairs in the list are dumped with commas separating them. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
ffestt_implist_dump (ffesttImpList list)
{
ffesttImpList next;
for (next = list->next; next != list; next = next->next)
{
if (next != list->next)
fputc (',', dmpout);
assert (ffelex_token_type (next->first) == FFELEX_typeNAME);
fputs (ffelex_token_text (next->first), dmpout);
if (next->last != NULL)
{
fputc ('-', dmpout);
assert (ffelex_token_type (next->last) == FFELEX_typeNAME);
fputs (ffelex_token_text (next->last), dmpout);
}
}
}
#endif
/* ffestt_implist_kill -- Kill list of token pairs
ffesttImpList list;
@ -964,44 +858,6 @@ ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) (ffelexToken))
}
}
/* ffestt_tokenlist_dump -- Dump list of tokens
ffesttTokenList tl;
ffestt_tokenlist_dump(tl);
The tokens in the list are dumped with commas separating them. */
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void
ffestt_tokenlist_dump (ffesttTokenList tl)
{
ffesttTokenItem ti;
for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
{
if (ti != tl->first)
fputc (',', dmpout);
switch (ffelex_token_type (ti->t))
{
case FFELEX_typeNUMBER:
case FFELEX_typeNAME:
case FFELEX_typeNAMES:
fputs (ffelex_token_text (ti->t), dmpout);
break;
case FFELEX_typeASTERISK:
fputc ('*', dmpout);
break;
default:
assert (FALSE);
fputc ('?', dmpout);
break;
}
}
}
#endif
/* ffestt_tokenlist_handle -- Handle list of tokens
ffesttTokenList tl;

18
gcc/f/stt.h
View File

@ -164,9 +164,6 @@ struct _ffest_format_list_
void ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
ffebld case2, ffelexToken t);
ffesttCaseList ffestt_caselist_create (void);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffestt_caselist_dump (ffesttCaseList list);
#endif
void ffestt_caselist_kill (ffesttCaseList list);
void ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
ffelexToken t);
@ -174,39 +171,24 @@ ffebld ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
ffebld *array_size, ffebld *extents,
bool is_ugly_assumed);
ffesttDimList ffestt_dimlist_create (void);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffestt_dimlist_dump (ffesttDimList list);
#endif
void ffestt_dimlist_kill (ffesttDimList list);
ffestpDimtype ffestt_dimlist_type (ffesttDimList dims, bool is_ugly_assumed);
void ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t);
ffesttExprList ffestt_exprlist_create (void);
void ffestt_exprlist_drive (ffesttExprList list, void (*fn) (ffebld, ffelexToken));
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffestt_exprlist_dump (ffesttExprList list);
#endif
void ffestt_exprlist_kill (ffesttExprList list);
ffesttFormatList ffestt_formatlist_append (ffesttFormatList list);
ffesttFormatList ffestt_formatlist_create (ffesttFormatList parent,
ffelexToken t);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffestt_formatlist_dump (ffesttFormatList list);
#endif
void ffestt_formatlist_kill (ffesttFormatList list);
void ffestt_implist_append (ffesttImpList list, ffelexToken first,
ffelexToken last);
ffesttImpList ffestt_implist_create (void);
void ffestt_implist_drive (ffesttImpList list, void (*fn) (ffelexToken, ffelexToken));
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffestt_implist_dump (ffesttImpList list);
#endif
void ffestt_implist_kill (ffesttImpList list);
void ffestt_tokenlist_append (ffesttTokenList list, ffelexToken t);
ffesttTokenList ffestt_tokenlist_create (void);
void ffestt_tokenlist_drive (ffesttTokenList list, void (*fn) (ffelexToken));
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffestt_tokenlist_dump (ffesttTokenList list);
#endif
ffelexHandler ffestt_tokenlist_handle (ffesttTokenList list,
ffelexHandler handler);
void ffestt_tokenlist_kill (ffesttTokenList list);

2
gcc/f/stw.h
View File

@ -73,7 +73,6 @@ struct _ffestw_
int uses_; /* # uses (new+use-kill calls). */
ffestvState state_;
int substate_; /* Used on a per-block-state basis. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
struct nesting *do_hook_; /* backend id for given loop (EXIT/CYCLE). */
tree do_tvar_; /* tree form of do_iter_var. */
tree do_incr_saved_; /* tree SAVED_EXPR of incr expr. */
@ -82,7 +81,6 @@ struct _ffestw_
bool select_break_; /* TRUE when CASE should start with gen
"break;". */
int ifthen_fake_else_; /* Number of fake `else' introductions. */
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC*/
};
struct _ffestw_case_

223
gcc/f/symbol.c
View File

@ -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. */
@ -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

7
gcc/f/symbol.h
View File

@ -182,9 +182,6 @@ ffesymbol ffesymbol_declare_subrunit (ffelexToken t);
void ffesymbol_drive (ffesymbol (*fn) (ffesymbol));
void ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol));
#define ffesymbol_dummyargs(s) ((s)->dummy_args)
#if FFECOM_targetCURRENT == FFECOM_targetFFE
void ffesymbol_dump (ffesymbol s);
#endif
void ffesymbol_error (ffesymbol s, ffelexToken t);
#define ffesymbol_equiv(s) ((s)->equiv)
#define ffesymbol_explicitwhere(s) ((s)->explicit_where)
@ -223,10 +220,6 @@ ffesymbol ffesymbol_lookup_local (ffelexToken t);
#define ffesymbol_ptr_to_namelist(s) (&(s)->namelist)
#define ffesymbol_rank(s) ffeinfo_rank((s)->info)
void ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit);
#if FFECOM_targetCURRENT == FFECOM_targetFFE
ffesymbol ffesymbol_report (ffesymbol s);
void ffesymbol_report_all (void);
#endif
void ffesymbol_resolve_intrin (ffesymbol s);
void ffesymbol_retract (bool retract);
bool ffesymbol_retractable (void);

10
gcc/f/target.h
View File

@ -860,13 +860,9 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
/* Define macros. */
#if BUILT_FOR_280
#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), ((kt == 1) ? SFmode : DFmode))
#else
#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0))
#endif
#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), \
((kt == 1) ? SFmode : DFmode))
#ifdef REAL_ARITHMETIC
#define ffetarget_add_complex1(res,l,r) \

2
gcc/f/top.c
View File

@ -53,10 +53,8 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#include "symbol.h"
#include "target.h"
#include "where.h"
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#include "flags.h"
#include "toplev.h"
#endif
/* Externals defined here. */