diff options
| -rw-r--r-- | gcc/f/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/f/bad.c | 77 | ||||
| -rw-r--r-- | gcc/f/bld.c | 1271 | ||||
| -rw-r--r-- | gcc/f/bld.h | 19 | ||||
| -rw-r--r-- | gcc/f/com.c | 419 | ||||
| -rw-r--r-- | gcc/f/com.h | 63 | ||||
| -rw-r--r-- | gcc/f/equiv.c | 15 | ||||
| -rw-r--r-- | gcc/f/equiv.h | 3 | ||||
| -rw-r--r-- | gcc/f/global.h | 8 | ||||
| -rw-r--r-- | gcc/f/intdoc.c | 12 | ||||
| -rw-r--r-- | gcc/f/intrin.c | 19 | ||||
| -rw-r--r-- | gcc/f/intrin.h | 2 | ||||
| -rw-r--r-- | gcc/f/lex.c | 50 | ||||
| -rw-r--r-- | gcc/f/parse.c | 44 | ||||
| -rw-r--r-- | gcc/f/sta.c | 6 | ||||
| -rw-r--r-- | gcc/f/std.c | 2421 | ||||
| -rw-r--r-- | gcc/f/ste.c | 3248 | ||||
| -rw-r--r-- | gcc/f/ste.h | 6 | ||||
| -rw-r--r-- | gcc/f/stt.c | 144 | ||||
| -rw-r--r-- | gcc/f/stt.h | 18 | ||||
| -rw-r--r-- | gcc/f/stw.h | 2 | ||||
| -rw-r--r-- | gcc/f/symbol.c | 223 | ||||
| -rw-r--r-- | gcc/f/symbol.h | 7 | ||||
| -rw-r--r-- | gcc/f/target.h | 10 | ||||
| -rw-r--r-- | gcc/f/top.c | 2 |
25 files changed, 1552 insertions, 6546 deletions
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog index f1234e3..b064088 100644 --- a/gcc/f/ChangeLog +++ b/gcc/f/ChangeLog @@ -1,5 +1,14 @@ 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. * com.c: Include it. (LANG_HOOKS_INIT, LANG_HOOKS_FINISH): New. diff --git a/gcc/f/bad.c b/gcc/f/bad.c index aa0ae6a..67eade0 100644 --- a/gcc/f/bad.c +++ b/gcc/f/bad.c @@ -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], diff --git a/gcc/f/bld.c b/gcc/f/bld.c index 6d2247f..41a79d6 100644 --- a/gcc/f/bld.c +++ b/gcc/f/bld.c @@ -438,433 +438,6 @@ ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2) } } -/* ffebld_constant_dump -- Display summary of constant's contents - - ffebldConstant c; - ffebld_constant_dump(c); - - Displays the constant in summary form. */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -void -ffebld_constant_dump (ffebldConstant c) -{ - switch (ffebld_constant_type (c)) - { -#if FFETARGET_okINTEGER1 - case FFEBLD_constINTEGER1: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER1); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1); - break; -#endif - -#if FFETARGET_okINTEGER2 - case FFEBLD_constINTEGER2: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER2); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2); - break; -#endif - -#if FFETARGET_okINTEGER3 - case FFEBLD_constINTEGER3: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER3); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3); - break; -#endif - -#if FFETARGET_okINTEGER4 - case FFEBLD_constINTEGER4: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER4); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4); - break; -#endif - -#if FFETARGET_okINTEGER5 - case FFEBLD_constINTEGER5: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER5); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER5); - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEBLD_constINTEGER6: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER6); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER6); - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEBLD_constINTEGER7: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER7); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER7); - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEBLD_constINTEGER8: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER8); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER8); - break; -#endif - -#if FFETARGET_okLOGICAL1 - case FFEBLD_constLOGICAL1: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL1); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1); - break; -#endif - -#if FFETARGET_okLOGICAL2 - case FFEBLD_constLOGICAL2: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL2); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2); - break; -#endif - -#if FFETARGET_okLOGICAL3 - case FFEBLD_constLOGICAL3: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL3); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3); - break; -#endif - -#if FFETARGET_okLOGICAL4 - case FFEBLD_constLOGICAL4: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL4); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4); - break; -#endif - -#if FFETARGET_okLOGICAL5 - case FFEBLD_constLOGICAL5: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL5); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL5); - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEBLD_constLOGICAL6: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL6); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL6); - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEBLD_constLOGICAL7: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL7); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL7); - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEBLD_constLOGICAL8: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL, - FFEINFO_kindtypeLOGICAL8); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL8); - break; -#endif - -#if FFETARGET_okREAL1 - case FFEBLD_constREAL1: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL1); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1); - break; -#endif - -#if FFETARGET_okREAL2 - case FFEBLD_constREAL2: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL2); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL2); - break; -#endif - -#if FFETARGET_okREAL3 - case FFEBLD_constREAL3: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL3); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL3); - break; -#endif - -#if FFETARGET_okREAL4 - case FFEBLD_constREAL4: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL4); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL4); - break; -#endif - -#if FFETARGET_okREAL5 - case FFEBLD_constREAL5: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL5); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL5); - break; -#endif - -#if FFETARGET_okREAL6 - case FFEBLD_constREAL6: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL6); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL6); - break; -#endif - -#if FFETARGET_okREAL7 - case FFEBLD_constREAL7: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL7); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL7); - break; -#endif - -#if FFETARGET_okREAL8 - case FFEBLD_constREAL8: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL, - FFEINFO_kindtypeREAL8); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL8); - break; -#endif - -#if FFETARGET_okCOMPLEX1 - case FFEBLD_constCOMPLEX1: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL1); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1); - break; -#endif - -#if FFETARGET_okCOMPLEX2 - case FFEBLD_constCOMPLEX2: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL2); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL2); - break; -#endif - -#if FFETARGET_okCOMPLEX3 - case FFEBLD_constCOMPLEX3: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL3); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL3); - break; -#endif - -#if FFETARGET_okCOMPLEX4 - case FFEBLD_constCOMPLEX4: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL4); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL4); - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEBLD_constCOMPLEX5: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL5); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL5); - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEBLD_constCOMPLEX6: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL6); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL6); - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEBLD_constCOMPLEX7: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL7); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL7); - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEBLD_constCOMPLEX8: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX, - FFEINFO_kindtypeREAL8); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL8); - break; -#endif - -#if FFETARGET_okCHARACTER1 - case FFEBLD_constCHARACTER1: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER1); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER1); - break; -#endif - -#if FFETARGET_okCHARACTER2 - case FFEBLD_constCHARACTER2: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER2); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER2); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEBLD_constCHARACTER3: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER3); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER3); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEBLD_constCHARACTER4: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER4); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER4); - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEBLD_constCHARACTER5: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER5); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER5); - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEBLD_constCHARACTER6: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER6); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER6); - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEBLD_constCHARACTER7: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER7); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER7); - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEBLD_constCHARACTER8: - ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTER8); - ffebld_constantunion_dump (ffebld_constant_union (c), - FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER8); - break; -#endif - - case FFEBLD_constHOLLERITH: - fprintf (dmpout, "H%" ffetargetHollerithSize_f "u/", - ffebld_constant_hollerith (c).length); - ffetarget_print_hollerith (dmpout, ffebld_constant_hollerith (c)); - break; - - case FFEBLD_constBINARY_MIL: - fprintf (dmpout, "BM/"); - ffetarget_print_binarymil (dmpout, ffebld_constant_typeless (c)); - break; - - case FFEBLD_constBINARY_VXT: - fprintf (dmpout, "BV/"); - ffetarget_print_binaryvxt (dmpout, ffebld_constant_typeless (c)); - break; - - case FFEBLD_constOCTAL_MIL: - fprintf (dmpout, "OM/"); - ffetarget_print_octalmil (dmpout, ffebld_constant_typeless (c)); - break; - - case FFEBLD_constOCTAL_VXT: - fprintf (dmpout, "OV/"); - ffetarget_print_octalvxt (dmpout, ffebld_constant_typeless (c)); - break; - - case FFEBLD_constHEX_X_MIL: - fprintf (dmpout, "XM/"); - ffetarget_print_hexxmil (dmpout, ffebld_constant_typeless (c)); - break; - - case FFEBLD_constHEX_X_VXT: - fprintf (dmpout, "XV/"); - ffetarget_print_hexxvxt (dmpout, ffebld_constant_typeless (c)); - break; - - case FFEBLD_constHEX_Z_MIL: - fprintf (dmpout, "ZM/"); - ffetarget_print_hexzmil (dmpout, ffebld_constant_typeless (c)); - break; - - case FFEBLD_constHEX_Z_VXT: - fprintf (dmpout, "ZV/"); - ffetarget_print_hexzvxt (dmpout, ffebld_constant_typeless (c)); - break; - - default: - assert ("bad constant type" == NULL); - fprintf (dmpout, "?/?"); - break; - } -} -#endif - /* ffebld_constant_is_magical -- Determine if integer is "magical" ffebldConstant c; @@ -1991,76 +1564,6 @@ ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val) return nc; } -/* ffebld_constantarray_dump -- Display summary of array's contents - - ffebldConstantArray a; - ffeinfoBasictype bt; - ffeinfoKindtype kt; - ffetargetOffset size; - ffebld_constant_dump(a,bt,kt,size,NULL); - - Displays the constant array in summary form. The fifth argument, if - supplied, is an ffebit object that is consulted as to whether the - constant at a particular offset is valid. */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -void -ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt, - ffeinfoKindtype kt, ffetargetOffset size, ffebit bits) -{ - ffetargetOffset i; - ffebitCount j; - - ffebld_dump_prefix (dmpout, bt, kt); - - fprintf (dmpout, "\\("); - - if (bits == NULL) - { - for (i = 0; i < size; ++i) - { - ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt, i), bt, - kt); - if (i != size - 1) - fputc (',', dmpout); - } - } - else - { - bool value; - ffebitCount length; - ffetargetOffset offset = 0; - - do - { - ffebit_test (bits, offset, &value, &length); - if (value && (length != 0)) - { - if (length == 1) - fprintf (dmpout, "[%" ffetargetOffset_f "d]:", offset); - else - fprintf (dmpout, - "[%" ffetargetOffset_f "u..%" ffetargetOffset_f "d]:", - offset, offset + (ffetargetOffset) length - 1); - for (j = 0; j < length; ++j, ++offset) - { - ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt, - offset), bt, kt); - if (j != length - 1) - fputc (',', dmpout); - } - fprintf (dmpout, ";"); - } - else - offset += length; - } - while (length != 0); - } - fprintf (dmpout, "\\)"); - -} -#endif - /* ffebld_constantarray_get -- Get a value from an array of constants See prototype. */ @@ -4408,780 +3911,6 @@ ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt, } } -/* ffebld_constantunion_dump -- Dump a constant - - See prototype. */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -void -ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt, - ffeinfoKindtype kt) -{ - switch (bt) - { - case FFEINFO_basictypeINTEGER: - switch (kt) - { -#if FFETARGET_okINTEGER1 - case FFEINFO_kindtypeINTEGER1: - ffetarget_print_integer1 (dmpout, u.integer1); - break; -#endif - -#if FFETARGET_okINTEGER2 - case FFEINFO_kindtypeINTEGER2: - ffetarget_print_integer2 (dmpout, u.integer2); - break; -#endif - -#if FFETARGET_okINTEGER3 - case FFEINFO_kindtypeINTEGER3: - ffetarget_print_integer3 (dmpout, u.integer3); - break; -#endif - -#if FFETARGET_okINTEGER4 - case FFEINFO_kindtypeINTEGER4: - ffetarget_print_integer4 (dmpout, u.integer4); - break; -#endif - -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - ffetarget_print_integer5 (dmpout, u.integer5); - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - ffetarget_print_integer6 (dmpout, u.integer6); - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - ffetarget_print_integer7 (dmpout, u.integer7); - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - ffetarget_print_integer8 (dmpout, u.integer8); - break; -#endif - - default: - assert ("bad INTEGER kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeLOGICAL: - switch (kt) - { -#if FFETARGET_okLOGICAL1 - case FFEINFO_kindtypeLOGICAL1: - ffetarget_print_logical1 (dmpout, u.logical1); - break; -#endif - -#if FFETARGET_okLOGICAL2 - case FFEINFO_kindtypeLOGICAL2: - ffetarget_print_logical2 (dmpout, u.logical2); - break; -#endif - -#if FFETARGET_okLOGICAL3 - case FFEINFO_kindtypeLOGICAL3: - ffetarget_print_logical3 (dmpout, u.logical3); - break; -#endif - -#if FFETARGET_okLOGICAL4 - case FFEINFO_kindtypeLOGICAL4: - ffetarget_print_logical4 (dmpout, u.logical4); - break; -#endif - -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - ffetarget_print_logical5 (dmpout, u.logical5); - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - ffetarget_print_logical6 (dmpout, u.logical6); - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - ffetarget_print_logical7 (dmpout, u.logical7); - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - ffetarget_print_logical8 (dmpout, u.logical8); - break; -#endif - - default: - assert ("bad LOGICAL kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeREAL: - switch (kt) - { -#if FFETARGET_okREAL1 - case FFEINFO_kindtypeREAL1: - ffetarget_print_real1 (dmpout, u.real1); - break; -#endif - -#if FFETARGET_okREAL2 - case FFEINFO_kindtypeREAL2: - ffetarget_print_real2 (dmpout, u.real2); - break; -#endif - -#if FFETARGET_okREAL3 - case FFEINFO_kindtypeREAL3: - ffetarget_print_real3 (dmpout, u.real3); - break; -#endif - -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - ffetarget_print_real4 (dmpout, u.real4); - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - ffetarget_print_real5 (dmpout, u.real5); - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - ffetarget_print_real6 (dmpout, u.real6); - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - ffetarget_print_real7 (dmpout, u.real7); - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - ffetarget_print_real8 (dmpout, u.real8); - break; -#endif - - default: - assert ("bad REAL kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeCOMPLEX: - switch (kt) - { -#if FFETARGET_okCOMPLEX1 - case FFEINFO_kindtypeREAL1: - fprintf (dmpout, "("); - ffetarget_print_real1 (dmpout, u.complex1.real); - fprintf (dmpout, ","); - ffetarget_print_real1 (dmpout, u.complex1.imaginary); - fprintf (dmpout, ")"); - break; -#endif - -#if FFETARGET_okCOMPLEX2 - case FFEINFO_kindtypeREAL2: - fprintf (dmpout, "("); - ffetarget_print_real2 (dmpout, u.complex2.real); - fprintf (dmpout, ","); - ffetarget_print_real2 (dmpout, u.complex2.imaginary); - fprintf (dmpout, ")"); - break; -#endif - -#if FFETARGET_okCOMPLEX3 - case FFEINFO_kindtypeREAL3: - fprintf (dmpout, "("); - ffetarget_print_real3 (dmpout, u.complex3.real); - fprintf (dmpout, ","); - ffetarget_print_real3 (dmpout, u.complex3.imaginary); - fprintf (dmpout, ")"); - break; -#endif - -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - fprintf (dmpout, "("); - ffetarget_print_real4 (dmpout, u.complex4.real); - fprintf (dmpout, ","); - ffetarget_print_real4 (dmpout, u.complex4.imaginary); - fprintf (dmpout, ")"); - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - fprintf (dmpout, "("); - ffetarget_print_real5 (dmpout, u.complex5.real); - fprintf (dmpout, ","); - ffetarget_print_real5 (dmpout, u.complex5.imaginary); - fprintf (dmpout, ")"); - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - fprintf (dmpout, "("); - ffetarget_print_real6 (dmpout, u.complex6.real); - fprintf (dmpout, ","); - ffetarget_print_real6 (dmpout, u.complex6.imaginary); - fprintf (dmpout, ")"); - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - fprintf (dmpout, "("); - ffetarget_print_real7 (dmpout, u.complex7.real); - fprintf (dmpout, ","); - ffetarget_print_real7 (dmpout, u.complex7.imaginary); - fprintf (dmpout, ")"); - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - fprintf (dmpout, "("); - ffetarget_print_real8 (dmpout, u.complex8.real); - fprintf (dmpout, ","); - ffetarget_print_real8 (dmpout, u.complex8.imaginary); - fprintf (dmpout, ")"); - break; -#endif - - default: - assert ("bad COMPLEX kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeCHARACTER: - switch (kt) - { -#if FFETARGET_okCHARACTER1 - case FFEINFO_kindtypeCHARACTER1: - ffetarget_print_character1 (dmpout, u.character1); - break; -#endif - -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - ffetarget_print_character2 (dmpout, u.character2); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - ffetarget_print_character3 (dmpout, u.character3); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - ffetarget_print_character4 (dmpout, u.character4); - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - ffetarget_print_character5 (dmpout, u.character5); - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - ffetarget_print_character6 (dmpout, u.character6); - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - ffetarget_print_character7 (dmpout, u.character7); - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - ffetarget_print_character8 (dmpout, u.character8); - break; -#endif - - default: - assert ("bad CHARACTER kindtype" == NULL); - break; - } - break; - - default: - assert ("bad basictype" == NULL); - break; - } -} -#endif - -/* ffebld_dump -- Dump expression tree in concise form - - ffebld b; - ffebld_dump(b); */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -void -ffebld_dump (ffebld b) -{ - ffeinfoKind k; - ffeinfoWhere w; - - if (b == NULL) - { - fprintf (dmpout, "(null)"); - return; - } - - switch (ffebld_op (b)) - { - case FFEBLD_opITEM: - fputs ("[", dmpout); - while (b != NULL) - { - ffebld_dump (ffebld_head (b)); - if ((b = ffebld_trail (b)) != NULL) - fputs (",", dmpout); - } - fputs ("]", dmpout); - return; - - case FFEBLD_opSTAR: - case FFEBLD_opBOUNDS: - case FFEBLD_opREPEAT: - case FFEBLD_opLABTER: - case FFEBLD_opLABTOK: - case FFEBLD_opIMPDO: - fputs (ffebld_op_string (ffebld_op (b)), dmpout); - break; - - default: - if (ffeinfo_size (ffebld_info (b)) != FFETARGET_charactersizeNONE) - fprintf (dmpout, "%s%d%s%s*%" ffetargetCharacterSize_f "u", - ffebld_op_string (ffebld_op (b)), - (int) ffeinfo_rank (ffebld_info (b)), - ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))), - ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))), - ffeinfo_size (ffebld_info (b))); - else - fprintf (dmpout, "%s%d%s%s", ffebld_op_string (ffebld_op (b)), - (int) ffeinfo_rank (ffebld_info (b)), - ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))), - ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b)))); - if ((k = ffeinfo_kind (ffebld_info (b))) != FFEINFO_kindNONE) - fprintf (dmpout, "/%s", ffeinfo_kind_string (k)); - if ((w = ffeinfo_where (ffebld_info (b))) != FFEINFO_whereNONE) - fprintf (dmpout, "@%s", ffeinfo_where_string (w)); - break; - } - - switch (ffebld_arity (b)) - { - case 2: - fputs ("(", dmpout); - ffebld_dump (ffebld_left (b)); - fputs (",", dmpout); - ffebld_dump (ffebld_right (b)); - fputs (")", dmpout); - break; - - case 1: - fputs ("(", dmpout); - ffebld_dump (ffebld_left (b)); - fputs (")", dmpout); - break; - - default: - switch (ffebld_op (b)) - { - case FFEBLD_opCONTER: - fprintf (dmpout, "<"); - ffebld_constant_dump (b->u.conter.expr); - fprintf (dmpout, ">"); - break; - - case FFEBLD_opACCTER: - fprintf (dmpout, "<"); - ffebld_constantarray_dump (b->u.accter.array, - ffeinfo_basictype (ffebld_info (b)), - ffeinfo_kindtype (ffebld_info (b)), - ffebit_size (b->u.accter.bits), b->u.accter.bits); - fprintf (dmpout, ">"); - break; - - case FFEBLD_opARRTER: - fprintf (dmpout, "<"); - ffebld_constantarray_dump (b->u.arrter.array, - ffeinfo_basictype (ffebld_info (b)), - ffeinfo_kindtype (ffebld_info (b)), - b->u.arrter.size, NULL); - fprintf (dmpout, ">"); - break; - - case FFEBLD_opLABTER: - if (b->u.labter == NULL) - fprintf (dmpout, "<>"); - else - fprintf (dmpout, "<%" ffelabValue_f "u>", ffelab_value (b->u.labter)); - break; - - case FFEBLD_opLABTOK: - fprintf (dmpout, "<%s>", ffelex_token_text (b->u.labtok)); - break; - - case FFEBLD_opSYMTER: - fprintf (dmpout, "<"); - ffesymbol_dump (b->u.symter.symbol); - if ((b->u.symter.generic != FFEINTRIN_genNONE) - || (b->u.symter.specific != FFEINTRIN_specNONE)) - fprintf (dmpout, "{%s:%s:%s}", - ffeintrin_name_generic (b->u.symter.generic), - ffeintrin_name_specific (b->u.symter.specific), - ffeintrin_name_implementation (b->u.symter.implementation)); - if (b->u.symter.do_iter) - fprintf (dmpout, "{/do-iter}"); - fprintf (dmpout, ">"); - break; - - default: - break; - } - } -} -#endif - -/* ffebld_dump_prefix -- Dump the prefix for a constant of a given type - - ffebld_dump_prefix(dmpout,FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGER1); */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -void -ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt) -{ - switch (bt) - { - case FFEINFO_basictypeINTEGER: - switch (kt) - { -#if FFETARGET_okINTEGER1 - case FFEINFO_kindtypeINTEGER1: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER1) "/"); - break; -#endif - -#if FFETARGET_okINTEGER2 - case FFEINFO_kindtypeINTEGER2: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER2) "/"); - break; -#endif - -#if FFETARGET_okINTEGER3 - case FFEINFO_kindtypeINTEGER3: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER3) "/"); - break; -#endif - -#if FFETARGET_okINTEGER4 - case FFEINFO_kindtypeINTEGER4: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER4) "/"); - break; -#endif - -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER5) "/"); - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER6) "/"); - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER7) "/"); - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - fprintf (out, "I" STRX (FFETARGET_kindINTEGER8) "/"); - break; -#endif - - default: - assert ("bad INTEGER kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeLOGICAL: - switch (kt) - { -#if FFETARGET_okLOGICAL1 - case FFEINFO_kindtypeLOGICAL1: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL1) "/"); - break; -#endif - -#if FFETARGET_okLOGICAL2 - case FFEINFO_kindtypeLOGICAL2: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL2) "/"); - break; -#endif - -#if FFETARGET_okLOGICAL3 - case FFEINFO_kindtypeLOGICAL3: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL3) "/"); - break; -#endif - -#if FFETARGET_okLOGICAL4 - case FFEINFO_kindtypeLOGICAL4: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL4) "/"); - break; -#endif - -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL5) "/"); - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL6) "/"); - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL7) "/"); - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - fprintf (out, "L" STRX (FFETARGET_kindLOGICAL8) "/"); - break; -#endif - - default: - assert ("bad LOGICAL kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeREAL: - switch (kt) - { -#if FFETARGET_okREAL1 - case FFEINFO_kindtypeREAL1: - fprintf (out, "R" STRX (FFETARGET_kindREAL1) "/"); - break; -#endif - -#if FFETARGET_okREAL2 - case FFEINFO_kindtypeREAL2: - fprintf (out, "R" STRX (FFETARGET_kindREAL2) "/"); - break; -#endif - -#if FFETARGET_okREAL3 - case FFEINFO_kindtypeREAL3: - fprintf (out, "R" STRX (FFETARGET_kindREAL3) "/"); - break; -#endif - -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - fprintf (out, "R" STRX (FFETARGET_kindREAL4) "/"); - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - fprintf (out, "R" STRX (FFETARGET_kindREAL5) "/"); - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - fprintf (out, "R" STRX (FFETARGET_kindREAL6) "/"); - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - fprintf (out, "R" STRX (FFETARGET_kindREAL7) "/"); - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - fprintf (out, "R" STRX (FFETARGET_kindREAL8) "/"); - break; -#endif - - default: - assert ("bad REAL kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeCOMPLEX: - switch (kt) - { -#if FFETARGET_okCOMPLEX1 - case FFEINFO_kindtypeREAL1: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX1) "/"); - break; -#endif - -#if FFETARGET_okCOMPLEX2 - case FFEINFO_kindtypeREAL2: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX2) "/"); - break; -#endif - -#if FFETARGET_okCOMPLEX3 - case FFEINFO_kindtypeREAL3: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX3) "/"); - break; -#endif - -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX4) "/"); - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX5) "/"); - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX6) "/"); - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX7) "/"); - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX8) "/"); - break; -#endif - - default: - assert ("bad COMPLEX kindtype" == NULL); - break; - } - break; - - case FFEINFO_basictypeCHARACTER: - switch (kt) - { -#if FFETARGET_okCHARACTER1 - case FFEINFO_kindtypeCHARACTER1: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER1) "/"); - break; -#endif - -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER2) "/"); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER3) "/"); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER4) "/"); - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER5) "/"); - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER6) "/"); - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER7) "/"); - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - fprintf (out, "A" STRX (FFETARGET_kindCHARACTER8) "/"); - break; -#endif - - default: - assert ("bad CHARACTER kindtype" == NULL); - break; - } - break; - - default: - assert ("bad basictype" == NULL); - fprintf (out, "?/?"); - break; - } -} -#endif - /* ffebld_init_0 -- Initialize the module ffebld_init_0(); */ diff --git a/gcc/f/bld.h b/gcc/f/bld.h index bee0480..5f8bede 100644 --- a/gcc/f/bld.h +++ b/gcc/f/bld.h @@ -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); diff --git a/gcc/f/com.c b/gcc/f/com.c index 16050f6..821a637 100644 --- a/gcc/f/com.c +++ b/gcc/f/com.c @@ -81,7 +81,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* Include files. */ #include "proj.h" -#if FFECOM_targetCURRENT == FFECOM_targetGCC #include "flags.h" #include "rtl.h" #include "toplev.h" @@ -91,9 +90,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "ggc.h" #include "diagnostic.h" #include "langhooks.h" -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ - -#define FFECOM_GCC_INCLUDE 1 /* Enable -I. */ /* VMS-specific definitions */ #ifdef VMS @@ -139,8 +135,6 @@ typedef struct { unsigned :16, :16, :16; } vms_ino_t; /* Externals defined here. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC - /* ~~gcc/tree.h *should* declare this, because toplev.c and dwarfout.c reference it. */ @@ -213,7 +207,6 @@ tree ffecom_f2c_ftnlen_two_node; tree ffecom_f2c_ptr_to_ftnlen_type_node; tree ffecom_f2c_ftnint_type_node; tree ffecom_f2c_ptr_to_ftnint_type_node; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Simple definitions and enumerations. */ @@ -253,16 +246,13 @@ typedef enum /* Internal typedefs. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC typedef struct _ffecom_concat_list_ ffecomConcatList_; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Private include files. */ /* Internal structure definitions. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC struct _ffecom_concat_list_ { ffebld *exprs; @@ -271,11 +261,9 @@ struct _ffecom_concat_list_ ffetargetCharacterSize minlen; ffetargetCharacterSize maxlen; }; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Static functions (internal). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_arglist_expr_ (const char *argstring, ffebld args); static tree ffecom_widest_expr_type_ (ffebld list); static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, @@ -368,12 +356,10 @@ static tree ffecom_vardesc_array_ (ffesymbol s); static tree ffecom_vardesc_dims_ (ffesymbol s); static tree ffecom_convert_narrow_ (tree type, tree expr); static tree ffecom_convert_widen_ (tree type, tree expr); -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* These are static functions that parallel those found in the C front end and thus have the same names. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree bison_rule_compstmt_ (void); static void bison_rule_pushlevel_ (void); static void delete_block (tree block); @@ -392,15 +378,12 @@ static tree storedecls (tree decls); static void store_parm_decls (int is_main_program); static tree start_decl (tree decl, bool is_top_level); static void start_function (tree name, tree type, int nested, int public); -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ -#if FFECOM_GCC_INCLUDE static void ffecom_file_ (const char *name); static void ffecom_initialize_char_syntax_ (void); static void ffecom_close_include_ (FILE *f); static int ffecom_decode_include_option_ (char *spec); static FILE *ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c); -#endif /* FFECOM_GCC_INCLUDE */ /* Static objects accessed by functions in this module. */ @@ -408,7 +391,6 @@ static ffesymbol ffecom_primary_entry_ = NULL; static ffesymbol ffecom_nested_entry_ = NULL; static ffeinfoKind ffecom_primary_entry_kind_; static bool ffecom_primary_entry_is_proc_; -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_outer_function_decl_; static tree ffecom_previous_function_decl_; static tree ffecom_which_entrypoint_decl_; @@ -507,12 +489,9 @@ static const char *const ffecom_gfrt_argstring_[FFECOM_gfrt] #include "com-rt.def" #undef DEFGFRT }; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Internal macros. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC - /* We let tm.h override the types used here, to handle trivial differences such as the choice of unsigned int or long unsigned int for size_t. When machines start needing nontrivial differences in the size type, @@ -634,8 +613,6 @@ static tree named_labels; /* A list of LABEL_DECLs from outer contexts that are currently shadowed. */ static tree shadowed_labels; - -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Return the subscript expression, modified to do range-checking. @@ -700,7 +677,7 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, else { /* Array reference substring range checking. */ - + cond = ffecom_2 (LE_EXPR, integer_type_node, low, element); @@ -980,7 +957,6 @@ ffecom_arrayref_ (tree item, ffebld expr, int want_ptr) and such might well be stable too, but for things like calculations, we do need to calculate a snapshot of a value before picking at it. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_stabilize_aggregate_ (tree ref) { @@ -1053,13 +1029,11 @@ ffecom_stabilize_aggregate_ (tree ref) return result; } -#endif /* A rip-off of gcc's convert.c convert_to_complex function, reworked to handle complex implemented as C structures (RECORD_TYPE with two fields, real and imaginary `r' and `i'). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_convert_to_complex_ (tree type, tree expr) { @@ -1069,7 +1043,7 @@ ffecom_convert_to_complex_ (tree type, tree expr) assert (TREE_CODE (type) == RECORD_TYPE); subtype = TREE_TYPE (TYPE_FIELDS (type)); - + if (form == REAL_TYPE || form == INTEGER_TYPE || form == ENUMERAL_TYPE) { expr = convert (subtype, expr); @@ -1102,16 +1076,14 @@ ffecom_convert_to_complex_ (tree type, tree expr) error ("pointer value used where a complex was expected"); else error ("aggregate value used where a complex was expected"); - + return ffecom_2 (COMPLEX_EXPR, type, convert (subtype, integer_zero_node), convert (subtype, integer_zero_node)); } -#endif /* Like gcc's convert(), but crashes if widening might happen. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_convert_narrow_ (type, expr) tree type, expr; @@ -1180,11 +1152,9 @@ ffecom_convert_narrow_ (type, expr) assert ("conversion to non-scalar type requested" == NULL); return error_mark_node; } -#endif /* Like gcc's convert(), but crashes if narrowing might happen. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_convert_widen_ (type, expr) tree type, expr; @@ -1253,13 +1223,11 @@ ffecom_convert_widen_ (type, expr) assert ("conversion to non-scalar type requested" == NULL); return error_mark_node; } -#endif /* Handles making a COMPLEX type, either the standard (but buggy?) gbe way, or the safer (but less elegant?) f2c way. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_make_complex_type_ (tree subtype) { @@ -1284,12 +1252,10 @@ ffecom_make_complex_type_ (tree subtype) return type; } -#endif /* Chooses either the gbe or the f2c way to build a complex constant. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart) { @@ -1308,9 +1274,7 @@ ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart) return bothparts; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_arglist_expr_ (const char *c, ffebld expr) { @@ -1456,9 +1420,7 @@ ffecom_arglist_expr_ (const char *c, ffebld expr) return list; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_widest_expr_type_ (ffebld list) { @@ -1494,7 +1456,6 @@ ffecom_widest_expr_type_ (ffebld list) assert (t != NULL_TREE); return t; } -#endif /* Check whether a partial overlap between two expressions is possible. @@ -1546,7 +1507,6 @@ ffecom_possible_partial_overlap_ (ffebld expr1, ffebld expr2 ATTRIBUTE_UNUSED) change before it is finally modified. dest_* are the canonized destination itself. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, tree source_tree, ffebld source UNUSED, @@ -1726,12 +1686,10 @@ ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, return TRUE; /* Destination and source overlap. */ } -#endif /* Check whether dest might overlap any of a list of arguments or is in a COMMON area the callee might know about (and thus modify). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, tree args, tree callee_commons, @@ -1767,13 +1725,11 @@ ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, return FALSE; } -#endif /* Build a string for a variable name as used by NAMELIST. This means that if we're using the f2c library, we build an uppercase string, since f2c does this. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_build_f2c_string_ (int i, const char *s) { @@ -1805,13 +1761,11 @@ ffecom_build_f2c_string_ (int i, const char *s) } } -#endif /* Returns CALL_EXPR or equivalent with given type (pass NULL_TREE for type to just get whatever the function returns), handling the f2c value-returning convention, if required, by prepending to the arglist a pointer to a temporary to receive the return value. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, tree args, tree dest_tree, @@ -1875,12 +1829,10 @@ ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, return item; } -#endif /* Given two arguments, transform them and make a call to the given function via ffecom_call_. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, @@ -1929,7 +1881,6 @@ ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, dest_tree, dest, dest_used, callee_commons, scalar_args, hook); } -#endif /* Return ptr/length args for char subexpression @@ -1941,7 +1892,6 @@ ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, Note that if with_null is TRUE, and the expression is an opCONTER, a null byte is appended to the string. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) { @@ -2295,7 +2245,6 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) *xitem = item; } -#endif /* Check the size of the type to be sure it doesn't overflow the "portable" capacities of the compiler back end. `dummy' types @@ -2304,7 +2253,6 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) must still enforce its size requirements, though, and the back end takes care of this in stor-layout.c. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy) { @@ -2331,13 +2279,11 @@ ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy) return type; } -#endif /* Builds a length argument (PARM_DECL). Also wraps type in an array type where the dimension info is (1:size) where <size> is ffesymbol_size(s) if known, length_arg if not known (FFETARGET_charactersizeNONE). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) { @@ -2356,9 +2302,7 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) else tlen = ffecom_get_invented_identifier ("__g77_%s", "length"); tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node); -#if BUILT_FOR_270 DECL_ARTIFICIAL (tlen) = 1; -#endif } if (sz == FFETARGET_charactersizeNONE) @@ -2381,7 +2325,6 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) return tlen; } -#endif /* ffecom_concat_list_gather_ -- Gather list of concatenated string exprs ffecomConcatList_ catlist; @@ -2392,14 +2335,13 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) Scans expr for character subexpressions, updates and returns catlist accordingly. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffecomConcatList_ ffecom_concat_list_gather_ (ffecomConcatList_ catlist, ffebld expr, ffetargetCharacterSize max) { ffetargetCharacterSize sz; -recurse: /* :::::::::::::::::::: */ + recurse: if (expr == NULL) return catlist; @@ -2495,7 +2437,6 @@ recurse: /* :::::::::::::::::::: */ } } -#endif /* ffecom_concat_list_kill_ -- Kill list of concatenated string exprs ffecomConcatList_ catlist; @@ -2503,7 +2444,6 @@ recurse: /* :::::::::::::::::::: */ Anything allocated within the list info is deallocated. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist) { @@ -2512,13 +2452,11 @@ ffecom_concat_list_kill_ (ffecomConcatList_ catlist) catlist.max * sizeof (catlist.exprs[0])); } -#endif /* Make list of concatenated string exprs. Returns a flattened list of concatenated subexpressions given a tree of such expressions. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max) { @@ -2528,13 +2466,10 @@ ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max) return ffecom_concat_list_gather_ (catlist, expr, max); } -#endif - /* Provide some kind of useful info on member of aggregate area, since current g77/gcc technology does not provide debug info on these members. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member, tree member_type UNUSED, ffetargetOffset offset) @@ -2613,7 +2548,6 @@ ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member, if (buff != &space[0]) malloc_kill_ks (malloc_pool_image (), buff, len + 1); } -#endif /* ffecom_do_entry_ -- Do compilation of a particular entrypoint @@ -2624,7 +2558,6 @@ ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member, Makes a public entry point that calls our private master fn (already compiled). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_do_entry_ (ffesymbol fn, int entrynum) { @@ -2981,7 +2914,6 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) ffecom_doing_entry_ = FALSE; } -#endif /* Transform expr into gcc tree with possible destination Recursive descent on expr while making corresponding tree nodes and @@ -2989,7 +2921,6 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) with temporary that would be made in certain cases, temporary isn't made, destination used instead, and dest_used flag set TRUE. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used, bool assignp, bool widenp) @@ -3240,7 +3171,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opUMINUS: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3250,7 +3181,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opADD: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3261,7 +3192,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opSUBTRACT: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3272,7 +3203,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opMULTIPLY: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3283,7 +3214,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opDIVIDE: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3845,14 +3776,12 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, #endif } -#endif /* Returns the tree that does the intrinsic invocation. Note: this function applies only to intrinsics returning CHARACTER*1 or non-CHARACTER results, and to intrinsic subroutines. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used) @@ -5478,12 +5407,10 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, the bottom of this source file. */ } -#endif /* For power (exponentiation) where right-hand operand is type INTEGER, generate in-line code to do it the fast way (which, if the operand is a constant, might just mean a series of multiplies). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_expr_power_integer_ (ffebld expr) { @@ -5851,7 +5778,6 @@ ffecom_expr_power_integer_ (ffebld expr) return result; } -#endif /* ffecom_expr_transform_ -- Transform symbols in expr ffebld expr; // FFE expression. @@ -5859,14 +5785,13 @@ ffecom_expr_power_integer_ (ffebld expr) Recursive descent on expr while transforming any untransformed SYMTERs. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_expr_transform_ (ffebld expr) { tree t; ffesymbol s; -tail_recurse: /* :::::::::::::::::::: */ + tail_recurse: if (expr == NULL) return; @@ -5914,10 +5839,8 @@ tail_recurse: /* :::::::::::::::::::: */ return; } -#endif /* Make a type based on info in live f2c.h file. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_f2c_make_type_ (tree *type, int tcode, const char *name) { @@ -5986,8 +5909,6 @@ ffecom_f2c_make_type_ (tree *type, int tcode, const char *name) *type)); } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC /* Set the f2c list-directed-I/O code for whatever (integral) type has the given size. */ @@ -6008,12 +5929,10 @@ ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, } } -#endif /* Finish up globals after doing all program units in file Need to handle only uninitialized COMMON areas. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffeglobal ffecom_finish_global_ (ffeglobal global) { @@ -6056,10 +5975,8 @@ ffecom_finish_global_ (ffeglobal global) return global; } -#endif /* Finish up any untransformed symbols. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s) { @@ -6103,12 +6020,10 @@ ffecom_finish_symbol_transform_ (ffesymbol s) return s; } -#endif /* Append underscore(s) to name before calling get_identifier. "us" is nonzero if the name already contains an underscore and thus needs two underscores appended. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_get_appended_identifier_ (char us, const char *name) { @@ -6130,11 +6045,9 @@ ffecom_get_appended_identifier_ (char us, const char *name) return id; } -#endif /* Decide whether to append underscore to name before calling get_identifier. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_get_external_identifier_ (ffesymbol s) { @@ -6160,7 +6073,6 @@ ffecom_get_external_identifier_ (ffesymbol s) return ffecom_get_appended_identifier_ (us, name); } -#endif /* Decide whether to append underscore to internal name before calling get_identifier. @@ -6176,7 +6088,6 @@ ffecom_get_external_identifier_ (ffesymbol s) If the name does contain an underscore, then transform it just like we transform an external identifier. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_get_identifier_ (const char *name) { @@ -6190,7 +6101,6 @@ ffecom_get_identifier_ (const char *name) name); } -#endif /* ffecom_gen_sfuncdef_ -- Generate definition of statement function tree t; @@ -6201,7 +6111,6 @@ ffecom_get_identifier_ (const char *name) Call after setting up containing function and getting trees for all other symbols. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) { @@ -6330,17 +6239,12 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) return func; } -#endif - -#if FFECOM_targetCURRENT == FFECOM_targetGCC static const char * ffecom_gfrt_args_ (ffecomGfrt ix) { return ffecom_gfrt_argstring_[ix]; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_gfrt_tree_ (ffecomGfrt ix) { @@ -6352,25 +6256,23 @@ ffecom_gfrt_tree_ (ffecomGfrt ix) ffecom_gfrt_[ix]); } -#endif /* Return initialize-to-zero expression for this VAR_DECL. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC /* A somewhat evil way to prevent the garbage collector from collecting 'tree' structures. */ #define NUM_TRACKED_CHUNK 63 -static struct tree_ggc_tracker +static struct tree_ggc_tracker { struct tree_ggc_tracker *next; tree trees[NUM_TRACKED_CHUNK]; } *tracker_head = NULL; -static void +static void mark_tracker_head (void *arg) { struct tree_ggc_tracker *head; int i; - + for (head = * (struct tree_ggc_tracker **) arg; head != NULL; head = head->next) @@ -6396,7 +6298,7 @@ ffecom_save_tree_forever (tree t) { /* Need to allocate a new block. */ struct tree_ggc_tracker *old_head = tracker_head; - + tracker_head = ggc_alloc (sizeof (*tracker_head)); tracker_head->next = old_head; tracker_head->trees[0] = t; @@ -6438,8 +6340,6 @@ ffecom_init_zero_ (tree decl) return init; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, tree *maybe_tree) @@ -6543,7 +6443,6 @@ ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, } } -#endif /* ffecom_intrinsic_len_ -- Return length info for char arg (LEN()) tree length_arg; @@ -6554,7 +6453,6 @@ ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, subexpressions by constructing the appropriate tree for the length-of-character-text argument in a calling sequence. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_intrinsic_len_ (ffebld expr) { @@ -6695,14 +6593,12 @@ ffecom_intrinsic_len_ (ffebld expr) return length; } -#endif /* Handle CHARACTER assignments. Generates code to do the assignment. Used by ordinary assignment statement handler ffecom_let_stmt and by statement-function handler to generate code for a statement function. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_let_char_ (tree dest_tree, tree dest_length, ffetargetCharacterSize dest_size, ffebld source) @@ -6904,7 +6800,6 @@ ffecom_let_char_ (tree dest_tree, tree dest_length, ffecom_concat_list_kill_ (catlist); } -#endif /* ffecom_make_gfrt_ -- Make initial info for run-time routine ffecomGfrt ix; @@ -6913,7 +6808,6 @@ ffecom_let_char_ (tree dest_tree, tree dest_length, Assumes gfrt_[ix] is NULL_TREE, and replaces it with the FUNCTION_DECL for the indicated run-time routine (ix). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_make_gfrt_ (ffecomGfrt ix) { @@ -7012,10 +6906,8 @@ ffecom_make_gfrt_ (ffecomGfrt ix) ffecom_gfrt_[ix] = t; } -#endif /* Phase 1 pass over each member of a COMMON/EQUIVALENCE group. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st) { @@ -7025,12 +6917,10 @@ ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st) ffecom_member_namelisted_ = TRUE; } -#endif /* Phase 2 pass over each member of a COMMON/EQUIVALENCE group. Declare the member so debugger will see it. Otherwise nobody should be referencing the member. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_member_phase2_ (ffestorag mst, ffestorag st) { @@ -7075,7 +6965,6 @@ ffecom_member_phase2_ (ffestorag mst, ffestorag st) finish_decl (t, NULL_TREE, FALSE); } -#endif /* Prepare source expression for assignment into a destination perhaps known to be of a specific size. */ @@ -7131,7 +7020,6 @@ ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size, ffebld source) always known by both the caller and the callee, though the code allows for someday permitting CHAR*(*) stmtfunc dummies). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc) { @@ -7201,13 +7089,11 @@ ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc) ffecom_transform_only_dummies_ = FALSE; } -#endif /* ffecom_start_progunit_ -- Beginning of program unit Does GNU back end stuff necessary to teach it about the start of its equivalent of a Fortran program unit. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_start_progunit_ () { @@ -7430,7 +7316,6 @@ ffecom_start_progunit_ () ffesymbol_drive (ffecom_finish_symbol_transform_); } -#endif /* ffecom_sym_transform_ -- Transform FFE sym into backend sym ffesymbol s; @@ -7439,7 +7324,6 @@ ffecom_start_progunit_ () The ffesymbol_hook info for s is updated with appropriate backend info on the symbol. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffesymbol ffecom_sym_transform_ (ffesymbol s) { @@ -7503,9 +7387,7 @@ ffecom_sym_transform_ (ffesymbol s) t = build_decl (PARM_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), ffecom_tree_ptr_to_subr_type); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif addr = TRUE; break; @@ -7972,9 +7854,7 @@ ffecom_sym_transform_ (ffesymbol s) } t = build_decl (PARM_DECL, t, type); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif /* If this arg is present in every entry point's list of dummy args, then we're done. */ @@ -8194,9 +8074,7 @@ ffecom_sym_transform_ (ffesymbol s) t = build_decl (PARM_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), t); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif addr = TRUE; break; @@ -8264,9 +8142,7 @@ ffecom_sym_transform_ (ffesymbol s) t = build_decl (PARM_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), ffecom_tree_ptr_to_subr_type); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif addr = TRUE; break; @@ -8459,7 +8335,6 @@ ffecom_sym_transform_ (ffesymbol s) return s; } -#endif /* Transform into ASSIGNable symbol. Symbol has already been transformed, but for whatever reason, the @@ -8468,7 +8343,6 @@ ffecom_sym_transform_ (ffesymbol s) another local symbol of type void * and stuff that in the assign_tree argument. The F77/F90 standards allow this implementation. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffesymbol ffecom_sym_transform_assign_ (ffesymbol s) { @@ -8542,7 +8416,6 @@ ffecom_sym_transform_assign_ (ffesymbol s) return s; } -#endif /* Implement COMMON area in back end. Because COMMON-based variables can be referenced in the dimension @@ -8571,7 +8444,6 @@ ffecom_sym_transform_assign_ (ffesymbol s) though we might do that as well just for debugging purposes (and stuff the rtl with the appropriate offset expression). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_transform_common_ (ffesymbol s) { @@ -8723,10 +8595,8 @@ ffecom_transform_common_ (ffesymbol s) ffecom_save_tree_forever (cbt); } -#endif /* Make master area for local EQUIVALENCE. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_transform_equiv_ (ffestorag eqst) { @@ -8856,10 +8726,8 @@ ffecom_transform_equiv_ (ffestorag eqst) eqst); } -#endif /* Implement NAMELIST in back end. See f2c/format.c for more info. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_transform_namelist_ (ffesymbol s) { @@ -8939,14 +8807,11 @@ ffecom_transform_namelist_ (ffesymbol s) return nmlt; } -#endif - /* A subroutine of ffecom_tree_canonize_ref_. The incoming tree is analyzed on the assumption it is calculating a pointer to be indirected through. It must return the proper decl and offset, taking into account different units of measurements for offsets. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, tree t) @@ -9001,7 +8866,6 @@ ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, break; } } -#endif /* Given a tree that is possibly intended for use as an lvalue, return information representing a canonical view of that tree as a decl, an @@ -9034,7 +8898,6 @@ ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, whereas converting the array offsets to consistant offsets will reveal the overlap. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_tree_canonize_ref_ (tree *decl, tree *offset, tree *size, tree t) @@ -9186,11 +9049,9 @@ ffecom_tree_canonize_ref_ (tree *decl, tree *offset, return; } } -#endif /* Do divide operation appropriate to type of operands. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right, tree dest_tree, ffebld dest, bool *dest_used, @@ -9278,10 +9139,8 @@ ffecom_tree_divide_ (tree tree_type, tree left, tree right, } } -#endif /* Build type info for non-dummy variable. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) @@ -9338,10 +9197,8 @@ ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, return type; } -#endif /* Build Namelist type. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_type_namelist_ () { @@ -9373,11 +9230,8 @@ ffecom_type_namelist_ () return type; } -#endif - /* Build Vardesc type. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_type_vardesc_ () { @@ -9406,9 +9260,6 @@ ffecom_type_vardesc_ () return type; } -#endif - -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_vardesc_ (ffebld expr) { @@ -9497,8 +9348,6 @@ ffecom_vardesc_ (ffebld expr) return ffesymbol_hook (s).vardesc_tree; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_vardesc_array_ (ffesymbol s) { @@ -9544,8 +9393,6 @@ ffecom_vardesc_array_ (ffesymbol s) return var; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_vardesc_dims_ (ffesymbol s) { @@ -9655,14 +9502,12 @@ ffecom_vardesc_dims_ (ffesymbol s) } } -#endif /* Essentially does a "fold (build1 (code, type, node))" while checking for certain housekeeping things. NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use ffecom_1_fn instead. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_1 (enum tree_code code, tree type, tree node) { @@ -9720,7 +9565,6 @@ ffecom_1 (enum tree_code code, tree type, tree node) TREE_CONSTANT (item) = 1; return fold (item); } -#endif /* Like ffecom_1 (ADDR_EXPR, TREE_TYPE (node), node), except handles TREE_CODE (node) == FUNCTION_DECL. In particular, @@ -9728,7 +9572,6 @@ ffecom_1 (enum tree_code code, tree type, tree node) function does not mean the function needs to be separately compiled). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_1_fn (tree node) { @@ -9749,12 +9592,10 @@ ffecom_1_fn (tree node) TREE_CONSTANT (item) = 1; return fold (item); } -#endif /* Essentially does a "fold (build (code, type, node1, node2))" while checking for certain housekeeping things. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2) @@ -9923,7 +9764,6 @@ ffecom_2 (enum tree_code code, tree type, tree node1, return fold (item); } -#endif /* ffecom_2pass_advise_entrypoint -- Advise that there's this entrypoint ffesymbol s; // the ENTRY point itself @@ -9942,7 +9782,6 @@ ffecom_2 (enum tree_code code, tree type, tree node1, 03-Jan-92 JCB 2.0 Return FALSE if the return type conflicts with previous entrypoints. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC bool ffecom_2pass_advise_entrypoint (ffesymbol entry) { @@ -10080,7 +9919,6 @@ ffecom_2pass_advise_entrypoint (ffesymbol entry) return TRUE; } -#endif /* ffecom_2pass_do_entrypoint -- Do compilation of entrypoint ffesymbol s; // the ENTRY point itself @@ -10090,7 +9928,6 @@ ffecom_2pass_advise_entrypoint (ffesymbol entry) happen. Must be called for each entrypoint after ffecom_finish_progunit is called. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_2pass_do_entrypoint (ffesymbol entry) { @@ -10111,13 +9948,10 @@ ffecom_2pass_do_entrypoint (ffesymbol entry) ffecom_do_entry_ (entry, ent_num); } -#endif - /* Essentially does a "fold (build (code, type, node1, node2))" while checking for certain housekeeping things. Always sets TREE_SIDE_EFFECTS. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_2s (enum tree_code code, tree type, tree node1, tree node2) @@ -10134,11 +9968,9 @@ ffecom_2s (enum tree_code code, tree type, tree node1, return fold (item); } -#endif /* Essentially does a "fold (build (code, type, node1, node2, node3))" while checking for certain housekeeping things. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2, tree node3) @@ -10158,12 +9990,10 @@ ffecom_3 (enum tree_code code, tree type, tree node1, return fold (item); } -#endif /* Essentially does a "fold (build (code, type, node1, node2, node3))" while checking for certain housekeeping things. Always sets TREE_SIDE_EFFECTS. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3) @@ -10181,8 +10011,6 @@ ffecom_3s (enum tree_code code, tree type, tree node1, return fold (item); } -#endif - /* ffecom_arg_expr -- Transform argument expr into gcc tree See use by ffecom_list_expr. @@ -10200,7 +10028,6 @@ ffecom_3s (enum tree_code code, tree type, tree node1, we allow CHARACTER*(*) dummies to statement functions, we'll need it). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_arg_expr (ffebld expr, tree *length) { @@ -10217,7 +10044,6 @@ ffecom_arg_expr (ffebld expr, tree *length) return ffecom_arg_ptr_to_expr (expr, &ign); } -#endif /* Transform expression into constant argument-pointer-to-expression tree. If the expression can be transformed into a argument-pointer-to-expression @@ -10286,7 +10112,6 @@ ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length) length argument. This might even be seen as a feature, if a null byte can always be appended. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length) { @@ -10529,7 +10354,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) return item; } -#endif /* Generate call to run-time function. The first arg is the GNU Fortran Run-Time function index, the second @@ -10537,7 +10361,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) (WITHOUT TREE_SIDE_EFFECTS set!) that makes the call and returns the result (which may be void). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook) { @@ -10547,11 +10370,9 @@ ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook) NULL_TREE, args, NULL_TREE, NULL, NULL, NULL_TREE, TRUE, hook); } -#endif /* Transform constant-union to tree. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, ffeinfoKindtype kt, tree tree_type) @@ -10819,8 +10640,6 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, return item; } -#endif - /* Transform expression into constant tree. If the expression can be transformed into a tree that is constant, @@ -10860,7 +10679,6 @@ ffecom_const_expr (ffebld expr) /* Handy way to make a field in a struct/union. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_decl_field (tree context, tree prevfield, const char *name, tree type) @@ -10877,35 +10695,25 @@ ffecom_decl_field (tree context, tree prevfield, return field; } -#endif - void ffecom_close_include (FILE *f) { -#if FFECOM_GCC_INCLUDE ffecom_close_include_ (f); -#endif } int ffecom_decode_include_option (char *spec) { -#if FFECOM_GCC_INCLUDE return ffecom_decode_include_option_ (spec); -#else - return 1; -#endif } /* End a compound statement (block). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_end_compstmt (void) { return bison_rule_compstmt_ (); } -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* ffecom_end_transition -- Perform end transition on all symbols @@ -10916,28 +10724,20 @@ ffecom_end_compstmt (void) void ffecom_end_transition () { -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffebld item; -#endif if (ffe_is_ffedebug ()) fprintf (dmpout, "; end_stmt_transition\n"); -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffecom_list_blockdata_ = NULL; ffecom_list_common_ = NULL; -#endif ffesymbol_drive (ffecom_sym_end_transition); if (ffe_is_ffedebug ()) { ffestorag_report (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffesymbol_report_all (); -#endif } -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffecom_start_progunit_ (); for (item = ffecom_list_blockdata_; @@ -10988,7 +10788,6 @@ ffecom_end_transition () ffecom_transform_common_ (ffebld_symter (ffebld_head (item))); ffecom_list_common_ = NULL; -#endif } /* ffecom_exec_transition -- Perform exec transition on all symbols @@ -11014,9 +10813,6 @@ ffecom_exec_transition () if (ffe_is_ffedebug ()) { ffestorag_report (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffesymbol_report_all (); -#endif } if (inhibited) @@ -11028,7 +10824,6 @@ ffecom_exec_transition () Convert dest and source using ffecom_expr, then join them with an ASSIGN op and pass the whole thing to expand_expr_stmt. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_expand_let_stmt (ffebld dest, ffebld source) { @@ -11138,7 +10933,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) source); } -#endif /* ffecom_expr -- Transform expr into gcc tree tree t; @@ -11148,41 +10942,34 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) Recursive descent on expr while making corresponding tree nodes and attaching type info and such. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr (ffebld expr) { return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, FALSE, FALSE); } -#endif /* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_assign (ffebld expr) { return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); } -#endif /* Like ffecom_expr_rw, but return tree usable for ASSIGN. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_assign_w (ffebld expr) { return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); } -#endif /* Transform expr for use as into read/write tree and stabilize the reference. Not for use on CHARACTER expressions. Recursive descent on expr while making corresponding tree nodes and attaching type info and such. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_rw (tree type, ffebld expr) { @@ -11193,14 +10980,12 @@ ffecom_expr_rw (tree type, ffebld expr) return stabilize_reference (ffecom_expr (expr)); } -#endif /* Transform expr for use as into write tree and stabilize the reference. Not for use on CHARACTER expressions. Recursive descent on expr while making corresponding tree nodes and attaching type info and such. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_w (tree type, ffebld expr) { @@ -11211,10 +10996,8 @@ ffecom_expr_w (tree type, ffebld expr) return stabilize_reference (ffecom_expr (expr)); } -#endif /* Do global stuff. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_finish_compile () { @@ -11224,10 +11007,8 @@ ffecom_finish_compile () ffeglobal_drive (ffecom_finish_global_); } -#endif /* Public entry point for front end to access finish_decl. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_finish_decl (tree decl, tree init, bool is_top_level) { @@ -11235,10 +11016,8 @@ ffecom_finish_decl (tree decl, tree init, bool is_top_level) finish_decl (decl, init, FALSE); } -#endif /* Finish a program unit. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_finish_progunit () { @@ -11250,11 +11029,8 @@ ffecom_finish_progunit () finish_function (0); } -#endif - /* Wrapper for get_identifier. pattern is sprintf-like. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_get_invented_identifier (const char *pattern, ...) { @@ -11420,9 +11196,7 @@ ffecom_init_0 () } } -#if FFECOM_GCC_INCLUDE ffecom_initialize_char_syntax_ (); -#endif ffecom_outer_function_decl_ = NULL_TREE; current_function_decl = NULL_TREE; @@ -11962,9 +11736,7 @@ ffecom_init_0 () builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, BUILT_IN_COS, BUILT_IN_NORMAL, "cosl"); -#if BUILT_FOR_270 pedantic_lvalues = FALSE; -#endif ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node, FFECOM_f2cINTEGER, @@ -12080,12 +11852,10 @@ ffecom_init_0 () #endif } -#endif /* ffecom_init_2 -- Initialize ffecom_init_2(); */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_init_2 () { @@ -12101,7 +11871,6 @@ ffecom_init_2 () ffecom_multi_retval_ = NULL_TREE; } -#endif /* ffecom_list_expr -- Transform list of exprs into gcc tree tree t; @@ -12110,7 +11879,6 @@ ffecom_init_2 () List of actual args is transformed into corresponding gcc backend list. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_list_expr (ffebld expr) { @@ -12142,7 +11910,6 @@ ffecom_list_expr (ffebld expr) return list; } -#endif /* ffecom_list_ptr_to_expr -- Transform list of exprs into gcc tree tree t; @@ -12152,7 +11919,6 @@ ffecom_list_expr (ffebld expr) List of actual args is transformed into corresponding gcc backend list for use in calling an external procedure (vs. a statement function). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_list_ptr_to_expr (ffebld expr) { @@ -12184,10 +11950,8 @@ ffecom_list_ptr_to_expr (ffebld expr) return list; } -#endif /* Obtain gcc's LABEL_DECL tree for label. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_lookup_label (ffelab label) { @@ -12247,13 +12011,11 @@ ffecom_lookup_label (ffelab label) return glabel; } -#endif /* Stabilizes the arguments. Don't use this if the lhs and rhs come from a single source specification (as in the fourth argument of MVBITS). If the type is NULL_TREE, the type of lhs is used to make the type of the MODIFY_EXPR. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_modify (tree newtype, tree lhs, tree rhs) @@ -12270,16 +12032,12 @@ ffecom_modify (tree newtype, tree lhs, return ffecom_2s (MODIFY_EXPR, newtype, lhs, rhs); } -#endif - /* Register source file name. */ void ffecom_file (const char *name) { -#if FFECOM_GCC_INCLUDE ffecom_file_ (name); -#endif } /* ffecom_notify_init_storage -- An aggregate storage is now fully init'ed @@ -12314,10 +12072,6 @@ void ffecom_notify_init_storage (ffestorag st) { ffebld init; /* The initialization expression. */ -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - ffetargetOffset size; /* The size of the entity. */ - ffetargetAlign pad; /* Its initial padding. */ -#endif if (ffestorag_init (st) == NULL) { @@ -12325,50 +12079,8 @@ ffecom_notify_init_storage (ffestorag st) assert (init != NULL); ffestorag_set_accretion (st, NULL); ffestorag_set_accretes (st, 0); - -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ - size = ffebld_accter_size (init); - pad = ffebld_accter_pad (init); - ffebit_kill (ffebld_accter_bits (init)); - ffebld_set_op (init, FFEBLD_opARRTER); - ffebld_set_arrter (init, ffebld_accter (init)); - ffebld_arrter_set_size (init, size); - ffebld_arrter_set_pad (init, size); -#endif - -#if FFECOM_TWOPASS ffestorag_set_init (st, init); -#endif } -#if FFECOM_ONEPASS - else - init = ffestorag_init (st); -#endif - -#if FFECOM_ONEPASS /* Process the inits, wipe 'em out. */ - ffestorag_set_init (st, ffebld_new_any ()); - - if (ffebld_op (init) == FFEBLD_opANY) - return; /* Oh, we already did this! */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - { - ffesymbol s; - - if (ffestorag_symbol (st) != NULL) - s = ffestorag_symbol (st); - else - s = ffestorag_typesymbol (st); - - fprintf (dmpout, "= initialize_storage \"%s\" ", - (s != NULL) ? ffesymbol_text (s) : "(unnamed)"); - ffebld_dump (init); - fputc ('\n', dmpout); - } -#endif - -#endif /* if FFECOM_ONEPASS */ } /* ffecom_notify_init_symbol -- A symbol is now fully init'ed @@ -12403,10 +12115,6 @@ void ffecom_notify_init_symbol (ffesymbol s) { ffebld init; /* The initialization expression. */ -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - ffetargetOffset size; /* The size of the entity. */ - ffetargetAlign pad; /* Its initial padding. */ -#endif if (ffesymbol_storage (s) == NULL) return; /* Do nothing until COMMON/EQUIVALENCE @@ -12417,40 +12125,8 @@ ffecom_notify_init_symbol (ffesymbol s) { ffesymbol_set_accretion (s, NULL); ffesymbol_set_accretes (s, 0); - -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ - size = ffebld_accter_size (init); - pad = ffebld_accter_pad (init); - ffebit_kill (ffebld_accter_bits (init)); - ffebld_set_op (init, FFEBLD_opARRTER); - ffebld_set_arrter (init, ffebld_accter (init)); - ffebld_arrter_set_size (init, size); - ffebld_arrter_set_pad (init, size); -#endif - -#if FFECOM_TWOPASS ffesymbol_set_init (s, init); -#endif } -#if FFECOM_ONEPASS - else - init = ffesymbol_init (s); -#endif - -#if FFECOM_ONEPASS - ffesymbol_set_init (s, ffebld_new_any ()); - - if (ffebld_op (init) == FFEBLD_opANY) - return; /* Oh, we already did this! */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "= initialize_symbol \"%s\" ", ffesymbol_text (s)); - ffebld_dump (init); - fputc ('\n', dmpout); -#endif - -#endif /* if FFECOM_ONEPASS */ } /* ffecom_notify_primary_entry -- Learn which is the primary entry point @@ -12482,7 +12158,6 @@ ffecom_notify_primary_entry (ffesymbol s) fprintf (stderr, " %s:\n", ffesymbol_text (s)); } -#if FFECOM_targetCURRENT == FFECOM_targetGCC if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE) { ffebld list; @@ -12500,17 +12175,12 @@ ffecom_notify_primary_entry (ffesymbol s) } } } -#endif } FILE * ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c) { -#if FFECOM_GCC_INCLUDE return ffecom_open_include_ (name, l, c); -#else - return fopen (name, "r"); -#endif } /* ffecom_ptr_to_expr -- Transform expr into gcc tree with & in front @@ -12521,7 +12191,6 @@ ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c) Like ffecom_expr, but sticks address-of in front of most things. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_ptr_to_expr (ffebld expr) { @@ -12624,7 +12293,6 @@ ffecom_ptr_to_expr (ffebld expr) return error_mark_node; } -#endif /* Obtain a temp var with given data type. size is FFETARGET_charactersizeNONE for a non-CHARACTER type @@ -12632,7 +12300,6 @@ ffecom_ptr_to_expr (ffebld expr) elements is -1 for a scalar or > 0 for an array of type. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_make_tempvar (const char *commentary, tree type, ffetargetCharacterSize size, int elements) @@ -12667,7 +12334,6 @@ ffecom_make_tempvar (const char *commentary, tree type, return t; } -#endif /* Prepare argument pointer to expression. @@ -13040,7 +12706,6 @@ ffecom_ptr_to_const_expr (ffebld expr) meaning no return value or the caller expects it to be returned somewhere else (which is handled by other parts of this module). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_return_expr (ffebld expr) { @@ -13111,30 +12776,24 @@ ffecom_return_expr (ffebld expr) return rtn; } -#endif /* Do save_expr only if tree is not error_mark_node. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_save_tree (tree t) { return save_expr (t); } -#endif /* Start a compound statement (block). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_start_compstmt (void) { bison_rule_pushlevel_ (); } -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Public entry point for front end to access start_decl. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_start_decl (tree decl, bool is_initialized) { @@ -13142,7 +12801,6 @@ ffecom_start_decl (tree decl, bool is_initialized) return start_decl (decl, FALSE); } -#endif /* ffecom_sym_commit -- Symbol's state being committed to reality ffesymbol s; @@ -13151,14 +12809,12 @@ ffecom_start_decl (tree decl, bool is_initialized) Does whatever the backend needs when a symbol is committed after having been backtrackable for a period of time. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_sym_commit (ffesymbol s UNUSED) { assert (!ffesymbol_retractable ()); } -#endif /* ffecom_sym_end_transition -- Perform end transition on all symbols ffecom_sym_end_transition(); @@ -13178,7 +12834,6 @@ ffecom_sym_end_transition (ffesymbol s) s = ffest_sym_end_transition (s); -#if FFECOM_targetCURRENT == FFECOM_targetGCC if ((ffesymbol_kind (s) == FFEINFO_kindBLOCKDATA) && (ffesymbol_where (s) == FFEINFO_whereGLOBAL)) { @@ -13188,7 +12843,6 @@ ffecom_sym_end_transition (ffesymbol s) FFEINTRIN_impNONE), ffecom_list_blockdata_); } -#endif /* This is where we finally notice that a symbol has partial initialization and finalize it. */ @@ -13206,7 +12860,6 @@ ffecom_sym_end_transition (ffesymbol s) ffecom_notify_init_storage (st); } -#if FFECOM_targetCURRENT == FFECOM_targetGCC if ((ffesymbol_kind (s) == FFEINFO_kindCOMMON) && (ffesymbol_where (s) == FFEINFO_whereLOCAL) && (ffesymbol_storage (s) != NULL)) @@ -13217,7 +12870,6 @@ ffecom_sym_end_transition (ffesymbol s) FFEINTRIN_impNONE), ffecom_list_common_); } -#endif return s; } @@ -13295,7 +12947,6 @@ ffecom_sym_learned (ffesymbol s) Does whatever the backend needs when a symbol is retracted after having been backtrackable for a period of time. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_sym_retract (ffesymbol s UNUSED) { @@ -13327,10 +12978,8 @@ ffecom_sym_retract (ffesymbol s UNUSED) #endif } -#endif /* Create temporary gcc label. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_temp_label () { @@ -13347,35 +12996,29 @@ ffecom_temp_label () return glabel; } -#endif /* Return an expression that is usable as an arg in a conditional context (IF, DO WHILE, .NOT., and so on). Use the one provided for the back end as of >2.6.0. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_truth_value (tree expr) { return truthvalue_conversion (expr); } -#endif /* Return the inversion of a truth value (the inversion of what ffecom_truth_value builds). Apparently invert_truthvalue, which is properly in the back end, is enough for now, so just use it. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_truth_value_invert (tree expr) { return invert_truthvalue (ffecom_truth_value (expr)); } -#endif - /* Return the tree that is the type of the expression, as would be returned in TREE_TYPE(ffecom_expr(expr)), without otherwise transforming the expression, generating temporaries, etc. */ @@ -13451,7 +13094,6 @@ ffecom_type_expr (ffebld expr) run time with the entrypoint number (0 for SUBROUTINE/FUNCTION, 1 for first ENTRY statement, and so on). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_which_entrypoint_decl () { @@ -13459,8 +13101,6 @@ ffecom_which_entrypoint_decl () return ffecom_which_entrypoint_decl_; } - -#endif /* The following sections consists of private and public functions that have the same names and perform roughly the same functions @@ -13477,8 +13117,6 @@ ffecom_which_entrypoint_decl () Functions named after rule "foo:" in c-parse.y are named "bison_rule_foo_" so they are easy to find. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC - static void bison_rule_pushlevel_ () { @@ -13699,13 +13337,11 @@ duplicate_decls (tree newdecl, tree olddecl) if (DECL_SECTION_NAME (newdecl) == NULL_TREE) DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl); -#if BUILT_FOR_270 if (TREE_CODE (newdecl) == FUNCTION_DECL) { DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl); DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl); } -#endif } /* If cannot merge, then use the new type and qualifiers, and don't preserve the old rtl. */ @@ -14015,7 +13651,6 @@ lang_printable_name (tree decl, int v) /* g77's function to print out name of current function that caused an error. */ -#if BUILT_FOR_270 static void lang_print_error_function (diagnostic_context *context __attribute__((unused)), const char *file) @@ -14087,7 +13722,6 @@ lang_print_error_function (diagnostic_context *context __attribute__((unused)), last_s = s; } } -#endif /* Similar to `lookup_name' but look only at current binding level. */ @@ -14480,7 +14114,7 @@ incomplete_type_error (value, type) } /* Mark ARG for GC. */ -static void +static void mark_binding_level (void *arg) { struct binding_level *level = *(struct binding_level **) arg; @@ -14546,11 +14180,11 @@ init_decl_processing () /* Record our roots. */ for (i = 0; i < ARRAY_SIZE (tree_roots); i++) ggc_add_tree_root (tree_roots[i], 1); - ggc_add_tree_root (&ffecom_tree_type[0][0], + ggc_add_tree_root (&ffecom_tree_type[0][0], FFEINFO_basictype*FFEINFO_kindtype); - ggc_add_tree_root (&ffecom_tree_fun_type[0][0], + ggc_add_tree_root (&ffecom_tree_fun_type[0][0], FFEINFO_basictype*FFEINFO_kindtype); - ggc_add_tree_root (&ffecom_tree_ptr_to_fun_type[0][0], + ggc_add_tree_root (&ffecom_tree_ptr_to_fun_type[0][0], FFEINFO_basictype*FFEINFO_kindtype); ggc_add_tree_root (ffecom_gfrt_, FFECOM_gfrt); ggc_add_root (¤t_binding_level, 1, sizeof current_binding_level, @@ -14584,9 +14218,7 @@ init_parse (filename) /* Make identifier nodes long enough for the language-specific slots. */ set_identifier_size (sizeof (struct lang_identifier)); decl_printable_name = lang_printable_name; -#if BUILT_FOR_270 print_error_function = lang_print_error_function; -#endif return filename; } @@ -14989,9 +14621,7 @@ pushdecl (x) { if (IDENTIFIER_INVENTED (name)) { -#if BUILT_FOR_270 DECL_ARTIFICIAL (x) = 1; -#endif DECL_IN_SYSTEM_HEADER (x) = 1; } @@ -15557,7 +15187,7 @@ unsigned_type (type) return type; } -void +void lang_mark_tree (t) union tree_node *t ATTRIBUTE_UNUSED; { @@ -15571,11 +15201,7 @@ lang_mark_tree (t) else if (TYPE_P (t) && TYPE_LANG_SPECIFIC (t)) ggc_mark (TYPE_LANG_SPECIFIC (t)); } - -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ -#if FFECOM_GCC_INCLUDE - /* From gcc/cccp.c, the code to handle -I. */ /* Skip leading "./" from a directory name. @@ -16254,7 +15880,6 @@ ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c) return f; } -#endif /* FFECOM_GCC_INCLUDE */ /**INDENT* (Do not reformat this comment even with -fca option.) Data-gathering files: Given the source file listed below, compiled with @@ -16740,12 +16365,12 @@ typedef doublereal E_f; // real function with -R not specified // void pow_ci(); double pow_dd(); void pow_zz(); - double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(), + double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(), asin(), atan(), atan2(), c_abs(); void c_cos(), c_exp(), c_log(), r_cnjg(); double cos(), cosh(); void c_sin(), c_sqrt(); - double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(), + double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(), d_sign(), sin(), sinh(), sqrt(), tan(), tanh(); integer i_dim(), i_dnnt(), i_indx(), i_sign(), i_len(); logical l_ge(), l_gt(), l_le(), l_lt(); @@ -16753,7 +16378,7 @@ typedef doublereal E_f; // real function with -R not specified // double r_sign(); // Local variables // - extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(), + extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(), fool_(), fooz_(), getem_(); static char a1[10], a2[10]; static complex c1, c2; diff --git a/gcc/f/com.h b/gcc/f/com.h index a0d08b1..5e20e2b 100644 --- a/gcc/f/com.h +++ b/gcc/f/com.h @@ -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() diff --git a/gcc/f/equiv.c b/gcc/f/equiv.c index 54dc12b..f58de9c 100644 --- a/gcc/f/equiv.c +++ b/gcc/f/equiv.c @@ -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(); */ diff --git a/gcc/f/equiv.h b/gcc/f/equiv.h index f3d2c85..59abfc8 100644 --- a/gcc/f/equiv.h +++ b/gcc/f/equiv.h @@ -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); diff --git a/gcc/f/global.h b/gcc/f/global.h index 5ab6741..15d984f 100644 --- a/gcc/f/global.h +++ b/gcc/f/global.h @@ -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 */ - + diff --git a/gcc/f/intdoc.c b/gcc/f/intdoc.c index 4ce776b..44ab7a8 100644 --- a/gcc/f/intdoc.c +++ b/gcc/f/intdoc.c @@ -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 diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c index add9902..6b89bfa 100644 --- a/gcc/f/intrin.c +++ b/gcc/f/intrin.c @@ -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)); } diff --git a/gcc/f/intrin.h b/gcc/f/intrin.h index 76b59dc..e741e69 100644 --- a/gcc/f/intrin.h +++ b/gcc/f/intrin.h @@ -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() diff --git a/gcc/f/lex.c b/gcc/f/lex.c index 9f49c7e..9fef050 100644 --- a/gcc/f/lex.c +++ b/gcc/f/lex.c @@ -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 () { diff --git a/gcc/f/parse.c b/gcc/f/parse.c index 005baa7..29c6133 100644 --- a/gcc/f/parse.c +++ b/gcc/f/parse.c @@ -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 } diff --git a/gcc/f/sta.c b/gcc/f/sta.c index 0c5f3b7..0b4c11a 100644 --- a/gcc/f/sta.c +++ b/gcc/f/sta.c @@ -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); diff --git a/gcc/f/std.c b/gcc/f/std.c index 425744c..b8e3b39 100644 --- a/gcc/f/std.c +++ b/gcc/f/std.c @@ -69,7 +69,6 @@ typedef enum FFESTD_ } ffestdStatelet_; -#if FFECOM_TWOPASS typedef enum { FFESTD_stmtidENDDOLOOP_, @@ -134,14 +133,10 @@ typedef enum FFESTD_stmtid_, } ffestdStmtId_; -#endif - /* Internal typedefs. */ typedef struct _ffestd_expr_item_ *ffestdExprItem_; -#if FFECOM_TWOPASS typedef struct _ffestd_stmt_ *ffestdStmt_; -#endif /* Private include files. */ @@ -155,16 +150,13 @@ struct _ffestd_expr_item_ ffelexToken token; }; -#if FFECOM_TWOPASS struct _ffestd_stmt_ { ffestdStmt_ next; ffestdStmt_ previous; ffestdStmtId_ id; -#if FFECOM_targetCURRENT == FFECOM_targetGCC char *filename; int filelinenum; -#endif union { struct @@ -491,47 +483,36 @@ struct _ffestd_stmt_ u; }; -#endif - /* Static objects accessed by functions in this module. */ static ffestdStatelet_ ffestd_statelet_ = FFESTD_stateletSIMPLE_; static int ffestd_block_level_ = 0; /* Block level for reachableness. */ static bool ffestd_is_reachable_; /* Is the current stmt reachable? */ static ffelab ffestd_label_formatdef_ = NULL; -#if FFECOM_TWOPASS static ffestdExprItem_ *ffestd_expr_list_; static struct { ffestdStmt_ first; ffestdStmt_ last; } - -ffestd_stmt_list_ -= +ffestd_stmt_list_ = { NULL, NULL }; -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -static int ffestd_2pass_entrypoints_ = 0; /* # ENTRY statements - pending. */ -#endif + +/* # ENTRY statements pending. */ +static int ffestd_2pass_entrypoints_ = 0; /* Static functions (internal). */ -#if FFECOM_TWOPASS static void ffestd_stmt_append_ (ffestdStmt_ stmt); static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id); static void ffestd_stmt_pass_ (void); -#endif -#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS +#if FFESTD_COPY_EASY_ static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max); #endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffestd_subr_vxt_ (void); -#endif #if FFESTR_F90 static void ffestd_subr_f90_ (void); #endif @@ -562,7 +543,6 @@ static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr); /* Internal macros. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC #define ffestd_subr_line_now_() \ ffeste_set_line (ffelex_token_where_filename (ffesta_tokens[0]), \ ffelex_token_where_filelinenum (ffesta_tokens[0])) @@ -571,13 +551,6 @@ static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr); #define ffestd_subr_line_save_(s) \ ((s)->filename = ffelex_token_where_filename (ffesta_tokens[0]), \ (s)->filelinenum = ffelex_token_where_filelinenum (ffesta_tokens[0])) -#else -#define ffestd_subr_line_now_() -#if FFECOM_TWOPASS -#define ffestd_subr_line_restore_(s) -#define ffestd_subr_line_save_(s) -#endif /* FFECOM_TWOPASS */ -#endif /* FFECOM_targetCURRENT != FFECOM_targetGCC */ #define ffestd_check_simple_() \ assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_) #define ffestd_check_start_() \ @@ -603,7 +576,7 @@ static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr); || ffestd_statelet_ == FFESTD_stateletITEM_); \ ffestd_statelet_ = FFESTD_stateletSIMPLE_ -#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS +#if FFESTD_COPY_EASY_ #define ffestd_subr_copy_accept_() (ffestpAcceptStmt *) \ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_acceptix) #define ffestd_subr_copy_beru_() (ffestpBeruStmt *) \ @@ -636,7 +609,6 @@ static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr); ffestd_stmt_append_(ffestd_stmt_new_(FFESTD_stmtidR737A_)); */ -#if FFECOM_TWOPASS static void ffestd_stmt_append_ (ffestdStmt_ stmt) { @@ -646,13 +618,11 @@ ffestd_stmt_append_ (ffestdStmt_ stmt) stmt->previous->next = stmt; } -#endif /* ffestd_stmt_new_ -- Make new statement with given id ffestdStmt_ stmt; stmt = ffestd_stmt_new_(FFESTD_stmtidR737A_); */ -#if FFECOM_TWOPASS static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id) { @@ -663,12 +633,10 @@ ffestd_stmt_new_ (ffestdStmtId_ id) return stmt; } -#endif /* ffestd_stmt_pass_ -- Pass all statements on list to ffeste ffestd_stmt_pass_(); */ -#if FFECOM_TWOPASS static void ffestd_stmt_pass_ () { @@ -676,7 +644,6 @@ ffestd_stmt_pass_ () ffestdExprItem_ expr; /* For traversing lists. */ bool okay = (TREE_CODE (current_function_decl) != ERROR_MARK); -#if FFECOM_targetCURRENT == FFECOM_targetGCC if ((ffestd_2pass_entrypoints_ != 0) && okay) { tree which = ffecom_which_entrypoint_decl (); @@ -717,7 +684,6 @@ ffestd_stmt_pass_ () expand_end_case (which); } -#endif for (stmt = ffestd_stmt_list_.first; stmt != (ffestdStmt_) &ffestd_stmt_list_.first; @@ -1175,7 +1141,6 @@ ffestd_stmt_pass_ () } } -#endif /* ffestd_subr_copy_easy_ -- Copy I/O statement data structure ffestd_subr_copy_easy_(); @@ -1187,7 +1152,7 @@ ffestd_stmt_pass_ () and structure references assume (though not necessarily dangerous if FALSE) that INQUIRE has the most file elements. */ -#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS +#if FFESTD_COPY_EASY_ static ffestpInquireStmt * ffestd_subr_copy_easy_ (ffestpInquireIx max) { @@ -1326,7 +1291,6 @@ ffestd_subr_f90_ () ffestd_subr_vxt_(); */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffestd_subr_vxt_ () { @@ -1336,7 +1300,6 @@ ffestd_subr_vxt_ () ffebad_finish (); } -#endif /* ffestd_begin_uses -- Start a bunch of USE statements ffestd_begin_uses(); @@ -1350,12 +1313,6 @@ ffestd_subr_vxt_ () void ffestd_begin_uses () { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("; begin_uses\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_do -- End of statement following DO-term-stmt etc @@ -1371,19 +1328,12 @@ ffestd_begin_uses () void ffestd_do (bool ok UNUSED) { -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_do (ffestw_stack_top ()); -#else - { - ffestdStmt_ stmt; + ffestdStmt_ stmt; - stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.enddoloop.block = ffestw_stack_top (); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.enddoloop.block = ffestw_stack_top (); --ffestd_block_level_; assert (ffestd_block_level_ >= 0); @@ -1400,12 +1350,6 @@ ffestd_do (bool ok UNUSED) void ffestd_end_uses (bool ok) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("; end_uses\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_end_R740 -- End a WHERE(-THEN) @@ -1432,18 +1376,11 @@ ffestd_end_R740 (bool ok) void ffestd_end_R807 (bool ok UNUSED) { -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_end_R807 (); -#else - { - ffestdStmt_ stmt; + ffestdStmt_ stmt; - stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); --ffestd_block_level_; assert (ffestd_block_level_ >= 0); @@ -1458,11 +1395,6 @@ ffestd_exec_begin () { ffecom_exec_transition (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("{ begin_exec\n", dmpout); -#endif - -#if FFECOM_targetCURRENT == FFECOM_targetGCC if (ffestd_2pass_entrypoints_ != 0) { /* Process pending ENTRY statements now that info filled in. */ @@ -1484,7 +1416,6 @@ ffestd_exec_begin () } while (--ents != 0); } -#endif } /* ffestd_exec_end -- Executable statements can no longer come in now @@ -1494,23 +1425,13 @@ ffestd_exec_begin () void ffestd_exec_end () { -#if FFECOM_targetCURRENT == FFECOM_targetGCC int old_lineno = lineno; const char *old_input_filename = input_filename; -#endif ffecom_end_transition (); -#if FFECOM_TWOPASS ffestd_stmt_pass_ (); -#endif -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("} end_exec\n", dmpout); - fputs ("> end_unit\n", dmpout); -#endif - -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffecom_finish_progunit (); if (ffestd_2pass_entrypoints_ != 0) @@ -1539,7 +1460,6 @@ ffestd_exec_end () lineno = old_lineno; input_filename = old_input_filename; -#endif } /* ffestd_init_3 -- Initialize for any program unit @@ -1549,10 +1469,8 @@ ffestd_exec_end () void ffestd_init_3 () { -#if FFECOM_TWOPASS ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first; ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first; -#endif } /* Generate "code" for "any" label def. */ @@ -1560,12 +1478,6 @@ ffestd_init_3 () void ffestd_labeldef_any (ffelab label UNUSED) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "; any_label_def %lu\n", ffelab_value (label)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_labeldef_branch -- Generate "code" for branch label def @@ -1575,17 +1487,11 @@ ffestd_labeldef_any (ffelab label UNUSED) void ffestd_labeldef_branch (ffelab label) { -#if FFECOM_ONEPASS - ffeste_labeldef_branch (label); -#else - { - ffestdStmt_ stmt; + ffestdStmt_ stmt; - stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_); - ffestd_stmt_append_ (stmt); - stmt->u.execlabel.label = label; - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_); + ffestd_stmt_append_ (stmt); + stmt->u.execlabel.label = label; ffestd_is_reachable_ = TRUE; } @@ -1599,29 +1505,11 @@ ffestd_labeldef_format (ffelab label) { ffestd_label_formatdef_ = label; -#if FFECOM_ONEPASS - ffeste_labeldef_format (label); -#else - { - ffestdStmt_ stmt; + ffestdStmt_ stmt; - stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_); -#if 0 - /* Don't bother with this. See FORMAT statement. */ - /* Prepend FORMAT label instead of appending it, so all the - FORMAT label/statement pairs end up at the top of the list. - This helps ensure all decls for a block (in the GBE) are - known before any executable statements are generated. */ - stmt->previous = (ffestdStmt_) &ffestd_stmt_list_.first; - stmt->next = ffestd_stmt_list_.first; - stmt->next->previous = stmt; - stmt->previous->next = stmt; -#else - ffestd_stmt_append_ (stmt); -#endif - stmt->u.formatlabel.label = label; - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_); + ffestd_stmt_append_ (stmt); + stmt->u.formatlabel.label = label; } /* ffestd_labeldef_useless -- Generate "code" for useless label def @@ -1631,12 +1519,6 @@ ffestd_labeldef_format (ffelab label) void ffestd_labeldef_useless (ffelab label UNUSED) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "; useless_label_def %lu\n", ffelab_value (label)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R423A -- PRIVATE statement (in R422 derived-type statement) @@ -1648,13 +1530,6 @@ void ffestd_R423A () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* PRIVATE_derived_type\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R423B -- SEQUENCE statement (in R422 derived-type-stmt) @@ -1665,13 +1540,6 @@ void ffestd_R423B () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* SEQUENCE_derived_type\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R424 -- derived-TYPE-def statement @@ -1720,12 +1588,6 @@ ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name) void ffestd_R425 (bool ok) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "* END_TYPE %s\n", ffelex_token_text (ffestw_name (ffestw_stack_top ()))); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R519_start -- INTENT statement list begin @@ -2016,13 +1878,6 @@ void ffestd_R522 () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* SAVE_all\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R522start -- SAVE statement list begin @@ -2035,13 +1890,6 @@ void ffestd_R522start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* SAVE ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R522item_object -- SAVE statement for object-name @@ -2054,13 +1902,6 @@ void ffestd_R522item_object (ffelexToken name UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R522item_cblock -- SAVE statement for common-block-name @@ -2073,13 +1914,6 @@ void ffestd_R522item_cblock (ffelexToken name UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "/%s/,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R522finish -- SAVE statement list complete @@ -2092,13 +1926,6 @@ void ffestd_R522finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R524_start -- DIMENSION statement list begin @@ -2111,16 +1938,6 @@ void ffestd_R524_start (bool virtual UNUSED) { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (virtual) - fputs ("* VIRTUAL ", dmpout); /* V028. */ - else - fputs ("* DIMENSION ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R524_item -- DIMENSION statement for object-name @@ -2133,16 +1950,6 @@ void ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (ffelex_token_text (name), dmpout); - fputc ('(', dmpout); - ffestt_dimlist_dump (dims); - fputs ("),", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R524_finish -- DIMENSION statement list complete @@ -2155,13 +1962,6 @@ void ffestd_R524_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R525_start -- ALLOCATABLE statement list begin @@ -2365,13 +2165,6 @@ void ffestd_R537_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* PARAMETER (", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R537_item -- PARAMETER statement assignment @@ -2385,16 +2178,6 @@ void ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (dest); - fputc ('=', dmpout); - ffebld_dump (source); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R537_finish -- PARAMETER statement list complete @@ -2407,13 +2190,6 @@ void ffestd_R537_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R539 -- IMPLICIT NONE statement @@ -2426,13 +2202,6 @@ void ffestd_R539 () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* IMPLICIT_NONE\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R539start -- IMPLICIT statement @@ -2445,13 +2214,6 @@ void ffestd_R539start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* IMPLICIT ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R539item -- IMPLICIT statement specification (R540) @@ -2465,88 +2227,7 @@ ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED, ffelexToken kindt UNUSED, ffebld len UNUSED, ffelexToken lent UNUSED, ffesttImpList letters UNUSED) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - char *a; -#endif - ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - switch (type) - { - case FFESTP_typeINTEGER: - a = "INTEGER"; - break; - - case FFESTP_typeBYTE: - a = "BYTE"; - break; - - case FFESTP_typeWORD: - a = "WORD"; - break; - - case FFESTP_typeREAL: - a = "REAL"; - break; - - case FFESTP_typeCOMPLEX: - a = "COMPLEX"; - break; - - case FFESTP_typeLOGICAL: - a = "LOGICAL"; - break; - - case FFESTP_typeCHARACTER: - a = "CHARACTER"; - break; - - case FFESTP_typeDBLPRCSN: - a = "DOUBLE PRECISION"; - break; - - case FFESTP_typeDBLCMPLX: - a = "DOUBLE COMPLEX"; - break; - -#if FFESTR_F90 - case FFESTP_typeTYPE: - a = "TYPE"; - break; -#endif - - default: - assert (FALSE); - a = "?"; - break; - } - fprintf (dmpout, "%s(", a); - if (kindt != NULL) - { - fputs ("kind=", dmpout); - if (kind == NULL) - fputs (ffelex_token_text (kindt), dmpout); - else - ffebld_dump (kind); - if (lent != NULL) - fputc (',', dmpout); - } - if (lent != NULL) - { - fputs ("len=", dmpout); - if (len == NULL) - fputs (ffelex_token_text (lent), dmpout); - else - ffebld_dump (len); - } - fputs (")(", dmpout); - ffestt_implist_dump (letters); - fputs ("),", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R539finish -- IMPLICIT statement @@ -2559,13 +2240,6 @@ void ffestd_R539finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R542_start -- NAMELIST statement list begin @@ -2578,13 +2252,6 @@ void ffestd_R542_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* NAMELIST ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R542_item_nlist -- NAMELIST statement for group-name @@ -2597,13 +2264,6 @@ void ffestd_R542_item_nlist (ffelexToken name UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "/%s/", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R542_item_nitem -- NAMELIST statement for variable-name @@ -2616,13 +2276,6 @@ void ffestd_R542_item_nitem (ffelexToken name UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R542_finish -- NAMELIST statement list complete @@ -2635,13 +2288,6 @@ void ffestd_R542_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R544_start -- EQUIVALENCE statement list begin @@ -2656,13 +2302,6 @@ void ffestd_R544_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* EQUIVALENCE (", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } #endif @@ -2677,14 +2316,6 @@ void ffestd_R544_item (ffesttExprList exprlist) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffestt_exprlist_dump (exprlist); - fputs ("),", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } #endif @@ -2699,13 +2330,6 @@ void ffestd_R544_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } #endif @@ -2719,13 +2343,6 @@ void ffestd_R547_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* COMMON ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R547_item_object -- COMMON statement for object-name @@ -2739,20 +2356,6 @@ ffestd_R547_item_object (ffelexToken name UNUSED, ffesttDimList dims UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (ffelex_token_text (name), dmpout); - if (dims != NULL) - { - fputc ('(', dmpout); - ffestt_dimlist_dump (dims); - fputc (')', dmpout); - } - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R547_item_cblock -- COMMON statement for common-block-name @@ -2765,16 +2368,6 @@ void ffestd_R547_item_cblock (ffelexToken name UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (name == NULL) - fputs ("//,", dmpout); - else - fprintf (dmpout, "/%s/,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R547_finish -- COMMON statement list complete @@ -2787,13 +2380,6 @@ void ffestd_R547_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R620 -- ALLOCATE statement @@ -2809,18 +2395,6 @@ ffestd_R620 (ffesttExprList exprlist, ffebld stat) ffestd_check_simple_ (); ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("+ ALLOCATE (", dmpout); - ffestt_exprlist_dump (exprlist); - if (stat != NULL) - { - fputs (",stat=", dmpout); - ffebld_dump (stat); - } - fputs (")\n", dmpout); -#endif } /* ffestd_R624 -- NULLIFY statement @@ -2857,18 +2431,6 @@ ffestd_R625 (ffesttExprList exprlist, ffebld stat) ffestd_check_simple_ (); ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("+ DEALLOCATE (", dmpout); - ffestt_exprlist_dump (exprlist); - if (stat != NULL) - { - fputs (",stat=", dmpout); - ffebld_dump (stat); - } - fputs (")\n", dmpout); -#endif } #endif @@ -2881,22 +2443,15 @@ ffestd_R737A (ffebld dest, ffebld source) { ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R737A (dest, source); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R737A.pool = ffesta_output_pool; - stmt->u.R737A.dest = dest; - stmt->u.R737A.source = source; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + ffestdStmt_ stmt; + + stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R737A.pool = ffesta_output_pool; + stmt->u.R737A.dest = dest; + stmt->u.R737A.source = source; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R737B -- Assignment statement inside of WHERE @@ -2908,16 +2463,6 @@ void ffestd_R737B (ffebld dest, ffebld source) { ffestd_check_simple_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs ("+ let_inside_where ", dmpout); - ffebld_dump (dest); - fputs ("=", dmpout); - ffebld_dump (source); - fputc ('\n', dmpout); -#endif } /* ffestd_R738 -- Pointer assignment statement @@ -2932,15 +2477,6 @@ ffestd_R738 (ffebld dest, ffebld source) ffestd_check_simple_ (); ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("+ let_pointer ", dmpout); - ffebld_dump (dest); - fputs ("=>", dmpout); - ffebld_dump (source); - fputc ('\n', dmpout); -#endif } /* ffestd_R740 -- WHERE statement @@ -2955,16 +2491,6 @@ ffestd_R740 (ffebld expr) ffestd_check_simple_ (); ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("+ WHERE (", dmpout); - ffebld_dump (expr); - fputs (")\n", dmpout); - - ++ffestd_block_level_; - assert (ffestd_block_level_ > 0); -#endif } /* ffestd_R742 -- WHERE-construct statement @@ -2979,16 +2505,6 @@ ffestd_R742 (ffebld expr) ffestd_check_simple_ (); ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("+ WHERE_construct (", dmpout); - ffebld_dump (expr); - fputs (")\n", dmpout); - - ++ffestd_block_level_; - assert (ffestd_block_level_ > 0); -#endif } /* ffestd_R744 -- ELSE WHERE statement @@ -3032,24 +2548,17 @@ ffestd_R745 (bool ok) void ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R803 (expr); /* Don't bother with name. */ -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R803.pool = ffesta_output_pool; - stmt->u.R803.block = ffestw_use (ffestw_stack_top ()); - stmt->u.R803.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R803.pool = ffesta_output_pool; + stmt->u.R803.block = ffestw_use (ffestw_stack_top ()); + stmt->u.R803.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); ++ffestd_block_level_; assert (ffestd_block_level_ > 0); @@ -3060,24 +2569,17 @@ ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr) void ffestd_R804 (ffebld expr, ffelexToken name UNUSED) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R804 (expr); /* Don't bother with name. */ -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R804.pool = ffesta_output_pool; - stmt->u.R804.block = ffestw_use (ffestw_stack_top ()); - stmt->u.R804.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R804.pool = ffesta_output_pool; + stmt->u.R804.block = ffestw_use (ffestw_stack_top ()); + stmt->u.R804.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ELSE statement. */ @@ -3085,21 +2587,14 @@ ffestd_R804 (ffebld expr, ffelexToken name UNUSED) void ffestd_R805 (ffelexToken name UNUSED) { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R805 (); /* Don't bother with name. */ -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R805.block = ffestw_use (ffestw_stack_top ()); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R805.block = ffestw_use (ffestw_stack_top ()); } /* END IF statement. */ @@ -3107,19 +2602,12 @@ ffestd_R805 (ffelexToken name UNUSED) void ffestd_R806 (bool ok UNUSED) { -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R806 (); -#else - { - ffestdStmt_ stmt; + ffestdStmt_ stmt; - stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R806.block = ffestw_use (ffestw_stack_top ()); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R806.block = ffestw_use (ffestw_stack_top ()); --ffestd_block_level_; assert (ffestd_block_level_ >= 0); @@ -3134,23 +2622,16 @@ ffestd_R806 (bool ok UNUSED) void ffestd_R807 (ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R807 (expr); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R807.pool = ffesta_output_pool; - stmt->u.R807.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R807.pool = ffesta_output_pool; + stmt->u.R807.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); ++ffestd_block_level_; assert (ffestd_block_level_ > 0); @@ -3165,25 +2646,18 @@ ffestd_R807 (ffebld expr) void ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R809 (ffestw_stack_top (), expr); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R809.pool = ffesta_output_pool; - stmt->u.R809.block = ffestw_use (ffestw_stack_top ()); - stmt->u.R809.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R809.pool = ffesta_output_pool; + stmt->u.R809.block = ffestw_use (ffestw_stack_top ()); + stmt->u.R809.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); + malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool); ++ffestd_block_level_; assert (ffestd_block_level_ > 0); @@ -3200,24 +2674,17 @@ ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr) void ffestd_R810 (unsigned long casenum) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R810 (ffestw_stack_top (), casenum); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R810.pool = ffesta_output_pool; - stmt->u.R810.block = ffestw_stack_top (); - stmt->u.R810.casenum = casenum; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R810.pool = ffesta_output_pool; + stmt->u.R810.block = ffestw_stack_top (); + stmt->u.R810.casenum = casenum; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R811 -- End a SELECT @@ -3227,19 +2694,12 @@ ffestd_R810 (unsigned long casenum) void ffestd_R811 (bool ok UNUSED) { -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R811 (ffestw_stack_top ()); -#else - { - ffestdStmt_ stmt; + ffestdStmt_ stmt; - stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R811.block = ffestw_stack_top (); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R811.block = ffestw_stack_top (); --ffestd_block_level_; assert (ffestd_block_level_ >= 0); @@ -3257,33 +2717,25 @@ ffestd_R819A (ffelexToken construct_name UNUSED, ffelab label, ffebld end, ffelexToken end_token, ffebld incr, ffelexToken incr_token) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R819A (ffestw_stack_top (), label, var, start, end, incr, - incr_token); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R819A.pool = ffesta_output_pool; - stmt->u.R819A.block = ffestw_use (ffestw_stack_top ()); - stmt->u.R819A.label = label; - stmt->u.R819A.var = var; - stmt->u.R819A.start = start; - stmt->u.R819A.start_token = ffelex_token_use (start_token); - stmt->u.R819A.end = end; - stmt->u.R819A.end_token = ffelex_token_use (end_token); - stmt->u.R819A.incr = incr; - stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL - : ffelex_token_use (incr_token); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R819A.pool = ffesta_output_pool; + stmt->u.R819A.block = ffestw_use (ffestw_stack_top ()); + stmt->u.R819A.label = label; + stmt->u.R819A.var = var; + stmt->u.R819A.start = start; + stmt->u.R819A.start_token = ffelex_token_use (start_token); + stmt->u.R819A.end = end; + stmt->u.R819A.end_token = ffelex_token_use (end_token); + stmt->u.R819A.incr = incr; + stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL + : ffelex_token_use (incr_token); + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); ++ffestd_block_level_; assert (ffestd_block_level_ > 0); @@ -3299,25 +2751,18 @@ void ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label, ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R819B (ffestw_stack_top (), label, expr); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R819B.pool = ffesta_output_pool; - stmt->u.R819B.block = ffestw_use (ffestw_stack_top ()); - stmt->u.R819B.label = label; - stmt->u.R819B.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R819B.pool = ffesta_output_pool; + stmt->u.R819B.block = ffestw_use (ffestw_stack_top ()); + stmt->u.R819B.label = label; + stmt->u.R819B.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); ++ffestd_block_level_; assert (ffestd_block_level_ > 0); @@ -3337,20 +2782,13 @@ ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label, void ffestd_R825 (ffelexToken name UNUSED) { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R825 (); -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); } /* ffestd_R834 -- CYCLE statement @@ -3362,21 +2800,14 @@ ffestd_R825 (ffelexToken name UNUSED) void ffestd_R834 (ffestw block) { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R834 (block); -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R834.block = block; - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R834.block = block; } /* ffestd_R835 -- EXIT statement @@ -3388,21 +2819,14 @@ ffestd_R834 (ffestw block) void ffestd_R835 (ffestw block) { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R835 (block); -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R835.block = block; - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R835.block = block; } /* ffestd_R836 -- GOTO statement @@ -3415,21 +2839,14 @@ ffestd_R835 (ffestw block) void ffestd_R836 (ffelab label) { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R836 (label); -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R836.label = label; - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R836.label = label; if (ffestd_block_level_ == 0) ffestd_is_reachable_ = FALSE; @@ -3445,25 +2862,18 @@ ffestd_R836 (ffelab label) void ffestd_R837 (ffelab *labels, int count, ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R837 (labels, count, expr); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R837.pool = ffesta_output_pool; - stmt->u.R837.labels = labels; - stmt->u.R837.count = count; - stmt->u.R837.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R837.pool = ffesta_output_pool; + stmt->u.R837.labels = labels; + stmt->u.R837.count = count; + stmt->u.R837.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R838 -- ASSIGN statement @@ -3478,24 +2888,17 @@ ffestd_R837 (ffelab *labels, int count, ffebld expr) void ffestd_R838 (ffelab label, ffebld target) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R838 (label, target); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R838.pool = ffesta_output_pool; - stmt->u.R838.label = label; - stmt->u.R838.target = target; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R838.pool = ffesta_output_pool; + stmt->u.R838.label = label; + stmt->u.R838.target = target; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R839 -- Assigned GOTO statement @@ -3508,23 +2911,16 @@ ffestd_R838 (ffelab label, ffebld target) void ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R839 (target); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R839.pool = ffesta_output_pool; - stmt->u.R839.target = target; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R839.pool = ffesta_output_pool; + stmt->u.R839.target = target; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); if (ffestd_block_level_ == 0) ffestd_is_reachable_ = FALSE; @@ -3539,26 +2935,19 @@ ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED) void ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R840 (expr, neg, zero, pos); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R840.pool = ffesta_output_pool; - stmt->u.R840.expr = expr; - stmt->u.R840.neg = neg; - stmt->u.R840.zero = zero; - stmt->u.R840.pos = pos; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R840.pool = ffesta_output_pool; + stmt->u.R840.expr = expr; + stmt->u.R840.neg = neg; + stmt->u.R840.zero = zero; + stmt->u.R840.pos = pos; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); if (ffestd_block_level_ == 0) ffestd_is_reachable_ = FALSE; @@ -3571,20 +2960,13 @@ ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos) void ffestd_R841 (bool in_where UNUSED) { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R841 (); -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); } /* ffestd_R842 -- STOP statement @@ -3594,36 +2976,29 @@ ffestd_R841 (bool in_where UNUSED) void ffestd_R842 (ffebld expr) { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R842 (expr); -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - if (ffesta_outpooldisp () == FFESTA_pooldispPRESERVE) - { - /* This is a "spurious" (automatically-generated) STOP - that follows a previous STOP or other statement. - Make sure we don't have an expression in the pool, - and then mark that the pool has already been killed. */ - assert (expr == NULL); - stmt->u.R842.pool = NULL; - stmt->u.R842.expr = NULL; - } - else - { - stmt->u.R842.pool = ffesta_output_pool; - stmt->u.R842.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + if (ffesta_outpooldisp () == FFESTA_pooldispPRESERVE) + { + /* This is a "spurious" (automatically-generated) STOP + that follows a previous STOP or other statement. + Make sure we don't have an expression in the pool, + and then mark that the pool has already been killed. */ + assert (expr == NULL); + stmt->u.R842.pool = NULL; + stmt->u.R842.expr = NULL; + } + else + { + stmt->u.R842.pool = ffesta_output_pool; + stmt->u.R842.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); + } if (ffestd_block_level_ == 0) ffestd_is_reachable_ = FALSE; @@ -3639,23 +3014,16 @@ ffestd_R842 (ffebld expr) void ffestd_R843 (ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R843 (expr); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R843.pool = ffesta_output_pool; - stmt->u.R843.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R843.pool = ffesta_output_pool; + stmt->u.R843.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R904 -- OPEN statement @@ -3667,9 +3035,10 @@ ffestd_R843 (ffebld expr) void ffestd_R904 () { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) \ (ffestp_file.open.open_spec[something].kw_or_val_present) @@ -3703,23 +3072,13 @@ ffestd_R904 () } #undef specified -#endif -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R904 (&ffestp_file.open); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R904.pool = ffesta_output_pool; - stmt->u.R904.params = ffestd_subr_copy_open_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R904.pool = ffesta_output_pool; + stmt->u.R904.params = ffestd_subr_copy_open_ (); + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R907 -- CLOSE statement @@ -3731,23 +3090,16 @@ ffestd_R904 () void ffestd_R907 () { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R907 (&ffestp_file.close); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R907.pool = ffesta_output_pool; - stmt->u.R907.params = ffestd_subr_copy_close_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R907.pool = ffesta_output_pool; + stmt->u.R907.params = ffestd_subr_copy_close_ (); + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R909_start -- READ(...) statement list begin @@ -3761,9 +3113,10 @@ void ffestd_R909_start (bool only_format, ffestvUnit unit, ffestvFormat format, bool rec, bool key) { + ffestdStmt_ stmt; + ffestd_check_start_ (); -#if FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) \ (ffestp_file.read.read_spec[something].kw_or_val_present) @@ -3784,30 +3137,20 @@ ffestd_R909_start (bool only_format, ffestvUnit unit, } #undef specified -#endif -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R909_start (&ffestp_file.read, only_format, unit, format, rec, key); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R909.pool = ffesta_output_pool; - stmt->u.R909.params = ffestd_subr_copy_read_ (); - stmt->u.R909.only_format = only_format; - stmt->u.R909.unit = unit; - stmt->u.R909.format = format; - stmt->u.R909.rec = rec; - stmt->u.R909.key = key; - stmt->u.R909.list = NULL; - ffestd_expr_list_ = &stmt->u.R909.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R909.pool = ffesta_output_pool; + stmt->u.R909.params = ffestd_subr_copy_read_ (); + stmt->u.R909.only_format = only_format; + stmt->u.R909.unit = unit; + stmt->u.R909.format = format; + stmt->u.R909.rec = rec; + stmt->u.R909.key = key; + stmt->u.R909.list = NULL; + ffestd_expr_list_ = &stmt->u.R909.list; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R909_item -- READ statement i/o item @@ -3819,23 +3162,18 @@ ffestd_R909_start (bool only_format, ffestvUnit unit, void ffestd_R909_item (ffebld expr, ffelexToken expr_token) { + ffestdExprItem_ item; + ffestd_check_item_ (); -#if FFECOM_ONEPASS - ffeste_R909_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - item->token = ffelex_token_use (expr_token); - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif + item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, + "ffestdExprItem_", sizeof (*item)); + + item->next = NULL; + item->expr = expr; + item->token = ffelex_token_use (expr_token); + *ffestd_expr_list_ = item; + ffestd_expr_list_ = &item->next; } /* ffestd_R909_finish -- READ statement list complete @@ -3848,12 +3186,6 @@ void ffestd_R909_finish () { ffestd_check_finish_ (); - -#if FFECOM_ONEPASS - ffeste_R909_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif } /* ffestd_R910_start -- WRITE(...) statement list begin @@ -3866,9 +3198,10 @@ ffestd_R909_finish () void ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec) { + ffestdStmt_ stmt; + ffestd_check_start_ (); -#if FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) \ (ffestp_file.write.write_spec[something].kw_or_val_present) @@ -3883,28 +3216,18 @@ ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec) } #undef specified -#endif -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R910_start (&ffestp_file.write, unit, format, rec); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R910.pool = ffesta_output_pool; - stmt->u.R910.params = ffestd_subr_copy_write_ (); - stmt->u.R910.unit = unit; - stmt->u.R910.format = format; - stmt->u.R910.rec = rec; - stmt->u.R910.list = NULL; - ffestd_expr_list_ = &stmt->u.R910.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R910.pool = ffesta_output_pool; + stmt->u.R910.params = ffestd_subr_copy_write_ (); + stmt->u.R910.unit = unit; + stmt->u.R910.format = format; + stmt->u.R910.rec = rec; + stmt->u.R910.list = NULL; + ffestd_expr_list_ = &stmt->u.R910.list; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R910_item -- WRITE statement i/o item @@ -3916,23 +3239,18 @@ ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec) void ffestd_R910_item (ffebld expr, ffelexToken expr_token) { + ffestdExprItem_ item; + ffestd_check_item_ (); -#if FFECOM_ONEPASS - ffeste_R910_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - item->token = ffelex_token_use (expr_token); - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif + item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, + "ffestdExprItem_", sizeof (*item)); + + item->next = NULL; + item->expr = expr; + item->token = ffelex_token_use (expr_token); + *ffestd_expr_list_ = item; + ffestd_expr_list_ = &item->next; } /* ffestd_R910_finish -- WRITE statement list complete @@ -3945,12 +3263,6 @@ void ffestd_R910_finish () { ffestd_check_finish_ (); - -#if FFECOM_ONEPASS - ffeste_R910_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif } /* ffestd_R911_start -- PRINT statement list begin @@ -3963,26 +3275,19 @@ ffestd_R910_finish () void ffestd_R911_start (ffestvFormat format) { + ffestdStmt_ stmt; + ffestd_check_start_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R911_start (&ffestp_file.print, format); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R911.pool = ffesta_output_pool; - stmt->u.R911.params = ffestd_subr_copy_print_ (); - stmt->u.R911.format = format; - stmt->u.R911.list = NULL; - ffestd_expr_list_ = &stmt->u.R911.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R911.pool = ffesta_output_pool; + stmt->u.R911.params = ffestd_subr_copy_print_ (); + stmt->u.R911.format = format; + stmt->u.R911.list = NULL; + ffestd_expr_list_ = &stmt->u.R911.list; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R911_item -- PRINT statement i/o item @@ -3994,23 +3299,18 @@ ffestd_R911_start (ffestvFormat format) void ffestd_R911_item (ffebld expr, ffelexToken expr_token) { + ffestdExprItem_ item; + ffestd_check_item_ (); -#if FFECOM_ONEPASS - ffeste_R911_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - item->token = ffelex_token_use (expr_token); - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif + item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, + "ffestdExprItem_", sizeof (*item)); + + item->next = NULL; + item->expr = expr; + item->token = ffelex_token_use (expr_token); + *ffestd_expr_list_ = item; + ffestd_expr_list_ = &item->next; } /* ffestd_R911_finish -- PRINT statement list complete @@ -4023,12 +3323,6 @@ void ffestd_R911_finish () { ffestd_check_finish_ (); - -#if FFECOM_ONEPASS - ffeste_R911_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif } /* ffestd_R919 -- BACKSPACE statement @@ -4040,23 +3334,16 @@ ffestd_R911_finish () void ffestd_R919 () { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R919 (&ffestp_file.beru); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R919.pool = ffesta_output_pool; - stmt->u.R919.params = ffestd_subr_copy_beru_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R919.pool = ffesta_output_pool; + stmt->u.R919.params = ffestd_subr_copy_beru_ (); + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R920 -- ENDFILE statement @@ -4068,23 +3355,16 @@ ffestd_R919 () void ffestd_R920 () { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R920 (&ffestp_file.beru); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R920.pool = ffesta_output_pool; - stmt->u.R920.params = ffestd_subr_copy_beru_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R920.pool = ffesta_output_pool; + stmt->u.R920.params = ffestd_subr_copy_beru_ (); + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R921 -- REWIND statement @@ -4096,23 +3376,16 @@ ffestd_R920 () void ffestd_R921 () { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R921 (&ffestp_file.beru); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R921.pool = ffesta_output_pool; - stmt->u.R921.params = ffestd_subr_copy_beru_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R921.pool = ffesta_output_pool; + stmt->u.R921.params = ffestd_subr_copy_beru_ (); + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R923A -- INQUIRE statement (non-IOLENGTH version) @@ -4124,9 +3397,10 @@ ffestd_R921 () void ffestd_R923A (bool by_file) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetGCC #define specified(something) \ (ffestp_file.inquire.inquire_spec[something].kw_or_val_present) @@ -4151,24 +3425,14 @@ ffestd_R923A (bool by_file) } #undef specified -#endif -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R923A (&ffestp_file.inquire, by_file); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R923A.pool = ffesta_output_pool; - stmt->u.R923A.params = ffestd_subr_copy_inquire_ (); - stmt->u.R923A.by_file = by_file; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R923A.pool = ffesta_output_pool; + stmt->u.R923A.params = ffestd_subr_copy_inquire_ (); + stmt->u.R923A.by_file = by_file; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin @@ -4181,25 +3445,18 @@ ffestd_R923A (bool by_file) void ffestd_R923B_start () { + ffestdStmt_ stmt; + ffestd_check_start_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R923B_start (&ffestp_file.inquire); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R923B.pool = ffesta_output_pool; - stmt->u.R923B.params = ffestd_subr_copy_inquire_ (); - stmt->u.R923B.list = NULL; - ffestd_expr_list_ = &stmt->u.R923B.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R923B.pool = ffesta_output_pool; + stmt->u.R923B.params = ffestd_subr_copy_inquire_ (); + stmt->u.R923B.list = NULL; + ffestd_expr_list_ = &stmt->u.R923B.list; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R923B_item -- INQUIRE statement i/o item @@ -4211,22 +3468,17 @@ ffestd_R923B_start () void ffestd_R923B_item (ffebld expr) { + ffestdExprItem_ item; + ffestd_check_item_ (); -#if FFECOM_ONEPASS - ffeste_R923B_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif + item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, + "ffestdExprItem_", sizeof (*item)); + + item->next = NULL; + item->expr = expr; + *ffestd_expr_list_ = item; + ffestd_expr_list_ = &item->next; } /* ffestd_R923B_finish -- INQUIRE statement list complete @@ -4239,12 +3491,6 @@ void ffestd_R923B_finish () { ffestd_check_finish_ (); - -#if FFECOM_ONEPASS - ffeste_R923B_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif } /* ffestd_R1001 -- FORMAT statement @@ -4256,6 +3502,7 @@ ffestd_R1001 (ffesttFormatList f) { ffestsHolder str; ffests s = &str; + ffestdStmt_ stmt; ffestd_check_simple_ (); @@ -4267,35 +3514,9 @@ ffestd_R1001 (ffesttFormatList f) ffestd_R1001dump_ (s, f); /* Build the string in s. */ ffests_putc (s, ')'); -#if FFECOM_ONEPASS - ffeste_R1001 (s); - ffests_kill (s); /* Kill the string in s. */ -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_); -#if 0 - /* Don't bother with this. After all, things like cilists also are - declared midway through code-generation. Perhaps the only problems - the gcc back end has with midway declarations are with stack vars, - maybe only with vars that can be put in registers. Unless/until the - need is established, handle FORMAT just like cilists and others; at - that point, they'd likely *all* have to be fixed, which would be - very painful anyway. */ - /* Insert FORMAT statement just after the first item on the - statement list, which must be a FORMAT label, which see. */ - assert (ffestd_stmt_list_.first->id == FFESTD_stmtidFORMATLABEL_); - stmt->previous = ffestd_stmt_list_.first; - stmt->next = ffestd_stmt_list_.first->next; - stmt->next->previous = stmt; - stmt->previous->next = stmt; -#else - ffestd_stmt_append_ (stmt); -#endif - stmt->u.R1001.str = str; - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_); + ffestd_stmt_append_ (stmt); + stmt->u.R1001.str = str; ffestd_label_formatdef_ = NULL; } @@ -4323,13 +3544,7 @@ ffestd_R1001dump_ (ffests s, ffesttFormatList list) break; case FFESTP_formattypeB: -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffestd_R1001dump_1005_3_ (s, next, "B"); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); -#else -#error -#endif break; case FFESTP_formattypeO: @@ -4349,13 +3564,7 @@ ffestd_R1001dump_ (ffests s, ffesttFormatList list) break; case FFESTP_formattypeEN: -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffestd_R1001dump_1005_5_ (s, next, "EN"); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); -#else -#error -#endif break; case FFESTP_formattypeG: @@ -4375,13 +3584,7 @@ ffestd_R1001dump_ (ffests s, ffesttFormatList list) break; case FFESTP_formattypeQ: -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffestd_R1001dump_1010_1_ (s, next, "Q"); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_R1001error_ (next); -#else -#error -#endif break; case FFESTP_formattypeDOLLAR: @@ -4852,16 +4055,6 @@ ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED) ffe_set_is_saveall (TRUE); /* Main program always has implicit SAVE. */ ffestw_set_sym (ffestw_stack_top (), s); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (name == NULL) - fputs ("< PROGRAM_unnamed\n", dmpout); - else - fprintf (dmpout, "< PROGRAM %s\n", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1103 -- End a PROGRAM @@ -4871,6 +4064,8 @@ ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED) void ffestd_R1103 (bool ok UNUSED) { + ffestdStmt_ stmt; + assert (ffestd_block_level_ == 0); if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_) @@ -4879,16 +4074,8 @@ ffestd_R1103 (bool ok UNUSED) if (ffestw_state (ffestw_stack_top ()) != FFESTV_statePROGRAM5) ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */ -#if FFECOM_ONEPASS - ffeste_R1103 (); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_); - ffestd_stmt_append_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_); + ffestd_stmt_append_ (stmt); } /* ffestd_R1105 -- MODULE statement @@ -5017,16 +4204,6 @@ ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED) ffecom_notify_primary_entry (s); ffestw_set_sym (ffestw_stack_top (), s); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (name == NULL) - fputs ("< BLOCK_DATA_unnamed\n", dmpout); - else - fprintf (dmpout, "< BLOCK_DATA %s\n", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1112 -- End a BLOCK DATA @@ -5036,6 +4213,8 @@ ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED) void ffestd_R1112 (bool ok UNUSED) { + ffestdStmt_ stmt; + assert (ffestd_block_level_ == 0); /* Generate any return-like code here (not likely for BLOCK DATA!). */ @@ -5043,16 +4222,8 @@ ffestd_R1112 (bool ok UNUSED) if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateBLOCKDATA5) ffestd_subr_labels_ (TRUE); /* Handle any undefined labels. */ -#if FFECOM_ONEPASS - ffeste_R1112 (); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_); - ffestd_stmt_append_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_); + ffestd_stmt_append_ (stmt); } /* ffestd_R1202 -- INTERFACE statement @@ -5249,13 +4420,6 @@ void ffestd_R1207_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* EXTERNAL (", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1207_item -- EXTERNAL statement for name @@ -5269,13 +4433,6 @@ ffestd_R1207_item (ffelexToken name) { ffestd_check_item_ (); assert (name != NULL); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1207_finish -- EXTERNAL statement list complete @@ -5288,13 +4445,6 @@ void ffestd_R1207_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1208_start -- INTRINSIC statement list begin @@ -5307,13 +4457,6 @@ void ffestd_R1208_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* INTRINSIC (", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1208_item -- INTRINSIC statement for name @@ -5327,13 +4470,6 @@ ffestd_R1208_item (ffelexToken name) { ffestd_check_item_ (); assert (name != NULL); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1208_finish -- INTRINSIC statement list complete @@ -5346,13 +4482,6 @@ void ffestd_R1208_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1212 -- CALL statement @@ -5364,23 +4493,16 @@ ffestd_R1208_finish () void ffestd_R1212 (ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R1212 (expr); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R1212.pool = ffesta_output_pool; - stmt->u.R1212.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R1212.pool = ffesta_output_pool; + stmt->u.R1212.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } /* ffestd_R1213 -- Defined assignment statement @@ -5396,15 +4518,6 @@ ffestd_R1213 (ffebld dest, ffebld source) ffestd_check_simple_ (); ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("+ let_defined ", dmpout); - ffebld_dump (dest); - fputs ("=", dmpout); - ffebld_dump (source); - fputc ('\n', dmpout); -#endif } #endif @@ -5427,10 +4540,6 @@ ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED, bool recursive UNUSED, ffelexToken result UNUSED, bool separate_result UNUSED) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - char *a; -#endif - assert (ffestd_block_level_ == 0); ffestd_is_reachable_ = TRUE; @@ -5438,97 +4547,6 @@ ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED, ffecom_notify_primary_entry (s); ffestw_set_sym (ffestw_stack_top (), s); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - switch (type) - { - case FFESTP_typeINTEGER: - a = "INTEGER"; - break; - - case FFESTP_typeBYTE: - a = "BYTE"; - break; - - case FFESTP_typeWORD: - a = "WORD"; - break; - - case FFESTP_typeREAL: - a = "REAL"; - break; - - case FFESTP_typeCOMPLEX: - a = "COMPLEX"; - break; - - case FFESTP_typeLOGICAL: - a = "LOGICAL"; - break; - - case FFESTP_typeCHARACTER: - a = "CHARACTER"; - break; - - case FFESTP_typeDBLPRCSN: - a = "DOUBLE PRECISION"; - break; - - case FFESTP_typeDBLCMPLX: - a = "DOUBLE COMPLEX"; - break; - -#if FFESTR_F90 - case FFESTP_typeTYPE: - a = "TYPE"; - break; -#endif - - case FFESTP_typeNone: - a = ""; - break; - - default: - assert (FALSE); - a = "?"; - break; - } - fprintf (dmpout, "< FUNCTION %s ", ffelex_token_text (funcname)); - if (recursive) - fputs ("RECURSIVE ", dmpout); - fprintf (dmpout, "%s(", a); - if (kindt != NULL) - { - fputs ("kind=", dmpout); - if (kind == NULL) - fputs (ffelex_token_text (kindt), dmpout); - else - ffebld_dump (kind); - if (lent != NULL) - fputc (',', dmpout); - } - if (lent != NULL) - { - fputs ("len=", dmpout); - if (len == NULL) - fputs (ffelex_token_text (lent), dmpout); - else - ffebld_dump (len); - } - fprintf (dmpout, ")"); - if (args != NULL) - { - fputs (" (", dmpout); - ffestt_tokenlist_dump (args); - fputc (')', dmpout); - } - if (result != NULL) - fprintf (dmpout, " result(%s)", ffelex_token_text (result)); - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1221 -- End a FUNCTION @@ -5538,6 +4556,8 @@ ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED, void ffestd_R1221 (bool ok UNUSED) { + ffestdStmt_ stmt; + assert (ffestd_block_level_ == 0); if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_) @@ -5546,16 +4566,8 @@ ffestd_R1221 (bool ok UNUSED) if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateFUNCTION5) ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */ -#if FFECOM_ONEPASS - ffeste_R1221 (); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_); - ffestd_stmt_append_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_); + ffestd_stmt_append_ (stmt); } /* ffestd_R1223 -- SUBROUTINE statement @@ -5580,22 +4592,6 @@ ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED, ffecom_notify_primary_entry (s); ffestw_set_sym (ffestw_stack_top (), s); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "< SUBROUTINE %s ", ffelex_token_text (subrname)); - if (recursive) - fputs ("recursive ", dmpout); - if (args != NULL) - { - fputc ('(', dmpout); - ffestt_tokenlist_dump (args); - fputc (')', dmpout); - } - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1225 -- End a SUBROUTINE @@ -5605,6 +4601,8 @@ ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED, void ffestd_R1225 (bool ok UNUSED) { + ffestdStmt_ stmt; + assert (ffestd_block_level_ == 0); if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_) @@ -5613,16 +4611,8 @@ ffestd_R1225 (bool ok UNUSED) if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateSUBROUTINE5) ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */ -#if FFECOM_ONEPASS - ffeste_R1225 (); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_); - ffestd_stmt_append_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_); + ffestd_stmt_append_ (stmt); } /* ffestd_R1226 -- ENTRY statement @@ -5637,10 +4627,6 @@ ffestd_R1226 (ffesymbol entry) { ffestd_check_simple_ (); -#if (FFECOM_targetCURRENT == FFECOM_targetFFE) || FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R1226 (entry); -#else if (!ffesta_seen_first_exec || ffecom_2pass_advise_entrypoint (entry)) { ffestdStmt_ stmt; @@ -5651,7 +4637,6 @@ ffestd_R1226 (ffesymbol entry) stmt->u.R1226.entry = entry; stmt->u.R1226.entrynum = ++ffestd_2pass_entrypoints_; } -#endif ffestd_is_reachable_ = TRUE; } @@ -5666,24 +4651,17 @@ ffestd_R1226 (ffesymbol entry) void ffestd_R1227 (ffebld expr) { + ffestdStmt_ stmt; + ffestd_check_simple_ (); -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R1227 (ffestw_stack_top (), expr); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.R1227.pool = ffesta_output_pool; - stmt->u.R1227.block = ffestw_stack_top (); - stmt->u.R1227.expr = expr; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); + stmt->u.R1227.pool = ffesta_output_pool; + stmt->u.R1227.block = ffestw_stack_top (); + stmt->u.R1227.expr = expr; + ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); if (ffestd_block_level_ == 0) ffestd_is_reachable_ = FALSE; @@ -5732,12 +4710,6 @@ void ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED) { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_R1229_finish -- STMTFUNCTION statement list complete @@ -5761,9 +4733,6 @@ ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED) void ffestd_R1229_finish (ffesymbol s) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld args = ffesymbol_dummyargs (s); -#endif ffebld expr = ffesymbol_sfexpr (s); ffestd_check_finish_ (); @@ -5771,37 +4740,9 @@ ffestd_R1229_finish (ffesymbol s) if (expr == NULL) return; /* Nothing to do, definition didn't work. */ -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "* stmtfunction %s(", ffesymbol_text (s)); - for (; args != NULL; args = ffebld_trail (args)) - fprintf (dmpout, "%s,", ffesymbol_text (ffebld_symter (ffebld_head (args)))); - fputs (")=", dmpout); - ffebld_dump (expr); - fputc ('\n', dmpout); -#if 0 /* Normally no need to preserve the - expression. */ - ffesymbol_set_sfexpr (s, NULL); /* Except expr.c sees NULL - as recursive reference! - So until we can use something - convenient, like a "permanent" - expression, don't worry about - wasting some memory in the - stand-alone FFE. */ -#else - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); -#endif -#elif FFECOM_targetCURRENT == FFECOM_targetGCC /* With gcc, cannot do anything here, because the backend hasn't even (necessarily) been notified that we're compiling a program unit! */ - -#if 0 /* Must preserve the expression for gcc. */ - ffesymbol_set_sfexpr (s, NULL); -#else ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); -#endif -#else -#error -#endif } /* ffestd_S3P4 -- INCLUDE line @@ -5852,17 +4793,7 @@ void ffestd_V003_start (ffelexToken structure_name) { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (structure_name == NULL) - fputs ("* STRUCTURE_unnamed ", dmpout); - else - fprintf (dmpout, "* STRUCTURE %s ", ffelex_token_text (structure_name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#else -#error -#endif } /* ffestd_V003_item -- STRUCTURE statement for object-name @@ -5875,20 +4806,6 @@ void ffestd_V003_item (ffelexToken name, ffesttDimList dims) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (ffelex_token_text (name), dmpout); - if (dims != NULL) - { - fputc ('(', dmpout); - ffestt_dimlist_dump (dims); - fputc (')', dmpout); - } - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V003_finish -- STRUCTURE statement list complete @@ -5901,13 +4818,6 @@ void ffestd_V003_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V004 -- End a STRUCTURE @@ -5917,12 +4827,6 @@ ffestd_V003_finish () void ffestd_V004 (bool ok) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* END_STRUCTURE\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V009 -- UNION statement @@ -5933,13 +4837,6 @@ void ffestd_V009 () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* UNION\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V010 -- End a UNION @@ -5949,12 +4846,6 @@ ffestd_V009 () void ffestd_V010 (bool ok) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* END_UNION\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V012 -- MAP statement @@ -5965,13 +4856,6 @@ void ffestd_V012 () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* MAP\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V013 -- End a MAP @@ -5981,12 +4865,6 @@ ffestd_V012 () void ffestd_V013 (bool ok) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* END_MAP\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } #endif @@ -6000,14 +4878,6 @@ void ffestd_V014_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* VOLATILE (", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - ffestd_subr_vxt_ (); -#else -#error -#endif } /* ffestd_V014_item_object -- VOLATILE statement for object-name @@ -6020,13 +4890,6 @@ void ffestd_V014_item_object (ffelexToken name UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V014_item_cblock -- VOLATILE statement for common-block-name @@ -6039,13 +4902,6 @@ void ffestd_V014_item_cblock (ffelexToken name UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "/%s/,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V014_finish -- VOLATILE statement list complete @@ -6058,13 +4914,6 @@ void ffestd_V014_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V016_start -- RECORD statement list begin @@ -6078,14 +4927,6 @@ void ffestd_V016_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* RECORD ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - ffestd_subr_vxt_ (); -#else -#error -#endif } /* ffestd_V016_item_structure -- RECORD statement for common-block-name @@ -6098,13 +4939,6 @@ void ffestd_V016_item_structure (ffelexToken name) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "/%s/,", ffelex_token_text (name)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V016_item_object -- RECORD statement for object-name @@ -6117,20 +4951,6 @@ void ffestd_V016_item_object (ffelexToken name, ffesttDimList dims) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (ffelex_token_text (name), dmpout); - if (dims != NULL) - { - fputc ('(', dmpout); - ffestt_dimlist_dump (dims); - fputc (')', dmpout); - } - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V016_finish -- RECORD statement list complete @@ -6143,13 +4963,6 @@ void ffestd_V016_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V018_start -- REWRITE(...) statement list begin @@ -6163,32 +4976,7 @@ void ffestd_V018_start (ffestvFormat format) { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V018_start (&ffestp_file.rewrite, format); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV018_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V018.pool = ffesta_output_pool; - stmt->u.V018.params = ffestd_subr_copy_rewrite_ (); - stmt->u.V018.format = format; - stmt->u.V018.list = NULL; - ffestd_expr_list_ = &stmt->u.V018.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V018_item -- REWRITE statement i/o item @@ -6201,27 +4989,6 @@ void ffestd_V018_item (ffebld expr) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V018_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V018_finish -- REWRITE statement list complete @@ -6234,18 +5001,6 @@ void ffestd_V018_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V018_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V019_start -- ACCEPT statement list begin @@ -6259,32 +5014,7 @@ void ffestd_V019_start (ffestvFormat format) { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V019_start (&ffestp_file.accept, format); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV019_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V019.pool = ffesta_output_pool; - stmt->u.V019.params = ffestd_subr_copy_accept_ (); - stmt->u.V019.format = format; - stmt->u.V019.list = NULL; - ffestd_expr_list_ = &stmt->u.V019.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V019_item -- ACCEPT statement i/o item @@ -6297,27 +5027,6 @@ void ffestd_V019_item (ffebld expr) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V019_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V019_finish -- ACCEPT statement list complete @@ -6330,18 +5039,6 @@ void ffestd_V019_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V019_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } #endif @@ -6356,32 +5053,7 @@ void ffestd_V020_start (ffestvFormat format UNUSED) { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V020_start (&ffestp_file.type, format); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV020_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V020.pool = ffesta_output_pool; - stmt->u.V020.params = ffestd_subr_copy_type_ (); - stmt->u.V020.format = format; - stmt->u.V020.list = NULL; - ffestd_expr_list_ = &stmt->u.V020.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V020_item -- TYPE statement i/o item @@ -6394,27 +5066,6 @@ void ffestd_V020_item (ffebld expr UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V020_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V020_finish -- TYPE statement list complete @@ -6427,18 +5078,6 @@ void ffestd_V020_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V020_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V021 -- DELETE statement @@ -6452,29 +5091,7 @@ void ffestd_V021 () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V021 (&ffestp_file.delete); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV021_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V021.pool = ffesta_output_pool; - stmt->u.V021.params = ffestd_subr_copy_delete_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V022 -- UNLOCK statement @@ -6487,29 +5104,7 @@ void ffestd_V022 () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V022 (&ffestp_file.beru); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV022_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V022.pool = ffesta_output_pool; - stmt->u.V022.params = ffestd_subr_copy_beru_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V023_start -- ENCODE(...) statement list begin @@ -6523,31 +5118,7 @@ void ffestd_V023_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V023_start (&ffestp_file.vxtcode); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV023_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V023.pool = ffesta_output_pool; - stmt->u.V023.params = ffestd_subr_copy_vxtcode_ (); - stmt->u.V023.list = NULL; - ffestd_expr_list_ = &stmt->u.V023.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V023_item -- ENCODE statement i/o item @@ -6560,27 +5131,6 @@ void ffestd_V023_item (ffebld expr) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V023_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V023_finish -- ENCODE statement list complete @@ -6593,18 +5143,6 @@ void ffestd_V023_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V023_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V024_start -- DECODE(...) statement list begin @@ -6618,31 +5156,7 @@ void ffestd_V024_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V024_start (&ffestp_file.vxtcode); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV024_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V024.pool = ffesta_output_pool; - stmt->u.V024.params = ffestd_subr_copy_vxtcode_ (); - stmt->u.V024.list = NULL; - ffestd_expr_list_ = &stmt->u.V024.list; - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V024_item -- DECODE statement i/o item @@ -6655,27 +5169,6 @@ void ffestd_V024_item (ffebld expr) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V024_item (expr); -#else - { - ffestdExprItem_ item - = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", - sizeof (*item)); - - item->next = NULL; - item->expr = expr; - *ffestd_expr_list_ = item; - ffestd_expr_list_ = &item->next; - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V024_finish -- DECODE statement list complete @@ -6688,18 +5181,6 @@ void ffestd_V024_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V024_finish (); -#else - /* Nothing to do, it's implicit. */ -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V025_start -- DEFINEFILE statement list begin @@ -6713,27 +5194,7 @@ void ffestd_V025_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V025_start (); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV025start_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } /* ffestd_V025_item -- DEFINE FILE statement item @@ -6747,27 +5208,6 @@ void ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V025_item (u, m, n, asv); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV025item_); - ffestd_stmt_append_ (stmt); - stmt->u.V025item.u = u; - stmt->u.V025item.m = m; - stmt->u.V025item.n = n; - stmt->u.V025item.asv = asv; - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V025_finish -- DEFINE FILE statement list complete @@ -6780,24 +5220,6 @@ void ffestd_V025_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffeste_V025_finish (); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV025finish_); - stmt->u.V025finish.pool = ffesta_output_pool; - ffestd_stmt_append_ (stmt); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC -#endif } /* ffestd_V026 -- FIND statement @@ -6810,29 +5232,7 @@ void ffestd_V026 () { ffestd_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_V026 (&ffestp_file.find); -#else - { - ffestdStmt_ stmt; - - stmt = ffestd_stmt_new_ (FFESTD_stmtidV026_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - stmt->u.V026.pool = ffesta_output_pool; - stmt->u.V026.params = ffestd_subr_copy_find_ (); - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - } -#endif - -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif } #endif @@ -6846,14 +5246,7 @@ void ffestd_V027_start () { ffestd_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* PARAMETER_vxt ", dmpout); -#else -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffestd_subr_vxt_ (); -#endif -#endif } /* ffestd_V027_item -- VXT PARAMETER statement assignment @@ -6867,16 +5260,6 @@ void ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED) { ffestd_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs (ffelex_token_text (dest_token), dmpout); - fputc ('=', dmpout); - ffebld_dump (source); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffestd_V027_finish -- VXT PARAMETER statement list complete @@ -6889,13 +5272,6 @@ void ffestd_V027_finish () { ffestd_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* Any executable statement. */ @@ -6903,18 +5279,11 @@ ffestd_V027_finish () void ffestd_any () { - ffestd_check_simple_ (); + ffestdStmt_ stmt; -#if FFECOM_ONEPASS - ffestd_subr_line_now_ (); - ffeste_R841 (); -#else - { - ffestdStmt_ stmt; + ffestd_check_simple_ (); - stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_); - ffestd_stmt_append_ (stmt); - ffestd_subr_line_save_ (stmt); - } -#endif + stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_); + ffestd_stmt_append_ (stmt); + ffestd_subr_line_save_ (stmt); } diff --git a/gcc/f/ste.c b/gcc/f/ste.c index 5b4c68e..6d1d0dc 100644 --- a/gcc/f/ste.c +++ b/gcc/f/ste.c @@ -31,13 +31,9 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* Include files. */ #include "proj.h" - -#if FFECOM_targetCURRENT == FFECOM_targetGCC #include "rtl.h" #include "toplev.h" #include "ggc.h" -#endif - #include "ste.h" #include "bld.h" #include "com.h" @@ -79,7 +75,6 @@ typedef enum /* Static objects accessed by functions in this module. */ static ffesteStatelet_ ffeste_statelet_ = FFESTE_stateletSIMPLE_; -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffelab ffeste_label_formatdef_ = NULL; static tree (*ffeste_io_driver_) (ffebld expr); /* do?io. */ static ffecomGfrt ffeste_io_endgfrt_; /* end function to call. */ @@ -89,11 +84,9 @@ static tree ffeste_io_end_; /* END= label or NULL_TREE. */ static tree ffeste_io_err_; /* ERR= label or NULL_TREE. */ static tree ffeste_io_iostat_; /* IOSTAT= var or NULL_TREE. */ static bool ffeste_io_iostat_is_temp_; /* IOSTAT= var is a temp. */ -#endif /* Static functions (internal). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffeste_begin_iterdo_ (ffestw block, tree *tvar, tree *tincr, tree *xitersvar, ffebld var, ffebld start, ffelexToken start_token, @@ -144,18 +137,11 @@ static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr, ffestpFile *recl_spec, ffestpFile *blank_spec); static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt); -#elif FFECOM_targetCURRENT == FFECOM_targetFFE -static void ffeste_subr_file_ (const char *kw, ffestpFile *spec); -#else -#error -#endif /* Internal macros. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC #define ffeste_emit_line_note_() \ emit_line_note (input_filename, lineno) -#endif #define ffeste_check_simple_() \ assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_) #define ffeste_check_start_() \ @@ -499,7 +485,6 @@ ffeste_end_stmt_(void) /* Begin an iterative DO loop. Pass the block to start if applicable. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr, tree *xitersvar, ffebld var, @@ -738,12 +723,9 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr, } } -#endif - /* End an iterative DO loop. Pass the same iteration variable and increment value trees that were generated in the paired _begin_ call. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr, tree itersvar) { @@ -789,11 +771,9 @@ ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr, tree itersvar) else ffeste_end_stmt_ (); } -#endif /* Generate call to run-time I/O routine. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffeste_io_call_ (tree call, bool do_check) { @@ -816,7 +796,6 @@ ffeste_io_call_ (tree call, bool do_check) expand_goto (ffeste_io_abort_); expand_end_cond (); } -#endif /* Handle implied-DO in I/O list. @@ -824,7 +803,6 @@ ffeste_io_call_ (tree call, bool do_check) DO loop, handles appropriately (possibly including recursively calling itself). Then expands code to end the DO loop. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token) { @@ -903,7 +881,6 @@ ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token) ffeste_end_iterdo_ (NULL, tvar, tincr, titervar); } -#endif /* I/O driver for formatted I/O item (do_fio) @@ -914,7 +891,6 @@ ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token) of the result to an IOSTAT= variable, and emit any checking of the result for errors. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_dofio_ (ffebld expr) { @@ -993,7 +969,6 @@ ffeste_io_dofio_ (ffebld expr) return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist, NULL_TREE); } -#endif /* I/O driver for list-directed I/O item (do_lio) Returns a tree for a CALL_EXPR to the do_lio function, which handles @@ -1003,7 +978,6 @@ ffeste_io_dofio_ (ffebld expr) of the result to an IOSTAT= variable, and emit any checking of the result for errors. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_dolio_ (ffebld expr) { @@ -1086,7 +1060,6 @@ ffeste_io_dolio_ (ffebld expr) return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist, NULL_TREE); } -#endif /* I/O driver for unformatted I/O item (do_uio) Returns a tree for a CALL_EXPR to the do_uio function, which handles @@ -1096,7 +1069,6 @@ ffeste_io_dolio_ (ffebld expr) of the result to an IOSTAT= variable, and emit any checking of the result for errors. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_douio_ (ffebld expr) { @@ -1175,7 +1147,6 @@ ffeste_io_douio_ (ffebld expr) return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist, NULL_TREE); } -#endif /* Make arglist with ptr to BACKSPACE/ENDFILE/REWIND control list. Returns a tree suitable as an argument list containing a pointer to @@ -1191,7 +1162,6 @@ ffeste_io_douio_ (ffebld expr) declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_ialist_ (bool have_err, ffestvUnit unit, @@ -1298,7 +1268,6 @@ ffeste_io_ialist_ (bool have_err, return t; } -#endif /* Make arglist with ptr to external-I/O control list. Returns a tree suitable as an argument list containing a pointer to @@ -1314,7 +1283,6 @@ ffeste_io_ialist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_cilist_ (bool have_err, ffestvUnit unit, @@ -1525,7 +1493,6 @@ ffeste_io_cilist_ (bool have_err, return t; } -#endif /* Make arglist with ptr to CLOSE control list. Returns a tree suitable as an argument list containing a pointer to @@ -1541,7 +1508,6 @@ ffeste_io_cilist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_cllist_ (bool have_err, ffebld unit_expr, @@ -1641,7 +1607,6 @@ ffeste_io_cllist_ (bool have_err, return t; } -#endif /* Make arglist with ptr to internal-I/O control list. Returns a tree suitable as an argument list containing a pointer to @@ -1657,7 +1622,6 @@ ffeste_io_cllist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_icilist_ (bool have_err, ffebld unit_expr, @@ -1837,7 +1801,7 @@ ffeste_io_icilist_ (bool have_err, { int need_unitexp = (! unitexp); int need_unitlenexp = (! unitlenexp); - + unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp); if (need_unitexp) ffeste_f2c_compile_ (unitfield, unitexp); @@ -1871,7 +1835,6 @@ ffeste_io_icilist_ (bool have_err, return t; } -#endif /* Make arglist with ptr to INQUIRE control list @@ -1888,7 +1851,6 @@ ffeste_io_icilist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_inlist_ (bool have_err, ffestpFile *unit_spec, @@ -2132,7 +2094,6 @@ ffeste_io_inlist_ (bool have_err, return t; } -#endif /* Make arglist with ptr to OPEN control list Returns a tree suitable as an argument list containing a pointer to @@ -2148,7 +2109,6 @@ ffeste_io_inlist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr, @@ -2291,35 +2251,8 @@ ffeste_io_olist_ (bool have_err, return t; } -#endif -/* Display file-statement specifier. */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE -static void -ffeste_subr_file_ (const char *kw, ffestpFile *spec) -{ - if (!spec->kw_or_val_present) - return; - fputs (kw, dmpout); - if (spec->value_present) - { - fputc ('=', dmpout); - if (spec->value_is_label) - { - assert (spec->value_is_label == 2); /* Temporary checking only. */ - fprintf (dmpout, "%" ffelabValue_f "u", - ffelab_value (spec->u.label)); - } - else - ffebld_dump (spec->u.expr); - } - fputc (',', dmpout); -} -#endif - /* Generate code for BACKSPACE/ENDFILE/REWIND. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt) { @@ -2419,7 +2352,6 @@ ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt) ffeste_end_stmt_ (); } -#endif /* END DO statement @@ -2431,9 +2363,6 @@ ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt) void ffeste_do (ffestw block) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ END_DO\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); if (ffestw_do_tvar (block) == 0) @@ -2447,9 +2376,6 @@ ffeste_do (ffestw block) ffestw_do_tvar (block), ffestw_do_incr_saved (block), ffestw_do_count_var (block)); -#else -#error -#endif } /* End of statement following logical IF. @@ -2459,17 +2385,11 @@ ffeste_do (ffestw block) void ffeste_end_R807 () { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ END_IF\n", dmpout); /* Also see ffeste_R806. */ -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_end_cond (); ffeste_end_block_ (NULL); -#else -#error -#endif } /* Generate "code" for branch label definition. */ @@ -2477,30 +2397,22 @@ ffeste_end_R807 () void ffeste_labeldef_branch (ffelab label) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "+ label %lu\n", ffelab_value (label)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree glabel; + tree glabel; - glabel = ffecom_lookup_label (label); - assert (glabel != NULL_TREE); - if (TREE_CODE (glabel) == ERROR_MARK) - return; + glabel = ffecom_lookup_label (label); + assert (glabel != NULL_TREE); + if (TREE_CODE (glabel) == ERROR_MARK) + return; - assert (DECL_INITIAL (glabel) == NULL_TREE); + assert (DECL_INITIAL (glabel) == NULL_TREE); - DECL_INITIAL (glabel) = error_mark_node; - DECL_SOURCE_FILE (glabel) = ffelab_definition_filename (label); - DECL_SOURCE_LINE (glabel) = ffelab_definition_filelinenum (label); + DECL_INITIAL (glabel) = error_mark_node; + DECL_SOURCE_FILE (glabel) = ffelab_definition_filename (label); + DECL_SOURCE_LINE (glabel) = ffelab_definition_filelinenum (label); - emit_nop (); + emit_nop (); - expand_label (glabel); - } -#else -#error -#endif + expand_label (glabel); } /* Generate "code" for FORMAT label definition. */ @@ -2508,13 +2420,7 @@ ffeste_labeldef_branch (ffelab label) void ffeste_labeldef_format (ffelab label) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "$ label %lu\n", ffelab_value (label)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_label_formatdef_ = label; -#else -#error -#endif } /* Assignment statement (outside of WHERE). */ @@ -2524,13 +2430,6 @@ ffeste_R737A (ffebld dest, ffebld source) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ let ", dmpout); - ffebld_dump (dest); - fputs ("=", dmpout); - ffebld_dump (source); - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffeste_start_stmt_ (); @@ -2538,9 +2437,6 @@ ffeste_R737A (ffebld dest, ffebld source) ffecom_expand_let_stmt (dest, source); ffeste_end_stmt_ (); -#else -#error -#endif } /* Block IF (IF-THEN) statement. */ @@ -2548,54 +2444,44 @@ ffeste_R737A (ffebld dest, ffebld source) void ffeste_R803 (ffestw block, ffebld expr) { - ffeste_check_simple_ (); + tree temp; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ IF_block (", dmpout); - ffebld_dump (expr); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree temp; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - ffeste_start_block_ (block); + ffeste_start_block_ (block); - temp = ffecom_make_tempvar ("ifthen", integer_type_node, - FFETARGET_charactersizeNONE, -1); + temp = ffecom_make_tempvar ("ifthen", integer_type_node, + FFETARGET_charactersizeNONE, -1); - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffecom_prepare_expr (expr); + ffecom_prepare_expr (expr); - if (ffecom_prepare_end ()) - { - tree result; + if (ffecom_prepare_end ()) + { + tree result; - result = ffecom_modify (void_type_node, - temp, - ffecom_truth_value (ffecom_expr (expr))); + result = ffecom_modify (void_type_node, + temp, + ffecom_truth_value (ffecom_expr (expr))); - expand_expr_stmt (result); + expand_expr_stmt (result); - ffeste_end_stmt_ (); - } - else - { - ffeste_end_stmt_ (); + ffeste_end_stmt_ (); + } + else + { + ffeste_end_stmt_ (); - temp = ffecom_truth_value (ffecom_expr (expr)); - } + temp = ffecom_truth_value (ffecom_expr (expr)); + } - expand_start_cond (temp, 0); + expand_start_cond (temp, 0); - /* No fake `else' constructs introduced (yet). */ - ffestw_set_ifthen_fake_else (block, 0); - } -#else -#error -#endif + /* No fake `else' constructs introduced (yet). */ + ffestw_set_ifthen_fake_else (block, 0); } /* ELSE IF statement. */ @@ -2603,66 +2489,56 @@ ffeste_R803 (ffestw block, ffebld expr) void ffeste_R804 (ffestw block, ffebld expr) { - ffeste_check_simple_ (); + tree temp; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ ELSE_IF (", dmpout); - ffebld_dump (expr); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree temp; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - /* Since ELSEIF(expr) might require preparations for expr, - implement as ELSE; prepare-expr; IF (expr) THEN ...; ENDIF. */ + /* Since ELSEIF(expr) might require preparations for expr, + implement as ELSE; prepare-expr; IF (expr) THEN ...; ENDIF. */ - expand_start_else (); + expand_start_else (); - ffeste_start_block_ (block); + ffeste_start_block_ (block); - temp = ffecom_make_tempvar ("elseif", integer_type_node, - FFETARGET_charactersizeNONE, -1); + temp = ffecom_make_tempvar ("elseif", integer_type_node, + FFETARGET_charactersizeNONE, -1); - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffecom_prepare_expr (expr); + ffecom_prepare_expr (expr); - if (ffecom_prepare_end ()) - { - tree result; + if (ffecom_prepare_end ()) + { + tree result; - result = ffecom_modify (void_type_node, - temp, - ffecom_truth_value (ffecom_expr (expr))); + result = ffecom_modify (void_type_node, + temp, + ffecom_truth_value (ffecom_expr (expr))); - expand_expr_stmt (result); + expand_expr_stmt (result); - ffeste_end_stmt_ (); - } - else - { - /* In this case, we could probably have used expand_start_elseif - instead, saving the need for a fake `else' construct. But, - until it's clear that'd improve performance, it's easier this - way, since we have to expand_start_else before we get to this - test, given the current design. */ + ffeste_end_stmt_ (); + } + else + { + /* In this case, we could probably have used expand_start_elseif + instead, saving the need for a fake `else' construct. But, + until it's clear that'd improve performance, it's easier this + way, since we have to expand_start_else before we get to this + test, given the current design. */ - ffeste_end_stmt_ (); + ffeste_end_stmt_ (); - temp = ffecom_truth_value (ffecom_expr (expr)); - } + temp = ffecom_truth_value (ffecom_expr (expr)); + } - expand_start_cond (temp, 0); + expand_start_cond (temp, 0); - /* Increment number of fake `else' constructs introduced. */ - ffestw_set_ifthen_fake_else (block, - ffestw_ifthen_fake_else (block) + 1); - } -#else -#error -#endif + /* Increment number of fake `else' constructs introduced. */ + ffestw_set_ifthen_fake_else (block, + ffestw_ifthen_fake_else (block) + 1); } /* ELSE statement. */ @@ -2672,15 +2548,9 @@ ffeste_R805 (ffestw block UNUSED) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ ELSE\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_start_else (); -#else -#error -#endif } /* END IF statement. */ @@ -2688,24 +2558,16 @@ ffeste_R805 (ffestw block UNUSED) void ffeste_R806 (ffestw block) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ END_IF_then\n", dmpout); /* Also see ffeste_shriek_if_. */ -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - int i = ffestw_ifthen_fake_else (block) + 1; + int i = ffestw_ifthen_fake_else (block) + 1; - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - for (; i; --i) - { - expand_end_cond (); + for (; i; --i) + { + expand_end_cond (); - ffeste_end_block_ (block); - } - } -#else -#error -#endif + ffeste_end_block_ (block); + } } /* Logical IF statement. */ @@ -2713,51 +2575,41 @@ ffeste_R806 (ffestw block) void ffeste_R807 (ffebld expr) { - ffeste_check_simple_ (); + tree temp; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ IF_logical (", dmpout); - ffebld_dump (expr); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree temp; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - ffeste_start_block_ (NULL); + ffeste_start_block_ (NULL); - temp = ffecom_make_tempvar ("if", integer_type_node, - FFETARGET_charactersizeNONE, -1); + temp = ffecom_make_tempvar ("if", integer_type_node, + FFETARGET_charactersizeNONE, -1); - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffecom_prepare_expr (expr); + ffecom_prepare_expr (expr); - if (ffecom_prepare_end ()) - { - tree result; + if (ffecom_prepare_end ()) + { + tree result; - result = ffecom_modify (void_type_node, - temp, - ffecom_truth_value (ffecom_expr (expr))); + result = ffecom_modify (void_type_node, + temp, + ffecom_truth_value (ffecom_expr (expr))); - expand_expr_stmt (result); + expand_expr_stmt (result); - ffeste_end_stmt_ (); - } - else - { - ffeste_end_stmt_ (); + ffeste_end_stmt_ (); + } + else + { + ffeste_end_stmt_ (); - temp = ffecom_truth_value (ffecom_expr (expr)); - } + temp = ffecom_truth_value (ffecom_expr (expr)); + } - expand_start_cond (temp, 0); - } -#else -#error -#endif + expand_start_cond (temp, 0); } /* SELECT CASE statement. */ @@ -2767,11 +2619,6 @@ ffeste_R809 (ffestw block, ffebld expr) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ SELECT_CASE (", dmpout); - ffebld_dump (expr); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); ffeste_start_block_ (block); @@ -2823,9 +2670,6 @@ ffeste_R809 (ffestw block, ffebld expr) ffestw_set_select_texpr (block, texpr); ffestw_set_select_break (block, FALSE); } -#else -#error -#endif } /* CASE statement. @@ -2839,6 +2683,11 @@ ffeste_R810 (ffestw block, unsigned long casenum) { ffestwSelect s = ffestw_select (block); ffestwCase c; + tree texprlow; + tree texprhigh; + tree tlabel; + int pushok; + tree duplicate; ffeste_check_simple_ (); @@ -2847,98 +2696,53 @@ ffeste_R810 (ffestw block, unsigned long casenum) else c = s->first_stmt; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if ((c == NULL) || (casenum != c->casenum)) - { - if (casenum == 0) /* Intentional CASE DEFAULT. */ - fputs ("+ CASE_DEFAULT", dmpout); - } - else - { - bool comma = FALSE; - - fputs ("+ CASE (", dmpout); - do - { - if (comma) - fputc (',', dmpout); - else - comma = TRUE; - if (c->low != NULL) - ffebld_constant_dump (c->low); - if (c->low != c->high) - { - fputc (':', dmpout); - if (c->high != NULL) - ffebld_constant_dump (c->high); - } - c = c->next_stmt; - /* Unlink prev. */ - c->previous_stmt->previous_stmt->next_stmt = c; - c->previous_stmt = c->previous_stmt->previous_stmt; - } - while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum)); - fputc (')', dmpout); - } - - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree texprlow; - tree texprhigh; - tree tlabel; - int pushok; - tree duplicate; - - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - if (ffestw_select_texpr (block) == error_mark_node) - return; + if (ffestw_select_texpr (block) == error_mark_node) + return; - /* ~~~Someday handle CHARACTER*1, CHARACTER*N */ + /* ~~~Someday handle CHARACTER*1, CHARACTER*N */ - tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); + tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); - if (ffestw_select_break (block)) - expand_exit_something (); - else - ffestw_set_select_break (block, TRUE); + if (ffestw_select_break (block)) + expand_exit_something (); + else + ffestw_set_select_break (block, TRUE); - if ((c == NULL) || (casenum != c->casenum)) + if ((c == NULL) || (casenum != c->casenum)) + { + if (casenum == 0) /* Intentional CASE DEFAULT. */ + { + pushok = pushcase (NULL_TREE, 0, tlabel, &duplicate); + assert (pushok == 0); + } + } + else + do { - if (casenum == 0) /* Intentional CASE DEFAULT. */ + texprlow = (c->low == NULL) ? NULL_TREE + : ffecom_constantunion (&ffebld_constant_union (c->low), s->type, + s->kindtype, + ffecom_tree_type[s->type][s->kindtype]); + if (c->low != c->high) { - pushok = pushcase (NULL_TREE, 0, tlabel, &duplicate); - assert (pushok == 0); + texprhigh = (c->high == NULL) ? NULL_TREE + : ffecom_constantunion (&ffebld_constant_union (c->high), + s->type, s->kindtype, + ffecom_tree_type[s->type][s->kindtype]); + pushok = pushcase_range (texprlow, texprhigh, convert, + tlabel, &duplicate); } + else + pushok = pushcase (texprlow, convert, tlabel, &duplicate); + assert (pushok == 0); + c = c->next_stmt; + /* Unlink prev. */ + c->previous_stmt->previous_stmt->next_stmt = c; + c->previous_stmt = c->previous_stmt->previous_stmt; } - else - do - { - texprlow = (c->low == NULL) ? NULL_TREE - : ffecom_constantunion (&ffebld_constant_union (c->low), s->type, - s->kindtype, ffecom_tree_type[s->type][s->kindtype]); - if (c->low != c->high) - { - texprhigh = (c->high == NULL) ? NULL_TREE - : ffecom_constantunion (&ffebld_constant_union (c->high), - s->type, s->kindtype, ffecom_tree_type[s->type][s->kindtype]); - pushok = pushcase_range (texprlow, texprhigh, convert, - tlabel, &duplicate); - } - else - pushok = pushcase (texprlow, convert, tlabel, &duplicate); - assert (pushok == 0); - c = c->next_stmt; - /* Unlink prev. */ - c->previous_stmt->previous_stmt->next_stmt = c; - c->previous_stmt = c->previous_stmt->previous_stmt; - } - while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum)); - } -#else -#error -#endif + while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum)); } /* END SELECT statement. */ @@ -2946,9 +2750,6 @@ ffeste_R810 (ffestw block, unsigned long casenum) void ffeste_R811 (ffestw block) { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ END_SELECT\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); /* ~~~Someday handle CHARACTER*1, CHARACTER*N */ @@ -2957,9 +2758,6 @@ ffeste_R811 (ffestw block) expand_end_case (ffestw_select_texpr (block)); ffeste_end_block_ (block); -#else -#error -#endif } /* Iterative DO statement. */ @@ -2972,44 +2770,14 @@ ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var, { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if ((ffebld_op (incr) == FFEBLD_opCONTER) - && (ffebld_constant_is_zero (ffebld_conter (incr)))) - { - ffebad_start (FFEBAD_DO_STEP_ZERO); - ffebad_here (0, ffelex_token_where_line (incr_token), - ffelex_token_where_column (incr_token)); - ffebad_string ("Iterative DO loop"); - ffebad_finish (); - /* Don't bother replacing it with 1 yet. */ - } + ffeste_emit_line_note_ (); - if (label == NULL) - fputs ("+ DO_iterative_nonlabeled (", dmpout); - else - fprintf (dmpout, "+ DO_iterative_labeled %lu (", ffelab_value (label)); - ffebld_dump (var); - fputc ('=', dmpout); - ffebld_dump (start); - fputc (',', dmpout); - ffebld_dump (end); - fputc (',', dmpout); - ffebld_dump (incr); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - ffeste_emit_line_note_ (); - - ffeste_begin_iterdo_ (block, NULL, NULL, NULL, - var, - start, start_token, - end, end_token, - incr, incr_token, - "Iterative DO loop"); - } -#else -#error -#endif + ffeste_begin_iterdo_ (block, NULL, NULL, NULL, + var, + start, start_token, + end, end_token, + incr, incr_token, + "Iterative DO loop"); } /* DO WHILE statement. */ @@ -3017,56 +2785,43 @@ ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var, void ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr) { - ffeste_check_simple_ (); + tree result; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (label == NULL) - fputs ("+ DO_WHILE_nonlabeled (", dmpout); - else - fprintf (dmpout, "+ DO_WHILE_labeled %lu (", ffelab_value (label)); - ffebld_dump (expr); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree result; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - ffeste_start_block_ (block); + ffeste_start_block_ (block); - if (expr) - { - struct nesting *loop; - tree mod; + if (expr) + { + struct nesting *loop; + tree mod; - result = ffecom_make_tempvar ("dowhile", integer_type_node, - FFETARGET_charactersizeNONE, -1); - loop = expand_start_loop (1); + result = ffecom_make_tempvar ("dowhile", integer_type_node, + FFETARGET_charactersizeNONE, -1); + loop = expand_start_loop (1); - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffecom_prepare_expr (expr); + ffecom_prepare_expr (expr); - ffecom_prepare_end (); + ffecom_prepare_end (); - mod = ffecom_modify (void_type_node, - result, - ffecom_truth_value (ffecom_expr (expr))); - expand_expr_stmt (mod); + mod = ffecom_modify (void_type_node, + result, + ffecom_truth_value (ffecom_expr (expr))); + expand_expr_stmt (mod); - ffeste_end_stmt_ (); + ffeste_end_stmt_ (); - ffestw_set_do_hook (block, loop); - expand_exit_loop_if_false (0, result); - } - else - ffestw_set_do_hook (block, expand_start_loop (1)); + ffestw_set_do_hook (block, loop); + expand_exit_loop_if_false (0, result); + } + else + ffestw_set_do_hook (block, expand_start_loop (1)); - ffestw_set_do_tvar (block, NULL_TREE); - } -#else -#error -#endif + ffestw_set_do_tvar (block, NULL_TREE); } /* END DO statement. @@ -3082,15 +2837,9 @@ ffeste_R825 () { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ END_DO_sugar\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); -#else -#error -#endif } /* CYCLE statement. */ @@ -3100,15 +2849,9 @@ ffeste_R834 (ffestw block) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "+ CYCLE block #%lu\n", ffestw_blocknum (block)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_continue_loop (ffestw_do_hook (block)); -#else -#error -#endif } /* EXIT statement. */ @@ -3118,15 +2861,9 @@ ffeste_R835 (ffestw block) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "+ EXIT block #%lu\n", ffestw_blocknum (block)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); expand_exit_loop (ffestw_do_hook (block)); -#else -#error -#endif } /* GOTO statement. */ @@ -3134,27 +2871,19 @@ ffeste_R835 (ffestw block) void ffeste_R836 (ffelab label) { - ffeste_check_simple_ (); + tree glabel; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "+ GOTO %lu\n", ffelab_value (label)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree glabel; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - glabel = ffecom_lookup_label (label); - if ((glabel != NULL_TREE) - && (TREE_CODE (glabel) != ERROR_MARK)) - { - expand_goto (glabel); - TREE_USED (glabel) = 1; - } - } -#else -#error -#endif + glabel = ffecom_lookup_label (label); + if ((glabel != NULL_TREE) + && (TREE_CODE (glabel) != ERROR_MARK)) + { + expand_goto (glabel); + TREE_USED (glabel) = 1; + } } /* Computed GOTO statement. */ @@ -3163,63 +2892,45 @@ void ffeste_R837 (ffelab *labels, int count, ffebld expr) { int i; + tree texpr; + tree value; + tree tlabel; + int pushok; + tree duplicate; ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ CGOTO (", dmpout); - for (i = 0; i < count; ++i) - { - if (i != 0) - fputc (',', dmpout); - fprintf (dmpout, "%" ffelabValue_f "u", ffelab_value (labels[i])); - } - fputs ("),", dmpout); - ffebld_dump (expr); - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree texpr; - tree value; - tree tlabel; - int pushok; - tree duplicate; - - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffecom_prepare_expr (expr); + ffecom_prepare_expr (expr); - ffecom_prepare_end (); + ffecom_prepare_end (); - texpr = ffecom_expr (expr); + texpr = ffecom_expr (expr); - expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement"); + expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement"); - for (i = 0; i < count; ++i) - { - value = build_int_2 (i + 1, 0); - tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); + for (i = 0; i < count; ++i) + { + value = build_int_2 (i + 1, 0); + tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); - pushok = pushcase (value, convert, tlabel, &duplicate); - assert (pushok == 0); + pushok = pushcase (value, convert, tlabel, &duplicate); + assert (pushok == 0); - tlabel = ffecom_lookup_label (labels[i]); - if ((tlabel == NULL_TREE) - || (TREE_CODE (tlabel) == ERROR_MARK)) - continue; + tlabel = ffecom_lookup_label (labels[i]); + if ((tlabel == NULL_TREE) + || (TREE_CODE (tlabel) == ERROR_MARK)) + continue; - expand_goto (tlabel); - TREE_USED (tlabel) = 1; - } - expand_end_case (texpr); + expand_goto (tlabel); + TREE_USED (tlabel) = 1; + } + expand_end_case (texpr); - ffeste_end_stmt_ (); - } -#else -#error -#endif + ffeste_end_stmt_ (); } /* ASSIGN statement. */ @@ -3227,48 +2938,38 @@ ffeste_R837 (ffelab *labels, int count, ffebld expr) void ffeste_R838 (ffelab label, ffebld target) { - ffeste_check_simple_ (); + tree expr_tree; + tree label_tree; + tree target_tree; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "+ ASSIGN %lu TO ", ffelab_value (label)); - ffebld_dump (target); - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree expr_tree; - tree label_tree; - tree target_tree; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); /* No need to call ffeste_start_stmt_(), as the sorts of expressions seen here should never require use of temporaries. */ - label_tree = ffecom_lookup_label (label); - if ((label_tree != NULL_TREE) - && (TREE_CODE (label_tree) != ERROR_MARK)) - { - label_tree = ffecom_1 (ADDR_EXPR, - build_pointer_type (void_type_node), - label_tree); - TREE_CONSTANT (label_tree) = 1; - - target_tree = ffecom_expr_assign_w (target); - if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree))) - < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree)))) - error ("ASSIGN to variable that is too small"); - - label_tree = convert (TREE_TYPE (target_tree), label_tree); - - expr_tree = ffecom_modify (void_type_node, - target_tree, - label_tree); - expand_expr_stmt (expr_tree); - } - } -#else -#error -#endif + label_tree = ffecom_lookup_label (label); + if ((label_tree != NULL_TREE) + && (TREE_CODE (label_tree) != ERROR_MARK)) + { + label_tree = ffecom_1 (ADDR_EXPR, + build_pointer_type (void_type_node), + label_tree); + TREE_CONSTANT (label_tree) = 1; + + target_tree = ffecom_expr_assign_w (target); + if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree))) + < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree)))) + error ("ASSIGN to variable that is too small"); + + label_tree = convert (TREE_TYPE (target_tree), label_tree); + + expr_tree = ffecom_modify (void_type_node, + target_tree, + label_tree); + expand_expr_stmt (expr_tree); + } } /* Assigned GOTO statement. */ @@ -3276,31 +2977,21 @@ ffeste_R838 (ffelab label, ffebld target) void ffeste_R839 (ffebld target) { - ffeste_check_simple_ (); + tree t; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ AGOTO ", dmpout); - ffebld_dump (target); - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree t; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - /* No need to call ffeste_start_stmt_(), as the sorts of expressions - seen here should never require use of temporaries. */ + /* No need to call ffeste_start_stmt_(), as the sorts of expressions + seen here should never require use of temporaries. */ - t = ffecom_expr_assign (target); - if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t))) - < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) - error ("ASSIGNed GOTO target variable is too small"); + t = ffecom_expr_assign (target); + if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t))) + < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node)))) + error ("ASSIGNed GOTO target variable is too small"); - expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t)); - } -#else -#error -#endif + expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t)); } /* Arithmetic IF statement. */ @@ -3308,112 +2999,101 @@ ffeste_R839 (ffebld target) void ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos) { - ffeste_check_simple_ (); + tree gneg = ffecom_lookup_label (neg); + tree gzero = ffecom_lookup_label (zero); + tree gpos = ffecom_lookup_label (pos); + tree texpr; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ IF_arithmetic (", dmpout); - ffebld_dump (expr); - fprintf (dmpout, ") %" ffelabValue_f "u,%" ffelabValue_f "u,%" ffelabValue_f "u\n", - ffelab_value (neg), ffelab_value (zero), ffelab_value (pos)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree gneg = ffecom_lookup_label (neg); - tree gzero = ffecom_lookup_label (zero); - tree gpos = ffecom_lookup_label (pos); - tree texpr; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - if ((gneg == NULL_TREE) || (gzero == NULL_TREE) || (gpos == NULL_TREE)) - return; - if ((TREE_CODE (gneg) == ERROR_MARK) - || (TREE_CODE (gzero) == ERROR_MARK) - || (TREE_CODE (gpos) == ERROR_MARK)) - return; + if ((gneg == NULL_TREE) || (gzero == NULL_TREE) || (gpos == NULL_TREE)) + return; + if ((TREE_CODE (gneg) == ERROR_MARK) + || (TREE_CODE (gzero) == ERROR_MARK) + || (TREE_CODE (gpos) == ERROR_MARK)) + return; - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffecom_prepare_expr (expr); + ffecom_prepare_expr (expr); - ffecom_prepare_end (); + ffecom_prepare_end (); - if (neg == zero) - { - if (neg == pos) - expand_goto (gzero); - else - { - /* IF (expr.LE.0) THEN GOTO neg/zero ELSE GOTO pos. */ - texpr = ffecom_expr (expr); - texpr = ffecom_2 (LE_EXPR, integer_type_node, - texpr, - convert (TREE_TYPE (texpr), - integer_zero_node)); - expand_start_cond (ffecom_truth_value (texpr), 0); - expand_goto (gzero); - expand_start_else (); - expand_goto (gpos); - expand_end_cond (); - } - } - else if (neg == pos) - { - /* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO zero. */ - texpr = ffecom_expr (expr); - texpr = ffecom_2 (NE_EXPR, integer_type_node, - texpr, - convert (TREE_TYPE (texpr), - integer_zero_node)); - expand_start_cond (ffecom_truth_value (texpr), 0); - expand_goto (gneg); - expand_start_else (); - expand_goto (gzero); - expand_end_cond (); - } - else if (zero == pos) - { - /* IF (expr.GE.0) THEN GOTO zero/pos ELSE GOTO neg. */ - texpr = ffecom_expr (expr); - texpr = ffecom_2 (GE_EXPR, integer_type_node, - texpr, - convert (TREE_TYPE (texpr), - integer_zero_node)); - expand_start_cond (ffecom_truth_value (texpr), 0); - expand_goto (gzero); - expand_start_else (); - expand_goto (gneg); - expand_end_cond (); - } - else - { - /* Use a SAVE_EXPR in combo with: - IF (expr.LT.0) THEN GOTO neg - ELSEIF (expr.GT.0) THEN GOTO pos - ELSE GOTO zero. */ - tree expr_saved = ffecom_save_tree (ffecom_expr (expr)); - - texpr = ffecom_2 (LT_EXPR, integer_type_node, - expr_saved, - convert (TREE_TYPE (expr_saved), - integer_zero_node)); - expand_start_cond (ffecom_truth_value (texpr), 0); - expand_goto (gneg); - texpr = ffecom_2 (GT_EXPR, integer_type_node, - expr_saved, - convert (TREE_TYPE (expr_saved), - integer_zero_node)); - expand_start_elseif (ffecom_truth_value (texpr)); - expand_goto (gpos); - expand_start_else (); + if (neg == zero) + { + if (neg == pos) expand_goto (gzero); - expand_end_cond (); - } + else + { + /* IF (expr.LE.0) THEN GOTO neg/zero ELSE GOTO pos. */ + texpr = ffecom_expr (expr); + texpr = ffecom_2 (LE_EXPR, integer_type_node, + texpr, + convert (TREE_TYPE (texpr), + integer_zero_node)); + expand_start_cond (ffecom_truth_value (texpr), 0); + expand_goto (gzero); + expand_start_else (); + expand_goto (gpos); + expand_end_cond (); + } + } + else if (neg == pos) + { + /* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO zero. */ + texpr = ffecom_expr (expr); + texpr = ffecom_2 (NE_EXPR, integer_type_node, + texpr, + convert (TREE_TYPE (texpr), + integer_zero_node)); + expand_start_cond (ffecom_truth_value (texpr), 0); + expand_goto (gneg); + expand_start_else (); + expand_goto (gzero); + expand_end_cond (); + } + else if (zero == pos) + { + /* IF (expr.GE.0) THEN GOTO zero/pos ELSE GOTO neg. */ + texpr = ffecom_expr (expr); + texpr = ffecom_2 (GE_EXPR, integer_type_node, + texpr, + convert (TREE_TYPE (texpr), + integer_zero_node)); + expand_start_cond (ffecom_truth_value (texpr), 0); + expand_goto (gzero); + expand_start_else (); + expand_goto (gneg); + expand_end_cond (); + } + else + { + /* Use a SAVE_EXPR in combo with: + IF (expr.LT.0) THEN GOTO neg + ELSEIF (expr.GT.0) THEN GOTO pos + ELSE GOTO zero. */ + tree expr_saved = ffecom_save_tree (ffecom_expr (expr)); + + texpr = ffecom_2 (LT_EXPR, integer_type_node, + expr_saved, + convert (TREE_TYPE (expr_saved), + integer_zero_node)); + expand_start_cond (ffecom_truth_value (texpr), 0); + expand_goto (gneg); + texpr = ffecom_2 (GT_EXPR, integer_type_node, + expr_saved, + convert (TREE_TYPE (expr_saved), + integer_zero_node)); + expand_start_elseif (ffecom_truth_value (texpr)); + expand_goto (gpos); + expand_start_else (); + expand_goto (gzero); + expand_end_cond (); + } - ffeste_end_stmt_ (); - } -#else -#error -#endif + ffeste_end_stmt_ (); } /* CONTINUE statement. */ @@ -3423,15 +3103,9 @@ ffeste_R841 () { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ CONTINUE\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_emit_line_note_ (); emit_nop (); -#else -#error -#endif } /* STOP statement. */ @@ -3439,82 +3113,66 @@ ffeste_R841 () void ffeste_R842 (ffebld expr) { + tree callit; + ffelexToken msg; + ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (expr == NULL) + ffeste_emit_line_note_ (); + + if ((expr == NULL) + || (ffeinfo_basictype (ffebld_info (expr)) + == FFEINFO_basictypeANY)) { - fputs ("+ STOP\n", dmpout); + msg = ffelex_token_new_character ("", + ffelex_token_where_line (ffesta_tokens[0]), + ffelex_token_where_column (ffesta_tokens[0])); + expr = ffebld_new_conter (ffebld_constant_new_characterdefault + (msg)); + ffelex_token_kill (msg); + ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, + FFEINFO_kindtypeCHARACTERDEFAULT, + 0, FFEINFO_kindENTITY, + FFEINFO_whereCONSTANT, 0)); + } + else if (ffeinfo_basictype (ffebld_info (expr)) + == FFEINFO_basictypeINTEGER) + { + char num[50]; + + assert (ffebld_op (expr) == FFEBLD_opCONTER); + assert (ffeinfo_kindtype (ffebld_info (expr)) + == FFEINFO_kindtypeINTEGERDEFAULT); + sprintf (num, "%" ffetargetIntegerDefault_f "d", + ffebld_constant_integer1 (ffebld_conter (expr))); + msg = ffelex_token_new_character (num, + ffelex_token_where_line (ffesta_tokens[0]), + ffelex_token_where_column (ffesta_tokens[0])); + expr = ffebld_new_conter (ffebld_constant_new_characterdefault (msg)); + ffelex_token_kill (msg); + ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, + FFEINFO_kindtypeCHARACTERDEFAULT, + 0, FFEINFO_kindENTITY, + FFEINFO_whereCONSTANT, 0)); } else { - fputs ("+ STOP_coded ", dmpout); - ffebld_dump (expr); - fputc ('\n', dmpout); + assert (ffeinfo_basictype (ffebld_info (expr)) + == FFEINFO_basictypeCHARACTER); + assert (ffebld_op (expr) == FFEBLD_opCONTER); + assert (ffeinfo_kindtype (ffebld_info (expr)) + == FFEINFO_kindtypeCHARACTERDEFAULT); } -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree callit; - ffelexToken msg; - ffeste_emit_line_note_ (); + /* No need to call ffeste_start_stmt_(), as the sorts of expressions + seen here should never require use of temporaries. */ - if ((expr == NULL) - || (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeANY)) - { - msg = ffelex_token_new_character ("", ffelex_token_where_line - (ffesta_tokens[0]), ffelex_token_where_column - (ffesta_tokens[0])); - expr = ffebld_new_conter (ffebld_constant_new_characterdefault - (msg)); - ffelex_token_kill (msg); - ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY, - FFEINFO_whereCONSTANT, 0)); - } - else if (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeINTEGER) - { - char num[50]; - - assert (ffebld_op (expr) == FFEBLD_opCONTER); - assert (ffeinfo_kindtype (ffebld_info (expr)) - == FFEINFO_kindtypeINTEGERDEFAULT); - sprintf (num, "%" ffetargetIntegerDefault_f "d", - ffebld_constant_integer1 (ffebld_conter (expr))); - msg = ffelex_token_new_character (num, ffelex_token_where_line - (ffesta_tokens[0]), ffelex_token_where_column - (ffesta_tokens[0])); - expr = ffebld_new_conter (ffebld_constant_new_characterdefault - (msg)); - ffelex_token_kill (msg); - ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY, - FFEINFO_whereCONSTANT, 0)); - } - else - { - assert (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeCHARACTER); - assert (ffebld_op (expr) == FFEBLD_opCONTER); - assert (ffeinfo_kindtype (ffebld_info (expr)) - == FFEINFO_kindtypeCHARACTERDEFAULT); - } + callit = ffecom_call_gfrt (FFECOM_gfrtSTOP, + ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), + NULL_TREE); + TREE_SIDE_EFFECTS (callit) = 1; - /* No need to call ffeste_start_stmt_(), as the sorts of expressions - seen here should never require use of temporaries. */ - - callit = ffecom_call_gfrt (FFECOM_gfrtSTOP, - ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), - NULL_TREE); - TREE_SIDE_EFFECTS (callit) = 1; - - expand_expr_stmt (callit); - } -#else -#error -#endif + expand_expr_stmt (callit); } /* PAUSE statement. */ @@ -3522,108 +3180,63 @@ ffeste_R842 (ffebld expr) void ffeste_R843 (ffebld expr) { + tree callit; + ffelexToken msg; + ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (expr == NULL) + ffeste_emit_line_note_ (); + + if ((expr == NULL) + || (ffeinfo_basictype (ffebld_info (expr)) + == FFEINFO_basictypeANY)) { - fputs ("+ PAUSE\n", dmpout); + msg = ffelex_token_new_character ("", + ffelex_token_where_line (ffesta_tokens[0]), + ffelex_token_where_column (ffesta_tokens[0])); + expr = ffebld_new_conter (ffebld_constant_new_characterdefault (msg)); + ffelex_token_kill (msg); + ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, + FFEINFO_kindtypeCHARACTERDEFAULT, + 0, FFEINFO_kindENTITY, + FFEINFO_whereCONSTANT, 0)); + } + else if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER) + { + char num[50]; + + assert (ffebld_op (expr) == FFEBLD_opCONTER); + assert (ffeinfo_kindtype (ffebld_info (expr)) + == FFEINFO_kindtypeINTEGERDEFAULT); + sprintf (num, "%" ffetargetIntegerDefault_f "d", + ffebld_constant_integer1 (ffebld_conter (expr))); + msg = ffelex_token_new_character (num, ffelex_token_where_line (ffesta_tokens[0]), + ffelex_token_where_column (ffesta_tokens[0])); + expr = ffebld_new_conter (ffebld_constant_new_characterdefault (msg)); + ffelex_token_kill (msg); + ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, + FFEINFO_kindtypeCHARACTERDEFAULT, + 0, FFEINFO_kindENTITY, + FFEINFO_whereCONSTANT, 0)); } else { - fputs ("+ PAUSE_coded ", dmpout); - ffebld_dump (expr); - fputc ('\n', dmpout); + assert (ffeinfo_basictype (ffebld_info (expr)) + == FFEINFO_basictypeCHARACTER); + assert (ffebld_op (expr) == FFEBLD_opCONTER); + assert (ffeinfo_kindtype (ffebld_info (expr)) + == FFEINFO_kindtypeCHARACTERDEFAULT); } -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree callit; - ffelexToken msg; - - ffeste_emit_line_note_ (); - - if ((expr == NULL) - || (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeANY)) - { - msg = ffelex_token_new_character ("", ffelex_token_where_line - (ffesta_tokens[0]), ffelex_token_where_column - (ffesta_tokens[0])); - expr = ffebld_new_conter (ffebld_constant_new_characterdefault - (msg)); - ffelex_token_kill (msg); - ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY, - FFEINFO_whereCONSTANT, 0)); - } - else if (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeINTEGER) - { - char num[50]; - - assert (ffebld_op (expr) == FFEBLD_opCONTER); - assert (ffeinfo_kindtype (ffebld_info (expr)) - == FFEINFO_kindtypeINTEGERDEFAULT); - sprintf (num, "%" ffetargetIntegerDefault_f "d", - ffebld_constant_integer1 (ffebld_conter (expr))); - msg = ffelex_token_new_character (num, ffelex_token_where_line - (ffesta_tokens[0]), ffelex_token_where_column - (ffesta_tokens[0])); - expr = ffebld_new_conter (ffebld_constant_new_characterdefault - (msg)); - ffelex_token_kill (msg); - ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER, - FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY, - FFEINFO_whereCONSTANT, 0)); - } - else - { - assert (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeCHARACTER); - assert (ffebld_op (expr) == FFEBLD_opCONTER); - assert (ffeinfo_kindtype (ffebld_info (expr)) - == FFEINFO_kindtypeCHARACTERDEFAULT); - } - /* No need to call ffeste_start_stmt_(), as the sorts of expressions - seen here should never require use of temporaries. */ + /* No need to call ffeste_start_stmt_(), as the sorts of expressions + seen here should never require use of temporaries. */ - callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE, - ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), - NULL_TREE); - TREE_SIDE_EFFECTS (callit) = 1; + callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE, + ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), + NULL_TREE); + TREE_SIDE_EFFECTS (callit) = 1; - expand_expr_stmt (callit); - } -#if 0 /* Old approach for phantom g77 run-time - library. */ - { - tree callit; - - ffeste_emit_line_note_ (); - - if (expr == NULL) - callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE, NULL_TREE); - else if (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeINTEGER) - callit = ffecom_call_gfrt (FFECOM_gfrtPAUSEINT, - ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), - NULL_TREE); - else if (ffeinfo_basictype (ffebld_info (expr)) - == FFEINFO_basictypeCHARACTER) - callit = ffecom_call_gfrt (FFECOM_gfrtPAUSECHAR, - ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)), - NULL_TREE); - else - abort (); - TREE_SIDE_EFFECTS (callit) = 1; - - expand_expr_stmt (callit); - } -#endif -#else -#error -#endif + expand_expr_stmt (callit); } /* OPEN statement. */ @@ -3631,133 +3244,95 @@ ffeste_R843 (ffebld expr) void ffeste_R904 (ffestpOpenStmt *info) { - ffeste_check_simple_ (); + tree args; + bool iostat; + bool errl; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ OPEN (", dmpout); - ffeste_subr_file_ ("UNIT", &info->open_spec[FFESTP_openixUNIT]); - ffeste_subr_file_ ("ACCESS", &info->open_spec[FFESTP_openixACCESS]); - ffeste_subr_file_ ("ACTION", &info->open_spec[FFESTP_openixACTION]); - ffeste_subr_file_ ("ASSOCIATEVARIABLE", &info->open_spec[FFESTP_openixASSOCIATEVARIABLE]); - ffeste_subr_file_ ("BLANK", &info->open_spec[FFESTP_openixBLANK]); - ffeste_subr_file_ ("BLOCKSIZE", &info->open_spec[FFESTP_openixBLOCKSIZE]); - ffeste_subr_file_ ("BUFFERCOUNT", &info->open_spec[FFESTP_openixBUFFERCOUNT]); - ffeste_subr_file_ ("CARRIAGECONTROL", &info->open_spec[FFESTP_openixCARRIAGECONTROL]); - ffeste_subr_file_ ("DEFAULTFILE", &info->open_spec[FFESTP_openixDEFAULTFILE]); - ffeste_subr_file_ ("DELIM", &info->open_spec[FFESTP_openixDELIM]); - ffeste_subr_file_ ("DISPOSE", &info->open_spec[FFESTP_openixDISPOSE]); - ffeste_subr_file_ ("ERR", &info->open_spec[FFESTP_openixERR]); - ffeste_subr_file_ ("EXTENDSIZE", &info->open_spec[FFESTP_openixEXTENDSIZE]); - ffeste_subr_file_ ("FILE", &info->open_spec[FFESTP_openixFILE]); - ffeste_subr_file_ ("FORM", &info->open_spec[FFESTP_openixFORM]); - ffeste_subr_file_ ("INITIALSIZE", &info->open_spec[FFESTP_openixINITIALSIZE]); - ffeste_subr_file_ ("IOSTAT", &info->open_spec[FFESTP_openixIOSTAT]); - ffeste_subr_file_ ("KEY", &info->open_spec[FFESTP_openixKEY]); - ffeste_subr_file_ ("MAXREC", &info->open_spec[FFESTP_openixMAXREC]); - ffeste_subr_file_ ("NOSPANBLOCKS", &info->open_spec[FFESTP_openixNOSPANBLOCKS]); - ffeste_subr_file_ ("ORGANIZATION", &info->open_spec[FFESTP_openixORGANIZATION]); - ffeste_subr_file_ ("PAD", &info->open_spec[FFESTP_openixPAD]); - ffeste_subr_file_ ("POSITION", &info->open_spec[FFESTP_openixPOSITION]); - ffeste_subr_file_ ("READONLY", &info->open_spec[FFESTP_openixREADONLY]); - ffeste_subr_file_ ("RECL", &info->open_spec[FFESTP_openixRECL]); - ffeste_subr_file_ ("RECORDTYPE", &info->open_spec[FFESTP_openixRECORDTYPE]); - ffeste_subr_file_ ("SHARED", &info->open_spec[FFESTP_openixSHARED]); - ffeste_subr_file_ ("STATUS", &info->open_spec[FFESTP_openixSTATUS]); - ffeste_subr_file_ ("USEROPEN", &info->open_spec[FFESTP_openixUSEROPEN]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree args; - bool iostat; - bool errl; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); #define specified(something) (info->open_spec[something].kw_or_val_present) - iostat = specified (FFESTP_openixIOSTAT); - errl = specified (FFESTP_openixERR); + iostat = specified (FFESTP_openixIOSTAT); + errl = specified (FFESTP_openixERR); #undef specified - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - if (errl) - { - ffeste_io_err_ - = ffeste_io_abort_ - = ffecom_lookup_label - (info->open_spec[FFESTP_openixERR].u.label); - ffeste_io_abort_is_temp_ = FALSE; - } - else - { - ffeste_io_err_ = NULL_TREE; + if (errl) + { + ffeste_io_err_ + = ffeste_io_abort_ + = ffecom_lookup_label + (info->open_spec[FFESTP_openixERR].u.label); + ffeste_io_abort_is_temp_ = FALSE; + } + else + { + ffeste_io_err_ = NULL_TREE; - if ((ffeste_io_abort_is_temp_ = iostat)) - ffeste_io_abort_ = ffecom_temp_label (); - else - ffeste_io_abort_ = NULL_TREE; - } + if ((ffeste_io_abort_is_temp_ = iostat)) + ffeste_io_abort_ = ffecom_temp_label (); + else + ffeste_io_abort_ = NULL_TREE; + } - if (iostat) - { - /* Have IOSTAT= specification. */ + if (iostat) + { + /* Have IOSTAT= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = ffecom_expr - (info->open_spec[FFESTP_openixIOSTAT].u.expr); - } - else if (ffeste_io_abort_ != NULL_TREE) - { - /* Have no IOSTAT= but have ERR=. */ + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = ffecom_expr + (info->open_spec[FFESTP_openixIOSTAT].u.expr); + } + else if (ffeste_io_abort_ != NULL_TREE) + { + /* Have no IOSTAT= but have ERR=. */ - ffeste_io_iostat_is_temp_ = TRUE; - ffeste_io_iostat_ - = ffecom_make_tempvar ("open", ffecom_integer_type_node, - FFETARGET_charactersizeNONE, -1); - } - else - { - /* No IOSTAT= or ERR= specification. */ + ffeste_io_iostat_is_temp_ = TRUE; + ffeste_io_iostat_ + = ffecom_make_tempvar ("open", ffecom_integer_type_node, + FFETARGET_charactersizeNONE, -1); + } + else + { + /* No IOSTAT= or ERR= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = NULL_TREE; - } + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = NULL_TREE; + } - /* Now prescan, then convert, all the arguments. */ + /* Now prescan, then convert, all the arguments. */ - args = ffeste_io_olist_ (errl || iostat, - info->open_spec[FFESTP_openixUNIT].u.expr, - &info->open_spec[FFESTP_openixFILE], - &info->open_spec[FFESTP_openixSTATUS], - &info->open_spec[FFESTP_openixACCESS], - &info->open_spec[FFESTP_openixFORM], - &info->open_spec[FFESTP_openixRECL], - &info->open_spec[FFESTP_openixBLANK]); + args = ffeste_io_olist_ (errl || iostat, + info->open_spec[FFESTP_openixUNIT].u.expr, + &info->open_spec[FFESTP_openixFILE], + &info->open_spec[FFESTP_openixSTATUS], + &info->open_spec[FFESTP_openixACCESS], + &info->open_spec[FFESTP_openixFORM], + &info->open_spec[FFESTP_openixRECL], + &info->open_spec[FFESTP_openixBLANK]); - /* Don't generate "if (iostat != 0) goto label;" if label is temp abort + /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ - ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args, NULL_TREE), - ! ffeste_io_abort_is_temp_); + ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args, NULL_TREE), + ! ffeste_io_abort_is_temp_); - /* If we've got a temp label, generate its code here. */ + /* If we've got a temp label, generate its code here. */ - if (ffeste_io_abort_is_temp_) - { - DECL_INITIAL (ffeste_io_abort_) = error_mark_node; - emit_nop (); - expand_label (ffeste_io_abort_); + if (ffeste_io_abort_is_temp_) + { + DECL_INITIAL (ffeste_io_abort_) = error_mark_node; + emit_nop (); + expand_label (ffeste_io_abort_); - assert (ffeste_io_err_ == NULL_TREE); - } + assert (ffeste_io_err_ == NULL_TREE); + } - ffeste_end_stmt_ (); - } -#else -#error -#endif + ffeste_end_stmt_ (); } /* CLOSE statement. */ @@ -3765,103 +3340,90 @@ ffeste_R904 (ffestpOpenStmt *info) void ffeste_R907 (ffestpCloseStmt *info) { - ffeste_check_simple_ (); + tree args; + bool iostat; + bool errl; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ CLOSE (", dmpout); - ffeste_subr_file_ ("UNIT", &info->close_spec[FFESTP_closeixUNIT]); - ffeste_subr_file_ ("ERR", &info->close_spec[FFESTP_closeixERR]); - ffeste_subr_file_ ("IOSTAT", &info->close_spec[FFESTP_closeixIOSTAT]); - ffeste_subr_file_ ("STATUS", &info->close_spec[FFESTP_closeixSTATUS]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree args; - bool iostat; - bool errl; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); #define specified(something) (info->close_spec[something].kw_or_val_present) - iostat = specified (FFESTP_closeixIOSTAT); - errl = specified (FFESTP_closeixERR); + iostat = specified (FFESTP_closeixIOSTAT); + errl = specified (FFESTP_closeixERR); #undef specified - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - if (errl) - { - ffeste_io_err_ - = ffeste_io_abort_ - = ffecom_lookup_label - (info->close_spec[FFESTP_closeixERR].u.label); - ffeste_io_abort_is_temp_ = FALSE; - } - else - { - ffeste_io_err_ = NULL_TREE; + if (errl) + { + ffeste_io_err_ + = ffeste_io_abort_ + = ffecom_lookup_label + (info->close_spec[FFESTP_closeixERR].u.label); + ffeste_io_abort_is_temp_ = FALSE; + } + else + { + ffeste_io_err_ = NULL_TREE; - if ((ffeste_io_abort_is_temp_ = iostat)) - ffeste_io_abort_ = ffecom_temp_label (); - else - ffeste_io_abort_ = NULL_TREE; - } + if ((ffeste_io_abort_is_temp_ = iostat)) + ffeste_io_abort_ = ffecom_temp_label (); + else + ffeste_io_abort_ = NULL_TREE; + } - if (iostat) - { - /* Have IOSTAT= specification. */ + if (iostat) + { + /* Have IOSTAT= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = ffecom_expr - (info->close_spec[FFESTP_closeixIOSTAT].u.expr); - } - else if (ffeste_io_abort_ != NULL_TREE) - { - /* Have no IOSTAT= but have ERR=. */ + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = ffecom_expr + (info->close_spec[FFESTP_closeixIOSTAT].u.expr); + } + else if (ffeste_io_abort_ != NULL_TREE) + { + /* Have no IOSTAT= but have ERR=. */ - ffeste_io_iostat_is_temp_ = TRUE; - ffeste_io_iostat_ - = ffecom_make_tempvar ("close", ffecom_integer_type_node, - FFETARGET_charactersizeNONE, -1); - } - else - { - /* No IOSTAT= or ERR= specification. */ + ffeste_io_iostat_is_temp_ = TRUE; + ffeste_io_iostat_ + = ffecom_make_tempvar ("close", ffecom_integer_type_node, + FFETARGET_charactersizeNONE, -1); + } + else + { + /* No IOSTAT= or ERR= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = NULL_TREE; - } + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = NULL_TREE; + } - /* Now prescan, then convert, all the arguments. */ + /* Now prescan, then convert, all the arguments. */ - args = ffeste_io_cllist_ (errl || iostat, - info->close_spec[FFESTP_closeixUNIT].u.expr, - &info->close_spec[FFESTP_closeixSTATUS]); + args = ffeste_io_cllist_ (errl || iostat, + info->close_spec[FFESTP_closeixUNIT].u.expr, + &info->close_spec[FFESTP_closeixSTATUS]); - /* Don't generate "if (iostat != 0) goto label;" if label is temp abort + /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ - ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args, NULL_TREE), - ! ffeste_io_abort_is_temp_); + ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args, NULL_TREE), + ! ffeste_io_abort_is_temp_); - /* If we've got a temp label, generate its code here. */ + /* If we've got a temp label, generate its code here. */ - if (ffeste_io_abort_is_temp_) - { - DECL_INITIAL (ffeste_io_abort_) = error_mark_node; - emit_nop (); - expand_label (ffeste_io_abort_); + if (ffeste_io_abort_is_temp_) + { + DECL_INITIAL (ffeste_io_abort_) = error_mark_node; + emit_nop (); + expand_label (ffeste_io_abort_); - assert (ffeste_io_err_ == NULL_TREE); - } + assert (ffeste_io_err_ == NULL_TREE); + } - ffeste_end_stmt_ (); - } -#else -#error -#endif + ffeste_end_stmt_ (); } /* READ(...) statement -- start. */ @@ -3871,254 +3433,174 @@ ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED, ffestvUnit unit, ffestvFormat format, bool rec, bool key UNUSED) { + ffecomGfrt start; + ffecomGfrt end; + tree cilist; + bool iostat; + bool errl; + bool endl; + ffeste_check_start_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE + ffeste_emit_line_note_ (); + + /* First determine the start, per-item, and end run-time functions to + call. The per-item function is picked by choosing an ffeste function + to call to handle a given item; it knows how to generate a call to the + appropriate run-time function, and is called an "I/O driver". */ + switch (format) { - case FFESTV_formatNONE: + case FFESTV_formatNONE: /* no FMT= */ + ffeste_io_driver_ = ffeste_io_douio_; if (rec) - fputs ("+ READ_ufdac", dmpout); - else if (key) - fputs ("+ READ_ufidx", dmpout); + start = FFECOM_gfrtSRDUE, end = FFECOM_gfrtERDUE; else - fputs ("+ READ_ufseq", dmpout); + start = FFECOM_gfrtSRSUE, end = FFECOM_gfrtERSUE; break; - case FFESTV_formatLABEL: - case FFESTV_formatCHAREXPR: - case FFESTV_formatINTEXPR: + case FFESTV_formatLABEL: /* FMT=10 */ + case FFESTV_formatCHAREXPR: /* FMT='(I10)' */ + case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */ + ffeste_io_driver_ = ffeste_io_dofio_; if (rec) - fputs ("+ READ_fmdac", dmpout); - else if (key) - fputs ("+ READ_fmidx", dmpout); + start = FFECOM_gfrtSRDFE, end = FFECOM_gfrtERDFE; else if (unit == FFESTV_unitCHAREXPR) - fputs ("+ READ_fmint", dmpout); + start = FFECOM_gfrtSRSFI, end = FFECOM_gfrtERSFI; else - fputs ("+ READ_fmseq", dmpout); + start = FFECOM_gfrtSRSFE, end = FFECOM_gfrtERSFE; break; - case FFESTV_formatASTERISK: + case FFESTV_formatASTERISK: /* FMT=* */ + ffeste_io_driver_ = ffeste_io_dolio_; if (unit == FFESTV_unitCHAREXPR) - fputs ("+ READ_lsint", dmpout); + start = FFECOM_gfrtSRSLI, end = FFECOM_gfrtERSLI; else - fputs ("+ READ_lsseq", dmpout); + start = FFECOM_gfrtSRSLE, end = FFECOM_gfrtERSLE; break; - case FFESTV_formatNAMELIST: - fputs ("+ READ_nlseq", dmpout); + case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST + /FOO/] */ + ffeste_io_driver_ = NULL; /* No start or driver function. */ + start = FFECOM_gfrtSRSNE, end = FFECOM_gfrt; break; default: - assert ("Unexpected kind of format item in R909 READ" == NULL); - } - - if (only_format) - { - fputc (' ', dmpout); - ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]); - fputc (' ', dmpout); - - return; + assert ("Weird stuff" == NULL); + start = FFECOM_gfrt, end = FFECOM_gfrt; + break; } - - fputs (" (", dmpout); - ffeste_subr_file_ ("UNIT", &info->read_spec[FFESTP_readixUNIT]); - ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]); - ffeste_subr_file_ ("ADVANCE", &info->read_spec[FFESTP_readixADVANCE]); - ffeste_subr_file_ ("EOR", &info->read_spec[FFESTP_readixEOR]); - ffeste_subr_file_ ("ERR", &info->read_spec[FFESTP_readixERR]); - ffeste_subr_file_ ("END", &info->read_spec[FFESTP_readixEND]); - ffeste_subr_file_ ("IOSTAT", &info->read_spec[FFESTP_readixIOSTAT]); - ffeste_subr_file_ ("KEYEQ", &info->read_spec[FFESTP_readixKEYEQ]); - ffeste_subr_file_ ("KEYGE", &info->read_spec[FFESTP_readixKEYGE]); - ffeste_subr_file_ ("KEYGT", &info->read_spec[FFESTP_readixKEYGT]); - ffeste_subr_file_ ("KEYID", &info->read_spec[FFESTP_readixKEYID]); - ffeste_subr_file_ ("NULLS", &info->read_spec[FFESTP_readixNULLS]); - ffeste_subr_file_ ("REC", &info->read_spec[FFESTP_readixREC]); - ffeste_subr_file_ ("SIZE", &info->read_spec[FFESTP_readixSIZE]); - fputs (") ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - - ffeste_emit_line_note_ (); - - { - ffecomGfrt start; - ffecomGfrt end; - tree cilist; - bool iostat; - bool errl; - bool endl; - - /* First determine the start, per-item, and end run-time functions to - call. The per-item function is picked by choosing an ffeste function - to call to handle a given item; it knows how to generate a call to the - appropriate run-time function, and is called an "I/O driver". */ - - switch (format) - { - case FFESTV_formatNONE: /* no FMT= */ - ffeste_io_driver_ = ffeste_io_douio_; - if (rec) - start = FFECOM_gfrtSRDUE, end = FFECOM_gfrtERDUE; -#if 0 - else if (key) - start = FFECOM_gfrtSRIUE, end = FFECOM_gfrtERIUE; -#endif - else - start = FFECOM_gfrtSRSUE, end = FFECOM_gfrtERSUE; - break; - - case FFESTV_formatLABEL: /* FMT=10 */ - case FFESTV_formatCHAREXPR: /* FMT='(I10)' */ - case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */ - ffeste_io_driver_ = ffeste_io_dofio_; - if (rec) - start = FFECOM_gfrtSRDFE, end = FFECOM_gfrtERDFE; -#if 0 - else if (key) - start = FFECOM_gfrtSRIFE, end = FFECOM_gfrtERIFE; -#endif - else if (unit == FFESTV_unitCHAREXPR) - start = FFECOM_gfrtSRSFI, end = FFECOM_gfrtERSFI; - else - start = FFECOM_gfrtSRSFE, end = FFECOM_gfrtERSFE; - break; - - case FFESTV_formatASTERISK: /* FMT=* */ - ffeste_io_driver_ = ffeste_io_dolio_; - if (unit == FFESTV_unitCHAREXPR) - start = FFECOM_gfrtSRSLI, end = FFECOM_gfrtERSLI; - else - start = FFECOM_gfrtSRSLE, end = FFECOM_gfrtERSLE; - break; - - case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST - /FOO/] */ - ffeste_io_driver_ = NULL; /* No start or driver function. */ - start = FFECOM_gfrtSRSNE, end = FFECOM_gfrt; - break; - - default: - assert ("Weird stuff" == NULL); - start = FFECOM_gfrt, end = FFECOM_gfrt; - break; - } - ffeste_io_endgfrt_ = end; + ffeste_io_endgfrt_ = end; #define specified(something) (info->read_spec[something].kw_or_val_present) - iostat = specified (FFESTP_readixIOSTAT); - errl = specified (FFESTP_readixERR); - endl = specified (FFESTP_readixEND); + iostat = specified (FFESTP_readixIOSTAT); + errl = specified (FFESTP_readixERR); + endl = specified (FFESTP_readixEND); #undef specified - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - if (errl) - { - /* Have ERR= specification. */ + if (errl) + { + /* Have ERR= specification. */ - ffeste_io_err_ - = ffecom_lookup_label (info->read_spec[FFESTP_readixERR].u.label); + ffeste_io_err_ + = ffecom_lookup_label (info->read_spec[FFESTP_readixERR].u.label); - if (endl) - { - /* Have both ERR= and END=. Need a temp label to handle both. */ - ffeste_io_end_ - = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label); - ffeste_io_abort_is_temp_ = TRUE; + if (endl) + { + /* Have both ERR= and END=. Need a temp label to handle both. */ + ffeste_io_end_ + = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label); + ffeste_io_abort_is_temp_ = TRUE; + ffeste_io_abort_ = ffecom_temp_label (); + } + else + { + /* Have ERR= but no END=. */ + ffeste_io_end_ = NULL_TREE; + if ((ffeste_io_abort_is_temp_ = iostat)) ffeste_io_abort_ = ffecom_temp_label (); - } - else - { - /* Have ERR= but no END=. */ - ffeste_io_end_ = NULL_TREE; - if ((ffeste_io_abort_is_temp_ = iostat)) - ffeste_io_abort_ = ffecom_temp_label (); - else - ffeste_io_abort_ = ffeste_io_err_; - } - } - else - { - /* No ERR= specification. */ + else + ffeste_io_abort_ = ffeste_io_err_; + } + } + else + { + /* No ERR= specification. */ - ffeste_io_err_ = NULL_TREE; - if (endl) - { - /* Have END= but no ERR=. */ - ffeste_io_end_ - = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label); - if ((ffeste_io_abort_is_temp_ = iostat)) - ffeste_io_abort_ = ffecom_temp_label (); - else - ffeste_io_abort_ = ffeste_io_end_; - } - else - { - /* Have no ERR= or END=. */ + ffeste_io_err_ = NULL_TREE; + if (endl) + { + /* Have END= but no ERR=. */ + ffeste_io_end_ + = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label); + if ((ffeste_io_abort_is_temp_ = iostat)) + ffeste_io_abort_ = ffecom_temp_label (); + else + ffeste_io_abort_ = ffeste_io_end_; + } + else + { + /* Have no ERR= or END=. */ - ffeste_io_end_ = NULL_TREE; - if ((ffeste_io_abort_is_temp_ = iostat)) - ffeste_io_abort_ = ffecom_temp_label (); - else - ffeste_io_abort_ = NULL_TREE; - } - } + ffeste_io_end_ = NULL_TREE; + if ((ffeste_io_abort_is_temp_ = iostat)) + ffeste_io_abort_ = ffecom_temp_label (); + else + ffeste_io_abort_ = NULL_TREE; + } + } - if (iostat) - { - /* Have IOSTAT= specification. */ + if (iostat) + { + /* Have IOSTAT= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ - = ffecom_expr (info->read_spec[FFESTP_readixIOSTAT].u.expr); - } - else if (ffeste_io_abort_ != NULL_TREE) - { - /* Have no IOSTAT= but have ERR= and/or END=. */ + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ + = ffecom_expr (info->read_spec[FFESTP_readixIOSTAT].u.expr); + } + else if (ffeste_io_abort_ != NULL_TREE) + { + /* Have no IOSTAT= but have ERR= and/or END=. */ - ffeste_io_iostat_is_temp_ = TRUE; - ffeste_io_iostat_ - = ffecom_make_tempvar ("read", ffecom_integer_type_node, - FFETARGET_charactersizeNONE, -1); - } - else - { - /* No IOSTAT=, ERR=, or END= specification. */ + ffeste_io_iostat_is_temp_ = TRUE; + ffeste_io_iostat_ + = ffecom_make_tempvar ("read", ffecom_integer_type_node, + FFETARGET_charactersizeNONE, -1); + } + else + { + /* No IOSTAT=, ERR=, or END= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = NULL_TREE; - } + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = NULL_TREE; + } - /* Now prescan, then convert, all the arguments. */ - - if (unit == FFESTV_unitCHAREXPR) - cilist = ffeste_io_icilist_ (errl || iostat, - info->read_spec[FFESTP_readixUNIT].u.expr, - endl || iostat, format, - &info->read_spec[FFESTP_readixFORMAT]); - else - cilist = ffeste_io_cilist_ (errl || iostat, unit, - info->read_spec[FFESTP_readixUNIT].u.expr, - 5, endl || iostat, format, - &info->read_spec[FFESTP_readixFORMAT], - rec, - info->read_spec[FFESTP_readixREC].u.expr); - - /* If there is no end function, then there are no item functions (i.e. - it's a NAMELIST), and vice versa by the way. In this situation, don't - generate the "if (iostat != 0) goto label;" if the label is temp abort - label, since we're gonna fall through to there anyway. */ - - ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), - (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); - } -#else -#error -#endif + /* Now prescan, then convert, all the arguments. */ + + if (unit == FFESTV_unitCHAREXPR) + cilist = ffeste_io_icilist_ (errl || iostat, + info->read_spec[FFESTP_readixUNIT].u.expr, + endl || iostat, format, + &info->read_spec[FFESTP_readixFORMAT]); + else + cilist = ffeste_io_cilist_ (errl || iostat, unit, + info->read_spec[FFESTP_readixUNIT].u.expr, + 5, endl || iostat, format, + &info->read_spec[FFESTP_readixFORMAT], + rec, + info->read_spec[FFESTP_readixREC].u.expr); + + /* If there is no end function, then there are no item functions (i.e. + it's a NAMELIST), and vice versa by the way. In this situation, don't + generate the "if (iostat != 0) goto label;" if the label is temp abort + label, since we're gonna fall through to there anyway. */ + + ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), + (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); } /* READ statement -- I/O item. */ @@ -4128,10 +3610,6 @@ ffeste_R909_item (ffebld expr, ffelexToken expr_token) { ffeste_check_item_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; @@ -4157,9 +3635,6 @@ ffeste_R909_item (ffebld expr, ffelexToken expr_token) ffeste_end_stmt_ (); } -#else -#error -#endif } /* READ statement -- end. */ @@ -4169,10 +3644,6 @@ ffeste_R909_finish () { ffeste_check_finish_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ @@ -4220,9 +3691,6 @@ ffeste_R909_finish () } ffeste_end_stmt_ (); -#else -#error -#endif } /* WRITE statement -- start. */ @@ -4231,195 +3699,144 @@ void ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit, ffestvFormat format, bool rec) { + ffecomGfrt start; + ffecomGfrt end; + tree cilist; + bool iostat; + bool errl; + ffeste_check_start_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE + ffeste_emit_line_note_ (); + + /* First determine the start, per-item, and end run-time functions to + call. The per-item function is picked by choosing an ffeste function + to call to handle a given item; it knows how to generate a call to the + appropriate run-time function, and is called an "I/O driver". */ + switch (format) { - case FFESTV_formatNONE: + case FFESTV_formatNONE: /* no FMT= */ + ffeste_io_driver_ = ffeste_io_douio_; if (rec) - fputs ("+ WRITE_ufdac (", dmpout); + start = FFECOM_gfrtSWDUE, end = FFECOM_gfrtEWDUE; else - fputs ("+ WRITE_ufseq_or_idx (", dmpout); + start = FFECOM_gfrtSWSUE, end = FFECOM_gfrtEWSUE; break; - case FFESTV_formatLABEL: - case FFESTV_formatCHAREXPR: - case FFESTV_formatINTEXPR: + case FFESTV_formatLABEL: /* FMT=10 */ + case FFESTV_formatCHAREXPR: /* FMT='(I10)' */ + case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */ + ffeste_io_driver_ = ffeste_io_dofio_; if (rec) - fputs ("+ WRITE_fmdac (", dmpout); + start = FFECOM_gfrtSWDFE, end = FFECOM_gfrtEWDFE; else if (unit == FFESTV_unitCHAREXPR) - fputs ("+ WRITE_fmint (", dmpout); + start = FFECOM_gfrtSWSFI, end = FFECOM_gfrtEWSFI; else - fputs ("+ WRITE_fmseq_or_idx (", dmpout); + start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE; break; - case FFESTV_formatASTERISK: + case FFESTV_formatASTERISK: /* FMT=* */ + ffeste_io_driver_ = ffeste_io_dolio_; if (unit == FFESTV_unitCHAREXPR) - fputs ("+ WRITE_lsint (", dmpout); + start = FFECOM_gfrtSWSLI, end = FFECOM_gfrtEWSLI; else - fputs ("+ WRITE_lsseq (", dmpout); + start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE; break; - case FFESTV_formatNAMELIST: - fputs ("+ WRITE_nlseq (", dmpout); + case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST + /FOO/] */ + ffeste_io_driver_ = NULL; /* No start or driver function. */ + start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt; break; default: - assert ("Unexpected kind of format item in R910 WRITE" == NULL); + assert ("Weird stuff" == NULL); + start = FFECOM_gfrt, end = FFECOM_gfrt; + break; } - - ffeste_subr_file_ ("UNIT", &info->write_spec[FFESTP_writeixUNIT]); - ffeste_subr_file_ ("FORMAT", &info->write_spec[FFESTP_writeixFORMAT]); - ffeste_subr_file_ ("ADVANCE", &info->write_spec[FFESTP_writeixADVANCE]); - ffeste_subr_file_ ("EOR", &info->write_spec[FFESTP_writeixEOR]); - ffeste_subr_file_ ("ERR", &info->write_spec[FFESTP_writeixERR]); - ffeste_subr_file_ ("IOSTAT", &info->write_spec[FFESTP_writeixIOSTAT]); - ffeste_subr_file_ ("REC", &info->write_spec[FFESTP_writeixREC]); - fputs (") ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - - ffeste_emit_line_note_ (); - - { - ffecomGfrt start; - ffecomGfrt end; - tree cilist; - bool iostat; - bool errl; - - /* First determine the start, per-item, and end run-time functions to - call. The per-item function is picked by choosing an ffeste function - to call to handle a given item; it knows how to generate a call to the - appropriate run-time function, and is called an "I/O driver". */ - - switch (format) - { - case FFESTV_formatNONE: /* no FMT= */ - ffeste_io_driver_ = ffeste_io_douio_; - if (rec) - start = FFECOM_gfrtSWDUE, end = FFECOM_gfrtEWDUE; - else - start = FFECOM_gfrtSWSUE, end = FFECOM_gfrtEWSUE; - break; - - case FFESTV_formatLABEL: /* FMT=10 */ - case FFESTV_formatCHAREXPR: /* FMT='(I10)' */ - case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */ - ffeste_io_driver_ = ffeste_io_dofio_; - if (rec) - start = FFECOM_gfrtSWDFE, end = FFECOM_gfrtEWDFE; - else if (unit == FFESTV_unitCHAREXPR) - start = FFECOM_gfrtSWSFI, end = FFECOM_gfrtEWSFI; - else - start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE; - break; - - case FFESTV_formatASTERISK: /* FMT=* */ - ffeste_io_driver_ = ffeste_io_dolio_; - if (unit == FFESTV_unitCHAREXPR) - start = FFECOM_gfrtSWSLI, end = FFECOM_gfrtEWSLI; - else - start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE; - break; - - case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST - /FOO/] */ - ffeste_io_driver_ = NULL; /* No start or driver function. */ - start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt; - break; - - default: - assert ("Weird stuff" == NULL); - start = FFECOM_gfrt, end = FFECOM_gfrt; - break; - } - ffeste_io_endgfrt_ = end; + ffeste_io_endgfrt_ = end; #define specified(something) (info->write_spec[something].kw_or_val_present) - iostat = specified (FFESTP_writeixIOSTAT); - errl = specified (FFESTP_writeixERR); + iostat = specified (FFESTP_writeixIOSTAT); + errl = specified (FFESTP_writeixERR); #undef specified - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffeste_io_end_ = NULL_TREE; + ffeste_io_end_ = NULL_TREE; - if (errl) - { - /* Have ERR= specification. */ + if (errl) + { + /* Have ERR= specification. */ - ffeste_io_err_ - = ffeste_io_abort_ - = ffecom_lookup_label - (info->write_spec[FFESTP_writeixERR].u.label); - ffeste_io_abort_is_temp_ = FALSE; - } - else - { - /* No ERR= specification. */ + ffeste_io_err_ + = ffeste_io_abort_ + = ffecom_lookup_label + (info->write_spec[FFESTP_writeixERR].u.label); + ffeste_io_abort_is_temp_ = FALSE; + } + else + { + /* No ERR= specification. */ - ffeste_io_err_ = NULL_TREE; + ffeste_io_err_ = NULL_TREE; - if ((ffeste_io_abort_is_temp_ = iostat)) - ffeste_io_abort_ = ffecom_temp_label (); - else - ffeste_io_abort_ = NULL_TREE; - } + if ((ffeste_io_abort_is_temp_ = iostat)) + ffeste_io_abort_ = ffecom_temp_label (); + else + ffeste_io_abort_ = NULL_TREE; + } - if (iostat) - { - /* Have IOSTAT= specification. */ + if (iostat) + { + /* Have IOSTAT= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = ffecom_expr - (info->write_spec[FFESTP_writeixIOSTAT].u.expr); - } - else if (ffeste_io_abort_ != NULL_TREE) - { - /* Have no IOSTAT= but have ERR=. */ + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = ffecom_expr + (info->write_spec[FFESTP_writeixIOSTAT].u.expr); + } + else if (ffeste_io_abort_ != NULL_TREE) + { + /* Have no IOSTAT= but have ERR=. */ - ffeste_io_iostat_is_temp_ = TRUE; - ffeste_io_iostat_ - = ffecom_make_tempvar ("write", ffecom_integer_type_node, - FFETARGET_charactersizeNONE, -1); - } - else - { - /* No IOSTAT= or ERR= specification. */ + ffeste_io_iostat_is_temp_ = TRUE; + ffeste_io_iostat_ + = ffecom_make_tempvar ("write", ffecom_integer_type_node, + FFETARGET_charactersizeNONE, -1); + } + else + { + /* No IOSTAT= or ERR= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = NULL_TREE; - } + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = NULL_TREE; + } - /* Now prescan, then convert, all the arguments. */ - - if (unit == FFESTV_unitCHAREXPR) - cilist = ffeste_io_icilist_ (errl || iostat, - info->write_spec[FFESTP_writeixUNIT].u.expr, - FALSE, format, - &info->write_spec[FFESTP_writeixFORMAT]); - else - cilist = ffeste_io_cilist_ (errl || iostat, unit, - info->write_spec[FFESTP_writeixUNIT].u.expr, - 6, FALSE, format, - &info->write_spec[FFESTP_writeixFORMAT], - rec, - info->write_spec[FFESTP_writeixREC].u.expr); - - /* If there is no end function, then there are no item functions (i.e. - it's a NAMELIST), and vice versa by the way. In this situation, don't - generate the "if (iostat != 0) goto label;" if the label is temp abort - label, since we're gonna fall through to there anyway. */ - - ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), - (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); - } -#else -#error -#endif + /* Now prescan, then convert, all the arguments. */ + + if (unit == FFESTV_unitCHAREXPR) + cilist = ffeste_io_icilist_ (errl || iostat, + info->write_spec[FFESTP_writeixUNIT].u.expr, + FALSE, format, + &info->write_spec[FFESTP_writeixFORMAT]); + else + cilist = ffeste_io_cilist_ (errl || iostat, unit, + info->write_spec[FFESTP_writeixUNIT].u.expr, + 6, FALSE, format, + &info->write_spec[FFESTP_writeixFORMAT], + rec, + info->write_spec[FFESTP_writeixREC].u.expr); + + /* If there is no end function, then there are no item functions (i.e. + it's a NAMELIST), and vice versa by the way. In this situation, don't + generate the "if (iostat != 0) goto label;" if the label is temp abort + label, since we're gonna fall through to there anyway. */ + + ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), + (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); } /* WRITE statement -- I/O item. */ @@ -4429,10 +3846,6 @@ ffeste_R910_item (ffebld expr, ffelexToken expr_token) { ffeste_check_item_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; @@ -4453,9 +3866,6 @@ ffeste_R910_item (ffebld expr, ffelexToken expr_token) ffeste_end_stmt_ (); } -#else -#error -#endif } /* WRITE statement -- end. */ @@ -4465,10 +3875,6 @@ ffeste_R910_finish () { ffeste_check_finish_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - /* Don't generate "if (iostat != 0) goto label;" if label is temp abort label, since we're gonna fall through to there anyway. */ @@ -4489,9 +3895,6 @@ ffeste_R910_finish () } ffeste_end_stmt_ (); -#else -#error -#endif } /* PRINT statement -- start. */ @@ -4499,96 +3902,68 @@ ffeste_R910_finish () void ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format) { + ffecomGfrt start; + ffecomGfrt end; + tree cilist; + ffeste_check_start_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE + ffeste_emit_line_note_ (); + + /* First determine the start, per-item, and end run-time functions to + call. The per-item function is picked by choosing an ffeste function + to call to handle a given item; it knows how to generate a call to the + appropriate run-time function, and is called an "I/O driver". */ + switch (format) { - case FFESTV_formatLABEL: - case FFESTV_formatCHAREXPR: - case FFESTV_formatINTEXPR: - fputs ("+ PRINT_fm ", dmpout); + case FFESTV_formatLABEL: /* FMT=10 */ + case FFESTV_formatCHAREXPR: /* FMT='(I10)' */ + case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */ + ffeste_io_driver_ = ffeste_io_dofio_; + start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE; break; - case FFESTV_formatASTERISK: - fputs ("+ PRINT_ls ", dmpout); + case FFESTV_formatASTERISK: /* FMT=* */ + ffeste_io_driver_ = ffeste_io_dolio_; + start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE; break; - case FFESTV_formatNAMELIST: - fputs ("+ PRINT_nl ", dmpout); + case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST + /FOO/] */ + ffeste_io_driver_ = NULL; /* No start or driver function. */ + start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt; break; default: - assert ("Unexpected kind of format item in R911 PRINT" == NULL); + assert ("Weird stuff" == NULL); + start = FFECOM_gfrt, end = FFECOM_gfrt; + break; } - ffeste_subr_file_ ("FORMAT", &info->print_spec[FFESTP_printixFORMAT]); - fputc (' ', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - - ffeste_emit_line_note_ (); + ffeste_io_endgfrt_ = end; - { - ffecomGfrt start; - ffecomGfrt end; - tree cilist; - - /* First determine the start, per-item, and end run-time functions to - call. The per-item function is picked by choosing an ffeste function - to call to handle a given item; it knows how to generate a call to the - appropriate run-time function, and is called an "I/O driver". */ - - switch (format) - { - case FFESTV_formatLABEL: /* FMT=10 */ - case FFESTV_formatCHAREXPR: /* FMT='(I10)' */ - case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */ - ffeste_io_driver_ = ffeste_io_dofio_; - start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE; - break; - - case FFESTV_formatASTERISK: /* FMT=* */ - ffeste_io_driver_ = ffeste_io_dolio_; - start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE; - break; - - case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST - /FOO/] */ - ffeste_io_driver_ = NULL; /* No start or driver function. */ - start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt; - break; - - default: - assert ("Weird stuff" == NULL); - start = FFECOM_gfrt, end = FFECOM_gfrt; - break; - } - ffeste_io_endgfrt_ = end; - - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffeste_io_end_ = NULL_TREE; - ffeste_io_err_ = NULL_TREE; - ffeste_io_abort_ = NULL_TREE; - ffeste_io_abort_is_temp_ = FALSE; - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = NULL_TREE; + ffeste_io_end_ = NULL_TREE; + ffeste_io_err_ = NULL_TREE; + ffeste_io_abort_ = NULL_TREE; + ffeste_io_abort_is_temp_ = FALSE; + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = NULL_TREE; - /* Now prescan, then convert, all the arguments. */ + /* Now prescan, then convert, all the arguments. */ - cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format, - &info->print_spec[FFESTP_printixFORMAT], FALSE, NULL); + cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format, + &info->print_spec[FFESTP_printixFORMAT], + FALSE, NULL); - /* If there is no end function, then there are no item functions (i.e. - it's a NAMELIST), and vice versa by the way. In this situation, don't - generate the "if (iostat != 0) goto label;" if the label is temp abort - label, since we're gonna fall through to there anyway. */ + /* If there is no end function, then there are no item functions (i.e. + it's a NAMELIST), and vice versa by the way. In this situation, don't + generate the "if (iostat != 0) goto label;" if the label is temp abort + label, since we're gonna fall through to there anyway. */ - ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), - (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); - } -#else -#error -#endif + ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE), + (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt)); } /* PRINT statement -- I/O item. */ @@ -4598,10 +3973,6 @@ ffeste_R911_item (ffebld expr, ffelexToken expr_token) { ffeste_check_item_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC if (expr == NULL) return; @@ -4622,9 +3993,6 @@ ffeste_R911_item (ffebld expr, ffelexToken expr_token) ffeste_end_stmt_ (); } -#else -#error -#endif } /* PRINT statement -- end. */ @@ -4634,19 +4002,12 @@ ffeste_R911_finish () { ffeste_check_finish_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - if (ffeste_io_endgfrt_ != FFECOM_gfrt) ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE, NULL_TREE), FALSE); ffeste_end_stmt_ (); -#else -#error -#endif } /* BACKSPACE statement. */ @@ -4656,17 +4017,7 @@ ffeste_R919 (ffestpBeruStmt *info) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ BACKSPACE (", dmpout); - ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]); - ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]); - ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFBACK); -#else -#error -#endif } /* ENDFILE statement. */ @@ -4676,17 +4027,7 @@ ffeste_R920 (ffestpBeruStmt *info) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ ENDFILE (", dmpout); - ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]); - ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]); - ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFEND); -#else -#error -#endif } /* REWIND statement. */ @@ -4696,17 +4037,7 @@ ffeste_R921 (ffestpBeruStmt *info) { ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ REWIND (", dmpout); - ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]); - ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]); - ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC ffeste_subr_beru_ (info, FFECOM_gfrtFREW); -#else -#error -#endif } /* INQUIRE statement (non-IOLENGTH version). */ @@ -4714,151 +4045,105 @@ ffeste_R921 (ffestpBeruStmt *info) void ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED) { - ffeste_check_simple_ (); + tree args; + bool iostat; + bool errl; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (by_file) - { - fputs ("+ INQUIRE_file (", dmpout); - ffeste_subr_file_ ("FILE", &info->inquire_spec[FFESTP_inquireixFILE]); - } - else - { - fputs ("+ INQUIRE_unit (", dmpout); - ffeste_subr_file_ ("UNIT", &info->inquire_spec[FFESTP_inquireixUNIT]); - } - ffeste_subr_file_ ("ACCESS", &info->inquire_spec[FFESTP_inquireixACCESS]); - ffeste_subr_file_ ("ACTION", &info->inquire_spec[FFESTP_inquireixACTION]); - ffeste_subr_file_ ("BLANK", &info->inquire_spec[FFESTP_inquireixBLANK]); - ffeste_subr_file_ ("CARRIAGECONTROL", &info->inquire_spec[FFESTP_inquireixCARRIAGECONTROL]); - ffeste_subr_file_ ("DEFAULTFILE", &info->inquire_spec[FFESTP_inquireixDEFAULTFILE]); - ffeste_subr_file_ ("DELIM", &info->inquire_spec[FFESTP_inquireixDELIM]); - ffeste_subr_file_ ("DIRECT", &info->inquire_spec[FFESTP_inquireixDIRECT]); - ffeste_subr_file_ ("ERR", &info->inquire_spec[FFESTP_inquireixERR]); - ffeste_subr_file_ ("EXIST", &info->inquire_spec[FFESTP_inquireixEXIST]); - ffeste_subr_file_ ("FORM", &info->inquire_spec[FFESTP_inquireixFORM]); - ffeste_subr_file_ ("FORMATTED", &info->inquire_spec[FFESTP_inquireixFORMATTED]); - ffeste_subr_file_ ("IOSTAT", &info->inquire_spec[FFESTP_inquireixIOSTAT]); - ffeste_subr_file_ ("KEYED", &info->inquire_spec[FFESTP_inquireixKEYED]); - ffeste_subr_file_ ("NAME", &info->inquire_spec[FFESTP_inquireixNAME]); - ffeste_subr_file_ ("NAMED", &info->inquire_spec[FFESTP_inquireixNAMED]); - ffeste_subr_file_ ("NEXTREC", &info->inquire_spec[FFESTP_inquireixNEXTREC]); - ffeste_subr_file_ ("NUMBER", &info->inquire_spec[FFESTP_inquireixNUMBER]); - ffeste_subr_file_ ("OPENED", &info->inquire_spec[FFESTP_inquireixOPENED]); - ffeste_subr_file_ ("ORGANIZATION", &info->inquire_spec[FFESTP_inquireixORGANIZATION]); - ffeste_subr_file_ ("PAD", &info->inquire_spec[FFESTP_inquireixPAD]); - ffeste_subr_file_ ("POSITION", &info->inquire_spec[FFESTP_inquireixPOSITION]); - ffeste_subr_file_ ("READ", &info->inquire_spec[FFESTP_inquireixREAD]); - ffeste_subr_file_ ("READWRITE", &info->inquire_spec[FFESTP_inquireixREADWRITE]); - ffeste_subr_file_ ("RECL", &info->inquire_spec[FFESTP_inquireixRECL]); - ffeste_subr_file_ ("RECORDTYPE", &info->inquire_spec[FFESTP_inquireixRECORDTYPE]); - ffeste_subr_file_ ("SEQUENTIAL", &info->inquire_spec[FFESTP_inquireixSEQUENTIAL]); - ffeste_subr_file_ ("UNFORMATTED", &info->inquire_spec[FFESTP_inquireixUNFORMATTED]); - ffeste_subr_file_ ("WRITE", &info->inquire_spec[FFESTP_inquireixWRITE]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree args; - bool iostat; - bool errl; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); #define specified(something) (info->inquire_spec[something].kw_or_val_present) - iostat = specified (FFESTP_inquireixIOSTAT); - errl = specified (FFESTP_inquireixERR); + iostat = specified (FFESTP_inquireixIOSTAT); + errl = specified (FFESTP_inquireixERR); #undef specified - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - if (errl) - { - ffeste_io_err_ - = ffeste_io_abort_ - = ffecom_lookup_label - (info->inquire_spec[FFESTP_inquireixERR].u.label); - ffeste_io_abort_is_temp_ = FALSE; - } - else - { - ffeste_io_err_ = NULL_TREE; + if (errl) + { + ffeste_io_err_ + = ffeste_io_abort_ + = ffecom_lookup_label + (info->inquire_spec[FFESTP_inquireixERR].u.label); + ffeste_io_abort_is_temp_ = FALSE; + } + else + { + ffeste_io_err_ = NULL_TREE; - if ((ffeste_io_abort_is_temp_ = iostat)) - ffeste_io_abort_ = ffecom_temp_label (); - else - ffeste_io_abort_ = NULL_TREE; - } + if ((ffeste_io_abort_is_temp_ = iostat)) + ffeste_io_abort_ = ffecom_temp_label (); + else + ffeste_io_abort_ = NULL_TREE; + } - if (iostat) - { - /* Have IOSTAT= specification. */ + if (iostat) + { + /* Have IOSTAT= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = ffecom_expr - (info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr); - } - else if (ffeste_io_abort_ != NULL_TREE) - { - /* Have no IOSTAT= but have ERR=. */ + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = ffecom_expr + (info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr); + } + else if (ffeste_io_abort_ != NULL_TREE) + { + /* Have no IOSTAT= but have ERR=. */ - ffeste_io_iostat_is_temp_ = TRUE; - ffeste_io_iostat_ - = ffecom_make_tempvar ("inquire", ffecom_integer_type_node, - FFETARGET_charactersizeNONE, -1); - } - else - { - /* No IOSTAT= or ERR= specification. */ + ffeste_io_iostat_is_temp_ = TRUE; + ffeste_io_iostat_ + = ffecom_make_tempvar ("inquire", ffecom_integer_type_node, + FFETARGET_charactersizeNONE, -1); + } + else + { + /* No IOSTAT= or ERR= specification. */ - ffeste_io_iostat_is_temp_ = FALSE; - ffeste_io_iostat_ = NULL_TREE; - } + ffeste_io_iostat_is_temp_ = FALSE; + ffeste_io_iostat_ = NULL_TREE; + } - /* Now prescan, then convert, all the arguments. */ - - args - = ffeste_io_inlist_ (errl || iostat, - &info->inquire_spec[FFESTP_inquireixUNIT], - &info->inquire_spec[FFESTP_inquireixFILE], - &info->inquire_spec[FFESTP_inquireixEXIST], - &info->inquire_spec[FFESTP_inquireixOPENED], - &info->inquire_spec[FFESTP_inquireixNUMBER], - &info->inquire_spec[FFESTP_inquireixNAMED], - &info->inquire_spec[FFESTP_inquireixNAME], - &info->inquire_spec[FFESTP_inquireixACCESS], - &info->inquire_spec[FFESTP_inquireixSEQUENTIAL], - &info->inquire_spec[FFESTP_inquireixDIRECT], - &info->inquire_spec[FFESTP_inquireixFORM], - &info->inquire_spec[FFESTP_inquireixFORMATTED], - &info->inquire_spec[FFESTP_inquireixUNFORMATTED], - &info->inquire_spec[FFESTP_inquireixRECL], - &info->inquire_spec[FFESTP_inquireixNEXTREC], - &info->inquire_spec[FFESTP_inquireixBLANK]); - - /* Don't generate "if (iostat != 0) goto label;" if label is temp abort - label, since we're gonna fall through to there anyway. */ + /* Now prescan, then convert, all the arguments. */ - ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args, NULL_TREE), - ! ffeste_io_abort_is_temp_); + args + = ffeste_io_inlist_ (errl || iostat, + &info->inquire_spec[FFESTP_inquireixUNIT], + &info->inquire_spec[FFESTP_inquireixFILE], + &info->inquire_spec[FFESTP_inquireixEXIST], + &info->inquire_spec[FFESTP_inquireixOPENED], + &info->inquire_spec[FFESTP_inquireixNUMBER], + &info->inquire_spec[FFESTP_inquireixNAMED], + &info->inquire_spec[FFESTP_inquireixNAME], + &info->inquire_spec[FFESTP_inquireixACCESS], + &info->inquire_spec[FFESTP_inquireixSEQUENTIAL], + &info->inquire_spec[FFESTP_inquireixDIRECT], + &info->inquire_spec[FFESTP_inquireixFORM], + &info->inquire_spec[FFESTP_inquireixFORMATTED], + &info->inquire_spec[FFESTP_inquireixUNFORMATTED], + &info->inquire_spec[FFESTP_inquireixRECL], + &info->inquire_spec[FFESTP_inquireixNEXTREC], + &info->inquire_spec[FFESTP_inquireixBLANK]); - /* If we've got a temp label, generate its code here. */ + /* Don't generate "if (iostat != 0) goto label;" if label is temp abort + label, since we're gonna fall through to there anyway. */ - if (ffeste_io_abort_is_temp_) - { - DECL_INITIAL (ffeste_io_abort_) = error_mark_node; - emit_nop (); - expand_label (ffeste_io_abort_); + ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args, NULL_TREE), + ! ffeste_io_abort_is_temp_); - assert (ffeste_io_err_ == NULL_TREE); - } + /* If we've got a temp label, generate its code here. */ - ffeste_end_stmt_ (); - } -#else -#error -#endif + if (ffeste_io_abort_is_temp_) + { + DECL_INITIAL (ffeste_io_abort_) = error_mark_node; + emit_nop (); + expand_label (ffeste_io_abort_); + + assert (ffeste_io_err_ == NULL_TREE); + } + + ffeste_end_stmt_ (); } /* INQUIRE(IOLENGTH=expr) statement -- start. */ @@ -4868,17 +4153,9 @@ ffeste_R923B_start (ffestpInquireStmt *info UNUSED) { ffeste_check_start_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ INQUIRE (", dmpout); - ffeste_subr_file_ ("IOLENGTH", &info->inquire_spec[FFESTP_inquireixIOLENGTH]); - fputs (") ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC assert ("INQUIRE(IOLENGTH=<var>) not implemented yet! ~~~" == NULL); ffeste_emit_line_note_ (); -#else -#error -#endif } /* INQUIRE(IOLENGTH=expr) statement -- I/O item. */ @@ -4887,14 +4164,6 @@ void ffeste_R923B_item (ffebld expr UNUSED) { ffeste_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* INQUIRE(IOLENGTH=expr) statement -- end. */ @@ -4903,13 +4172,6 @@ void ffeste_R923B_finish () { ffeste_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ffeste_R1001 -- FORMAT statement @@ -4919,57 +4181,49 @@ ffeste_R923B_finish () void ffeste_R1001 (ffests s) { - ffeste_check_simple_ (); + tree t; + tree ttype; + tree maxindex; + tree var; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "$ FORMAT %.*s\n", (int) ffests_length (s), ffests_text (s)); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree t; - tree ttype; - tree maxindex; - tree var; + ffeste_check_simple_ (); - assert (ffeste_label_formatdef_ != NULL); + assert (ffeste_label_formatdef_ != NULL); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - t = build_string (ffests_length (s), ffests_text (s)); + t = build_string (ffests_length (s), ffests_text (s)); - TREE_TYPE (t) - = build_type_variant (build_array_type - (char_type_node, - build_range_type (integer_type_node, - integer_one_node, + TREE_TYPE (t) + = build_type_variant (build_array_type + (char_type_node, + build_range_type (integer_type_node, + integer_one_node, build_int_2 (ffests_length (s), 0))), - 1, 0); - TREE_CONSTANT (t) = 1; - TREE_STATIC (t) = 1; + 1, 0); + TREE_CONSTANT (t) = 1; + TREE_STATIC (t) = 1; - var = ffecom_lookup_label (ffeste_label_formatdef_); - if ((var != NULL_TREE) - && (TREE_CODE (var) == VAR_DECL)) - { - DECL_INITIAL (var) = t; - maxindex = build_int_2 (ffests_length (s) - 1, 0); - ttype = TREE_TYPE (var); - TYPE_DOMAIN (ttype) = build_range_type (integer_type_node, - integer_zero_node, - maxindex); - if (!TREE_TYPE (maxindex)) - TREE_TYPE (maxindex) = TYPE_DOMAIN (ttype); - layout_type (ttype); - rest_of_decl_compilation (var, NULL, 1, 0); - expand_decl (var); - expand_decl_init (var); - } + var = ffecom_lookup_label (ffeste_label_formatdef_); + if ((var != NULL_TREE) + && (TREE_CODE (var) == VAR_DECL)) + { + DECL_INITIAL (var) = t; + maxindex = build_int_2 (ffests_length (s) - 1, 0); + ttype = TREE_TYPE (var); + TYPE_DOMAIN (ttype) = build_range_type (integer_type_node, + integer_zero_node, + maxindex); + if (!TREE_TYPE (maxindex)) + TREE_TYPE (maxindex) = TYPE_DOMAIN (ttype); + layout_type (ttype); + rest_of_decl_compilation (var, NULL, 1, 0); + expand_decl (var); + expand_decl_init (var); + } - ffeste_label_formatdef_ = NULL; - } -#else -#error -#endif + ffeste_label_formatdef_ = NULL; } /* END PROGRAM. */ @@ -4977,12 +4231,6 @@ ffeste_R1001 (ffests s) void ffeste_R1103 () { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ END_PROGRAM\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* END BLOCK DATA. */ @@ -4990,12 +4238,6 @@ ffeste_R1103 () void ffeste_R1112 () { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("* END_BLOCK_DATA\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* CALL statement. */ @@ -5003,129 +4245,121 @@ ffeste_R1112 () void ffeste_R1212 (ffebld expr) { + ffebld args; + ffebld arg; + ffebld labels = NULL; /* First in list of LABTERs. */ + ffebld prevlabels = NULL; + ffebld prevargs = NULL; + ffeste_check_simple_ (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ CALL ", dmpout); - ffebld_dump (expr); - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - ffebld args = ffebld_right (expr); - ffebld arg; - ffebld labels = NULL; /* First in list of LABTERs. */ - ffebld prevlabels = NULL; - ffebld prevargs = NULL; + args = ffebld_right (expr); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - /* Here we split the list at ffebld_right(expr) into two lists: one at - ffebld_right(expr) consisting of all items that are not LABTERs, the - other at labels consisting of all items that are LABTERs. Then, if - the latter list is NULL, we have an ordinary call, else we have a call - with alternate returns. */ + /* Here we split the list at ffebld_right(expr) into two lists: one at + ffebld_right(expr) consisting of all items that are not LABTERs, the + other at labels consisting of all items that are LABTERs. Then, if + the latter list is NULL, we have an ordinary call, else we have a call + with alternate returns. */ - for (args = ffebld_right (expr); args != NULL; args = ffebld_trail (args)) - { - if (((arg = ffebld_head (args)) == NULL) - || (ffebld_op (arg) != FFEBLD_opLABTER)) - { - if (prevargs == NULL) - { - prevargs = args; - ffebld_set_right (expr, args); - } - else - { - ffebld_set_trail (prevargs, args); - prevargs = args; - } - } - else - { - if (prevlabels == NULL) - { - prevlabels = labels = args; - } - else - { - ffebld_set_trail (prevlabels, args); - prevlabels = args; - } - } - } - if (prevlabels == NULL) - labels = NULL; - else - ffebld_set_trail (prevlabels, NULL); - if (prevargs == NULL) - ffebld_set_right (expr, NULL); - else - ffebld_set_trail (prevargs, NULL); + for (args = ffebld_right (expr); args != NULL; args = ffebld_trail (args)) + { + if (((arg = ffebld_head (args)) == NULL) + || (ffebld_op (arg) != FFEBLD_opLABTER)) + { + if (prevargs == NULL) + { + prevargs = args; + ffebld_set_right (expr, args); + } + else + { + ffebld_set_trail (prevargs, args); + prevargs = args; + } + } + else + { + if (prevlabels == NULL) + { + prevlabels = labels = args; + } + else + { + ffebld_set_trail (prevlabels, args); + prevlabels = args; + } + } + } + if (prevlabels == NULL) + labels = NULL; + else + ffebld_set_trail (prevlabels, NULL); + if (prevargs == NULL) + ffebld_set_right (expr, NULL); + else + ffebld_set_trail (prevargs, NULL); - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - /* No temporaries are actually needed at this level, but we go - through the motions anyway, just to be sure in case they do - get made. Temporaries needed for arguments should be in the - scopes of inner blocks, and if clean-up actions are supported, - such as CALL-ing an intrinsic that writes to an argument of one - type when a variable of a different type is provided (requiring - assignment to the variable from a temporary after the library - routine returns), the clean-up must be done by the expression - evaluator, generally, to handle alternate returns (which we hope - won't ever be supported by intrinsics, but might be a similar - issue, such as CALL-ing an F90-style subroutine with an INTERFACE - block). That implies the expression evaluator will have to - recognize the need for its own temporary anyway, meaning it'll - construct a block within the one constructed here. */ - - ffecom_prepare_expr (expr); - - ffecom_prepare_end (); - - if (labels == NULL) - expand_expr_stmt (ffecom_expr (expr)); - else - { - tree texpr; - tree value; - tree tlabel; - int caseno; - int pushok; - tree duplicate; - ffebld label; - - texpr = ffecom_expr (expr); - expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement"); - - for (caseno = 1, label = labels; - label != NULL; - ++caseno, label = ffebld_trail (label)) - { - value = build_int_2 (caseno, 0); - tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); - - pushok = pushcase (value, convert, tlabel, &duplicate); - assert (pushok == 0); - - tlabel - = ffecom_lookup_label (ffebld_labter (ffebld_head (label))); - if ((tlabel == NULL_TREE) - || (TREE_CODE (tlabel) == ERROR_MARK)) - continue; - TREE_USED (tlabel) = 1; - expand_goto (tlabel); - } + /* No temporaries are actually needed at this level, but we go + through the motions anyway, just to be sure in case they do + get made. Temporaries needed for arguments should be in the + scopes of inner blocks, and if clean-up actions are supported, + such as CALL-ing an intrinsic that writes to an argument of one + type when a variable of a different type is provided (requiring + assignment to the variable from a temporary after the library + routine returns), the clean-up must be done by the expression + evaluator, generally, to handle alternate returns (which we hope + won't ever be supported by intrinsics, but might be a similar + issue, such as CALL-ing an F90-style subroutine with an INTERFACE + block). That implies the expression evaluator will have to + recognize the need for its own temporary anyway, meaning it'll + construct a block within the one constructed here. */ + + ffecom_prepare_expr (expr); - expand_end_case (texpr); - } + ffecom_prepare_end (); - ffeste_end_stmt_ (); - } -#else -#error -#endif + if (labels == NULL) + expand_expr_stmt (ffecom_expr (expr)); + else + { + tree texpr; + tree value; + tree tlabel; + int caseno; + int pushok; + tree duplicate; + ffebld label; + + texpr = ffecom_expr (expr); + expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement"); + + for (caseno = 1, label = labels; + label != NULL; + ++caseno, label = ffebld_trail (label)) + { + value = build_int_2 (caseno, 0); + tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE); + + pushok = pushcase (value, convert, tlabel, &duplicate); + assert (pushok == 0); + + tlabel + = ffecom_lookup_label (ffebld_labter (ffebld_head (label))); + if ((tlabel == NULL_TREE) + || (TREE_CODE (tlabel) == ERROR_MARK)) + continue; + TREE_USED (tlabel) = 1; + expand_goto (tlabel); + } + + expand_end_case (texpr); + } + + ffeste_end_stmt_ (); } /* END FUNCTION. */ @@ -5133,12 +4367,6 @@ ffeste_R1212 (ffebld expr) void ffeste_R1221 () { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ END_FUNCTION\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* END SUBROUTINE. */ @@ -5146,12 +4374,6 @@ ffeste_R1221 () void ffeste_R1225 () { -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "+ END_SUBROUTINE\n"); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ENTRY statement. */ @@ -5159,59 +4381,20 @@ ffeste_R1225 () void ffeste_R1226 (ffesymbol entry) { - ffeste_check_simple_ (); + tree label; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "+ ENTRY %s", ffesymbol_text (entry)); - if (ffesymbol_dummyargs (entry) != NULL) - { - ffebld argh; + ffeste_check_simple_ (); - fputc ('(', dmpout); - for (argh = ffesymbol_dummyargs (entry); - argh != NULL; - argh = ffebld_trail (argh)) - { - assert (ffebld_head (argh) != NULL); - switch (ffebld_op (ffebld_head (argh))) - { - case FFEBLD_opSYMTER: - fputs (ffesymbol_text (ffebld_symter (ffebld_head (argh))), - dmpout); - break; - - case FFEBLD_opSTAR: - fputc ('*', dmpout); - break; - - default: - fputc ('?', dmpout); - ffebld_dump (ffebld_head (argh)); - fputc ('?', dmpout); - break; - } - if (ffebld_trail (argh) != NULL) - fputc (',', dmpout); - } - fputc (')', dmpout); - } - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree label = ffesymbol_hook (entry).length_tree; + label = ffesymbol_hook (entry).length_tree; - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - if (label == error_mark_node) - return; + if (label == error_mark_node) + return; - DECL_INITIAL (label) = error_mark_node; - emit_nop (); - expand_label (label); - } -#else -#error -#endif + DECL_INITIAL (label) = error_mark_node; + emit_nop (); + expand_label (label); } /* RETURN statement. */ @@ -5219,55 +4402,38 @@ ffeste_R1226 (ffesymbol entry) void ffeste_R1227 (ffestw block UNUSED, ffebld expr) { - ffeste_check_simple_ (); + tree rtn; -#if FFECOM_targetCURRENT == FFECOM_targetFFE - if (expr == NULL) - { - fputs ("+ RETURN\n", dmpout); - } - else - { - fputs ("+ RETURN_alternate ", dmpout); - ffebld_dump (expr); - fputc ('\n', dmpout); - } -#elif FFECOM_targetCURRENT == FFECOM_targetGCC - { - tree rtn; + ffeste_check_simple_ (); - ffeste_emit_line_note_ (); + ffeste_emit_line_note_ (); - ffeste_start_stmt_ (); + ffeste_start_stmt_ (); - ffecom_prepare_return_expr (expr); + ffecom_prepare_return_expr (expr); - ffecom_prepare_end (); + ffecom_prepare_end (); - rtn = ffecom_return_expr (expr); + rtn = ffecom_return_expr (expr); - if ((rtn == NULL_TREE) - || (rtn == error_mark_node)) - expand_null_return (); - else - { - tree result = DECL_RESULT (current_function_decl); - - if ((result != error_mark_node) - && (TREE_TYPE (result) != error_mark_node)) - expand_return (ffecom_modify (NULL_TREE, - result, - convert (TREE_TYPE (result), - rtn))); - else - expand_null_return (); - } + if ((rtn == NULL_TREE) + || (rtn == error_mark_node)) + expand_null_return (); + else + { + tree result = DECL_RESULT (current_function_decl); + + if ((result != error_mark_node) + && (TREE_TYPE (result) != error_mark_node)) + expand_return (ffecom_modify (NULL_TREE, + result, + convert (TREE_TYPE (result), + rtn))); + else + expand_null_return (); + } - ffeste_end_stmt_ (); - } -#else -#error -#endif + ffeste_end_stmt_ (); } /* REWRITE statement -- start. */ @@ -5277,32 +4443,6 @@ void ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format) { ffeste_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - switch (format) - { - case FFESTV_formatNONE: - fputs ("+ REWRITE_uf (", dmpout); - break; - - case FFESTV_formatLABEL: - case FFESTV_formatCHAREXPR: - case FFESTV_formatINTEXPR: - fputs ("+ REWRITE_fm (", dmpout); - break; - - default: - assert ("Unexpected kind of format item in V018 REWRITE" == NULL); - } - ffeste_subr_file_ ("UNIT", &info->rewrite_spec[FFESTP_rewriteixUNIT]); - ffeste_subr_file_ ("FMT", &info->rewrite_spec[FFESTP_rewriteixFMT]); - ffeste_subr_file_ ("ERR", &info->rewrite_spec[FFESTP_rewriteixERR]); - ffeste_subr_file_ ("IOSTAT", &info->rewrite_spec[FFESTP_rewriteixIOSTAT]); - fputs (") ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* REWRITE statement -- I/O item. */ @@ -5311,14 +4451,6 @@ void ffeste_V018_item (ffebld expr) { ffeste_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* REWRITE statement -- end. */ @@ -5327,13 +4459,6 @@ void ffeste_V018_finish () { ffeste_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ACCEPT statement -- start. */ @@ -5342,33 +4467,6 @@ void ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format) { ffeste_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - switch (format) - { - case FFESTV_formatLABEL: - case FFESTV_formatCHAREXPR: - case FFESTV_formatINTEXPR: - fputs ("+ ACCEPT_fm ", dmpout); - break; - - case FFESTV_formatASTERISK: - fputs ("+ ACCEPT_ls ", dmpout); - break; - - case FFESTV_formatNAMELIST: - fputs ("+ ACCEPT_nl ", dmpout); - break; - - default: - assert ("Unexpected kind of format item in V019 ACCEPT" == NULL); - } - ffeste_subr_file_ ("FORMAT", &info->accept_spec[FFESTP_acceptixFORMAT]); - fputc (' ', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ACCEPT statement -- I/O item. */ @@ -5377,14 +4475,6 @@ void ffeste_V019_item (ffebld expr) { ffeste_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ACCEPT statement -- end. */ @@ -5393,13 +4483,6 @@ void ffeste_V019_finish () { ffeste_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } #endif @@ -5410,33 +4493,6 @@ ffeste_V020_start (ffestpTypeStmt *info UNUSED, ffestvFormat format UNUSED) { ffeste_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - switch (format) - { - case FFESTV_formatLABEL: - case FFESTV_formatCHAREXPR: - case FFESTV_formatINTEXPR: - fputs ("+ TYPE_fm ", dmpout); - break; - - case FFESTV_formatASTERISK: - fputs ("+ TYPE_ls ", dmpout); - break; - - case FFESTV_formatNAMELIST: - fputs ("* TYPE_nl ", dmpout); - break; - - default: - assert ("Unexpected kind of format item in V020 TYPE" == NULL); - } - ffeste_subr_file_ ("FORMAT", &info->type_spec[FFESTP_typeixFORMAT]); - fputc (' ', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* TYPE statement -- I/O item. */ @@ -5445,14 +4501,6 @@ void ffeste_V020_item (ffebld expr UNUSED) { ffeste_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* TYPE statement -- end. */ @@ -5461,13 +4509,6 @@ void ffeste_V020_finish () { ffeste_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* DELETE statement. */ @@ -5477,18 +4518,6 @@ void ffeste_V021 (ffestpDeleteStmt *info) { ffeste_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ DELETE (", dmpout); - ffeste_subr_file_ ("UNIT", &info->delete_spec[FFESTP_deleteixUNIT]); - ffeste_subr_file_ ("REC", &info->delete_spec[FFESTP_deleteixREC]); - ffeste_subr_file_ ("ERR", &info->delete_spec[FFESTP_deleteixERR]); - ffeste_subr_file_ ("IOSTAT", &info->delete_spec[FFESTP_deleteixIOSTAT]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* UNLOCK statement. */ @@ -5497,17 +4526,6 @@ void ffeste_V022 (ffestpBeruStmt *info) { ffeste_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ UNLOCK (", dmpout); - ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]); - ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]); - ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ENCODE statement -- start. */ @@ -5516,19 +4534,6 @@ void ffeste_V023_start (ffestpVxtcodeStmt *info) { ffeste_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ ENCODE (", dmpout); - ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]); - ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]); - ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]); - ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]); - ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]); - fputs (") ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ENCODE statement -- I/O item. */ @@ -5537,14 +4542,6 @@ void ffeste_V023_item (ffebld expr) { ffeste_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* ENCODE statement -- end. */ @@ -5553,13 +4550,6 @@ void ffeste_V023_finish () { ffeste_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* DECODE statement -- start. */ @@ -5568,19 +4558,6 @@ void ffeste_V024_start (ffestpVxtcodeStmt *info) { ffeste_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ DECODE (", dmpout); - ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]); - ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]); - ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]); - ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]); - ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]); - fputs (") ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* DECODE statement -- I/O item. */ @@ -5589,14 +4566,6 @@ void ffeste_V024_item (ffebld expr) { ffeste_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (expr); - fputc (',', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* DECODE statement -- end. */ @@ -5605,13 +4574,6 @@ void ffeste_V024_finish () { ffeste_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* DEFINEFILE statement -- start. */ @@ -5620,13 +4582,6 @@ void ffeste_V025_start () { ffeste_check_start_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ DEFINE_FILE ", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* DEFINE FILE statement -- item. */ @@ -5635,20 +4590,6 @@ void ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv) { ffeste_check_item_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffebld_dump (u); - fputc ('(', dmpout); - ffebld_dump (m); - fputc (',', dmpout); - ffebld_dump (n); - fputs (",U,", dmpout); - ffebld_dump (asv); - fputs ("),", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* DEFINE FILE statement -- end. */ @@ -5657,13 +4598,6 @@ void ffeste_V025_finish () { ffeste_check_finish_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputc ('\n', dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } /* FIND statement. */ @@ -5672,18 +4606,6 @@ void ffeste_V026 (ffestpFindStmt *info) { ffeste_check_simple_ (); - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fputs ("+ FIND (", dmpout); - ffeste_subr_file_ ("UNIT", &info->find_spec[FFESTP_findixUNIT]); - ffeste_subr_file_ ("REC", &info->find_spec[FFESTP_findixREC]); - ffeste_subr_file_ ("ERR", &info->find_spec[FFESTP_findixERR]); - ffeste_subr_file_ ("IOSTAT", &info->find_spec[FFESTP_findixIOSTAT]); - fputs (")\n", dmpout); -#elif FFECOM_targetCURRENT == FFECOM_targetGCC -#else -#error -#endif } #endif diff --git a/gcc/f/ste.h b/gcc/f/ste.h index a447357..fb32c79 100644 --- a/gcc/f/ste.h +++ b/gcc/f/ste.h @@ -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 diff --git a/gcc/f/stt.c b/gcc/f/stt.c index 4b008e2..c48a505 100644 --- a/gcc/f/stt.c +++ b/gcc/f/stt.c @@ -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; diff --git a/gcc/f/stt.h b/gcc/f/stt.h index e56e843..56543d0 100644 --- a/gcc/f/stt.h +++ b/gcc/f/stt.h @@ -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); diff --git a/gcc/f/stw.h b/gcc/f/stw.h index 826e941..080bd73 100644 --- a/gcc/f/stw.h +++ b/gcc/f/stw.h @@ -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_ diff --git a/gcc/f/symbol.c b/gcc/f/symbol.c index 424a9c6..816ad19 100644 --- a/gcc/f/symbol.c +++ b/gcc/f/symbol.c @@ -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 diff --git a/gcc/f/symbol.h b/gcc/f/symbol.h index cc8b1c0..c9e582a 100644 --- a/gcc/f/symbol.h +++ b/gcc/f/symbol.h @@ -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); diff --git a/gcc/f/target.h b/gcc/f/target.h index faaf519..b21f269 100644 --- a/gcc/f/target.h +++ b/gcc/f/target.h @@ -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) \ diff --git a/gcc/f/top.c b/gcc/f/top.c index f446768..560bcb4 100644 --- a/gcc/f/top.c +++ b/gcc/f/top.c @@ -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. */ |