diff options
| author | kan <kan@FreeBSD.org> | 2004-07-28 03:11:36 +0000 |
|---|---|---|
| committer | kan <kan@FreeBSD.org> | 2004-07-28 03:11:36 +0000 |
| commit | e0020c9fe3d2c91658ad0f59cb6a55c44f909db3 (patch) | |
| tree | b406472295ae0b130894cc19f02f43b36157fec6 /contrib/gcc/f | |
| parent | b754d213ab76dee1e7bcd5acb4becd5658c0ca99 (diff) | |
| parent | 5e00ec74d8ce58f99801200d4d3d0412c7cc1b28 (diff) | |
| download | FreeBSD-src-e0020c9fe3d2c91658ad0f59cb6a55c44f909db3.zip FreeBSD-src-e0020c9fe3d2c91658ad0f59cb6a55c44f909db3.tar.gz | |
This commit was generated by cvs2svn to compensate for changes in r132718,
which included commits to RCS files with non-trunk default branches.
Diffstat (limited to 'contrib/gcc/f')
60 files changed, 6565 insertions, 18264 deletions
diff --git a/contrib/gcc/f/ChangeLog b/contrib/gcc/f/ChangeLog index d88c653..d671c1e 100644 --- a/contrib/gcc/f/ChangeLog +++ b/contrib/gcc/f/ChangeLog @@ -1,14 +1,295 @@ -2003-10-16 Release Manager +2004-07-12 Bud Davis <bdavis9659@comcast.net> - * GCC 3.3.2 Released. + * bld.c (ffebld_constant_new_character1, ffebld_constant_new_complex{1,2}, + ffebld_constant_new_hollerith, ffebld_constant_new_integer1, + ffebld_constant_new_integer{1,2,3,4}_val, ffebld_constant_new_logical1, + ffebld_constant_new_logical{1,2,3,4}_val, ffebld_constant_new_real{1,2}, + ffebld_constant_new_typeless_ov): + Fill and use `rlink' and `llink' pointers in _ffebld_ struct. + * bld.h (struct _ffebld_): remove 'next' pointer, add + `rlink, llink' pointers; remove `negate' entry. + * malloc.c (malloc_kill_area_): Adapt for new `mallocArea' pointer. + (malloc_display_): Adapt. + (malloc_new_inpool_): Set it. + (malloc_resize_inpool_): Ditto. -2003-08-04 Release Manager +2004-07-01 Release Manager - * GCC 3.3.1 Released. + * GCC 3.4.1 released. -2003-08-04 Release Manager +2004-06-17 Toon Moene <toon@moene.indiv.nluug.nl> - * GCC 3.3.1 Released. + * news.texi: Note that GCC 3.4.x is the last version + of GCC to contain g77. + +2004-05-18 Joseph S. Myers <jsm@polyomino.org.uk> + + * bugs.texi, news.texi: Don't reference mainline versions. + +2004-05-16 Gerald Pfeifer <gerald@pfeifer.com> + + * g77.texi (Floating-point Errors): Fix typo. + +2004-05-07 Gerald Pfeifer <gerald@pfeifer.com> + + * g77.texi (Floating-point Errors): Avoid referencing + http://www.linuxsupportline.com/~billm/ which as has been hijacked; + add a reference to the official IEEE 754 site. + +2004-04-18 Release Manager + + * GCC 3.4.0 released. + +2004-03-21 Joseph S. Myers <jsm@polyomino.org.uk> + + * g77.texi: Update link to "G++ and GCC". + +2004-03-14 Gerald Pfeifer <gerald@pfeifer.com> + + * g77.texi (Aligned Data): Remove obsolete paragraph including a + broken link. + (Floating-point Errors): Remove links to http://www.validgh.com/ + which was "hijacked". + (Language): Fix link to Fortran books. + (Projects): Remove obsolete paragraph including a broken link to + ftp://alpha.gnu.org/gnu/g77/projects/. + (Trouble): Remove obsolete paragraph including a broken link to + ftp://alpha.gnu.org/g77.plan. + + * invoke.texi (Overall Options): Remove broken reference to + rat7.uue (which was of dubious copyright status anyways). + + * root.texi (www-burley): Fix URL. + +2004-03-06 Roger Sayle <roger@eyesopen.com> + + * parse.c (ffe_parse_file): Handle the case that main_input_filename + is NULL. + +2004-02-24 Michael Matz <matz@suse.de> + + * Make-lang.in (sta.o-warn): Delete. + * sta.c (ffesta_save_): Don't break aliasing rules. + +2004-02-20 Kazu Hirata <kazu@cs.umass.edu> + + * Make-lang.in (g77spec.o): Depend on intl.h. + * g77spec.c: Include intl.h. + (lang_specific_driver): Allow translation of the copyright + symbol but not the rest of the copyright message. Allow + translation of the message about warranty. + +2004-02-15 Roger Sayle <roger@eyesopen.com> + + PR fortran/14129 + * lex.c (ffelex_cfelex_): Avoid calling xrealloc on a local stack + allocated array. + +2004-01-30 Kelley Cook <kcook@gcc.gnu.org> + + * Make-lang.in (doc/g77.dvi): Use $(abs_docdir). + +2004-01-20 Kelley Cook <kcook@gcc.gnu.org> + + * Make-lang.in: Replace $(docdir) with doc. + (TEXI_G77_FILES): Define. + (f77.rebuilt): Delete. + (f77.srcextra): Add dependencies on f/BUGS and f/NEWS. + (f77.srcman, f77.srcinfo, f77.man, f77.info): New rules. + (doc/g77.info, doc/g77.dvi): Depend on TEXI_G77_FILES. Always build in + doc directory. Use $(MAKEINFOFLAGS). + (info, dvi, generated_manpages): Update to look in doc directory. + (f/BUGS, f/NEWS): Generate in build directory. + (f77.mostlyclean): Delete BUGS and NEWS from build directory. + (f77.maintainer-clean): Adjust to delete from source directory. + (f77.install-man): Revamp rule. + +2004-01-19 Kelley Cook <kcook@gcc.gnu.org> + + * Make-lang.in (G77_INSTALL_NAME): Define via a immediate $(shell) + instead of deferred backquote. + +2004-01-15 Kelley Cook <kcook@gcc.gnu.org> + + * Make-lang.in (f77.srcextra): Dummy entry. + +2004-01-13 Ian Lance Taylor <ian@wasabisystems.com> + + PR fortran/6491 + * expr.c (ffeexpr_reduce_): When handling AND, OR, and XOR, and + when using -fugly-logint, if both operands are logical, convert + the result back to logical. + (ffeexpr_reduced_ugly2log_): Add bothlogical parameter. Change + all callers. Convert logical operands to integer. + +2004-01-12 Ian Lance Taylor <ian@wasabisystems.com> + + * README: Remove. + +2004-01-07 Joseph S. Myers <jsm@polyomino.org.uk> + + * com.h (ffecom_gfrt_basictype): Correct return type. + +2003-12-29 Roger Sayle <roger@eyesopen.com> + + PR fortran/12632 + * com.c (ffecom_subscript_check_): Take as an extra argument the + (possibly NULL) decl of the array. Don't create unnecessary tree + nodes if the array index is known to be safe at compile-time. + If the array index is unsafe, force the array decl into memory to + avoid RTL expansion problems. + (ffecom_array_ref_): Update calls to ffecom_subscript_check_. + (ffecom_char_args_x_): Likewise. + +2003-12-06 Kelley Cook <kcook@gcc.gnu.org> + + * Make-lang.in (G77_CROSS_NAME): Delete. + (g77.install_common, g77.install-man, g77.uninstall): Adjust for above. + +2003-11-30 Andreas Jaeger <aj@suse.de> + + * Make-lang.in (f77.rebuilt): Fix dependency on g77.info. + +2003-11-24 Toon Moene <toon@moene.indiv.nluug.nl> + + PR fortran/12633 + * expr.c (ffeexpr_reduced_ugly2log_): Revert + change allowing logical .and. logical to be + integer in expressions when -fugly-logint. + +2003-11-21 Kelley Cook <kcook@gcc.gnu.org> + + * .cvsignore: Delete. + +2003-11-20 Joseph S. Myers <jsm@polyomino.org.uk> + + * Make-lang.in (f77.extraclean): Delete. + +2003-11-20 Joseph S. Myers <jsm@polyomino.org.uk> + + * Make-lang.in (check-f77, lang_checks): Add. + +2003-11-16 Jason Merrill <jason@redhat.com> + + * Make-lang.in (f77.tags): Create TAGS.sub files in each directory + and TAGS files that include them for each front end. + +2003-11-12 Andreas Jaeger <aj@suse.de> + + * intdoc.in (Signal Intrinsic (subroutine)): Fix texinfo warning + using @code. + * intdoc.texi: Regenerated. + +2003-11-03 Kelley Cook <kcook@gcc.gnu.org> + + * Make-lang.in (dvi): Move targets to $(docobjdir). + (g77.dvi): Simplify rule. + (g77.info): Sinplify rule. + (g77.1): Delete. + (g77.pod): New intermediate rule. + +2003-10-31 Jakub Jelinek <jakub@redhat.com> + + * com.c (ffecom_sym_transform_): Set tree type of offset + to ssizetype. + +2003-10-21 Kelley Cook <kcook@gcc.gnu.org> + + * Make-lang.in (f/g77.1): Honor $(docobjdir). + ($(docobjdir)/g77.info): Replace $(srcdir)/doc with $(docdir). + (f/g77.dvi): Likewise. + +2003-10-21 Jan Hubicka <jh@suse.cz> + + * lex.c (ffelex_cfelex_): Initialize d. + +Mon Oct 20 23:15:46 2003 Mark Mitchell <mark@codesourcery.com> + + * Make-lang.in ($(docobjdir)/g77.info): Add dependency on + stmp-docobjdir. + +Mon Oct 20 13:49:43 2003 Mark Mitchell <mark@codesourcery.com> + + * Make-lang.in (.PHONY): Remove f77.info, f77.install-info. + (info): Update dependencies. + ($(srcdir)/f/g77.info): Replace with ... + ($(docobjdir)/g77.info): ... this. + (f77.install-info): Remove. + (install-info): New target. + +2003-10-06 Mark Mitchell <mark@codesourcery.com> + + * Make-lang.in (f77.info): Replace with ... + (info): ... this. + (f77.dvi): Replace with ... + (dvi): ... this. + (f77.generated-manpages): Replace with ... + (generated-manpages): ... this. + +2003-09-29 Zack Weinberg <zack@codesourcery.com> + + * target.c (FFETARGET_ATOF_): Delete. + (ffetarget_real1, ffetarget_real2): Use real_from_string directly. + * target.h (FFETARGET_REAL_VALUE_FROM_INT_, + FFETARGET_REAL_VALUE_FROM_LONGLONG_): Use mode_for_size, + don't refer to SFmode or DFmode directly. + +2003-09-28 Richard Henderson <rth@redhat.com> + + * com.c (duplicate_decls): Copy DECL_SOURCE_LOCATION, not + file and line separately. + +2003-09-21 Richard Henderson <rth@redhat.com> + + * com.c, ste.c: Revert. + +2003-09-21 Richard Henderson <rth@redhat.com> + + * com.c, ste.c: Update for DECL_SOURCE_LOCATION rename and + change to const. + +2003-09-21 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Update with fixed PR's. + +2003-09-21 George Helffrich <bugzilla@w170.uklinux.net> + + * g77.texi: Remove ancient part about debugging COMMON + and EQUIVALENCE not correctly. + +2003-09-18 Roger Sayle <roger@eyesopen.com> + + * com.c (ffecom_overlap_): Remove FFS_EXPR case. + (ffecom_tree_canonize_ref_): Likewise. + (ffe_truthvalue_conversion): Likewise. + +2003-09-01 Josef Zlomek <zlomekj@suse.cz> + + * com.c (ffecom_overlap_): Kill BIT_ANDTC_EXPR. + (ffecom_tree_canonize_ref_): Kill BIT_ANDTC_EXPR. + +Thu Jul 31 01:47:27 2003 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (ffecom_init_0): Use `dconsthalf'. + +Sat Jul 19 12:03:03 2003 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c data.c expr.c fini.c g77spec.c global.c lab.c lex.c name.c + sta.c stc.c std.c storag.c stt.c stw.c symbol.c target.c type.c: + Remove unnecessary casts. + +Thu Jul 17 06:34:41 2003 Neil Booth <neil@daikokuya.co.uk> + + * lang-options.h: Remove. + * lang.opt: Document most options. + +2003-07-14 Geoffrey Keating <geoffk@apple.com> + + * lang-specs.h (f77-cpp-input): Use -o to specify the CPP output file. + +2003-07-10 Toon Moene <toon@moene.indiv.nluug.nl> + + * ffe.texi: Correctly use @var{srcdir}. 2003-07-09 Toon Moene <toon@moene.indiv.nluug.nl> @@ -16,9 +297,56 @@ * com.c (ffecom_sym_transform_): finish_decl should have the same last argument as start_decl. -Tue Jul 8 15:18:14 2003 Andreas Schwab <schwab@suse.de> +2003-07-08 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE> + + * Make-lang.in (f/g77.dvi): Use PWD_COMMAND. + +2003-07-08 Zack Weinberg <zack@codesourcery.com> + + * lex.c: Remove error block #ifdef MAP_CHARACTER. - * Make-lang.in (f/g77.dvi): Replace PWD with PWD_COMMAND. +Mon Jul 7 18:13:22 2003 Nathan Sidwell <nathan@codesourcery.com> + + * com.c (bison_rule_pushlevel_, bison_rule_compstmt_): Adjust + emit_line_note calls. + * ste.c (ffeste_emit_line_note_): Likewise. + +2003-07-06 Andreas Jaeger <aj@suse.de> + + * bad.c: Convert () to (void) in function definitions. + * bld.c: Likewise. + * data.c: Likewise. + * equiv.c: Likewise. + * expr.c: Likewise. + * global.c: Likewise. + * implic.c: Likewise. + * info.c: Likewise. + * intdoc.c: Likewise. + * intrin.c: Likewise. + * lab.c: Likewise. + * lex.c: Likewise. + * malloc.c: Likewise. + * src.c: Likewise. + * st.c: Likewise. + * sta.c: Likewise. + * stb.c: Likewise. + * stc.c: Likewise. + * std.c: Likewise. + * ste.c: Likewise. + * storag.c: Likewise. + * stt.c: Likewise. + * stw.c: Likewise. + * symbol.c: Likewise. + * top.c: Likewise. + * where.c: Likewise. + + * com.c: Convert prototypes to ISO C90. + * com.h: Likewise. + * g77spec.c: Likewise. + +Sun Jul 6 20:01:29 2003 Neil Booth <neil@daikokuya.co.uk> + + * top.c (ffe_handle_option): Don't handle filenames. 2003-07-05 Toon Moene <toon@moene.indiv.nluug.nl> @@ -27,39 +355,344 @@ Tue Jul 8 15:18:14 2003 Andreas Schwab <schwab@suse.de> FFEINFO_whereGLOBAL symbols in the global binding level if not -fno-globals. +Wed Jul 2 21:16:02 2003 Neil Booth <neil@daikokuya.co.uk> + + * top.c (ffe_init_options): Update prototype. + * top.h (ffe_init_options): Update prototype. + +2003-06-27 Zack Weinberg <zack@codesourcery.com> + + * com.c (input_file_stack_tick): Delete redundant declaration. + +Thu Jun 26 07:06:29 2003 Neil Booth <neil@daikokuya.co.uk> + + * top.c (ffe_handle_option): Don't check for missing arguments. + +Wed Jun 25 06:52:12 2003 Neil Booth <neil@daikokuya.co.uk> + + * top.c (ffe_handle_option): Add missing break;. + +2003-06-24 Scott Snyder <snyder@fnal.gov> + + PR fortran/11299 + * com.c (ffe_init): Call push_srcloc() to ensure that + input_file_stack is initialized. + +Sat Jun 21 21:29:38 2003 Neil Booth <neil@daikokuya.co.uk> + + * lang.opt: Add -fpreprocessed. + * top.c (ffe_handle_option): Handle it. + +Fri Jun 20 10:00:31 2003 Nathan Sidwell <nathan@codesourcery.com> + + * com.c (finish_function): Adjust expand_function_end call. + +2003-06-17 Nathanael Nerode <neroden@gcc.gnu.org> + + * Make-lang.in: Replace BUILD_CC references with CC_FOR_BUILD. + +Sun Jun 15 15:56:51 2003 Neil Booth <neil@daikokuya.co.uk> + + * lang.opt: Declare F77. + +Sat Jun 14 18:13:00 2003 Nathan Sidwell <nathan@codesourcery.com> + + * com.c (stor_parm_decls): Adjust init_function_start call. + +Sat Jun 14 13:25:00 2003 Neil Booth <neil@daikokuya.co.uk> + + * Make-lang.in: Update to use options.c and options.h. + * top.c: Include options.h not f-options.h. + (ffe_init_options): From com.c. Request F77 options. + (ffe_handle_options): Abort on unrecognized switch. + * com.c (ffe_init_options): Move to top.c. + * top.h (fee_init_options): New. + 2003-06-13 Richard Henderson <rth@redhat.com> - PR debug/9864 - * com.c (ffecom_sym_transform_): Install FFEINFO_whereGLOBAL - symbols in the global binding level. + PR debug/9864 + * com.c (ffecom_sym_transform_): Install FFEINFO_whereGLOBAL + symbols in the global binding level. + +Sun Jun 8 15:42:09 2003 Neil Booth <neil@daikokuya.co.uk> + + * Make-lang.in (F77_OBJS, f77.mostlyclean, f/com.o): Update. + (f/f-options.c, f/f-options.h): New. + * com.c: Include opts.h and f-options.h. + (ffecom_decode_include_option_): Remove. + (LANG_HOOKS_HANDLE_OPTION): New. + (LANG_HOOKS_DECODE_OPTION): Drop. + (struct file_name_list, ffecom_decode_include_option, + ffecom_open_include_): Constify. + * com.h (ffecom_decode_include_option): Update. + * lang.opt: New. + * top.c: Include f-options.h, opts.h. + (ffe_is_digit_string_): Constify. + (ffe_decode_option): Transform to ffe_handle_option. + * top.h (ffe_decode_option): Replace with ffe_handle_option. + +2003-06-08 Andreas Jaeger <aj@suse.de> + + * std.c: Remove #if 0'ed functions. + + * sta.c: Remove usage of HARD_F90, FFESTR_F90 and FFESTR_VXT. + * stb.c: Likewise. + * stb.h: Likewise. + * stc.c: Likewise. + * stc.h: Likewise. + * std.c: Likewise. + * std.h: Likewise. + * ste.c: Likewise. + * ste.h: Likewise. + + * str.h (FFESTR_F90): Remove macro. + (FFESTR_VXT): Remove macro. + + * bld.c: Remove usage of FFETARGET_okCHARACTER2, + FFETARGET_okCHARACTER3, FFETARGET_okCHARACTER4, + FFETARGET_okCHARACTER5, FFETARGET_okCHARACTER6, + FFETARGET_okCHARACTER7, FFETARGET_okCHARACTER8, + FFETARGET_okCOMPLEX4, FFETARGET_okCOMPLEX5, FFETARGET_okCOMPLEX6, + FFETARGET_okCOMPLEX7, FFETARGET_okCOMPLEX8, FFETARGET_okINTEGER5, + FFETARGET_okINTEGER6, FFETARGET_okINTEGER7, FFETARGET_okINTEGER8, + FFETARGET_okLOGICAL5, FFETARGET_okLOGICAL6, FFETARGET_okLOGICAL7, + FFETARGET_okLOGICAL8, FFETARGET_okREAL4, FFETARGET_okREAL5, + FFETARGET_okREAL6, FFETARGET_okREAL7 and FFETARGET_okREAL8. + * bld.h: Likewise. + * expr.c: Likewise. + * target.h: Likewise. + * com.c: Likewise. + +Sun Jun 8 12:28:14 2003 Neil Booth <neil@daikokuya.co.uk> + + * Make-lang.in: Update. + * top.c: Include opts.h. Define cl_options_count and cl_options. + +2003-06-07 Andreas Jaeger <aj@suse.de> + + * symbol.c (ffesymbol_new_): Remove tests for macro + FFECOM_symbolHOOK. + * symbol.h: Likewise. + + * storag.c (ffestorag_new): Remove tests for macro + FFECOM_storageHOOK. + * storag.h: Likewise. + + * lab.c (ffelab_new): Remove tests for macro FFECOM_labelHOOK. + * lab.h: Likewise. + + * global.c: Remove tests for macro FFECOM_globalHOOK. + * global.h (struct _ffeglobal_): Likewise. + + * bld.h: Remove tests for macros FFECOM_constantHOOK, + FFECOM_nonterHOOK, FFECOM_globalHOOK, FFECOM_labelHOOK, + FFECOM_storageHOOK, FFECOM_symbolHOOK. + Remove code dependend on FFECOM_itemHOOK. + * bld.c: Likewise. + + * com.h (FFECOM_constantHOOK): Remove define. + (FFECOM_nonterHOOK): Remove. + (FFECOM_globalHOOK): Remove. + (FFECOM_labelHOOK): Remove. + (FFECOM_storageHOOK): Remove. + (FFECOM_symbolHOOK): Remove. + + * com.c (ffecom_get_external_identifier_): Remove usage of + FFETARGET_isENFORCED_MAIN_NAME. + + * bld.c: Remove code dependend on FFEBLD_BLANK_, FFECOM_itemHOOK. + (ffebld_new_accter): Likewise. + (ffebld_new_arrter): Likewise. + (ffebld_new_conter_with_orig): Likewise. + (ffebld_new_item): Likewise. + (ffebld_new_labter): Likewise. + (ffebld_new_labtok): Likewise. + (ffebld_new_none): Likewise. + (ffebld_new_one): Likewise. + (ffebld_new_symter): Likewise. + (ffebld_new_two): Likewise. + +Sat Jun 7 12:10:41 2003 Neil Booth <neil@daikokuya.co.uk> + + * com.c (ffe_init_options): Update. + +Thu Jun 5 18:33:40 CEST 2003 Jan Hubicka <jh@suse.cz> + + * Make-lang.in: Add support for stageprofile and stagefeedback + +2003-06-04 Andreas Jaeger <aj@suse.de> + + * g77spec.c (lang_specific_driver): Remove ALT_LIBM usage. + +2003-06-01 Bud Davis <bdavis9659@comcast.net> + + * ste.c (ffeste_R838): Handle ERROR_MARK. + (ffeste_R839): Ditto. + +2003-06-01 Andreas Jaeger <aj@suse.de> + + * lex.c (ffelex_file_fixed): Remove usage of + REDUCE_CARD_SIZE_AFTER_BIGGY. + + * expr.c (ffeexpr_exprstack_push_operand_): Remove code depenend + on WEIRD_NONFORTRAN_RULES. + + * com.c (ffecom_arg_ptr_to_expr): Remove + PASS_HOLLERITH_BY_DESCRIPTOR dependend code. + (ffecom_const_expr): Remove usage of NEWCOMMON. + (ffecom_expand_let_stmt): Remove MOVE_EXPR. + +2003-05-31 Bud Davis <bdavis9659@comcast.net> + + PR fortran/10843 + * sta.c (ffesta_second_): Parse GO TO correctly, + even in free source format. + +2003-05-31 Andreas Jaeger <aj@suse.de> + + * lex.c (ffelex_hash_): Remove HANDLE_PRAGMA and + HANDLE_GENERIC_PRAGMA dependend code, remove #if 0 code. + (pragma_getc): Removed. + (pragma_ungetc): Removed. + +2003-05-30 Roger Sayle <roger@eyesopen.com> + + * com.c (ffecom_init_0): Define built-in functions for tan and atan. + * com-rt.def: Use then to implement g77's tan and atan intrinsics. + +2003-05-22 Bud Davis <bdavis9659@comcast.net> + + * com.c (ffecom_sym_transform_): Error out on unallocatable + storage after type is set. 2003-05-18 Toon Moene <toon@moene.indiv.nluug.nl> - PR fortran/10726 * intdoc.in: Fix documentation of IDATE. * intdoc.texi: Regenerate. - * news.texi: Update due to the above. + * news.texi: Update due to also fixing it in 3.3.1. 2003-05-16 Wolfgang Bangerth <bangerth@dealii.org> - * g77.texi: Remove most of the preface of the bugs section. + * g77.texi: Remove most of the of the preface of the + bugs section. 2003-05-15 Wolfgang Bangerth <bangerth@dealii.org> * g77.texi: Remove most of the bug reporting instructions and merge them into bugs.html. -2003-05-13 Release Manager +2003-05-13 Zack Weinberg <zack@codesourcery.com> + + * com.c: Replace all calls to fatal_io_error with calls to + fatal_error; add ": %m" to the end of all the affected error + messages. - * GCC 3.3 Released. +2003-05-12 Zack Weinberg <zack@codesourcery.com> -2003-05-13 Release Manager + * bad.c: Don't call diagnostic_count_diagnostic. - * GCC 3.3 Released. +2003-05-12 Roger Sayle <roger@eyesopen.com> -2003-05-13 Release Manager + * com.c (ffecom_init_0): Define built-in functions for atan2, + exp, floor, fmod, log and pow. + (duplicate_decls): Preserve assembler name when redeclaring a + built-in. + * com-rt.def: Implement using the built-in forms of the above + functions rather than calling the standard C library directly. + Correct some of the run-time prototype "codes". - * GCC 3.3 Released. +2003-05-11 Toon Moene <toon@moene.indiv.nluug.nl> + + PR fortran/10726 + * intdoc.in: Fix documentation of IDATE. + * intdoc.texi: Regenerate. + * g77.texi: Document completion of INTEGER*n support. + * news.texi: Update due to the above. + +2003-05-08 Roger Sayle <roger@eyesopen.com> + + PR fortran/8485 + * target.h (FFETARGET_REAL_VALUE_FROM_INT_): Cast to + HOST_WIDE_INT instead of long. + (FFETARGET_REAL_VALUE_FROM_LONGLONG_): New macro. + (FFETARGET_LONGLONG_FROM_INTS_): New macro. + (ffetarget_convert_complex1_integer4): Implement. + (ffetarget_convert_complex2_integer4): Implement. + (ffetarget_convert_integer4_complex1): Implement. + (ffetarget_convert_integer4_complex2): Implement. + (ffetarget_convert_integer4_real1): Implement. + (ffetarget_convert_integer4_real2): Implement. + (ffetarget_convert_real1_integer4): Implement. + (ffetarget_convert_real2_integer4): Implement. + * com.c (ffecom_constantunion): Handle INTEGER*8. + (ffecom_constantunion_with_type): Likewise. + +2003-05-03 Nathan Sidwell <nathan@codesourcery.com> + + * com.c (ffecom_do_entry_): Use location_t and input_location + directly. + (ffecom_gen_sfuncdef_): Likewise. + (ffecom_start_progunit_): Likewise. + (ffecom_sym_transform_): Likewise. + (ffecom_sym_transform_assign_): Likewise. + * lex.c (ffelex_hash_): Likewise. + (ffelex_include_): Likewise. + * std.c (ffestd_exec_begin): Likewise. + (ffestd_exec_end): Likewise. + * ste.c (struct gbe_block): Likewise. + (ffeste_start_block_): Likewise. + (ffeste_start_stmt_): Likewise. + +2003-05-03 Nathan Sidwell <nathan@codesourcery.com> + + * ansify.c (die_unless): Revert lineno change here. + +2003-05-02 Nathan Sidwell <nathan@codesourcery.com> + + * lex.c (ffelex_file_pop_): Adjust file_stack member use. + (ffelex_file_push_): Likewise. + (ffelex_hash_): Likewise. + +2003-05-01 Nathan Sidwell <nathan@codesourcery.com> + + * ansify.c (die_unless): Rename lineno to input_line. + * com.c (ffecom_subscript_check_, ffecom_do_entry_, + ffecom_gen_sfuncdef_, ffecom_start_progunit_, + ffecom_sym_transform_, ffecom_sym_transform_assign_, + bison_rule_pushlevel_, bison_rule_compstmt_, finish_function, + store_parm_decls): Likewise. + * intrin.c (ffeintrin_fulfill_generic): Likewise. + * lex.c (ffelex_hash_, ffelex_include_, ffelex_next_line_, + ffelex_file_fixed, ffelex_file_free): Likewise. + * std.c (ffestd_exec_end): Likewise. + * ste.c (ffeste_emit_line_note_, ffeste_start_block_, + ffeste_start_stmt_): Likewise. + * ste.h (ffeste_filelinenum, ffeste_set_line): Likewise. + + * lex.c (ffelex_file_pop_): Rename parameter from input_filename. + (ffelex_file_push_): Likewise. + + * ste.c (struct gbe_block): Rename field from input_filename. + (ffeste_start_block_, ffeste_start_stmt_): Likewise. + +2003-04-17 Roger Sayle <roger@eyesopen.com> + + PR c/10375 + * com.c (duplicate_decls): Preserve "const" and "noreturn" + function attributes. + +2003-04-13 Roger Sayle <roger@eyesopen.com> + + * com.c (duplicate_decls): Preserve pure and malloc attributes. + +2003-04-12 Zack Weinberg <zack@codesourcery.com> + + * com.c (ffecom_build_complex_constant_, ffecom_expr_) + (ffecom_init_zero_, ffecom_transform_namelist_, ffecom_vardesc_) + (ffecom_vardesc_array_, ffecom_vardesc_dims_, ffecom_2) + * ste.c (ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_) + (ffeste_io_icilist_, ffeste_io_inlist_, ffeste_io_olist_): + Use build_constructor. 2003-04-11 Bud Davis <bdavis9659@comcast.net> @@ -68,6 +701,10 @@ Tue Jul 8 15:18:14 2003 Andreas Schwab <schwab@suse.de> increment values for INTEGER typeness. * gcc/f/news.texi: Document these fixes. +2003-03-27 Steven Bosscher <steven@gcc.gnu.org> + + * ffe.texi: Don't mention dead file proj.c. + 2003-03-26 Roger Sayle <roger@eyesopen.com> PR fortran/9793 @@ -99,12 +736,42 @@ Sun Mar 23 23:43:45 2003 Mark Mitchell <mark@codesourcery.com> * ste.c (ffeste_R810): Use ffecom_constantunion_with_type to discern SELECT CASE variables. +2003-03-15 Roger Sayle <roger@eyesopen.com> + + * stb.c (ffestb_R100110_): Allow the number before the X format + to be optional when not -fpedantic. + * std.c (ffestd_R1001dump_1010_3_): Delete unused static function. + (ffestd_R1001dump_): For the FFESTP_formattypeX case, call + ffestd_R1001dump_1010_2_ instead of ffestd_R1001dump_1010_3_. + +2003-03-15 Roger Sayle <roger@eyesopen.com> + + * f/ste.c (ffeste_R810): Fix whitespace. + 2003-03-15 Andreas Jaeger <aj@suse.de> * g77spec.c (DEFAULT_SWITCH_TAKES_ARG): Remove. (DEFAULT_WORD_SWITCH_TAKES_ARG): Remove. -2003-02-21 Toon Moene <toon@moene.indiv.nluug.nl> +2003-03-12 Nathanael Nerode <neroden@gcc.gnu.org> + + * g77.texi, invoke.texi, g77spec.c, lang-specs.h: GCC, not + GNU CC. Especially here. + +2003-03-10 Roger Sayle <roger@eyesopen.com> + + * com.c (duplicate_decls): Synchronize with C's duplicate_decls. + +Sat Mar 8 21:11:40 2003 Neil Booth <neil@daikokuya.co.uk> + + * com.c (ffe_init): Update prototype; move code to ffe_post_options. + (ffe_post_options): New. + +2003-03-04 Tom Tromey <tromey@redhat.com> + + * Make-lang.in (f77.tags): New target. + +2003-02-20 Toon Moene <toon@moene.indiv.nluug.nl> * news.texi: Document fixing PR fortran/9038. @@ -112,28 +779,61 @@ Sun Mar 23 23:43:45 2003 Mark Mitchell <mark@codesourcery.com> * g77.texi, invoke.texi: Update to GFDL 1.2. -2003-01-30 Toon Moene <toon@moene.indiv.nluug.nl> +2003-01-31 Toon Moene <toon@moene.indiv.nluug.nl> * news.texi: Document fixing PR fortran/7681 - and PR optimization/9258. + and optimization/9258. 2003-01-26 Toon Moene <toon@moene.indiv.nluug.nl> - * lang-specs.h: Revert change to solve 9038. + * lang-specs.h: Revoke change to (incorrectly) prohibit + passing -f options to cc1 when preprocessing. * news.texi: Document this. -2003-01-26 Christian Cornelssen <ccorn@cs.tu-berlin.de> +Tue Jan 21 08:42:12 2003 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + Make-lang.in (f/sta.o-warn): Add -Wno-error. - * Make-lang.in (f77.install-common, f77.install-info) - (f77.install-man, f77.uninstall): Prepend $(DESTDIR) to +Thu Jan 16 10:53:16 2003 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in (f/target.o): Depend on toplev.h. + * target.c: Include toplev.h. + +Sat Jan 11 21:31:10 2003 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (ffecom_convert_narrow_, ffecom_convert_widen_, + pushdecl_top_level, storedecls, convert, delete_block, + insert_block, ffe_init, ffe_mark_addressable, poplevel, + ffe_print_identifier, pushdecl, pushlevel, set_block, + ffe_signed_or_unsigned_type, ffe_signed_type, + ffe_truthvalue_conversion, ffe_type_for_mode, ffe_type_for_size, + ffe_unsigned_type, append_include_chain, open_include_file, + read_filename_string, read_name_map): Convert to ISO C style function + definitions. + * parse.c (ffe_parse_file): Likewise. + * top.c (ffe_is_digit_string_): Likewise. + +2003-01-09 Christian Cornelssen <ccorn@cs.tu-berlin.de> + + * Make-lang.in (f77.install-common, f77.install-info, + f77.install-man, f77.uninstall): Prepend $(DESTDIR) to destination paths in all (un)installation commands. -2003-01-05 Steven Bosscher <s.bosscher@student.tudelft.nl> +2003-01-05 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Revise history again: + PR Fortran/9038 will be fixed in 3.4. + +2003-01-05 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Update news to reflect reality: + PR Fortran/9038 won't be fixed until 3.4. + +2003-01-04 Toon Moene <toon@moene.indiv.nluug.nl> PR Fortran/9038 - * lang-specs.h: Prevent -f<option> from being passed - to cc1. - * news.texi: Document this fix. + * lang-specs.h: Remove -f options before preprocessing. + * news.texi: Document fixing of PR Fortran/9038. 2003-01-03 Bud Davis <bdavis11@directvinternet.com> @@ -171,15 +871,3260 @@ Sun Mar 23 23:43:45 2003 Mark Mitchell <mark@codesourcery.com> * intdoc.texi: Likewise. * news.texi: Follow spelling conventions. -Mon Dec 16 13:55:24 2002 Mark Mitchell <mark@codesourcery.com> +Mon Dec 16 13:53:18 2002 Mark Mitchell <mark@codesourcery.com> + + * root.texi: Change version number to 3.4. + +2002-12-15 Zack Weinberg <zack@codesourcery.com> + + * target.h: Don't define HOST_WIDE_INT. - * root.texi (DEVELOPMENT): @clear it. +2002-12-02 Nathanael Nerode <neroden@gcc.gnu.org> + + * Make-lang.in, ansify.c, intdoc.c, proj.h: Replace hconfig.h with + bconfig.h. + * fini.c, proj.h: Replace USE_HCONFIG with USE_BCONFIG + +2002-11-30 Zack Weinberg <zack@codesourcery.com> + + * proj.h, ansify.c, g77spec.c, intdoc.c: + Include coretypes.h and tm.h. + * Make-lang.in: Update dependencies. 2002-11-20 Toon Moene <toon@moene.indiv.nluug.nl> * invoke.texi: Explain the purpose of -fmove-all-movables, -freduce-all-givs and -frerun-loop-opts better. +2002-11-19 Nathanael Nerode <neroden@gcc.gnu.org> + + * Make-lang.in: Correct BUILD/HOST confusion. + +2002-11-19 Toon Moene <toon@moene.indiv.nluug.nl> + + PR fortran/8587 + * news.texi: Show PR fortran/8587 fixed. + +2002-11-19 Jason Thorpe <thorpej@wasabisystems.com> + + * g77spec.c (lang_specific_spec_functions): New. + +2002-11-02 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77.texi: Correct documentation on generating C++ prototypes + of Fortran routines with f2c. + * news.texi: Document fixes in GCC-3.3, 3.2 and 3.1. + +2002-10-30 Roger Sayle <roger@eyesopen.com> + + * com.c (ffecom_subscript_check_): Cast the failure branch + of the bounds check COND_EXPR to void, to indicate noreturn. + (ffe_truthvalue_conversion): Only apply truth value conversion + to the non-void branches of a COND_EXPR. + +2002-10-26 Andris Pavenis <pavenis@latnet.lv> + + * lang-specs.h: Fix ratfor specs. + +2002-10-15 Richard Henderson <rth@redhat.com> + + * target.h (ffetarget_print_real1, ffetarget_print_real2): Use + real_to_decimal directly, and with the new arguments. + +2002-09-23 Zack Weinberg <zack@codesourcery.com> + + * Make-lang.in (g77spec.o): Don't depend on f/version.h. + (f/parse.o): Depend on version.h not f/version.h. + (g77version.o, f/version.o): Delete all references. + + * com.c (ffecom_init_0): Fix transposed array indices in bsearch test. + * g77spec.c: Don't include f/version.h or refer to ffe_version_string. + * parse.c: Use version_string, not ffe_version_string. + * version.c, version.h: Delete files. + +2002-09-23 Kazu Hirata <kazu@cs.umass.edu> + + * ChangeLog: Follow spelling conventions. + * ChangeLog.0: Likewise. + * com.c: Likewise. + * ffe.texi: Likewise. + * g77.texi: Likewise. + * intdoc.in: Likewise. + * invoke.texi: Likewise. + * news.texi: Likewise. + * intdoc.texi: Regenerate. + +2002-09-16 Geoffrey Keating <geoffk@apple.com> + + * com.c (union lang_tree_node): Add chain_next option. + +2002-09-16 Richard Henderson <rth@redhat.com> + + * target.c (ffetarget_real1): Don't pass FFETARGET_ATOF_ + directly to ffetarget_make_real1. + (ffetarget_real2): Similarly. + * target.h (ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r2_, + ffetarget_cvt_r2_to_rv_): Use new real.h interface and simplify. + +2002-09-15 Kazu Hirata <kazu@cs.umass.edu> + + * intdoc.texi: Regenerate. + +2002-09-15 Kazu Hirata <kazu@cs.umass.edu> + + * ChangeLog: Follow spelling conventions. + * intdoc.in: Likewise. + +2002-09-09 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at> + + Fix PR web/7596: + * ffe.texi (Front End): Fix broken links. + * bugs.texi (Known Bugs): Refer to gcc.gnu.org instead of + www.gnu.org for onlinedocs. + * news.texi (News): Ditto. + +2002-09-07 Jan Hubicka <jh@suse.cz> + + * com.c (ffe_type_for_mode): Handle long double. + +2002-09-04 Richard Henderson <rth@redhat.com> + + * target.h (ffetarget_print_real1, ffetarget_print_real2): Update + call to REAL_VALUE_TO_DECIMAL. + +2002-08-31 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c: Don't set flag_finite_math_only by default. + * invoke.texi: Reverse the documentation of option + -ffinite-math-only to reflect the new default. + +2002-08-30 Hans-Peter Nilsson <hp@bitrange.com> + + * target.c (ffetarget_memcpy_): Don't test nonexistent + HOST_BYTES_BIG_ENDIAN, HOST_BITS_BIG_ENDIAN. Check + HOST_WORDS_BIG_ENDIAN against both WORDS_BIG_ENDIAN and + BYTES_BIG_ENDIAN. + +2002-08-30 Alan Modra <amodra@bigpond.net.au> + + * target.h (FFETARGET_32bit_longs): Don't define for powerpc64 or + mmix. + +2002-08-28 Joseph S. Myers <jsm@polyomino.org.uk> + + * bugs.texi, news.texi: Update URLs for online news and bugs + lists. + +2002-08-22 Hans-Peter Nilsson <hp@bitrange.com> + + * where.h (struct _ffewhere_file_): Mark GTY. + (ffewhere_file_kill): Remove prototype. + * where.c: Include ggc.h. + (struct _ffewhere_ll_, struct _ffewhere_root_ll_): Mark GTY. + (ffewhere_root_ll_): Ditto. Change type from struct + _ffewhere_root_ll_ to struct _ffewhere_root_ll_*. All uses + changed. + (ffewhere_file_kill): Remove. + (ffewhere_file_new): Use GC to allocate ffewhereFile objects. + (ffewhere_file_set): Use GC to allocate ffewhereLL_ objects. + (ffewhere_init_1): Use GC to allocate ffewhere_root_ll_ sentinel. + Include gt-f-where.h. + * lex.c (ffelex_current_wf_, ffelex_include_wherefile_): Mark GTY. + Include gt-f-lex.h. + * std.c (ffestd_S3P4): Don't call ffewhere_file_kill. + * config-lang.in (gtfiles): Add f/where.h f/where.c and f/lex.c. + * Make-lang.in (gt-f-lex.h gt-f-where.h): Add to dependents of + s-gtype. + (f/lex.o): Depend on gt-f-lex.h. + (f/where.o): Depend on gt-f-where.h. + +Tue Aug 20 16:49:40 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * where.c (ffewhere_track): Remove impossible if-then clause. + +Thu Aug 8 10:06:14 2002 Nathan Sidwell <nathan@codesourcery.com> + + * f/Make-lang.in (f.mostlyclean): Remove coverage files. + +2002-08-06 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at> + + * g77.texi (Top): Rename Index to Keyword Index. + +2002-08-05 Toon Moene <toon@moene.indiv.nluug.nl> + + * invoke.texi: Improve description of + -fno-finite-math-only flag. + +Sun Aug 4 16:45:49 2002 Joseph S. Myers <jsm@polyomino.org.uk> + + * root.texi (version-gcc): Increase to 3.3. + +2002-07-30 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffe_init_options): Set + flag_finite_math_only. + * invoke.texi: Document -fno-finite-math-only. + +Mon Jul 29 22:05:35 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (read_name_map): Use concat in lieu of xmalloc/strcpy. + +2002-07-25 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Document better handling of (no-)alias + information of dummy arguments and induction variables + on loop unrolling. + +2002-07-01 Roger Sayle <roger@eyesopen.com> + + * f/com.c (builtin_function): Accept additional parameter. + (ffe_com_init_0): Pass an additional NULL_TREE argument to + builtin_function. + +2002-06-28 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Mention 2 Gbyte limit on 32-bit targets + for arrays explicitly in news on g77-3.1. + +Thu Jun 20 21:56:34 2002 Neil Booth <neil@daikokuya.co.uk> + + * lang-specs.h: Use cc1 for traditional preprocessing. + +2002-06-20 Andreas Jaeger <aj@suse.de> + + * com.c (ffecom_prepare_expr_,ffecom_expr_power_integer_): + Remove #ifdefed HAHA sections. + +2002-06-20 Nathanael Nerode <neroden@twcny.rr.com> + + * com.c: Remove #ifdef HOHO sections. + +2002-06-17 Jason Thorpe <thorpej@wasabisystems.com> + + * bit.c: Don't include glimits.h. + * target.c: Likewise. + * where.h: Likewise. + +2002-06-12 Gabriel Dos Reis <gdr@codesourcery.com> + + * bad.c (ffebad_start_): Adjust calls to diagnostic_count_error. + +2002-06-04 Gabriel Dos Reis <gdr@codesourcery.com> + + * bad.c (ffebad_start_): Adjust call to count_error. + * Make-lang.in (f/bad.o): Depend on diagnostic.h + * bad.c: #include diagnostic.h + +2002-06-03 Geoffrey Keating <geoffk@redhat.com> + + * Make-lang.in (f/com.o): Depend on debug.h. + * com.c: Include debug.h. + (LANG_HOOKS_MARK_TREE): Delete. + (struct lang_identifier): Use gengtype. + (union lang_tree_node): New. + (struct lang_decl): New dummy definition. + (struct lang_type): New dummy definition. + (ffe_mark_tree): Delete. + + * com.c (struct language_function): New dummy structure. + + * Make-lang.in: Add rules to generate gt-f-ste.h gtype-f.h; allow + for filename changes. + (com.o): Allow for filename changes; add gtype-f.h as dependency. + (ste.o): Add gt-f-ste.h as dependency. + * config-lang.in (gtfiles): Add com.h, ste.c. + * com.c: Replace uses of ggc_add_* with GTY markers. Include + gtype-f.h. + (mark_binding_level): Delete. + * com.h: Replace uses of ggc_add_* with GTY markers. + * ste.c: Replace uses of ggc_add_* with GTY markers. Include + gt-f-ste.h. + + * Make-lang.in (f/gt-com.h): Build using gengtype. + (com.o): Depend on f/gt-com.h. + * com.c: Rename struct binding_level to f_binding_level. + (struct f_binding_level): Use gengtype. + (struct tree_ggc_tracker): Use gengtype. + (mark_tracker_head): Use gt_ggc_m_tree_ggc_tracker. + (make_binding_level): Use GGC. + (mark_binding_level): Use gt_ggc_m_f_binding_level. + (ffecom_init_decl_processing): Change free_binding_level + to a deletable root. + * config-lang.in (gtfiles): Define. + * where.c: Strings need no longer be allocated in GCable memory; + remove my change of 30 Dec 1999. + +2002-05-31 Matthew Woodcraft <mattheww@chiark.greenend.org.uk> + + * lang-specs.h: Use cpp_debug_options. + +2002-05-28 Zack Weinberg <zack@codesourcery.com> + + * bld.c, com.c, expr.c, target.c: Include real.h. + * Make-lang.in: Update dependency lists. + +2002-05-16 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE> + + * Make-lang.in: Allow for PWDCMD to override hardcoded pwd. + +2002-05-09 Hassan Aurag <aurag@cae.com> + + * expr.c (ffeexpr_reduced_ugly2log_): Allow logicals-as-integers + under -fugly-logint as arguments of .and., .or., .xor. + +2002-05-07 Jan Hubicka <jh@suse.cz> + + * target.h (FFETARGET_32bit_longs): Undefine for x86-64. + +2002-04-29 Joseph S. Myers <jsm28@cam.ac.uk> + + * invoke.texi: Use @gol at ends of lines inside @gccoptlist. + * g77.texi: Update last update date. + +Thu Apr 25 07:44:44 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.h (ffe_parse_file): Update. + * lex.c (ffe_parse_file): Update. + +2002-04-20 Toon Moene <toon@moene.indiv.nluug.nl> + + * root.texi: Remove variable version-g77. + * g77.texi: Remove the single use of that variable. + +Thu Apr 18 19:10:44 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (incomplete_type_error): Remove. + +Tue Apr 16 14:55:47 2002 Mark Mitchell <mark@codesourcery.com> + + * com.c (ffecom_expr_power_integer): Add has_scope argument to + call to expand_start_stmt_expr. + +Mon Apr 15 10:59:14 2002 Mark Mitchell <mark@codesourcery.com> + + * g77.texi: Remove Chill reference. + +2002-04-13 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Deprecate frontend version number; + update list of fixed bugs. + +2002-04-08 Hans-Peter Nilsson <hp@bitrange.com> + + * Make-lang.in (f/target.o): Depend on diagnostic.h. + * target.c: Include diagnostic.h. + (ffetarget_memcpy_): Call sorry if host and target endians are + not matching. + +Thu Apr 4 23:29:48 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_TRUTHVALUE_CONVERSION): Redefine. + (truthvalue_conversion): Rename. Update. Make static. + (ffecom_truth_value): Update. + +Mon Apr 1 21:39:36 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_MARK_ADDRESSABLE): Redefine. + (mark_addressable): Rename. + (ffecom_arrayref_, ffecom_1): Update. + +Mon Apr 1 09:59:53 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_SIGNED_TYPE, LANG_HOOKS_UNSIGNED_TYPE, + LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE): New. + (unsigned_type, signed_type, signed_or_unsigned_type): Rename. + +Sun Mar 31 23:50:22 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (lang_print_error_function): Rename. + (LANG_HOOKS_PRINT_ERROR_FUNCTION): Redefine. + (ffe_init): Don't set hook. + +Fri Mar 29 21:59:15 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_TYPE_FOR_MODE, LANG_HOOKS_TYPE_FOR_SIZE): + Redefine. + (type_for_mode, type_for_size): Rename. + (signed_or_unsigned_type, signed_type, truthvalue_conversion, + unsigned_type): Use new hooks. + +Tue Mar 26 10:30:05 2002 Andrew Cagney <ac131313@redhat.com> + + * invoke.texi (Warning Options): Mention -Wswitch-enum. + Fix PR c/5044. + +Tue Mar 26 07:30:51 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_MARK_TREE): Redefine. + (lang_mark_tree): Rename ffe_mark_tree, make static. + +Mon Mar 25 19:27:11 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (maybe_build_cleanup): Remove. + +2002-03-23 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffecom_check_size_overflow_): Add a test + so that arrays too large for 32-bit byte-offset + addressing get caught. + * news.texi: Document the fixing of this problem. + +Sat Mar 23 11:18:17 2002 Andrew Cagney <ac131313@redhat.com> + + * invoke.texi (Warning Options): Mention -Wswitch-default. + +Thu Mar 21 18:55:41 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * cp-tree.h (pushdecl, pushlevel, poplevel, set_block, + insert_block, getdecls, global_bindings_p): New. + +Wed Mar 20 08:03:42 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (lang_printable_name): Rename. + (LANG_HOOKS_DECL_PRINTABLE_NAME): Redefine. + (ffe_init): Don't use old hook. + +Sun Mar 17 18:50:15 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.h (ffe_parse_file): Prototype. + +Sun Mar 17 20:57:30 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_PARSE_FILE): Redefine. + * com.h (ffe_parse_file): New. + * parse.c (NAME_OF_STDIN): Remove. + (yyparse): Rename ffe_parse_file. + +Tue Mar 12 20:23:18 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (tree_code_type, tree_code_length, tree_code_name): + Define. + +Sun Mar 10 12:37:42 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * target.c (ffetarget_print_hex): Const-ify. + +2002-03-06 Phil Edwards <pme@gcc.gnu.org> + + * version.c: Fix misplaced leading blanks on first line. + +2002-03-03 Zack Weinberg <zack@codesourcery.com> + + * com.c, target.h: Remove all #ifndef REAL_ARITHMETIC + blocks, make all #ifdef REAL_ARITHMETIC blocks unconditional. + Delete some further #ifdef blocks predicated on REAL_ARITHMETIC. + +Thu Feb 28 07:53:46 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (copy_lang_decl): Delete. + +2002-02-27 Zack Weinberg <zack@codesourcery.com> + + * com.c, lex.c, top.c: Delete traditional-mode-related code + copied from the C front end but not used, or used only to + permit the compiler to link. + +2002-02-13 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: List Problem Reports fixed in 3.1. + +2002-02-13 Toon Moene <toon@moene.indiv.nluug.nl> + + * data.c (ffedata_eval_offset_): Only convert index, + low and high bound in data statements to default integer + if they are constants. Use a copy of the data structure. + +2002-02-09 Toon Moene <toon@moene.indiv.nluug.nl> + + * data.c (ffedata_eval_offset_): Convert non-default integer + constants to default integer kind if necessary. + +2002-02-09 Toon Moene <toon@moene.indiv.nlug.nl> + + * invoke.texi: Add a short debugging session + as an example to the documentation of -g. + +2002-02-06 Toon Moene <toon@moene.indiv.nluug.nl> + + PR fortran/4730 fortran/5473 + * com.c (ffecom_expr_): Deal with %VAL constructs. + * intrin.c (ffeintrin_check_): Handle 'N' constraints for intrinsics, + to indicate "no larger than default kind" integers and logicals. + * intrin.def: Use 'N' constraints in table of intrinsics. + * intdoc.c: Document this constraint. + * intdoc.texi: Regenerated. + +2002-02-04 Philipp Thomas <pthomas@suse.de> + + * implic.c lex.c stb.c ste.c stu.c: Update copyright dates. + +2002-02-04 Philipp Thomas <pthomas@suse.de> + + * bad.def com.c expr.c implic.c lex.c stb.c ste.c stu.c: + Insert comments to mark messages as not being printf style + where appropriate. + +2002-02-03 Toon Moene <toon@moene.indiv.nluug.nl> + + * expr.c (ffeexpr_sym_impdoitem_): Allow other than + default INTEGER implied-do loop counts. + +2002-02-01 Toon Moene <toon@moene.indiv.nluug.nl> + + * bad.def: Remove non-historical reference to version 0.6. + * bugs.texi: Ditto. + * com.c: Ditto. + * ffe.texi: Ditto. + * proj.h: Ditto. + * g77.texi: Ditto. + +2002-01-31 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77spec.c (lang_specific_driver): Follow GNU Coding Standards + for --version. + +2002-01-30 Richard Henderson <rth@redhat.com> + + * ste.c (ffeste_begin_iterdo_): Use expand_exit_loop_top_cond. + (ffeste_R819B): Likewise. + +2002-01-30 Toon Moene <toon@moene.indiv.nluug.nl> + + * intrin.c (upcasecmp_): New function. + (ffeintrin_cmp_name_): Use it to correctly compare name + and table entry for bsearch. + +2002-01-26 Toon Moene <toon@moene.indiv.nluug.nl> + + * intrin.c (ffeintrin_cmp_name_): Correct comparison + for intrinsics in intrinsic table (intrin.def). + +2002-01-22 Zack Weinberg <zack@codesourcery.com> + + * bad.c: Include intl.h. + (FFEBAD_MSGS1, FFEBAD_MSGS2): Replace by FFEBAD_MSG, SHORT, + LONG. Adjust definitions to work with exgettext. + (ffebad_start_): Translate all error messages. + (ffebad_finish): Mark constant strings for translation. + * bad.h: Use FFEBAD_MSG. Adjust prototype of ffebad_start_ + and definitions of ffebad_start_msg, ffebad_start_msg_lex to + work with exgettext. + * bad.def: Use FFEBAD_MSG, SHORT, LONG throughout. + + * com.c: Include intl.h. + (lang_print_error_function): Always use ffeinfo_kind_message + to get the kind label for a non-nested construct. Translate + it. Translate constant strings. + * info.c (FFEINFO_KIND): Adjust definition to work with exgettext. + * info-k.def: Block xgettext from slurping copyright notice + into gcc.pot. Adjust strings for their sole use, in com.c. + + * Make-lang.in (f/bad.o, f/com.o): Depend on intl.h. + +2002-01-14 David Billinghurst <David.Billinghurst@riotinto.com> + + PR fortran/3807 + * f/intrin.c (ffeintrin_check_): Allow for case of intrinsic + control string have COL-spec an integer > 0. + +2002-01-08 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77spec.c (lookup_option): Handle -fversion. + (lang_specific_driver): Update copyright date in --version output. + +Mon Jan 7 00:03:42 2002 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at> + + * invoke.texi: Markup g77 as @command. Remove reference to + http://gcc.gnu.org/thanks.html. + +Wed Jan 2 18:13:11 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (clear_binding_level): Const-ify. + (ffecom_arglist_expr_): Likewise. + * info.c (ffeinfo_types_): Don't needlessly zero init. + * lex.c (ffelex_hash_kludge): Const-ify. + +Sun Dec 23 10:45:09 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (ffecom_gfrt_volatile_, ffecom_gfrt_complex_, + ffecom_gfrt_const_, ffecom_gfrt_type_): Const-ify. + +Sat Dec 22 16:01:51 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bld.c (ffebld_arity_op_): Declare array size explicitly. + * bld.h (ffebld_arity_op_): Likewise. + +2001-12-20 Joseph S. Myers <jsm28@cam.ac.uk> + + * config-lang.in (diff_excludes): Remove. + +2001-12-17 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77.texi, invoke.texi: Update links to GCC manual. + +Sun Dec 16 16:08:57 2001 Joseph S. Myers <jsm28@cam.ac.uk> + + * news.texi: Fix spelling errors. + +Sun Dec 16 10:36:51 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in (f/version.o): Depend on f/version.h. + * version.c: Include ansidecl.h and f/version.h. + +Sun Dec 16 08:52:48 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * lex.c (ffelex_backslash_, ffelex_cfebackslash_): Use hex_value. + * target.c (ffetarget_integerhex, ffetarget_typeless_hex): Use + hex_p/hex_value. + +2001-12-14 Roger Sayle <roger@eyesopen.com> + + * com-rt.def: Use __builtin_sqrt instead of __builtin_fsqrt. + * com.c (ffecom_init_0): Same, and fixed enumeration usage. + +2001-12-10 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77.texi: Don't condition menus on @ifinfo. + +Wed Dec 5 06:49:21 2001 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (ffecom_1): Properly handle TREE_READONLY for INDIRECT_REF. + +Mon Dec 3 18:56:04 2001 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c: Remove leading capital from diagnostic messages, as + per GNU coding standards. + * g77spec.c: Similarly. + * lex.c: Similarly. + +2001-12-01 Zack Weinberg <zack@codesourcery.com> + + * f/fini.c: Use xmalloc. + +Fri Nov 30 20:54:02 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in: Delete references to proj.[co], proj-h.[co]. + * proj.c: Delete file. + +2001-11-29 Zack Weinberg <zack@codesourcery.com> + + * Make-lang.in (f/fini, f/intdoc): Depend on $(HOST_LIBDEPS) + and link with $(HOST_LIBS), not safe-ctype.o. + +2001-11-29 Joseph S. Myers <jsm28@cam.ac.uk> + + * Make-lang.in (f77.generated-manpages): New target. + ($(srcdir)/f/g77.1): Don't check $(GENERATED_MANPAGES). Allow + manpage generation to fail. + (f77.info): Don't depend on $(srcdir)/f/g77.1. + (f77.install-man): Depend on $(GENERATED_MANPAGES) rather than + directly on $(srcdir)/g77.1. + +2001-11-24 Toon Moene <toon@moene.indiv.nluug.nl> + + PR fortran/3957 + * lang-specs.h: Correct !pipe conditional in tradcpp0 invocation. + +2001-11-21 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77.texi: egcs was not a `@command'. + * invoke.texi: Ditto. + * news.texi: Substitute `@command' for `@code' + and `@option' for `@samp' where appropriate. + +2001-11-19 Loren J. Rittle <ljrittle@acm.org> + + * Make-lang.in: Complete ``Build g77.1 in $(srcdir)''. + +2001-11-19 Geoffrey Keating <geoffk@redhat.com> + + * g77spec.c (lang_specific_driver) [ENABLE_SHARED_LIBGCC]: Add + libgcc_s.so if libf2c is used. + * Make-lang.in (g77spec.o): Use DRIVER_DEFINES. + +2001-11-19 Toon Moene <toon@moene.indiv.nluug.nl> + + * .cvsignore: Ignore g77.1 + * g77.texi: Substitute `@command' for `@code' + where appropriate. + * invoke.texi: Ditto. + +2001-11-18 Toon Moene <toon@moene.indiv.nluug.nl> + + * Make-lang.in: Remove all references to LANGUAGES + and the stamp files that depend on its value. + +Sun Nov 18 11:13:04 2001 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (finish_parse): Remove. + (ffe_finish): Move body of finish_parse. + +Thu Nov 15 10:06:38 2001 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (ffecom_init_decl_processing): Renamed from + init_decl_processing. + (init_parse): Move contents to ffe_init. + (ffe_init): Update prototype. + +2001-11-14 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77.texi: Update to use `@command', `@option. + * invoke.texi: Ditto + +2001-11-14 Joseph S. Myers <jsm28@cam.ac.uk> + + * Make-lang.in: Change all uses of $(manext) to $(man1ext). + +2001-11-14 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77.1: Remove from CVS. + * Make-lang.in: Build g77.1 in $(srcdir). + Add --section=1 to POD2MAN command line. + * invoke.texi: Correct copyright years. + Add more sections to man page. Add GFDL. + +Fri Nov 9 23:16:45 2001 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (ffe_print_identifier): Rename. + (LANG_HOOKS_PRINT_IDENTIFIER): Override. + (lang_print_xnode, print_lang_decl, print_lang_statistics, + print_lang_type, set_yydebug): Remove. + +2001-11-09 Zack Weinberg <zack@codesourcery.com> + + * g77spec.c (lang_specific_driver): Adjust behavior of -v and + --version for consistency with other front ends. Remove large + #if 0 block. Do not add libraries to argv if there are no + input files. + (add_version_magic): Delete all references and dependent code. + * lang-options.h: Delete -fnull-version. + * lang-specs.h: Delete f77-version spec. + + * lex.c: Delete logic conditional on ffe_is_null_version() and + now-unused label. + * top.c: Delete ffe_is_null_version_ variable. + (ffe_decode_option): Delete -fnull-version case. + * top.h: Delete declaration of ffe_is_null_version_ and + ffe_is_null_version(), ffe_set_is_null_version() macros. + +Fri Nov 9 07:14:47 2001 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (language_string, lang_identify): Remove. + (struct lang_hooks): Constify. + (LANG_HOOKS_NAME): Override. + (init_parse): Update. + +2001-11-08 Andreas Franck <afranck@gmx.de> + + * Make-lang.in (G77_INSTALL_NAME, G77_CROSS_NAME): Handle + program_transform_name the way suggested by autoconf. + +2001-11-08 Toon Moene <toon@moene.indiv.nluug.nl> + + * Make-lang.in: Add rules for building g77.1. + * invoke.texi: Add man page stuff. Move indexing + from g77.texi to here. + * g77.texi: Remove indexing specific to invoke.texi. + * news.texi: Document that g77.1 is now a generated + file. + +Tue Nov 6 21:17:47 2001 Neil Booth <neil@cat.daikokuya.demon.co.uk> + + * com.c: Include langhooks-def.h. + * Make-lang.in: Update. + +2001-11-04 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77.texi: Split off invoke.texi (preliminary to using it + to generate a man page). + * Make-lang.in: Reflect in build rules. + +Fri Nov 2 10:51:34 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (ffecom_initialize_char_syntax_, U_CHAR, is_idchar, + is_idstart, is_hor_space, is_space, SKIP_WHITE_SPACE, + SKIP_ALL_WHITE_SPACE): Delete. + (read_filename_string, read_name_map): Don't use is_space or + is_hor_space. + +2001-10-29 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Document new ability to compile programs with + arrays larger than 512 Mbyte on 32-bit targets. + +2001-10-24 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffecom_check_size_overflow_): Only check for TREE_OVERFLOW. + +Tue Oct 23 14:01:27 2001 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (LANG_HOOKS_GET_ALIAS_SET): New macro. + (lang_get_alias_set): Delete. + +2001-10-23 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77.texi (Sending Patches): Remove. + +2001-10-22 Zack Weinberg <zack@codesourcery.com> + + * Make-lang.in (f/intdoc): Depend on safe-ctype.o. + +Sun Oct 21 17:28:17 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bad.c (ffebad_finish): Use safe-ctype macros and/or fold extra + calls into fewer ones. + * implic.c (ffeimplic_lookup_): Likewise. + * intdoc.c (dumpimp): Likewise. + * intrin.c (ffeintrin_init_0): Likewise. + * lex.c (ffelex_backslash_, ffelex_cfebackslash_, ffelex_hash_): + Likewise. + * lex.h (ffelex_is_firstnamechar): Likewise. + * target.c (ffetarget_integerhex): Likewise. + +2001-10-21 Craig Prescott <prescott@phys.ufl.edu> + + * target.h (FFETARGET_32bit_longs): Don't define + for 64-bit hppa. + +2001-10-17 Richard Henderson <rth@redhat.com> + + * std.c (ffestd_labeldef_format): Fix variable/stmt ordering. + (ffestd_R737A): Likewise. + +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. + (LANG_HOOKS_INIT_OPTIONS, LANG_HOOKS_DECODE_OPTION): New. + (lang_hooks): Use LANG_HOOKS_INITIALIZER. + +Sun Oct 7 12:27:54 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bad.c (_ffebad_message_, ffebad_messages_): Const-ify. + * bld.c (ffebld_arity_op_): Likewise. + * bld.h (ffebld_arity_op_): Likewise. + * com.c (ffecom_init_0): Likewise. + * intdoc.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_, + _ffeintrin_imp_, names, gens, imps, specs, cc_pair, + cc_descriptions, cc_summaries): Likewise. + * intrin.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_, + _ffeintrin_imp_, ffeintrin_names_, ffeintrin_gens_, + ffeintrin_imps_, ffeintrin_specs_): Likewise. + +2001-10-05 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Document libf2c being built as a shared library. + Use of array elements in bounds of adjustable arrays ditto. + +2001-10-03 Toon Moene <toon@moene.indiv.nluug.nl> + + * Make-lang.in: Remove reference to FORTRAN_INIT. + * g77spec.c: Add reference to FORTRAN_INIT. + +2001-09-29 Juergen Pfeifer <juergen.pfeifer@gmx.net> + + Make libf2c a shared library. + + * Make-lang.in: Pass define of frtbegin.o to compilation of g77spec.c. + * g77spec.c (lang_specific_driver): Treat linking in of frtbegin.o. + +2001-09-28 Robert Anderson <rwa@alumni.princeton.edu> + + * expr.c (ffeexpr_sym_rhs_dimlist_): Allow array elements + as bounds of adjustable arrays. + +Thu Sep 20 15:05:20 JST 2001 George Helffrich <george@geo.titech.ac.jp> + + * com.c (ffecom_subscript_check_): Loosen subscript checking rules + for character strings, to permit substring expressions like + string(1:0). + * news.texi: Document this as a new feature. + +Thu Sep 13 10:33:27 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bad.c (ffebad_finish): Const-ification and/or static-ization. + * intrin.c (ffeintrin_cmp_name_): Likewise. + * stc.c (ffestc_R904): Likewise. + +Wed Sep 12 12:09:04 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bld.c (ffebld_op_string_): Const-ification. + * com.c (ffecom_gfrt_name_, ffecom_gfrt_argstring_): Likewise. + * fini.c (xspaces): Likewise. + * global.c (ffeglobal_type_string_): Likewise. + * info.c (ffeinfo_basictype_string_, ffeinfo_kind_message_, + ffeinfo_kind_string_, ffeinfo_kindtype_string_, + ffeinfo_where_string_): Likewise. + * lex.c (ffelex_type_string_): Likewise. + * malloc.c (malloc_types_): Likewise. + * stc.c (ffestc_subr_binsrch_, ffestc_R904, ffestc_R904, + ffestc_R907): Likewise. + * symbol.c (ffesymbol_state_name_, ffesymbol_attr_name_): + Likewise. + * version.c (ffe_version_string): Likewise. + * version.h (ffe_version_string): Likewise. + +2001-09-11 Richard Henderson <rth@redhat.com> + + * parse.c (finput): Mark extern. + +2001-09-11 Jakub Jelinek <jakub@redhat.com> + + * com.c (ffe_init_options): Default to -fmerge-all-constants + if optimizing. + +2000-08-14 Ulrich Weigand <uweigand@de.ibm.com> + + * target.h (FFETARGET_32bit_longs): Don't define + for 64-bit S/390. + +2001-07-20 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffecom_expr_intrinsic_): + case FFEINTRIN_impIBITS: Remove TREE_SHIFT_FULLWIDTH define. + case FFEINTRIN_impISHFT: Ditto. Change LT_EXPR to NE_EXPR. + case FFEINTRIN_impISHFTC: Ditto. + case FFEINTRIN_impMVBITS: Ditto. + +2001-07-19 Jakub Jelinek <jakub@redhat.com> + + * top.c (ffe_decode_option): Disallow lang-independent processing + for -ffixed-form. + +2001-07-19 Toon Moene <toon@moene.indiv.nluug.nl> + + * f/com.c (ffecom_expr_intrinsic_): Deal (correctly) with + {L|R}SHIFT_EXPR not working when shift > size of type. + +2001-07-17 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (lang_print_error_function): Argument context + is unused. + +2001-07-14 Tim Josling <tej@melbpc.org.au> + + * com.c (ffecom_overlap_): Remove references to EXPON_EXPR. + (ffecom_tree_canonize_ref_): Likewise. + +2001-07-10 James Smaby <jsmaby@virgo.umeche.maine.edu> + + * intdoc.in: Fix the definition of COMPLEX ABS. + Remove `the' where inappropriate. + * intdoc.texi: Rebuilt. + +2001-07-04 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77.texi: Use gpl.texi and funding.texi. Remove Look and Feel + section. Add Funding Free Software to invariant sections. + * Make-lang.in ($(srcdir)/f/g77.info, f/g77.dvi): Update + dependencies and use doc/include in search path. + +2001-06-28 Gabriel Dos Reis <gdr@codesourcery.com> + + * Make-lang.in (f/com.o): Depend on diagnostic.h + * com.c: #include diagnostic.h + (lang_print_error_function): Take a 'diagnostic_context *'. + +Wed Jun 13 11:22:39 2001 Mark Mitchell <mark@codesourcery.com> + + * BUGS: Remove. + * NEWS: Likewise. + +2001-06-10 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77install.texi: Remove. + * Make-lang.in: Remove all mention of g77install.texi. + * g77.texi: Add documentation on how to get output always + flushed and how to increase the maximum unit number. + Remove all mention of g77install.texi. + * bugs.texi: Add documentation on how to change the threshold + for putting local arrays on the stack. + +2001-06-03 Toon Moene <toon@moene.indiv.nluug.nl> + + * root.texi: Fix typo in patches e-mail address. + +2001-06-03 Toon Moene <toon@moene.indiv.nluug.nl> + Jan van Male <jan.vanmale@fenk.wau.nl> + + * root.texi: Define `help' and `patches' mailing list + addresses. + * news.texi: Remove `prerelease' from 0.5.26 + * g77.texi: Use two spaces between command options, eliminate + some 'overfull hboxes'. Use help and patches mailing list + addresses where appropriate. + +2001-06-02 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77.texi: Move contents to just after title page. + +2001-06-02 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffecom_init_0): Make CHARACTER*1 unsigned. + +2001-05-23 Theodore Papadopoulo <Theodore.Papadopoulo@sophia.inria.fr> + + * Make-lang.in ($(srcdir)/f/g77.info): Added dependencies on + fdl.texi. + (f/g77.dvi): Use TEXI2DVI instead of custom tex calls. Create the + dvi file in the f directory. + +2001-05-25 Sam TH <sam@uchicago.edu> + + * bad.h: Fix header include guards. + * bit.h bld.h com.h data.h equiv.h expr.h global.h + implic.h info.h intrin.h lab.h lex.h malloc.h name.h + proj.h src.h st.h sta.h stb.h stc.h std.h ste.h + storag.h stp.h str.h sts.h stt.h stu.h stv.h stw.h + symbol.h target.h top.h type.h version.h + where.h: Likewise. + +2001-05-22 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77.texi: Update last-changed date. + * news.texi: Update copyright years, last-changed date. + * bugs.texi: Update copyright years, last-changed date. + +2001-05-22 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77.texi: Update maintenance information for + GNU Fortran. Remove all mention of -fdebug-kludge. + * news.texi: Make more news in 0.5.26 `user visible + changes'. Acknowledge work by important contributors. + * bugs.texi: Remove all mention of -fdebug-kludge. + +2001-05-20 Joseph S. Myers <jsm28@cam.ac.uk> + + * Make-lang.in (f/g77.dvi): Include $(srcdir) in TEXINPUTS. + +2001-05-19 Toon Moene <toon@moene.indiv.nluug.nl> + + * Make-lang.in: Have $(MAKEINFO) look into the parent + directory for includes. + * g77.texi: Use the GFDL. + +Sun May 13 12:25:06 2001 Mark Mitchell <mark@codesourcery.com> + + * Make-lang.in: Replace all uses of `touch' with $(STAMP). + +Wed May 2 10:20:08 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c: NULL_PTR -> NULL. + +Sun Apr 22 20:18:01 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (ffecom_subscript_check_): Use concat in lieu of + xmalloc/sprintf. + +2001-04-21 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Update release information for 0.5.27. + +Thu Apr 19 12:49:24 2001 Mark Mitchell <mark@codesourcery.com> + + * top.c (ffe_decode_option): Do not permit language-independent + processing for -ffixed-line-length. + +Thu Apr 12 17:57:55 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bad.c (inhibit_warnings): Delete redundant declaration. + + * com.c (skip_redundant_dir_prefix): Likewise. + + * com.h (mark_addressable): Likewise. + +2001-04-02 Jakub Jelinek <jakub@redhat.com> + + * lex.c (ffelex_hash_): Avoid eating one whole line after + #line. + +Mon Apr 2 22:38:09 2001 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (duplicate_decls): Fix thinko in lazy DECL_RTL patch + of 2001-03-04. + +Tue Mar 27 17:40:08 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in: Depend on $(SYSTEM_H), not system.h. + +Mon Mar 26 18:13:30 2001 Mark Mitchell <mark@codesourcery.com> + + * com.c (duplicate_decls): Don't copy DECL_FRAME_SIZE. + +Mon Mar 19 15:05:39 2001 Mark Mitchell <mark@codesourcery.com> + + * com.c (builtin_function): Use SET_DECL_ASSEMBLER_NAME. + +Wed Mar 14 09:29:27 2001 Mark Mitchell <mark@codesourcery.com> + + * com.c (ffecom_member_phase_2): Use COPY_DECL_RTL, + DECL_RTL_SET_P, etc. + (duplicate_decls): Likewise. + (start_decl): Likewise. + +Fri Mar 9 22:52:55 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * fini.c (main): Use really_call_malloc, not malloc. + +Thu Mar 8 13:27:47 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c: Don't rely on the POSIX macro to define autoconf stuff. + +2001-03-07 Brad Lucier <lucier@math.purdue.edu> + + * g77.texi: Document new options -funsafe-math-optimizations + and -fno-trapping-math. Revise documentation for -ffast-math. + +2001-03-01 Zack Weinberg <zackw@stanford.edu> + + * proj.h: Delete 'bool' type. Don't include stddef.h here. + * com.c: Rename variables named 'true' and/or 'false'. + * intdoc.c: Delete 'bool' type. + +2001-03-01 Zack Weinberg <zackw@stanford.edu> + + * lang-specs.h: Add zero initializer for cpp_spec field to all + array elements. + +2001-02-24 Zack Weinberg <zackw@stanford.edu> + + * com.c: Don't define STDC_HEADERS, autoconf handles it. + +Fri Feb 23 15:28:39 2001 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (set_block): Set NAMES and BLOCKS from BLOCK. + +2001-02-19 Joseph S. Myers <jsm28@cam.ac.uk> + + * version.c, root.texi: Update GCC version number to 3.1. Update + G77 version number to 0.5.27. + * BUGS, NEWS: Regenerate. + +Sun Feb 4 15:52:44 2001 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (ffecom_init_0): Call fatal_error instead of fatal. + * com.c (init_parse): Call fatal_io_error instead of + pfatal_with_name. + (ffecom_decode_include_option_): Make errors non-fatal. + * lex.c (ffelex_cfelex_, ffelex_get_directive_line_): Likewise. + (ffelex_hash_): Likewise. + +Sat Jan 27 20:52:18 2001 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in: Remove all dependencies on defaults.h. + * com.c: Don't include defaults.h. + +2001-01-23 Michael Sokolov <msokolov@ivan.Harhan.ORG> + + * com.c: Don't explicitly include any time headers, the right ones are + already included by proj.h. + +2001-01-15 Mark Mitchell <mark@codesourcery.com> + + * com.c (ffecom_lookup_label): Set DECL_CONTEXT for FORMAT + label to current_function_decl. + +Fri Jan 12 17:21:33 2001 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77spec.c (lang_specific_driver): Update copyright year to 2001. + +Wed Jan 10 14:39:45 2001 Mark Mitchell <mark@codesourcery.com> + + * com.c (ffecom_init_zero_): Remove last argument in call to + make_decl_rtl; use make_function_rtl instead of make_decl_rtl. + (ffecom_lookup_label_): Likewise. + (builtin_function): Likewise. + (start_function): Likewise. + +Thu Dec 21 21:19:42 2000 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77install.texi, g77.texi: Update last-updated dates for + installation information and the manual as a whole. + * bugs.texi, news.texi: Update copyright years in the comments at + the top of the file. + +2000-12-21 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77install.texi: Adjust wording of an EGCS reference. + +Thu Dec 21 20:00:48 2000 Joseph S. Myers <jsm28@cam.ac.uk> + + * BUGS, NEWS: Regenerate. + +2000-12-18 Joseph S. Myers <jsm28@cam.ac.uk> + + * com.c [VMS]: Remove definition of BSTRING. + +2000-12-18 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77.texi: Update GPL copy not to refer to years 19@var{yy}. + +2000-12-18 Toon Moene <toon@moene.indiv.nluug.nl> + + * bugs.texi: Correct copyright years. + * g77.texi: Likewise. + * news.texi: Likewise. + +2000-12-18 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77install.texi: Remove obsolete parts only used for INSTALL, + and DOC-G77 conditionals. Update last-update-install date. + +Sat Dec 9 10:20:11 2000 Joseph S. Myers <jsm28@cam.ac.uk> + + * .cvsignore: New file; add info files. + +2000-12-08 Joseph S. Myers <jsm28@cam.ac.uk> + + * Make-lang.in (f77.info): Depend on info files in source + directory. + (f/g77.info): Build info files in source directory; don't build + them unless BUILD_INFO is "info". + (f77.install-info): Install info files from source directory. + +2000-12-07 Zack Weinberg <zack@wolery.stanford.edu> + + * Make-lang.in: Link f/fini with safe-ctype.o. + * bad.c: Don't test ISUPPER(c) || ISLOWER(c) before calling TOUPPER(c). + * com.c: Use TOUPPER, not ffesrc_toupper. + * fini.c: Don't test ISALPHA(c) before calling TOUPPER(c)/TOLOWER(c). + * intrin.c: Don't test IN_CTYPE_DOMAIN(c). + * src.c: Delete ffesrc_toupper_ and ffesrc_tolower_ and their + initializing code; use TOUPPER and TOLOWER instead of + ffesrc_toupper and ffesrc_tolower. + * src.h: Don't declare ffesrc_toupper_ or ffesrc_tolower_. + Don't define ffesrc_toupper or ffesrc_tolower. + +2000-11-28 Richard Henderson <rth@redhat.com> + + * com.c (ffecom_member_phase2_): Set TREE_USED on the debugging decl. + +2000-11-26 Joseph S. Myers <jsm28@cam.ac.uk> + + * RELEASE-PREP: Remove obsolete EGCS reference. + * g77.texi: Adjust reference to EGCS as something current. + * lang-options.h (FTNOPT): Remove macro and obsolete comment. + Include doc strings directly in option listing instead of through + this macro. + * root.texi: Remove support for multiple different (FSF and EGCS) + distributions of g77. + * g77install.texi: Remove conditioned out instructions applying + only to obsolete distributions of g77 not as part of GCC. Change + "superceded" to the correct spelling "superseded". + +Sun Nov 26 19:25:56 2000 Joseph S. Myers <jsm28@cam.ac.uk> + + * g77spec.c (lang_specific_driver): Update copyright year to 2000. + +Thu Nov 23 02:18:57 2000 J"orn Rennecke <amylaar@redhat.com> + + * Make-lang.in (g77spec.o): Depend on $(CONFIG_H). + +2000-11-21 David Billinghurst <David.Billinghurst@riotinto.com) + + * Make-lang.in: Add $(build_exeext) to f/fini target + +2000-11-21 Andreas Jaeger <aj@suse.de> + + * g77.texi (Floating-point Exception Handling): Use feenableexcept + in example. + (Floating-point precision): Change to match above change. + +Sun Nov 19 17:29:22 2000 Matthias Klose <doko@marvin.itso-berlin.de> + + * g77.texi (Floating-point precision): Adjust example + to work with glibc (>= 2.1). + +Sat Nov 18 13:54:49 2000 Matthias Klose <doko@cs.tu-berlin.de> + + * g77.texi (Floating-point Exception Handling): Adjust + example to work with glibc (>= 2.1). + +2000-11-18 Alexandre Oliva <aoliva@redhat.com> + + * Make-lang.in (INTDOC_DEPS): New macro. + (f/intdoc.texi): Depend on $(INTDOC_DEPS). Build f/intdoc. + (f/intdoc): Likewise. Add $(build_exeext). + +2000-11-17 Zack Weinberg <zack@wolery.stanford.edu> + + * lex.c (ffelex_hash_): Change ggc_alloc_string (var, -1) to + ggc_strdup (var). + +Thu Nov 16 23:14:07 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * malloc.c (malloc_init): Call xmalloc, not malloc. + +2000-11-10 Rodney Brown <RodneyBrown@mynd.com> + + * Make-lang.in: Remove OUTPUT_OPTION from g77version.o target. + +2000-11-10 Toon Moene <toon@moene.indiv.nluug.nl> + + * root.texi: Remove non-historical EGCS reference. + Set current g77 version to 0.5.26. + +2000-11-10 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffecom_stabilize_aggregate_) case RTL_EXPR: Abort. + +2000-11-10 Zack Weinberg <zack@wolery.stanford.edu> + + * Make-lang.in (f/fini.o, f/proj-h.o): Remove pointless sed + munging of source file name. + ($(srcdir)/f/intdoc.texi): Break up into several rules each of + which builds just one thing. Don't mess with $(LANGUAGES). + (f/ansify.o, f/intdoc.o): Remove unnecessary rules. + +2000-11-05 Toon Moene <toon@moene.indiv.nluug.nl> + + * root.texi, news.texi, g77install.texi, g77.texi, bugs.texi: + Remove non-historical references to egcs/EGCS. + +2000-11-05 Joseph S. Myers <jsm28@cam.ac.uk> + + * Make-lang.in: Remove f77.distdir and f/INSTALL. + * INSTALL, install0.texi: Remove. + +2000-11-02 Joseph S. Myers <jsm28@cam.ac.uk> + + * com.c (open_include_file, ffecom_open_include_): Use strchr () + and strrchr () instead of index () and rindex (). + +2000-10-27 Zack Weinberg <zack@wolery.stanford.edu> + + * Make-lang.in: Move all build rules here from Makefile.in, + adapt to new context. Wrap all rules that change the current + directory in parentheses. Expunge all references to $(P). + When one command depends on another and they're run all at + once, use && to separate them, not ;. Add OUTPUT_OPTION to + all object-file generation rules. Delete obsolete variables. + + * Makefile.in: Delete. + * config-lang.in: Delete outputs= line. + +Sat Oct 21 18:07:48 2000 Joseph S. Myers <jsm28@cam.ac.uk> + + * Makefile.in, g77spec.c: Remove EGCS references in comments. + +Thu Oct 12 22:28:51 2000 Mark Mitchell <mark@codesourcery.com> + + * com.c (ffecom_do_entry_): Don't mess with obstacks. + (ffecom_finish_global_): Likewise. + (ffecom_finish_symbol_transform_): Likewise. + (ffecom_gen_sfuncdef_): Likewise. + (ffecom_init_zero_): Likewise. + (ffecom_start_progunit_): Likewise. + (ffecom_sym_transform_): Likewise. + (ffecom_sym_transform_assign_): Likewise. + (ffecom_transform_equiv_): Likewise. + (ffecom_transform_namelist_): Likewise. + (ffecom_vardesc_): Likewise. + (ffecom_vardesc_array_): Likewise. + (ffecom_vardesc_dims_): Likewise. + (ffecom_end_transition): Likewise. + (ffecom_make_tempvar): Likewise. + (bison_rule_pushlevel_): Likewise. + (bison_rule_compstmt_): Likewise. + (finish_decl): Likewise. + (finish_function): Likewise. + (push_parm_decl): Likewise. + (start_decl): Likewise. + (start_function): Likewise. + (ggc_p): Don't define. + * std.c (ffestd_stmt_pass_): Likewise. + * ste.c (ffeste_end_block_): Likewise. + (ffeste_end_stmt_): Likewise. + (ffeste_begin_iterdo_): Likewise. + (ffeste_io_ialist_): Likewise. + (ffeste_io_cilist_): Likewise. + (ffeste_io_inlist_): Likewise. + (ffeste_io_olist_): Likewise. + (ffeste_R810): Likewise. + (ffeste_R838): Likewise. + (ffeste_R839): Likewise. + (ffeste_R842): Likewise. + (ffeste_R843): Likewise. + (ffeste_R1001): Likewise. + +2000-10-05 Richard Henderson <rth@cygnus.com> + + * com.c (finish_function): Don't init can_reach_end. + +Sun Oct 1 11:43:44 2000 Mark Mitchell <mark@codesourcery.com> + + * com.c (lang_mark_false_label_stack): Remove. + +2000-09-10 Zack Weinberg <zack@wolery.cumb.org> + + * com.c: Include defaults.h. + * com.h: Don't define the *_TYPE_SIZE macros. + * Makefile.in: Update dependencies. + +2000-08-29 Zack Weinberg <zack@wolery.cumb.org> + + * ansify.c: Use #line, not # <number>. + +2000-08-24 Greg McGary <greg@mcgary.org> + + * intdoc.c (ARRAY_SIZE): Remove macro. + * proj.h (ARRAY_SIZE): Remove macro. + * com.c (init_decl_processing): Use ARRAY_SIZE. + +2000-08-22 Toon Moene <toon@moene.indiv.nluug.nl> + + * com-rt.def: Adapt macro DEFGFRT to accept CONST boolean. + * com.c (macro DEFGFRT): Use CONST boolean. + (ffecom_call_binop_): Choose between call by value + and call by reference. + (ffecom_expr_): Use direct calls to (g)libc functions for + POW_DD, LOG10, (float) MOD. + (ffecom_make_gfrt_): Add const indication to table of + intrinsics. + * com.h (macro DEFGFRT): Use CONST boolean. + * intrin.def: Adjust DEFIMP definition of LOG10, (float) MOD. + +2000-08-21 Nix <nix@esperi.demon.co.uk> + + * lang-specs.h: Do not process -o or run the assembler if + -fsyntax-only. Use %j instead of /dev/null. + +2000-08-21 Jakub Jelinek <jakub@redhat.com> + + * lang-specs.h: Pass -I* options to f771. + +2000-08-19 Toon Moene <toon@moene.indiv.nluug.nl> + + * top.c (ffe_decode_option): Disable -fdebug-kludge + and warn about it. + * lang-options.h: Document the fact. + * g77.texi: Ditto. + +2000-08-13 Toon Moene <toon@moene.indiv.nluug.nl> + + * bugs.texi: Describe new ability to emit debug info + for EQUIVALENCE members. + * news.texi: Ditto. + +2000-08-11 G. Helffrich <george@gly.bris.ac.uk> + Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffecom_transform_equiv_): Make EQUIVALENCEs addressable + so that debug info can be attached to their storage. + Unconditionally list the storage set aside for them. + +2000-08-07 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77spec.c (lang_specific_driver): Clearer g77 version message. + +2000-08-04 Zack Weinberg <zack@wolery.cumb.org> + + * Make-lang.in (f771): Depend on $(BACKEND), not stamp-objlist. + * Makefile.in: Add BACKEND; delete OBJS, OBJDEPS. + (f771): Link with $(BACKEND). + +2000-08-02 Zack Weinberg <zack@wolery.cumb.org> + + * g77spec.c: Adjust type of second argument to + lang_specific_driver, and update code as necessary. + + * expr.c (ffeexpr_finished_): Cast signed side of ?: + expression to bool. + +2000-07-31 Zack Weinberg <zack@wolery.cumb.org> + + * lang-specs.h: Rename cpp to cpp0 and/or tradcpp to tradcpp0. + +Thu Jul 27 11:50:08 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * fini.c (main): Avoid automatic aggregate initialization. + + * proj.h: Indent #error directive. + +2000-07-26 Toon Moene <toon@moene.indiv.nluug.nl> + + * lang-specs.h: Remove one /dev/null from tradcpp invocation. + +Sun Jul 23 15:47:30 2000 Billinghurst, David <David.Billinghurst@riotinto.com> + + * Make-lang.in: Put $(build_exeext) suffix on programs which run + on the build machine. + +2000-07-22 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c (ffecom_expr_intrinsic_): case FFEINTRIN_impFGETC_subr, + FFEINTRIN_impFPUTC_subr: Check for arg3 being NULL. + +2000-07-13 Zack Weinberg <zack@wolery.cumb.org> + + * lang-specs.h: Use the new named specs. Remove unnecessary braces. + +2000-07-02 Toon Moene <toon@moene.indiv.nluug.nl> + + * version.c: Bump version number. + +2000-06-21 Zack Weinberg <zack@wolery.cumb.org> + + * Make-lang.in (F77_SRCS): Remove all .j files. + * Makefile.in (ASSERT_H, CONFIG_H, CONVERT_H, FLAGS_H, GGC_H, + GLIMITS_H, HCONFIG_H, INPUT_H, OUTPUT_H, RTL_H, SYSTEM_H, + TOPLEV_H, TREE_H): Remove references to .j files. + (TCONFIG_H, TM_H): Remove entirely. + (deps-kinda): Delete rule. + Correct commentary. + + * assert.j, config.j, convert.j. flags.j, ggc.j, glimits.j, + hconfig.j, input.j, output.j, rtl.j, system.j, toplev.j, + tree.j, tconfig.j, tree.j: Delete. + + * ansify.c, bad.c, bit.c, com.c, com.h, intdoc.c, lex.c, + parse.c, proj.c, proj.h, ste.c, target.c, target.h, top.c, + where.c, where.h: Include parent-directory headers directly. + * lex.c: Don't include tree.h twice. + +2000-05-17 H.J. Lu (hjl@gnu.org) + + * Make-lang.in: Use a unique stamp for each target to support + parallel make. + +Thu Jun 15 14:03:14 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * ste.c (gbe_block): Constify. + +2000-06-13 Jakub Jelinek <jakub@redhat.com> + + * com.c (ffecom_transform_common_): Set DECL_USER_ALIGN. + (ffecom_transform_equiv_, ffecom_decl_field): Likewise. + (ffecom_init_0): Set DECL_USER_ALIGN resp. TYPE_USER_ALIGN. + (duplicate_decls): Set DECL_USER_ALIGN. + +Sun Jun 11 00:03:00 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (lang_get_alias_set): Mark parameter with ATTRIBUTE_UNUSED. + +2000-06-04 Philipp Thomas <pthomas@suse.de> + + * Makefile.in(INTLLIBS): New macro. + (LIBS): Add INTLLIBS. + (DEPLIBS): Likewise. + +2000-06-02 Richard Henderson <rth@cygnus.com> + + * com.c (lang_get_alias_set): New. + +2000-05-28 Toon Moene <toon@moene.indiv.nluug.nl> + + * bugs.texi: Note that debugging information for + common block items is emitted now. + * news.texi: Ditto. + +2000-05-18 Chris Demetriou <cgd@sibyte.com> + + * com.h (FFECOM_f2cINTEGER, FFECOM_f2cLONGINT): Note that + these types correspond to built-in types now defined in + the C front end (for libf2c). + +Wed May 17 17:27:44 2000 Andrew Cagney <cagney@b1.cygnus.com> + + * top.c (ffe_decode_option): Update -Wall unused flags by calling + set_Wunused. + +2000-05-09 Zack Weinberg <zack@wolery.cumb.org> + + * com.c (ffecom_subscript_check_): Constify array_name + parameter. Clean up string bashing. + (ffecom_arrayref_, ffecom_char_args_x_): Constify array_name + parameter. + (ffecom_do_entry_, ffecom_gen_sfuncdef_, ffecom_start_progunit_, + ffecom_sym_transform_, ffecom_sym_transform_assign_): Constify + local char *. + (init_parse): Constify parameter and return value. + * lex.c: Include dwarfout.h instead of prototyping dwarfout_* + functions here. + (ffelex_file_pop_, ffelex_file_push_): Constify filename parameter. + (ffelex_hash_, ffelex_include_): Constify local char *. + * std.c (ffestd_exec_end): Constify local char *. + * where.c (ffewhere_file_new): Constify filename parameter. + * where.h: Update prototypes. + +2000-05-06 Zack Weinberg <zack@wolery.cumb.org> + + * com.c (ffecom_overlap_): Set source_offset to + bitsize_zero_node. + (ffecom_tree_canonize_ptr_): Use size_binop. Convert to + bitsizetype before multiplying by TYPE_SIZE. + (ffecom_tree_canonize_ref_) [case ARRAY_REF]: Break up offset + calculation. Convert to bitsizetype before multiplying by + TYPE_SIZE. + +2000-04-18 Zack Weinberg <zack@wolery.cumb.org> + + * lex.c: Remove references to cccp.c. + * g77install.texi: Remove references to cexp.c/cexp.y. + +2000-04-15 David Edelsohn <edelsohn@gnu.org> + + * target.h (FFETARGET_32bit_longs): Define for 64-bit PowerPC + as well. + +Wed Apr 12 15:15:26 2000 Mark Mitchell <mark@codesourcery.com> + + * com.h (FFECOM_f2cINTEGER): Avoid using LONG_TYPE_SIZE as a + preprocessor constant. + (FFECOM_f2cLOGICAL): Likewise. + (FFECOM_f2cLONGINT): Likewise. + +Wed Apr 5 17:46:39 2000 Mark Mitchell <mark@codesourcery.com> + + * Makefile.in (GGC_H): Add varray.h. + +2000-04-03 Zack Weinberg <zack@wolery.cumb.org> + + * lang-specs.h: Pass -fno-show-column to the preprocessor. + +2000-03-28 Franz Sirl <Franz.Sirl-kernel@lauterbach.com> + + * com.c (ffecom_decl_field): Use DECL_ALIGN for a FIELD_DECL. + (ffecom_init_0): Likewise. + +Sat Mar 25 09:12:10 2000 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (ffecom_tree_canonize_ptr_): Use bitsize_zero_node. + (ffecom_tree_canonize_ref_): Likewise. + +Mon Mar 20 15:49:40 2000 Jim Wilson <wilson@cygnus.com> + + * f/target.h (FFETARGET_32bit_longs): New. Define for alpha, sparc64, + and ia64. + (ffetargetInteger1, ffetargetLogical1, ffetargetReal1, ffetargetReal2, + ffetarget_integerdefault_is_magical): Use FFETARGET_32bit_longs. + +Fri Mar 10 00:43:55 2000 Jason Merrill <jason@casey.cygnus.com> + + * com.c (ffecom_stabilize_aggregate_): Don't refer to TREE_RAISES. + +Mon Mar 6 18:05:19 2000 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (ffecom_f2c_set_lio_code_): Use compare_tree_int. + (ffecom_sym_transform_, ffecom_transform_common_): Likewise. + (ffecom_transform_equiv_): Likewise. + +Mon Mar 6 13:01:19 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * ansify.c (die_unless): Don't use ANSI string concatenation. + (die): Mark with ATTRIBUTE_NORETURN. + +Wed Mar 1 00:31:44 2000 Martin von Loewis <loewis@informatik.hu-berlin.de> + + * com.c (current_function_decl): Move to toplev.c. + +Sun Feb 27 16:40:33 2000 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (ffecom_arrayref_): Convert args to size_binop to proper type. + (ffecom_tree_canonize_ptr_): Don't use size_binop for non-sizes. + (ffecom_tree_canonize_ref_): Likewise. + (type_for_mode): Handle TImode. + * ste.c (ffeste_io_dofio_, ffeste_io_douio_): Use TYPE_SIZE_UNIT. + (ffeste_io_ciclist_): Likewise. + +2000-02-23 Zack Weinberg <zack@wolery.cumb.org> + + * com.c (ffecom_type_permanent_copy_): Delete unused function. + (finish_decl): Don't change TREE_PERMANENT (DECL_INITIAL (decl)). + +Sat Feb 19 18:43:13 2000 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> + + * com.c (ffecom_sym_transform): Use DECL_SIZE_UNIT. + (ffecom_transform_common_, ffecom_transform_equiv_): Likewise. + (duplicate_decls): Likewise. + (ffecom_tree_canonize_ptr_): Delete extra arg to bitsize_int. + (finish_decl): Delete -Wlarger-than processing. + +Fri Feb 18 13:19:34 2000 Martin von Loewis <loewis@informatik.hu-berlin.de> + + * g77spec.c (lang_specific_driver): Use GCCBUGURL. + +2000-02-17 Andy Vaught <andy@maxwell.la.asu.edu> + + * com.c (ffecom_member_phase2_): Re-enable COMMON debug code. + (ffecom_finish_symbol_transform_): Likewise. + (ffecom_transform_common_): Call ffestorag_set_hook. + +Wed Feb 16 11:09:38 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in (g77spec.o): Depend on $(GCC_H), not gcc.h. + +2000-02-15 Jonathan Larmour <jlarmour@redhat.co.uk> + + * lang-specs.h: Add new __GNUC_PATCHLEVEL__ define to default spec. + +Tue Feb 15 11:14:17 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * g77spec.c: Don't declare `version_string'. + +Sat Feb 5 23:27:25 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (mark_tracker_head, mark_binding_level): Protoize. + + * where.c (mark_ffewhere_head): Likewise. + +Wed Jan 12 09:32:59 2000 Zack Weinberg <zack@wolery.cumb.org> + + * lang-specs.h: Pass -lang-fortran to preprocessor. + +Thu Dec 30 13:14:31 1999 Richard Henderson <rth@cygnus.com> + + * stw.h (struct _ffestw_): Change type of uses_ to int. + +Thu Dec 30 11:42:05 1999 Geoff Keating <geoffk@cygnus.com> + + * com.c (ffecom_init_0): Make double_ftype_double, + float_ftype_float, ldouble_ftype_ldouble, + ffecom_tree_ptr_to_fun_type_void local. + (tracker_head): New static variable. + (mark_tracker_head): New, marker procedure for tracker_head. + (ffecom_save_tree_forever): New procedure. + (ffecom_init_zero_): Remove obstack use. + (ffecom_make_gfrt_): Remove obstack use. + (ffecom_sym_transform_): Remove obstack use, save appropriate trees. + (ffecom_transform_common_): Remove obstack use, save appropriate + trees. + (ffecom_type_namelist_): Remove obstack use, save appropriate + trees. + (ffecom_type_vardesc_): Remove obstack use, save appropriate trees. + (ffecom_lookup_label): Remove obstack use, save appropriate trees. + (duplicate_decls): Remove obstack use. + (finish_function): push & pop ggc context around + rest_of_compilation when building nested function. + (mark_binding_level): New function. + (init_decl_processing): Mark all the GC roots. + (ggc_p): Set to 1. + (lang_mark_tree): New function. + (lang_mark_false_label_stack): New trivial function. + * com.h (ffecom_save_tree_forever): Declare as external. + * lex.c (ffelex_hash_): Use GC to allocate the filename string + even when ffelex_kludge_flag_. + * ste.c (ffeste_io_ialist_): Register a static root. + (ffeste_io_inlist_): Likewise. + (ffeste_io_icilist_): Likewise. + (ffeste_io_cllist_): Likewise. + (ffeste_io_cilist_): Likewise. + (ffeste_io_olist_): Likewise. + * Makefile.in (OBJS): Don't use ggc-callbacks.o. + (OBJDEPS): Likewise. + (GGC_H): New variable. + Update dependencies. + * where.c (ffewhere_head): New global. + (mark_ffewhere_head): New marker procedure for ffewhere_head. + (ffewhere_file_kill): Use GC to do memory management. + (ffewhere_file_new): Use GC to do memory management. + * ggc.j: New file. + +Wed Dec 29 19:29:26 1999 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at> + + * g77.texi (C Interfacing Tools): Fix an incorrect link. + +1999-12-13 Jakub Jelinek <jakub@redhat.com> + + * target.h: Handle sparc64 the same way as alpha. + +Sun Nov 28 21:39:05 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (ffecom_file_, ffecom_file, file_buf, + ffecom_open_include_): Constify a char*. + (ffecom_possible_partial_overlap_): Mark parameter `expr2' with + ATTRIBUTE_UNUSED. + (ffecom_init_0): Use a fully prototyped cast in call to bsearch. + (lang_print_error_function): ANSI-fy. + + * com.h (ffecom_file): Constify a char*. + + * fini.c (main): Call return, not exit. + + * g77spec.c (lang_specific_driver): Use non-const *in_argv in + assignment. + + * intrin.c (ffeintrin_cmp_name_): Don't needlessly cast away + const-ness. + +Sun Nov 28 21:15:29 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (ffecom_get_invented_identifier): Rewrite to take an ellipses. + + (ffecom_char_enhance_arg_, ffecom_do_entry_, + ffecom_f2c_make_type_, ffecom_gen_sfuncdef_, + ffecom_start_progunit_, ffecom_start_progunit_, + ffecom_start_progunit_, ffecom_sym_transform_assign_, + ffecom_transform_equiv_, ffecom_transform_namelist_, + ffecom_vardesc_, ffecom_vardesc_array_, ffecom_vardesc_dims_, + ffecom_end_transition, ffecom_lookup_label, ffecom_temp_label): + Adjust accordingly. + + * com.h (ffecom_get_invented_identifier): Likewise. + + * sts.c (ffests_printf): New function taking ellipses. + (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s, + ffests_printf_2Us): Delete. + + * sts.h: Likewise. + + * std.c (ffestd_R1001dump_, ffestd_R1001dump_1005_1_, + ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_, + ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_, + ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_, + ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_, + ffestd_R1001rtexpr_): Call `ffests_printf', not `ffests_printf_*'. + + * ste.c (ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_, + ffeste_io_icilist_, ffeste_io_inlist_, ffeste_io_olist_): Likewise. + +Wed Nov 10 12:43:21 1999 Philippe De Muyter <phdm@macqel.be> + Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * proj.h: Test `GCC_VERSION', not `HAVE_GCC_VERSION'. + +Tue Oct 26 01:32:19 1999 Mark Mitchell <mark@codesourcery.com> + + * com.c (poplevel): Don't call remember_end_note. + +Fri Oct 15 15:18:12 1999 Greg McGary <gkm@gnu.org> + + * top.h (ffe_is_subscript_check_): Remove extern decl. + (ffe_is_subscript_check, ffe_set_is_subscript_check): Remove macros. + * top.c (ffe_is_subscript_check_): Remove global variable. + (ffe_decode_option): Remove "(no-)bounds-check" flag handling. + Set flag_bounds_check for "(no-)fortran-bounds-check". + * com.c + (ffecom_arrayref_): s/ffe_is_subscript_check ()/flag_bounds_check/ + (ffecom_char_args_x_): Ditto. + +Sun Oct 10 08:40:18 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * proj.h: Use HAVE_GCC_VERSION instead of explicitly testing + __GNUC__ and __GNUC_MINOR__. Don't define BUILT_WITH_270. Define + macro UNUSED in terms of ATTRIBUTE_UNUSED. + +Fri Sep 24 10:48:10 1999 Bernd Schmidt <bernds@cygnus.co.uk> + + * com.c (duplicate_decls): Use DECL_BUILT_IN_CLASS rather than + DECL_BUILT_IN. + (builtin_function): No longer static. New arg CLASS. Arg + FUNCTION_CODE now of type int. All callers changed. + Set the builtin's DECL_BUILT_IN_CLASS. + +Tue Sep 21 09:08:30 1999 Toon Moene <toon@moene.indiv.nluug.nl> + + * g77spec.c (lang_specific_driver): Initialize return value. + +Thu Sep 16 18:07:11 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bad.c (ffebad_finish): Use uppercase ctype macro from system.h. + + * fini.c (main): Likewise. + + * intrin.c (ffeintrin_init_0): Likewise. + + * lex.c (ffelex_hash_): Likewise. + + * src.c (ffesrc_init_1): Likewise. + +Tue Sep 14 12:14:28 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * g77spec.c (lang_specific_driver): Remove unnecessary argument in + call to function `fatal'. + +Sun Sep 12 23:29:47 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in (g77spec.o): Depend on system.h and gcc.h. + + * g77spec.c: Include gcc.h. + (g77_xargv): Constify. + (g77_fn): Add parameter prototypes. + (lookup_option, append_arg): Add static prototypes. + (g77_newargv): Constify. + (lookup_option, append_arg, lang_specific_driver): Constify a char*. + (lang_specific_driver): All calls to the function pointer + parameter now explicitly call `fatal'. + +Fri Sep 10 10:32:32 1999 Bernd Schmidt <bernds@cygnus.co.uk> + + * com.h: Delete declarations for all tree nodes now moved to + global_trees. + * com.c: Delete their definitions. + (ffecom_init_0): Call build_common_tree_nodes and + build_common_tree_nodes_2 instead of building their nodes here. + Override their decisions for complex nodes. + +Sat Sep 4 13:46:27 1999 Mark Mitchell <mark@codesourcery.com> + + * Make-lang.in (f771): Depend on ggc-callbacks.o. + * Makefile.in (OBJS): Add ggc-callbacks.o. + (OBJDEPS): Likewise. + +Mon Aug 30 22:05:53 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (language_string): Constify. + +Mon Aug 30 20:29:30 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Makefile.in (LIBS, LIBDEPS): Link with & depend on libiberty.a. + Remove hacks for stuff which now comes from libiberty. + +Sun Aug 29 09:47:45 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (lang_printable_name): Constify a char*. + +Wed Aug 25 01:21:06 1999 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE> + + * lang-specs.h: Pass cc1 spec to f771. + +Mon Aug 9 19:44:08 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (lang_print_error_function): Constify a char*. + (init_parse): Remove redundant prototype for `print_error_function'. + (lang_identify): Constify a char*. + +Thu Aug 5 02:40:42 1999 Jeffrey A Law (law@cygnus.com) + + * g77spec.c: Update URLS and mail addresses. + * root.texi: Update URLS and mail addresses. + +1999-07-25 Richard Henderson <rth@cygnus.com> + + * com.c (ptr_type_node, va_list_type_node): New. + (ffecom_init_0): Init and use ptr_type_node. + +1999-07-17 Alexandre Oliva <oliva@dcc.unicamp.br> + + * root.texi: Update e-mail addresses to gcc.gnu.org. + * g77spec.c (lang_specific_driver): Updated URL with bug reporting + instructions to gcc.gnu.org. Removed e-mail address. + +Sat Jul 17 11:28:43 1999 Craig Burley <craig@jcb-sc.com> + + * root.texi, g77install.texi: Switchover to GCC terminology. + Also, FSF-G77 had been mistakenly set at some point. + +Thu Jul 8 15:38:50 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Describe DATE intrinsic fix. + +Mon Jun 28 21:44:19 1999 Craig Burley <craig@jcb-sc.com> + + * version.c: Denote experimental version. + +Mon Jun 28 10:43:11 1999 Craig Burley <craig@jcb-sc.com> + + * com.c (ffecom_prepare_expr_): A COMPLEX intrinsic needs + a temp even if -fno-f2c. + + * version.c: Bump version. + +Mon Jun 28 21:31:35 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi, news.texi: Doc upgrade to netlib libf2c as of today. + Explain that this fixes the NAMELIST-read bug. + +Fri Jun 25 11:06:32 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi: Describe K(5)=10*3 NAMELIST-read bug. + +Mon Jun 21 12:40:17 1999 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at> + + * g77.texi: Update links. + +Mon Jun 21 05:33:51 1999 Jeffrey A Law (law@cygnus.com) + + * news.texi: Add missing @end ifclear. + +Fri Jun 18 11:43:46 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Doc TtyNam fix. + +Fri Jun 18 11:26:50 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: New heading for development version. + Doc upgrade to netlib libf2c as of today. + +Wed Jun 16 11:43:02 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Mention BACKSPACE fix to libg2c. + +Mon Jun 7 08:42:40 1999 Craig Burley <craig@jcb-sc.com> + + * Make-lang.in: Any target using libsubdir must depend + on installdirs. + +Sat Jun 5 23:50:36 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Describe a few more missing features people + have emailed me about. + +Sat Jun 5 17:03:23 1999 Craig Burley <craig@jcb-sc.com> + + From Dave Love to egcs-patches on 20 May 1999 17:38:38 +0100: + * g77.texi: Clean up fossil text vis-a-vis Intel CPUs. + +Fri Jun 4 13:56:56 1999 Craig Burley <craig@jcb-sc.com> + + * Make-lang.in: Use libsubdir, not prefix, to store + temporary lang-f77 `flag' file. + +Fri Jun 4 10:26:04 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi (News): Mention GCC 2.95 in favor of EGCS 1.2. + Mention that libg2c is multilibbed. + +Fri Jun 4 10:09:50 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi (Missing Features): Add `Better Warnings' + item. + +Fri May 28 16:51:41 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Fix thinko. + +Wed May 26 14:43:27 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Document Tue May 18 03:52:04 1999 patch. + Fix a grammo. + +Wed May 26 14:25:07 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi, news.texi, root.texi, version.c: Start renaming + EGCS 1.2 to GCC 2.95, and start using 0.5.25 to designate + the version of g77 within GCC 2.95. + +Wed May 26 11:45:21 1999 Craig Burley <craig@jcb-sc.com> + + Rename -fsubscript-check to -fbounds-check and + -ff2c-subscript-check to -ffortran-bounds-check: + * g77.texi: Rename options in docs, clarify usage. + * lang-options.h: Rename options, clarify doclets. + * news.texi: Rename options, don't bother with fortran-specific + option. + * top.c (ffe_decode_option): Rename recognized strings. + +Tue May 25 18:21:09 1999 Craig Burley <craig@jcb-sc.com> + + * com.c (FFECOM_FASTER_ARRAY_REFS): Delete this vestige, + now that -fflatten-arrays exists. + +Tue May 25 17:48:34 1999 Craig Burley <craig@jcb-sc.com> + + Fix 19990525-0.f: + * com.c (ffecom_arg_ptr_to_expr): Strip off parens around + CHARACTER expression. + (ffecom_prepare_expr_): Ditto. + +Tue May 18 03:52:04 1999 Craig Burley <craig@jcb-sc.com> + + Support use of back end's improved open-coding of complex divide: + * com.c (ffecom_tree_divide_): Use RDIV_EXPR for complex divide, + instead of run-time call to [cz]_div, if `-Os' option specified. + (lang_init_options): Tell back end we want support for wide range + of inputs to complex divide. + + * Bump version. + +Tue May 18 00:21:34 1999 Zack Weinberg <zack@rabi.phys.columbia.edu> + + * lang-specs.h: Define __GNUC__ and __GNUC_MINOR__ only if -no-gcc + was not given. + +Thu May 13 12:23:20 1999 Craig Burley <craig@jcb-sc.com> + + Fix INTEGER*8 subscripts in array references: + * com.c (ffecom_subscript_check_): Convert low, high, and + element as necessary to make comparison work. + (ffecom_arrayref_): Do more of the work. + Properly handle subscript expr that's wider than int, + if pointers are wider than int. + (ffecom_expr_): Leave more work to ffecom_arrayref_. + (ffecom_init_0): Record sizes of pointers and ints for + convenience. + Use set_sizetype etc. as done by gcc front end. + (ffecom_ptr_to_expr): Leave more work to ffecom_arrayref_. + * expr.c (ffeexpr_finished_): Don't convert INTEGER subscript + expressions in run-time contexts. + (ffeexpr_token_elements_, ffeexpr_token_substring_1_): Cope with + non-default INTEGER subscript expressions. + * news.texi: Announce. + + Finish accepting -fflatten-arrays option: + * com.c (ffecom_arrayref_): Flatten references if requested. + * g77.texi: Describe. + * lang-options.h: Allow. + * news.texi: Announce. + * top.c, top.h: Recognize. + + * version.c: Bump version. + +Wed May 12 07:30:05 1999 Craig Burley <craig@jcb-sc.com> + + * com.c (lang_init_options): Disable back end's maintenance + of errno. + * news.texi: Document dropping of errno. + +1999-05-10 18:21 -0400 Zack Weinberg <zack@rabi.phys.columbia.edu> + + * lang-specs.h: Pass -$ to the preprocessor. + +Mon May 10 18:14:28 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Fix various @xref's per proper style. + Go ahead and use nested braces in @xref's, with care. + * g77install.texi: Fix @xref per proper style. + +Mon May 10 17:38:39 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Doc upgrade to netlib libf2c as of today. + +Sun May 9 18:52:13 1999 Hans-Peter Nilsson <hp@bitrange.com> + + * f/g77spec.c (lang_specific_driver): Correct bug-report address + and point to the FAQ. + +Thu May 6 12:40:21 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi (Arbitrary Concatenation): Put this under + "Missing Features" instead of "Projects". + (Internals Documentation): Point to new "Front End" chapter. + +Thu May 6 08:23:52 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi, news.texi: Automatic arrays reportedly working + on HP-UX systems. + +Thu May 6 08:19:31 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi (Advantages Over f2c): Expand on this topic. + +Mon May 3 19:41:48 1999 Craig Burley <craig@jcb-sc.com> + + * com.c (ffecom_expr_intrinsic_): Fix test of CTIME_subr. + +Mon May 3 18:11:48 1999 Craig Burley <craig@jcb-sc.com> + + Reverse order of two arguments to CTIME_subr, DTIME_subr, + ETIME_subr, and TTYNAM_subr: + * com.c (ffecom_expr_intrinsic_): Reverse the arguments. + While at it, set TREE_SIDE_EFFECTS for CTIME_subr and + TTYNAM_subr. + * intdoc.in: Document the new calling sequences. + * intrin.def: Reverse the arguments. + * news.texi: Document the fact that they changed. + * version.c: Bump version. + +Mon May 3 11:28:14 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Doc upgrade to netlib libf2c as of today. + +Sun May 2 17:04:28 1999 Craig Burley <craig@jcb-sc.com> + + * version.c: Bump version. + +Sun May 2 16:53:01 1999 Craig Burley <craig@jcb-sc.com> + + Fix compile/19990502-1.f: + * ste.c (ffeste_R819B): Don't overwrite tree for temp + variable when expanding the assignment into it. + +Sun Apr 25 20:55:10 1999 Craig Burley <craig@jcb-sc.com> + + Fix 19990325-0.f and 19990325-1.f: + * com.c (ffecom_possible_partial_overlap_): New function. + (ffecom_expand_let_stmt): Use it to determine whether to assign + to a COMPLEX operand through a temp. + * news.texi: Document fix. + + * version.c: Bump version. + +Sat Apr 24 12:19:53 1999 Craig Burley <craig@jcb-sc.com> + + * expr.c (ffeexpr_finished_): Convert DATA implied-do + start/end/incr expressions to default INTEGER. + Fix some broken conditionals. + Clean up some code in the region. + * news.c: Document the fix. + + * version.c: Bump version. + +Fri Apr 23 02:08:32 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi (Compiler Prototypes): Replace "missing" subscript- + checking option with something else. + +Fri Apr 23 01:48:28 1999 Craig Burley <craig@jcb-sc.com> + + Support new -fsubscript-check and -ff2c-subscript-check options: + * com-rt.def (FFECOM_gfrtRANGE): Describe s_rnge, in libf2c/libF77. + * com.c (ffecom_subscript_check_, ffecom_arrayref_): New functions. + (ffecom_char_args_x_): Use new ffecom_arrayref_ function for + FFEBLD_opARRAYREF case. + Compute character name, array type, and use new + ffecom_subscript_check_ function for FFEBLD_opSUBSTRING case. + (ffecom_expr_): Use new ffecom_arrayref_ function. + (ffecom_ptr_to_expr): Use new ffecom_arrayref_ function. + * g77.texi, news.texi: Document new options. + * top.c, top.h: Support new options. + + * news.texi: Fix up some items to not be in "User-Visible Changes". + + * ste.c (ffeste_R819B): Fix type for loop variable, to avoid + warnings. + + * version.c: Bump version. + +Tue Apr 20 01:38:57 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi, news.texi: Clarify -malign-double situation. + +Tue Apr 20 01:15:25 1999 Craig Burley <craig@jcb-sc.com> + + * stb.c (ffestb_R5282_): Convert DATA repeat count + to default INTEGER, to avoid problems downstream. + + * version.c: Bump version. + +Mon Apr 19 21:36:48 1999 Craig Burley <craig@jcb-sc.com> + + * ste.c (ffeste_R819B): Start the loop before expanding + the termination expression. + + * version.c: Bump version. + +Sun Apr 18 21:53:58 1999 Craig Burley <craig@jcb-sc.com> + + * com.c (ffecom_sym_transform_): COMMON and EQUIVALENCE + variables have constant addresses (EQUIVALENCE only if + containing aggregate is static). + +Sat Apr 17 16:55:59 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi, ffe.texi, g77.texi, g77install.texi, news.texi: + Clean up @code{} vs. @samp{}. + Clean up dashes (`--') vs. @minus{} vs. `---'. + + * ffe.texi: Add copyright header. + + * g77.texi, lang-options.h, news.texi, top.c (ffe_decode_option): + Remove support for -fugly option. + Clarify that -fugly-logint is needed instead of -fugly + to work around using .EQ./.NE. on LOGICAL operands. + Explain more about why -fugly-logint is bad juju. + + * g77.texi (Missing Features): Describe READONLY as a missing + feature. Describe AUTOMATIC better. + + * news.texi: Mention libf2c upgrade. + +Sat Apr 17 14:05:53 1999 Craig Burley <craig@jcb-sc.com> + + Make a place for front-end internals documentation: + * Make-lang.in (f/g77.info, f/g77.dvi): Depend on f/ffe.texi. + * ffe.texi: New file, containing docs on front-end internals. + * g77.texi: New chapter for, and inclusion of, ffe.texi. + + * g77.texi: Fix an index entry. + +Sat Apr 17 13:53:43 1999 Craig Burley <craig@jcb-sc.com> + + Rewrite to use block/scope structure of GBE and to ensure + variables (especially those going on stack/reg) are declared + before executable code generated: + * bld.c (ffebld_new_item, ffebld_new_one, ffebld_new_two): + Support new hooks. + * bld.h (ffebld_item_hook, ffebld_item_set_hook, + ffebld_nonter_hook, ffebld_nonter_set_hook): Ditto. + * bld.h (ffebld_basictype, ffebld_kind, ffebld_kindtype, + ffebld_rank, ffebld_where): New convenience macros (used + by rest of this patch). + * com.c, com.h (ffecom_push_calltemps, ffecom_pop_calltemps, + ffecom_push_tempvar, ffecom_pop_tempvar): Remove temp-var- + handling mechanism. + * com.c (ffecom_call_, ffecom_call_binop_, ffecom_tree_divide_, + ffecom_call_gfrt): Support passing hooks for temp-var info. + (ffecom_expr_power_integer_): Takes opPOWER expression, instead + of its left and right operands, so it can get at the hook. + (ffecom_prepare_let_char_, ffecom_prepare_arg_ptr_to_expr, + ffecom_prepare_end, ffecom_prepare_expr_, ffecom_prepare_expr_rw, + ffecom_prepare_expr_w, ffecom_prepare_return_expr, + ffecom_prepare_ptr_to_expr): New functions supporting expression + pre-scanning. + (bison_rule_compstmt_): Return the tree, as in the CFE. + (delete_block): New function, from CFE. + (kept_level_p): New function, from CFE, modified. + (ffecom_start_compstmt, ffecom_end_compstmt): New functions, + replacing ffecom_start_compstmt_ and ffecom_end_compstmt_ macros, + and they do real work. + (struct binding_level): Add prep_state member. Initialize to 0. + (ffecom_get_invented_identifier): Now takes either or both a + string and an integer, using -1 to denote no integer. + (ffecom_do_entry_): Disallow temp-var generation via expressions + in body of function, since the exprs aren't prescanned. + (ffecom_expr_rw): Now takes destination tree. + (ffecom_expr_w): New function, now used in some places + ffecom_expr_rw had been used. + (ffecom_expr_intrinsic_): Move huge f2c-related comment to bottom + of source file, to avoid annoying problems editing com.c using + Emacs C-mode. + (ffecom_expr_power_integer_): Make a temp var for division, if + necessary. + Handle expanded statement expression as does CFE. + (ffecom_start_progunit_): Disallow temp-var generation in body + of function, since expressions are not prescanned at this level. + (ffecom_sym_transform_): Transform ASSIGN variables as well, + so these are all transformed up front, before code-generation + begins. + (ffecom_arg_ptr_to_const_expr, ffecom_const_expr, + ffecom_ptr_to_const_expr): New functions to transform expressions + only if the results will surely be constants. + (ffecom_arg_ptr_to_expr): Precompute size, for convenience + obtaining temp vars. + (ffecom_expand_let_stmt): Guess at usability of destination + pre-expansion, to provide better prescan preparation (fewer + spurious temp vars). + (ffecom_init_0): Disallow temp-var generation in global scope. + (ffecom_type_expr): New function, returns just the type tree + for the expression. + (start_function): Disallow temp-var generation in parm scope. + (incomplete_type_error): Fix introductory comment. + (poplevel): Update (somewhat) from CFE. + (pushlevel): Update (somewhat) from CFE. + * stc.c (ffestc_R838): Mark ASSIGNed variable as so. + * std.c (ffestd_stmt_pass_, ffestd_R803, ffestd_R804, ffestd_R805, + ffestd_R806): Remember and pass through the ffestw block info + for these (IFTHEN, ELSEIF, ELSE, and ENDIF) statements. + * ste.c (ffeste_end_iterdo_): Now takes ffestw block argument. + (ffeste_io_inlist_): Add prototype. + (ffeste_f2c_*): Macros rewritten, new ones added. + (ffeste_start_block_, ffeste_end_block_, ffeste_start_stmt_, + ffeste_end_stmt_): New macros/functions, depending on whether + checking is enabled, to keep track of symmetry of other ste.c code. + (ffeste_begin_iterdo_, ffeste_end_iterdo_, ffeste_io_impdo_, + ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_, + ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_, + ffeste_icilist_, ffeste_io_inlist_, ffeste_io_olist_, + ffeste_subr_beru_, ffeste_do, ffeste_end_R807, ffeste_R737A, + ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806, ffeste_R807, + ffeste_R809, ffeste_R810, ffeste_R811, ffeste_R819A, ffeste_R819B, + ffeste_R837, ffeste_R838, ffeste_R839, ffeste_R840, ffeste_R904, + ffeste_R907, ffeste_R909_start, ffeste_R909_item, ffeste_R909_finish, + ffeste_R910_start, ffeste_R910_item, ffeste_R910_finish, + ffeste_R911_start, ffeste_R911_item, ffeste_R911_finish, + ffeste_R923A, ffeste_R1212, ffeste_R1227): Prescan/prepare + all pertinent expressions, update to new com.c interface, etc. + (ffeste_io_impdo_): Relocate. + (ffeste_R834, ffeste_R835, ffeste_R836, ffeste_R1226): Don't + bother calling clear_momentary, nothing was generated. + (ffeste_R842, ffeste_R843): Update to new com.c interface. + (ffeste_R1226): Don't try to stuff error_mark_node's DECL_INITIAL. + (ffeste_terminate_2): When checking enabled, make sure all blocks + and statements have been ended. + * ste.h (ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806): + These now take ffestw block argument. + (ffeste_terminate_2): When checking enabled, it's a function, not + a macro. + * stw.h (struct _ffestw_): New variable for IFTHEN. + (ffestw_ifthen_fake_else, ffestw_set_ifthen_fake_else): New + accessor macros. + * symbol.c, symbol.h: Support new ASSIGN'ed-to info. + + * com.c: Clean up commentary per GNU coding standards. + + * bld.h (ffebld_size, ffebld_size_known): Canonize. + + * version.c: Bump version. + +Sun Apr 11 21:33:33 1999 Mumit Khan <khan@xraylith.wisc.edu> + + * g77spec.c (lang_specific_driver): Check whether MATH_LIBRARY is + null to decide whether to use it. + +Wed Apr 7 09:47:09 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * ansify.c (die): Specify void argument. + + * intdoc.c (family_name, dumpgen, dumpspec, dumpimp, + argument_info_ptr, argument_info_string, argument_name_ptr, + argument_name_string, elaborate_if_complex, + elaborate_if_maybe_complex, elaborate_if_real, print_type_string): + Const-ify a char*. + (main): Mark parameter `argv' with ATTRIBUTE_UNUSED. + (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_, + _ffeintrin_imp_, cc_pair, descriptions, summaries): Const-ify a char*. + +Mon Apr 5 11:57:54 1999 Donn Terry (donn@interix.com) + + * Make-lang.in (HOST_CFLAGS): compute dynamically. + +Mon Apr 5 02:11:23 1999 Craig Burley <craig@jcb-sc.com> + + Fix bugs exposed by configuring with --enable-checking: + * com.c (ffecom_do_entry_, ffecom_expr_, ffecom_arg_ptr_to_expr, + ffecom_list_expr, ffecom_list_ptr_to_expr, finish_function, + pop_f_function_context, store_parm_decls, poplevel): Handle + error_mark_node properly. + * ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Ditto. + * version.c: Bump version. + +Sat Apr 3 23:57:56 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Fix up docs for -fset-g77-defaults, and + describe how internal consistency checking now happens. + (Should have been done for EGCS version 1.1.) + +Sat Apr 3 23:29:33 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi, g77.texi, lang-options.h, news.texi, top.c: + Make -fno-emulate-complex the default, as COMPLEX support + in the back end is now believed to be working. + + * version.c: Bump version. + +Fri Apr 2 13:33:16 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi: -malign-double now works. + Give URL for alignment-testing package. + * news.texi: -malign-double now works. + +Fri Apr 2 12:49:12 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi (Funding GNU Fortran): Dude's got a web page. + * root.texi: Ditto. + +Tue Mar 30 12:04:11 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * sta.c (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st): + Const-ify a char*. + + * sta.h (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st): + Likewise. + + * stb.c (ffestb_local_u_): Likewise. + (ffestb_do, ffestb_dowhile, ffestb_else, ffestb_elsexyz, + ffestb_else3_, ffestb_endxyz, ffestb_goto, ffestb_let, + ffestb_type, ffestb_type1_, ffestb_varlist, ffestb_R423B, + ffestb_R522, ffestb_R528, ffestb_R542, ffestb_R834, ffestb_R835, + ffestb_R838, ffestb_R841, ffestb_R1102, ffestb_blockdata, + ffestb_R1212, ffestb_R1228, ffestb_V009, ffestb_module, + ffestb_R809, ffestb_R810, ffestb_R10014_, ffestb_R10015_, + ffestb_R10018_, ffestb_R1107, ffestb_R1202, ffestb_R12026_, + ffestb_S3P4, ffestb_V012, ffestb_V014, ffestb_V025, ffestb_V0255_, + ffestb_V020, ffestb_dimlist, ffestb_dummy, ffestb_R524, + ffestb_R547, ffestb_decl_chartype, ffestb_decl_dbltype, + ffestb_decl_gentype, ffestb_decl_recursive, ffestb_decl_entsp_2_, + ffestb_decl_func_, ffestb_V003, ffestb_V016, ffestb_V027, + ffestb_decl_R539): Likewise. + + * stb.h (_ffestb_args_): Likewise. + + * stc.c (ffestc_subr_binsrch_, ffestc_subr_is_present_, + ffestc_subr_speccmp_, ffestc_R904, ffestc_R907): Likewise. + + * std.c (ffestd_R1001dump_1005_1_, ffestd_R1001dump_1005_2_, + ffestd_R1001dump_1005_3_, ffestd_R1001dump_1005_4_, + ffestd_R1001dump_1005_5_, ffestd_R1001dump_1010_1_, + ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_, + ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_): Likewise. + + * ste.c (ffeste_begin_iterdo_, ffeste_subr_file_): Likewise. + + * sts.c (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s, + ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise. + + * sts.h (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s, + ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise. + + * stt.c (ffestt_exprlist_drive, ffestt_implist_drive, + ffestt_tokenlist_drive): Add prototype arguments. + + * stt.h (ffestt_exprlist_drive, ffestt_implist_drive, + ffestt_tokenlist_drive): Likewise. + + * stu.c (ffestu_dummies_transition_): Likewise. + (ffestu_sym_end_transition): Const-ify a char*. + + * stw.c (ffestw_display_state, ffestw_new, ffestw_pop): Add + prototype arguments. + + * stw.h (ffestw_display_state, ffestw_new, ffestw_pop): Likewise. + + * version.c (ffe_version_string): Const-ify a char*. + + * version.h (ffe_version_string): Likewise. + +Sat Mar 27 13:00:43 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bad.c (_ffebad_message_, ffebad_string_, ffebad_message_, + ffebad_bufputs_, ffebad_bufputs_, ffebad_start_, ffebad_string, + ffebad_finish): Const-ify a char*. + + * bld.c (ffebld_op_string_, ffebld_op_string): Likewise. + + * bld.h (ffebld_op_string): Likewise. + + * com.c (ffecom_arglist_expr_, ffecom_build_f2c_string_, + ffecom_debug_kludge_, ffecom_f2c_make_type_, + ffecom_get_appended_identifier_, ffecom_get_identifier_, + ffecom_gfrt_args_): Likewise. + (ffecom_convert_narrow_, ffecom_convert_widen_): Add prototype. + (builtin_function, ffecom_gfrt_name_, ffecom_gfrt_argstring_, + ffecom_arglist_expr_, ffecom_build_f2c_string_, + ffecom_debug_kludge_, ffecom_f2c_make_type_, + ffecom_get_appended_identifier_, ffecom_get_external_identifier_, + ffecom_get_identifier_, ffecom_decl_field, + ffecom_get_invented_identifier, lang_print_error_function, + skip_redundant_dir_prefix, read_name_map, print_containing_files): + Const-ify a char*. + (savestring): Remove, use `xstrdup' instead. + + * com.h (ffecom_decl_field, ffecom_get_invented_identifier): + Const-ify a char*. + + * data.c (ffebld, ffedata_gather_): Make explicitly static. + + * expr.c (ffeexpr_isdigits_, ffeexpr_percent_, + ffeexpr_reduced_concatenate_, ffeexpr_nil_real_, + ffeexpr_nil_number_, ffeexpr_nil_number_period_, + ffeexpr_nil_number_real_, ffeexpr_token_real_, + ffeexpr_token_number_, ffeexpr_token_number_period_, + ffeexpr_token_number_real_): Const-ify a char*. + + * fini.c (xspaces): Likewise. + + * global.c (ffeglobal_type_string_): Likewise. + (ffeglobal_drive): Protoize. + (ffeglobal_proc_def_arg): Const-ify a char*. + + * global.h (ffeglobal_drive): Protoize. + (ffeglobal_proc_def_arg): Const-ify a char*. + + * implic.c (ffeimplic_none, ffeimplic_peek_symbol_type): + Likewise. + + * implic.h (ffeimplic_peek_symbol_type): Likewise. + + * info.c (ffeinfo_basictype_string_, ffeinfo_kind_message_, + ffeinfo_kind_string_, ffeinfo_kindtype_string_, + ffeinfo_where_string_, ffeinfo_basictype_string, + ffeinfo_kind_message, ffeinfo_kind_string, + ffeinfo_kindtype_string, ffeinfo_where_string): Likewise. + + * info.h (ffeinfo_basictype_string, ffeinfo_kind_message, + ffeinfo_kind_string, ffeinfo_kindtype_string, + ffeinfo_where_string): Likewise. + + * intrin.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_, + _ffeintrin_imp_, ffeintrin_check_, ffeintrin_cmp_name_, + ffeintrin_fulfill_specific, ffeintrin_init_0, + ffeintrin_is_actualarg, ffeintrin_is_intrinsic, + ffeintrin_name_generic, ffeintrin_name_implementation, + ffeintrin_name_specific): Likewise. + + * intrin.h (ffeintrin_is_intrinsic, ffeintrin_name_generic, + ffeintrin_name_implementation, ffeintrin_name_specific): Likewise. + + * lex.c (ffelex_type_string_, ffelex_token_new_character, + ffelex_token_new_name, ffelex_token_new_names, + ffelex_token_new_number): Likewise. + + * lex.h (ffelex_token_new_character, ffelex_token_new_name, + ffelex_token_new_names, ffelex_token_new_number): Likewise. + + * malloc.c (malloc_types_, malloc_pool_new, malloc_new_inpool_, + malloc_new_zinpool_): Likewise. + + * malloc.h (malloc_new_inpool_, malloc_new_zinpool_, + malloc_pool_new): Likewise. + + * name.c (ffename_space_drive_global, ffename_space_drive_symbol): + Protoize. + + * name.h (ffename_space_drive_global, ffename_space_drive_symbol): + Likewise. + + * symbol.c (ffesymbol_state_name_, ffesymbol_attr_name_, + ffesymbol_attrs_string): Const-ify a char*. + (ffesymbol_drive, ffesymbol_drive_sfnames): Protoize. + (ffesymbol_state_string): Const-ify a char*. + + * symbol.h (ffesymbol_attrs_string): Likewise. + (ffesymbol_drive, ffesymbol_drive_sfnames): Protoize. + (ffesymbol_state_string): Const-ify a char*. + + * target.c (ffetarget_layout): Likewise. + + * target.h (ffetarget_layout): Likewise. + +1999-03-25 Zack Weinberg <zack@rabi.columbia.edu> + + * Make-lang.in: Remove all references to g77.o/g77.c. + Link g77 from gcc.o. + +1999-03-21 Manfred Hollstein <manfred@s-direktnet.de> + + * Makefile.in (g77$(exeext)): Depend on intl.o. Link in intl.o. + +Wed Mar 17 11:39:44 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Editorial fix. + +Mon Mar 15 17:12:07 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi, g77.texi, news.texi: Editorial fixes. + +Sat Mar 13 17:51:55 1999 Craig Burley <craig@jcb-sc.com> + + Fix 19990313-0.f, 19990313-1.f, 19990313-2.f, 19990313-3.f: + * bad.def (FFEBAD_NOCANDO): New error code for internal use only. + * expr.c (ffeexpr_collapse_convert): If FFEBAD_NOCANDO returned + by convertor, just return original expr. + * target.h: Return FFEBAD_NOCANDO for (usually) 64-bit + conversions that aren't yet working properly. + * news.texi: Explain. + + * version.c: Bump version. + +Sat Mar 13 14:26:55 1999 Craig Burley <craig@jcb-sc.com> + + * RELEASE-PREP: New file, lists things to do for a release. + + * Make-lang.in, bugs.texi, bugs0.texi, g77.texi, g77install.texi, + install0.texi, news.texi, news0.texi: Accommodate new doc + architecture. + Consolidate news items. Don't describe old news items in + various generated docs. + Don't describe FSF-g77 installation stuff in various EGCS-g77 + generated docs. + Move description of AUTOMATIC to more suitable location. + * root.texi: New file for new doc architecture. + +Thu Mar 11 17:32:55 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Add AUTOMATIC to list of unsupported extensions. + +Sat Mar 6 02:28:35 1999 Craig Burley <craig@jcb-sc.com> + + Warn about non-Y2K-compliant intrinsics: + * bad.def (FFEBAD_INTRINSIC_Y2KBAD): New diagnostic. + * intrin.def (FFEINTRIN_impDATE, FFEINTRIN_impIDATE_vxt): + Use new DEFIMPY macro to flag these as non-Y2K-compliant. + * intdoc.c (DEFIMPY): Support new Y2K macro. + * intrin.h (DEFIMPY): Ditto. + * intrin.c (DEFIMPY): Ditto. + (ffeintrin_fulfill_generic, ffeintrin_fulfill_specific): + Warn about invocation of non-Y2K-compliant intrinsic. + * com-rt.def (FFECOM_gfrtDATE, FFECOM_gfrtVXTIDATE): + Rename external procedure names, to keep previously- + compiled (sans-new-warnings) code from linking to + new library. + * g77.texi: Document all this stuff. + * news.texi: Spread the joy. + * version.c: Bump version. + +Fri Mar 5 13:22:44 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Relocate IDATE (VXT) fix: we put it in 1.1.2 + so describe it there, instead of under 1.2. + +Wed Mar 3 00:57:56 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: IDATE (VXT) fixed to return year as 0..99. + +Wed Mar 3 00:43:49 1999 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Add remaining changes pending from Dave Love. + +Wed Mar 3 00:38:42 1999 Craig Burley <craig@jcb-sc.com> + + * bugs.texi, news.texi: Conditionalize cross-references + on non-html processing, providing temporary HTML "links". + + * g77.texi: Fix up a reference. + +Wed Mar 3 00:12:31 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi, bugs.texi: Delete fixed bugs, make one + of them into the appropriate news item. + +Wed Mar 3 00:05:52 1999 Craig Burley <craig@jcb-sc.com> + + * news.texi: Copy over 1.1.2 news. + +1999-03-02 Craig Burley <craig@jcb-sc.com> + + * g77.texi (Bug Reporting): Clarify whether to use -E. + Clarify other instructions. + +1999-02-27 Craig Burley <craig@jcb-sc.com> + + * lang-specs.h: Fix specs to pass `-ax' as well as `-a' option. + +1999-02-26 Craig Burley <craig@jcb-sc.com> + + * intdoc.in (STAT_func, STAT_subr, + FSTAT_func, FSTAT_subr, LSTAT_func, LSTAT_subr): + Properly order array elements. Specify N/A return values. + +1999-02-26 Craig Burley <craig@jcb-sc.com> + + * intdoc.in (DATE_AND_TIME): Explain that VALUES(7) holds + seconds, and VALUES(8), therefore, milliseconds. + +1999-02-26 Craig Burley <craig@jcb-sc.com> + + * news.texi: Clarify IOSTAT= fix. + +1999-02-25 Richard Henderson <rth@cygnus.com> + + * lang-specs.h: Define __FAST_MATH__ when appropriate. + +1999-02-25 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Clarify/index lack of run-time allocation for + concatenation. + +1999-02-25 Andreas Jaeger <aj@arthur.rhein-neckar.de> + + * f/intdoc.in: Add missing `,' after cross references. + +1999-02-20 Craig Burley <craig@jcb-sc.com> + + * Make-lang.in (f77.install-common, f77.install-info, + f77.install-man, f77.uninstall): Use `$(prefix)/lang-f77' + instead of `lang-f77' for flag file, to be sure of a + writable directory, and remove the flag file after each + operation to keep things clean. + +1999-02-20 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Properly attribute Priest document; clarify + that it is in the .ps version of the Goldberg document. + +1999-02-19 Craig Burley <craig@jcb-sc.com> + + * bugs0.texi, bugs.texi, install0.texi, g77install.texi, + news0.texi, news.texi: Update copyright dates. + Clarify which files are source, which are derived, + and remind maintainers where copyright dates are sourced. + * BUGS, INSTALL, NEWS: Regenerated. + +1999-02-19 Craig Burley <craig@jcb-sc.com> + + * global.c (ffeglobal_ref_progunit_): Warn about a function + definition that disagrees with the type of a previous reference. + Improve commentary. Fix a couple of minor bugs. Clean up + some code. + * news.texi: Spread the joy. + +1999-02-18 Craig Burley <craig@jcb-sc.com> + + * expr.c (ffeexpr_finished_): Disallow non-default INTEGER + as argument for FILEINT and FILEASSOC as lhs. + * news.texi: Document fix. + * version.c: Bump. + +1999-02-18 Craig Burley <craig@jcb-sc.com> + + * g77.texi: Clarify -fno-globals vs. -Wno-globals. + +1999-02-18 Craig Burley <craig@jcb-sc.com> + + * intdoc.in (LOG10): Fix typo. + +1999-02-17 Ulrich Drepper <drepper@cygnus.com> + + * intdoc.in: Fix typo. + +1999-02-17 Craig Burley <craig@jcb-sc.com> + + * g77.texi, intdoc.in: Document Y2K and some other known + limitations. + * intrin.def (DTIME, FDATE): Fix capitalization of + case-sensitive forms of these intrinsics' names. + +1999-02-17 Dave Love <fx@gnu.org> + + * intdoc.in: Say `common' logarithm for log10. + +1999-02-16 Ulrich Drepper <drepper@cygnus.com> + + * g77.texi: Add missing @ in email addresses. + +1999-02-15 Craig Burley <craig@jcb-sc.com> + + * *.*: Delete my (old) email address in most places, change it + in a few. + +1999-02-14 Craig Burley <craig@jcb-sc.com> + + * version.c: Bump. + +1999-02-14 Craig Burley <craig@jcb-sc.com> + + * version.c: Bump for 1998-10-02 change (forgot to do this + before). + +1999-02-14 Craig Burley <craig@jcb-sc.com> + + * lang-specs.h, g77.1, g77.texi, news.texi: Recognize `.FOR' + and `.FPP' as well as `.for' and `.fpp'. + +1999-02-14 Craig Burley <craig@jcb-sc.com> + + * intdoc.in (LOG10): Fix description. + +1999-02-14 Craig Burley <craig@jcb-sc.com> + + * news.texi: Mention fix for SIGNAL invocation circa egcs-1.1. + +1999-02-14 Craig Burley <craig@jcb-sc.com> + + * g77.texi, g77install.texi, bugs.texi, g77install.texi: Clean + up and improve indexing, and some other areas of docs. + +1999-02-14 Craig Burley <craig@jcb-sc.com> + + * intdoc.in (MCLOCK8, TIME8): Warn about lower range on + 32-bit systems. + +Sat Feb 6 18:02:17 1999 Jeffrey A Law (law@cygnus.com) + + * g77.texi: Update email addresses. + +Wed Feb 3 22:50:17 1999 Marc Espie <Marc.Espie@liafa.jussieu.fr> + + * Make-lang.in (g77$(exeext)): Get choose-temp.o, pexecute.o and + mkstemp.o from libiberty. + +1999-02-01 Zack Weinberg <zack@rabi.columbia.edu> + + * top.c: Don't define ffe_is_ident_. Don't process + -f(no-)ident here. + * top.h: Remove declaration of ffe_is_ident_ and macros + ffe_is_ident() and ffe_set_is_ident(). + * lex.c: Use flag_no_ident instead of ffe_is_ident(). + +Sun Jan 31 20:34:29 1999 Zack Weinberg <zack@rabi.columbia.edu> + + * lang-specs.h: Map -Qn to -fno-ident. + +Tue Jan 5 22:12:41 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Make-lang.in (g77.o): Depend on prefix.h. + +Fri Nov 27 13:10:32 1998 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * fini.c: Rename variable `spaces' to `xspaces' to avoid + conflicting with function `spaces' from libiberty. + + * g77spec.c: Don't prototype libiberty functions. + * malloc.c: Likewise. + +1998-11-20 Dave Love <d.love@dl.ac.uk> + + * g77.texi: Assorted minor changes. + +1998-11-19 Dave Love <d.love@dl.ac.uk> + + * bugs.texi: Formatting changes from Craig. + + * intdoc.in: Terminate some @xrefs with `,'. + +1998-11-19 Manfred Hollstein <manfred@s-direktnet.de> + + * Make-lang.in (mandir): Replace all uses of $(mandir) by $(man1dir). + +Mon Nov 9 23:15:39 1998 Jeffrey A Law (law@cygnus.com) + + * g77.texi, news.texi: Updates from Craig. + +Sun Nov 8 17:47:56 1998 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * Makefile.in (INCLUDES): Add "-I$(srcdir)/../../include". + +Sat Nov 7 15:58:54 1998 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * g77spec.c: Don't include gansidecl.h. + * output.j: Likewise. + +1998-11-04 Dave Love <d.love@dl.ac.uk> + + * g77.texi: Small formatting/indexing fixes. + +Mon Oct 12 20:41:59 1998 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * bad.c (ffebad_finish): Change type of variable `c' to unsigned + char, change type of variable `s' to unsigned char *. + + * com.c (ffecom_symbol_null_): Add missing initializers. + + * fini.c (MAXNAMELEN): Undef it before defining. + + * implic.c (ffeimplic_lookup_): Change type of parameter `c' to + unsigned char. + + * intrin.c (ffeintrin_init_0): Cast the argument of ctype macros + to (unsigned char). + + * lex.c (ffelex_splice_tokens): Change type of variable `p' to + unsigned char *. + (ffelex_token_name_from_names): Cast the argument of + `ffelex_is_firstnamechar' to (unsigned char). + (ffelex_token_names_from_names): Likewise. + (ffelex_token_new_name): Likewise. + (ffelex_token_new_names): Likewise. + + * malloc.c (malloc_root_): Add missing initializer. + + * stb.c (ffestb_do): Change type of variable `p' to unsigned char *. + (ffestb_else) Likewise. + (ffestb_else3_) Likewise. + (ffestb_endxyz) Likewise. + (ffestb_goto) Likewise. + (ffestb_let) Likewise. + (ffestb_varlist) Likewise. + (ffestb_R522) Likewise. + (ffestb_R528) Likewise. + (ffestb_R834) Likewise. + (ffestb_R835) Likewise. + (ffestb_R838) Likewise. + (ffestb_R1102) Likewise. + (ffestb_blockdata) Likewise. + (ffestb_R1212) Likewise. + (ffestb_R810) Likewise. + (ffestb_R10014_): Cast the argument of `ffelex_is_firstnamechar' + to (unsigned char). + (ffestb_V014): Change type of variable `p' to unsigned char *. + (ffestb_dummy) Likewise. + (ffestb_R524) Likewise. + (ffestb_R547) Likewise. + (ffestb_decl_chartype) Likewise. + (ffestb_decl_dbltype) Likewise. + (ffestb_decl_gentype) Likewise. + (ffestb_decl_entsp_2_) Likewise. + (ffestb_V027) Likewise. + (ffestb_decl_R539) Likewise. + + * top.c (ffe_decode_option): Mark parameter `argc' with + ATTRIBUTE_UNUSED. + + * where.c (ffewhere_unknown_line_): Add missing initializers. + +1998-10-02 Dave Love <d.love@dl.ac.uk> + + * com.c (ffecom_expr_intrinsic_): Fix return type for RAND. + +Thu Oct 1 10:43:45 1998 Nick Clifton <nickc@cygnus.com> + + * lex.c: Replace occurances of HANDLE_SYSV_PRAGMA with + HANDLE_GENERIC_PRAGMAS. + +Mon Sep 28 04:22:00 1998 Jeffrey A Law (law@cygnus.com) + + * news.texi: Update from Craig. + +1998-09-23 Dave Love <d.love@dl.ac.uk> + + * g77.texi: Additions about `/*', trailing comments and cpp. + +1998-09-18 Dave Love <d.love@dl.ac.uk> + + * g77.texi: Various additions and some small fixes. + +Thu Sep 10 14:55:44 1998 Kamil Iskra <iskra@student.uci.agh.edu.pl> + + * Make-lang.in (f77.install-common): Add missing "else true;". + +1998-09-07 Dave Love <d.love@dl.ac.uk> + + * ChangeLog.egcs: Deleted. Entries merged here. + +1998-09-05 Dave Love <d.love@dl.ac.uk> + + * Makefile.in (LDFLAGS): Set from BOOT_LDFLAGS. + (F771_LDFLAGS): Variable dispensed with. + +Fri Sep 4 19:53:34 1998 Craig Burley <burley@gnu.org> + + * intdoc.in: Minor editorial tweaks. + +Fri Sep 4 18:35:52 1998 Craig Burley <burley@gnu.org> + + * lang-options.h: Convert to wrap option and doc string + in a new macro invocation, FTNOPT, so the nearly identical + list can be used in FSF-g77. + +Fri Sep 4 18:35:52 1998 Craig Burley <burley@gnu.org> + + * Makefile.in (fini.o): Don't define USE_HCONFIG here. + * fini.c: Define USE_HCONFIG here instead, so deps-kinda + picks up correct dependency. + + * Makefile.in (proj-h.o): Fix dependencies list. + +Wed Sep 02 09:25:29 1998 Nick Clifton <nickc@cygnus.com> + + * lex.c (ffe_lex_hash): Change how HANDLE_PRAGMA and + HANDLE_SYSV_PRAGMA would be called if they pragma parsing was + enabled in this code. + Generate warning messages if unknown pragmas are encountered. + (pragma_getc): New function: retrieves characters from the + input stream. Defined when HANDLE_PRAGMA is defined. + (pragma_ungetc): New function: replaces characters back into the + input stream. Defined when HANDLE_PRAGMA is defined. + +Tue Sep 1 10:00:21 1998 Craig Burley <burley@gnu.org> + + * bugs.texi, g77.1, g77.texi, intdoc.in, news.texi: Doc updates + from Craig. + +1998-08-23 Dave Love <d.love@dl.ac.uk> + + * g77.texi: Increment `version-g77' and fix a few typos. + +Tue Aug 18 21:41:31 1998 Jeffrey A Law (law@cygnus.com) + + * Make-lang.in: Add several "else true" clauses to deal with lame + systems. + +Tue Aug 11 08:12:14 1998 H.J. Lu (hjl@gnu.org) + + * Make-lang.in (g77.o): Touch lang-f77 before checking it. + +1998-08-09 Dave Love <d.love@dl.ac.uk> + + * Make-lang.in (f/g77.dvi): Replace non-working use of texi2dvi + with explicit use of tex. + (f77.mostlyclean): Remove TeX index files. + + * g77install.texi (Prerequisites): Kluge round TeX lossage with + hyphen in @value in @code. + +Tue Aug 4 16:59:39 1998 Craig Burley <burley@gnu.org> + + * com.c (ffecom_convert_narrow_, ffecom_convert_widen_): + Allow conversion from pointer to same-sized integer, + to fix invoking SIGNAL as a function. + +1998-07-26 Dave Love <d.love@dl.ac.uk> + + * BUGS, INSTALL, NEWS: Rebuilt. + +Sat Jul 25 17:23:55 1998 Craig Burley <burley@gnu.org> + + Fix 980615-0.f: + * stc.c (ffestc_R1229_start): Set info to ANY as well. + +Tue Jul 21 04:33:37 1998 Craig Burley <burley@gnu.org> + + * g77spec.c (lang_specific_driver): Return unmolested + command line when --help seen. + Comment out code that printed g77-specific --help info. + +Sat Jul 18 19:16:48 1998 Craig Burley <burley@gnu.org> + + * lang-options.h: Fix up doc strings. + Remove the unimplemented -fdcp-intrinsics-* options. + + * str-1t.fin: Change mixed-case spelling of `GoTo' from + `Goto'. + +Thu Jul 16 13:26:36 1998 Craig Burley <burley@gnu.org> + + * com.c (ffecom_finish_symbol_transform_): Revert change + of 1998-05-23, as it was too aggressive, in that it + prevented transformation of (used) functions before + primary code generation. + +1998-07-15 Dave Love <d.love@dl.ac.uk> + + * intdoc.texi: Regenerated. + +Mon Jul 13 18:45:06 1998 Craig Burley <burley@gnu.org> + + * Make-lang.in (f77.rebuilt): Fix to depend on + build-dir-based, not source-based, g77.info. + + * g77.texi: Merge docs with 0.5.24. + * g77install.texi: Ditto. + +Mon Jul 13 18:02:29 1998 Craig Burley <burley@gnu.org> + + Cleanups vis-a-vis g77-0.5.24: + * g77spec.c (lang_specific_driver): Tabify source. + * top.c (ffe_decode_option): Use fixed macro to set + internal-checking flag. + * top.h (ffe_set_is_do_internal_checks): Fix macro. + +Mon Jul 13 17:33:44 1998 Craig Burley <burley@gnu.org> + + Cleanups vis-a-vis system.h cutover and g77-0.5.24: + * Makefile.in (fini.o): Define USE_HCONFIG macro + so source code doesn't have to. + * fini.c: Don't define USE_HCONFIG here, since + source code usually shouldn't care about this. + * ansify.c: Include stddef.h only if we have it. + * intdoc.c: Ditto. + * proj.h: Ditto. + +Mon Jul 13 17:30:29 1998 Nick Clifton <nickc@cygnus.com> + + * lang-options.h: Format changed to work with --help support added + to gcc/toplev.c + +Mon Jul 13 11:54:03 1998 Craig Burley <burley@gnu.org> + + * com.c (ffecom_push_tempvar): Replace kludge that + munged back-end globals directly with proper calls + to push_topmost_sequence and pop_topmost_sequence. + +1998-07-12 Dave Love <d.love@dl.ac.uk> + + * version.c: Bump version. + +Sat Jul 11 19:24:32 1998 Craig Burley <burley@gnu.org> + + Fix 980616-0.f: + * equiv.c (ffeequiv_offset_): Don't crash on various + possible ANY operands. + +Sat Jul 11 18:24:37 1998 Craig Burley <burley@gnu.org> + + * com.c (ffecom_expr_) [FFEBLD_opCONTER]: Die if padding + for constant is nonzero. + + * com.c (__eprintf): Delete this function, it is obsolete. + +1998-07-09 Dave Love <d.love@dl.ac.uk> + + * intdoc.in (HOSTNM_func, HOSTNM_subr): Update last change. + +Thu Jul 9 00:45:59 1998 Craig Burley <burley@gnu.org> + + Fix debugging of CHARACTER*(*), etc., which requires + emitting debug info on types like `ftnlen': + * com.c (ffecom_start_progunit_): Don't bother + resetting "invented" flag for identifier. + (ffecom_transform_equiv_): Don't bother zeroing + "ignored" flag for decl. + (pushdecl): No longer set "ignored", "used", or + "suppressed debug" flags for decls having "invented" + identifiers. + +1998-07-06 Mike Stump <mrs@wrs.com> + + * Make-lang.in (f77.stage?): Use mv -f instead of just mv so that + we can move g77.c. + +1998-07-06 Dave Love <d.love@dl.ac.uk> + + * intdoc.in (HOSTNM_func, HOSTNM_subr): Note possible need for + -lsocket. + +1998-07-05 Dave Love <d.love@dl.ac.uk> + + * intdoc.in: Add entry for DATE_AND_TIME. + + * intrin.def: Add implementation for DATE_AND_TIME. Make second + and third args of SYSTEM_CLOCK optional. + + * com.c (ffecom_expr_intrinsic_): New case for DATE_AND_TIME. + + * com-rt.def (FFECOM_gfrtSYSTEM_CLOCK): Call G77_system_clock_0, + not system_clock_. + (FFECOM_gfrtDATE_AND_TIME): New DEFGFRT. + +Wed Jul 1 11:19:13 1998 Craig Burley <burley@gnu.org> + + Fix 980701-1.f (which was producing "unaligned trap" + on an Alpha running GNU/Linux, as predicted): + * equiv.c (ffeequiv_layout_local_): Don't bother + coping with pre-padding of entire area while building + it; do that instead after the building is done, and + do it by modifying only the modulo field. This covers + the case of alignment stringency being increased without + lowering the starting offset, unlike the previous changes, + and even more elegantly than those. + + * target.c (ffetarget_align): Make sure alignments + are nonzero, just in case. + +See ChangeLog.0 for earlier changes. + +Local Variables: +add-log-time-format: current-time-string +End: +2003-01-01 Andreas Jaeger <aj@suse.de> + + * f/Make-lang.in ($(srcdir)/f/BUGS): Add include path for + gcc-common.texi. + ($(srcdir)/f/NEWS): Likewise. + +2002-12-28 Joseph S. Myers <jsm@polyomino.org.uk> + + * g77.texi: Use @copying. + +2002-12-23 Joseph S. Myers <jsm@polyomino.org.uk> + + * root.texi: Include gcc-common.texi. + * bugs.texi, news.texi: Don't include root.texi as part of full + manual. + * g77.texi: Update for use of gcc-common.texi. + * Make-lang.in ($(srcdir)/f/g77.info, f/g77.dvi): Depend on + $(srcdir)/doc/include/gcc-common.texi. + +2002-12-19 Kazu Hirata <kazu@cs.umass.edu> + + * intdoc.in: Fix typos. + +2002-12-18 Kazu Hirata <kazu@cs.umass.edu> + + * g77.texi: Fix typos. + * intdoc.texi: Likewise. + * news.texi: Follow spelling conventions. + +Mon Dec 16 13:53:18 2002 Mark Mitchell <mark@codesourcery.com> + + * root.texi: Change version number to 3.4. + +2002-12-15 Zack Weinberg <zack@codesourcery.com> + + * target.h: Don't define HOST_WIDE_INT. + +2002-12-02 Nathanael Nerode <neroden@gcc.gnu.org> + + * Make-lang.in, ansify.c, intdoc.c, proj.h: Replace hconfig.h with + bconfig.h. + * fini.c, proj.h: Replace USE_HCONFIG with USE_BCONFIG + +2002-11-30 Zack Weinberg <zack@codesourcery.com> + + * proj.h, ansify.c, g77spec.c, intdoc.c: + Include coretypes.h and tm.h. + * Make-lang.in: Update dependencies. + +2002-11-20 Toon Moene <toon@moene.indiv.nluug.nl> + + * invoke.texi: Explain the purpose of -fmove-all-movables, + -freduce-all-givs and -frerun-loop-opts better. + +2002-11-19 Nathanael Nerode <neroden@gcc.gnu.org> + + * Make-lang.in: Correct BUILD/HOST confusion. + 2002-11-19 Toon Moene <toon@moene.indiv.nluug.nl> PR fortran/8587 diff --git a/contrib/gcc/f/Make-lang.in b/contrib/gcc/f/Make-lang.in index 1286f07..47585b0 100644 --- a/contrib/gcc/f/Make-lang.in +++ b/contrib/gcc/f/Make-lang.in @@ -1,4 +1,4 @@ -# Top level makefile fragment for GNU Fortran. -*-makefile-*- +# Top level -*- makefile -*- fragment for GNU Fortran. # Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. #This file is part of GNU Fortran. @@ -22,10 +22,9 @@ # Each language makefile fragment must provide the following targets: # # foo.all.build, foo.all.cross, foo.start.encap, foo.rest.encap, -# foo.info, foo.dvi, -# foo.install-normal, foo.install-common, foo.install-info, foo.install-man, +# foo.install-normal, foo.install-common, foo.install-man, # foo.uninstall, -# foo.mostlyclean, foo.clean, foo.distclean, foo.extraclean, +# foo.mostlyclean, foo.clean, foo.distclean, # foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4 # # where `foo' is the name of the language. @@ -39,10 +38,7 @@ # $(srcdir) must be set to the gcc/ source directory (not gcc/f/). # # Actual name to use when installing a native compiler. -G77_INSTALL_NAME = `echo g77|sed '$(program_transform_name)'` - -# Actual name to use when installing a cross-compiler. -G77_CROSS_NAME = `echo g77|sed '$(program_transform_cross_name)'` +G77_INSTALL_NAME := $(shell echo g77|sed '$(program_transform_name)') # Some versions of `touch' (such as the version on Solaris 2.8) # do not correctly set the timestamp due to buggy versions of `utime' @@ -58,15 +54,16 @@ F77 f77: f771$(exeext) # Tell GNU make to ignore these if they exist. .PHONY: F77 f77 f77.all.build f77.all.cross \ - f77.start.encap f77.rest.encap f77.info f77.dvi \ + f77.start.encap f77.rest.encap f77.dvi \ f77.install-normal \ - f77.install-common f77.install-info f77.install-man \ + f77.install-common f77.install-man \ f77.uninstall f77.mostlyclean f77.clean f77.distclean \ - f77.extraclean f77.maintainer-clean f77.rebuilt \ - f77.stage1 f77.stage2 f77.stage3 f77.stage4 + f77.maintainer-clean \ + f77.stage1 f77.stage2 f77.stage3 f77.stage4 \ + f77.stageprofile f77.stagefeedback -g77spec.o: $(srcdir)/f/g77spec.c $(SYSTEM_H) $(GCC_H) \ - $(CONFIG_H) +g77spec.o: $(srcdir)/f/g77spec.c $(SYSTEM_H) coretypes.h $(TM_H) $(GCC_H) \ + $(CONFIG_H) intl.h (SHLIB_LINK='$(SHLIB_LINK)' \ SHLIB_MULTILIB='$(SHLIB_MULTILIB)'; \ $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \ @@ -92,7 +89,7 @@ F77_OBJS = f/bad.o f/bit.o f/bld.o f/com.o f/data.o f/equiv.o f/expr.o \ f/stv.o f/stw.o f/symbol.o f/target.o f/top.o f/type.o f/where.o # Use loose warnings for this front end. -f-warn = +f-warn = $(WERROR) f771$(exeext): $(F77_OBJS) $(BACKEND) $(LIBDEPS) rm -f f771$(exeext) @@ -125,12 +122,12 @@ f/str-op.h f/str-op.j: f/fini$(build_exeext) f/str-op.fin f/str-ot.h f/str-ot.j: f/fini$(build_exeext) f/str-ot.fin ./f/fini$(build_exeext) $(srcdir)/f/str-ot.fin f/str-ot.j f/str-ot.h -f/fini$(build_exeext): f/fini.o $(HOST_LIBDEPS) - $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) -o f/fini$(build_exeext) \ - f/fini.o $(HOST_LIBS) +f/fini$(build_exeext): f/fini.o $(BUILD_LIBDEPS) + $(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) -o f/fini$(build_exeext) \ + f/fini.o $(BUILD_LIBS) f/fini.o: - $(HOST_CC) $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \ + $(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_CPPFLAGS) $(INCLUDES) \ -c $(srcdir)/f/fini.c $(OUTPUT_OPTION) gt-f-lex.h gt-f-where.h gt-f-com.h gt-f-ste.h gtype-f.h : s-gtype; @true @@ -143,39 +140,43 @@ f77.all.cross: g77-cross$(exeext) f77.start.encap: g77$(exeext) f77.rest.encap: -f77.info: $(srcdir)/f/g77.info -f77.dvi: f/g77.dvi -f77.generated-manpages: $(srcdir)/f/g77.1 +f77.srcinfo: doc/g77.info + -cp -p $^ $(srcdir)/doc +f77.srcman: doc/g77.1 + -cp -p $^ $(srcdir)/doc +f77.srcextra: f/BUGS f/NEWS + -cp -p $^ $(srcdir)/f + +f77.tags: force + cd $(srcdir)/f; etags -o TAGS.sub *.c *.h; \ + etags --include TAGS.sub --include ../TAGS.sub + +f77.info: doc/g77.info +dvi:: doc/g77.dvi +f77.man: doc/g77.1 + +check-f77 : check-g77 +lang_checks += check-g77 # g77 documentation. -$(srcdir)/f/g77.info: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ - $(srcdir)/f/ffe.texi $(srcdir)/f/invoke.texi \ - $(srcdir)/f/news.texi $(srcdir)/f/intdoc.texi \ - $(srcdir)/f/root.texi $(srcdir)/doc/include/fdl.texi \ - $(srcdir)/doc/include/gpl.texi \ - $(srcdir)/doc/include/funding.texi \ - $(srcdir)/doc/include/gcc-common.texi - if [ x$(BUILD_INFO) = xinfo ]; then \ - rm -f $(srcdir)/f/g77.info-*; \ - cd $(srcdir)/f && $(MAKEINFO) -I../doc/include -o g77.info g77.texi; \ +TEXI_G77_FILES = f/g77.texi f/bugs.texi f/ffe.texi f/invoke.texi \ + f/news.texi f/root.texi $(docdir)/include/fdl.texi \ + $(docdir)/include/gpl.texi $(docdir)/include/funding.texi \ + $(docdir)/include/gcc-common.texi $(srcdir)/f/intdoc.texi + +doc/g77.info: $(TEXI_G77_FILES) + if test "x$(BUILD_INFO)" = xinfo; then \ + rm -f $(@)*; \ + $(MAKEINFO) $(MAKEINFOFLAGS) -I$(docdir)/include -I$(srcdir)/f \ + -o$@ $<; \ else true; fi -f/g77.dvi: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ - $(srcdir)/f/ffe.texi $(srcdir)/f/invoke.texi \ - $(srcdir)/f/news.texi $(srcdir)/f/intdoc.texi \ - $(srcdir)/f/root.texi $(srcdir)/doc/include/fdl.texi \ - $(srcdir)/doc/include/gpl.texi \ - $(srcdir)/doc/include/funding.texi \ - $(srcdir)/doc/include/gcc-common.texi - s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ - cd f && $(TEXI2DVI) -I $$s/doc/include $$s/f/g77.texi - -$(srcdir)/f/g77.1: $(srcdir)/f/invoke.texi - -$(TEXI2POD) < $(srcdir)/f/invoke.texi > f/g77.pod; \ - ($(POD2MAN) --section=1 f/g77.pod > f/g77.1.T$$$$ && \ - mv -f f/g77.1.T$$$$ $(srcdir)/f/g77.1) || \ - (rm -f f/g77.1.T$$$$ && exit 1); \ - rm -f f/g77.pod; \ +doc/g77.dvi: $(TEXI_G77_FILES) + $(TEXI2DVI) -I $(srcdir)/f -I $(abs_docdir)/include -I $(objdir)/f -o $@ $< + +.INTERMEDIATE: g77.pod +g77.pod: f/invoke.texi + -$(TEXI2POD) < $< > $@ # This dance is all about producing accurate documentation for g77's # intrinsics with minimum fuss. f/ansify appends "\n\" to C strings @@ -199,41 +200,43 @@ $(srcdir)/f/g77.1: $(srcdir)/f/invoke.texi # If the documentation files depended on executables in the build # tree, there'd be no way to ship a source tree with the documentation -# already generated such that `make' wouldn't attempt to rebuilt it. +# already generated such that `make' wouldn't attempt to rebuild it. # So, we punt and arrange for the documentation files to depend on the # dependencies of the executables, not on the executables themselves. # But then, we have to build the executables explicitly in their build # rules. -INTDOC_DEPS = $(srcdir)/f/intdoc.c $(srcdir)/f/intrin.h $(srcdir)/f/intrin.def +INTDOC_DEPS = f/intdoc.c f/intrin.h f/intrin.def -$(srcdir)/f/intdoc.texi: $(INTDOC_DEPS) $(srcdir)/f/intdoc.in +$(srcdir)/f/intdoc.texi: $(INTDOC_DEPS) f/intdoc.in $(MAKE) f/intdoc$(build_exeext) f/intdoc$(build_exeext) > $(srcdir)/f/intdoc.texi -f/intdoc$(build_exeext): $(INTDOC_DEPS) f/intdoc.h0 hconfig.h $(SYSTEM_H) \ - $(HOST_LIBDEPS) - $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) $(INCLUDES) \ - $(srcdir)/f/intdoc.c $(HOST_LIBS) -o f/intdoc$(build_exeext) +f/intdoc$(build_exeext): $(INTDOC_DEPS) f/intdoc.h0 bconfig.h \ + $(SYSTEM_H) coretypes.h $(TM_H) $(BUILD_LIBDEPS) + $(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) $(INCLUDES) $< \ + $(BUILD_LIBS) -o $@ f/intdoc.h0: f/intdoc.in f/ansify$(build_exeext) - f/ansify$(build_exeext) $(srcdir)/f/intdoc.in \ - < $(srcdir)/f/intdoc.in > f/intdoc.h0 - -f/ansify$(build_exeext): f/ansify.c hconfig.h $(SYSTEM_H) - $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) $(INCLUDES) \ - $(srcdir)/f/ansify.c -o f/ansify$(build_exeext) + f/ansify$(build_exeext) $< < $< > $@ -$(srcdir)/f/BUGS: f/bugs0.texi f/bugs.texi f/root.texi - cd $(srcdir)/f; $(MAKEINFO) -D BUGSONLY --no-header --no-split \ - --no-validate -I../doc/include -o BUGS bugs0.texi +f/ansify$(build_exeext): f/ansify.c bconfig.h $(SYSTEM_H) coretypes.h $(TM_H) + $(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) $(INCLUDES) $< \ + -o $@ -$(srcdir)/f/NEWS: f/news0.texi f/news.texi f/root.texi - cd $(srcdir)/f; $(MAKEINFO) -D NEWSONLY --no-header --no-split \ - --no-validate -I../doc/include -o NEWS news0.texi +f/BUGS: f/bugs0.texi f/bugs.texi f/root.texi + if [ x$(BUILD_INFO) = xinfo ]; then \ + rm -f $(@)*; \ + $(MAKEINFO) $(MAKEINFOFLAGS) -D BUGSONLY --no-header --no-split \ + --no-validate -I$(docdir)/include -I$(srcdir)/f -o $@ bugs0.texi; \ + else true; fi -f77.rebuilt: f/g77.info $(srcdir)/f/BUGS \ - $(srcdir)/f/NEWS +f/NEWS: f/news0.texi f/news.texi f/root.texi + if [ x$(BUILD_INFO) = xinfo ]; then \ + rm -f $(@)*; \ + $(MAKEINFO) $(MAKEINFOFLAGS) -D NEWSONLY --no-header --no-split \ + --no-validate -I$(docdir)/include -I$(srcdir)/f -o $@ news0.texi; \ + else true; fi # # Install hooks: @@ -245,15 +248,9 @@ f77.install-normal: # and also as either g77 (if native) or $(tooldir)/bin/g77. f77.install-common: installdirs -if [ -f f771$(exeext) ] ; then \ - if [ -f g77-cross$(exeext) ] ; then \ - rm -f $(DESTDIR)$(bindir)/$(G77_CROSS_NAME)$(exeext); \ - $(INSTALL_PROGRAM) g77-cross$(exeext) $(DESTDIR)$(bindir)/$(G77_CROSS_NAME)$(exeext); \ - chmod a+x $(DESTDIR)$(bindir)/$(G77_CROSS_NAME)$(exeext); \ - else \ - rm -f $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \ - $(INSTALL_PROGRAM) g77$(exeext) $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \ - chmod a+x $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \ - fi ; \ + rm -f $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \ + $(INSTALL_PROGRAM) g77$(exeext) $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \ + chmod a+x $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \ else true; fi @if [ -f f77-install-ok -o -f $(srcdir)/f77-install-ok ]; then \ echo ''; \ @@ -265,36 +262,14 @@ f77.install-common: installdirs echo ''; \ else true; fi -# $(INSTALL_DATA) might be a relative pathname, so we can't cd into srcdir -# to do the install. The sed rule was copied from stmp-int-hdrs. -f77.install-info: f77.info installdirs - if [ -f $(srcdir)/f/g77.info ] ; then \ - rm -f $(DESTDIR)$(infodir)/g77.info*; \ - for f in $(srcdir)/f/g77.info*; do \ - realfile=`echo $$f | sed -e 's|.*/\([^/]*\)$$|\1|'`; \ - $(INSTALL_DATA) $$f $(DESTDIR)$(infodir)/$$realfile; \ - done; \ - chmod a-x $(DESTDIR)$(infodir)/g77.info*; \ - else true; fi - @if [ -f $(srcdir)/f/g77.info ] ; then \ - if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ - echo " install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info"; \ - install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info || : ; \ - else : ; fi; \ - else : ; fi +install-info:: $(DESTDIR)$(infodir)/g77.info -f77.install-man: $(GENERATED_MANPAGES) installdirs - -if [ -f f771$(exeext) ] ; then \ - if [ -f g77-cross$(exeext) ] ; then \ - rm -f $(DESTDIR)$(man1dir)/$(G77_CROSS_NAME)$(man1ext); \ - $(INSTALL_DATA) $(srcdir)/f/g77.1 $(DESTDIR)$(man1dir)/$(G77_CROSS_NAME)$(man1ext); \ - chmod a-x $(DESTDIR)$(man1dir)/$(G77_CROSS_NAME)$(man1ext); \ - else \ - rm -f $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext); \ - $(INSTALL_DATA) $(srcdir)/f/g77.1 $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext); \ - chmod a-x $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext); \ - fi; \ - else true; fi +f77.install-man: installdirs $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext) + +$(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext): doc/g77.1 + -rm -f $@ + -$(INSTALL_DATA) $< $@ + -chmod a-x $@ f77.uninstall: installdirs if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ @@ -302,9 +277,7 @@ f77.uninstall: installdirs install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info || : ; \ else : ; fi rm -rf $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \ - rm -rf $(DESTDIR)$(bindir)/$(G77_CROSS_NAME)$(exeext); \ rm -rf $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext); \ - rm -rf $(DESTDIR)$(man1dir)/$(G77_CROSS_NAME)$(man1ext); \ rm -rf $(DESTDIR)$(infodir)/g77.info* # # Clean hooks: @@ -315,16 +288,16 @@ f77.mostlyclean: -rm -f f/*$(objext) -rm -f f/*$(coverageexts) -rm -f f/fini$(build_exeext) f/stamp-str f/str-*.h f/str-*.j - -rm -f f/intdoc$(build_exeext) f/ansify$(build_exeext) f/intdoc.h0 + -rm -f f/BUGS f/NEWS -rm -f g77.aux g77.cps g77.ky g77.toc g77.vr g77.fn g77.kys \ g77.pg g77.tp g77.vrs g77.cp g77.fns g77.log g77.pgs g77.tps f77.clean: -rm -f g77spec.o f77.distclean: -rm -f f/Makefile -f77.extraclean: f77.maintainer-clean: - -rm -f f/g77.info* f/g77.*aux f/TAGS f/BUGS f/NEWS f/intdoc.texi + -rm -f $(srcdir)/f/BUGS $(srcdir)/f/TAGS $(srcdir)/f/TAGS.SUB + -rm -f $(srcdir)/f/NEWS $(srcdir)/f/intdoc.texi # # Stage hooks: # The main makefile has already created stage?/f. @@ -344,6 +317,11 @@ f77.stage3: stage3-start f77.stage4: stage4-start -mv -f $(G77STAGESTUFF) stage4/f +f77.stageprofile: stageprofile-start + -mv -f $(G77STAGESTUFF) stageprofile/f + +f77.stagefeedback: stageprofile-start + -mv -f $(G77STAGESTUFF) stagefeedback/f # # .o: .h dependencies. @@ -352,178 +330,187 @@ f/bad.o: f/bad.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \ f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \ f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \ f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h toplev.h intl.h \ - diagnostic.h + diagnostic.h coretypes.h $(TM_H) f/bit.o: f/bit.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/bit.h \ - f/malloc.h + f/malloc.h coretypes.h $(TM_H) f/bld.o: f/bld.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bld.h f/bld-op.def f/bit.h \ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h f/top.h f/lex.h \ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \ - f/name.h f/intrin.h f/intrin.def real.h + f/name.h f/intrin.h f/intrin.def real.h coretypes.h $(TM_H) f/com.o: f/com.c f/proj.h $(CONFIG_H) $(SYSTEM_H) flags.h $(RTL_H) $(TREE_H) \ output.h convert.h f/com.h f/com-rt.def f/bld.h f/bld-op.def f/bit.h \ f/malloc.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \ f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \ f/name.h f/expr.h f/implic.h f/src.h f/st.h $(GGC_H) toplev.h diagnostic.h \ - $(LANGHOOKS_DEF) langhooks.h intl.h real.h debug.h gt-f-com.h gtype-f.h + $(LANGHOOKS_DEF) langhooks.h intl.h real.h debug.h gt-f-com.h gtype-f.h \ + coretypes.h $(TM_H) f/data.o: f/data.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/data.h f/bld.h f/bld-op.def \ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \ f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \ - f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/st.h + f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/st.h coretypes.h $(TM_H) f/equiv.o: f/equiv.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/equiv.h f/bld.h \ f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \ glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \ - f/global.h f/name.h f/intrin.h f/intrin.def f/data.h + f/global.h f/name.h f/intrin.h f/intrin.def f/data.h coretypes.h $(TM_H) f/expr.o: f/expr.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/expr.h f/bld.h f/bld-op.def \ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \ f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \ f/global.h f/name.h f/intrin.h f/intrin.def f/implic.h f/src.h f/st.h \ - f/stamp-str real.h -f/fini.o: f/fini.c f/proj.h hconfig.h $(SYSTEM_H) f/malloc.h + f/stamp-str real.h coretypes.h $(TM_H) +f/fini.o: f/fini.c f/proj.h bconfig.h $(SYSTEM_H) f/malloc.h coretypes.h $(TM_H) f/global.o: f/global.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/global.h f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/type.h f/name.h f/symbol.h \ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \ - f/storag.h f/intrin.h f/intrin.def f/equiv.h + f/storag.h f/intrin.h f/intrin.def f/equiv.h coretypes.h $(TM_H) f/implic.o: f/implic.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/implic.h f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/type.h f/symbol.h \ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \ - f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/src.h + f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/src.h \ + coretypes.h $(TM_H) f/info.o: f/info.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def f/where.h \ - glimits.h f/top.h f/malloc.h f/lex.h f/type.h + glimits.h f/top.h f/malloc.h f/lex.h f/type.h coretypes.h $(TM_H) f/intrin.o: f/intrin.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/intrin.h \ f/intrin.def f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def \ $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \ - f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/expr.h f/src.h + f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/expr.h f/src.h \ + coretypes.h $(TM_H) f/lab.o: f/lab.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/lab.h f/com.h f/com-rt.def \ $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \ f/top.h f/lex.h f/type.h f/intrin.h f/intrin.def f/symbol.h f/symbol.def \ - f/equiv.h f/storag.h f/global.h f/name.h + f/equiv.h f/storag.h f/global.h f/name.h coretypes.h $(TM_H) f/lex.o: f/lex.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \ glimits.h f/bad.h f/bad.def f/com.h f/com-rt.def $(TREE_H) f/bld.h \ f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \ f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \ f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h f/src.h flags.h \ - debug.h input.h toplev.h output.h $(GGC_H) gt-f-lex.h -f/malloc.o: f/malloc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/malloc.h + debug.h input.h toplev.h output.h $(GGC_H) gt-f-lex.h coretypes.h $(TM_H) +f/malloc.o: f/malloc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/malloc.h \ + coretypes.h $(TM_H) f/name.o: f/name.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \ glimits.h f/top.h f/malloc.h f/name.h f/global.h f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h $(TREE_H) f/lex.h f/type.h f/symbol.h \ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \ - f/storag.h f/intrin.h f/intrin.def f/equiv.h f/src.h + f/storag.h f/intrin.h f/intrin.def f/equiv.h f/src.h coretypes.h $(TM_H) f/parse.o: f/parse.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h \ f/where.h glimits.h f/com.h f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def \ f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ f/bad.def f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \ - f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h version.h flags.h + f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h version.h flags.h \ + coretypes.h $(TM_H) f/src.o: f/src.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/src.h f/bad.h f/bad.def \ - f/where.h glimits.h f/top.h f/malloc.h + f/where.h glimits.h f/top.h f/malloc.h coretypes.h $(TM_H) f/st.o: f/st.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/st.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/symbol.h f/symbol.def \ f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h \ f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/sta.h \ f/stamp-str f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h f/std.h \ - f/stv.h f/stw.h f/ste.h f/sts.h f/stu.h + f/stv.h f/stw.h f/ste.h f/sts.h f/stu.h coretypes.h $(TM_H) f/sta.o: f/sta.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/sta.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/stamp-str f/symbol.h \ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) \ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h \ f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/implic.h \ - f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h f/std.h f/stv.h f/stw.h + f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h f/std.h f/stv.h f/stw.h coretypes.h \ + $(TM_H) f/stb.o: f/stb.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stb.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/malloc.h f/expr.h f/bld.h f/bld-op.def f/bit.h \ f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \ f/info-w.def f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \ - f/stt.h f/stamp-str f/src.h f/sta.h f/stc.h + f/stt.h f/stamp-str f/src.h f/sta.h f/stc.h coretypes.h $(TM_H) f/stc.o: f/stc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stc.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/malloc.h f/bld.h f/bld-op.def f/bit.h f/com.h \ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \ f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \ f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/stp.h \ - f/stt.h f/stamp-str f/data.h f/implic.h f/src.h f/sta.h f/std.h f/stv.h f/stw.h + f/stt.h f/stamp-str f/data.h f/implic.h f/src.h f/sta.h f/std.h f/stv.h \ + f/stw.h coretypes.h $(TM_H) f/std.o: f/std.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/std.h f/bld.h f/bld-op.def \ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \ f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \ f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str \ - f/stv.h f/stw.h f/sta.h f/ste.h f/sts.h + f/stv.h f/stw.h f/sta.h f/ste.h f/sts.h coretypes.h $(TM_H) f/ste.o: f/ste.c f/proj.h $(CONFIG_H) $(SYSTEM_H) $(RTL_H) toplev.h f/ste.h \ f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) \ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \ f/stt.h f/stamp-str f/sts.h f/stv.h f/stw.h f/expr.h f/sta.h $(GGC_H) \ - gt-f-ste.h + gt-f-ste.h coretypes.h $(TM_H) f/storag.o: f/storag.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/storag.h f/bld.h \ f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) \ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h \ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \ - f/intrin.def f/data.h + f/intrin.def f/data.h coretypes.h $(TM_H) f/stp.o: f/stp.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stp.h f/bld.h f/bld-op.def \ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \ - f/intrin.def f/stt.h + f/intrin.def f/stt.h coretypes.h $(TM_H) f/str.o: f/str.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/src.h f/bad.h f/bad.def \ - f/where.h glimits.h f/top.h f/malloc.h f/stamp-str f/lex.h + f/where.h glimits.h f/top.h f/malloc.h f/stamp-str f/lex.h coretypes.h $(TM_H) f/sts.o: f/sts.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/sts.h f/malloc.h f/com.h \ f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h f/intrin.def \ f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \ - f/name.h + f/name.h coretypes.h $(TM_H) f/stt.o: f/stt.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stt.h f/top.h f/malloc.h \ f/where.h glimits.h f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def \ $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h \ f/bad.h f/bad.def f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def \ - f/stp.h f/expr.h f/sta.h f/stamp-str + f/stp.h f/expr.h f/sta.h f/stamp-str coretypes.h $(TM_H) f/stu.o: f/stu.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bld.h f/bld-op.def f/bit.h \ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \ glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def \ - f/implic.h f/stu.h f/sta.h f/stamp-str + f/implic.h f/stu.h f/sta.h f/stamp-str coretypes.h $(TM_H) f/stv.o: f/stv.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stv.h f/lab.h f/com.h \ f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h \ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \ f/intrin.def f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \ - f/name.h + f/name.h coretypes.h $(TM_H) f/stw.o: f/stw.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stw.h f/bld.h f/bld-op.def \ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \ - f/intrin.def f/stv.h f/sta.h f/stamp-str + f/intrin.def f/stv.h f/sta.h f/stamp-str coretypes.h $(TM_H) f/symbol.o: f/symbol.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/symbol.h \ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h \ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h f/top.h \ f/lex.h f/type.h f/lab.h f/storag.h f/intrin.h f/intrin.def f/equiv.h \ - f/global.h f/name.h f/src.h f/st.h + f/global.h f/name.h f/src.h f/st.h coretypes.h $(TM_H) f/target.o: f/target.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/target.h \ $(TREE_H) f/bad.h f/bad.def f/where.h f/top.h f/malloc.h f/info.h real.h \ - f/info-b.def f/info-k.def f/info-w.def f/type.h f/lex.h diagnostic.h + f/info-b.def f/info-k.def f/info-w.def f/type.h f/lex.h diagnostic.h \ + coretypes.h $(TM_H) toplev.h f/top.o: f/top.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \ glimits.h f/bad.h f/bad.def f/bit.h f/bld.h f/bld-op.def f/com.h \ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \ f/info-w.def f/target.h f/lex.h f/type.h f/lab.h f/storag.h \ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \ f/intrin.def f/data.h f/expr.h f/implic.h f/src.h f/st.h flags.h \ - toplev.h -f/type.o: f/type.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/type.h f/malloc.h -f/where.o: f/where.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/where.h glimits.h f/top.h \ - f/malloc.h f/lex.h $(GGC_H) gt-f-where.h + toplev.h coretypes.h $(TM_H) opts.h options.h +f/type.o: f/type.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/type.h f/malloc.h \ + coretypes.h $(TM_H) +f/where.o: f/where.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/where.h glimits.h \ + f/top.h f/malloc.h f/lex.h $(GGC_H) gt-f-where.h coretypes.h $(TM_H) diff --git a/contrib/gcc/f/ansify.c b/contrib/gcc/f/ansify.c index ec99107..b03206d 100644 --- a/contrib/gcc/f/ansify.c +++ b/contrib/gcc/f/ansify.c @@ -1,5 +1,5 @@ /* ansify.c - Copyright (C) 1997 Free Software Foundation, Inc. + Copyright (C) 1997, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -19,8 +19,10 @@ along with GNU Fortran; see the file COPYING. If not, write to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#include "hconfig.h" +#include "bconfig.h" #include "system.h" +#include "coretypes.h" +#include "tm.h" #define die_unless(c) \ do if (!(c)) \ diff --git a/contrib/gcc/f/bad.c b/contrib/gcc/f/bad.c index 21fa487..bed9734 100644 --- a/contrib/gcc/f/bad.c +++ b/contrib/gcc/f/bad.c @@ -1,5 +1,5 @@ /* bad.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -132,7 +132,7 @@ ffebad_bufputs_ (char buf[], int bufi, const char *s) ffebad_init_0(); */ void -ffebad_init_0 () +ffebad_init_0 (void) { assert (FFEBAD == ARRAY_SIZE (ffebad_messages_)); } @@ -203,11 +203,12 @@ ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, if ((ffebad_severity_ != FFEBAD_severityPEDANTIC) || !flag_pedantic_errors) { - if (!diagnostic_count_diagnostic (global_dc, DK_WARNING)) + if (!diagnostic_report_warnings_p ()) { /* User wants no warnings. */ ffebad_is_temp_inhibited_ = TRUE; return FALSE; } + diagnostic_kind_count (global_dc, DK_WARNING)++; break; } /* Fall through (PEDANTIC && flag_pedantic_errors). */ @@ -215,7 +216,7 @@ ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, case FFEBAD_severityWEIRD: case FFEBAD_severitySEVERE: case FFEBAD_severityDISASTER: - diagnostic_count_diagnostic (global_dc, DK_ERROR); + diagnostic_kind_count (global_dc, DK_ERROR)++; break; default: @@ -347,7 +348,7 @@ ffebad_string (const char *string) to actually get it to print (to stderr). */ void -ffebad_finish () +ffebad_finish (void) { #define MAX_SPACES 132 static const char *const spaces diff --git a/contrib/gcc/f/bld.c b/contrib/gcc/f/bld.c index 3460c24..ec7c5cd6 100644 --- a/contrib/gcc/f/bld.c +++ b/contrib/gcc/f/bld.c @@ -1,5 +1,5 @@ /* bld.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2003, 2004 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -70,40 +70,9 @@ struct _ffebld_pool_stack_ ffebld_pool_stack_; /* Static objects accessed by functions in this module. */ -#if FFEBLD_BLANK_ -static struct _ffebld_ ffebld_blank_ -= -{ - 0, - {FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, FFEINFO_kindNONE, - FFEINFO_whereNONE, FFETARGET_charactersizeNONE}, - {NULL, NULL} -}; -#endif #if FFETARGET_okCHARACTER1 static ffebldConstant ffebld_constant_character1_; #endif -#if FFETARGET_okCHARACTER2 -static ffebldConstant ffebld_constant_character2_; -#endif -#if FFETARGET_okCHARACTER3 -static ffebldConstant ffebld_constant_character3_; -#endif -#if FFETARGET_okCHARACTER4 -static ffebldConstant ffebld_constant_character4_; -#endif -#if FFETARGET_okCHARACTER5 -static ffebldConstant ffebld_constant_character5_; -#endif -#if FFETARGET_okCHARACTER6 -static ffebldConstant ffebld_constant_character6_; -#endif -#if FFETARGET_okCHARACTER7 -static ffebldConstant ffebld_constant_character7_; -#endif -#if FFETARGET_okCHARACTER8 -static ffebldConstant ffebld_constant_character8_; -#endif #if FFETARGET_okCOMPLEX1 static ffebldConstant ffebld_constant_complex1_; #endif @@ -113,21 +82,6 @@ static ffebldConstant ffebld_constant_complex2_; #if FFETARGET_okCOMPLEX3 static ffebldConstant ffebld_constant_complex3_; #endif -#if FFETARGET_okCOMPLEX4 -static ffebldConstant ffebld_constant_complex4_; -#endif -#if FFETARGET_okCOMPLEX5 -static ffebldConstant ffebld_constant_complex5_; -#endif -#if FFETARGET_okCOMPLEX6 -static ffebldConstant ffebld_constant_complex6_; -#endif -#if FFETARGET_okCOMPLEX7 -static ffebldConstant ffebld_constant_complex7_; -#endif -#if FFETARGET_okCOMPLEX8 -static ffebldConstant ffebld_constant_complex8_; -#endif #if FFETARGET_okINTEGER1 static ffebldConstant ffebld_constant_integer1_; #endif @@ -140,18 +94,6 @@ static ffebldConstant ffebld_constant_integer3_; #if FFETARGET_okINTEGER4 static ffebldConstant ffebld_constant_integer4_; #endif -#if FFETARGET_okINTEGER5 -static ffebldConstant ffebld_constant_integer5_; -#endif -#if FFETARGET_okINTEGER6 -static ffebldConstant ffebld_constant_integer6_; -#endif -#if FFETARGET_okINTEGER7 -static ffebldConstant ffebld_constant_integer7_; -#endif -#if FFETARGET_okINTEGER8 -static ffebldConstant ffebld_constant_integer8_; -#endif #if FFETARGET_okLOGICAL1 static ffebldConstant ffebld_constant_logical1_; #endif @@ -164,18 +106,6 @@ static ffebldConstant ffebld_constant_logical3_; #if FFETARGET_okLOGICAL4 static ffebldConstant ffebld_constant_logical4_; #endif -#if FFETARGET_okLOGICAL5 -static ffebldConstant ffebld_constant_logical5_; -#endif -#if FFETARGET_okLOGICAL6 -static ffebldConstant ffebld_constant_logical6_; -#endif -#if FFETARGET_okLOGICAL7 -static ffebldConstant ffebld_constant_logical7_; -#endif -#if FFETARGET_okLOGICAL8 -static ffebldConstant ffebld_constant_logical8_; -#endif #if FFETARGET_okREAL1 static ffebldConstant ffebld_constant_real1_; #endif @@ -185,21 +115,6 @@ static ffebldConstant ffebld_constant_real2_; #if FFETARGET_okREAL3 static ffebldConstant ffebld_constant_real3_; #endif -#if FFETARGET_okREAL4 -static ffebldConstant ffebld_constant_real4_; -#endif -#if FFETARGET_okREAL5 -static ffebldConstant ffebld_constant_real5_; -#endif -#if FFETARGET_okREAL6 -static ffebldConstant ffebld_constant_real6_; -#endif -#if FFETARGET_okREAL7 -static ffebldConstant ffebld_constant_real7_; -#endif -#if FFETARGET_okREAL8 -static ffebldConstant ffebld_constant_real8_; -#endif static ffebldConstant ffebld_constant_hollerith_; static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST - FFEBLD_constTYPELESS_FIRST + 1]; @@ -265,30 +180,6 @@ ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2) ffebld_constant_integer4 (c2)); #endif -#if FFETARGET_okINTEGER5 - case FFEBLD_constINTEGER5: - return ffetarget_cmp_integer5 (ffebld_constant_integer5 (c1), - ffebld_constant_integer5 (c2)); -#endif - -#if FFETARGET_okINTEGER6 - case FFEBLD_constINTEGER6: - return ffetarget_cmp_integer6 (ffebld_constant_integer6 (c1), - ffebld_constant_integer6 (c2)); -#endif - -#if FFETARGET_okINTEGER7 - case FFEBLD_constINTEGER7: - return ffetarget_cmp_integer7 (ffebld_constant_integer7 (c1), - ffebld_constant_integer7 (c2)); -#endif - -#if FFETARGET_okINTEGER8 - case FFEBLD_constINTEGER8: - return ffetarget_cmp_integer8 (ffebld_constant_integer8 (c1), - ffebld_constant_integer8 (c2)); -#endif - #if FFETARGET_okLOGICAL1 case FFEBLD_constLOGICAL1: return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1), @@ -313,30 +204,6 @@ ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2) ffebld_constant_logical4 (c2)); #endif -#if FFETARGET_okLOGICAL5 - case FFEBLD_constLOGICAL5: - return ffetarget_cmp_logical5 (ffebld_constant_logical5 (c1), - ffebld_constant_logical5 (c2)); -#endif - -#if FFETARGET_okLOGICAL6 - case FFEBLD_constLOGICAL6: - return ffetarget_cmp_logical6 (ffebld_constant_logical6 (c1), - ffebld_constant_logical6 (c2)); -#endif - -#if FFETARGET_okLOGICAL7 - case FFEBLD_constLOGICAL7: - return ffetarget_cmp_logical7 (ffebld_constant_logical7 (c1), - ffebld_constant_logical7 (c2)); -#endif - -#if FFETARGET_okLOGICAL8 - case FFEBLD_constLOGICAL8: - return ffetarget_cmp_logical8 (ffebld_constant_logical8 (c1), - ffebld_constant_logical8 (c2)); -#endif - #if FFETARGET_okREAL1 case FFEBLD_constREAL1: return ffetarget_cmp_real1 (ffebld_constant_real1 (c1), @@ -355,84 +222,12 @@ ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2) ffebld_constant_real3 (c2)); #endif -#if FFETARGET_okREAL4 - case FFEBLD_constREAL4: - return ffetarget_cmp_real4 (ffebld_constant_real4 (c1), - ffebld_constant_real4 (c2)); -#endif - -#if FFETARGET_okREAL5 - case FFEBLD_constREAL5: - return ffetarget_cmp_real5 (ffebld_constant_real5 (c1), - ffebld_constant_real5 (c2)); -#endif - -#if FFETARGET_okREAL6 - case FFEBLD_constREAL6: - return ffetarget_cmp_real6 (ffebld_constant_real6 (c1), - ffebld_constant_real6 (c2)); -#endif - -#if FFETARGET_okREAL7 - case FFEBLD_constREAL7: - return ffetarget_cmp_real7 (ffebld_constant_real7 (c1), - ffebld_constant_real7 (c2)); -#endif - -#if FFETARGET_okREAL8 - case FFEBLD_constREAL8: - return ffetarget_cmp_real8 (ffebld_constant_real8 (c1), - ffebld_constant_real8 (c2)); -#endif - #if FFETARGET_okCHARACTER1 case FFEBLD_constCHARACTER1: return ffetarget_cmp_character1 (ffebld_constant_character1 (c1), ffebld_constant_character1 (c2)); #endif -#if FFETARGET_okCHARACTER2 - case FFEBLD_constCHARACTER2: - return ffetarget_cmp_character2 (ffebld_constant_character2 (c1), - ffebld_constant_character2 (c2)); -#endif - -#if FFETARGET_okCHARACTER3 - case FFEBLD_constCHARACTER3: - return ffetarget_cmp_character3 (ffebld_constant_character3 (c1), - ffebld_constant_character3 (c2)); -#endif - -#if FFETARGET_okCHARACTER4 - case FFEBLD_constCHARACTER4: - return ffetarget_cmp_character4 (ffebld_constant_character4 (c1), - ffebld_constant_character4 (c2)); -#endif - -#if FFETARGET_okCHARACTER5 - case FFEBLD_constCHARACTER5: - return ffetarget_cmp_character5 (ffebld_constant_character5 (c1), - ffebld_constant_character5 (c2)); -#endif - -#if FFETARGET_okCHARACTER6 - case FFEBLD_constCHARACTER6: - return ffetarget_cmp_character6 (ffebld_constant_character6 (c1), - ffebld_constant_character6 (c2)); -#endif - -#if FFETARGET_okCHARACTER7 - case FFEBLD_constCHARACTER7: - return ffetarget_cmp_character7 (ffebld_constant_character7 (c1), - ffebld_constant_character7 (c2)); -#endif - -#if FFETARGET_okCHARACTER8 - case FFEBLD_constCHARACTER8: - return ffetarget_cmp_character8 (ffebld_constant_character8 (c1), - ffebld_constant_character8 (c2)); -#endif - default: assert ("bad constant type" == NULL); return 0; @@ -488,26 +283,6 @@ ffebld_constant_is_zero (ffebldConstant c) return ffebld_constant_integer4 (c) == 0; #endif -#if FFETARGET_okINTEGER5 - case FFEBLD_constINTEGER5: - return ffebld_constant_integer5 (c) == 0; -#endif - -#if FFETARGET_okINTEGER6 - case FFEBLD_constINTEGER6: - return ffebld_constant_integer6 (c) == 0; -#endif - -#if FFETARGET_okINTEGER7 - case FFEBLD_constINTEGER7: - return ffebld_constant_integer7 (c) == 0; -#endif - -#if FFETARGET_okINTEGER8 - case FFEBLD_constINTEGER8: - return ffebld_constant_integer8 (c) == 0; -#endif - #if FFETARGET_okLOGICAL1 case FFEBLD_constLOGICAL1: return ffebld_constant_logical1 (c) == 0; @@ -528,26 +303,6 @@ ffebld_constant_is_zero (ffebldConstant c) return ffebld_constant_logical4 (c) == 0; #endif -#if FFETARGET_okLOGICAL5 - case FFEBLD_constLOGICAL5: - return ffebld_constant_logical5 (c) == 0; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEBLD_constLOGICAL6: - return ffebld_constant_logical6 (c) == 0; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEBLD_constLOGICAL7: - return ffebld_constant_logical7 (c) == 0; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEBLD_constLOGICAL8: - return ffebld_constant_logical8 (c) == 0; -#endif - #if FFETARGET_okREAL1 case FFEBLD_constREAL1: return ffetarget_iszero_real1 (ffebld_constant_real1 (c)); @@ -563,31 +318,6 @@ ffebld_constant_is_zero (ffebldConstant c) return ffetarget_iszero_real3 (ffebld_constant_real3 (c)); #endif -#if FFETARGET_okREAL4 - case FFEBLD_constREAL4: - return ffetarget_iszero_real4 (ffebld_constant_real4 (c)); -#endif - -#if FFETARGET_okREAL5 - case FFEBLD_constREAL5: - return ffetarget_iszero_real5 (ffebld_constant_real5 (c)); -#endif - -#if FFETARGET_okREAL6 - case FFEBLD_constREAL6: - return ffetarget_iszero_real6 (ffebld_constant_real6 (c)); -#endif - -#if FFETARGET_okREAL7 - case FFEBLD_constREAL7: - return ffetarget_iszero_real7 (ffebld_constant_real7 (c)); -#endif - -#if FFETARGET_okREAL8 - case FFEBLD_constREAL8: - return ffetarget_iszero_real8 (ffebld_constant_real8 (c)); -#endif - #if FFETARGET_okCOMPLEX1 case FFEBLD_constCOMPLEX1: return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real) @@ -606,45 +336,11 @@ ffebld_constant_is_zero (ffebldConstant c) && ffetarget_iszero_real3 (ffebld_constant_complex3 (c).imaginary); #endif -#if FFETARGET_okCOMPLEX4 - case FFEBLD_constCOMPLEX4: - return ffetarget_iszero_real4 (ffebld_constant_complex4 (c).real) - && ffetarget_iszero_real4 (ffebld_constant_complex4 (c).imaginary); -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEBLD_constCOMPLEX5: - return ffetarget_iszero_real5 (ffebld_constant_complex5 (c).real) - && ffetarget_iszero_real5 (ffebld_constant_complex5 (c).imaginary); -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEBLD_constCOMPLEX6: - return ffetarget_iszero_real6 (ffebld_constant_complex6 (c).real) - && ffetarget_iszero_real6 (ffebld_constant_complex6 (c).imaginary); -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEBLD_constCOMPLEX7: - return ffetarget_iszero_real7 (ffebld_constant_complex7 (c).real) - && ffetarget_iszero_real7 (ffebld_constant_complex7 (c).imaginary); -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEBLD_constCOMPLEX8: - return ffetarget_iszero_real8 (ffebld_constant_complex8 (c).real) - && ffetarget_iszero_real8 (ffebld_constant_complex8 (c).imaginary); -#endif - #if FFETARGET_okCHARACTER1 case FFEBLD_constCHARACTER1: return ffetarget_iszero_character1 (ffebld_constant_character1 (c)); #endif -#if FFETARGET_okCHARACTER2 || FFETARGET_okCHARACTER3 /* ... */ -#error "no support for these!!" -#endif - case FFEBLD_constHOLLERITH: return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c)); @@ -686,40 +382,52 @@ ffebld_constant_new_character1 (ffelexToken t) ffebldConstant ffebld_constant_new_character1_val (ffetargetCharacter1 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - ffetarget_verify_character1 (ffebld_constant_pool(), val); - - for (c = (ffebldConstant) &ffebld_constant_character1_; - c->next != NULL; - c = c->next) - { - malloc_verify_kp (ffebld_constant_pool(), - c->next, - sizeof (*(c->next))); - ffetarget_verify_character1 (ffebld_constant_pool(), - ffebld_constant_character1 (c->next)); - cmp = ffetarget_cmp_character1 (val, - ffebld_constant_character1 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_character1_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constCHARACTER1", + sizeof (*nc)); + nc->consttype = FFEBLD_constCHARACTER1; + nc->u.character1 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_character1_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_character1 (val, ffebld_constant_character1 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constCHARACTER1", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constCHARACTER1; nc->u.character1 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -749,35 +457,56 @@ ffebld_constant_new_complex1 (ffebldConstant real, ffebldConstant ffebld_constant_new_complex1_val (ffetargetComplex1 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_complex1_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_real1 (val.real, ffebld_constant_complex1 (c->next).real); - if (cmp == 0) - cmp = ffetarget_cmp_real1 (val.imaginary, - ffebld_constant_complex1 (c->next).imaginary); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_complex1_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constCOMPLEX1", + sizeof (*nc)); + nc->consttype = FFEBLD_constCOMPLEX1; + nc->u.complex1 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_complex1_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_real1 (val.real, + ffebld_constant_complex1 (P).real); + if (cmp == 0) + cmp = ffetarget_cmp_real1 (val.imaginary, + ffebld_constant_complex1 (P).imaginary); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constCOMPLEX1", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constCOMPLEX1; nc->u.complex1 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -807,35 +536,56 @@ ffebld_constant_new_complex2 (ffebldConstant real, ffebldConstant ffebld_constant_new_complex2_val (ffetargetComplex2 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_complex2_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_real2 (val.real, ffebld_constant_complex2 (c->next).real); - if (cmp == 0) - cmp = ffetarget_cmp_real2 (val.imaginary, - ffebld_constant_complex2 (c->next).imaginary); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_complex2_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constCOMPLEX2", + sizeof (*nc)); + nc->consttype = FFEBLD_constCOMPLEX2; + nc->u.complex2 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_complex2_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_real2 (val.real, + ffebld_constant_complex2 (P).real); + if (cmp == 0) + cmp = ffetarget_cmp_real2 (val.imaginary, + ffebld_constant_complex2 (P).imaginary); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constCOMPLEX2", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constCOMPLEX2; nc->u.complex2 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -860,32 +610,52 @@ ffebld_constant_new_hollerith (ffelexToken t) ffebldConstant ffebld_constant_new_hollerith_val (ffetargetHollerith val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_hollerith_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_hollerith_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constHOLLERITH", + sizeof (*nc)); + nc->consttype = FFEBLD_constHOLLERITH; + nc->u.hollerith = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_hollerith_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constHOLLERITH", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constHOLLERITH; nc->u.hollerith = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -917,32 +687,53 @@ ffebld_constant_new_integer1 (ffelexToken t) ffebldConstant ffebld_constant_new_integer1_val (ffetargetInteger1 val) { - ffebldConstant c; - ffebldConstant nc; - int cmp; - for (c = (ffebldConstant) &ffebld_constant_integer1_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant nc; + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_integer1_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constINTEGER1", + sizeof (*nc)); + nc->consttype = FFEBLD_constINTEGER1; + nc->u.integer1 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_integer1_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constINTEGER1", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constINTEGER1; nc->u.integer1 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -955,32 +746,52 @@ ffebld_constant_new_integer1_val (ffetargetInteger1 val) ffebldConstant ffebld_constant_new_integer2_val (ffetargetInteger2 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_integer2_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_integer2_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constINTEGER2", + sizeof (*nc)); + nc->consttype = FFEBLD_constINTEGER2; + nc->u.integer2 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_integer2_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constINTEGER2", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constINTEGER2; nc->u.integer2 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -993,32 +804,52 @@ ffebld_constant_new_integer2_val (ffetargetInteger2 val) ffebldConstant ffebld_constant_new_integer3_val (ffetargetInteger3 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_integer3_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_integer3_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constINTEGER3", + sizeof (*nc)); + nc->consttype = FFEBLD_constINTEGER3; + nc->u.integer3 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_integer3_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constINTEGER3", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constINTEGER3; nc->u.integer3 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1031,32 +862,52 @@ ffebld_constant_new_integer3_val (ffetargetInteger3 val) ffebldConstant ffebld_constant_new_integer4_val (ffetargetInteger4 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_integer4_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_integer4 (val, ffebld_constant_integer4 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_integer4_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constINTEGER4", + sizeof (*nc)); + nc->consttype = FFEBLD_constINTEGER4; + nc->u.integer4 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_integer4_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_integer4 (val, ffebld_constant_integer4 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constINTEGER4", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constINTEGER4; nc->u.integer4 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1144,32 +995,52 @@ ffebld_constant_new_logical1 (bool truth) ffebldConstant ffebld_constant_new_logical1_val (ffetargetLogical1 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_logical1_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_logical1_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constLOGICAL1", + sizeof (*nc)); + nc->consttype = FFEBLD_constLOGICAL1; + nc->u.logical1 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_logical1_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constLOGICAL1", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL1; nc->u.logical1 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1182,32 +1053,52 @@ ffebld_constant_new_logical1_val (ffetargetLogical1 val) ffebldConstant ffebld_constant_new_logical2_val (ffetargetLogical2 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_logical2_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_logical2_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constLOGICAL2", + sizeof (*nc)); + nc->consttype = FFEBLD_constLOGICAL2; + nc->u.logical2 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_logical2_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constLOGICAL2", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL2; nc->u.logical2 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1220,32 +1111,52 @@ ffebld_constant_new_logical2_val (ffetargetLogical2 val) ffebldConstant ffebld_constant_new_logical3_val (ffetargetLogical3 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_logical3_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_logical3_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constLOGICAL3", + sizeof (*nc)); + nc->consttype = FFEBLD_constLOGICAL3; + nc->u.logical3 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_logical3_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constLOGICAL3", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL3; nc->u.logical3 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1258,32 +1169,52 @@ ffebld_constant_new_logical3_val (ffetargetLogical3 val) ffebldConstant ffebld_constant_new_logical4_val (ffetargetLogical4 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_logical4_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_logical4 (val, ffebld_constant_logical4 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_logical4_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constLOGICAL4", + sizeof (*nc)); + nc->consttype = FFEBLD_constLOGICAL4; + nc->u.logical4 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_logical4_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_logical4 (val, ffebld_constant_logical4 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constLOGICAL4", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constLOGICAL4; nc->u.logical4 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1314,32 +1245,52 @@ ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal, ffebldConstant ffebld_constant_new_real1_val (ffetargetReal1 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_real1_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_real1_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constREAL1", + sizeof (*nc)); + nc->consttype = FFEBLD_constREAL1; + nc->u.real1 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_real1_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constREAL1", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constREAL1; nc->u.real1 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1370,32 +1321,52 @@ ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal, ffebldConstant ffebld_constant_new_real2_val (ffetargetReal2 val) { - ffebldConstant c; ffebldConstant nc; - int cmp; - - for (c = (ffebldConstant) &ffebld_constant_real2_; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_real2_; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constREAL2", + sizeof (*nc)); + nc->consttype = FFEBLD_constREAL1; + nc->u.real2 = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_real2_ = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constREAL2", sizeof (*nc)); - nc->next = c->next; nc->consttype = FFEBLD_constREAL2; nc->u.real2 = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1535,33 +1506,54 @@ ffebld_constant_new_typeless_ov (ffelexToken t) ffebldConstant ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val) { - ffebldConstant c; - ffebldConstant nc; - int cmp; - for (c = (ffebldConstant) &ffebld_constant_typeless_[type - - FFEBLD_constTYPELESS_FIRST]; - c->next != NULL; - c = c->next) - { - cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (c->next)); - if (cmp == 0) - return c->next; - if (cmp > 0) - break; - } + ffebldConstant nc; + ffebldConstant P; + ffebldConstant Q; + int cmp = 0; + P = ffebld_constant_typeless_[type + - FFEBLD_constTYPELESS_FIRST]; + Q = P; + if (!P) + { + /* make this node the root */ + nc = malloc_new_kp (ffebld_constant_pool(), + "FFEBLD_constTYPELESS", + sizeof (*nc)); + nc->consttype = type; + nc->u.typeless = val; + nc->hook = FFECOM_constantNULL; + nc->llink = NULL; + nc->rlink = NULL; + ffebld_constant_typeless_[type- FFEBLD_constTYPELESS_FIRST] = nc; + return nc; + } + else + while (P) + { + Q = P; + cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (P)); + if (cmp > 0) + P = P->llink; + else if (cmp < 0) + P = P->rlink; + else + return P; + } nc = malloc_new_kp (ffebld_constant_pool(), "FFEBLD_constTYPELESS", sizeof (*nc)); - nc->next = c->next; nc->consttype = type; nc->u.typeless = val; -#ifdef FFECOM_constantHOOK nc->hook = FFECOM_constantNULL; -#endif - c->next = nc; + nc->llink = NULL; + nc->rlink = NULL; + if (cmp < 0) + Q->llink = nc; + else + Q->rlink = nc; return nc; } @@ -1604,30 +1596,6 @@ ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - u.integer5 = *(array.integer5 + offset); - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - u.integer6 = *(array.integer6 + offset); - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - u.integer7 = *(array.integer7 + offset); - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - u.integer8 = *(array.integer8 + offset); - break; -#endif - default: assert ("bad INTEGER kindtype" == NULL); break; @@ -1661,30 +1629,6 @@ ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - u.logical5 = *(array.logical5 + offset); - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - u.logical6 = *(array.logical6 + offset); - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - u.logical7 = *(array.logical7 + offset); - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - u.logical8 = *(array.logical8 + offset); - break; -#endif - default: assert ("bad LOGICAL kindtype" == NULL); break; @@ -1712,36 +1656,6 @@ ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - u.real4 = *(array.real4 + offset); - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - u.real5 = *(array.real5 + offset); - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - u.real6 = *(array.real6 + offset); - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - u.real7 = *(array.real7 + offset); - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - u.real8 = *(array.real8 + offset); - break; -#endif - default: assert ("bad REAL kindtype" == NULL); break; @@ -1769,36 +1683,6 @@ ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - u.complex4 = *(array.complex4 + offset); - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - u.complex5 = *(array.complex5 + offset); - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - u.complex6 = *(array.complex6 + offset); - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - u.complex7 = *(array.complex7 + offset); - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - u.complex8 = *(array.complex8 + offset); - break; -#endif - default: assert ("bad COMPLEX kindtype" == NULL); break; @@ -1815,55 +1699,6 @@ ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - u.character2.length = 1; - u.character2.text = array.character2 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - u.character3.length = 1; - u.character3.text = array.character3 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - u.character4.length = 1; - u.character4.text = array.character4 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - u.character5.length = 1; - u.character5.text = array.character5 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - u.character6.length = 1; - u.character6.text = array.character6 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - u.character7.length = 1; - u.character7.text = array.character7 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - u.character8.length = 1; - u.character8.text = array.character8 + offset; - break; -#endif - default: assert ("bad CHARACTER kindtype" == NULL); break; @@ -1929,42 +1764,6 @@ ffebld_constantarray_new (ffeinfoBasictype bt, break; #endif -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - ptr.integer5 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetInteger5), - 0); - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - ptr.integer6 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetInteger6), - 0); - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - ptr.integer7 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetInteger7), - 0); - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - ptr.integer8 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetInteger8), - 0); - break; -#endif - default: assert ("bad INTEGER kindtype" == NULL); break; @@ -2010,42 +1809,6 @@ ffebld_constantarray_new (ffeinfoBasictype bt, break; #endif -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - ptr.logical5 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetLogical5), - 0); - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - ptr.logical6 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetLogical6), - 0); - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - ptr.logical7 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetLogical7), - 0); - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - ptr.logical8 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetLogical8), - 0); - break; -#endif - default: assert ("bad LOGICAL kindtype" == NULL); break; @@ -2082,51 +1845,6 @@ ffebld_constantarray_new (ffeinfoBasictype bt, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - ptr.real4 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetReal4), - 0); - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - ptr.real5 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetReal5), - 0); - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - ptr.real6 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetReal6), - 0); - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - ptr.real7 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetReal7), - 0); - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - ptr.real8 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetReal8), - 0); - break; -#endif - default: assert ("bad REAL kindtype" == NULL); break; @@ -2163,51 +1881,6 @@ ffebld_constantarray_new (ffeinfoBasictype bt, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - ptr.complex4 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetComplex4), - 0); - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - ptr.complex5 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetComplex5), - 0); - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - ptr.complex6 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetComplex6), - 0); - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - ptr.complex7 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetComplex7), - 0); - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - ptr.complex8 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size *= sizeof (ffetargetComplex8), - 0); - break; -#endif - default: assert ("bad COMPLEX kindtype" == NULL); break; @@ -2227,76 +1900,6 @@ ffebld_constantarray_new (ffeinfoBasictype bt, break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - ptr.character2 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size - *= sizeof (ffetargetCharacterUnit2), - 0); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - ptr.character3 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size - *= sizeof (ffetargetCharacterUnit3), - 0); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - ptr.character4 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size - *= sizeof (ffetargetCharacterUnit4), - 0); - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - ptr.character5 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size - *= sizeof (ffetargetCharacterUnit5), - 0); - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - ptr.character6 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size - *= sizeof (ffetargetCharacterUnit6), - 0); - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - ptr.character7 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size - *= sizeof (ffetargetCharacterUnit7), - 0); - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - ptr.character8 = malloc_new_zkp (ffebld_constant_pool(), - "ffebldConstantArray", - size - *= sizeof (ffetargetCharacterUnit8), - 0); - break; -#endif - default: assert ("bad CHARACTER kindtype" == NULL); break; @@ -2353,30 +1956,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - *aptr = array.integer5 + offset; - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - *aptr = array.integer6 + offset; - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - *aptr = array.integer7 + offset; - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - *aptr = array.integer8 + offset; - break; -#endif - default: assert ("bad INTEGER akindtype" == NULL); break; @@ -2410,30 +1989,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - *aptr = array.logical5 + offset; - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - *aptr = array.logical6 + offset; - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - *aptr = array.logical7 + offset; - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - *aptr = array.logical8 + offset; - break; -#endif - default: assert ("bad LOGICAL akindtype" == NULL); break; @@ -2461,36 +2016,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - *aptr = array.real4 + offset; - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - *aptr = array.real5 + offset; - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - *aptr = array.real6 + offset; - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - *aptr = array.real7 + offset; - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - *aptr = array.real8 + offset; - break; -#endif - default: assert ("bad REAL akindtype" == NULL); break; @@ -2518,36 +2043,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - *aptr = array.complex4 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - *aptr = array.complex5 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - *aptr = array.complex6 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - *aptr = array.complex7 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - *aptr = array.complex8 + offset; - break; -#endif - default: assert ("bad COMPLEX akindtype" == NULL); break; @@ -2563,48 +2058,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - *aptr = array.character2 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - *aptr = array.character3 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - *aptr = array.character4 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - *aptr = array.character5 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - *aptr = array.character6 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - *aptr = array.character7 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - *aptr = array.character8 + offset; - break; -#endif - default: assert ("bad CHARACTER akindtype" == NULL); break; @@ -2649,34 +2102,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - *cptr = source_array.integer5; - *size = sizeof (*source_array.integer5); - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - *cptr = source_array.integer6; - *size = sizeof (*source_array.integer6); - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - *cptr = source_array.integer7; - *size = sizeof (*source_array.integer7); - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - *cptr = source_array.integer8; - *size = sizeof (*source_array.integer8); - break; -#endif - default: assert ("bad INTEGER ckindtype" == NULL); break; @@ -2714,34 +2139,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - *cptr = source_array.logical5; - *size = sizeof (*source_array.logical5); - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - *cptr = source_array.logical6; - *size = sizeof (*source_array.logical6); - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - *cptr = source_array.logical7; - *size = sizeof (*source_array.logical7); - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - *cptr = source_array.logical8; - *size = sizeof (*source_array.logical8); - break; -#endif - default: assert ("bad LOGICAL ckindtype" == NULL); break; @@ -2772,41 +2169,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - *cptr = source_array.real4; - *size = sizeof (*source_array.real4); - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - *cptr = source_array.real5; - *size = sizeof (*source_array.real5); - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - *cptr = source_array.real6; - *size = sizeof (*source_array.real6); - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - *cptr = source_array.real7; - *size = sizeof (*source_array.real7); - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - *cptr = source_array.real8; - *size = sizeof (*source_array.real8); - break; -#endif - default: assert ("bad REAL ckindtype" == NULL); break; @@ -2837,41 +2199,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - *cptr = source_array.complex4; - *size = sizeof (*source_array.complex4); - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - *cptr = source_array.complex5; - *size = sizeof (*source_array.complex5); - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - *cptr = source_array.complex6; - *size = sizeof (*source_array.complex6); - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - *cptr = source_array.complex7; - *size = sizeof (*source_array.complex7); - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - *cptr = source_array.complex8; - *size = sizeof (*source_array.complex8); - break; -#endif - default: assert ("bad COMPLEX ckindtype" == NULL); break; @@ -2888,55 +2215,6 @@ ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - *cptr = source_array.character2; - *size = sizeof (*source_array.character2); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - *cptr = source_array.character3; - *size = sizeof (*source_array.character3); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - *cptr = source_array.character4; - *size = sizeof (*source_array.character4); - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - *cptr = source_array.character5; - *size = sizeof (*source_array.character5); - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - *cptr = source_array.character6; - *size = sizeof (*source_array.character6); - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - *cptr = source_array.character7; - *size = sizeof (*source_array.character7); - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - *cptr = source_array.character8; - *size = sizeof (*source_array.character8); - break; -#endif - default: assert ("bad CHARACTER ckindtype" == NULL); break; @@ -2999,30 +2277,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - *aptr = array.integer5 + offset; - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - *aptr = array.integer6 + offset; - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - *aptr = array.integer7 + offset; - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - *aptr = array.integer8 + offset; - break; -#endif - default: assert ("bad INTEGER akindtype" == NULL); break; @@ -3056,30 +2310,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - *aptr = array.logical5 + offset; - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - *aptr = array.logical6 + offset; - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - *aptr = array.logical7 + offset; - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - *aptr = array.logical8 + offset; - break; -#endif - default: assert ("bad LOGICAL akindtype" == NULL); break; @@ -3107,36 +2337,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - *aptr = array.real4 + offset; - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - *aptr = array.real5 + offset; - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - *aptr = array.real6 + offset; - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - *aptr = array.real7 + offset; - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - *aptr = array.real8 + offset; - break; -#endif - default: assert ("bad REAL akindtype" == NULL); break; @@ -3164,36 +2364,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - *aptr = array.complex4 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - *aptr = array.complex5 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - *aptr = array.complex6 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - *aptr = array.complex7 + offset; - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - *aptr = array.complex8 + offset; - break; -#endif - default: assert ("bad COMPLEX akindtype" == NULL); break; @@ -3209,48 +2379,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - *aptr = array.character2 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - *aptr = array.character3 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - *aptr = array.character4 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - *aptr = array.character5 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - *aptr = array.character6 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - *aptr = array.character7 + offset; - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - *aptr = array.character8 + offset; - break; -#endif - default: assert ("bad CHARACTER akindtype" == NULL); break; @@ -3295,34 +2423,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - *cptr = &constant->integer5; - *size = sizeof (constant->integer5); - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - *cptr = &constant->integer6; - *size = sizeof (constant->integer6); - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - *cptr = &constant->integer7; - *size = sizeof (constant->integer7); - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - *cptr = &constant->integer8; - *size = sizeof (constant->integer8); - break; -#endif - default: assert ("bad INTEGER ckindtype" == NULL); break; @@ -3360,34 +2460,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - *cptr = &constant->logical5; - *size = sizeof (constant->logical5); - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - *cptr = &constant->logical6; - *size = sizeof (constant->logical6); - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - *cptr = &constant->logical7; - *size = sizeof (constant->logical7); - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - *cptr = &constant->logical8; - *size = sizeof (constant->logical8); - break; -#endif - default: assert ("bad LOGICAL ckindtype" == NULL); break; @@ -3418,41 +2490,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - *cptr = &constant->real4; - *size = sizeof (constant->real4); - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - *cptr = &constant->real5; - *size = sizeof (constant->real5); - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - *cptr = &constant->real6; - *size = sizeof (constant->real6); - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - *cptr = &constant->real7; - *size = sizeof (constant->real7); - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - *cptr = &constant->real8; - *size = sizeof (constant->real8); - break; -#endif - default: assert ("bad REAL ckindtype" == NULL); break; @@ -3483,41 +2520,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - *cptr = &constant->complex4; - *size = sizeof (constant->complex4); - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - *cptr = &constant->complex5; - *size = sizeof (constant->complex5); - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - *cptr = &constant->complex6; - *size = sizeof (constant->complex6); - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - *cptr = &constant->complex7; - *size = sizeof (constant->complex7); - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - *cptr = &constant->complex8; - *size = sizeof (constant->complex8); - break; -#endif - default: assert ("bad COMPLEX ckindtype" == NULL); break; @@ -3534,55 +2536,6 @@ ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size, break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - *cptr = ffetarget_text_character2 (constant->character2); - *size = ffetarget_length_character2 (constant->character2); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - *cptr = ffetarget_text_character3 (constant->character3); - *size = ffetarget_length_character3 (constant->character3); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - *cptr = ffetarget_text_character4 (constant->character4); - *size = ffetarget_length_character4 (constant->character4); - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - *cptr = ffetarget_text_character5 (constant->character5); - *size = ffetarget_length_character5 (constant->character5); - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - *cptr = ffetarget_text_character6 (constant->character6); - *size = ffetarget_length_character6 (constant->character6); - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - *cptr = ffetarget_text_character7 (constant->character7); - *size = ffetarget_length_character7 (constant->character7); - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - *cptr = ffetarget_text_character8 (constant->character8); - *size = ffetarget_length_character8 (constant->character8); - break; -#endif - default: assert ("bad CHARACTER ckindtype" == NULL); break; @@ -3632,30 +2585,6 @@ ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okINTEGER5 - case FFEINFO_kindtypeINTEGER5: - *(array.integer5 + offset) = constant.integer5; - break; -#endif - -#if FFETARGET_okINTEGER6 - case FFEINFO_kindtypeINTEGER6: - *(array.integer6 + offset) = constant.integer6; - break; -#endif - -#if FFETARGET_okINTEGER7 - case FFEINFO_kindtypeINTEGER7: - *(array.integer7 + offset) = constant.integer7; - break; -#endif - -#if FFETARGET_okINTEGER8 - case FFEINFO_kindtypeINTEGER8: - *(array.integer8 + offset) = constant.integer8; - break; -#endif - default: assert ("bad INTEGER kindtype" == NULL); break; @@ -3689,30 +2618,6 @@ ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okLOGICAL5 - case FFEINFO_kindtypeLOGICAL5: - *(array.logical5 + offset) = constant.logical5; - break; -#endif - -#if FFETARGET_okLOGICAL6 - case FFEINFO_kindtypeLOGICAL6: - *(array.logical6 + offset) = constant.logical6; - break; -#endif - -#if FFETARGET_okLOGICAL7 - case FFEINFO_kindtypeLOGICAL7: - *(array.logical7 + offset) = constant.logical7; - break; -#endif - -#if FFETARGET_okLOGICAL8 - case FFEINFO_kindtypeLOGICAL8: - *(array.logical8 + offset) = constant.logical8; - break; -#endif - default: assert ("bad LOGICAL kindtype" == NULL); break; @@ -3740,36 +2645,6 @@ ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - *(array.real4 + offset) = constant.real4; - break; -#endif - -#if FFETARGET_okREAL5 - case FFEINFO_kindtypeREAL5: - *(array.real5 + offset) = constant.real5; - break; -#endif - -#if FFETARGET_okREAL6 - case FFEINFO_kindtypeREAL6: - *(array.real6 + offset) = constant.real6; - break; -#endif - -#if FFETARGET_okREAL7 - case FFEINFO_kindtypeREAL7: - *(array.real7 + offset) = constant.real7; - break; -#endif - -#if FFETARGET_okREAL8 - case FFEINFO_kindtypeREAL8: - *(array.real8 + offset) = constant.real8; - break; -#endif - default: assert ("bad REAL kindtype" == NULL); break; @@ -3797,36 +2672,6 @@ ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - *(array.complex4 + offset) = constant.complex4; - break; -#endif - -#if FFETARGET_okCOMPLEX5 - case FFEINFO_kindtypeREAL5: - *(array.complex5 + offset) = constant.complex5; - break; -#endif - -#if FFETARGET_okCOMPLEX6 - case FFEINFO_kindtypeREAL6: - *(array.complex6 + offset) = constant.complex6; - break; -#endif - -#if FFETARGET_okCOMPLEX7 - case FFEINFO_kindtypeREAL7: - *(array.complex7 + offset) = constant.complex7; - break; -#endif - -#if FFETARGET_okCOMPLEX8 - case FFEINFO_kindtypeREAL8: - *(array.complex8 + offset) = constant.complex8; - break; -#endif - default: assert ("bad COMPLEX kindtype" == NULL); break; @@ -3844,62 +2689,6 @@ ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - memcpy (array.character2 + offset, - ffetarget_text_character2 (constant.character2), - ffetarget_length_character2 (constant.character2)); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - memcpy (array.character3 + offset, - ffetarget_text_character3 (constant.character3), - ffetarget_length_character3 (constant.character3)); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - memcpy (array.character4 + offset, - ffetarget_text_character4 (constant.character4), - ffetarget_length_character4 (constant.character4)); - break; -#endif - -#if FFETARGET_okCHARACTER5 - case FFEINFO_kindtypeCHARACTER5: - memcpy (array.character5 + offset, - ffetarget_text_character5 (constant.character5), - ffetarget_length_character5 (constant.character5)); - break; -#endif - -#if FFETARGET_okCHARACTER6 - case FFEINFO_kindtypeCHARACTER6: - memcpy (array.character6 + offset, - ffetarget_text_character6 (constant.character6), - ffetarget_length_character6 (constant.character6)); - break; -#endif - -#if FFETARGET_okCHARACTER7 - case FFEINFO_kindtypeCHARACTER7: - memcpy (array.character7 + offset, - ffetarget_text_character7 (constant.character7), - ffetarget_length_character7 (constant.character7)); - break; -#endif - -#if FFETARGET_okCHARACTER8 - case FFEINFO_kindtypeCHARACTER8: - memcpy (array.character8 + offset, - ffetarget_text_character8 (constant.character8), - ffetarget_length_character8 (constant.character8)); - break; -#endif - default: assert ("bad CHARACTER kindtype" == NULL); break; @@ -3917,7 +2706,7 @@ ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt, ffebld_init_0(); */ void -ffebld_init_0 () +ffebld_init_0 (void) { assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_)); assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_)); @@ -3928,7 +2717,7 @@ ffebld_init_0 () ffebld_init_1(); */ void -ffebld_init_1 () +ffebld_init_1 (void) { #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_ int i; @@ -3936,27 +2725,6 @@ ffebld_init_1 () #if FFETARGET_okCHARACTER1 ffebld_constant_character1_ = NULL; #endif -#if FFETARGET_okCHARACTER2 - ffebld_constant_character2_ = NULL; -#endif -#if FFETARGET_okCHARACTER3 - ffebld_constant_character3_ = NULL; -#endif -#if FFETARGET_okCHARACTER4 - ffebld_constant_character4_ = NULL; -#endif -#if FFETARGET_okCHARACTER5 - ffebld_constant_character5_ = NULL; -#endif -#if FFETARGET_okCHARACTER6 - ffebld_constant_character6_ = NULL; -#endif -#if FFETARGET_okCHARACTER7 - ffebld_constant_character7_ = NULL; -#endif -#if FFETARGET_okCHARACTER8 - ffebld_constant_character8_ = NULL; -#endif #if FFETARGET_okCOMPLEX1 ffebld_constant_complex1_ = NULL; #endif @@ -3966,21 +2734,6 @@ ffebld_init_1 () #if FFETARGET_okCOMPLEX3 ffebld_constant_complex3_ = NULL; #endif -#if FFETARGET_okCOMPLEX4 - ffebld_constant_complex4_ = NULL; -#endif -#if FFETARGET_okCOMPLEX5 - ffebld_constant_complex5_ = NULL; -#endif -#if FFETARGET_okCOMPLEX6 - ffebld_constant_complex6_ = NULL; -#endif -#if FFETARGET_okCOMPLEX7 - ffebld_constant_complex7_ = NULL; -#endif -#if FFETARGET_okCOMPLEX8 - ffebld_constant_complex8_ = NULL; -#endif #if FFETARGET_okINTEGER1 ffebld_constant_integer1_ = NULL; #endif @@ -3993,18 +2746,6 @@ ffebld_init_1 () #if FFETARGET_okINTEGER4 ffebld_constant_integer4_ = NULL; #endif -#if FFETARGET_okINTEGER5 - ffebld_constant_integer5_ = NULL; -#endif -#if FFETARGET_okINTEGER6 - ffebld_constant_integer6_ = NULL; -#endif -#if FFETARGET_okINTEGER7 - ffebld_constant_integer7_ = NULL; -#endif -#if FFETARGET_okINTEGER8 - ffebld_constant_integer8_ = NULL; -#endif #if FFETARGET_okLOGICAL1 ffebld_constant_logical1_ = NULL; #endif @@ -4017,18 +2758,6 @@ ffebld_init_1 () #if FFETARGET_okLOGICAL4 ffebld_constant_logical4_ = NULL; #endif -#if FFETARGET_okLOGICAL5 - ffebld_constant_logical5_ = NULL; -#endif -#if FFETARGET_okLOGICAL6 - ffebld_constant_logical6_ = NULL; -#endif -#if FFETARGET_okLOGICAL7 - ffebld_constant_logical7_ = NULL; -#endif -#if FFETARGET_okLOGICAL8 - ffebld_constant_logical8_ = NULL; -#endif #if FFETARGET_okREAL1 ffebld_constant_real1_ = NULL; #endif @@ -4038,21 +2767,6 @@ ffebld_init_1 () #if FFETARGET_okREAL3 ffebld_constant_real3_ = NULL; #endif -#if FFETARGET_okREAL4 - ffebld_constant_real4_ = NULL; -#endif -#if FFETARGET_okREAL5 - ffebld_constant_real5_ = NULL; -#endif -#if FFETARGET_okREAL6 - ffebld_constant_real6_ = NULL; -#endif -#if FFETARGET_okREAL7 - ffebld_constant_real7_ = NULL; -#endif -#if FFETARGET_okREAL8 - ffebld_constant_real8_ = NULL; -#endif ffebld_constant_hollerith_ = NULL; for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i) ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL; @@ -4064,7 +2778,7 @@ ffebld_init_1 () ffebld_init_2(); */ void -ffebld_init_2 () +ffebld_init_2 (void) { #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_ int i; @@ -4076,27 +2790,6 @@ ffebld_init_2 () #if FFETARGET_okCHARACTER1 ffebld_constant_character1_ = NULL; #endif -#if FFETARGET_okCHARACTER2 - ffebld_constant_character2_ = NULL; -#endif -#if FFETARGET_okCHARACTER3 - ffebld_constant_character3_ = NULL; -#endif -#if FFETARGET_okCHARACTER4 - ffebld_constant_character4_ = NULL; -#endif -#if FFETARGET_okCHARACTER5 - ffebld_constant_character5_ = NULL; -#endif -#if FFETARGET_okCHARACTER6 - ffebld_constant_character6_ = NULL; -#endif -#if FFETARGET_okCHARACTER7 - ffebld_constant_character7_ = NULL; -#endif -#if FFETARGET_okCHARACTER8 - ffebld_constant_character8_ = NULL; -#endif #if FFETARGET_okCOMPLEX1 ffebld_constant_complex1_ = NULL; #endif @@ -4106,21 +2799,6 @@ ffebld_init_2 () #if FFETARGET_okCOMPLEX3 ffebld_constant_complex3_ = NULL; #endif -#if FFETARGET_okCOMPLEX4 - ffebld_constant_complex4_ = NULL; -#endif -#if FFETARGET_okCOMPLEX5 - ffebld_constant_complex5_ = NULL; -#endif -#if FFETARGET_okCOMPLEX6 - ffebld_constant_complex6_ = NULL; -#endif -#if FFETARGET_okCOMPLEX7 - ffebld_constant_complex7_ = NULL; -#endif -#if FFETARGET_okCOMPLEX8 - ffebld_constant_complex8_ = NULL; -#endif #if FFETARGET_okINTEGER1 ffebld_constant_integer1_ = NULL; #endif @@ -4133,18 +2811,6 @@ ffebld_init_2 () #if FFETARGET_okINTEGER4 ffebld_constant_integer4_ = NULL; #endif -#if FFETARGET_okINTEGER5 - ffebld_constant_integer5_ = NULL; -#endif -#if FFETARGET_okINTEGER6 - ffebld_constant_integer6_ = NULL; -#endif -#if FFETARGET_okINTEGER7 - ffebld_constant_integer7_ = NULL; -#endif -#if FFETARGET_okINTEGER8 - ffebld_constant_integer8_ = NULL; -#endif #if FFETARGET_okLOGICAL1 ffebld_constant_logical1_ = NULL; #endif @@ -4157,18 +2823,6 @@ ffebld_init_2 () #if FFETARGET_okLOGICAL4 ffebld_constant_logical4_ = NULL; #endif -#if FFETARGET_okLOGICAL5 - ffebld_constant_logical5_ = NULL; -#endif -#if FFETARGET_okLOGICAL6 - ffebld_constant_logical6_ = NULL; -#endif -#if FFETARGET_okLOGICAL7 - ffebld_constant_logical7_ = NULL; -#endif -#if FFETARGET_okLOGICAL8 - ffebld_constant_logical8_ = NULL; -#endif #if FFETARGET_okREAL1 ffebld_constant_real1_ = NULL; #endif @@ -4178,21 +2832,6 @@ ffebld_init_2 () #if FFETARGET_okREAL3 ffebld_constant_real3_ = NULL; #endif -#if FFETARGET_okREAL4 - ffebld_constant_real4_ = NULL; -#endif -#if FFETARGET_okREAL5 - ffebld_constant_real5_ = NULL; -#endif -#if FFETARGET_okREAL6 - ffebld_constant_real6_ = NULL; -#endif -#if FFETARGET_okREAL7 - ffebld_constant_real7_ = NULL; -#endif -#if FFETARGET_okREAL8 - ffebld_constant_real8_ = NULL; -#endif ffebld_constant_hollerith_ = NULL; for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i) ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL; @@ -4231,9 +2870,6 @@ ffebld_new_accter (ffebldConstantArray a, ffebit b) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = FFEBLD_opACCTER; x->u.accter.array = a; x->u.accter.bits = b; @@ -4254,9 +2890,6 @@ ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = FFEBLD_opARRTER; x->u.arrter.array = a; x->u.arrter.size = size; @@ -4276,9 +2909,6 @@ ffebld_new_conter_with_orig (ffebldConstant c, ffebld o) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = FFEBLD_opCONTER; x->u.conter.expr = c; x->u.conter.orig = o; @@ -4297,15 +2927,9 @@ ffebld_new_item (ffebld head, ffebld trail) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = FFEBLD_opITEM; x->u.item.head = head; x->u.item.trail = trail; -#ifdef FFECOM_itemHOOK - x->u.item.hook = FFECOM_itemNULL; -#endif return x; } @@ -4321,9 +2945,6 @@ ffebld_new_labter (ffelab l) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = FFEBLD_opLABTER; x->u.labter = l; return x; @@ -4346,9 +2967,6 @@ ffebld_new_labtok (ffelexToken t) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = FFEBLD_opLABTOK; x->u.labtok = t; return x; @@ -4365,9 +2983,6 @@ ffebld_new_none (ffebldOp o) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = o; return x; } @@ -4383,14 +2998,9 @@ ffebld_new_one (ffebldOp o, ffebld left) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = o; x->u.nonter.left = left; -#ifdef FFECOM_nonterHOOK x->u.nonter.hook = FFECOM_nonterNULL; -#endif return x; } @@ -4410,9 +3020,6 @@ ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec, ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = FFEBLD_opSYMTER; x->u.symter.symbol = s; x->u.symter.generic = gen; @@ -4433,15 +3040,10 @@ ffebld_new_two (ffebldOp o, ffebld left, ffebld right) ffebld x; x = ffebld_new (); -#if FFEBLD_BLANK_ - *x = ffebld_blank_; -#endif x->op = o; x->u.nonter.left = left; x->u.nonter.right = right; -#ifdef FFECOM_nonterHOOK x->u.nonter.hook = FFECOM_nonterNULL; -#endif return x; } @@ -4450,7 +3052,7 @@ ffebld_new_two (ffebldOp o, ffebld left, ffebld right) ffebld_pool_pop(); */ void -ffebld_pool_pop () +ffebld_pool_pop (void) { ffebldPoolstack_ ps; diff --git a/contrib/gcc/f/bld.h b/contrib/gcc/f/bld.h index e7285e6..900b5de 100644 --- a/contrib/gcc/f/bld.h +++ b/contrib/gcc/f/bld.h @@ -1,5 +1,5 @@ /* bld.h -- Public #include File (module.h template V1.0) - Copyright (C) 1995, 1996 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -154,18 +154,6 @@ union _ffebld_constant_union_ #if FFETARGET_okINTEGER4 ffetargetInteger4 integer4; #endif -#if FFETARGET_okINTEGER5 - ffetargetInteger5 integer5; -#endif -#if FFETARGET_okINTEGER6 - ffetargetInteger6 integer6; -#endif -#if FFETARGET_okINTEGER7 - ffetargetInteger7 integer7; -#endif -#if FFETARGET_okINTEGER8 - ffetargetInteger8 integer8; -#endif #if FFETARGET_okLOGICAL1 ffetargetLogical1 logical1; #endif @@ -178,18 +166,6 @@ union _ffebld_constant_union_ #if FFETARGET_okLOGICAL4 ffetargetLogical4 logical4; #endif -#if FFETARGET_okLOGICAL5 - ffetargetLogical5 logical5; -#endif -#if FFETARGET_okLOGICAL6 - ffetargetLogical6 logical6; -#endif -#if FFETARGET_okLOGICAL7 - ffetargetLogical7 logical7; -#endif -#if FFETARGET_okLOGICAL8 - ffetargetLogical8 logical8; -#endif #if FFETARGET_okREAL1 ffetargetReal1 real1; #endif @@ -199,21 +175,6 @@ union _ffebld_constant_union_ #if FFETARGET_okREAL3 ffetargetReal3 real3; #endif -#if FFETARGET_okREAL4 - ffetargetReal4 real4; -#endif -#if FFETARGET_okREAL5 - ffetargetReal5 real5; -#endif -#if FFETARGET_okREAL6 - ffetargetReal6 real6; -#endif -#if FFETARGET_okREAL7 - ffetargetReal7 real7; -#endif -#if FFETARGET_okREAL8 - ffetargetReal8 real8; -#endif #if FFETARGET_okCOMPLEX1 ffetargetComplex1 complex1; #endif @@ -223,45 +184,9 @@ union _ffebld_constant_union_ #if FFETARGET_okCOMPLEX3 ffetargetComplex3 complex3; #endif -#if FFETARGET_okCOMPLEX4 - ffetargetComplex4 complex4; -#endif -#if FFETARGET_okCOMPLEX5 - ffetargetComplex5 complex5; -#endif -#if FFETARGET_okCOMPLEX6 - ffetargetComplex6 complex6; -#endif -#if FFETARGET_okCOMPLEX7 - ffetargetComplex7 complex7; -#endif -#if FFETARGET_okCOMPLEX8 - ffetargetComplex8 complex8; -#endif #if FFETARGET_okCHARACTER1 ffetargetCharacter1 character1; #endif -#if FFETARGET_okCHARACTER2 - ffetargetCharacter2 character2; -#endif -#if FFETARGET_okCHARACTER3 - ffetargetCharacter3 character3; -#endif -#if FFETARGET_okCHARACTER4 - ffetargetCharacter4 character4; -#endif -#if FFETARGET_okCHARACTER5 - ffetargetCharacter5 character5; -#endif -#if FFETARGET_okCHARACTER6 - ffetargetCharacter6 character6; -#endif -#if FFETARGET_okCHARACTER7 - ffetargetCharacter7 character7; -#endif -#if FFETARGET_okCHARACTER8 - ffetargetCharacter8 character8; -#endif }; union _ffebld_constant_array_ @@ -278,18 +203,6 @@ union _ffebld_constant_array_ #if FFETARGET_okINTEGER4 ffetargetInteger4 *integer4; #endif -#if FFETARGET_okINTEGER5 - ffetargetInteger5 *integer5; -#endif -#if FFETARGET_okINTEGER6 - ffetargetInteger6 *integer6; -#endif -#if FFETARGET_okINTEGER7 - ffetargetInteger7 *integer7; -#endif -#if FFETARGET_okINTEGER8 - ffetargetInteger8 *integer8; -#endif #if FFETARGET_okLOGICAL1 ffetargetLogical1 *logical1; #endif @@ -302,18 +215,6 @@ union _ffebld_constant_array_ #if FFETARGET_okLOGICAL4 ffetargetLogical4 *logical4; #endif -#if FFETARGET_okLOGICAL5 - ffetargetLogical5 *logical5; -#endif -#if FFETARGET_okLOGICAL6 - ffetargetLogical6 *logical6; -#endif -#if FFETARGET_okLOGICAL7 - ffetargetLogical7 *logical7; -#endif -#if FFETARGET_okLOGICAL8 - ffetargetLogical8 *logical8; -#endif #if FFETARGET_okREAL1 ffetargetReal1 *real1; #endif @@ -323,21 +224,6 @@ union _ffebld_constant_array_ #if FFETARGET_okREAL3 ffetargetReal3 *real3; #endif -#if FFETARGET_okREAL4 - ffetargetReal4 *real4; -#endif -#if FFETARGET_okREAL5 - ffetargetReal5 *real5; -#endif -#if FFETARGET_okREAL6 - ffetargetReal6 *real6; -#endif -#if FFETARGET_okREAL7 - ffetargetReal7 *real7; -#endif -#if FFETARGET_okREAL8 - ffetargetReal8 *real8; -#endif #if FFETARGET_okCOMPLEX1 ffetargetComplex1 *complex1; #endif @@ -347,45 +233,9 @@ union _ffebld_constant_array_ #if FFETARGET_okCOMPLEX3 ffetargetComplex3 *complex3; #endif -#if FFETARGET_okCOMPLEX4 - ffetargetComplex4 *complex4; -#endif -#if FFETARGET_okCOMPLEX5 - ffetargetComplex5 *complex5; -#endif -#if FFETARGET_okCOMPLEX6 - ffetargetComplex6 *complex6; -#endif -#if FFETARGET_okCOMPLEX7 - ffetargetComplex7 *complex7; -#endif -#if FFETARGET_okCOMPLEX8 - ffetargetComplex8 *complex8; -#endif #if FFETARGET_okCHARACTER1 ffetargetCharacterUnit1 *character1; #endif -#if FFETARGET_okCHARACTER2 - ffetargetCharacterUnit2 *character2; -#endif -#if FFETARGET_okCHARACTER3 - ffetargetCharacterUnit3 *character3; -#endif -#if FFETARGET_okCHARACTER4 - ffetargetCharacterUnit4 *character4; -#endif -#if FFETARGET_okCHARACTER5 - ffetargetCharacterUnit5 *character5; -#endif -#if FFETARGET_okCHARACTER6 - ffetargetCharacterUnit6 *character6; -#endif -#if FFETARGET_okCHARACTER7 - ffetargetCharacterUnit7 *character7; -#endif -#if FFETARGET_okCHARACTER8 - ffetargetCharacterUnit8 *character8; -#endif }; struct _ffebld_ @@ -400,18 +250,13 @@ struct _ffebld_ { ffebld left; ffebld right; -#ifdef FFECOM_nonterHOOK ffecomNonter hook; /* Whatever the compiler/backend wants! */ -#endif } nonter; struct { ffebld head; ffebld trail; -#ifdef FFECOM_itemHOOK - ffecomItem hook; /* Whatever the compiler/backend wants! */ -#endif } item; struct @@ -454,14 +299,12 @@ struct _ffebld_ struct _ffebld_constant_ { - ffebldConstant next; + ffebldConstant rlink; + ffebldConstant llink; ffebldConstant first_complex; /* First complex const with me as real. */ - ffebldConstant negated; /* We point to each other through here. */ ffebldConst consttype; -#ifdef FFECOM_constantHOOK ffecomConstant hook; /* Whatever the compiler/backend wants! */ -#endif bool numeric; /* A numeric kind of constant. */ ffebldConstantUnion u; }; @@ -486,34 +329,6 @@ bool ffebld_constant_is_zero (ffebldConstant c); ffebldConstant ffebld_constant_new_character1 (ffelexToken t); ffebldConstant ffebld_constant_new_character1_val (ffetargetCharacter1 val); #endif -#if FFETARGET_okCHARACTER2 -ffebldConstant ffebld_constant_new_character2 (ffelexToken t); -ffebldConstant ffebld_constant_new_character2_val (ffetargetCharacter2 val); -#endif -#if FFETARGET_okCHARACTER3 -ffebldConstant ffebld_constant_new_character3 (ffelexToken t); -ffebldConstant ffebld_constant_new_character3_val (ffetargetCharacter3 val); -#endif -#if FFETARGET_okCHARACTER4 -ffebldConstant ffebld_constant_new_character4 (ffelexToken t); -ffebldConstant ffebld_constant_new_character4_val (ffetargetCharacter4 val); -#endif -#if FFETARGET_okCHARACTER5 -ffebldConstant ffebld_constant_new_character5 (ffelexToken t); -ffebldConstant ffebld_constant_new_character5_val (ffetargetCharacter5 val); -#endif -#if FFETARGET_okCHARACTER6 -ffebldConstant ffebld_constant_new_character6 (ffelexToken t); -ffebldConstant ffebld_constant_new_character6_val (ffetargetCharacter6 val); -#endif -#if FFETARGET_okCHARACTER7 -ffebldConstant ffebld_constant_new_character7 (ffelexToken t); -ffebldConstant ffebld_constant_new_character7_val (ffetargetCharacter7 val); -#endif -#if FFETARGET_okCHARACTER8 -ffebldConstant ffebld_constant_new_character8 (ffelexToken t); -ffebldConstant ffebld_constant_new_character8_val (ffetargetCharacter8 val); -#endif #if FFETARGET_okCOMPLEX1 ffebldConstant ffebld_constant_new_complex1 (ffebldConstant real, ffebldConstant imaginary); @@ -529,31 +344,6 @@ ffebldConstant ffebld_constant_new_complex3 (ffebldConstant real, ffebldConstant imaginary); ffebldConstant ffebld_constant_new_complex3_val (ffetargetComplex3 val); #endif -#if FFETARGET_okCOMPLEX4 -ffebldConstant ffebld_constant_new_complex4 (ffebldConstant real, - ffebldConstant imaginary); -ffebldConstant ffebld_constant_new_complex4_val (ffetargetComplex4 val); -#endif -#if FFETARGET_okCOMPLEX5 -ffebldConstant ffebld_constant_new_complex5 (ffebldConstant real, - ffebldConstant imaginary); -ffebldConstant ffebld_constant_new_complex5_val (ffetargetComplex5 val); -#endif -#if FFETARGET_okCOMPLEX6 -ffebldConstant ffebld_constant_new_complex6 (ffebldConstant real, - ffebldConstant imaginary); -ffebldConstant ffebld_constant_new_complex6_val (ffetargetComplex6 val); -#endif -#if FFETARGET_okCOMPLEX7 -ffebldConstant ffebld_constant_new_complex7 (ffebldConstant real, - ffebldConstant imaginary); -ffebldConstant ffebld_constant_new_complex7_val (ffetargetComplex7 val); -#endif -#if FFETARGET_okCOMPLEX8 -ffebldConstant ffebld_constant_new_complex8 (ffebldConstant real, - ffebldConstant imaginary); -ffebldConstant ffebld_constant_new_complex8_val (ffetargetComplex8 val); -#endif ffebldConstant ffebld_constant_new_hollerith (ffelexToken t); ffebldConstant ffebld_constant_new_hollerith_val (ffetargetHollerith val); #if FFETARGET_okINTEGER1 @@ -572,22 +362,6 @@ ffebldConstant ffebld_constant_new_integer3_val (ffetargetInteger3 val); ffebldConstant ffebld_constant_new_integer4 (ffelexToken t); ffebldConstant ffebld_constant_new_integer4_val (ffetargetInteger4 val); #endif -#if FFETARGET_okINTEGER5 -ffebldConstant ffebld_constant_new_integer5 (ffelexToken t); -ffebldConstant ffebld_constant_new_integer5_val (ffetargetInteger5 val); -#endif -#if FFETARGET_okINTEGER6 -ffebldConstant ffebld_constant_new_integer6 (ffelexToken t); -ffebldConstant ffebld_constant_new_integer6_val (ffetargetInteger6 val); -#endif -#if FFETARGET_okINTEGER7 -ffebldConstant ffebld_constant_new_integer7 (ffelexToken t); -ffebldConstant ffebld_constant_new_integer7_val (ffetargetInteger7 val); -#endif -#if FFETARGET_okINTEGER8 -ffebldConstant ffebld_constant_new_integer8 (ffelexToken t); -ffebldConstant ffebld_constant_new_integer8_val (ffetargetInteger8 val); -#endif ffebldConstant ffebld_constant_new_integerbinary (ffelexToken t); ffebldConstant ffebld_constant_new_integerhex (ffelexToken t); ffebldConstant ffebld_constant_new_integeroctal (ffelexToken t); @@ -607,22 +381,6 @@ ffebldConstant ffebld_constant_new_logical3_val (ffetargetLogical3 val); ffebldConstant ffebld_constant_new_logical4 (bool truth); ffebldConstant ffebld_constant_new_logical4_val (ffetargetLogical4 val); #endif -#if FFETARGET_okLOGICAL5 -ffebldConstant ffebld_constant_new_logical5 (bool truth); -ffebldConstant ffebld_constant_new_logical5_val (ffetargetLogical5 val); -#endif -#if FFETARGET_okLOGICAL6 -ffebldConstant ffebld_constant_new_logical6 (bool truth); -ffebldConstant ffebld_constant_new_logical6_val (ffetargetLogical6 val); -#endif -#if FFETARGET_okLOGICAL7 -ffebldConstant ffebld_constant_new_logical7 (bool truth); -ffebldConstant ffebld_constant_new_logical7_val (ffetargetLogical7 val); -#endif -#if FFETARGET_okLOGICAL8 -ffebldConstant ffebld_constant_new_logical8 (bool truth); -ffebldConstant ffebld_constant_new_logical8_val (ffetargetLogical8 val); -#endif #if FFETARGET_okREAL1 ffebldConstant ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal, ffelexToken fraction, ffelexToken exponent, @@ -641,36 +399,6 @@ ffebldConstant ffebld_constant_new_real3 (ffelexToken integer, ffelexToken exponent_sign, ffelexToken exponent_digits); ffebldConstant ffebld_constant_new_real3_val (ffetargetReal3 val); #endif -#if FFETARGET_okREAL4 -ffebldConstant ffebld_constant_new_real4 (ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, ffelexToken exponent, - ffelexToken exponent_sign, ffelexToken exponent_digits); -ffebldConstant ffebld_constant_new_real4_val (ffetargetReal4 val); -#endif -#if FFETARGET_okREAL5 -ffebldConstant ffebld_constant_new_real5 (ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, ffelexToken exponent, - ffelexToken exponent_sign, ffelexToken exponent_digits); -ffebldConstant ffebld_constant_new_real5_val (ffetargetReal5 val); -#endif -#if FFETARGET_okREAL6 -ffebldConstant ffebld_constant_new_real6 (ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, ffelexToken exponent, - ffelexToken exponent_sign, ffelexToken exponent_digits); -ffebldConstant ffebld_constant_new_real6_val (ffetargetReal6 val); -#endif -#if FFETARGET_okREAL7 -ffebldConstant ffebld_constant_new_real7 (ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, ffelexToken exponent, - ffelexToken exponent_sign, ffelexToken exponent_digits); -ffebldConstant ffebld_constant_new_real7_val (ffetargetReal7 val); -#endif -#if FFETARGET_okREAL8 -ffebldConstant ffebld_constant_new_real8 (ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, ffelexToken exponent, - ffelexToken exponent_sign, ffelexToken exponent_digits); -ffebldConstant ffebld_constant_new_real8_val (ffetargetReal8 val); -#endif ffebldConstant ffebld_constant_new_typeless_bm (ffelexToken t); ffebldConstant ffebld_constant_new_typeless_bv (ffelexToken t); ffebldConstant ffebld_constant_new_typeless_hxm (ffelexToken t); diff --git a/contrib/gcc/f/bugs.texi b/contrib/gcc/f/bugs.texi index 176072c..fdc4f15 100644 --- a/contrib/gcc/f/bugs.texi +++ b/contrib/gcc/f/bugs.texi @@ -1,4 +1,4 @@ -@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @@ -7,9 +7,9 @@ @c Keep this the same as the dates above, since it's used @c in the standalone derivations of this file (e.g. BUGS). -@set copyrights-bugs 1995,1996,1997,1998,1999,2000,2001,2002 +@set copyrights-bugs 1995,1996,1997,1998,1999,2000,2001,2002,2004 -@set last-update-bugs 2002-02-01 +@set last-update-bugs 2004-05-18 @ifset DOC-BUGS @include root.texi @@ -74,13 +74,6 @@ is expected to contain documentation that is most consistent with the @code{g77} product in that version. @end ifset -An online, ``live'' version of this document -(derived directly from the mainline, development version -of @code{g77} within @code{gcc}) -is available via -@uref{http://gcc.gnu.org/onlinedocs/g77/Trouble.html}. -Follow the ``Known Bugs'' link. - The following information was last updated on @value{last-update-bugs}: @itemize @bullet diff --git a/contrib/gcc/f/com-rt.def b/contrib/gcc/f/com-rt.def index 43344d9..185aef5 100644 --- a/contrib/gcc/f/com-rt.def +++ b/contrib/gcc/f/com-rt.def @@ -128,7 +128,7 @@ DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, F DEFGFRT (FFECOM_gfrtANINT, "r_nint", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE) DEFGFRT (FFECOM_gfrtASIN, "r_asin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE) DEFGFRT (FFECOM_gfrtATAN, "r_atan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE) -DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE) +DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeREAL_F2C_, "&f&f", FALSE, FALSE, FALSE) DEFGFRT (FFECOM_gfrtCABS, "c_abs", FFECOM_rttypeREAL_F2C_, "&c", FALSE, FALSE, FALSE) DEFGFRT (FFECOM_gfrtCCOS, "c_cos", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE) DEFGFRT (FFECOM_gfrtCEXP, "c_exp", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE) @@ -259,22 +259,22 @@ DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE, F DEFGFRT (FFECOM_gfrtL_ACOS, "acos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_ASIN, "asin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_ATAN, "atan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_ATAN2, "atan2", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_ATAN, "__builtin_atan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_ATAN2, "__builtin_atan2", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_COS, "__builtin_cos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_COSH, "cosh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_ERF, "erf", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_ERFC, "erfc", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_EXP, "exp", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_FLOOR, "floor", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_FMOD, "fmod", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_LOG, "log", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_EXP, "__builtin_exp", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_FLOOR, "__builtin_floor", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_FMOD, "__builtin_fmod", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_LOG, "__builtin_log", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_LOG10, "log10", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_POW, "pow", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_POW, "__builtin_pow", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_SIN, "__builtin_sin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_SINH, "sinh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_SQRT, "__builtin_sqrt", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) -DEFGFRT (FFECOM_gfrtL_TAN, "tan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) +DEFGFRT (FFECOM_gfrtL_TAN, "__builtin_tan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtL_TANH, "tanh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE) DEFGFRT (FFECOM_gfrtPOW_CI, "pow_ci", FFECOM_rttypeCOMPLEX_F2C_, "&c&i", FALSE, TRUE, FALSE) diff --git a/contrib/gcc/f/com.c b/contrib/gcc/f/com.c index fca0f94..a64ef86 100644 --- a/contrib/gcc/f/com.c +++ b/contrib/gcc/f/com.c @@ -1,5 +1,5 @@ /* com.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 + Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. @@ -168,7 +168,7 @@ tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype]; appropriate _tree_type array element. */ static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; -static GTY(()) tree +static GTY(()) tree ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; static GTY(()) tree ffecom_tree_subr_type; static GTY(()) tree ffecom_tree_ptr_to_subr_type; @@ -264,14 +264,14 @@ struct _ffecom_concat_list_ /* Static functions (internal). */ -static tree ffe_type_for_mode PARAMS ((enum machine_mode, int)); -static tree ffe_type_for_size PARAMS ((unsigned int, int)); -static tree ffe_unsigned_type PARAMS ((tree)); -static tree ffe_signed_type PARAMS ((tree)); -static tree ffe_signed_or_unsigned_type PARAMS ((int, tree)); -static bool ffe_mark_addressable PARAMS ((tree)); -static tree ffe_truthvalue_conversion PARAMS ((tree)); -static void ffecom_init_decl_processing PARAMS ((void)); +static tree ffe_type_for_mode (enum machine_mode, int); +static tree ffe_type_for_size (unsigned int, int); +static tree ffe_unsigned_type (tree); +static tree ffe_signed_type (tree); +static tree ffe_signed_or_unsigned_type (int, tree); +static bool ffe_mark_addressable (tree); +static tree ffe_truthvalue_conversion (tree); +static void ffecom_init_decl_processing (void); 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, @@ -389,7 +389,6 @@ static tree start_decl (tree decl, bool is_top_level); static void start_function (tree name, tree type, int nested, int public); static void ffecom_file_ (const char *name); 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); @@ -604,18 +603,18 @@ struct lang_identifier GTY(()) (((struct lang_identifier *)(NODE))->invented) /* The resulting tree type. */ -union lang_tree_node +union lang_tree_node GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) { - union tree_node GTY ((tag ("0"), - desc ("tree_node_structure (&%h)"))) + union tree_node GTY ((tag ("0"), + desc ("tree_node_structure (&%h)"))) generic; struct lang_identifier GTY ((tag ("1"))) identifier; }; /* Fortran doesn't use either of these. */ -struct lang_decl GTY(()) +struct lang_decl GTY(()) { }; struct lang_type GTY(()) @@ -639,15 +638,16 @@ static GTY(()) tree shadowed_labels; /* Return the subscript expression, modified to do range-checking. - `array' is the array to be checked against. + `array' is the array type to be checked against. `element' is the subscript expression to check. `dim' is the dimension number (starting at 0). `total_dims' is the total number of dimensions (0 for CHARACTER substring). + `item' is the array decl or NULL_TREE. */ static tree ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, - const char *array_name) + const char *array_name, tree item) { tree low = TYPE_MIN_VALUE (TYPE_DOMAIN (array)); tree high = TYPE_MAX_VALUE (TYPE_DOMAIN (array)); @@ -714,6 +714,10 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, } } + /* If the array index is safe at compile-time, return element. */ + if (integer_nonzerop (cond)) + return element; + { int len; char *proc; @@ -791,7 +795,7 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, arg3); arg4 = convert (ffecom_f2c_ftnint_type_node, - build_int_2 (lineno, 0)); + build_int_2 (input_line, 0)); arg1 = build_tree_list (NULL_TREE, arg1); arg2 = build_tree_list (NULL_TREE, arg2); @@ -808,13 +812,10 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, TREE_SIDE_EFFECTS (die) = 1; die = convert (void_type_node, die); - element = ffecom_3 (COND_EXPR, - TREE_TYPE (element), - cond, - element, - die); + if (integer_zerop (cond) && item) + ffe_mark_addressable (item); - return element; + return ffecom_3 (COND_EXPR, TREE_TYPE (element), cond, element, die); } /* Return the computed element of an array reference. @@ -900,7 +901,7 @@ ffecom_arrayref_ (tree item, ffebld expr, int want_ptr) element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE); if (flag_bounds_check) element = ffecom_subscript_check_ (array, element, i, total_dims, - array_name); + array_name, item); if (element == error_mark_node) return element; @@ -946,7 +947,7 @@ ffecom_arrayref_ (tree item, ffebld expr, int want_ptr) element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE); if (flag_bounds_check) element = ffecom_subscript_check_ (array, element, i, total_dims, - array_name); + array_name, item); if (element == error_mark_node) return element; @@ -1109,8 +1110,7 @@ ffecom_convert_to_complex_ (tree type, tree expr) /* Like gcc's convert(), but crashes if widening might happen. */ static tree -ffecom_convert_narrow_ (type, expr) - tree type, expr; +ffecom_convert_narrow_ (tree type, tree expr) { register tree e = expr; register enum tree_code code = TREE_CODE (type); @@ -1180,8 +1180,7 @@ ffecom_convert_narrow_ (type, expr) /* Like gcc's convert(), but crashes if narrowing might happen. */ static tree -ffecom_convert_widen_ (type, expr) - tree type, expr; +ffecom_convert_widen_ (tree type, tree expr) { register tree e = expr; register enum tree_code code = TREE_CODE (type); @@ -1289,7 +1288,7 @@ ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart) { bothparts = build_tree_list (TYPE_FIELDS (type), realpart); TREE_CHAIN (bothparts) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), imagpart); - bothparts = build (CONSTRUCTOR, type, NULL_TREE, bothparts); + bothparts = build_constructor (type, bothparts); } else { @@ -1533,8 +1532,7 @@ ffecom_possible_partial_overlap_ (ffebld expr1, ffebld expr2 ATTRIBUTE_UNUSED) static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, - tree source_tree, ffebld source UNUSED, - bool scalar_arg) + tree source_tree, ffebld source UNUSED, bool scalar_arg) { tree source_decl; tree source_offset; @@ -1577,7 +1575,6 @@ ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, case MIN_EXPR: case MAX_EXPR: case ABS_EXPR: - case FFS_EXPR: case LSHIFT_EXPR: case RSHIFT_EXPR: case LROTATE_EXPR: @@ -1585,7 +1582,6 @@ ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, case BIT_IOR_EXPR: case BIT_XOR_EXPR: case BIT_AND_EXPR: - case BIT_ANDTC_EXPR: case BIT_NOT_EXPR: case TRUTH_ANDIF_EXPR: case TRUTH_ORIF_EXPR: @@ -1715,9 +1711,8 @@ ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, in a COMMON area the callee might know about (and thus modify). */ static bool -ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, - tree args, tree callee_commons, - bool scalar_args) +ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, tree args, + tree callee_commons, bool scalar_args) { tree arg; tree dest_decl; @@ -1791,10 +1786,9 @@ ffecom_build_f2c_string_ (int i, const char *s) to the arglist a pointer to a temporary to receive the return value. */ static tree -ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, - tree type, tree args, tree dest_tree, - ffebld dest, bool *dest_used, tree callee_commons, - bool scalar_args, tree hook) +ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, + tree args, tree dest_tree, ffebld dest, bool *dest_used, + tree callee_commons, bool scalar_args, tree hook) { tree item; tree tempvar; @@ -1852,9 +1846,9 @@ ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, - tree type, ffebld left, ffebld right, - tree dest_tree, ffebld dest, bool *dest_used, - tree callee_commons, bool scalar_args, bool ref, tree hook) + tree type, ffebld left, ffebld right, tree dest_tree, + ffebld dest, bool *dest_used, tree callee_commons, + bool scalar_args, bool ref, tree hook) { tree left_tree; tree right_tree; @@ -2045,7 +2039,7 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) end_tree = ffecom_expr (end); if (flag_bounds_check) end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0, - char_name); + char_name, NULL_TREE); end_tree = convert (ffecom_f2c_ftnlen_type_node, end_tree); @@ -2063,7 +2057,7 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) start_tree = ffecom_expr (start); if (flag_bounds_check) start_tree = ffecom_subscript_check_ (array, start_tree, 0, 0, - char_name); + char_name, NULL_TREE); start_tree = convert (ffecom_f2c_ftnlen_type_node, start_tree); @@ -2096,7 +2090,7 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) end_tree = ffecom_expr (end); if (flag_bounds_check) end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0, - char_name); + char_name, NULL_TREE); end_tree = convert (ffecom_f2c_ftnlen_type_node, end_tree); @@ -2584,12 +2578,12 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) CHARACTER. */ bool cmplxfunc; /* Use f2c way of returning COMPLEX. */ bool multi; /* Master fn has multiple return types. */ - bool altreturning = FALSE; /* This entry point has alternate returns. */ - int old_lineno = lineno; - const char *old_input_filename = input_filename; + bool altreturning = FALSE; /* This entry point has alternate + returns. */ + location_t old_loc = input_location; input_filename = ffesymbol_where_filename (fn); - lineno = ffesymbol_where_filelinenum (fn); + input_line = ffesymbol_where_filelinenum (fn); ffecom_doing_entry_ = TRUE; /* Don't bother with array dimensions. */ @@ -2919,8 +2913,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) finish_function (0); - lineno = old_lineno; - input_filename = old_input_filename; + input_location = old_loc; ffecom_doing_entry_ = FALSE; } @@ -2933,8 +2926,8 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) made, destination used instead, and dest_used flag set TRUE. */ static tree -ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, - bool *dest_used, bool assignp, bool widenp) +ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used, + bool assignp, bool widenp) { tree item; tree list; @@ -3029,7 +3022,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, build_range_type (ffecom_integer_type_node, ffecom_integer_zero_node, item)); - list = build (CONSTRUCTOR, item, NULL_TREE, list); + list = build_constructor (item, list); TREE_CONSTANT (list) = 1; TREE_STATIC (list) = 1; return list; @@ -3077,7 +3070,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, build_range_type (ffecom_integer_type_node, ffecom_integer_zero_node, item)); - list = build (CONSTRUCTOR, item, NULL_TREE, list); + list = build_constructor (item, list); TREE_CONSTANT (list) = 1; TREE_STATIC (list) = 1; return list; @@ -3799,8 +3792,8 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, subroutines. */ static tree -ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, - ffebld dest, bool *dest_used) +ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest, + bool *dest_used) { tree expr_tree; tree saved_expr1; /* For those who need it. */ @@ -5905,8 +5898,7 @@ ffecom_f2c_make_type_ (tree *type, int tcode, const char *name) given size. */ static void -ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, - int code) +ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, int code) { int j; tree t; @@ -6050,11 +6042,7 @@ ffecom_get_external_identifier_ (ffesymbol s) if (!ffe_is_underscoring () || (strcmp (name, FFETARGET_nameBLANK_COMMON) == 0) -#if FFETARGET_isENFORCED_MAIN_NAME - || (strcmp (name, FFETARGET_nameENFORCED_NAME) == 0) -#else || (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0) -#endif || (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0)) return get_identifier (name); @@ -6112,8 +6100,7 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) tree result; bool charfunc = (bt == FFEINFO_basictypeCHARACTER); static bool recurse = FALSE; - int old_lineno = lineno; - const char *old_input_filename = input_filename; + location_t old_loc = input_location; ffecom_nested_entry_ = s; @@ -6126,7 +6113,7 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) see how it works at this point. */ input_filename = ffesymbol_where_filename (s); - lineno = ffesymbol_where_filelinenum (s); + input_line = ffesymbol_where_filelinenum (s); /* Pretransform the expression so any newly discovered things belong to the outer program unit, not to the statement function. */ @@ -6223,8 +6210,7 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) recurse = FALSE; - lineno = old_lineno; - input_filename = old_input_filename; + input_location = old_loc; ffecom_nested_entry_ = NULL; @@ -6304,7 +6290,7 @@ ffecom_init_zero_ (tree decl) init = convert (type, integer_zero_node); else if (!incremental) { - init = build (CONSTRUCTOR, type, NULL_TREE, NULL_TREE); + init = build_constructor (type, NULL_TREE); TREE_CONSTANT (init) = 1; TREE_STATIC (init) = 1; } @@ -6318,8 +6304,7 @@ ffecom_init_zero_ (tree decl) } static tree -ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, - tree *maybe_tree) +ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, tree *maybe_tree) { tree expr_tree; tree length_tree; @@ -7062,7 +7047,7 @@ ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc) equivalent of a Fortran program unit. */ static void -ffecom_start_progunit_ () +ffecom_start_progunit_ (void) { ffesymbol fn = ffecom_primary_entry_; ffebld arglist; @@ -7082,14 +7067,13 @@ ffecom_start_progunit_ () && (ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION) && (ffecom_master_bt_ == FFEINFO_basictypeNONE); bool main_program = FALSE; - int old_lineno = lineno; - const char *old_input_filename = input_filename; + location_t old_loc = input_location; assert (fn != NULL); assert (ffesymbol_hook (fn).decl_tree == NULL_TREE); input_filename = ffesymbol_where_filename (fn); - lineno = ffesymbol_where_filelinenum (fn); + input_line = ffesymbol_where_filelinenum (fn); switch (ffecom_primary_entry_kind_) { @@ -7271,8 +7255,7 @@ ffecom_start_progunit_ () /* Disallow temp vars at this level. */ current_binding_level->prep_state = 2; - lineno = old_lineno; - input_filename = old_input_filename; + input_location = old_loc; /* This handles any symbols still untransformed, in case -g specified. This used to be done in ffecom_finish_progunit, but it turns out to @@ -7300,8 +7283,7 @@ ffecom_sym_transform_ (ffesymbol s) ffeinfoBasictype bt; ffeinfoKindtype kt; ffeglobal g; - int old_lineno = lineno; - const char *old_input_filename = input_filename; + location_t old_loc = input_location; /* Must ensure special ASSIGN variables are declared at top of outermost block, else they'll end up in the innermost block when their first @@ -7320,14 +7302,14 @@ ffecom_sym_transform_ (ffesymbol s) if (ffesymbol_sfdummyparent (s) == NULL) { input_filename = ffesymbol_where_filename (s); - lineno = ffesymbol_where_filelinenum (s); + input_line = ffesymbol_where_filelinenum (s); } else { ffesymbol sf = ffesymbol_sfdummyparent (s); input_filename = ffesymbol_where_filename (sf); - lineno = ffesymbol_where_filelinenum (sf); + input_line = ffesymbol_where_filelinenum (sf); } bt = ffeinfo_basictype (ffebld_info (s)); @@ -7416,16 +7398,16 @@ ffecom_sym_transform_ (ffesymbol s) ffestorag st = ffesymbol_storage (s); tree type; - if ((st != NULL) - && (ffestorag_size (st) == 0)) + type = ffecom_type_localvar_ (s, bt, kt); + + if (type == error_mark_node) { t = error_mark_node; break; } - type = ffecom_type_localvar_ (s, bt, kt); - - if (type == error_mark_node) + if ((st != NULL) + && (ffestorag_size (st) == 0)) { t = error_mark_node; break; @@ -7939,6 +7921,7 @@ ffecom_sym_transform_ (ffesymbol s) { ffetargetOffset offset; ffestorag cst; + tree toffset; cst = ffestorag_parent (st); assert (cst == ffesymbol_storage (cs)); @@ -7955,9 +7938,10 @@ ffecom_sym_transform_ (ffesymbol s) ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (ct)), ct)); + toffset = build_int_2 (offset, 0); + TREE_TYPE (toffset) = ssizetype; t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t), - t, - build_int_2 (offset, 0)); + t, toffset); t = convert (build_pointer_type (type), t); TREE_CONSTANT (t) = 1; @@ -8296,8 +8280,7 @@ ffecom_sym_transform_ (ffesymbol s) ffesymbol_hook (s).length_tree = tlen; ffesymbol_hook (s).addr = addr; - lineno = old_lineno; - input_filename = old_input_filename; + input_location = old_loc; return s; } @@ -8314,20 +8297,19 @@ static ffesymbol ffecom_sym_transform_assign_ (ffesymbol s) { tree t; /* Transformed thingy. */ - int old_lineno = lineno; - const char *old_input_filename = input_filename; + location_t old_loc = input_location; if (ffesymbol_sfdummyparent (s) == NULL) { input_filename = ffesymbol_where_filename (s); - lineno = ffesymbol_where_filelinenum (s); + input_line = ffesymbol_where_filelinenum (s); } else { ffesymbol sf = ffesymbol_sfdummyparent (s); input_filename = ffesymbol_where_filename (sf); - lineno = ffesymbol_where_filelinenum (sf); + input_line = ffesymbol_where_filelinenum (sf); } assert (!ffecom_transform_only_dummies_); @@ -8377,8 +8359,7 @@ ffecom_sym_transform_assign_ (ffesymbol s) ffesymbol_hook (s).assign_tree = t; - lineno = old_lineno; - input_filename = old_input_filename; + input_location = old_loc; return s; } @@ -8763,7 +8744,7 @@ ffecom_transform_namelist_ (ffesymbol s) TREE_CHAIN (TREE_CHAIN (nmlinits)) = build_tree_list ((field = TREE_CHAIN (field)), nvarsinit); - nmlinits = build (CONSTRUCTOR, nmltype, NULL_TREE, nmlinits); + nmlinits = build_constructor (nmltype, nmlinits); TREE_CONSTANT (nmlinits) = 1; TREE_STATIC (nmlinits) = 1; @@ -8780,8 +8761,7 @@ ffecom_transform_namelist_ (ffesymbol s) taking into account different units of measurements for offsets. */ static void -ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, - tree t) +ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, tree t) { switch (TREE_CODE (t)) { @@ -8866,8 +8846,7 @@ ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, reveal the overlap. */ static void -ffecom_tree_canonize_ref_ (tree *decl, tree *offset, - tree *size, tree t) +ffecom_tree_canonize_ref_ (tree *decl, tree *offset, tree *size, tree t) { /* The default path is to report a nonexistant decl. */ *decl = NULL_TREE; @@ -8906,7 +8885,6 @@ ffecom_tree_canonize_ref_ (tree *decl, tree *offset, case MIN_EXPR: case MAX_EXPR: case ABS_EXPR: - case FFS_EXPR: case LSHIFT_EXPR: case RSHIFT_EXPR: case LROTATE_EXPR: @@ -8914,7 +8892,6 @@ ffecom_tree_canonize_ref_ (tree *decl, tree *offset, case BIT_IOR_EXPR: case BIT_XOR_EXPR: case BIT_AND_EXPR: - case BIT_ANDTC_EXPR: case BIT_NOT_EXPR: case TRUTH_ANDIF_EXPR: case TRUTH_ORIF_EXPR: @@ -9020,9 +8997,8 @@ ffecom_tree_canonize_ref_ (tree *decl, tree *offset, /* Do divide operation appropriate to type of operands. */ static tree -ffecom_tree_divide_ (tree tree_type, tree left, tree right, - tree dest_tree, ffebld dest, bool *dest_used, - tree hook) +ffecom_tree_divide_ (tree tree_type, tree left, tree right, tree dest_tree, + ffebld dest, bool *dest_used, tree hook) { if ((left == error_mark_node) || (right == error_mark_node)) @@ -9109,8 +9085,7 @@ ffecom_tree_divide_ (tree tree_type, tree left, tree right, /* Build type info for non-dummy variable. */ static tree -ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, - ffeinfoKindtype kt) +ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) { tree type; ffebld dl; @@ -9168,7 +9143,7 @@ ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, static GTY(()) tree ffecom_type_namelist_var; static tree -ffecom_type_namelist_ () +ffecom_type_namelist_ (void) { if (ffecom_type_namelist_var == NULL_TREE) { @@ -9199,7 +9174,7 @@ ffecom_type_namelist_ () static GTY(()) tree ffecom_type_vardesc_var; static tree -ffecom_type_vardesc_ () +ffecom_type_vardesc_ (void) { if (ffecom_type_vardesc_var == NULL_TREE) { @@ -9298,7 +9273,7 @@ ffecom_vardesc_ (ffebld expr) TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (varinits))) = build_tree_list ((field = TREE_CHAIN (field)), typeinit); - varinits = build (CONSTRUCTOR, vardesctype, NULL_TREE, varinits); + varinits = build_constructor (vardesctype, varinits); TREE_CONSTANT (varinits) = 1; TREE_STATIC (varinits) = 1; @@ -9343,7 +9318,7 @@ ffecom_vardesc_array_ (ffesymbol s) build_range_type (integer_type_node, integer_one_node, build_int_2 (i, 0))); - list = build (CONSTRUCTOR, item, NULL_TREE, list); + list = build_constructor (item, list); TREE_CONSTANT (list) = 1; TREE_STATIC (list) = 1; @@ -9449,7 +9424,7 @@ ffecom_vardesc_dims_ (ffesymbol s) build_int_2 ((int) ffesymbol_rank (s) + 2, 0))); - list = build (CONSTRUCTOR, item, NULL_TREE, numdim); + list = build_constructor (item, numdim); TREE_CONSTANT (list) = 1; TREE_STATIC (list) = 1; @@ -9563,8 +9538,7 @@ ffecom_1_fn (tree node) checking for certain housekeeping things. */ tree -ffecom_2 (enum tree_code code, tree type, tree node1, - tree node2) +ffecom_2 (enum tree_code code, tree type, tree node1, tree node2) { tree item; @@ -9584,7 +9558,7 @@ ffecom_2 (enum tree_code code, tree type, tree node1, case COMPLEX_EXPR: item = build_tree_list (TYPE_FIELDS (type), node1); TREE_CHAIN (item) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), node2); - item = build (CONSTRUCTOR, type, NULL_TREE, item); + item = build_constructor (type, item); break; case PLUS_EXPR: @@ -9919,8 +9893,7 @@ ffecom_2pass_do_entrypoint (ffesymbol entry) TREE_SIDE_EFFECTS. */ tree -ffecom_2s (enum tree_code code, tree type, tree node1, - tree node2) +ffecom_2s (enum tree_code code, tree type, tree node1, tree node2) { tree item; @@ -9938,8 +9911,7 @@ ffecom_2s (enum tree_code code, tree type, tree node1, checking for certain housekeeping things. */ tree -ffecom_3 (enum tree_code code, tree type, tree node1, - tree node2, tree node3) +ffecom_3 (enum tree_code code, tree type, tree node1, tree node2, tree node3) { tree item; @@ -9961,8 +9933,7 @@ ffecom_3 (enum tree_code code, tree type, tree node1, TREE_SIDE_EFFECTS. */ tree -ffecom_3s (enum tree_code code, tree type, tree node1, - tree node2, tree node3) +ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3) { tree item; @@ -10122,9 +10093,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) case FFEBLD_opPERCENT_DESCR: switch (ffeinfo_basictype (ffebld_info (expr))) { -#ifdef PASS_HOLLERITH_BY_DESCRIPTOR - case FFEINFO_basictypeHOLLERITH: -#endif case FFEINFO_basictypeCHARACTER: break; /* Passed by descriptor anyway. */ @@ -10140,21 +10108,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) break; } -#ifdef PASS_HOLLERITH_BY_DESCRIPTOR - if ((ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH) - && (length != NULL)) - { /* Pass Hollerith by descriptor. */ - ffetargetHollerith h; - - assert (ffebld_op (expr) == FFEBLD_opCONTER); - h = ffebld_cu_val_hollerith (ffebld_constant_union - (ffebld_conter (expr))); - *length - = build_int_2 (h.length, 0); - TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node; - } -#endif - if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) return ffecom_ptr_to_expr (expr); @@ -10336,31 +10289,43 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, { case FFEINFO_basictypeINTEGER: { - int val; + HOST_WIDE_INT hi, lo; switch (kt) { #if FFETARGET_okINTEGER1 case FFEINFO_kindtypeINTEGER1: - val = ffebld_cu_val_integer1 (*cu); + lo = ffebld_cu_val_integer1 (*cu); + hi = (lo < 0) ? -1 : 0; break; #endif #if FFETARGET_okINTEGER2 case FFEINFO_kindtypeINTEGER2: - val = ffebld_cu_val_integer2 (*cu); + lo = ffebld_cu_val_integer2 (*cu); + hi = (lo < 0) ? -1 : 0; break; #endif #if FFETARGET_okINTEGER3 case FFEINFO_kindtypeINTEGER3: - val = ffebld_cu_val_integer3 (*cu); + lo = ffebld_cu_val_integer3 (*cu); + hi = (lo < 0) ? -1 : 0; break; #endif #if FFETARGET_okINTEGER4 case FFEINFO_kindtypeINTEGER4: - val = ffebld_cu_val_integer4 (*cu); +#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT + { + long long int big = ffebld_cu_val_integer4 (*cu); + hi = (HOST_WIDE_INT) (big >> HOST_BITS_PER_WIDE_INT); + lo = (HOST_WIDE_INT) big; + } +#else + lo = ffebld_cu_val_integer4 (*cu); + hi = (lo < 0) ? -1 : 0; +#endif break; #endif @@ -10370,7 +10335,7 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, case FFEINFO_kindtypeANY: return error_mark_node; } - item = build_int_2 (val, (val < 0) ? -1 : 0); + item = build_int_2 (lo, hi); TREE_TYPE (item) = tree_type; } break; @@ -10440,12 +10405,6 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - val = ffetarget_value_real4 (ffebld_cu_val_real4 (*cu)); - break; -#endif - default: assert ("bad REAL constant kind type" == NULL); /* Fall through. */ @@ -10485,13 +10444,6 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - real = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).real); - imag = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).imaginary); - break; -#endif - default: assert ("bad REAL constant kind type" == NULL); /* Fall through. */ @@ -10596,8 +10548,8 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, /* Transform constant-union to tree, with the type known. */ tree -ffecom_constantunion_with_type (ffebldConstantUnion *cu, - tree tree_type, ffebldConst ct) +ffecom_constantunion_with_type (ffebldConstantUnion *cu, tree tree_type, + ffebldConst ct) { tree item; @@ -10607,7 +10559,7 @@ ffecom_constantunion_with_type (ffebldConstantUnion *cu, { #if FFETARGET_okINTEGER1 case FFEBLD_constINTEGER1: - val = ffebld_cu_val_integer1 (*cu); + val = ffebld_cu_val_integer1 (*cu); item = build_int_2 (val, (val < 0) ? -1 : 0); break; #endif @@ -10625,8 +10577,17 @@ ffecom_constantunion_with_type (ffebldConstantUnion *cu, #endif #if FFETARGET_okINTEGER4 case FFEBLD_constINTEGER4: +#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT + { + long long int big = ffebld_cu_val_integer4 (*cu); + item = build_int_2 ((HOST_WIDE_INT) big, + (HOST_WIDE_INT) + (big >> HOST_BITS_PER_WIDE_INT)); + } +#else val = ffebld_cu_val_integer4 (*cu); item = build_int_2 (val, (val < 0) ? -1 : 0); +#endif break; #endif #if FFETARGET_okLOGICAL1 @@ -10685,10 +10646,6 @@ ffecom_const_expr (ffebld expr) if (ffebld_arity (expr) == 0 && (ffebld_op (expr) != FFEBLD_opSYMTER -#if NEWCOMMON - /* ~~Enable once common/equivalence is handled properly? */ - || ffebld_where (expr) == FFEINFO_whereCOMMON -#endif || ffebld_where (expr) == FFEINFO_whereGLOBAL || ffebld_where (expr) == FFEINFO_whereINTRINSIC)) { @@ -10705,8 +10662,7 @@ ffecom_const_expr (ffebld expr) /* Handy way to make a field in a struct/union. */ tree -ffecom_decl_field (tree context, tree prevfield, - const char *name, tree type) +ffecom_decl_field (tree context, tree prevfield, const char *name, tree type) { tree field; @@ -10726,12 +10682,6 @@ ffecom_close_include (FILE *f) ffecom_close_include_ (f); } -int -ffecom_decode_include_option (char *spec) -{ - return ffecom_decode_include_option_ (spec); -} - /* End a compound statement (block). */ tree @@ -10747,7 +10697,7 @@ ffecom_end_compstmt (void) Calls ffecom_sym_end_transition for each global and local symbol. */ void -ffecom_end_transition () +ffecom_end_transition (void) { ffebld item; @@ -10823,7 +10773,7 @@ ffecom_end_transition () Make sure error updating not inhibited. */ void -ffecom_exec_transition () +ffecom_exec_transition (void) { bool inhibited; @@ -10920,16 +10870,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) expr_tree = source_tree; else if (assign_temp) { -#ifdef MOVE_EXPR - /* The back end understands a conceptual move (evaluate source; - store into dest), so use that, in case it can determine - that it is going to use, say, two registers as temporaries - anyway. So don't use the temp (and someday avoid generating - it, once this code starts triggering regularly). */ - expr_tree = ffecom_2s (MOVE_EXPR, void_type_node, - dest_tree, - source_tree); -#else expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, assign_temp, source_tree); @@ -10937,7 +10877,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, dest_tree, assign_temp); -#endif } else expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, @@ -11024,7 +10963,7 @@ ffecom_expr_w (tree type, ffebld expr) /* Do global stuff. */ void -ffecom_finish_compile () +ffecom_finish_compile (void) { assert (ffecom_outer_function_decl_ == NULL_TREE); assert (current_function_decl == NULL_TREE); @@ -11044,7 +10983,7 @@ ffecom_finish_decl (tree decl, tree init, bool is_top_level) /* Finish a program unit. */ void -ffecom_finish_progunit () +ffecom_finish_progunit (void) { ffecom_end_compstmt (); @@ -11168,7 +11107,7 @@ ffecom_gfrt_kindtype (ffecomGfrt gfrt) } void -ffecom_init_0 () +ffecom_init_0 (void) { tree endlink; int i; @@ -11177,9 +11116,9 @@ ffecom_init_0 () tree field; ffetype type; ffetype base_type; - tree double_ftype_double; - tree float_ftype_float; - tree ldouble_ftype_ldouble; + tree double_ftype_double, double_ftype_double_double; + tree float_ftype_float, float_ftype_float_float; + tree ldouble_ftype_ldouble, ldouble_ftype_ldouble_ldouble; tree ffecom_tree_ptr_to_fun_type_void; /* This block of code comes from the now-obsolete cktyps.c. It checks @@ -11312,18 +11251,21 @@ ffecom_init_0 () endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE); - float_ftype_float - = build_function_type (float_type_node, - tree_cons (NULL_TREE, float_type_node, endlink)); + t = tree_cons (NULL_TREE, float_type_node, endlink); + float_ftype_float = build_function_type (float_type_node, t); + t = tree_cons (NULL_TREE, float_type_node, t); + float_ftype_float_float = build_function_type (float_type_node, t); - double_ftype_double - = build_function_type (double_type_node, - tree_cons (NULL_TREE, double_type_node, endlink)); + t = tree_cons (NULL_TREE, double_type_node, endlink); + double_ftype_double = build_function_type (double_type_node, t); + t = tree_cons (NULL_TREE, double_type_node, t); + double_ftype_double_double = build_function_type (double_type_node, t); - ldouble_ftype_ldouble - = build_function_type (long_double_type_node, - tree_cons (NULL_TREE, long_double_type_node, - endlink)); + t = tree_cons (NULL_TREE, long_double_type_node, endlink); + ldouble_ftype_ldouble = build_function_type (long_double_type_node, t); + t = tree_cons (NULL_TREE, long_double_type_node, t); + ldouble_ftype_ldouble_ldouble = build_function_type (long_double_type_node, + t); for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i) for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j) @@ -11740,18 +11682,20 @@ ffecom_init_0 () ffecom_tree_blockdata_type = build_function_type (void_type_node, NULL_TREE); - builtin_function ("__builtin_sqrtf", float_ftype_float, - BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf", NULL_TREE); - builtin_function ("__builtin_sqrt", double_ftype_double, - BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt", NULL_TREE); - builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble, - BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl", NULL_TREE); - builtin_function ("__builtin_sinf", float_ftype_float, - BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf", NULL_TREE); - builtin_function ("__builtin_sin", double_ftype_double, - BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", NULL_TREE); - builtin_function ("__builtin_sinl", ldouble_ftype_ldouble, - BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl", NULL_TREE); + builtin_function ("__builtin_atanf", float_ftype_float, + BUILT_IN_ATANF, BUILT_IN_NORMAL, "atanf", NULL_TREE); + builtin_function ("__builtin_atan", double_ftype_double, + BUILT_IN_ATAN, BUILT_IN_NORMAL, "atan", NULL_TREE); + builtin_function ("__builtin_atanl", ldouble_ftype_ldouble, + BUILT_IN_ATANL, BUILT_IN_NORMAL, "atanl", NULL_TREE); + + builtin_function ("__builtin_atan2f", float_ftype_float_float, + BUILT_IN_ATAN2F, BUILT_IN_NORMAL, "atan2f", NULL_TREE); + builtin_function ("__builtin_atan2", double_ftype_double_double, + BUILT_IN_ATAN2, BUILT_IN_NORMAL, "atan2", NULL_TREE); + builtin_function ("__builtin_atan2l", ldouble_ftype_ldouble_ldouble, + BUILT_IN_ATAN2L, BUILT_IN_NORMAL, "atan2l", NULL_TREE); + builtin_function ("__builtin_cosf", float_ftype_float, BUILT_IN_COSF, BUILT_IN_NORMAL, "cosf", NULL_TREE); builtin_function ("__builtin_cos", double_ftype_double, @@ -11759,6 +11703,62 @@ ffecom_init_0 () builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, BUILT_IN_COSL, BUILT_IN_NORMAL, "cosl", NULL_TREE); + builtin_function ("__builtin_expf", float_ftype_float, + BUILT_IN_EXPF, BUILT_IN_NORMAL, "expf", NULL_TREE); + builtin_function ("__builtin_exp", double_ftype_double, + BUILT_IN_EXP, BUILT_IN_NORMAL, "exp", NULL_TREE); + builtin_function ("__builtin_expl", ldouble_ftype_ldouble, + BUILT_IN_EXPL, BUILT_IN_NORMAL, "expl", NULL_TREE); + + builtin_function ("__builtin_floorf", float_ftype_float, + BUILT_IN_FLOORF, BUILT_IN_NORMAL, "floorf", NULL_TREE); + builtin_function ("__builtin_floor", double_ftype_double, + BUILT_IN_FLOOR, BUILT_IN_NORMAL, "floor", NULL_TREE); + builtin_function ("__builtin_floorl", ldouble_ftype_ldouble, + BUILT_IN_FLOORL, BUILT_IN_NORMAL, "floorl", NULL_TREE); + + builtin_function ("__builtin_fmodf", float_ftype_float_float, + BUILT_IN_FMODF, BUILT_IN_NORMAL, "fmodf", NULL_TREE); + builtin_function ("__builtin_fmod", double_ftype_double_double, + BUILT_IN_FMOD, BUILT_IN_NORMAL, "fmod", NULL_TREE); + builtin_function ("__builtin_fmodl", ldouble_ftype_ldouble_ldouble, + BUILT_IN_FMODL, BUILT_IN_NORMAL, "fmodl", NULL_TREE); + + builtin_function ("__builtin_logf", float_ftype_float, + BUILT_IN_LOGF, BUILT_IN_NORMAL, "logf", NULL_TREE); + builtin_function ("__builtin_log", double_ftype_double, + BUILT_IN_LOG, BUILT_IN_NORMAL, "log", NULL_TREE); + builtin_function ("__builtin_logl", ldouble_ftype_ldouble, + BUILT_IN_LOGL, BUILT_IN_NORMAL, "logl", NULL_TREE); + + builtin_function ("__builtin_powf", float_ftype_float_float, + BUILT_IN_POWF, BUILT_IN_NORMAL, "powf", NULL_TREE); + builtin_function ("__builtin_pow", double_ftype_double_double, + BUILT_IN_POW, BUILT_IN_NORMAL, "pow", NULL_TREE); + builtin_function ("__builtin_powl", ldouble_ftype_ldouble_ldouble, + BUILT_IN_POWL, BUILT_IN_NORMAL, "powl", NULL_TREE); + + builtin_function ("__builtin_sinf", float_ftype_float, + BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf", NULL_TREE); + builtin_function ("__builtin_sin", double_ftype_double, + BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", NULL_TREE); + builtin_function ("__builtin_sinl", ldouble_ftype_ldouble, + BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl", NULL_TREE); + + builtin_function ("__builtin_sqrtf", float_ftype_float, + BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf", NULL_TREE); + builtin_function ("__builtin_sqrt", double_ftype_double, + BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt", NULL_TREE); + builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble, + BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl", NULL_TREE); + + builtin_function ("__builtin_tanf", float_ftype_float, + BUILT_IN_TANF, BUILT_IN_NORMAL, "tanf", NULL_TREE); + builtin_function ("__builtin_tan", double_ftype_double, + BUILT_IN_TAN, BUILT_IN_NORMAL, "tan", NULL_TREE); + builtin_function ("__builtin_tanl", ldouble_ftype_ldouble, + BUILT_IN_TANL, BUILT_IN_NORMAL, "tanl", NULL_TREE); + pedantic_lvalues = FALSE; ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node, @@ -11818,13 +11818,8 @@ ffecom_init_0 () ffecom_float_zero_ = build_real (float_type_node, dconst0); ffecom_double_zero_ = build_real (double_type_node, dconst0); - { - REAL_VALUE_TYPE point_5; - - REAL_ARITHMETIC (point_5, RDIV_EXPR, dconst1, dconst2); - ffecom_float_half_ = build_real (float_type_node, point_5); - ffecom_double_half_ = build_real (double_type_node, point_5); - } + ffecom_float_half_ = build_real (float_type_node, dconsthalf); + ffecom_double_half_ = build_real (double_type_node, dconsthalf); /* Do "extern int xargc;". */ @@ -11875,7 +11870,7 @@ ffecom_init_0 () ffecom_init_2(); */ void -ffecom_init_2 () +ffecom_init_2 (void) { assert (ffecom_outer_function_decl_ == NULL_TREE); assert (current_function_decl == NULL_TREE); @@ -12035,8 +12030,7 @@ ffecom_lookup_label (ffelab label) the MODIFY_EXPR. */ tree -ffecom_modify (tree newtype, tree lhs, - tree rhs) +ffecom_modify (tree newtype, tree lhs, tree rhs) { if (lhs == error_mark_node || rhs == error_mark_node) return error_mark_node; @@ -12978,7 +12972,7 @@ ffecom_sym_retract (ffesymbol s UNUSED) /* Create temporary gcc label. */ tree -ffecom_temp_label () +ffecom_temp_label (void) { tree glabel; static int mynumber = 0; @@ -13092,7 +13086,7 @@ ffecom_type_expr (ffebld expr) first ENTRY statement, and so on). */ tree -ffecom_which_entrypoint_decl () +ffecom_which_entrypoint_decl (void) { assert (ffecom_which_entrypoint_decl_ != NULL_TREE); @@ -13115,16 +13109,16 @@ ffecom_which_entrypoint_decl () "bison_rule_foo_" so they are easy to find. */ static void -bison_rule_pushlevel_ () +bison_rule_pushlevel_ (void) { - emit_line_note (input_filename, lineno); + emit_line_note (input_location); pushlevel (0); clear_last_expr (); expand_start_bindings (0); } static tree -bison_rule_compstmt_ () +bison_rule_compstmt_ (void) { tree t; int keep = kept_level_p (); @@ -13133,7 +13127,7 @@ bison_rule_compstmt_ () if (! keep) current_binding_level->names = NULL_TREE; - emit_line_note (input_filename, lineno); + emit_line_note (input_location); expand_end_bindings (getdecls (), keep, 0); t = poplevel (keep, 1, 0); @@ -13151,8 +13145,7 @@ bison_rule_compstmt_ () tree builtin_function (const char *name, tree type, int function_code, - enum built_in_class class, - const char *library_name, + enum built_in_class class, const char *library_name, tree attrs ATTRIBUTE_UNUSED) { tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); @@ -13294,9 +13287,6 @@ duplicate_decls (tree newdecl, tree olddecl) COPY_DECL_RTL (olddecl, newdecl); /* Merge the type qualifiers. */ - if (DECL_BUILT_IN_NONANSI (olddecl) && TREE_THIS_VOLATILE (olddecl) - && !TREE_THIS_VOLATILE (newdecl)) - TREE_THIS_VOLATILE (olddecl) = 0; if (TREE_READONLY (newdecl)) TREE_READONLY (olddecl) = 1; if (TREE_THIS_VOLATILE (newdecl)) @@ -13311,8 +13301,7 @@ duplicate_decls (tree newdecl, tree olddecl) if ((DECL_INITIAL (newdecl) == 0 && DECL_INITIAL (olddecl) != 0) || (DECL_CONTEXT (newdecl) != 0 && DECL_CONTEXT (olddecl) == 0)) { - DECL_SOURCE_LINE (newdecl) = DECL_SOURCE_LINE (olddecl); - DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (olddecl); + DECL_SOURCE_LOCATION (newdecl) = DECL_SOURCE_LOCATION (olddecl); if (DECL_CONTEXT (olddecl) == 0 && TREE_CODE (newdecl) != FUNCTION_DECL) @@ -13336,10 +13325,17 @@ duplicate_decls (tree newdecl, tree olddecl) if (DECL_SECTION_NAME (newdecl) == NULL_TREE) DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl); + /* Copy the assembler name. */ + COPY_DECL_ASSEMBLER_NAME (olddecl, newdecl); + if (TREE_CODE (newdecl) == FUNCTION_DECL) { DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl); DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl); + TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl); + TREE_READONLY (newdecl) |= TREE_READONLY (olddecl); + DECL_IS_MALLOC (newdecl) |= DECL_IS_MALLOC (olddecl); + DECL_IS_PURE (newdecl) |= DECL_IS_PURE (olddecl); } } /* If cannot merge, then use the new type and qualifiers, @@ -13586,7 +13582,7 @@ finish_function (int nested) /* Obey `register' declarations if `setjmp' is called in this fn. */ /* Generate rtl for function exit. */ - expand_function_end (input_filename, lineno, 0); + expand_function_end (); /* If this is a nested function, protect the local variables in the stack above us from being collected while we're compiling this function. */ @@ -13724,7 +13720,7 @@ lookup_name_current_level (tree name) /* Create a new `struct f_binding_level'. */ static struct f_binding_level * -make_binding_level () +make_binding_level (void) { /* NOSTRICT */ return ggc_alloc (sizeof (struct f_binding_level)); @@ -13747,7 +13743,7 @@ struct f_function *f_function_chain; /* Restore the variables used during compilation of a C function. */ static void -pop_f_function_context () +pop_f_function_context (void) { struct f_function *p = f_function_chain; tree link; @@ -13783,10 +13779,9 @@ pop_f_function_context () used during compilation of a C function. */ static void -push_f_function_context () +push_f_function_context (void) { - struct f_function *p - = (struct f_function *) xmalloc (sizeof (struct f_function)); + struct f_function *p = xmalloc (sizeof (struct f_function)); push_function_context (); @@ -13823,8 +13818,7 @@ push_parm_decl (tree parm) /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL, if appropriate. */ static tree -pushdecl_top_level (x) - tree x; +pushdecl_top_level (tree x) { register tree t; register struct f_binding_level *b = current_binding_level; @@ -13843,8 +13837,7 @@ pushdecl_top_level (x) after they are modified in the light of any missing parameters. */ static tree -storedecls (decls) - tree decls; +storedecls (tree decls) { return current_binding_level->names = decls; } @@ -13868,11 +13861,9 @@ store_parm_decls (int is_main_program UNUSED) DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ())); /* Initialize the RTL code for the function. */ - - init_function_start (fndecl, input_filename, lineno); + init_function_start (fndecl); /* Set up parameters and prepare for return, for the function. */ - expand_function_start (fndecl, 0); } @@ -14008,8 +13999,7 @@ start_function (tree name, tree type, int nested, int public) /* Here are the public functions the GNU back end needs. */ tree -convert (type, expr) - tree type, expr; +convert (tree type, tree expr) { register tree e = expr; register enum tree_code code = TREE_CODE (type); @@ -14054,7 +14044,7 @@ convert (type, expr) store the result back using `storedecls' or you will lose. */ tree -getdecls () +getdecls (void) { return current_binding_level->names; } @@ -14062,13 +14052,13 @@ getdecls () /* Nonzero if we are currently in the global binding level. */ int -global_bindings_p () +global_bindings_p (void) { return current_binding_level == global_binding_level; } static void -ffecom_init_decl_processing () +ffecom_init_decl_processing (void) { malloc_init (); @@ -14080,8 +14070,7 @@ ffecom_init_decl_processing () so that the block can be reinserted where appropriate. */ static void -delete_block (block) - tree block; +delete_block (tree block) { tree t; if (current_binding_level->blocks == block) @@ -14100,8 +14089,7 @@ delete_block (block) } void -insert_block (block) - tree block; +insert_block (tree block) { TREE_USED (block) = 1; current_binding_level->blocks @@ -14109,10 +14097,10 @@ insert_block (block) } /* Each front end provides its own. */ -static const char *ffe_init PARAMS ((const char *)); -static void ffe_finish PARAMS ((void)); -static void ffe_init_options PARAMS ((void)); -static void ffe_print_identifier PARAMS ((FILE *, tree, int)); +static bool ffe_init (void); +static void ffe_finish (void); +static bool ffe_post_options (const char **); +static void ffe_print_identifier (FILE *, tree, int); struct language_function GTY(()) { @@ -14127,8 +14115,10 @@ struct language_function GTY(()) #define LANG_HOOKS_FINISH ffe_finish #undef LANG_HOOKS_INIT_OPTIONS #define LANG_HOOKS_INIT_OPTIONS ffe_init_options -#undef LANG_HOOKS_DECODE_OPTION -#define LANG_HOOKS_DECODE_OPTION ffe_decode_option +#undef LANG_HOOKS_HANDLE_OPTION +#define LANG_HOOKS_HANDLE_OPTION ffe_handle_option +#undef LANG_HOOKS_POST_OPTIONS +#define LANG_HOOKS_POST_OPTIONS ffe_post_options #undef LANG_HOOKS_PARSE_FILE #define LANG_HOOKS_PARSE_FILE ffe_parse_file #undef LANG_HOOKS_MARK_ADDRESSABLE @@ -14194,10 +14184,11 @@ const char *const tree_code_name[] = { }; #undef DEFTREECODE -static const char * -ffe_init (filename) - const char *filename; +static bool +ffe_post_options (const char **pfilename) { + const char *filename = *pfilename; + /* Open input file. */ if (filename == 0 || !strcmp (filename, "-")) { @@ -14206,11 +14197,19 @@ ffe_init (filename) } else finput = fopen (filename, "r"); + if (finput == 0) - fatal_io_error ("can't open %s", filename); + fatal_error ("can't open %s: %m", filename); + + return false; +} + +static bool +ffe_init (void) +{ #ifdef IO_BUFFER_SIZE - setvbuf (finput, (char *) xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE); + setvbuf (finput, xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE); #endif ffecom_init_decl_processing (); @@ -14223,16 +14222,15 @@ ffe_init (filename) to try doing this. */ ffelex_hash_kludge (finput); - /* FIXME: The ffelex_hash_kludge code needs to be cleaned up to - return the new file name. */ - if (main_input_filename) - filename = main_input_filename; + push_srcloc (input_filename, 0); - return filename; + /* FIXME: The ffelex_hash_kludge code needs to be cleaned up to + set the new file name. Maybe in ffe_post_options. */ + return true; } static void -ffe_finish () +ffe_finish (void) { ffe_terminate_0 (); @@ -14242,21 +14240,8 @@ ffe_finish () fclose (finput); } -static void -ffe_init_options () -{ - /* Set default options for Fortran. */ - flag_move_all_movables = 1; - flag_reduce_all_givs = 1; - flag_argument_noalias = 2; - flag_merge_constants = 2; - flag_errno_math = 0; - flag_complex_divide_method = 1; -} - static bool -ffe_mark_addressable (exp) - tree exp; +ffe_mark_addressable (tree exp) { register tree x = exp; while (1) @@ -14326,10 +14311,7 @@ ffe_mark_addressable (exp) them into the BLOCK. */ tree -poplevel (keep, reverse, functionbody) - int keep; - int reverse; - int functionbody; +poplevel (int keep, int reverse, int functionbody) { register tree link; /* The chain of decls was accumulated in reverse order. @@ -14465,10 +14447,7 @@ poplevel (keep, reverse, functionbody) } static void -ffe_print_identifier (file, node, indent) - FILE *file; - tree node; - int indent; +ffe_print_identifier (FILE *file, tree node, int indent) { print_node (file, "global", IDENTIFIER_GLOBAL_VALUE (node), indent + 4); print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4); @@ -14483,8 +14462,7 @@ ffe_print_identifier (file, node, indent) to agree with what X says. */ tree -pushdecl (x) - tree x; +pushdecl (tree x) { register tree t; register tree name = DECL_NAME (x); @@ -14594,7 +14572,7 @@ pushdecl (x) /* Nonzero if the current level needs to have a BLOCK made. */ static int -kept_level_p () +kept_level_p (void) { tree decl; @@ -14617,8 +14595,7 @@ kept_level_p () not for that of tags. */ void -pushlevel (tag_transparent) - int tag_transparent; +pushlevel (int tag_transparent) { register struct f_binding_level *newlevel = NULL_BINDING_LEVEL; @@ -14653,8 +14630,7 @@ pushlevel (tag_transparent) (the one we are currently in). */ void -set_block (block) - register tree block; +set_block (tree block) { current_binding_level->this_block = block; current_binding_level->names = chainon (current_binding_level->names, @@ -14664,9 +14640,7 @@ set_block (block) } static tree -ffe_signed_or_unsigned_type (unsignedp, type) - int unsignedp; - tree type; +ffe_signed_or_unsigned_type (int unsignedp, tree type) { tree type2; @@ -14692,8 +14666,7 @@ ffe_signed_or_unsigned_type (unsignedp, type) } static tree -ffe_signed_type (type) - tree type; +ffe_signed_type (tree type) { tree type1 = TYPE_MAIN_VARIANT (type); ffeinfoKindtype kt; @@ -14747,8 +14720,7 @@ ffe_signed_type (type) The resulting type should always be `integer_type_node'. */ static tree -ffe_truthvalue_conversion (expr) - tree expr; +ffe_truthvalue_conversion (tree expr) { if (TREE_CODE (expr) == ERROR_MARK) return expr; @@ -14830,7 +14802,6 @@ ffe_truthvalue_conversion (expr) case NEGATE_EXPR: case ABS_EXPR: case FLOAT_EXPR: - case FFS_EXPR: /* These don't change whether an object is nonzero or zero. */ return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)); @@ -14926,9 +14897,7 @@ ffe_truthvalue_conversion (expr) } static tree -ffe_type_for_mode (mode, unsignedp) - enum machine_mode mode; - int unsignedp; +ffe_type_for_mode (enum machine_mode mode, int unsignedp) { int i; int j; @@ -14986,9 +14955,7 @@ ffe_type_for_mode (mode, unsignedp) } static tree -ffe_type_for_size (bits, unsignedp) - unsigned bits; - int unsignedp; +ffe_type_for_size (unsigned bits, int unsignedp) { ffeinfoKindtype kt; tree type_node; @@ -15022,8 +14989,7 @@ ffe_type_for_size (bits, unsignedp) } static tree -ffe_unsigned_type (type) - tree type; +ffe_unsigned_type (tree type) { tree type1 = TYPE_MAIN_VARIANT (type); ffeinfoKindtype kt; @@ -15106,7 +15072,7 @@ static int max_include_len = 0; struct file_name_list { struct file_name_list *next; - char *fname; + const char *fname; /* Mapping of file names for this directory. */ struct file_name_map *name_map; /* Nonzero if name_map is valid. */ @@ -15134,7 +15100,6 @@ static struct file_buf { } instack[INPUT_STACK_MAX]; static int last_error_tick = 0; /* Incremented each time we print it. */ -static int input_file_stack_tick = 0; /* Incremented when status changes. */ /* Current nesting level of input sources. `instack[indepth]' is the level currently being read. */ @@ -15163,8 +15128,8 @@ static struct file_name_map *read_name_map (const char *dirname); FIRST is the beginning of the chain to append, and LAST is the end. */ static void -append_include_chain (first, last) - struct file_name_list *first, *last; +append_include_chain (struct file_name_list *first, + struct file_name_list *last) { struct file_name_list *dir; @@ -15194,9 +15159,7 @@ append_include_chain (first, last) read_name_map. */ static FILE * -open_include_file (filename, searchptr) - char *filename; - struct file_name_list *searchptr; +open_include_file (char *filename, struct file_name_list *searchptr) { register struct file_name_map *map; register char *from; @@ -15255,7 +15218,7 @@ open_include_file (filename, searchptr) } else { - dir = (char *) xmalloc (p - filename + 1); + dir = xmalloc (p - filename + 1); memcpy (dir, filename, p - filename); dir[p - filename] = '\0'; from = p + 1; @@ -15333,9 +15296,7 @@ print_containing_files (ffebadSeverity sev) file. */ static char * -read_filename_string (ch, f) - int ch; - FILE *f; +read_filename_string (int ch, FILE *f) { char *alloc, *set; int len; @@ -15364,8 +15325,7 @@ read_filename_string (ch, f) /* Read the file name map file for DIRNAME. */ static struct file_name_map * -read_name_map (dirname) - const char *dirname; +read_name_map (const char *dirname) { /* This structure holds a linked list of file name maps, one per directory. */ @@ -15389,8 +15349,7 @@ read_name_map (dirname) if (! strcmp (map_list_ptr->map_list_name, dirname)) return map_list_ptr->map_list_map; - map_list_ptr = ((struct file_name_map_list *) - xmalloc (sizeof (struct file_name_map_list))); + map_list_ptr = xmalloc (sizeof (struct file_name_map_list)); map_list_ptr->map_list_name = xstrdup (dirname); map_list_ptr->map_list_map = NULL; @@ -15420,8 +15379,7 @@ read_name_map (dirname) ; to = read_filename_string (ch, f); - ptr = ((struct file_name_map *) - xmalloc (sizeof (struct file_name_map))); + ptr = xmalloc (sizeof (struct file_name_map)); ptr->map_from = from; /* Make the real filename absolute. */ @@ -15461,7 +15419,7 @@ ffecom_file_ (const char *name) early #line directives (when -g is in effect). */ fp = &instack[++indepth]; - memset ((char *) fp, 0, sizeof (FILE_BUF)); + memset (fp, 0, sizeof (FILE_BUF)); if (name == NULL) name = ""; fp->nominal_fname = fp->fname = name; @@ -15479,26 +15437,20 @@ ffecom_close_include_ (FILE *f) ffewhere_column_kill (instack[indepth].column); } -static int -ffecom_decode_include_option_ (char *spec) +void +ffecom_decode_include_option (const char *dir) { - struct file_name_list *dirtmp; - - if (! ignore_srcdir && !strcmp (spec, "-")) + if (! ignore_srcdir && !strcmp (dir, "-")) ignore_srcdir = 1; else { - dirtmp = (struct file_name_list *) - xmalloc (sizeof (struct file_name_list)); + struct file_name_list *dirtmp + = xmalloc (sizeof (struct file_name_list)); dirtmp->next = 0; /* New one goes on the end */ - dirtmp->fname = spec; + dirtmp->fname = dir; dirtmp->got_name_map = 0; - if (spec[0] == 0) - error ("directory name must immediately follow -I"); - else - append_include_chain (dirtmp, dirtmp); + append_include_chain (dirtmp, dirtmp); } - return 1; } /* Open INCLUDEd file. */ @@ -15553,9 +15505,10 @@ ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c) if (ep != NULL) { n = ep - nam; - dsp[0].fname = (char *) xmalloc (n + 1); - strncpy (dsp[0].fname, nam, n); - dsp[0].fname[n] = '\0'; + fname = xmalloc (n + 1); + strncpy (fname, nam, n); + fname[n] = '\0'; + dsp[0].fname = fname; if (n + INCLUDE_LEN_FUDGE > max_include_len) max_include_len = n + INCLUDE_LEN_FUDGE; } @@ -15663,7 +15616,7 @@ ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c) } if (dsp[0].fname != NULL) - free (dsp[0].fname); + free ((char *) dsp[0].fname); if (f == NULL) return NULL; @@ -15684,7 +15637,7 @@ ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c) instack[indepth].column = ffewhere_column_use (c); fp = &instack[indepth + 1]; - memset ((char *) fp, 0, sizeof (FILE_BUF)); + memset (fp, 0, sizeof (FILE_BUF)); fp->nominal_fname = fp->fname = fname; fp->dir = searchptr; diff --git a/contrib/gcc/f/com.h b/contrib/gcc/f/com.h index b58e5ba..d23db66 100644 --- a/contrib/gcc/f/com.h +++ b/contrib/gcc/f/com.h @@ -1,5 +1,6 @@ /* com.h -- Public #include File (module.h template V1.0) - Copyright (C) 1995, 1996, 1997, 2000 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997, 2000, 2003, 2004 + Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -128,17 +129,11 @@ typedef enum #endif typedef tree ffecomConstant; -#define FFECOM_constantHOOK typedef tree ffecomNonter; -#define FFECOM_nonterHOOK typedef tree ffecomLabel; -#define FFECOM_globalHOOK typedef tree ffecomGlobal; -#define FFECOM_labelHOOK typedef tree ffecomStorage; -#define FFECOM_storageHOOK typedef struct _ffecom_symbol_ ffecomSymbol; -#define FFECOM_symbolHOOK struct _ffecom_symbol_ { @@ -157,13 +152,13 @@ struct _ffecom_symbol_ #include "storag.h" #include "symbol.h" -extern int global_bindings_p PARAMS ((void)); -extern tree getdecls PARAMS ((void)); -extern void pushlevel PARAMS ((int)); -extern tree poplevel PARAMS ((int,int, int)); -extern void insert_block PARAMS ((tree)); -extern void set_block PARAMS ((tree)); -extern tree pushdecl PARAMS ((tree)); +extern int global_bindings_p (void); +extern tree getdecls (void); +extern void pushlevel (int); +extern tree poplevel (int,int, int); +extern void insert_block (tree); +extern void set_block (tree); +extern tree pushdecl (tree); /* Global objects accessed by users of this module. */ @@ -218,7 +213,7 @@ tree ffecom_const_expr (ffebld expr); tree ffecom_decl_field (tree context, tree prevfield, const char *name, tree type); void ffecom_close_include (FILE *f); -int ffecom_decode_include_option (char *spec); +void ffecom_decode_include_option (const char *dir); tree ffecom_end_compstmt (void); void ffecom_end_transition (void); void ffecom_exec_transition (void); @@ -233,7 +228,7 @@ void ffecom_finish_decl (tree decl, tree init, bool is_top_level); void ffecom_finish_progunit (void); tree ffecom_get_invented_identifier (const char *pattern, ...) ATTRIBUTE_PRINTF_1; -ffeinfoKindtype ffecom_gfrt_basictype (ffecomGfrt ix); +ffeinfoBasictype ffecom_gfrt_basictype (ffecomGfrt ix); ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix); void ffecom_init_0 (void); void ffecom_init_2 (void); diff --git a/contrib/gcc/f/data.c b/contrib/gcc/f/data.c index 91b835d..2040f0a 100644 --- a/contrib/gcc/f/data.c +++ b/contrib/gcc/f/data.c @@ -314,7 +314,7 @@ ffedata_value (ffetargetIntegerDefault rpt, ffebld value, ffelexToken token) CHARTYPE is CHARACTER*3, for example. */ static bool -ffedata_advance_ () +ffedata_advance_ (void) { ffebld next; @@ -723,8 +723,8 @@ ffedata_convert_ (ffebld source, ffelexToken source_token, if (max > ffedata_convert_cache_max_) { - cache = (ffedataConvertCache_) malloc_new_ks (malloc_pool_image (), - "FFEDATA cache", max * sizeof (*cache)); + cache = malloc_new_ks (malloc_pool_image (), + "FFEDATA cache", max * sizeof (*cache)); if (ffedata_convert_cache_max_ != 0) { memcpy (cache, ffedata_convert_cache_, @@ -1457,7 +1457,7 @@ ffedata_gather_ (ffestorag mst, ffestorag st) ffedata_pop_(); */ static void -ffedata_pop_ () +ffedata_pop_ (void) { ffedataImpdo_ victim = ffedata_stack_; @@ -1473,7 +1473,7 @@ ffedata_pop_ () ffedata_push_(); */ static void -ffedata_push_ () +ffedata_push_ (void) { ffedataImpdo_ baby; diff --git a/contrib/gcc/f/equiv.c b/contrib/gcc/f/equiv.c index f58de9c..bd7ac6d 100644 --- a/contrib/gcc/f/equiv.c +++ b/contrib/gcc/f/equiv.c @@ -1,5 +1,6 @@ /* equiv.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997, 1998, 2003 + Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -918,7 +919,7 @@ ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t) ffeequiv_exec_transition(); */ void -ffeequiv_exec_transition () +ffeequiv_exec_transition (void) { while (ffeequiv_list_.first != (ffeequiv) &ffeequiv_list_.first) ffeequiv_layout_local_ (ffeequiv_list_.first); @@ -931,7 +932,7 @@ ffeequiv_exec_transition () Initializes the list of equivalences. */ void -ffeequiv_init_2 () +ffeequiv_init_2 (void) { ffeequiv_list_.first = (ffeequiv) &ffeequiv_list_.first; ffeequiv_list_.last = (ffeequiv) &ffeequiv_list_.first; @@ -1312,7 +1313,7 @@ ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t) objects. */ ffeequiv -ffeequiv_new () +ffeequiv_new (void) { ffeequiv eq; diff --git a/contrib/gcc/f/expr.c b/contrib/gcc/f/expr.c index 4824be7..ef7661d 100644 --- a/contrib/gcc/f/expr.c +++ b/contrib/gcc/f/expr.c @@ -1,5 +1,5 @@ /* expr.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002 + Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. @@ -309,7 +309,8 @@ static ffebld ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op, static ffebld ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, ffeexprExpr_ r); static ffebld ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, - ffeexprExpr_ op, ffeexprExpr_ r); + ffeexprExpr_ op, ffeexprExpr_ r, + bool *); static ffelexHandler ffeexpr_find_close_paren_ (ffelexToken t, ffelexHandler after); static ffelexHandler ffeexpr_nil_finished_ (ffelexToken t); @@ -516,14 +517,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer1_real4 - (ffebld_cu_ptr_integer1 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER1/REAL bad source kind type" == NULL); break; @@ -557,14 +550,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer1_complex4 - (ffebld_cu_ptr_integer1 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER1/COMPLEX bad source kind type" == NULL); break; @@ -709,14 +694,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer2_real4 - (ffebld_cu_ptr_integer2 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER2/REAL bad source kind type" == NULL); break; @@ -750,14 +727,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer2_complex4 - (ffebld_cu_ptr_integer2 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER2/COMPLEX bad source kind type" == NULL); break; @@ -902,14 +871,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer3_real4 - (ffebld_cu_ptr_integer3 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER3/REAL bad source kind type" == NULL); break; @@ -943,14 +904,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer3_complex4 - (ffebld_cu_ptr_integer3 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER3/COMPLEX bad source kind type" == NULL); break; @@ -1095,14 +1048,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer4_real4 - (ffebld_cu_ptr_integer4 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER4/REAL bad source kind type" == NULL); break; @@ -1136,14 +1081,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_integer4_complex4 - (ffebld_cu_ptr_integer4 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("INTEGER3/COMPLEX bad source kind type" == NULL); break; @@ -1752,14 +1689,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_real1_real4 - (ffebld_cu_ptr_real1 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("REAL1/REAL bad source kind type" == NULL); break; @@ -1793,14 +1722,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_real1_complex4 - (ffebld_cu_ptr_real1 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("REAL1/COMPLEX bad source kind type" == NULL); break; @@ -1904,14 +1825,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_real2_real4 - (ffebld_cu_ptr_real2 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("REAL2/REAL bad source kind type" == NULL); break; @@ -1945,14 +1858,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_real2_complex4 - (ffebld_cu_ptr_real2 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("REAL2/COMPLEX bad source kind type" == NULL); break; @@ -2056,14 +1961,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_real3_real4 - (ffebld_cu_ptr_real3 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("REAL3/REAL bad source kind type" == NULL); break; @@ -2097,14 +1994,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_real3_complex4 - (ffebld_cu_ptr_real3 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("REAL3/COMPLEX bad source kind type" == NULL); break; @@ -2144,158 +2033,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - switch (ffeinfo_basictype (ffebld_info (l))) - { - case FFEINFO_basictypeINTEGER: - switch (ffeinfo_kindtype (ffebld_info (l))) - { -#if FFETARGET_okINTEGER1 - case FFEINFO_kindtypeINTEGER1: - error = ffetarget_convert_real4_integer1 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_integer1 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okINTEGER2 - case FFEINFO_kindtypeINTEGER2: - error = ffetarget_convert_real4_integer2 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_integer2 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okINTEGER3 - case FFEINFO_kindtypeINTEGER3: - error = ffetarget_convert_real4_integer3 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_integer3 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okINTEGER4 - case FFEINFO_kindtypeINTEGER4: - error = ffetarget_convert_real4_integer4 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_integer4 (ffebld_conter (l))); - break; -#endif - - default: - assert ("REAL4/INTEGER bad source kind type" == NULL); - break; - } - break; - - case FFEINFO_basictypeREAL: - switch (ffeinfo_kindtype (ffebld_info (l))) - { -#if FFETARGET_okREAL1 - case FFEINFO_kindtypeREAL1: - error = ffetarget_convert_real4_real1 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_real1 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okREAL2 - case FFEINFO_kindtypeREAL2: - error = ffetarget_convert_real4_real2 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_real2 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okREAL3 - case FFEINFO_kindtypeREAL3: - error = ffetarget_convert_real4_real3 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_real3 (ffebld_conter (l))); - break; -#endif - - default: - assert ("REAL4/REAL bad source kind type" == NULL); - break; - } - break; - - case FFEINFO_basictypeCOMPLEX: - switch (ffeinfo_kindtype (ffebld_info (l))) - { -#if FFETARGET_okCOMPLEX1 - case FFEINFO_kindtypeREAL1: - error = ffetarget_convert_real4_complex1 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_complex1 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okCOMPLEX2 - case FFEINFO_kindtypeREAL2: - error = ffetarget_convert_real4_complex2 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_complex2 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okCOMPLEX3 - case FFEINFO_kindtypeREAL3: - error = ffetarget_convert_real4_complex3 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_complex3 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_real4_complex4 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - - default: - assert ("REAL4/COMPLEX bad source kind type" == NULL); - break; - } - break; - - case FFEINFO_basictypeCHARACTER: - error = ffetarget_convert_real4_character1 - (ffebld_cu_ptr_real4 (u), - ffebld_constant_character1 (ffebld_conter (l))); - break; - - case FFEINFO_basictypeHOLLERITH: - error = ffetarget_convert_real4_hollerith - (ffebld_cu_ptr_real4 (u), - ffebld_constant_hollerith (ffebld_conter (l))); - break; - - case FFEINFO_basictypeTYPELESS: - error = ffetarget_convert_real4_typeless - (ffebld_cu_ptr_real4 (u), - ffebld_constant_typeless (ffebld_conter (l))); - break; - - default: - assert ("REAL4 bad type" == NULL); - break; - } - - /* If conversion operation is not implemented, return original expr. */ - if (error == FFEBAD_NOCANDO) - return expr; - - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_real4_val - (ffebld_cu_val_real4 (u)), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -2378,14 +2115,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_complex1_real4 - (ffebld_cu_ptr_complex1 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("COMPLEX1/REAL bad source kind type" == NULL); break; @@ -2411,14 +2140,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_complex1_complex4 - (ffebld_cu_ptr_complex1 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("COMPLEX1/COMPLEX bad source kind type" == NULL); break; @@ -2530,14 +2251,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_complex2_real4 - (ffebld_cu_ptr_complex2 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("COMPLEX2/REAL bad source kind type" == NULL); break; @@ -2563,14 +2276,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_complex2_complex4 - (ffebld_cu_ptr_complex2 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("COMPLEX2/COMPLEX bad source kind type" == NULL); break; @@ -2682,14 +2387,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_complex3_real4 - (ffebld_cu_ptr_complex3 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - default: assert ("COMPLEX3/REAL bad source kind type" == NULL); break; @@ -2715,14 +2412,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_complex3_complex4 - (ffebld_cu_ptr_complex3 (u), - ffebld_constant_complex4 (ffebld_conter (l))); - break; -#endif - default: assert ("COMPLEX3/COMPLEX bad source kind type" == NULL); break; @@ -2762,158 +2451,6 @@ ffeexpr_collapse_convert (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - switch (ffeinfo_basictype (ffebld_info (l))) - { - case FFEINFO_basictypeINTEGER: - switch (ffeinfo_kindtype (ffebld_info (l))) - { -#if FFETARGET_okINTEGER1 - case FFEINFO_kindtypeINTEGER1: - error = ffetarget_convert_complex4_integer1 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_integer1 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okINTEGER2 - case FFEINFO_kindtypeINTEGER2: - error = ffetarget_convert_complex4_integer2 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_integer2 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okINTEGER3 - case FFEINFO_kindtypeINTEGER3: - error = ffetarget_convert_complex4_integer3 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_integer3 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okINTEGER4 - case FFEINFO_kindtypeINTEGER4: - error = ffetarget_convert_complex4_integer4 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_integer4 (ffebld_conter (l))); - break; -#endif - - default: - assert ("COMPLEX4/INTEGER bad source kind type" == NULL); - break; - } - break; - - case FFEINFO_basictypeREAL: - switch (ffeinfo_kindtype (ffebld_info (l))) - { -#if FFETARGET_okREAL1 - case FFEINFO_kindtypeREAL1: - error = ffetarget_convert_complex4_real1 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_real1 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okREAL2 - case FFEINFO_kindtypeREAL2: - error = ffetarget_convert_complex4_real2 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_real2 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okREAL3 - case FFEINFO_kindtypeREAL3: - error = ffetarget_convert_complex4_real3 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_real3 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_convert_complex4_real4 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_real4 (ffebld_conter (l))); - break; -#endif - - default: - assert ("COMPLEX4/REAL bad source kind type" == NULL); - break; - } - break; - - case FFEINFO_basictypeCOMPLEX: - switch (ffeinfo_kindtype (ffebld_info (l))) - { -#if FFETARGET_okCOMPLEX1 - case FFEINFO_kindtypeREAL1: - error = ffetarget_convert_complex4_complex1 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex1 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okCOMPLEX2 - case FFEINFO_kindtypeREAL2: - error = ffetarget_convert_complex4_complex2 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex2 (ffebld_conter (l))); - break; -#endif - -#if FFETARGET_okCOMPLEX3 - case FFEINFO_kindtypeREAL3: - error = ffetarget_convert_complex4_complex3 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex3 (ffebld_conter (l))); - break; -#endif - - default: - assert ("COMPLEX4/COMPLEX bad source kind type" == NULL); - break; - } - break; - - case FFEINFO_basictypeCHARACTER: - error = ffetarget_convert_complex4_character1 - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_character1 (ffebld_conter (l))); - break; - - case FFEINFO_basictypeHOLLERITH: - error = ffetarget_convert_complex4_hollerith - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_hollerith (ffebld_conter (l))); - break; - - case FFEINFO_basictypeTYPELESS: - error = ffetarget_convert_complex4_typeless - (ffebld_cu_ptr_complex4 (u), - ffebld_constant_typeless (ffebld_conter (l))); - break; - - default: - assert ("COMPLEX4 bad type" == NULL); - break; - } - - /* If conversion operation is not implemented, return original expr. */ - if (error == FFEBAD_NOCANDO) - return expr; - - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_complex4_val - (ffebld_cu_val_complex4 (u)), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -3302,15 +2839,6 @@ ffeexpr_collapse_uminus (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_uminus_real4 (ffebld_cu_ptr_real4 (u), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val - (ffebld_cu_val_real4 (u)), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -3347,15 +2875,6 @@ ffeexpr_collapse_uminus (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_uminus_complex4 (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val - (ffebld_cu_val_complex4 (u)), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -3646,16 +3165,6 @@ ffeexpr_collapse_add (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_add_real4 (ffebld_cu_ptr_real4 (u), - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val - (ffebld_cu_val_real4 (u)), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -3695,16 +3204,6 @@ ffeexpr_collapse_add (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_add_complex4 (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex4 (ffebld_conter (l)), - ffebld_constant_complex4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val - (ffebld_cu_val_complex4 (u)), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -3851,16 +3350,6 @@ ffeexpr_collapse_subtract (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_subtract_real4 (ffebld_cu_ptr_real4 (u), - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val - (ffebld_cu_val_real4 (u)), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -3900,16 +3389,6 @@ ffeexpr_collapse_subtract (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_subtract_complex4 (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex4 (ffebld_conter (l)), - ffebld_constant_complex4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val - (ffebld_cu_val_complex4 (u)), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -4056,16 +3535,6 @@ ffeexpr_collapse_multiply (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_multiply_real4 (ffebld_cu_ptr_real4 (u), - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val - (ffebld_cu_val_real4 (u)), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -4105,16 +3574,6 @@ ffeexpr_collapse_multiply (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_multiply_complex4 (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex4 (ffebld_conter (l)), - ffebld_constant_complex4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val - (ffebld_cu_val_complex4 (u)), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -4261,16 +3720,6 @@ ffeexpr_collapse_divide (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_divide_real4 (ffebld_cu_ptr_real4 (u), - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val - (ffebld_cu_val_real4 (u)), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -4310,16 +3759,6 @@ ffeexpr_collapse_divide (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_divide_complex4 (ffebld_cu_ptr_complex4 (u), - ffebld_constant_complex4 (ffebld_conter (l)), - ffebld_constant_complex4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val - (ffebld_cu_val_complex4 (u)), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -4563,39 +4002,6 @@ ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_concatenate_character2 (ffebld_cu_ptr_character2 (u), - ffebld_constant_character2 (ffebld_conter (l)), - ffebld_constant_character2 (ffebld_conter (r)), - ffebld_constant_pool (), &len); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val - (ffebld_cu_val_character2 (u)), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_concatenate_character3 (ffebld_cu_ptr_character3 (u), - ffebld_constant_character3 (ffebld_conter (l)), - ffebld_constant_character3 (ffebld_conter (r)), - ffebld_constant_pool (), &len); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val - (ffebld_cu_val_character3 (u)), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_concatenate_character4 (ffebld_cu_ptr_character4 (u), - ffebld_constant_character4 (ffebld_conter (l)), - ffebld_constant_character4 (ffebld_conter (r)), - ffebld_constant_pool (), &len); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val - (ffebld_cu_val_character4 (u)), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -4740,16 +4146,6 @@ ffeexpr_collapse_eq (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_eq_real4 (&val, - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -4789,16 +4185,6 @@ ffeexpr_collapse_eq (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_eq_complex4 (&val, - ffebld_constant_complex4 (ffebld_conter (l)), - ffebld_constant_complex4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -4818,36 +4204,6 @@ ffeexpr_collapse_eq (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_eq_character2 (&val, - ffebld_constant_character2 (ffebld_conter (l)), - ffebld_constant_character2 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_eq_character3 (&val, - ffebld_constant_character3 (ffebld_conter (l)), - ffebld_constant_character3 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_eq_character4 (&val, - ffebld_constant_character4 (ffebld_conter (l)), - ffebld_constant_character4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -4992,16 +4348,6 @@ ffeexpr_collapse_ne (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_ne_real4 (&val, - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -5041,16 +4387,6 @@ ffeexpr_collapse_ne (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_ne_complex4 (&val, - ffebld_constant_complex4 (ffebld_conter (l)), - ffebld_constant_complex4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad complex kind type" == NULL); break; @@ -5070,36 +4406,6 @@ ffeexpr_collapse_ne (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_ne_character2 (&val, - ffebld_constant_character2 (ffebld_conter (l)), - ffebld_constant_character2 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_ne_character3 (&val, - ffebld_constant_character3 (ffebld_conter (l)), - ffebld_constant_character3 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_ne_character4 (&val, - ffebld_constant_character4 (ffebld_conter (l)), - ffebld_constant_character4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -5244,16 +4550,6 @@ ffeexpr_collapse_ge (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_ge_real4 (&val, - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -5273,36 +4569,6 @@ ffeexpr_collapse_ge (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_ge_character2 (&val, - ffebld_constant_character2 (ffebld_conter (l)), - ffebld_constant_character2 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_ge_character3 (&val, - ffebld_constant_character3 (ffebld_conter (l)), - ffebld_constant_character3 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_ge_character4 (&val, - ffebld_constant_character4 (ffebld_conter (l)), - ffebld_constant_character4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -5447,16 +4713,6 @@ ffeexpr_collapse_gt (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_gt_real4 (&val, - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -5476,36 +4732,6 @@ ffeexpr_collapse_gt (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_gt_character2 (&val, - ffebld_constant_character2 (ffebld_conter (l)), - ffebld_constant_character2 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_gt_character3 (&val, - ffebld_constant_character3 (ffebld_conter (l)), - ffebld_constant_character3 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_gt_character4 (&val, - ffebld_constant_character4 (ffebld_conter (l)), - ffebld_constant_character4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -5650,16 +4876,6 @@ ffeexpr_collapse_le (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_le_real4 (&val, - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -5679,36 +4895,6 @@ ffeexpr_collapse_le (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_le_character2 (&val, - ffebld_constant_character2 (ffebld_conter (l)), - ffebld_constant_character2 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_le_character3 (&val, - ffebld_constant_character3 (ffebld_conter (l)), - ffebld_constant_character3 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_le_character4 (&val, - ffebld_constant_character4 (ffebld_conter (l)), - ffebld_constant_character4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -5853,16 +5039,6 @@ ffeexpr_collapse_lt (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okREAL4 - case FFEINFO_kindtypeREAL4: - error = ffetarget_lt_real4 (&val, - ffebld_constant_real4 (ffebld_conter (l)), - ffebld_constant_real4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad real kind type" == NULL); break; @@ -5882,36 +5058,6 @@ ffeexpr_collapse_lt (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_lt_character2 (&val, - ffebld_constant_character2 (ffebld_conter (l)), - ffebld_constant_character2 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_lt_character3 (&val, - ffebld_constant_character3 (ffebld_conter (l)), - ffebld_constant_character3 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_lt_character4 (&val, - ffebld_constant_character4 (ffebld_conter (l)), - ffebld_constant_character4 (ffebld_conter (r))); - expr = ffebld_new_conter_with_orig - (ffebld_constant_new_logicaldefault (val), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -6906,36 +6052,6 @@ ffeexpr_collapse_substr (ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCHARACTER2 - case FFEINFO_kindtypeCHARACTER2: - error = ffetarget_substr_character2 (ffebld_cu_ptr_character2 (u), - ffebld_constant_character2 (ffebld_conter (l)), first, last, - ffebld_constant_pool (), &len); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val - (ffebld_cu_val_character2 (u)), expr); - break; -#endif - -#if FFETARGET_okCHARACTER3 - case FFEINFO_kindtypeCHARACTER3: - error = ffetarget_substr_character3 (ffebld_cu_ptr_character3 (u), - ffebld_constant_character3 (ffebld_conter (l)), first, last, - ffebld_constant_pool (), &len); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val - (ffebld_cu_val_character3 (u)), expr); - break; -#endif - -#if FFETARGET_okCHARACTER4 - case FFEINFO_kindtypeCHARACTER4: - error = ffetarget_substr_character4 (ffebld_cu_ptr_character4 (u), - ffebld_constant_character4 (ffebld_conter (l)), first, last, - ffebld_constant_pool (), &len); - expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val - (ffebld_cu_val_character4 (u)), expr); - break; -#endif - default: assert ("bad character kind type" == NULL); break; @@ -7204,7 +6320,7 @@ ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token, /* Initializes the module. */ void -ffeexpr_init_2 () +ffeexpr_init_2 (void) { ffeexpr_stack_ = NULL; ffeexpr_level_ = 0; @@ -7666,17 +6782,6 @@ ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr, ffelexToken t) break; #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: - e->u.operand = ffebld_new_conter (ffebld_constant_new_complex4 - (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr))); - ffebld_set_info (e->u.operand, - ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0, - FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, - FFETARGET_charactersizeNONE)); - break; -#endif - default: if (ffebad_start ((nkt == FFEINFO_kindtypeREALDOUBLE) ? FFEBAD_BAD_DBLCMPLX : FFEBAD_BAD_COMPLEX)) @@ -8663,9 +7768,6 @@ ffeexpr_type_combine (ffeinfoBasictype *xnbt, ffeinfoKindtype *xnkt, #if FFETARGET_okCOMPLEX3 case FFEINFO_kindtypeREAL3: #endif -#if FFETARGET_okCOMPLEX4 - case FFEINFO_kindtypeREAL4: -#endif break; /* Fine and dandy. */ default: @@ -9383,12 +8485,11 @@ ffeexpr_expr_kill_ (ffeexprExpr_ e) Allocates and initializes a new expression object, returns it. */ static ffeexprExpr_ -ffeexpr_expr_new_ () +ffeexpr_expr_new_ (void) { ffeexprExpr_ e; - e = (ffeexprExpr_) malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR expr", - sizeof (*e)); + e = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR expr", sizeof (*e)); e->previous = NULL; e->type = FFEEXPR_exprtypeUNKNOWN_; e->token = NULL; @@ -9577,15 +8678,6 @@ static void ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e) { ffeexpr_exprstack_push_ (e); -#ifdef WEIRD_NONFORTRAN_RULES - if ((ffeexpr_stack_->exprstack != NULL) - && (ffeexpr_stack_->exprstack->expr->type == FFEEXPR_exprtypeBINARY_) - && (ffeexpr_stack_->exprstack->expr->u.operator.prec - == FFEEXPR_operatorprecedenceHIGHEST_) - && (ffeexpr_stack_->exprstack->expr->u.operator.as - == FFEEXPR_operatorassociativityL2R_)) - ffeexpr_reduce_ (); -#endif } /* ffeexpr_exprstack_push_unary_ -- Push a unary operator onto the stack @@ -9700,7 +8792,7 @@ again: requisite type-assignment. */ static void -ffeexpr_reduce_ () +ffeexpr_reduce_ (void) { ffeexprExpr_ operand; /* This is B in -B or A+B. */ ffeexprExpr_ left_operand; /* When operator is binary, this is A in A+B. */ @@ -9711,6 +8803,7 @@ ffeexpr_reduce_ () ffebld expr; ffebld left_expr; bool submag = FALSE; + bool bothlogical; operand = ffeexpr_stack_->exprstack; assert (operand != NULL); @@ -9902,37 +8995,58 @@ ffeexpr_reduce_ () reduced = ffebld_new_and (left_expr, expr); if (ffe_is_ugly_logint ()) reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator, - operand); + operand, &bothlogical); reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator, operand); reduced = ffeexpr_collapse_and (reduced, operator->token); + if (ffe_is_ugly_logint() && bothlogical) + reduced = ffeexpr_convert (reduced, left_operand->token, + operator->token, + FFEINFO_basictypeLOGICAL, + FFEINFO_kindtypeLOGICALDEFAULT, 0, + FFETARGET_charactersizeNONE, + FFEEXPR_contextLET); break; case FFEEXPR_operatorOR_: reduced = ffebld_new_or (left_expr, expr); if (ffe_is_ugly_logint ()) reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator, - operand); + operand, &bothlogical); reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator, operand); reduced = ffeexpr_collapse_or (reduced, operator->token); + if (ffe_is_ugly_logint() && bothlogical) + reduced = ffeexpr_convert (reduced, left_operand->token, + operator->token, + FFEINFO_basictypeLOGICAL, + FFEINFO_kindtypeLOGICALDEFAULT, 0, + FFETARGET_charactersizeNONE, + FFEEXPR_contextLET); break; case FFEEXPR_operatorXOR_: reduced = ffebld_new_xor (left_expr, expr); if (ffe_is_ugly_logint ()) reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator, - operand); + operand, &bothlogical); reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator, operand); reduced = ffeexpr_collapse_xor (reduced, operator->token); + if (ffe_is_ugly_logint() && bothlogical) + reduced = ffeexpr_convert (reduced, left_operand->token, + operator->token, + FFEINFO_basictypeLOGICAL, + FFEINFO_kindtypeLOGICALDEFAULT, 0, + FFETARGET_charactersizeNONE, + FFEEXPR_contextLET); break; case FFEEXPR_operatorEQV_: reduced = ffebld_new_eqv (left_expr, expr); if (ffe_is_ugly_logint ()) reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator, - operand); + operand, NULL); reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator, operand); reduced = ffeexpr_collapse_eqv (reduced, operator->token); @@ -9942,7 +9056,7 @@ ffeexpr_reduce_ () reduced = ffebld_new_neqv (left_expr, expr); if (ffe_is_ugly_logint ()) reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator, - operand); + operand, NULL); reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator, operand); reduced = ffeexpr_collapse_neqv (reduced, operator->token); @@ -11423,7 +10537,7 @@ ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, static ffebld ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, - ffeexprExpr_ r) + ffeexprExpr_ r, bool *bothlogical) { ffeinfo linfo, rinfo; ffeinfoBasictype lbt, rbt; @@ -11503,23 +10617,31 @@ ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, } if (lbt == FFEINFO_basictypeLOGICAL) - { - ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced), - l->token, op->token, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGERDEFAULT, 0, - FFETARGET_charactersizeNONE, - FFEEXPR_contextLET)); - } + { + ffebld_set_left (reduced, + ffeexpr_convert (ffebld_left (reduced), + l->token, op->token, + FFEINFO_basictypeINTEGER, + FFEINFO_kindtypeINTEGERDEFAULT, 0, + FFETARGET_charactersizeNONE, + FFEEXPR_contextLET)); + } if (rbt == FFEINFO_basictypeLOGICAL) - { - ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced), - r->token, op->token, FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGERDEFAULT, 0, - FFETARGET_charactersizeNONE, - FFEEXPR_contextLET)); - } - + { + ffebld_set_right (reduced, + ffeexpr_convert (ffebld_right (reduced), + r->token, op->token, + FFEINFO_basictypeINTEGER, + FFEINFO_kindtypeINTEGERDEFAULT, 0, + FFETARGET_charactersizeNONE, + FFEEXPR_contextLET)); + } + + if (bothlogical != NULL) + *bothlogical = (lbt == FFEINFO_basictypeLOGICAL + && rbt == FFEINFO_basictypeLOGICAL); + return reduced; } @@ -19442,7 +18564,7 @@ ffeexpr_token_anything_ (ffelexToken ft UNUSED, ffebld expr UNUSED, /* Terminate module. */ void -ffeexpr_terminate_2 () +ffeexpr_terminate_2 (void) { assert (ffeexpr_stack_ == NULL); assert (ffeexpr_level_ == 0); diff --git a/contrib/gcc/f/ffe.texi b/contrib/gcc/f/ffe.texi index 9aa6a97..fd5d3bf 100644 --- a/contrib/gcc/f/ffe.texi +++ b/contrib/gcc/f/ffe.texi @@ -1,4 +1,4 @@ -@c Copyright (C) 1999 Free Software Foundation, Inc. +@c Copyright (C) 1999, 2003 Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @@ -37,22 +37,22 @@ need to take first. The current directory layout includes the following: @table @file -@item @value{srcdir}/gcc/ +@item @var{srcdir}/gcc/ Non-g77 files in gcc -@item @value{srcdir}/gcc/f/ +@item @var{srcdir}/gcc/f/ GNU Fortran front end sources -@item @value{srcdir}/libf2c/ +@item @var{srcdir}/libf2c/ @code{libg2c} configuration and @code{g2c.h} file generation -@item @value{srcdir}/libf2c/libF77/ +@item @var{srcdir}/libf2c/libF77/ General support and math portion of @code{libg2c} -@item @value{srcdir}/libf2c/libI77/ +@item @var{srcdir}/libf2c/libI77/ I/O portion of @code{libg2c} -@item @value{srcdir}/libf2c/libU77/ +@item @var{srcdir}/libf2c/libU77/ Additional interfaces to Unix @code{libc} for @code{libg2c} @end table @@ -199,8 +199,7 @@ in @file{xyz.h} and implemented there (if it's a macro) or in @file{xyz.c}. The ``porting'' files of note currently are: @table @file -@item proj.c -@itemx proj.h +@item proj.h This defines the ``language'' used by all the other source files, the language being Standard C plus some useful things like @code{ARRAY_SIZE} and such. diff --git a/contrib/gcc/f/fini.c b/contrib/gcc/f/fini.c index 28d9028..167837b 100644 --- a/contrib/gcc/f/fini.c +++ b/contrib/gcc/f/fini.c @@ -19,7 +19,7 @@ along with GNU Fortran; see the file COPYING. If not, write to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#define USE_HCONFIG +#define USE_BCONFIG #include "proj.h" #include "malloc.h" @@ -367,7 +367,7 @@ main (int argc, char **argv) /* Make new name object to store name and its keyword. */ - newname = (name) xmalloc (sizeof (*newname)); + newname = xmalloc (sizeof (*newname)); newname->namelen = strlen (buf); newname->kwlen = strlen (kwname); total_length = newname->kwlen + fixlengths; diff --git a/contrib/gcc/f/g77.texi b/contrib/gcc/f/g77.texi index a7cd96b..3d5f83d 100644 --- a/contrib/gcc/f/g77.texi +++ b/contrib/gcc/f/g77.texi @@ -2,8 +2,8 @@ @c %**start of header @setfilename g77.info -@set last-update 2003-05-13 -@set copyrights-g77 1995,1996,1997,1998,1999,2000,2001,2002,2003 +@set last-update 2004-03-21 +@set copyrights-g77 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004 @include root.texi @@ -250,7 +250,7 @@ many people have helped create and improve GNU Fortran. @itemize @bullet @item The packaging and compiler portions of GNU Fortran are based largely -on the GNU CC compiler. +on the GCC compiler. @xref{Contributors,,Contributors to GCC,gcc,Using the GNU Compiler Collection (GCC)}, for more information. @@ -316,6 +316,8 @@ for @code{INTEGER*1}, @code{INTEGER*2}, and This inspired Craig to add further support, even though the resulting support would still be incomplete. +This support is believed to be completed at version 3.4 +of @command{gcc} by Roger Sayle (@email{roger@@eyesopen.com}). @item David Ronis (@email{ronis@@onsager.chem.mcgill.ca}) inspired @@ -797,10 +799,10 @@ files and accepts Fortran-specific command-line options, plus some command-line options that are designed to cater to Fortran users but apply to other languages as well. -@xref{G++ and GCC,,Compile C; C++; Objective-C; Ada; Fortran; -or Java,gcc,Using the GNU Compiler Collection (GCC)}, +@xref{G++ and GCC,,Programming Languages Supported by GCC,gcc,Using +the GNU Compiler Collection (GCC)}, for information on the way different languages are handled -by the GNU CC compiler (@command{gcc}). +by the GCC compiler (@command{gcc}). @cindex @command{g77}, command @cindex commands, @command{g77} @@ -849,7 +851,7 @@ by GNU Fortran. @cindex textbooks (If you need a text on Fortran, a few freely available electronic references have pointers from -@uref{http://www.fortran.com/fortran/Books/}. There is a `cooperative +@uref{http://www.fortran.com/F/books.html}. There is a `cooperative net project', @cite{User Notes on Fortran Programming} at @uref{ftp://vms.huji.ac.il/fortran/} and mirrors elsewhere; some of this material might not apply specifically to @command{g77}.) @@ -6898,13 +6900,6 @@ without having to traverse C-like structures and unions, while @command{f2c} is unlikely to ever offer this ability (due to limitations in the C language). -However, due to apparent bugs in the back end, @command{g77} currently doesn't -take advantage of this facility at all---it doesn't emit any debugging -information for @code{COMMON} and @code{EQUIVALENCE} areas, -other than information -on the array of @code{char} it creates (and, in the case -of local @code{EQUIVALENCE}, names) for each such area. - Yet another example is arrays. @command{g77} represents them to the debugger using the same ``dimensionality'' as in the source code, while @command{f2c} @@ -8000,13 +7995,6 @@ Progress is being made on making this work @command{gcc}, and some of the relevant operating systems (such as GNU/Linux). -@cindex alignment testing -@cindex testing alignment -A package that tests the degree to which a Fortran compiler -(such as @command{g77}) -aligns 64-bit floating-point variables and arrays -is available at @uref{ftp://alpha.gnu.org/gnu/g77/align/}. - @node Prefer Automatic Uninitialized Variables @subsection Prefer Automatic Uninitialized Variables @@ -8088,10 +8076,6 @@ Some of these problems are due to bugs in other software, some are missing features that are too much work to add, and some are places where people's opinions differ as to what is best. -To find out about major bugs discovered in the current release and -possible workarounds for them, see -@uref{ftp://alpha.gnu.org/g77.plan}. - (Note that some of this portion of the manual is lifted directly from the @command{gcc} manual, with minor modifications to tailor it to users of @command{g77}. @@ -8627,24 +8611,17 @@ Goldberg, `What Every Computer Scientist Should Know About Floating-Point Arithmetic', Computing Surveys, 23, March 1991, pp.@: 5-48. An online version is available at -@uref{http://docs.sun.com/}, -and there is a supplemented version, in PostScript form, at -@uref{http://www.validgh.com/goldberg/paper.ps}. +@uref{http://docs.sun.com/}. -Information related to the IEEE 754 -floating-point standard by a leading light can be found at +Information related to the IEEE 754 floating-point standard can be found +at @uref{http://grouper.ieee.org/groups/754/} and @uref{http://http.cs.berkeley.edu/%7Ewkahan/ieee754status/}; see also slides from the short course referenced from @uref{http://http.cs.berkeley.edu/%7Efateman/}. -@uref{http://www.linuxsupportline.com/%7Ebillm/} has a brief -guide to IEEE 754, a somewhat x86-GNU/Linux-specific FAQ, -and library code for GNU/Linux x86 systems. The supplement to the PostScript-formatted Goldberg document, referenced above, is available in HTML format. -See `Differences Among IEEE 754 Implementations' by Doug Priest, -available online at -@uref{http://www.validgh.com/goldberg/addendum.html}. +See `Differences Among IEEE 754 Implementations' by Doug Priest. This document explores some of the issues surrounding computing of extended (80-bit) results on processors such as the x86, especially when those results are arbitrarily truncated @@ -10635,7 +10612,7 @@ ways to find it: @item Look in the service directory for someone who might help you for a fee. The service directory is found in the file named @file{SERVICE} in the -GNU CC distribution. +GCC distribution. @item Send a message to @email{@value{email-help}}. @@ -10777,8 +10754,6 @@ are passed via this mechanism. If you want to contribute to @command{g77} by doing research, design, specification, documentation, coding, or testing, the following information should give you some ideas. -More relevant information might be available from -@uref{ftp://alpha.gnu.org/gnu/g77/projects/}. @menu * Efficiency:: Make @command{g77} itself compile code faster. diff --git a/contrib/gcc/f/global.c b/contrib/gcc/f/global.c index 1fe9270..8793f62 100644 --- a/contrib/gcc/f/global.c +++ b/contrib/gcc/f/global.c @@ -1,5 +1,5 @@ /* global.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1997 Free Software Foundation, Inc. + Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -62,14 +62,14 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA static ffenameSpace ffeglobal_filewide_ = NULL; static const char *const ffeglobal_type_string_[] = { - [FFEGLOBAL_typeNONE] "??", - [FFEGLOBAL_typeMAIN] "main program", - [FFEGLOBAL_typeEXT] "external", - [FFEGLOBAL_typeSUBR] "subroutine", - [FFEGLOBAL_typeFUNC] "function", - [FFEGLOBAL_typeBDATA] "block data", - [FFEGLOBAL_typeCOMMON] "common block", - [FFEGLOBAL_typeANY] "?any?" + [FFEGLOBAL_typeNONE] = "??", + [FFEGLOBAL_typeMAIN] = "main program", + [FFEGLOBAL_typeEXT] = "external", + [FFEGLOBAL_typeSUBR] = "subroutine", + [FFEGLOBAL_typeFUNC] = "function", + [FFEGLOBAL_typeBDATA] = "block data", + [FFEGLOBAL_typeCOMMON] = "common block", + [FFEGLOBAL_typeANY] = "?any?" }; #endif @@ -107,12 +107,9 @@ ffeglobal_new_ (ffename n) assert (n != NULL); - g = (ffeglobal) malloc_new_ks (malloc_pool_image (), "FFEGLOBAL", - sizeof (*g)); + g = malloc_new_ks (malloc_pool_image (), "FFEGLOBAL", sizeof (*g)); g->n = n; -#ifdef FFECOM_globalHOOK g->hook = FFECOM_globalNULL; -#endif g->tick = 0; ffename_set_global (n, g); @@ -126,7 +123,7 @@ ffeglobal_new_ (ffename n) ffeglobal_init_1(); */ void -ffeglobal_init_1 () +ffeglobal_init_1 (void) { #if FFEGLOBAL_ENABLED if (ffeglobal_filewide_ != NULL) @@ -782,10 +779,9 @@ ffeglobal_proc_def_nargs (ffesymbol s, int n_args) return; } - g->u.proc.arg_info - = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (), - "ffeglobalArgInfo_", - n_args * sizeof (g->u.proc.arg_info[0])); + g->u.proc.arg_info = malloc_new_ks (malloc_pool_image (), + "ffeglobalArgInfo_", + n_args * sizeof (g->u.proc.arg_info[0])); while (n_args-- > 0) g->u.proc.arg_info[n_args].t = NULL; } @@ -1125,10 +1121,9 @@ ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t) return TRUE; } - g->u.proc.arg_info - = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (), - "ffeglobalArgInfo_", - n_args * sizeof (g->u.proc.arg_info[0])); + g->u.proc.arg_info = malloc_new_ks (malloc_pool_image (), + "ffeglobalArgInfo_", + n_args * sizeof (g->u.proc.arg_info[0])); while (n_args-- > 0) g->u.proc.arg_info[n_args].t = NULL; @@ -1430,9 +1425,7 @@ ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) /* We've learned more, so point to where we learned it. */ g->t = ffelex_token_use (t); g->type = type; -#ifdef FFECOM_globalHOOK g->hook = FFECOM_globalNULL; /* Discard previous _DECL. */ -#endif g->u.proc.n_args = -1; } @@ -1588,6 +1581,6 @@ ffeglobal_size_common (ffesymbol s, ffetargetOffset size) #endif void -ffeglobal_terminate_1 () +ffeglobal_terminate_1 (void) { } diff --git a/contrib/gcc/f/global.h b/contrib/gcc/f/global.h index 15d984f..dc499df 100644 --- a/contrib/gcc/f/global.h +++ b/contrib/gcc/f/global.h @@ -1,5 +1,5 @@ /* global.h -- Public #include File (module.h template V1.0) - Copyright (C) 1995, 1997 Free Software Foundation, Inc. + Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -89,9 +89,7 @@ struct _ffeglobal_ { ffelexToken t; ffename n; -#ifdef FFECOM_globalHOOK ffecomGlobal hook; -#endif ffeCounter tick; /* Recent transition in this progunit. */ ffeglobalType type; bool intrinsic; /* Known as intrinsic? */ diff --git a/contrib/gcc/f/implic.c b/contrib/gcc/f/implic.c index 6fe4606..c7a28cb 100644 --- a/contrib/gcc/f/implic.c +++ b/contrib/gcc/f/implic.c @@ -1,5 +1,5 @@ /* implic.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -220,7 +220,7 @@ ffeimplic_establish_symbol (ffesymbol s) Allows for holes in the sequence of letters (i.e. EBCDIC). */ void -ffeimplic_init_2 () +ffeimplic_init_2 (void) { ffeimplic_ imp; char c; @@ -312,7 +312,7 @@ ffeimplic_init_2 () Assigns null type information to all initial letters. */ void -ffeimplic_none () +ffeimplic_none (void) { ffeimplic_ imp; @@ -378,6 +378,6 @@ ffeimplic_peek_symbol_type (ffesymbol s, const char *name) Kills info object for each entry in table. */ void -ffeimplic_terminate_2 () +ffeimplic_terminate_2 (void) { } diff --git a/contrib/gcc/f/info.c b/contrib/gcc/f/info.c index 1bedaa0..3c0030f 100644 --- a/contrib/gcc/f/info.c +++ b/contrib/gcc/f/info.c @@ -1,5 +1,5 @@ /* info.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -141,7 +141,7 @@ ffeinfo_basictype_string (ffeinfoBasictype basictype) ffeinfo_init_0(); */ void -ffeinfo_init_0 () +ffeinfo_init_0 (void) { ffeinfoBasictype i; ffeinfoBasictype j; diff --git a/contrib/gcc/f/intdoc.c b/contrib/gcc/f/intdoc.c index fb88e88..b24c79a 100644 --- a/contrib/gcc/f/intdoc.c +++ b/contrib/gcc/f/intdoc.c @@ -1,5 +1,6 @@ /* intdoc.c - Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc. + Copyright (C) 1997, 2000, 2001, 2003 + Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -22,8 +23,10 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* From f/proj.h, which uses #error -- not all C compilers support that, and we want *this* program to be compilable by pretty much any C compiler. */ -#include "hconfig.h" +#include "bconfig.h" #include "system.h" +#include "coretypes.h" +#include "tm.h" #include "assert.h" /* Pull in the intrinsics info, but only the doc parts. */ @@ -235,13 +238,13 @@ dumpif (ffeintrinFamily fam) } static void -dumpendif () +dumpendif (void) { in_ifset = 2; } static void -dumpclearif () +dumpclearif (void) { if ((in_ifset == 2) || (latest_family != FFEINTRIN_familyNONE)) @@ -251,7 +254,7 @@ dumpclearif () } static void -dumpem () +dumpem (void) { int i; diff --git a/contrib/gcc/f/intdoc.in b/contrib/gcc/f/intdoc.in index 55d426a..6f2423f 100644 --- a/contrib/gcc/f/intdoc.in +++ b/contrib/gcc/f/intdoc.in @@ -2401,7 +2401,7 @@ See @code{signal(2)}. Note that @var{@2@} will be called using C conventions, so the value of its argument in Fortran terms -Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it. +Fortran terms is obtained by applying @code{%LOC()} (or @code{LOC()}) to it. The value returned by @code{signal(2)} is written to @var{@3@}, if that argument is supplied. @@ -2451,7 +2451,7 @@ See @code{signal(2)}. Note that @var{@2@} will be called using C conventions, so the value of its argument in Fortran terms -is obtained by applying @code{%LOC()} (or @var{LOC()}) to it. +is obtained by applying @code{%LOC()} (or @code{LOC()}) to it. The value returned by @code{signal(2)} is returned. diff --git a/contrib/gcc/f/intdoc.texi b/contrib/gcc/f/intdoc.texi index 7de4257..e657510 100644 --- a/contrib/gcc/f/intdoc.texi +++ b/contrib/gcc/f/intdoc.texi @@ -9500,7 +9500,7 @@ See @code{signal(2)}. Note that @var{Handler} will be called using C conventions, so the value of its argument in Fortran terms -Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it. +Fortran terms is obtained by applying @code{%LOC()} (or @code{LOC()}) to it. The value returned by @code{signal(2)} is written to @var{Status}, if that argument is supplied. @@ -9579,7 +9579,7 @@ See @code{signal(2)}. Note that @var{Handler} will be called using C conventions, so the value of its argument in Fortran terms -is obtained by applying @code{%LOC()} (or @var{LOC()}) to it. +is obtained by applying @code{%LOC()} (or @code{LOC()}) to it. The value returned by @code{signal(2)} is returned. diff --git a/contrib/gcc/f/intrin.c b/contrib/gcc/f/intrin.c index 1c6c00c..a379684 100644 --- a/contrib/gcc/f/intrin.c +++ b/contrib/gcc/f/intrin.c @@ -1,5 +1,6 @@ /* intrin.c -- Recognize references to intrinsics - Copyright (C) 1995, 1996, 1997, 1998, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997, 1998, 2002, + 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -1389,7 +1390,7 @@ ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t) if (!highly_specific && (nimp != FFEINTRIN_impNONE)) { fprintf (stderr, "lineno=%ld, gen=%s, imp=%s, timp=%s\n", - (long) lineno, + (long) input_line, ffeintrin_gens_[gen].name, ffeintrin_imps_[imp].name, ffeintrin_imps_[nimp].name); @@ -1588,7 +1589,7 @@ ffeintrin_gfrt_indirect (ffeintrinImp imp) } void -ffeintrin_init_0 () +ffeintrin_init_0 (void) { int i; const char *p1; diff --git a/contrib/gcc/f/invoke.texi b/contrib/gcc/f/invoke.texi index 50c7ca4..fd1b804 100644 --- a/contrib/gcc/f/invoke.texi +++ b/contrib/gcc/f/invoke.texi @@ -1,11 +1,11 @@ -@c Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +@c Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 @c Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @ignore @c man begin COPYRIGHT -Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002 +Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -255,7 +255,7 @@ program is written is generally indicated by the suffix. Suffixes specific to GNU Fortran are listed below. @xref{Overall Options,,Options Controlling the Kind of Output,gcc,Using the GNU Compiler Collection (GCC)}, for -information on suffixes recognized by GNU CC. +information on suffixes recognized by GCC. @table @gcctabopt @cindex .f filename suffix @@ -286,7 +286,7 @@ You can force @samp{.f} files to be preprocessed by @command{cpp} by using @item @var{file}.fpp @item @var{file}.FPP Fortran source code that must be preprocessed (by the C preprocessor -@command{cpp}, which is part of GNU CC). +@command{cpp}, which is part of GCC). Note that preprocessing is not extended to the contents of files included by the @code{INCLUDE} directive---the @code{#include} @@ -300,9 +300,7 @@ preprocessor directive must be used instead. Ratfor source code, which must be preprocessed by the @command{ratfor} command, which is available separately (as it is not yet part of the GNU Fortran distribution). -One version in Fortran, adapted for use with @command{g77} is at -@uref{ftp://members.aol.com/n8tm/rat7.uue} (of uncertain copyright -status). Another, public domain version in C is at +A public domain version in C is at @uref{http://sepwww.stanford.edu/sep/prof/ratfor.shar.2}. @end table diff --git a/contrib/gcc/f/lab.c b/contrib/gcc/f/lab.c index a870a7f..1d27874 100644 --- a/contrib/gcc/f/lab.c +++ b/contrib/gcc/f/lab.c @@ -1,5 +1,5 @@ /* lab.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -94,7 +94,7 @@ ffelab_find (ffelabValue v) Kill all the labels on the list. */ void -ffelab_finish () +ffelab_finish (void) { ffelab l; ffelab pl; @@ -115,7 +115,7 @@ ffelab_finish () unit is going to be processed. */ void -ffelab_init_3 () +ffelab_init_3 (void) { ffelab_list_ = NULL; ffelab_num_news_ = 0; @@ -141,11 +141,9 @@ ffelab_new (ffelabValue v) ffelab l; ++ffelab_num_news_; - l = (ffelab) malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l)); + l = malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l)); l->next = ffelab_list_; -#ifdef FFECOM_labelHOOK l->hook = FFECOM_labelNULL; -#endif l->value = v; l->firstref_line = ffewhere_line_unknown (); l->firstref_col = ffewhere_column_unknown (); diff --git a/contrib/gcc/f/lab.h b/contrib/gcc/f/lab.h index fba3808..f3f8986 100644 --- a/contrib/gcc/f/lab.h +++ b/contrib/gcc/f/lab.h @@ -1,5 +1,5 @@ /* lab.h -- Public #include File (module.h template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -70,9 +70,7 @@ typedef unsigned long ffelabValue; struct _ffelab_ { ffelab next; -#ifdef FFECOM_labelHOOK ffecomLabel hook; -#endif ffelabValue value; /* 1 through 99999, or 100000+ for temp labels. */ unsigned long blocknum; /* Managed entirely by user of module. */ diff --git a/contrib/gcc/f/lang-specs.h b/contrib/gcc/f/lang-specs.h index 62b78c6..9ed51ef 100644 --- a/contrib/gcc/f/lang-specs.h +++ b/contrib/gcc/f/lang-specs.h @@ -31,14 +31,14 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA {"@f77-cpp-input", "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ %{E|M|MM:%(cpp_debug_options)}\ - %{!M:%{!MM:%{!E:%{!pipe:%g.f} |\n\ - f771 %{!pipe:%g.f} %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}}}", 0}, + %{!M:%{!MM:%{!E: -o %|.f |\n\ + f771 %|.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}}}", 0}, {".r", "@ratfor", 0}, {"@ratfor", - "%{C:%{!E:%eGNU C does not support -C without using -E}}\ - %{CC:%{!E:%eGNU C does not support -CC without using -E}}\ + "%{C:%{!E:%eGCC does not support -C without using -E}}\ + %{CC:%{!E:%eGCC does not support -CC without using -E}}\ ratfor %{C} %{CC} %{v} %{E:%W{o*}} %{!E: %{!pipe:-o %g.f} %i |\n\ - f771 %{!pipe:%g.f} %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}", 0}, + f771 %m.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}", 0}, {".f", "@f77", 0}, {".for", "@f77", 0}, {".FOR", "@f77", 0}, diff --git a/contrib/gcc/f/lang.opt b/contrib/gcc/f/lang.opt new file mode 100644 index 0000000..d6a53b7 --- /dev/null +++ b/contrib/gcc/f/lang.opt @@ -0,0 +1,402 @@ +; Options for the Fortran 77 front end. +; Copyright (C) 2003 Free Software Foundation, Inc. +; +; This file is part of GCC. +; +; GCC is free software; you can redistribute it and/or modify it under +; the terms of the GNU General Public License as published by the Free +; Software Foundation; either version 2, or (at your option) any later +; version. +; +; GCC is distributed in the hope that it will be useful, but WITHOUT ANY +; WARRANTY; without even the implied warranty of MERCHANTABILITY or +; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +; for more details. +; +; You should have received a copy of the GNU General Public License +; along with GCC; see the file COPYING. If not, write to the Free +; Software Foundation, 59 Temple Place - Suite 330, Boston, MA +; 02111-1307, USA. + +; See c.opt for a description of this file's format. + +; Please try to keep this file in ASCII collating order. + +Language +F77 + +I +F77 Joined +Add a directory for INCLUDE searching + +Wall +F77 +; Documented in C + +Wcomment +F77 + +Wcomments +F77 + +Wglobals +F77 +Enable warnings about inter-procedural problems + +Wimplicit +F77 + +Wimport +F77 + +Wsurprising +F77 +Warn about constructs with surprising meanings + +Wtrigraphs +F77 + +fautomatic +F77 +Do not treat local variables and COMMON blocks as if they were named in SAVE statements + +fbackslash +F77 +Backslashes in character and hollerith constants are special (not C-style) + +fbadu77-intrinsics-delete +F77 RejectNegative +Delete libU77 intrinsics with bad interfaces + +fbadu77-intrinsics-disable +F77 RejectNegative +Disable libU77 intrinsics with bad interfaces + +fbadu77-intrinsics-enable +F77 RejectNegative +Enable libU77 intrinsics with bad interfaces + +fbadu77-intrinsics-hide +F77 RejectNegative +Hide libU77 intrinsics with bad interfaces + +fcase-initcap +F77 RejectNegative +Program written in strict mixed-case + +fcase-lower +F77 RejectNegative +Compile as if program written in lowercase + +fcase-preserve +F77 RejectNegative +Preserve case used in program + +fcase-strict-lower +F77 RejectNegative +Program written in lowercase + +fcase-strict-upper +F77 RejectNegative +Program written in uppercase + +fcase-upper +F77 RejectNegative +Compile as if program written in uppercase + +fdebug-kludge +F77 +Emit special debugging information for COMMON and EQUIVALENCE (disabled) + +fdollar-ok +F77 +Allow '$' in symbol names + +femulate-complex +F77 +Have front end emulate COMPLEX arithmetic to avoid bugs + +ff2c +F77 +f2c-compatible code can be generated + +ff2c-intrinsics-delete +F77 RejectNegative +Delete non-FORTRAN-77 intrinsics f2c supports + +ff2c-intrinsics-disable +F77 RejectNegative +Disable non-FORTRAN-77 intrinsics f2c supports + +ff2c-intrinsics-enable +F77 RejectNegative +Enable non-FORTRAN-77 intrinsics f2c supports + +ff2c-intrinsics-hide +F77 RejectNegative +Hide non-FORTRAN-77 intrinsics f2c supports + +ff2c-library +F77 +Unsupported; generate libf2c-calling code + +ff66 +F77 +Program is written in typical FORTRAN 66 dialect + +ff77 +F77 +Program is written in typical Unix-f77 dialect + +ff90 +F77 +Program is written in Fortran-90-ish dialect + +ff90-intrinsics-delete +F77 RejectNegative +Delete non-FORTRAN-77 intrinsics F90 supports + +ff90-intrinsics-disable +F77 RejectNegative +Disable non-FORTRAN-77 intrinsics F90 supports + +ff90-intrinsics-enable +F77 RejectNegative +Enable non-FORTRAN-77 intrinsics F90 supports + +ff90-intrinsics-hide +F77 RejectNegative +Hide non-FORTRAN-77 intrinsics F90 supports + +ff90-not-vxt +F77 RejectNegative + +ffixed-form +F77 + +ffixed-line-length- +F77 Joined +ffixed-line-length-<number> Set the maximum line length to <number> + +fflatten-arrays +F77 +Unsupported; affects code generation of arrays + +ffortran-bounds-check +F77 +Generate code to check subscript and substring bounds + +ffree-form +F77 +Program is written in Fortran-90-ish free form + +fglobals +F77 +Enable fatal diagnostics about inter-procedural problems + +fgnu-intrinsics-delete +F77 RejectNegative +Delete non-FORTRAN-77 intrinsics g77 supports + +fgnu-intrinsics-disable +F77 RejectNegative +Disable non-FORTRAN 77 intrinsics F90 supports + +fgnu-intrinsics-enable +F77 RejectNegative +Enable non-FORTRAN 77 intrinsics F90 supports + +fgnu-intrinsics-hide +F77 RejectNegative +Hide non-FORTRAN 77 intrinsics F90 supports + +finit-local-zero +F77 +Initialize local vars and arrays to zero + +fintrin-case-any +F77 RejectNegative +Intrinsics letters in arbitrary cases + +fintrin-case-initcap +F77 RejectNegative +Intrinsics spelled as e.g. SqRt + +fintrin-case-lower +F77 RejectNegative +Intrinsics in lowercase + +fintrin-case-upper +F77 RejectNegative +Intrinsics in uppercase + +fmatch-case-any +F77 RejectNegative +Language keyword letters in arbitrary cases + +fmatch-case-initcap +F77 RejectNegative +Language keywords spelled as e.g. IOStat + +fmatch-case-lower +F77 RejectNegative +Language keywords in lowercase + +fmatch-case-upper +F77 RejectNegative +Language keywords in uppercase + +fmil-intrinsics-delete +F77 RejectNegative +Delete MIL-STD 1753 intrinsics + +fmil-intrinsics-disable +F77 RejectNegative +Disable MIL-STD 1753 intrinsics + +fmil-intrinsics-enable +F77 RejectNegative +Enable MIL-STD 1753 intrinsics + +fmil-intrinsics-hide +F77 RejectNegative +Hide MIL-STD 1753 intrinsics + +fonetrip +F77 +Take at least one trip through each iterative DO loop + +fpedantic +F77 +Warn about use of (only a few for now) Fortran extensions + +fpreprocessed +F77 + +fsecond-underscore +F77 +Allow appending a second underscore to externals + +fsilent +F77 +Do not print names of program units as they are compiled + +fsource-case-lower +F77 RejectNegative +Internally convert most source to lowercase + +fsource-case-preserve +F77 RejectNegative +Internally preserve source case + +fsource-case-upper +F77 RejectNegative +Internally convert most source to uppercase + +fsymbol-case-any +F77 RejectNegative + +fsymbol-case-initcap +F77 RejectNegative +Symbol names spelled in mixed case + +fsymbol-case-lower +F77 RejectNegative +Symbol names in lowercase + +fsymbol-case-upper +F77 RejectNegative +Symbol names in uppercase + +ftypeless-boz +F77 +Make prefix-radix non-decimal constants be typeless + +fugly +F77 +Allow all ugly features + +fugly-args +F77 +Hollerith and typeless can be passed as arguments + +fugly-assign +F77 +Allow ordinary copying of ASSIGN'ed vars + +fugly-assumed +F77 +Dummy array dimensioned to (1) is assumed-size + +fugly-comma +F77 +Trailing comma in procedure call denotes null argument + +fugly-complex +F77 +Allow REAL(Z) and AIMAG(Z) given DOUBLE COMPLEX Z + +fugly-init +F77 +Initialization via DATA and PARAMETER is not type-compatible + +fugly-logint +F77 +Allow INTEGER and LOGICAL interchangeability + +funderscoring +F77 +Append underscores to externals + +funix-intrinsics-delete +F77 RejectNegative +Delete libU77 intrinsics + +funix-intrinsics-disable +F77 RejectNegative +Disable libU77 intrinsics + +funix-intrinsics-enable +F77 RejectNegative +Enable libU77 intrinsics + +funix-intrinsics-hide +F77 RejectNegative +Hide libU77 intrinsics + +fversion +F77 RejectNegative +Print g77-specific version information and run internal tests + +fvxt +F77 +Program is written in VXT (Digital-like) FORTRAN + +fvxt-intrinsics-delete +F77 RejectNegative +Delete non-FORTRAN-77 intrinsics VXT FORTRAN supports + +fvxt-intrinsics-disable +F77 RejectNegative +Disable non-FORTRAN-77 intrinsics VXT FORTRAN supports + +fvxt-intrinsics-enable +F77 RejectNegative +Enable non-FORTRAN-77 intrinsics VXT FORTRAN supports + +fvxt-intrinsics-hide +F77 RejectNegative +Hide non-FORTRAN-77 intrinsics VXT FORTRAN supports + +fvxt-not-f90 +F77 RejectNegative + +fxyzzy +F77 +Print internal debugging-related information + +fzeros +F77 +Treat initial values of 0 like non-zero values + +; This comment is to ensure we retain the blank line above. diff --git a/contrib/gcc/f/lex.c b/contrib/gcc/f/lex.c index 6d065dd..8475d2f 100644 --- a/contrib/gcc/f/lex.c +++ b/contrib/gcc/f/lex.c @@ -1,5 +1,5 @@ /* Implementation of Fortran lexer - Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002 + Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. @@ -219,11 +219,6 @@ ffelex_append_to_token_ (char c) ffelex_token_->size <<= 1; assert (ffelex_token_->length < ffelex_token_->size); } -#ifdef MAP_CHARACTER -Sorry, MAP_CHARACTER is not going to work as expected in GNU Fortran, -please contact fortran@gnu.org if you wish to fund work to -port g77 to non-ASCII machines. -#endif ffelex_token_->text[ffelex_token_->length++] = c; } @@ -699,7 +694,13 @@ ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c) register unsigned bytes_used = (p - q); buffer_length *= 2; - q = (char *)xrealloc (q, buffer_length); + if (q == &buff[0]) + { + q = xmalloc (buffer_length); + memcpy (q, buff, bytes_used); + } + else + q = xrealloc (q, buffer_length); p = &q[bytes_used]; r = &q[buffer_length]; } @@ -726,7 +727,7 @@ ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c) { bool done = FALSE; int use_d = 0; - int d; + int d = 0; switch (c) { @@ -759,7 +760,13 @@ ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c) register unsigned bytes_used = (p - q); buffer_length = bytes_used * 2; - q = (char *)xrealloc (q, buffer_length); + if (q == &buff[0]) + { + q = xmalloc (buffer_length); + memcpy (q, buff, bytes_used); + } + else + q = xrealloc (q, buffer_length); p = &q[bytes_used]; r = &q[buffer_length]; } @@ -788,7 +795,7 @@ ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c) } static void -ffelex_file_pop_ (const char *input_filename) +ffelex_file_pop_ (const char *filename) { if (input_file_stack->next) { @@ -796,7 +803,7 @@ ffelex_file_pop_ (const char *input_filename) input_file_stack = p->next; free (p); input_file_stack_tick++; - (*debug_hooks->end_source_file) (input_file_stack->line); + (*debug_hooks->end_source_file) (input_file_stack->location.line); } else error ("#-lines for entering and leaving files don't match"); @@ -804,27 +811,26 @@ ffelex_file_pop_ (const char *input_filename) /* Now that we've pushed or popped the input stack, update the name in the top element. */ if (input_file_stack) - input_file_stack->name = input_filename; + input_file_stack->location.file = filename; } static void -ffelex_file_push_ (int old_lineno, const char *input_filename) +ffelex_file_push_ (int old_lineno, const char *filename) { - struct file_stack *p - = (struct file_stack *) xmalloc (sizeof (struct file_stack)); + struct file_stack *p = xmalloc (sizeof (struct file_stack)); - input_file_stack->line = old_lineno; + input_file_stack->location.line = old_lineno; p->next = input_file_stack; - p->name = input_filename; + p->location.file = filename; input_file_stack = p; input_file_stack_tick++; - (*debug_hooks->start_source_file) (0, input_filename); + (*debug_hooks->start_source_file) (0, filename); /* Now that we've pushed or popped the input stack, update the name in the top element. */ if (input_file_stack) - input_file_stack->name = input_filename; + input_file_stack->location.file = filename; } /* Prepare to finish a statement-in-progress by sending the current @@ -834,7 +840,7 @@ ffelex_file_push_ (int old_lineno, const char *input_filename) typical fixed-form cases. */ static void -ffelex_prepare_eos_ () +ffelex_prepare_eos_ (void) { if (ffelex_token_->type != FFELEX_typeNONE) { @@ -883,7 +889,7 @@ ffelex_prepare_eos_ () } static void -ffelex_finish_statement_ () +ffelex_finish_statement_ (void) { if ((ffelex_number_of_tokens_ == 0) && (ffelex_token_->type == FFELEX_typeNONE)) @@ -928,7 +934,7 @@ ffelex_get_directive_line_ (char **text, FILE *finput) if (buffer_length == 0) { - directive_buffer = (char *)xmalloc (128); + directive_buffer = xmalloc (128); buffer_length = 128; } @@ -944,8 +950,7 @@ ffelex_get_directive_line_ (char **text, FILE *finput) register unsigned bytes_used = (p - directive_buffer); buffer_length *= 2; - directive_buffer - = (char *)xrealloc (directive_buffer, buffer_length); + directive_buffer = xrealloc (directive_buffer, buffer_length); p = &directive_buffer[bytes_used]; buffer_limit = &directive_buffer[buffer_length]; } @@ -997,22 +1002,6 @@ ffelex_get_directive_line_ (char **text, FILE *finput) Returns the next character unhandled, which is always newline or EOF. */ -#if defined HANDLE_PRAGMA -/* Local versions of these macros, that can be passed as function pointers. */ -static int -pragma_getc () -{ - return getc (finput); -} - -static void -pragma_ungetc (arg) - int arg; -{ - ungetc (arg, finput); -} -#endif /* HANDLE_PRAGMA */ - static int ffelex_hash_ (FILE *finput) { @@ -1041,46 +1030,9 @@ ffelex_hash_ (FILE *finput) && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n' || c == EOF)) { -#if 0 /* g77 doesn't handle pragmas, so ignores them FOR NOW. */ - static char buffer [128]; - char * buff = buffer; - - /* Read the pragma name into a buffer. - ISSPACE() may evaluate its argument more than once! */ - while (((c = getc (finput)), ISSPACE(c))) - continue; - - do - { - * buff ++ = c; - c = getc (finput); - } - while (c != EOF && ! ISSPACE (c) && c != '\n' - && buff < buffer + 128); - - pragma_ungetc (c); - - * -- buff = 0; -#ifdef HANDLE_PRAGMA - if (HANDLE_PRAGMA (pragma_getc, pragma_ungetc, buffer)) - goto skipline; -#endif /* HANDLE_PRAGMA */ -#ifdef HANDLE_GENERIC_PRAGMAS - if (handle_generic_pragma (buffer)) - goto skipline; -#endif /* !HANDLE_GENERIC_PRAGMAS */ - - /* Issue a warning message if we have been asked to do so. - Ignoring unknown pragmas in system header file unless - an explcit -Wunknown-pragmas has been given. */ - if (warn_unknown_pragmas > 1 - || (warn_unknown_pragmas && ! in_system_header)) - warning ("ignoring pragma: %s", token_buffer); -#endif /* 0 */ goto skipline; } } - else if (c == 'd') { if (getc (finput) == 'e' @@ -1096,7 +1048,7 @@ ffelex_hash_ (FILE *finput) c = ffelex_get_directive_line_ (&text, finput); if (debug_info_level == DINFO_LEVEL_VERBOSE) - (*debug_hooks->define) (lineno, text); + (*debug_hooks->define) (input_line, text); goto skipline; } @@ -1115,7 +1067,7 @@ ffelex_hash_ (FILE *finput) c = ffelex_get_directive_line_ (&text, finput); if (debug_info_level == DINFO_LEVEL_VERBOSE) - (*debug_hooks->undef) (lineno, text); + (*debug_hooks->undef) (input_line, text); goto skipline; } @@ -1193,8 +1145,7 @@ ffelex_hash_ (FILE *finput) if ((token != NULL) && (ffelex_token_type (token) == FFELEX_typeNUMBER)) { - int old_lineno = lineno; - const char *old_input_filename = input_filename; + location_t old_loc = input_location; ffewhereFile wf; /* subtract one, because it is the following line that @@ -1207,7 +1158,7 @@ ffelex_hash_ (FILE *finput) if (c == '\n' || c == EOF) { /* No more: store the line number and check following line. */ - lineno = l; + input_line = l; if (!ffelex_kludge_flag_) { ffewhere_file_set (NULL, TRUE, (ffewhereLineNumber) l); @@ -1230,7 +1181,7 @@ ffelex_hash_ (FILE *finput) goto skipline; } - lineno = l; + input_line = l; if (ffelex_kludge_flag_) input_filename = ggc_strdup (ffelex_token_text (token)); @@ -1260,7 +1211,7 @@ ffelex_hash_ (FILE *finput) { /* Update the name in the top element of input_file_stack. */ if (input_file_stack) - input_file_stack->name = input_filename; + input_file_stack->location.file = input_filename; if (token != NULL) ffelex_token_kill (token); @@ -1280,15 +1231,15 @@ ffelex_hash_ (FILE *finput) if (ffelex_kludge_flag_) { - lineno = 1; - input_filename = old_input_filename; + input_line = 1; + input_filename = old_loc.file; error ("use `#line ...' instead of `# ...' in first line"); } if (num == 1) { /* Pushing to a new file. */ - ffelex_file_push_ (old_lineno, input_filename); + ffelex_file_push_ (old_loc.line, input_filename); } else if (num == 2) { @@ -1324,8 +1275,8 @@ ffelex_hash_ (FILE *finput) || (c != '\n' && c != EOF)) && ffelex_kludge_flag_) { - lineno = 1; - input_filename = old_input_filename; + input_line = 1; + input_filename = old_loc.file; error ("use `#line ...' instead of `# ...' in first line"); } if (c == '\n' || c == EOF) @@ -1452,7 +1403,7 @@ ffelex_image_char_ (int c, ffewhereColumnNumber column) } static void -ffelex_include_ () +ffelex_include_ (void) { ffewhereFile include_wherefile = ffelex_include_wherefile_; FILE *include_file = ffelex_include_file_; @@ -1470,8 +1421,7 @@ ffelex_include_ () ffewhereLineNumber linecount_current = ffelex_linecount_current_; ffewhereLineNumber linecount_offset = ffewhere_line_filelinenum (current_wl); - int old_lineno = lineno; - const char *old_input_filename = input_filename; + location_t old_loc = input_location; if (card_length != 0) { @@ -1489,7 +1439,7 @@ ffelex_include_ () ffewhere_file_set (include_wherefile, TRUE, 0); - ffelex_file_push_ (old_lineno, ffewhere_file_name (include_wherefile)); + ffelex_file_push_ (old_loc.line, ffewhere_file_name (include_wherefile)); if (ffelex_include_free_form_) ffelex_file_free (include_wherefile, include_file); @@ -1504,16 +1454,12 @@ ffelex_include_ () if (card_length != 0) { -#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */ -#error "need to handle possible reduction of card size here!!" -#endif assert (ffelex_card_size_ >= card_length); /* It shrunk?? */ memcpy (ffelex_card_image_, card_image, card_length); } ffelex_card_image_[card_length] = '\0'; - input_filename = old_input_filename; - lineno = old_lineno; + input_location = old_loc; ffelex_linecount_current_ = linecount_current; ffelex_current_wf_ = current_wf; ffelex_final_nontab_column_ = final_nontab_column; @@ -1567,15 +1513,15 @@ ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col) } static void -ffelex_next_line_ () +ffelex_next_line_ (void) { ffelex_linecount_current_ = ffelex_linecount_next_; ++ffelex_linecount_next_; - ++lineno; + ++input_line; } static void -ffelex_send_token_ () +ffelex_send_token_ (void) { ++ffelex_number_of_tokens_; @@ -1649,14 +1595,13 @@ ffelex_swallow_tokens_ (ffelexToken t) } static ffelexToken -ffelex_token_new_ () +ffelex_token_new_ (void) { ffelexToken t; ++ffelex_total_tokens_; - t = (ffelexToken) malloc_new_ks (malloc_pool_image (), - "FFELEX token", sizeof (*t)); + t = malloc_new_ks (malloc_pool_image (), "FFELEX token", sizeof (*t)); t->id_ = ffelex_token_nextid_++; return t; } @@ -1747,7 +1692,7 @@ ffelex_display_token (ffelexToken t) return FALSE. */ bool -ffelex_expecting_character () +ffelex_expecting_character (void) { return (ffelex_raw_mode_ != 0); } @@ -1787,7 +1732,7 @@ ffelex_file_fixed (ffewhereFile wf, FILE *f) assert (ffelex_handler_ != NULL); - lineno = 0; + input_line = 0; input_filename = ffewhere_file_name (wf); ffelex_current_wf_ = wf; disallow_continuation_line = TRUE; @@ -1811,18 +1756,6 @@ ffelex_file_fixed (ffewhereFile wf, FILE *f) beginning_of_line_again: /* :::::::::::::::::::: */ -#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */ - if (ffelex_card_size_ != FFELEX_columnINITIAL_SIZE_) - { - ffelex_card_image_ - = malloc_resize_ks (malloc_pool_image (), - ffelex_card_image_, - FFELEX_columnINITIAL_SIZE_ + 9, - ffelex_card_size_ + 9); - ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_; - } -#endif - first_line: /* :::::::::::::::::::: */ c = latest_char_in_file; @@ -2977,7 +2910,7 @@ ffelex_file_free (ffewhereFile wf, FILE *f) assert (ffelex_handler_ != NULL); - lineno = 0; + input_line = 0; input_filename = ffewhere_file_name (wf); ffelex_current_wf_ = wf; continuation_line = FALSE; @@ -3896,7 +3829,7 @@ ffelex_hash_kludge (FILE *finput) } void -ffelex_init_1 () +ffelex_init_1 (void) { unsigned int i; @@ -3977,7 +3910,7 @@ ffelex_init_1 () Must be called while lexer is active, obviously. */ bool -ffelex_is_names_expected () +ffelex_is_names_expected (void) { return ffelex_names_; } @@ -3986,7 +3919,7 @@ ffelex_is_names_expected () ffelex_linecount_current_. */ char * -ffelex_line () +ffelex_line (void) { return ffelex_card_image_; } @@ -3998,7 +3931,7 @@ ffelex_line () Must be called while lexer is active, obviously. */ ffewhereColumnNumber -ffelex_line_length () +ffelex_line_length (void) { return ffelex_card_length_; } @@ -4007,7 +3940,7 @@ ffelex_line_length () is current. */ ffewhereLineNumber -ffelex_line_number () +ffelex_line_number (void) { return ffelex_linecount_current_; } @@ -4442,7 +4375,7 @@ ffelex_token_new_character (const char *s, ffewhereLine l, ffewhereColumn c) /* Make a new EOF token right after end of file. */ ffelexToken -ffelex_token_new_eof () +ffelex_token_new_eof (void) { ffelexToken t; diff --git a/contrib/gcc/f/malloc.c b/contrib/gcc/f/malloc.c index 77e2e4a..8c85511 100644 --- a/contrib/gcc/f/malloc.c +++ b/contrib/gcc/f/malloc.c @@ -1,5 +1,5 @@ /* malloc.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -101,13 +101,14 @@ malloc_kill_area_ (mallocPool pool UNUSED, mallocArea_ a) #if MALLOC_DEBUG assert (strcmp (a->name, ((char *) (a->where)) + a->size) == 0); #endif - malloc_kill_ (a->where, a->size); + malloc_kill_ (a->where - sizeof(mallocArea_*), a->size); a->next->previous = a->previous; a->previous->next = a->next; #if MALLOC_DEBUG pool->freed += a->size; pool->frees++; #endif + malloc_kill_ (a, offsetof (struct _malloc_area_, name) + strlen (a->name) + 1); @@ -136,7 +137,7 @@ malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a UNUSED) Call malloc_init before you do anything else. */ void -malloc_init () +malloc_init (void) { if (malloc_reserve_ != NULL) return; @@ -303,21 +304,9 @@ malloc_display_ (mallocArea_ a UNUSED) mallocArea_ malloc_find_inpool_ (mallocPool pool, void *ptr) { - mallocArea_ a; - mallocArea_ b = (mallocArea_) &pool->first; - int n = 0; - - for (a = pool->first; a != (mallocArea_) &pool->first; a = a->next) - { - assert (("Infinite loop detected" != NULL) && (a != b)); - if (a->where == ptr) - return a; - ++n; - if (n & 1) - b = b->next; - } - assert ("Couldn't find object in pool!" == NULL); - return NULL; + mallocArea_ *t; + t = (mallocArea_ *) (ptr - sizeof(mallocArea_)); + return *t; } /* malloc_kill_inpool_ -- Kill object @@ -388,6 +377,7 @@ malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocS void *ptr; mallocArea_ a; unsigned short i; + mallocArea_ *temp; if (pool == NULL) pool = malloc_pool_image (); @@ -397,11 +387,14 @@ malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocS || malloc_pool_find_ (pool, malloc_pool_image ())); #endif - ptr = malloc_new_ (s + (i = (MALLOC_DEBUG ? strlen (name) + 1 : 0))); + ptr = malloc_new_ (sizeof(mallocArea_*) + s + (i = (MALLOC_DEBUG ? strlen (name) + 1 : 0))); #if MALLOC_DEBUG strcpy (((char *) (ptr)) + s, name); #endif a = malloc_new_ (offsetof (struct _malloc_area_, name) + i); + temp = (mallocArea_ *) ptr; + *temp = a; + ptr = ptr + sizeof(mallocArea_*); switch (type) { /* A little optimization to speed up killing of non-permanent stuff. */ @@ -477,6 +470,7 @@ malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED, void *ptr, mallocSize ns, mallocSize os UNUSED) { mallocArea_ a; + mallocArea_ *temp; if (pool == NULL) pool = malloc_pool_image (); @@ -493,7 +487,10 @@ malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED, assert (a->size == os); assert (strcmp (a->name, ((char *) (ptr)) + os) == 0); #endif - ptr = malloc_resize_ (ptr, ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0)); + ptr = malloc_resize_ (ptr - sizeof(mallocArea_*), sizeof(mallocArea_*) + ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0)); + temp = (mallocArea_ *) ptr; + *temp = a; + ptr = ptr + sizeof(mallocArea_*); a->where = ptr; #if MALLOC_DEBUG a->size = ns; diff --git a/contrib/gcc/f/name.c b/contrib/gcc/f/name.c index 360279b..26f713e 100644 --- a/contrib/gcc/f/name.c +++ b/contrib/gcc/f/name.c @@ -105,7 +105,7 @@ ffename_find (ffenameSpace ns, ffelexToken t) if (found) return n; - newn = (ffename) malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n)); + newn = malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n)); newn->next = n; newn->previous = n->previous; n->previous = newn; @@ -232,8 +232,7 @@ ffename_space_new (mallocPool pool) { ffenameSpace ns; - ns = (ffenameSpace) malloc_new_ks (pool, "FFENAME space", - sizeof (*ns)); + ns = malloc_new_ks (pool, "FFENAME space", sizeof (*ns)); ns->first = (ffename) &ns->first; ns->last = (ffename) &ns->first; ns->pool = pool; diff --git a/contrib/gcc/f/news.texi b/contrib/gcc/f/news.texi index fe6fa80..9b34df0 100644 --- a/contrib/gcc/f/news.texi +++ b/contrib/gcc/f/news.texi @@ -1,4 +1,5 @@ -@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +@c 2003, 2004 @c Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @@ -8,9 +9,9 @@ @c Keep this the same as the dates above, since it's used @c in the standalone derivations of this file (e.g. NEWS). -@set copyrights-news 1995,1996,1997,1998,1999,2000,2001,2002,2003 +@set copyrights-news 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004 -@set last-update-news 2003-05-18 +@set last-update-news 2004-06-17 @ifset DOC-NEWS @include root.texi @@ -60,6 +61,9 @@ such changes to @command{g77}. @end ifset @ifclear USERVISONLY + +@emph{@code{GCC} 3.4.x is the last edition of @code{GCC} to contain @command{g77} - from @code{GCC} 3.5 onwards, use @command{gfortran}} + Changes made to recent versions of GNU Fortran are listed below, with the most recent version first. @@ -142,16 +146,26 @@ That's due to attempts to keep this development version of news about previous @command{g77} versions up-to-date. @end ifset -@ifclear USERVISONLY -An online, ``live'' version of this document -(derived directly from the mainline, development version -of @command{g77} within @command{gcc}) -is available at -@uref{http://gcc.gnu.org/onlinedocs/g77/News.html}. -@end ifclear - The following information was last updated on @value{last-update-news}: +@heading In @code{GCC} 3.4 versus @code{GCC} 3.3: +@itemize @bullet +@item +Problem Reports fixed (in chronological order of submission): +@table @code +@item 8485 +g77 doesn't accept INTEGER*8 constant in PARAMETER multiplication. +@item 11918 +(libf2c) isatty does not call f_init. +@item 12317 +Incorrect documentation for Fortran debugging features. +@end table +@item +Roger Sayle (@email{roger@@eyesopen.com}) fixed the remaining +problems with regard to the support of INTEGER*8, INTEGER*2 and INTEGER*1 +as a fallout of fixing PR 8485. +@end itemize + @heading In @code{GCC} 3.3 versus @code{GCC} 3.2: @itemize @bullet @item diff --git a/contrib/gcc/f/parse.c b/contrib/gcc/f/parse.c index 106ff3f..d822773 100644 --- a/contrib/gcc/f/parse.c +++ b/contrib/gcc/f/parse.c @@ -29,9 +29,9 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA extern FILE *finput; void -ffe_parse_file (set_yydebug) - int set_yydebug ATTRIBUTE_UNUSED; +ffe_parse_file (int set_yydebug ATTRIBUTE_UNUSED) { + const char *fname; ffewhereFile wf; if (ffe_is_version ()) @@ -40,8 +40,9 @@ ffe_parse_file (set_yydebug) if (!ffe_is_pedantic ()) ffe_set_is_pedantic (pedantic); - wf = ffewhere_file_new (main_input_filename, strlen (main_input_filename)); - ffecom_file (main_input_filename); + fname = main_input_filename ? main_input_filename : "<stdin>"; + wf = ffewhere_file_new (fname, strlen (fname)); + ffecom_file (fname); ffe_file (wf, finput); ffecom_finish_compile (); diff --git a/contrib/gcc/f/proj.h b/contrib/gcc/f/proj.h index 8cf54c9..0896bdf 100644 --- a/contrib/gcc/f/proj.h +++ b/contrib/gcc/f/proj.h @@ -24,12 +24,14 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #ifndef GCC_F_PROJ_H #define GCC_F_PROJ_H -#ifdef USE_HCONFIG -#include "hconfig.h" +#ifdef USE_BCONFIG +#include "bconfig.h" #else #include "config.h" #endif #include "system.h" +#include "coretypes.h" +#include "tm.h" #if (GCC_VERSION < 2000) #error "You have to use gcc 2.x to build g77." diff --git a/contrib/gcc/f/root.texi b/contrib/gcc/f/root.texi index d8619cc..1956abc 100644 --- a/contrib/gcc/f/root.texi +++ b/contrib/gcc/f/root.texi @@ -11,4 +11,4 @@ @set which-gcc GCC @set email-burley craig@@jcb-sc.com -@set www-burley http://world.std.com/%7Eburley +@set www-burley http://world.std.com/%7Eburley/ diff --git a/contrib/gcc/f/src.c b/contrib/gcc/f/src.c index 28c55cc..54fc777 100644 --- a/contrib/gcc/f/src.c +++ b/contrib/gcc/f/src.c @@ -1,5 +1,5 @@ /* src.c -- Implementation File - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -93,7 +93,7 @@ bool ffesrc_ok_match_noninit_lower_; /* Initialize table of alphabetic matches. */ void -ffesrc_init_1 () +ffesrc_init_1 (void) { int i; diff --git a/contrib/gcc/f/st.c b/contrib/gcc/f/st.c index 8f27f89..cdfdfb5 100644 --- a/contrib/gcc/f/st.c +++ b/contrib/gcc/f/st.c @@ -1,5 +1,5 @@ /* st.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -141,7 +141,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA yet been set. */ void -ffest_confirmed () +ffest_confirmed (void) { ffesta_confirmed (); } @@ -160,7 +160,7 @@ ffest_confirmed () processing a statement (make and destroy pools, et cetera). */ void -ffest_eof () +ffest_eof (void) { ffesta_eof (); } @@ -242,7 +242,7 @@ ffest_first (ffelexToken t) this list. Initializes the executable and nonexecutable lists. */ void -ffest_init_0 () +ffest_init_0 (void) { ffesta_init_0 (); ffestb_init_0 (); @@ -271,7 +271,7 @@ ffest_init_0 () this list. Initializes the executable and nonexecutable lists. */ void -ffest_init_1 () +ffest_init_1 (void) { ffesta_init_1 (); ffestb_init_1 (); @@ -300,7 +300,7 @@ ffest_init_1 () this list. Initializes the executable and nonexecutable lists. */ void -ffest_init_2 () +ffest_init_2 (void) { ffesta_init_2 (); ffestb_init_2 (); @@ -321,7 +321,7 @@ ffest_init_2 () ffest_init_3(); */ void -ffest_init_3 () +ffest_init_3 (void) { ffesta_init_3 (); ffestb_init_3 (); @@ -344,7 +344,7 @@ ffest_init_3 () ffest_init_4(); */ void -ffest_init_4 () +ffest_init_4 (void) { ffesta_init_4 (); ffestb_init_4 (); @@ -366,7 +366,7 @@ ffest_init_4 () Else returns FALSE. */ bool -ffest_is_entry_valid () +ffest_is_entry_valid (void) { return ffesta_is_entry_valid; } @@ -396,7 +396,7 @@ ffest_is_entry_valid () the ffestb call would be completely dropped without this mechanism. */ bool -ffest_is_inhibited () +ffest_is_inhibited (void) { return ffesta_is_inhibited (); } @@ -412,7 +412,7 @@ ffest_is_inhibited () is being run. */ bool -ffest_seen_first_exec () +ffest_seen_first_exec (void) { return ffesta_seen_first_exec; } @@ -421,7 +421,7 @@ ffest_seen_first_exec () user with a diagnostic if we're not inhibited. */ void -ffest_shutdown () +ffest_shutdown (void) { ffesta_shutdown (); } @@ -453,7 +453,7 @@ ffest_sym_exec_transition (ffesymbol s) ffest_terminate_0(); */ void -ffest_terminate_0 () +ffest_terminate_0 (void) { ffesta_terminate_0 (); ffestb_terminate_0 (); @@ -474,7 +474,7 @@ ffest_terminate_0 () ffest_terminate_1(); */ void -ffest_terminate_1 () +ffest_terminate_1 (void) { ffesta_terminate_1 (); ffestb_terminate_1 (); @@ -495,7 +495,7 @@ ffest_terminate_1 () ffest_terminate_2(); */ void -ffest_terminate_2 () +ffest_terminate_2 (void) { ffesta_terminate_2 (); ffestb_terminate_2 (); @@ -516,7 +516,7 @@ ffest_terminate_2 () ffest_terminate_3(); */ void -ffest_terminate_3 () +ffest_terminate_3 (void) { ffesta_terminate_3 (); ffestb_terminate_3 (); @@ -537,7 +537,7 @@ ffest_terminate_3 () ffest_terminate_4(); */ void -ffest_terminate_4 () +ffest_terminate_4 (void) { ffesta_terminate_4 (); ffestb_terminate_4 (); diff --git a/contrib/gcc/f/sta.c b/contrib/gcc/f/sta.c index 0b4c11a..ee75fa8 100644 --- a/contrib/gcc/f/sta.c +++ b/contrib/gcc/f/sta.c @@ -1,5 +1,5 @@ /* sta.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -183,7 +183,7 @@ ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named) invocation of ffestc_exec_transition. */ static bool -ffesta_inhibited_exec_transition_ () +ffesta_inhibited_exec_transition_ (void) { bool result; @@ -208,7 +208,7 @@ ffesta_inhibited_exec_transition_ () Clears the lists of executable and nonexecutable statements. */ static void -ffesta_reset_possibles_ () +ffesta_reset_possibles_ (void) { ffesta_num_possibles_ = 0; @@ -247,9 +247,8 @@ ffesta_save_ (ffelexToken t) if (saved_tokens == NULL) { saved_tokens - = (ffelexToken *) malloc_new_ksr (malloc_pool_image (), - "FFEST Saved Tokens", - (max_saved_tokens = 8) * sizeof (ffelexToken)); + = malloc_new_ksr (malloc_pool_image (), "FFEST Saved Tokens", + (max_saved_tokens = 8) * sizeof (ffelexToken)); /* Start off with 8. */ } else if (num_saved_tokens >= max_saved_tokens) @@ -258,10 +257,9 @@ ffesta_save_ (ffelexToken t) max_saved_tokens <<= 1; /* Multiply by two. */ assert (max_saved_tokens > toknum); saved_tokens - = (ffelexToken *) malloc_resize_ksr (malloc_pool_image (), - saved_tokens, - max_saved_tokens * sizeof (ffelexToken), - toknum * sizeof (ffelexToken)); + = malloc_resize_ksr (malloc_pool_image (), saved_tokens, + max_saved_tokens * sizeof (ffelexToken), + toknum * sizeof (ffelexToken)); } *(saved_tokens + num_saved_tokens++) = ffelex_token_use (t); @@ -337,7 +335,7 @@ ffesta_save_ (ffelexToken t) { /* No handler in this list, try exec list if not tried yet. */ if (ffesta_current_possible_ - == (ffestaPossible_) &ffesta_possible_nonexecs_) + == (ffestaPossible_) &ffesta_possible_nonexecs_.first) { ffesta_current_possible_ = ffesta_possible_execs_.first; ffesta_current_handler_ = ffesta_current_possible_->handler; @@ -381,7 +379,7 @@ ffesta_save_ (ffelexToken t) { if (possible->handler == NULL) { - if (possible == (ffestaPossible_) &ffesta_possible_nonexecs_) + if (possible == (ffestaPossible_) &ffesta_possible_nonexecs_.first) { possible = first_exec = ffesta_possible_execs_.first; continue; @@ -592,29 +590,6 @@ ffesta_second_ (ffelexToken t) switch (ffesta_first_kw) { -#if FFESTR_VXT - case FFESTR_firstACCEPT: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V019); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstALLOCATABLE: - ffestb_args.dimlist.len = FFESTR_firstlALLOCATABLE; - ffestb_args.dimlist.badname = "ALLOCATABLE"; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstALLOCATE: - ffestb_args.heap.len = FFESTR_firstlALLOCATE; - ffestb_args.heap.badname = "ALLOCATE"; - ffestb_args.heap.ctx = FFEEXPR_contextALLOCATE; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap); - break; -#endif - case FFESTR_firstASSIGN: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R838); break; @@ -666,12 +641,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); break; -#if FFESTR_F90 - case FFESTR_firstCONTAINS: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1228); - break; -#endif - case FFESTR_firstCONTINUE: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R841); break; @@ -687,32 +656,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R528); break; -#if FFESTR_F90 - case FFESTR_firstDEALLOCATE: - ffestb_args.heap.len = FFESTR_firstlDEALLOCATE; - ffestb_args.heap.badname = "DEALLOCATE"; - ffestb_args.heap.ctx = FFEEXPR_contextDEALLOCATE; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap); - break; -#endif - -#if FFESTR_VXT - case FFESTR_firstDECODE: - ffestb_args.vxtcode.len = FFESTR_firstlDECODE; - ffestb_args.vxtcode.badname = "DECODE"; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode); - break; -#endif - -#if FFESTR_VXT - case FFESTR_firstDEFINEFILE: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V025); - break; - - case FFESTR_firstDELETE: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V021); - break; -#endif case FFESTR_firstDIMENSION: ffestb_args.R524.len = FFESTR_firstlDIMENSION; ffestb_args.R524.badname = "DIMENSION"; @@ -752,21 +695,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz); break; -#if FFESTR_F90 - case FFESTR_firstELSEWHERE: - ffestb_args.elsexyz.second = FFESTR_secondWHERE; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz); - break; -#endif - -#if FFESTR_VXT - case FFESTR_firstENCODE: - ffestb_args.vxtcode.len = FFESTR_firstlENCODE; - ffestb_args.vxtcode.badname = "ENCODE"; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode); - break; -#endif - case FFESTR_firstEND: if ((ffelex_token_type (ffesta_token_0_) == FFELEX_typeNAMES) || (ffelex_token_type (t) != FFELEX_typeNAME)) @@ -781,15 +709,9 @@ ffesta_second_ (ffelexToken t) case FFESTR_secondFILE: case FFESTR_secondFUNCTION: case FFESTR_secondIF: -#if FFESTR_F90 - case FFESTR_secondMODULE: -#endif case FFESTR_secondPROGRAM: case FFESTR_secondSELECT: case FFESTR_secondSUBROUTINE: -#if FFESTR_F90 - case FFESTR_secondWHERE: -#endif ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end); break; @@ -836,30 +758,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); break; -#if FFESTR_F90 - case FFESTR_firstENDINTERFACE: - ffestb_args.endxyz.len = FFESTR_firstlENDINTERFACE; - ffestb_args.endxyz.second = FFESTR_secondINTERFACE; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); - break; -#endif - -#if FFESTR_VXT - case FFESTR_firstENDMAP: - ffestb_args.endxyz.len = FFESTR_firstlENDMAP; - ffestb_args.endxyz.second = FFESTR_secondMAP; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstENDMODULE: - ffestb_args.endxyz.len = FFESTR_firstlENDMODULE; - ffestb_args.endxyz.second = FFESTR_secondMODULE; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); - break; -#endif - case FFESTR_firstENDPROGRAM: ffestb_args.endxyz.len = FFESTR_firstlENDPROGRAM; ffestb_args.endxyz.second = FFESTR_secondPROGRAM; @@ -872,44 +770,12 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); break; -#if FFESTR_VXT - case FFESTR_firstENDSTRUCTURE: - ffestb_args.endxyz.len = FFESTR_firstlENDSTRUCTURE; - ffestb_args.endxyz.second = FFESTR_secondSTRUCTURE; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); - break; -#endif - case FFESTR_firstENDSUBROUTINE: ffestb_args.endxyz.len = FFESTR_firstlENDSUBROUTINE; ffestb_args.endxyz.second = FFESTR_secondSUBROUTINE; ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); break; -#if FFESTR_F90 - case FFESTR_firstENDTYPE: - ffestb_args.endxyz.len = FFESTR_firstlENDTYPE; - ffestb_args.endxyz.second = FFESTR_secondTYPE; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); - break; -#endif - -#if FFESTR_VXT - case FFESTR_firstENDUNION: - ffestb_args.endxyz.len = FFESTR_firstlENDUNION; - ffestb_args.endxyz.second = FFESTR_secondUNION; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstENDWHERE: - ffestb_args.endxyz.len = FFESTR_firstlENDWHERE; - ffestb_args.endxyz.second = FFESTR_secondWHERE; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); - break; -#endif - case FFESTR_firstENTRY: ffestb_args.dummy.len = FFESTR_firstlENTRY; ffestb_args.dummy.badname = "ENTRY"; @@ -931,12 +797,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); break; -#if FFESTR_VXT - case FFESTR_firstFIND: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V026); - break; -#endif - /* WARNING: don't put anything that might cause an item to precede FORMAT in the list of possible statements (it's added below) without making sure FORMAT still is first. It has to run with @@ -954,6 +814,22 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy); break; + case FFESTR_firstGO: + if ((ffelex_token_type (ffesta_token_0_) == FFELEX_typeNAMES) + || (ffelex_token_type (t) != FFELEX_typeNAME)) + ffesta_add_possible_exec_ ((ffelexHandler) ffestb_goto); + else + switch (ffesta_second_kw) + { + case FFESTR_secondTO: + ffesta_add_possible_exec_ ((ffelexHandler) ffestb_goto); + break; + default: + ffesta_add_possible_exec_ ((ffelexHandler) ffestb_goto); + break; + } + break; + case FFESTR_firstGOTO: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_goto); break; @@ -992,20 +868,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); break; -#if FFESTR_F90 - case FFESTR_firstINTENT: - ffestb_args.varlist.len = FFESTR_firstlINTENT; - ffestb_args.varlist.badname = "INTENT"; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstINTERFACE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1202); - break; -#endif - case FFESTR_firstINTRINSIC: ffestb_args.varlist.len = FFESTR_firstlINTRINSIC; ffestb_args.varlist.badname = "INTRINSIC"; @@ -1018,40 +880,14 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); break; -#if FFESTR_VXT - case FFESTR_firstMAP: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V012); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstMODULE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_module); - break; -#endif - case FFESTR_firstNAMELIST: ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R542); break; -#if FFESTR_F90 - case FFESTR_firstNULLIFY: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R624); - break; -#endif - case FFESTR_firstOPEN: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R904); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - ffestb_args.varlist.len = FFESTR_firstlOPTIONAL; - ffestb_args.varlist.badname = "OPTIONAL"; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); - break; -#endif - case FFESTR_firstPARAMETER: ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R537); ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V027); @@ -1062,38 +898,14 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt); break; -#if FFESTR_F90 - case FFESTR_firstPOINTER: - ffestb_args.dimlist.len = FFESTR_firstlPOINTER; - ffestb_args.dimlist.badname = "POINTER"; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist); - break; -#endif - case FFESTR_firstPRINT: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R911); break; -#if HARD_F90 - case FFESTR_firstPRIVATE: - ffestb_args.varlist.len = FFESTR_firstlPRIVATE; - ffestb_args.varlist.badname = "ACCESS"; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); - break; -#endif - case FFESTR_firstPROGRAM: ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1102); break; -#if HARD_F90 - case FFESTR_firstPUBLIC: - ffestb_args.varlist.len = FFESTR_firstlPUBLIC; - ffestb_args.varlist.badname = "ACCESS"; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); - break; -#endif - case FFESTR_firstREAD: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R909); break; @@ -1104,18 +916,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); break; -#if FFESTR_VXT - case FFESTR_firstRECORD: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V016); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstRECURSIVE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_recursive); - break; -#endif - case FFESTR_firstRETURN: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1227); break; @@ -1126,12 +926,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru); break; -#if FFESTR_VXT - case FFESTR_firstREWRITE: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V018); - break; -#endif - case FFESTR_firstSAVE: ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R522); break; @@ -1144,23 +938,11 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809); break; -#if HARD_F90 - case FFESTR_firstSEQUENCE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R423B); - break; -#endif - case FFESTR_firstSTOP: ffestb_args.halt.len = FFESTR_firstlSTOP; ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt); break; -#if FFESTR_VXT - case FFESTR_firstSTRUCTURE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V003); - break; -#endif - case FFESTR_firstSUBROUTINE: ffestb_args.dummy.len = FFESTR_firstlSUBROUTINE; ffestb_args.dummy.badname = "SUBROUTINE"; @@ -1168,50 +950,10 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy); break; -#if FFESTR_F90 - case FFESTR_firstTARGET: - ffestb_args.dimlist.len = FFESTR_firstlTARGET; - ffestb_args.dimlist.badname = "TARGET"; - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist); - break; -#endif - case FFESTR_firstTYPE: ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V020); break; -#if FFESTR_F90 - case FFESTR_firstTYPE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_type); - break; -#endif - -#if HARD_F90 - case FFESTR_firstTYPE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_typetype); - break; -#endif - -#if FFESTR_VXT - case FFESTR_firstUNLOCK: - ffestb_args.beru.len = FFESTR_firstlUNLOCK; - ffestb_args.beru.badname = "UNLOCK"; - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru); - break; -#endif - -#if FFESTR_VXT - case FFESTR_firstUNION: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V009); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstUSE: - ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1107); - break; -#endif - case FFESTR_firstVIRTUAL: ffestb_args.R524.len = FFESTR_firstlVIRTUAL; ffestb_args.R524.badname = "VIRTUAL"; @@ -1222,12 +964,6 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V014); break; -#if HARD_F90 - case FFESTR_firstWHERE: - ffesta_add_possible_exec_ ((ffelexHandler) ffestb_where); - break; -#endif - case FFESTR_firstWORD: ffestb_args.decl.len = FFESTR_firstlWORD; ffestb_args.decl.type = FFESTP_typeWORD; @@ -1274,13 +1010,7 @@ ffesta_second_ (ffelexToken t) ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let); break; -#if FFESTR_F90 - case FFELEX_typePERCENT: -#endif case FFELEX_typeEQUALS: -#if FFESTR_F90 - case FFELEX_typePOINTS: -#endif ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let); break; @@ -1391,7 +1121,7 @@ ffesta_send_two_ (ffelexToken t) yet been set. */ void -ffesta_confirmed () +ffesta_confirmed (void) { if (ffesta_inhibit_confirmation_) return; @@ -1415,7 +1145,7 @@ ffesta_confirmed () processing a statement (make and destroy pools, et cetera). */ void -ffesta_eof () +ffesta_eof (void) { ffesta_tokens[0] = ffelex_token_new_eof (); @@ -1582,15 +1312,13 @@ ffesta_first (ffelexToken t) this list. Initializes the executable and nonexecutable lists. */ void -ffesta_init_0 () +ffesta_init_0 (void) { ffestaPossible_ ptr; int i; - ptr = (ffestaPossible_) malloc_new_kp (malloc_pool_image (), - "FFEST possibles", - FFESTA_maxPOSSIBLES_ - * sizeof (*ptr)); + ptr = malloc_new_kp (malloc_pool_image (), "FFEST possibles", + FFESTA_maxPOSSIBLES_ * sizeof (*ptr)); for (i = 0; i < FFESTA_maxPOSSIBLES_; ++i) ffesta_possibles_[i] = ptr++; @@ -1607,7 +1335,7 @@ ffesta_init_0 () ffesta_init_3(); */ void -ffesta_init_3 () +ffesta_init_3 (void) { ffesta_output_pool = NULL; /* May be doing this just before reaching */ ffesta_scratch_pool = NULL; /* ffesta_zero or ffesta_two. */ @@ -1644,7 +1372,7 @@ ffesta_init_3 () the ffestb call would be completely dropped without this mechanism. */ bool -ffesta_is_inhibited () +ffesta_is_inhibited (void) { assert (ffesta_confirmed_current_ || ffesta_inhibit_confirmation_); return ffesta_is_inhibited_; @@ -1793,7 +1521,7 @@ ffesta_ffebad_2t (ffebad errnum, ffelexToken t1, ffelexToken t2) } ffestaPooldisp -ffesta_outpooldisp () +ffesta_outpooldisp (void) { return ffesta_outpooldisp_; } @@ -1808,7 +1536,7 @@ ffesta_set_outpooldisp (ffestaPooldisp d) user with a diagnostic if we're not inhibited. */ void -ffesta_shutdown () +ffesta_shutdown (void) { if (ffesta_is_inhibited_) ffesta_current_shutdown_ = TRUE; diff --git a/contrib/gcc/f/stb.c b/contrib/gcc/f/stb.c index bf456a1..673f96c 100644 --- a/contrib/gcc/f/stb.c +++ b/contrib/gcc/f/stb.c @@ -1,5 +1,6 @@ /* stb.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2002, 2003 + Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -216,13 +217,6 @@ union ffestb_local_u_ ffestrOther kw; } varlist; -#if FFESTR_F90 - struct - { - ffestrOther kw; - } - type; -#endif struct { ffelexHandler next; @@ -241,13 +235,6 @@ union ffestb_local_u_ bool complained; /* If run-time expr seen in nonexec context. */ } format; -#if FFESTR_F90 - struct - { - bool started; - } - moduleprocedure; -#endif struct { ffebld expr; @@ -258,47 +245,11 @@ union ffestb_local_u_ ffesttCaseList cases; } case_stmt; -#if FFESTR_F90 - struct - { - ffesttExprList exprs; - ffebld expr; - } - heap; -#endif -#if FFESTR_F90 - struct - { - ffesttExprList exprs; - } - R624; -#endif -#if FFESTR_F90 - struct - { - ffestpDefinedOperator operator; - bool assignment; /* TRUE for INTERFACE ASSIGNMENT, FALSE for - ...OPERATOR. */ - bool slash; /* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */ - } - interface; -#endif struct { bool is_cblock; } V014; -#if FFESTR_VXT - struct - { - bool started; - ffebld u; - ffebld m; - ffebld n; - ffebld asv; - } - V025; -#endif struct { ffestpBeruIx ix; @@ -380,13 +331,6 @@ union ffestb_local_u_ ffeexprContext context; } write; -#if FFESTR_F90 - struct - { - bool started; - } - structure; -#endif struct { bool started; @@ -481,10 +425,6 @@ static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t); -static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t); -#endif static ffelexHandler ffestb_subr_label_list_ (ffelexToken t); static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t); static ffelexHandler ffestb_do1_ (ffelexToken t); @@ -529,26 +469,8 @@ static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_type1_ (ffelexToken t); -static ffelexHandler ffestb_type2_ (ffelexToken t); -static ffelexHandler ffestb_type3_ (ffelexToken t); -static ffelexHandler ffestb_type4_ (ffelexToken t); -#endif -#if FFESTR_F90 -static ffelexHandler ffestb_varlist1_ (ffelexToken t); -static ffelexHandler ffestb_varlist2_ (ffelexToken t); -static ffelexHandler ffestb_varlist3_ (ffelexToken t); -static ffelexHandler ffestb_varlist4_ (ffelexToken t); -#endif static ffelexHandler ffestb_varlist5_ (ffelexToken t); static ffelexHandler ffestb_varlist6_ (ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_where2_ (ffelexToken t); -static ffelexHandler ffestb_where3_ (ffelexToken t); -#endif static ffelexHandler ffestb_R5221_ (ffelexToken t); static ffelexHandler ffestb_R5222_ (ffelexToken t); static ffelexHandler ffestb_R5223_ (ffelexToken t); @@ -599,20 +521,6 @@ static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_construct1_ (ffelexToken t); static ffelexHandler ffestb_construct2_ (ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_heap2_ (ffelexToken t); -static ffelexHandler ffestb_heap3_ (ffelexToken t); -static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_heap5_ (ffelexToken t); -#endif -#if FFESTR_F90 -static ffelexHandler ffestb_module1_ (ffelexToken t); -static ffelexHandler ffestb_module2_ (ffelexToken t); -static ffelexHandler ffestb_module3_ (ffelexToken t); -#endif static ffelexHandler ffestb_R8091_ (ffelexToken t); static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr, ffelexToken t); @@ -645,48 +553,12 @@ static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr, ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_R11071_ (ffelexToken t); -static ffelexHandler ffestb_R11072_ (ffelexToken t); -static ffelexHandler ffestb_R11073_ (ffelexToken t); -static ffelexHandler ffestb_R11074_ (ffelexToken t); -static ffelexHandler ffestb_R11075_ (ffelexToken t); -static ffelexHandler ffestb_R11076_ (ffelexToken t); -static ffelexHandler ffestb_R11077_ (ffelexToken t); -static ffelexHandler ffestb_R11078_ (ffelexToken t); -static ffelexHandler ffestb_R11079_ (ffelexToken t); -static ffelexHandler ffestb_R110710_ (ffelexToken t); -static ffelexHandler ffestb_R110711_ (ffelexToken t); -static ffelexHandler ffestb_R110712_ (ffelexToken t); -#endif -#if FFESTR_F90 -static ffelexHandler ffestb_R12021_ (ffelexToken t); -static ffelexHandler ffestb_R12022_ (ffelexToken t); -static ffelexHandler ffestb_R12023_ (ffelexToken t); -static ffelexHandler ffestb_R12024_ (ffelexToken t); -static ffelexHandler ffestb_R12025_ (ffelexToken t); -static ffelexHandler ffestb_R12026_ (ffelexToken t); -#endif static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_V0141_ (ffelexToken t); static ffelexHandler ffestb_V0142_ (ffelexToken t); static ffelexHandler ffestb_V0143_ (ffelexToken t); static ffelexHandler ffestb_V0144_ (ffelexToken t); -#if FFESTR_VXT -static ffelexHandler ffestb_V0251_ (ffelexToken t); -static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0255_ (ffelexToken t); -static ffelexHandler ffestb_V0256_ (ffelexToken t); -static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0258_ (ffelexToken t); -#endif #if FFESTB_KILL_EASY_ static void ffestb_subr_kill_easy_ (ffestpInquireIx max); #else @@ -717,23 +589,6 @@ static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr, static ffelexHandler ffestb_beru8_ (ffelexToken t); static ffelexHandler ffestb_beru9_ (ffelexToken t); static ffelexHandler ffestb_beru10_ (ffelexToken t); -#if FFESTR_VXT -static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_vxtcode4_ (ffelexToken t); -static ffelexHandler ffestb_vxtcode5_ (ffelexToken t); -static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_vxtcode7_ (ffelexToken t); -static ffelexHandler ffestb_vxtcode8_ (ffelexToken t); -static ffelexHandler ffestb_vxtcode9_ (ffelexToken t); -static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, - ffelexToken t); -#endif static ffelexHandler ffestb_R9041_ (ffelexToken t); static ffelexHandler ffestb_R9042_ (ffelexToken t); static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr, @@ -814,63 +669,10 @@ static ffelexHandler ffestb_R9239_ (ffelexToken t); static ffelexHandler ffestb_R92310_ (ffelexToken t); static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t); -#if FFESTR_VXT -static ffelexHandler ffestb_V0181_ (ffelexToken t); -static ffelexHandler ffestb_V0182_ (ffelexToken t); -static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0184_ (ffelexToken t); -static ffelexHandler ffestb_V0185_ (ffelexToken t); -static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0187_ (ffelexToken t); -static ffelexHandler ffestb_V0188_ (ffelexToken t); -static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V01810_ (ffelexToken t); -static ffelexHandler ffestb_V01811_ (ffelexToken t); -static ffelexHandler ffestb_V01812_ (ffelexToken t); -static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr, - ffelexToken t); -#endif static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t); -#if FFESTR_VXT -static ffelexHandler ffestb_V0211_ (ffelexToken t); -static ffelexHandler ffestb_V0212_ (ffelexToken t); -static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0214_ (ffelexToken t); -static ffelexHandler ffestb_V0215_ (ffelexToken t); -static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0217_ (ffelexToken t); -static ffelexHandler ffestb_V0218_ (ffelexToken t); -static ffelexHandler ffestb_V0219_ (ffelexToken t); -static ffelexHandler ffestb_V0261_ (ffelexToken t); -static ffelexHandler ffestb_V0262_ (ffelexToken t); -static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0264_ (ffelexToken t); -static ffelexHandler ffestb_V0265_ (ffelexToken t); -static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_V0267_ (ffelexToken t); -static ffelexHandler ffestb_V0268_ (ffelexToken t); -static ffelexHandler ffestb_V0269_ (ffelexToken t); -#endif -#if FFESTR_F90 -static ffelexHandler ffestb_dimlist1_ (ffelexToken t); -static ffelexHandler ffestb_dimlist2_ (ffelexToken t); -static ffelexHandler ffestb_dimlist3_ (ffelexToken t); -static ffelexHandler ffestb_dimlist4_ (ffelexToken t); -#endif static ffelexHandler ffestb_dummy1_ (ffelexToken t); static ffelexHandler ffestb_dummy2_ (ffelexToken t); static ffelexHandler ffestb_R5241_ (ffelexToken t); @@ -884,30 +686,13 @@ static ffelexHandler ffestb_R5474_ (ffelexToken t); static ffelexHandler ffestb_R5475_ (ffelexToken t); static ffelexHandler ffestb_R5476_ (ffelexToken t); static ffelexHandler ffestb_R5477_ (ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr, - ffelexToken t); -static ffelexHandler ffestb_R6242_ (ffelexToken t); -#endif static ffelexHandler ffestb_R12291_ (ffelexToken t); static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t); -static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t); -static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t); -static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t); -#endif static ffelexHandler ffestb_decl_attrs_ (ffelexToken t); static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t); static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t); -static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t); -static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t); -static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t); -#endif static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t); static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t); static ffelexHandler ffestb_decl_ents_ (ffelexToken t); @@ -936,9 +721,6 @@ static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t); static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t); static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t); static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_decl_func_ (ffelexToken t); -#endif static ffelexHandler ffestb_decl_funcname_ (ffelexToken t); static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t); static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t); @@ -950,29 +732,12 @@ static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t); static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t); static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t); static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t); -#if FFESTR_VXT -static ffelexHandler ffestb_V0031_ (ffelexToken t); -static ffelexHandler ffestb_V0032_ (ffelexToken t); -static ffelexHandler ffestb_V0033_ (ffelexToken t); -static ffelexHandler ffestb_V0034_ (ffelexToken t); -static ffelexHandler ffestb_V0035_ (ffelexToken t); -static ffelexHandler ffestb_V0036_ (ffelexToken t); -static ffelexHandler ffestb_V0161_ (ffelexToken t); -static ffelexHandler ffestb_V0162_ (ffelexToken t); -static ffelexHandler ffestb_V0163_ (ffelexToken t); -static ffelexHandler ffestb_V0164_ (ffelexToken t); -static ffelexHandler ffestb_V0165_ (ffelexToken t); -static ffelexHandler ffestb_V0166_ (ffelexToken t); -#endif static ffelexHandler ffestb_V0271_ (ffelexToken t); static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_V0273_ (ffelexToken t); static ffelexHandler ffestb_decl_R5391_ (ffelexToken t); static ffelexHandler ffestb_decl_R5392_ (ffelexToken t); -#if FFESTR_F90 -static ffelexHandler ffestb_decl_R5393_ (ffelexToken t); -#endif static ffelexHandler ffestb_decl_R5394_ (ffelexToken t); static ffelexHandler ffestb_decl_R5395_ (ffelexToken t); static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t); @@ -1050,7 +815,7 @@ ffestb_subr_ambig_nope_ (ffelexToken t) in _ents_ (perform housekeeping tasks). */ static void -ffestb_subr_ambig_to_ents_ () +ffestb_subr_ambig_to_ents_ (void) { ffelexToken nt; @@ -1737,67 +1502,6 @@ ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN - - return ffestb_decl_typetype1_; // to lexer - - Handle NAME. */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_decl_typetype1_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffestb_local_.decl.kindt = ffelex_token_use (t); - return (ffelexHandler) ffestb_decl_typetype2_; - - default: - break; - } - - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, - ffestb_local_.decl.badname, - t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME - - return ffestb_decl_typetype2_; // to lexer - - Handle CLOSE_PAREN. */ - -static ffelexHandler -ffestb_decl_typetype2_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - ffestb_local_.decl.type = FFESTP_typeTYPE; - ffestb_local_.decl.kind = NULL; - ffestb_local_.decl.len = NULL; - ffestb_local_.decl.lent = NULL; - ffelex_set_names (TRUE); - return (ffelexHandler) ffestb_local_.decl.handler; - - default: - break; - } - - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - ffelex_token_kill (ffestb_local_.decl.kindt); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, - ffestb_local_.decl.badname, - t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN @@ -2664,11 +2368,6 @@ ffestb_elsexyz (ffelexToken t) p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE); ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); -#if FFESTR_F90 - if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE) - && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE)) - ffestb_args.elsexyz.second = FFESTR_secondNone; -#endif return (ffelexHandler) ffestb_else1_ (t); default: @@ -2727,16 +2426,6 @@ ffestb_else1_ (ffelexToken t) switch (ffestb_args.elsexyz.second) { -#if FFESTR_F90 - case FFESTR_secondWHERE: - if (!ffesta_is_inhibited ()) - if ((ffesta_first_kw == FFESTR_firstELSEWHERE) - && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)) - ffestc_R744 (); - else - ffestc_elsewhere (ffesta_tokens[1]); /* R744 or R805. */ - break; -#endif default: if (!ffesta_is_inhibited ()) @@ -2936,20 +2625,6 @@ ffestb_end (ffelexToken t) case FFESTR_secondBLOCK: return (ffelexHandler) ffestb_end1_; -#if FFESTR_F90 - case FFESTR_secondINTERFACE: -#endif -#if FFESTR_VXT - case FFESTR_secondMAP: - case FFESTR_secondSTRUCTURE: - case FFESTR_secondUNION: -#endif -#if FFESTR_F90 - case FFESTR_secondWHERE: - ffesta_tokens[1] = NULL; - return (ffelexHandler) ffestb_end3_; -#endif - case FFESTR_secondNone: goto bad_1; /* :::::::::::::::::::: */ @@ -3030,19 +2705,6 @@ ffestb_endxyz (ffelexToken t) ffesta_confirmed (); switch (ffestb_args.endxyz.second) { -#if FFESTR_F90 - case FFESTR_secondINTERFACE: -#endif -#if FFESTR_VXT - case FFESTR_secondMAP: - case FFESTR_secondSTRUCTURE: - case FFESTR_secondUNION: -#endif -#if FFESTR_F90 - case FFESTR_secondWHERE: - goto bad_1; /* :::::::::::::::::::: */ -#endif - case FFESTR_secondBLOCK: if (ffesta_second_kw != FFESTR_secondDATA) goto bad_1; /* :::::::::::::::::::: */ @@ -3086,24 +2748,6 @@ ffestb_endxyz (ffelexToken t) { p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.endxyz.len); - switch (ffestb_args.endxyz.second) - { -#if FFESTR_F90 - case FFESTR_secondINTERFACE: -#endif -#if FFESTR_VXT - case FFESTR_secondMAP: - case FFESTR_secondSTRUCTURE: - case FFESTR_secondUNION: -#endif -#if FFESTR_F90 - case FFESTR_secondWHERE: - goto bad_i; /* :::::::::::::::::::: */ -#endif - - default: - break; - } if (!ffesrc_is_name_init (*p)) goto bad_i; /* :::::::::::::::::::: */ ffesta_tokens[1] @@ -3211,20 +2855,6 @@ ffestb_end3_ (ffelexToken t) switch (ffestb_args.endxyz.second) { -#if FFESTR_F90 - case FFESTR_secondTYPE: - if (!ffesta_is_inhibited ()) - ffestc_R425 (ffesta_tokens[1]); - break; -#endif - -#if FFESTR_F90 - case FFESTR_secondWHERE: - if (!ffesta_is_inhibited ()) - ffestc_R745 (); - break; -#endif - case FFESTR_secondIF: if (!ffesta_is_inhibited ()) ffestc_R806 (ffesta_tokens[1]); @@ -3245,25 +2875,12 @@ ffestb_end3_ (ffelexToken t) ffestc_R1103 (ffesta_tokens[1]); break; -#if FFESTR_F90 - case FFESTR_secondMODULE: - if (!ffesta_is_inhibited ()) - ffestc_R1106 (ffesta_tokens[1]); - break; -#endif case FFESTR_secondBLOCK: case FFESTR_secondBLOCKDATA: if (!ffesta_is_inhibited ()) ffestc_R1112 (ffesta_tokens[1]); break; -#if FFESTR_F90 - case FFESTR_secondINTERFACE: - if (!ffesta_is_inhibited ()) - ffestc_R1203 (); - break; -#endif - case FFESTR_secondFUNCTION: if (!ffesta_is_inhibited ()) ffestc_R1221 (ffesta_tokens[1]); @@ -3274,27 +2891,6 @@ ffestb_end3_ (ffelexToken t) ffestc_R1225 (ffesta_tokens[1]); break; -#if FFESTR_VXT - case FFESTR_secondSTRUCTURE: - if (!ffesta_is_inhibited ()) - ffestc_V004 (); - break; -#endif - -#if FFESTR_VXT - case FFESTR_secondUNION: - if (!ffesta_is_inhibited ()) - ffestc_V010 (); - break; -#endif - -#if FFESTR_VXT - case FFESTR_secondMAP: - if (!ffesta_is_inhibited ()) - ffestc_V013 (); - break; -#endif - default: ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]); if (ffesta_tokens[1] != NULL) @@ -3990,155 +3586,6 @@ ffestb_if3_ (ffelexToken t) return (ffelexHandler) next; } -/* ffestb_where -- Parse a WHERE statement - - return ffestb_where; // to lexer - - Make sure the statement has a valid form for a WHERE statement. - If it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_where (ffelexToken t) -{ - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstWHERE) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstWHERE) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE) - goto bad_0; /* :::::::::::::::::::: */ - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE, - (ffeexprCallback) ffestb_where1_); - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -#endif -/* ffestb_where1_ -- "WHERE" OPEN_PAREN expr - - (ffestb_where1_) // to expression handler - - Make sure the next token is CLOSE_PAREN. */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - ffestb_local_.if_stmt.expr = expr; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffesta_tokens[1] = ffelex_token_use (ft); - ffelex_set_names (TRUE); - return (ffelexHandler) ffestb_where2_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif -/* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN - - return ffestb_where2_; // to lexer - - Make sure the next token is NAME. */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_where2_ (ffelexToken t) -{ - ffelex_set_names (FALSE); - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - case FFELEX_typeNAMES: - ffesta_confirmed (); - ffesta_tokens[2] = ffelex_token_use (t); - return (ffelexHandler) ffestb_where3_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif -/* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME - - return ffestb_where3_; // to lexer - - Implement R742. */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_where3_ (ffelexToken t) -{ - ffelexHandler next; - ffelexToken my_2 = ffesta_tokens[2]; - - if (!ffesta_is_inhibited ()) - ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - next = (ffelexHandler) ffesta_two (my_2, t); - ffelex_token_kill (my_2); - return (ffelexHandler) next; -} - -#endif /* ffestb_let -- Parse an assignment statement return ffestb_let; // to lexer @@ -4220,9 +3667,6 @@ ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) switch (ffelex_token_type (t)) { -#if FFESTR_F90 - case FFELEX_typePOINTS: -#endif case FFELEX_typeEQUALS: if (expr == NULL) break; @@ -4257,14 +3701,7 @@ ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t) break; ffesta_confirmed (); if (!ffesta_is_inhibited ()) -#if FFESTR_F90 - if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS) -#endif - ffestc_let (ffestb_local_.let.dest, expr, ft); -#if FFESTR_F90 - else - ffestc_R738 (ffestb_local_.let.dest, expr, ft); -#endif + ffestc_let (ffestb_local_.let.dest, expr, ft); ffelex_token_kill (ffesta_tokens[1]); return (ffelexHandler) ffesta_zero (t); @@ -4280,251 +3717,6 @@ ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_type -- Parse the TYPE statement - - return ffestb_type; // to lexer - - Make sure the statement has a valid form for the TYPE statement. If - it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_type (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstTYPE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeCOMMA: - ffesta_confirmed (); - return (ffelexHandler) ffestb_type1_; - - case FFELEX_typeNAME: /* No confirm here, because ambig w/V020 VXT - TYPE. */ - ffesta_tokens[1] = NULL; - ffesta_tokens[2] = ffelex_token_use (t); - return (ffelexHandler) ffestb_type4_; - } - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstTYPE) - goto bad_0; /* :::::::::::::::::::: */ - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE); - switch (ffelex_token_type (t)) - { - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeCOMMA: - if (*p != '\0') - goto bad_i; /* :::::::::::::::::::: */ - ffesta_confirmed (); - ffelex_set_names (TRUE); - return (ffelexHandler) ffestb_type1_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - break; - } - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - ffesta_tokens[1] = NULL; - ffesta_tokens[2] - = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - return (ffelexHandler) ffestb_type4_ (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_type1_ -- "TYPE" COMMA - - return ffestb_type1_; // to lexer - - Make sure the next token is a NAME. */ - -static ffelexHandler -ffestb_type1_ (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - - ffelex_set_names (FALSE); - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - ffestb_local_.type.kw = ffestr_other (t); - switch (ffestb_local_.varlist.kw) - { - case FFESTR_otherPUBLIC: - case FFESTR_otherPRIVATE: - return (ffelexHandler) ffestb_type2_; - - default: - ffelex_token_kill (ffesta_tokens[1]); - break; - } - break; - - case FFELEX_typeNAMES: - ffesta_tokens[1] = ffelex_token_use (t); - ffestb_local_.type.kw = ffestr_other (t); - switch (ffestb_local_.varlist.kw) - { - case FFESTR_otherPUBLIC: - p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC); - if (*p == '\0') - return (ffelexHandler) ffestb_type2_; - if (!ffesrc_is_name_init (*p)) - goto bad_i1; /* :::::::::::::::::::: */ - ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0); - return (ffelexHandler) ffestb_type4_; - - case FFESTR_otherPRIVATE: - p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE); - if (*p == '\0') - return (ffelexHandler) ffestb_type2_; - if (!ffesrc_is_name_init (*p)) - goto bad_i1; /* :::::::::::::::::::: */ - ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0); - return (ffelexHandler) ffestb_type4_; - - default: - ffelex_token_kill (ffesta_tokens[1]); - break; - } - break; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_i1: /* :::::::::::::::::::: */ - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_type2_ -- "TYPE" COMMA NAME - - return ffestb_type2_; // to lexer - - Handle COLONCOLON or NAME. */ - -static ffelexHandler -ffestb_type2_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOLONCOLON: - return (ffelexHandler) ffestb_type3_; - - case FFELEX_typeNAME: - return (ffelexHandler) ffestb_type3_ (t); - - default: - break; - } - - if (ffesta_tokens[1] != NULL) - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]] - - return ffestb_type3_; // to lexer - - Make sure the next token is a NAME. */ - -static ffelexHandler -ffestb_type3_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[2] = ffelex_token_use (t); - return (ffelexHandler) ffestb_type4_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); - break; - } - - if (ffesta_tokens[1] != NULL) - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME - - return ffestb_type4_; // to lexer - - Make sure the next token is an EOS or SEMICOLON. */ - -static ffelexHandler -ffestb_type4_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw, - ffesta_tokens[2]); - if (ffesta_tokens[1] != NULL) - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - return (ffelexHandler) ffesta_zero (t); - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); - break; - } - - if (ffesta_tokens[1] != NULL) - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE statement @@ -4549,23 +3741,7 @@ ffestb_varlist (ffelexToken t) case FFELEX_typeEOS: case FFELEX_typeSEMICOLON: ffesta_confirmed (); - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - if (!ffesta_is_inhibited ()) - ffestc_R521A (); - return (ffelexHandler) ffesta_zero (t); - - case FFESTR_firstPRIVATE: - if (!ffesta_is_inhibited ()) - ffestc_private (); /* Either R523A or R521B. */ - return (ffelexHandler) ffesta_zero (t); -#endif - - default: - goto bad_1; /* :::::::::::::::::::: */ - } + goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeCOMMA: ffesta_confirmed (); /* Error, but clearly intended. */ @@ -4573,45 +3749,14 @@ ffestb_varlist (ffelexToken t) case FFELEX_typeCOLONCOLON: ffesta_confirmed (); - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - if (!ffesta_is_inhibited ()) - ffestc_R520_start (); - break; - - case FFESTR_firstPUBLIC: - if (!ffesta_is_inhibited ()) - ffestc_R521Astart (); - break; - - case FFESTR_firstPRIVATE: - if (!ffesta_is_inhibited ()) - ffestc_R521Bstart (); - break; -#endif - - default: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - } - return (ffelexHandler) ffestb_varlist5_; + ffesta_confirmed (); /* Error, but clearly intended. */ + goto bad_1; /* :::::::::::::::::::: */ default: goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeOPEN_PAREN: - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstINTENT: - return (ffelexHandler) ffestb_varlist1_; -#endif - - default: - goto bad_1; /* :::::::::::::::::::: */ - } + goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeNAME: ffesta_confirmed (); @@ -4622,35 +3767,11 @@ ffestb_varlist (ffelexToken t) ffestc_R1207_start (); break; -#if FFESTR_F90 - case FFESTR_firstINTENT: - goto bad_1; /* :::::::::::::::::::: */ -#endif - case FFESTR_firstINTRINSIC: if (!ffesta_is_inhibited ()) ffestc_R1208_start (); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - if (!ffesta_is_inhibited ()) - ffestc_R520_start (); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - if (!ffesta_is_inhibited ()) - ffestc_R521Astart (); - break; - - case FFESTR_firstPRIVATE: - if (!ffesta_is_inhibited ()) - ffestc_R521Bstart (); - break; -#endif - default: break; } @@ -4664,93 +3785,23 @@ ffestb_varlist (ffelexToken t) case FFELEX_typeEOS: case FFELEX_typeSEMICOLON: ffesta_confirmed (); - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstINTENT: - goto bad_1; /* :::::::::::::::::::: */ -#endif - - default: - break; - } if (*p != '\0') break; - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - if (!ffesta_is_inhibited ()) - ffestc_R521A (); - return (ffelexHandler) ffesta_zero (t); - - case FFESTR_firstPRIVATE: - if (!ffesta_is_inhibited ()) - ffestc_private (); /* Either R423A or R521B. */ - return (ffelexHandler) ffesta_zero (t); -#endif - - default: - goto bad_1; /* :::::::::::::::::::: */ - } + goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeCOMMA: ffesta_confirmed (); /* Error, but clearly intended. */ - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstINTENT: - goto bad_1; /* :::::::::::::::::::: */ -#endif - default: - break; - } if (*p != '\0') break; goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeCOLONCOLON: ffesta_confirmed (); - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - if (!ffesta_is_inhibited ()) - ffestc_R520_start (); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - if (!ffesta_is_inhibited ()) - ffestc_R521Astart (); - break; - - case FFESTR_firstPRIVATE: - if (!ffesta_is_inhibited ()) - ffestc_R521Bstart (); - break; -#endif - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - return (ffelexHandler) ffestb_varlist5_; + goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeOPEN_PAREN: - switch (ffesta_first_kw) - { -#if FFESTR_F90 - case FFESTR_firstINTENT: - if (*p != '\0') - goto bad_1; /* :::::::::::::::::::: */ - return (ffelexHandler) ffestb_varlist1_; -#endif - - default: - goto bad_1; /* :::::::::::::::::::: */ - } + goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeNAME: ffesta_confirmed (); @@ -4761,35 +3812,11 @@ ffestb_varlist (ffelexToken t) ffestc_R1207_start (); break; -#if FFESTR_F90 - case FFESTR_firstINTENT: - goto bad_1; /* :::::::::::::::::::: */ -#endif - case FFESTR_firstINTRINSIC: if (!ffesta_is_inhibited ()) ffestc_R1208_start (); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - if (!ffesta_is_inhibited ()) - ffestc_R520_start (); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - if (!ffesta_is_inhibited ()) - ffestc_R521Astart (); - break; - - case FFESTR_firstPRIVATE: - if (!ffesta_is_inhibited ()) - ffestc_R521Bstart (); - break; -#endif - default: break; } @@ -4819,22 +3846,6 @@ ffestb_varlist (ffelexToken t) ffestc_R1208_start (); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - ffestc_R520_start (); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - ffestc_R521Astart (); - break; - - case FFESTR_firstPRIVATE: - ffestc_R521Bstart (); - break; -#endif - default: assert (FALSE); } @@ -4861,139 +3872,6 @@ bad_i: /* :::::::::::::::::::: */ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_varlist1_ -- "INTENT" OPEN_PAREN - - return ffestb_varlist1_; // to lexer - - Handle NAME. */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_varlist1_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - ffestb_local_.varlist.kw = ffestr_other (t); - switch (ffestb_local_.varlist.kw) - { - case FFESTR_otherIN: - return (ffelexHandler) ffestb_varlist2_; - - case FFESTR_otherINOUT: - return (ffelexHandler) ffestb_varlist3_; - - case FFESTR_otherOUT: - return (ffelexHandler) ffestb_varlist3_; - - default: - ffelex_token_kill (ffesta_tokens[1]); - break; - } - break; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN" - - return ffestb_varlist2_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_varlist2_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - switch (ffestr_other (t)) - { - case FFESTR_otherOUT: - ffestb_local_.varlist.kw = FFESTR_otherINOUT; - return (ffelexHandler) ffestb_varlist3_; - - default: - break; - } - break; - - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_varlist4_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"] - - return ffestb_varlist3_; // to lexer - - Handle CLOSE_PAREN. */ - -static ffelexHandler -ffestb_varlist3_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_varlist4_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN - - return ffestb_varlist4_; // to lexer - - Handle COLONCOLON or NAME. */ - -static ffelexHandler -ffestb_varlist4_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_varlist5_; - - case FFELEX_typeNAME: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_varlist5_ (t); - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_varlist5_ -- Handles the list of variable names return ffestb_varlist5_; // to lexer @@ -5022,32 +3900,10 @@ ffestb_varlist5_ (ffelexToken t) ffestc_R1207_finish (); break; -#if FFESTR_F90 - case FFESTR_firstINTENT: - ffestc_R519_finish (); - break; -#endif - case FFESTR_firstINTRINSIC: ffestc_R1208_finish (); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - ffestc_R520_finish (); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - ffestc_R521Afinish (); - break; - - case FFESTR_firstPRIVATE: - ffestc_R521Bfinish (); - break; -#endif - default: assert (FALSE); } @@ -5075,32 +3931,10 @@ ffestb_varlist6_ (ffelexToken t) ffestc_R1207_item (ffesta_tokens[1]); break; -#if FFESTR_F90 - case FFESTR_firstINTENT: - ffestc_R519_item (ffesta_tokens[1]); - break; -#endif - case FFESTR_firstINTRINSIC: ffestc_R1208_item (ffesta_tokens[1]); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - ffestc_R520_item (ffesta_tokens[1]); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - ffestc_R521Aitem (ffesta_tokens[1]); - break; - - case FFESTR_firstPRIVATE: - ffestc_R521Bitem (ffesta_tokens[1]); - break; -#endif - default: assert (FALSE); } @@ -5119,37 +3953,11 @@ ffestb_varlist6_ (ffelexToken t) ffestc_R1207_finish (); break; -#if FFESTR_F90 - case FFESTR_firstINTENT: - ffestc_R519_item (ffesta_tokens[1]); - ffestc_R519_finish (); - break; -#endif - case FFESTR_firstINTRINSIC: ffestc_R1208_item (ffesta_tokens[1]); ffestc_R1208_finish (); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - ffestc_R520_item (ffesta_tokens[1]); - ffestc_R520_finish (); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - ffestc_R521Aitem (ffesta_tokens[1]); - ffestc_R521Afinish (); - break; - - case FFESTR_firstPRIVATE: - ffestc_R521Bitem (ffesta_tokens[1]); - ffestc_R521Bfinish (); - break; -#endif - default: assert (FALSE); } @@ -5170,32 +3978,10 @@ ffestb_varlist6_ (ffelexToken t) ffestc_R1207_finish (); break; -#if FFESTR_F90 - case FFESTR_firstINTENT: - ffestc_R519_finish (); - break; -#endif - case FFESTR_firstINTRINSIC: ffestc_R1208_finish (); break; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - ffestc_R520_finish (); - break; -#endif - -#if FFESTR_F90 - case FFESTR_firstPUBLIC: - ffestc_R521Afinish (); - break; - - case FFESTR_firstPRIVATE: - ffestc_R521Bfinish (); - break; -#endif - default: assert (FALSE); } @@ -5204,75 +3990,6 @@ ffestb_varlist6_ (ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_R423B -- Parse the SEQUENCE statement - - return ffestb_R423B; // to lexer - - Make sure the statement has a valid form for the SEQUENCE statement. If - it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_R423B (ffelexToken t) -{ - const char *p; - ffeTokenLength i; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstSEQUENCE) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstSEQUENCE) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE) - { - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE); - goto bad_i; /* :::::::::::::::::::: */ - } - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R423B (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid first token. */ - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_R522 -- Parse the SAVE statement return ffestb_R522; // to lexer @@ -7669,144 +6386,6 @@ ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_R1228 -- Parse the CONTAINS statement - - return ffestb_R1228; // to lexer - - Make sure the statement has a valid form for the CONTAINS statement. If - it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_R1228 (ffelexToken t) -{ - const char *p; - ffeTokenLength i; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstCONTAINS) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstCONTAINS) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS) - { - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS); - goto bad_i; /* :::::::::::::::::::: */ - } - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R1228 (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid first token. */ - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif -/* ffestb_V009 -- Parse the UNION statement - - return ffestb_V009; // to lexer - - Make sure the statement has a valid form for the UNION statement. If - it does, implement the statement. */ - -#if FFESTR_VXT -ffelexHandler -ffestb_V009 (ffelexToken t) -{ - const char *p; - ffeTokenLength i; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstUNION) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstUNION) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION) - { - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION); - goto bad_i; /* :::::::::::::::::::: */ - } - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V009 (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid first token. */ - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_construct -- Parse a construct name return ffestb_construct; // to lexer @@ -7924,505 +6503,6 @@ ffestb_construct2_ (ffelexToken t) return (ffelexHandler) (*ffestb_local_.construct.next) (t); } -/* ffestb_heap -- Parse an ALLOCATE/DEALLOCATE statement - - return ffestb_heap; // to lexer - - Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE - statement. If it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_heap (ffelexToken t) -{ - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - break; - - case FFELEX_typeNAMES: - if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len) - goto bad_0; /* :::::::::::::::::::: */ - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - - ffestb_local_.heap.exprs = ffestt_exprlist_create (); - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - ffestb_args.heap.ctx, - (ffeexprCallback) ffestb_heap1_); - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -/* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr - - (ffestb_heap1_) // to expression handler - - Make sure the next token is COMMA. */ - -static ffelexHandler -ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - if (expr == NULL) - break; - ffestt_exprlist_append (ffestb_local_.heap.exprs, expr, - ffelex_token_use (t)); - return (ffelexHandler) ffestb_heap2_; - - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestt_exprlist_append (ffestb_local_.heap.exprs, expr, - ffelex_token_use (t)); - ffesta_tokens[1] = NULL; - ffestb_local_.heap.expr = NULL; - return (ffelexHandler) ffestb_heap5_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); - ffestt_exprlist_kill (ffestb_local_.heap.exprs); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA - - return ffestb_heap2_; // to lexer - - Make sure the next token is NAME. */ - -static ffelexHandler -ffestb_heap2_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_heap3_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); - ffestt_exprlist_kill (ffestb_local_.heap.exprs); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME - - return ffestb_heap3_; // to lexer - - If token is EQUALS, make sure NAME was "STAT" and handle STAT variable; - else pass NAME and token to expression handler. */ - -static ffelexHandler -ffestb_heap3_ (ffelexToken t) -{ - ffelexHandler next; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - ffesta_confirmed (); - if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT) - break; - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextHEAPSTAT, - (ffeexprCallback) ffestb_heap4_); - - default: - next = (ffelexHandler) - (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - ffestb_args.heap.ctx, - (ffeexprCallback) ffestb_heap1_))) - (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) (*next) (t); - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); - ffestt_exprlist_kill (ffestb_local_.heap.exprs); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS - expr - - (ffestb_heap4_) // to expression handler - - Make sure the next token is CLOSE_PAREN. */ - -static ffelexHandler -ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffesta_tokens[1] = ffelex_token_use (ft); - ffestb_local_.heap.expr = expr; - return (ffelexHandler) ffestb_heap5_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); - ffestt_exprlist_kill (ffestb_local_.heap.exprs); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN - - return ffestb_heap5_; // to lexer - - Make sure the next token is EOS/SEMICOLON. */ - -static ffelexHandler -ffestb_heap5_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - if (ffesta_first_kw == FFESTR_firstALLOCATE) - ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr, - ffesta_tokens[1]); - else - ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr, - ffesta_tokens[1]); - ffestt_exprlist_kill (ffestb_local_.heap.exprs); - if (ffesta_tokens[1] != NULL) - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); - ffestt_exprlist_kill (ffestb_local_.heap.exprs); - if (ffesta_tokens[1] != NULL) - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif -/* ffestb_module -- Parse the MODULEPROCEDURE statement - - return ffestb_module; // to lexer - - Make sure the statement has a valid form for the MODULEPROCEDURE statement. - If it does, implement the statement. - - 31-May-90 JCB 1.1 - Confirm NAME==MODULE followed by standard four invalid tokens, so we - get decent message if somebody forgets that MODULE requires a name. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_module (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - ffelexToken nt; - ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e. - includes "PROCEDURE". */ - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstMODULE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - break; - - case FFELEX_typeCOLONCOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - goto bad_1m; /* :::::::::::::::::::: */ - - default: - goto bad_1m; /* :::::::::::::::::::: */ - } - - ffesta_confirmed (); - if (ffesta_second_kw != FFESTR_secondPROCEDURE) - { - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_module3_; - } - ffestb_local_.moduleprocedure.started = FALSE; - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_module1_; - - case FFELEX_typeNAMES: - p = ffelex_token_text (ffesta_tokens[0]) - + (i = FFESTR_firstlMODULEPROCEDURE); - if ((ffesta_first_kw == FFESTR_firstMODULE) - || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE) - && !ffesrc_is_name_init (*p))) - { /* Definitely not "MODULE PROCEDURE name". */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1m; /* :::::::::::::::::::: */ - - default: - goto bad_1m; /* :::::::::::::::::::: */ - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - break; - } - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE); - if (!ffesrc_is_name_init (*p)) - goto bad_im; /* :::::::::::::::::::: */ - nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - if (!ffesta_is_inhibited ()) - ffestc_R1105 (nt); - ffelex_token_kill (nt); - return (ffelexHandler) ffesta_zero (t); - } - - /* Here we know that we're indeed looking at a MODULEPROCEDURE - statement rather than MODULE and that the character following - MODULEPROCEDURE in the NAMES token is a valid first character for a - NAME. This means that unless the second token is COMMA, we have an - ambiguous statement that can be read either as MODULE PROCEDURE name - or MODULE PROCEDUREname, the former being an R1205, the latter an - R1105. */ - - if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeCOMMA: /* Aha, clearly not MODULE PROCEDUREname. */ - ffesta_confirmed (); - ffestb_local_.moduleprocedure.started = FALSE; - ffesta_tokens[1] - = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - return (ffelexHandler) ffestb_module2_ (t); - - case FFELEX_typeEOS: /* MODULE PROCEDURE name or MODULE - PROCEDUREname. */ - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - break; - } - nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE, - 0); - if (!ffesta_is_inhibited ()) - ffestc_module (mt, nt); /* Implement ambiguous statement. */ - ffelex_token_kill (nt); - ffelex_token_kill (mt); - return (ffelexHandler) ffesta_zero (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_1m: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_im: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE" - - return ffestb_module1_; // to lexer - - Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_module1_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - if (!ffestb_local_.moduleprocedure.started - && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)) - { - ffesta_confirmed (); - ffelex_token_kill (ffesta_tokens[1]); - } - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_module2_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (ffestb_local_.moduleprocedure.started) - break; /* Error if we've already seen NAME COMMA. */ - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R1105 (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - break; - - default: - break; - } - - if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ()) - ffestc_R1205_finish (); - else if (!ffestb_local_.moduleprocedure.started) - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_module2_ -- "MODULE/PROCEDURE" NAME - - return ffestb_module2_; // to lexer - - Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_module2_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffestb_local_.moduleprocedure.started) - { - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R1205_start (); - } - if (!ffesta_is_inhibited ()) - { - ffestc_R1205_item (ffesta_tokens[1]); - ffestc_R1205_finish (); - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - if (!ffestb_local_.moduleprocedure.started) - { - ffestb_local_.moduleprocedure.started = TRUE; - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R1205_start (); - } - if (!ffesta_is_inhibited ()) - ffestc_R1205_item (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_module1_; - - default: - break; - } - - if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ()) - ffestc_R1205_finish (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_module3_ -- "MODULE" NAME - - return ffestb_module3_; // to lexer - - Make sure the statement has a valid form for the MODULE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_module3_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - ffestc_R1105 (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_R809 -- Parse the SELECTCASE statement return ffestb_R809; // to lexer @@ -10514,7 +8594,7 @@ ffestb_R100110_ (ffelexToken t) case FFESTP_formattypeX: err = FFEBAD_FORMAT_BAD_X_SPEC; - pre = required; + pre = ffe_is_pedantic() ? required : optional; post = disallowed; dot = disallowed; exp = disallowed; @@ -10978,987 +9058,6 @@ ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) } } -/* ffestb_R1107 -- Parse the USE statement - - return ffestb_R1107; // to lexer - - Make sure the statement has a valid form for the USE statement. - If it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_R1107 (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstUSE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - ffesta_confirmed (); - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_R11071_; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstUSE) - goto bad_0; /* :::::::::::::::::::: */ - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE); - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeCOMMA: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - break; - } - ffesta_confirmed (); - ffesta_tokens[1] - = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - return (ffelexHandler) ffestb_R11071_ (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11071_ -- "USE" NAME - - return ffestb_R11071_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11071_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - { - ffestc_R1107_start (ffesta_tokens[1], FALSE); - ffestc_R1107_finish (); - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - return (ffelexHandler) ffestb_R11072_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11072_ -- "USE" NAME COMMA - - return ffestb_R11072_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11072_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[2] = ffelex_token_use (t); - return (ffelexHandler) ffestb_R11073_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11073_ -- "USE" NAME COMMA NAME - - return ffestb_R11073_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11073_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOLON: - if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY) - break; - if (!ffesta_is_inhibited ()) - ffestc_R1107_start (ffesta_tokens[1], TRUE); - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - return (ffelexHandler) ffestb_R11074_; - - case FFELEX_typePOINTS: - if (!ffesta_is_inhibited ()) - ffestc_R1107_start (ffesta_tokens[1], FALSE); - ffelex_token_kill (ffesta_tokens[1]); - ffesta_tokens[1] = ffesta_tokens[2]; - return (ffelexHandler) ffestb_R110711_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON - - return ffestb_R11074_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11074_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_R11075_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - ffestc_R1107_finish (); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME - - return ffestb_R11075_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11075_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - { - ffestc_R1107_item (NULL, ffesta_tokens[1]); - ffestc_R1107_finish (); - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - if (!ffesta_is_inhibited ()) - ffestc_R1107_item (NULL, ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_R11078_; - - case FFELEX_typePOINTS: - return (ffelexHandler) ffestb_R11076_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS - - return ffestb_R11076_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11076_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - if (!ffesta_is_inhibited ()) - ffestc_R1107_item (ffesta_tokens[1], t); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_R11077_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME - - return ffestb_R11077_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11077_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - ffestc_R1107_finish (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - return (ffelexHandler) ffestb_R11078_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA - - return ffestb_R11078_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11078_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_R11075_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R11079_ -- "USE" NAME COMMA - - return ffestb_R11079_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R11079_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_R110710_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R110710_ -- "USE" NAME COMMA NAME - - return ffestb_R110710_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R110710_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typePOINTS: - return (ffelexHandler) ffestb_R110711_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS - - return ffestb_R110711_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R110711_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - if (!ffesta_is_inhibited ()) - ffestc_R1107_item (ffesta_tokens[1], t); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_R110712_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME - - return ffestb_R110712_; // to lexer - - Make sure the statement has a valid form for the USE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R110712_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - ffestc_R1107_finish (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - return (ffelexHandler) ffestb_R11079_; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); - ffestc_R1107_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif -/* ffestb_R1202 -- Parse the INTERFACE statement - - return ffestb_R1202; // to lexer - - Make sure the statement has a valid form for the INTERFACE statement. - If it does, implement the statement. - - 15-May-90 JCB 1.1 - Allow INTERFACE by itself; missed this - valid form when originally doing syntactic analysis code. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_R1202 (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstINTERFACE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorNone, NULL); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - - ffesta_confirmed (); - switch (ffesta_second_kw) - { - case FFESTR_secondOPERATOR: - ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR; - break; - - case FFESTR_secondASSIGNMENT: - ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT; - break; - - default: - ffestb_local_.interface.operator = FFESTP_definedoperatorNone; - break; - } - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_R12021_; - - case FFELEX_typeNAMES: - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE); - switch (ffesta_first_kw) - { - case FFESTR_firstINTERFACEOPERATOR: - if (*(ffelex_token_text (ffesta_tokens[0]) - + FFESTR_firstlINTERFACEOPERATOR) == '\0') - ffestb_local_.interface.operator - = FFESTP_definedoperatorOPERATOR; - break; - - case FFESTR_firstINTERFACEASSGNMNT: - if (*(ffelex_token_text (ffesta_tokens[0]) - + FFESTR_firstlINTERFACEASSGNMNT) == '\0') - ffestb_local_.interface.operator - = FFESTP_definedoperatorASSIGNMENT; - break; - - case FFESTR_firstINTERFACE: - ffestb_local_.interface.operator = FFESTP_definedoperatorNone; - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeOPEN_PAREN: - case FFELEX_typeOPEN_ARRAY: /* Sigh. */ - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (*p == '\0') - { - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorNone, NULL); - return (ffelexHandler) ffesta_zero (t); - } - break; - } - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - return (ffelexHandler) ffestb_R12021_ (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R12021_ -- "INTERFACE" NAME - - return ffestb_R12021_; // to lexer - - Make sure the statement has a valid form for the INTERFACE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_R12021_ (ffelexToken t) -{ - ffestb_local_.interface.slash = TRUE; /* Slash follows open paren. */ - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeOPEN_PAREN: - ffestb_local_.interface.slash = FALSE; /* Slash doesn't follow. */ - /* Fall through. */ - case FFELEX_typeOPEN_ARRAY: - switch (ffestb_local_.interface.operator) - { - case FFESTP_definedoperatorNone: - break; - - case FFESTP_definedoperatorOPERATOR: - ffestb_local_.interface.assignment = FALSE; - return (ffelexHandler) ffestb_R12022_; - - case FFESTP_definedoperatorASSIGNMENT: - ffestb_local_.interface.assignment = TRUE; - return (ffelexHandler) ffestb_R12022_; - - default: - assert (FALSE); - } - break; - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - break; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN - - return ffestb_R12022_; // to lexer - - Make sure the statement has a valid form for the INTERFACE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_R12022_ (ffelexToken t) -{ - ffesta_tokens[2] = ffelex_token_use (t); - - switch (ffelex_token_type (t)) - { - case FFELEX_typePERIOD: - if (ffestb_local_.interface.slash) - break; - return (ffelexHandler) ffestb_R12023_; - - case FFELEX_typePOWER: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeASTERISK: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorMULT; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typePLUS: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorADD; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeCONCAT: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeSLASH: - if (ffestb_local_.interface.slash) - { - ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT; - return (ffelexHandler) ffestb_R12025_; - } - ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeMINUS: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeREL_EQ: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorEQ; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeREL_NE: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorNE; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeOPEN_ANGLE: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorLT; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeREL_LE: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorLE; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeCLOSE_ANGLE: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorGT; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeREL_GE: - if (ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorGE; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeEQUALS: - if (ffestb_local_.interface.slash) - { - ffestb_local_.interface.operator = FFESTP_definedoperatorNE; - return (ffelexHandler) ffestb_R12025_; - } - ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT; - return (ffelexHandler) ffestb_R12025_; - - case FFELEX_typeCLOSE_ARRAY: - if (!ffestb_local_.interface.slash) - { - ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE; - return (ffelexHandler) ffestb_R12026_; - } - ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT; - return (ffelexHandler) ffestb_R12026_; - - case FFELEX_typeCLOSE_PAREN: - if (!ffestb_local_.interface.slash) - break; - ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE; - return (ffelexHandler) ffestb_R12026_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD - - return ffestb_R12023_; // to lexer - - Make sure the statement has a valid form for the INTERFACE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_R12023_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffelex_token_kill (ffesta_tokens[2]); - ffesta_tokens[2] = ffelex_token_use (t); - return (ffelexHandler) ffestb_R12024_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME - - return ffestb_R12024_; // to lexer - - Make sure the statement has a valid form for the INTERFACE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_R12024_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typePERIOD: - return (ffelexHandler) ffestb_R12025_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator - - return ffestb_R12025_; // to lexer - - Make sure the statement has a valid form for the INTERFACE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_R12025_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_R12026_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN - - return ffestb_R12026_; // to lexer - - Make sure the statement has a valid form for the INTERFACE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_R12026_ (ffelexToken t) -{ - const char *p; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (ffestb_local_.interface.assignment - && (ffestb_local_.interface.operator - != FFESTP_definedoperatorASSIGNMENT)) - { - ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]), - ffelex_token_where_column (ffesta_tokens[1])); - ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]), - ffelex_token_where_column (ffesta_tokens[2])); - ffebad_finish (); - } - switch (ffelex_token_type (ffesta_tokens[2])) - { - case FFELEX_typeNAME: - switch (ffestr_other (ffesta_tokens[2])) - { - case FFESTR_otherNOT: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorNOT, NULL); - break; - - case FFESTR_otherAND: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorAND, NULL); - break; - - case FFESTR_otherOR: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorOR, NULL); - break; - - case FFESTR_otherEQV: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorEQV, NULL); - break; - - case FFESTR_otherNEQV: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL); - break; - - case FFESTR_otherEQ: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorEQ, NULL); - break; - - case FFESTR_otherNE: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorNE, NULL); - break; - - case FFESTR_otherLT: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorLT, NULL); - break; - - case FFESTR_otherLE: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorLE, NULL); - break; - - case FFESTR_otherGT: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorGT, NULL); - break; - - case FFESTR_otherGE: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorGE, NULL); - break; - - default: - for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p) - { - if (! ISALPHA (*p)) - { - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER, - ffesta_tokens[2]); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); - } - } - if (!ffesta_is_inhibited ()) - ffestc_R1202 (FFESTP_definedoperatorOPERATOR, - ffesta_tokens[2]); - } - break; - - case FFELEX_typeEQUALS: - if (!ffestb_local_.interface.assignment - && (ffestb_local_.interface.operator - == FFESTP_definedoperatorASSIGNMENT)) - { - ffebad_start (FFEBAD_INTERFACE_OPERATOR); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]), - ffelex_token_where_column (ffesta_tokens[1])); - ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]), - ffelex_token_where_column (ffesta_tokens[2])); - ffebad_finish (); - } - if (!ffesta_is_inhibited ()) - ffestc_R1202 (ffestb_local_.interface.operator, NULL); - break; - - default: - if (!ffesta_is_inhibited ()) - ffestc_R1202 (ffestb_local_.interface.operator, NULL); - } - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_S3P4 -- Parse the INCLUDE line return ffestb_S3P4; // to lexer @@ -12092,75 +9191,6 @@ ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_V012 -- Parse the MAP statement - - return ffestb_V012; // to lexer - - Make sure the statement has a valid form for the MAP statement. If - it does, implement the statement. */ - -#if FFESTR_VXT -ffelexHandler -ffestb_V012 (ffelexToken t) -{ - const char *p; - ffeTokenLength i; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstMAP) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstMAP) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP) - { - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP); - goto bad_i; /* :::::::::::::::::::: */ - } - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V012 (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid first token. */ - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_V014 -- Parse the VOLATILE statement return ffestb_V014; // to lexer @@ -12394,344 +9424,6 @@ ffestb_V0144_ (ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_V025 -- Parse the DEFINEFILE statement - - return ffestb_V025; // to lexer - - Make sure the statement has a valid form for the DEFINEFILE statement. - If it does, implement the statement. */ - -#if FFESTR_VXT -ffelexHandler -ffestb_V025 (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - ffelexToken nt; - ffelexHandler next; - - ffestb_local_.V025.started = FALSE; - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - switch (ffesta_first_kw) - { - case FFESTR_firstDEFINE: - if ((ffelex_token_type (t) != FFELEX_typeNAME) - || (ffesta_second_kw != FFESTR_secondFILE)) - goto bad_1; /* :::::::::::::::::::: */ - ffesta_confirmed (); - return (ffelexHandler) ffestb_V0251_; - - case FFESTR_firstDEFINEFILE: - return (ffelexHandler) ffestb_V0251_ (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstDEFINEFILE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeOPEN_PAREN: - break; - } - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE); - if (ISDIGIT (*p)) - nt = ffelex_token_number_from_names (ffesta_tokens[0], i); - else if (ffesrc_is_name_init (*p)) - nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - else - goto bad_i; /* :::::::::::::::::::: */ - next = (ffelexHandler) ffestb_V0251_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE" - - return ffestb_V0251_; // to lexer - - Make sure the statement has a valid form for the DEFINEFILE statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_V0251_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - case FFELEX_typeNUMBER: - if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME) - ffesta_confirmed (); - return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_))) - (t); - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - break; - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0252_ -- "DEFINEFILE" expr - - (ffestb_V0252_) // to expression handler - - Make sure the statement has a valid form for the DEFINEFILE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - ffestb_local_.V025.u = expr; - ffesta_tokens[1] = ffelex_token_use (ft); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_); - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr - - (ffestb_V0253_) // to expression handler - - Make sure the statement has a valid form for the DEFINEFILE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - ffestb_local_.V025.m = expr; - ffesta_tokens[2] = ffelex_token_use (ft); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_); - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr - - (ffestb_V0254_) // to expression handler - - Make sure the statement has a valid form for the DEFINEFILE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - ffestb_local_.V025.n = expr; - ffesta_tokens[3] = ffelex_token_use (ft); - return (ffelexHandler) ffestb_V0255_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA - - return ffestb_V0255_; // to lexer - - Make sure the statement has a valid form for the DEFINEFILE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_V0255_ (ffelexToken t) -{ - const char *p; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - p = ffelex_token_text (t); - if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0')) - break; - return (ffelexHandler) ffestb_V0256_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffelex_token_kill (ffesta_tokens[3]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U" - - return ffestb_V0256_; // to lexer - - Make sure the statement has a valid form for the DEFINEFILE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_V0256_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextFILEASSOC, - (ffeexprCallback) ffestb_V0257_); - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffelex_token_kill (ffesta_tokens[3]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U" - COMMA expr - - (ffestb_V0257_) // to expression handler - - Make sure the statement has a valid form for the DEFINEFILE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - ffestb_local_.V025.asv = expr; - ffesta_tokens[4] = ffelex_token_use (ft); - return (ffelexHandler) ffestb_V0258_; - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffelex_token_kill (ffesta_tokens[3]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U" - COMMA expr CLOSE_PAREN - - return ffestb_V0258_; // to lexer - - Make sure the statement has a valid form for the DEFINEFILE statement. If - it does, implement the statement. */ - -static ffelexHandler -ffestb_V0258_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffestb_local_.V025.started) - { - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V025_start (); - ffestb_local_.V025.started = TRUE; - } - if (!ffesta_is_inhibited ()) - ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1], - ffestb_local_.V025.m, ffesta_tokens[2], - ffestb_local_.V025.n, ffesta_tokens[3], - ffestb_local_.V025.asv, ffesta_tokens[4]); - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffelex_token_kill (ffesta_tokens[3]); - ffelex_token_kill (ffesta_tokens[4]); - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_); - if (!ffesta_is_inhibited ()) - ffestc_V025_finish (); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[2]); - ffelex_token_kill (ffesta_tokens[3]); - ffelex_token_kill (ffesta_tokens[4]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_subr_kill_easy_ -- Kill I/O statement data structure ffestb_subr_kill_easy_(); @@ -12768,7 +9460,7 @@ ffestb_subr_kill_easy_ (ffestpInquireIx max) #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_accept_ () +ffestb_subr_kill_accept_ (void) { ffestpAcceptIx ix; @@ -12794,7 +9486,7 @@ ffestb_subr_kill_accept_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_beru_ () +ffestb_subr_kill_beru_ (void) { ffestpBeruIx ix; @@ -12819,7 +9511,7 @@ ffestb_subr_kill_beru_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_close_ () +ffestb_subr_kill_close_ (void) { ffestpCloseIx ix; @@ -12844,7 +9536,7 @@ ffestb_subr_kill_close_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_delete_ () +ffestb_subr_kill_delete_ (void) { ffestpDeleteIx ix; @@ -12869,7 +9561,7 @@ ffestb_subr_kill_delete_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_inquire_ () +ffestb_subr_kill_inquire_ (void) { ffestpInquireIx ix; @@ -12894,7 +9586,7 @@ ffestb_subr_kill_inquire_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_open_ () +ffestb_subr_kill_open_ (void) { ffestpOpenIx ix; @@ -12919,7 +9611,7 @@ ffestb_subr_kill_open_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_print_ () +ffestb_subr_kill_print_ (void) { ffestpPrintIx ix; @@ -12944,7 +9636,7 @@ ffestb_subr_kill_print_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_read_ () +ffestb_subr_kill_read_ (void) { ffestpReadIx ix; @@ -12969,7 +9661,7 @@ ffestb_subr_kill_read_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_rewrite_ () +ffestb_subr_kill_rewrite_ (void) { ffestpRewriteIx ix; @@ -12994,7 +9686,7 @@ ffestb_subr_kill_rewrite_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_type_ () +ffestb_subr_kill_type_ (void) { ffestpTypeIx ix; @@ -13019,7 +9711,7 @@ ffestb_subr_kill_type_ () #if !FFESTB_KILL_EASY_ static void -ffestb_subr_kill_write_ () +ffestb_subr_kill_write_ (void) { ffestpWriteIx ix; @@ -13187,12 +9879,6 @@ ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t) ffestc_R921 (); break; -#if FFESTR_VXT - case FFESTR_firstUNLOCK: - ffestc_V022 (); - break; -#endif - default: assert (FALSE); } @@ -13549,12 +10235,6 @@ ffestb_beru10_ (ffelexToken t) ffestc_R921 (); break; -#if FFESTR_VXT - case FFESTR_firstUNLOCK: - ffestc_V022 (); - break; -#endif - default: assert (FALSE); } @@ -13571,504 +10251,6 @@ ffestb_beru10_ (ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement - - return ffestb_vxtcode; // to lexer - - Make sure the statement has a valid form for the VXT DECODE/ENCODE - statement. If it does, implement the statement. */ - -#if FFESTR_VXT -ffelexHandler -ffestb_vxtcode (ffelexToken t) -{ - ffestpVxtcodeIx ix; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeNAME: - case FFELEX_typeNUMBER: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeOPEN_PAREN: - for (ix = 0; ix < FFESTP_vxtcodeix; ++ix) - ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE; - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_); - } - - case FFELEX_typeNAMES: - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeOPEN_PAREN: - if (ffelex_token_length (ffesta_tokens[0]) - != ffestb_args.vxtcode.len) - goto bad_0; /* :::::::::::::::::::: */ - - for (ix = 0; ix < FFESTP_vxtcodeix; ++ix) - ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE; - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_); - } - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -/* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr - - (ffestb_vxtcode1_) // to expression handler - - Handle COMMA here. */ - -static ffelexHandler -ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - if (expr == NULL) - break; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present - = TRUE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label - = FALSE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value - = ffelex_token_use (ft); - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr; - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_); - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr - - (ffestb_vxtcode2_) // to expression handler - - Handle COMMA here. */ - -static ffelexHandler -ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present - = TRUE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label - = (expr == NULL); - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value - = ffelex_token_use (ft); - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr; - if (ffesta_first_kw == FFESTR_firstENCODE) - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextFILEVXTCODE, - (ffeexprCallback) ffestb_vxtcode3_); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEVXTCODE, - (ffeexprCallback) ffestb_vxtcode3_); - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr - - (ffestb_vxtcode3_) // to expression handler - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present - = TRUE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label - = FALSE; - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value - = ffelex_token_use (ft); - ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_vxtcode4_; - return (ffelexHandler) ffestb_vxtcode9_; - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ... - - return ffestb_vxtcode4_; // to lexer - - Handle NAME=expr construct here. */ - -static ffelexHandler -ffestb_vxtcode4_ (ffelexToken t) -{ - ffestrGenio kw; - - ffestb_local_.vxtcode.label = FALSE; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - kw = ffestr_genio (t); - switch (kw) - { - case FFESTR_genioERR: - ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR; - ffestb_local_.vxtcode.label = TRUE; - break; - - case FFESTR_genioIOSTAT: - ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT; - ffestb_local_.vxtcode.left = TRUE; - ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT; - break; - - default: - goto bad; /* :::::::::::::::::::: */ - } - if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] - .kw_or_val_present) - break; /* Can't specify a keyword twice! */ - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] - .kw_or_val_present = TRUE; - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] - .kw_present = TRUE; - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] - .value_present = FALSE; - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label - = ffestb_local_.vxtcode.label; - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw - = ffelex_token_use (t); - return (ffelexHandler) ffestb_vxtcode5_; - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format - COMMA]] NAME - - return ffestb_vxtcode5_; // to lexer - - Make sure EQUALS here, send next token to expression handler. */ - -static ffelexHandler -ffestb_vxtcode5_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - ffesta_confirmed (); - if (ffestb_local_.vxtcode.label) - return (ffelexHandler) ffestb_vxtcode7_; - if (ffestb_local_.vxtcode.left) - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - ffestb_local_.vxtcode.context, - (ffeexprCallback) ffestb_vxtcode6_); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - ffestb_local_.vxtcode.context, - (ffeexprCallback) ffestb_vxtcode6_); - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr - - (ffestb_vxtcode6_) // to expression handler - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present - = TRUE; - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value - = ffelex_token_use (ft); - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_vxtcode4_; - return (ffelexHandler) ffestb_vxtcode9_; - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS - - return ffestb_vxtcode7_; // to lexer - - Handle NUMBER for label here. */ - -static ffelexHandler -ffestb_vxtcode7_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNUMBER: - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present - = TRUE; - ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value - = ffelex_token_use (t); - return (ffelexHandler) ffestb_vxtcode8_; - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER - - return ffestb_vxtcode8_; // to lexer - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_vxtcode8_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - return (ffelexHandler) ffestb_vxtcode4_; - - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_vxtcode9_; - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN - - return ffestb_vxtcode9_; // to lexer - - Handle EOS or SEMICOLON here. - - 07-Jun-90 JCB 1.1 - Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST - since they apply to internal files. */ - -static ffelexHandler -ffestb_vxtcode9_ (ffelexToken t) -{ - ffelexHandler next; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - if (ffesta_first_kw == FFESTR_firstENCODE) - { - ffestc_V023_start (); - ffestc_V023_finish (); - } - else - { - ffestc_V024_start (); - ffestc_V024_finish (); - } - } - ffestb_subr_kill_vxtcode_ (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeNAME: - case FFELEX_typeOPEN_PAREN: - case FFELEX_typeCOMMA: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - if (ffesta_first_kw == FFESTR_firstENCODE) - ffestc_V023_start (); - else - ffestc_V024_start (); - ffestb_subr_kill_vxtcode_ (); - if (ffesta_first_kw == FFESTR_firstDECODE) - next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextIOLISTDF, - (ffeexprCallback) ffestb_vxtcode10_); - else - next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextIOLISTDF, - (ffeexprCallback) ffestb_vxtcode10_); - - /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. - (f2c provides this extension, as do other compilers, supposedly.) */ - - if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) - return next; - - return (ffelexHandler) (*next) (t); - - default: - break; - } - - ffestb_subr_kill_vxtcode_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_vxtcode10_ -- "VXTCODE(...)" expr - - (ffestb_vxtcode10_) // to expression handler - - Handle COMMA or EOS/SEMICOLON here. - - 07-Jun-90 JCB 1.1 - Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST - since they apply to internal files. */ - -static ffelexHandler -ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - if (expr == NULL) - break; - if (!ffesta_is_inhibited ()) - if (ffesta_first_kw == FFESTR_firstENCODE) - ffestc_V023_item (expr, ft); - else - ffestc_V024_item (expr, ft); - if (ffesta_first_kw == FFESTR_firstDECODE) - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextIOLISTDF, - (ffeexprCallback) ffestb_vxtcode10_); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextIOLISTDF, - (ffeexprCallback) ffestb_vxtcode10_); - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (expr == NULL) - break; - if (!ffesta_is_inhibited ()) - { - if (ffesta_first_kw == FFESTR_firstENCODE) - { - ffestc_V023_item (expr, ft); - ffestc_V023_finish (); - } - else - { - ffestc_V024_item (expr, ft); - ffestc_V024_finish (); - } - } - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - if (!ffesta_is_inhibited ()) - if (ffesta_first_kw == FFESTR_firstENCODE) - ffestc_V023_finish (); - else - ffestc_V024_finish (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_R904 -- Parse an OPEN statement return ffestb_R904; // to lexer @@ -17183,728 +13365,6 @@ ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_V018 -- Parse the REWRITE statement - - return ffestb_V018; // to lexer - - Make sure the statement has a valid form for the REWRITE - statement. If it does, implement the statement. */ - -#if FFESTR_VXT -ffelexHandler -ffestb_V018 (ffelexToken t) -{ - ffestpRewriteIx ix; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstREWRITE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeNAME: - case FFELEX_typeNUMBER: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeOPEN_PAREN: - for (ix = 0; ix < FFESTP_rewriteix; ++ix) - ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE; - return (ffelexHandler) ffestb_V0181_; - } - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstREWRITE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeOPEN_PAREN: - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE) - goto bad_0; /* :::::::::::::::::::: */ - - for (ix = 0; ix < FFESTP_rewriteix; ++ix) - ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE; - return (ffelexHandler) ffestb_V0181_; - } - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -/* ffestb_V0181_ -- "REWRITE" OPEN_PAREN - - return ffestb_V0181_; // to lexer - - Handle expr construct (not NAME=expr construct) here. */ - -static ffelexHandler -ffestb_V0181_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0182_; - - default: - return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_))) - (t); - } -} - -/* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME - - return ffestb_V0182_; // to lexer - - If EQUALS here, go to states that handle it. Else, send NAME and this - token thru expression handler. */ - -static ffelexHandler -ffestb_V0182_ (ffelexToken t) -{ - ffelexHandler next; - ffelexToken nt; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - nt = ffesta_tokens[1]; - next = (ffelexHandler) ffestb_V0187_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - - default: - nt = ffesta_tokens[1]; - next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_))) - (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - } -} - -/* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN] - - (ffestb_V0183_) // to expression handler - - Handle COMMA or EOS/SEMICOLON here. */ - -static ffelexHandler -ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present - = TRUE; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label - = FALSE; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value - = ffelex_token_use (ft); - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_V0184_; - return (ffelexHandler) ffestb_V01812_; - - default: - break; - } - - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA - - return ffestb_V0184_; // to lexer - - Handle expr construct (not NAME=expr construct) here. */ - -static ffelexHandler -ffestb_V0184_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0185_; - - default: - return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_))) - (t); - } -} - -/* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME - - return ffestb_V0185_; // to lexer - - If EQUALS here, go to states that handle it. Else, send NAME and this - token thru expression handler. */ - -static ffelexHandler -ffestb_V0185_ (ffelexToken t) -{ - ffelexHandler next; - ffelexToken nt; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - nt = ffesta_tokens[1]; - next = (ffelexHandler) ffestb_V0187_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - - default: - nt = ffesta_tokens[1]; - next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_))) - (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - } -} - -/* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr - - (ffestb_V0186_) // to expression handler - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present - = TRUE; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE; - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label - = (expr == NULL); - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value - = ffelex_token_use (ft); - ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_V0187_; - return (ffelexHandler) ffestb_V01812_; - - default: - break; - } - - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format - COMMA]] - - return ffestb_V0187_; // to lexer - - Handle expr construct (not NAME=expr construct) here. */ - -static ffelexHandler -ffestb_V0187_ (ffelexToken t) -{ - ffestrGenio kw; - - ffestb_local_.rewrite.label = FALSE; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - kw = ffestr_genio (t); - switch (kw) - { - case FFESTR_genioERR: - ffestb_local_.rewrite.ix = FFESTP_rewriteixERR; - ffestb_local_.rewrite.label = TRUE; - break; - - case FFESTR_genioFMT: - ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT; - ffestb_local_.rewrite.left = FALSE; - ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT; - break; - - case FFESTR_genioIOSTAT: - ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT; - ffestb_local_.rewrite.left = TRUE; - ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT; - break; - - case FFESTR_genioUNIT: - ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT; - ffestb_local_.rewrite.left = FALSE; - ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM; - break; - - default: - goto bad; /* :::::::::::::::::::: */ - } - if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] - .kw_or_val_present) - break; /* Can't specify a keyword twice! */ - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] - .kw_or_val_present = TRUE; - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] - .kw_present = TRUE; - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] - .value_present = FALSE; - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label - = ffestb_local_.rewrite.label; - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw - = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0188_; - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format - COMMA]] NAME - - return ffestb_V0188_; // to lexer - - Make sure EQUALS here, send next token to expression handler. */ - -static ffelexHandler -ffestb_V0188_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - ffesta_confirmed (); - if (ffestb_local_.rewrite.label) - return (ffelexHandler) ffestb_V01810_; - if (ffestb_local_.rewrite.left) - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - ffestb_local_.rewrite.context, - (ffeexprCallback) ffestb_V0189_); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - ffestb_local_.rewrite.context, - (ffeexprCallback) ffestb_V0189_); - - default: - break; - } - - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr - - (ffestb_V0189_) // to expression handler - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT) - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] - .value_is_label = TRUE; - else - break; - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present - = TRUE; - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value - = ffelex_token_use (ft); - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_V0187_; - return (ffelexHandler) ffestb_V01812_; - - default: - break; - } - - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS - - return ffestb_V01810_; // to lexer - - Handle NUMBER for label here. */ - -static ffelexHandler -ffestb_V01810_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNUMBER: - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present - = TRUE; - ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value - = ffelex_token_use (t); - return (ffelexHandler) ffestb_V01811_; - - default: - break; - } - - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER - - return ffestb_V01811_; // to lexer - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_V01811_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - return (ffelexHandler) ffestb_V0187_; - - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_V01812_; - - default: - break; - } - - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN - - return ffestb_V01812_; // to lexer - - Handle EOS or SEMICOLON here. */ - -static ffelexHandler -ffestb_V01812_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - ffestc_V018_start (); - ffestc_V018_finish (); - } - ffestb_subr_kill_rewrite_ (); - return (ffelexHandler) ffesta_zero (t); - - case FFELEX_typeNAME: - case FFELEX_typeOPEN_PAREN: - case FFELEX_typeCOMMA: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V018_start (); - ffestb_subr_kill_rewrite_ (); - - /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. - (f2c provides this extension, as do other compilers, supposedly.) */ - - if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_); - - return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_))) - (t); - - default: - break; - } - - ffestb_subr_kill_rewrite_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V01813_ -- "REWRITE(...)" expr - - (ffestb_V01813_) // to expression handler - - Handle COMMA or EOS/SEMICOLON here. */ - -static ffelexHandler -ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - if (expr == NULL) - break; - if (!ffesta_is_inhibited ()) - ffestc_V018_item (expr, ft); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_); - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (expr == NULL) - break; - if (!ffesta_is_inhibited ()) - { - ffestc_V018_item (expr, ft); - ffestc_V018_finish (); - } - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V018_finish (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V019 -- Parse the ACCEPT statement - - return ffestb_V019; // to lexer - - Make sure the statement has a valid form for the ACCEPT - statement. If it does, implement the statement. */ - -ffelexHandler -ffestb_V019 (ffelexToken t) -{ - ffelexHandler next; - ffestpAcceptIx ix; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstACCEPT) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeEQUALS: - case FFELEX_typePOINTS: - case FFELEX_typeCOLON: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeNAME: - case FFELEX_typeNUMBER: - ffesta_confirmed (); - break; - - default: - break; - } - - for (ix = 0; ix < FFESTP_acceptix; ++ix) - ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE; - return (ffelexHandler) (*((ffelexHandler) - ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_))) - (t); - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstACCEPT) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - ffesta_confirmed (); - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT) - break; - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeEQUALS: - case FFELEX_typePOINTS: - case FFELEX_typeCOLON: - goto bad_1; /* :::::::::::::::::::: */ - - default: - break; - } - for (ix = 0; ix < FFESTP_acceptix; ++ix) - ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE; - next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_); - next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], - FFESTR_firstlACCEPT); - if (next == NULL) - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); - return (ffelexHandler) (*next) (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -/* ffestb_V0191_ -- "ACCEPT" expr - - (ffestb_V0191_) // to expression handler - - Make sure the next token is a COMMA or EOS/SEMICOLON. */ - -static ffelexHandler -ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - ffesta_confirmed (); - ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present - = TRUE; - ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE; - ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE; - ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label - = (expr == NULL); - ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value - = ffelex_token_use (ft); - ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr; - if (!ffesta_is_inhibited ()) - ffestc_V019_start (); - ffestb_subr_kill_accept_ (); - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextIOLIST, - (ffeexprCallback) ffestb_V0192_); - if (!ffesta_is_inhibited ()) - ffestc_V019_finish (); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffestb_subr_kill_accept_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0192_ -- "ACCEPT" expr COMMA expr - - (ffestb_V0192_) // to expression handler - - Handle COMMA or EOS/SEMICOLON here. */ - -static ffelexHandler -ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - if (expr == NULL) - break; - if (!ffesta_is_inhibited ()) - ffestc_V019_item (expr, ft); - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextIOLIST, - (ffeexprCallback) ffestb_V0192_); - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (expr == NULL) - break; - if (!ffesta_is_inhibited ()) - { - ffestc_V019_item (expr, ft); - ffestc_V019_finish (); - } - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V019_finish (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_V020 -- Parse the TYPE statement return ffestb_V020; // to lexer @@ -18107,1294 +13567,6 @@ ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t) return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_V021 -- Parse a DELETE statement - - return ffestb_V021; // to lexer - - Make sure the statement has a valid form for a DELETE statement. - If it does, implement the statement. */ - -#if FFESTR_VXT -ffelexHandler -ffestb_V021 (ffelexToken t) -{ - ffestpDeleteIx ix; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstDELETE) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstDELETE) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE) - goto bad_0; /* :::::::::::::::::::: */ - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - - for (ix = 0; ix < FFESTP_deleteix; ++ix) - ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE; - - return (ffelexHandler) ffestb_V0211_; - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -/* ffestb_V0211_ -- "DELETE" OPEN_PAREN - - return ffestb_V0211_; // to lexer - - Handle expr construct (not NAME=expr construct) here. */ - -static ffelexHandler -ffestb_V0211_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0212_; - - default: - return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_))) - (t); - } -} - -/* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME - - return ffestb_V0212_; // to lexer - - If EQUALS here, go to states that handle it. Else, send NAME and this - token thru expression handler. */ - -static ffelexHandler -ffestb_V0212_ (ffelexToken t) -{ - ffelexHandler next; - ffelexToken nt; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - nt = ffesta_tokens[1]; - next = (ffelexHandler) ffestb_V0214_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - - default: - next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_))) - (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) (*next) (t); - } -} - -/* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr - - (ffestb_V0213_) // to expression handler - - Handle COMMA or DELETE_PAREN here. */ - -static ffelexHandler -ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present - = TRUE; - ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE; - ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE; - ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label - = FALSE; - ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value - = ffelex_token_use (ft); - ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_V0214_; - return (ffelexHandler) ffestb_V0219_; - - default: - break; - } - - ffestb_subr_kill_delete_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] - - return ffestb_V0214_; // to lexer - - Handle expr construct (not NAME=expr construct) here. */ - -static ffelexHandler -ffestb_V0214_ (ffelexToken t) -{ - ffestrGenio kw; - - ffestb_local_.delete.label = FALSE; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - kw = ffestr_genio (t); - switch (kw) - { - case FFESTR_genioERR: - ffestb_local_.delete.ix = FFESTP_deleteixERR; - ffestb_local_.delete.label = TRUE; - break; - - case FFESTR_genioIOSTAT: - ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT; - ffestb_local_.delete.left = TRUE; - ffestb_local_.delete.context = FFEEXPR_contextFILEINT; - break; - - case FFESTR_genioREC: - ffestb_local_.delete.ix = FFESTP_deleteixREC; - ffestb_local_.delete.left = FALSE; - ffestb_local_.delete.context = FFEEXPR_contextFILENUM; - break; - - case FFESTR_genioUNIT: - ffestb_local_.delete.ix = FFESTP_deleteixUNIT; - ffestb_local_.delete.left = FALSE; - ffestb_local_.delete.context = FFEEXPR_contextFILENUM; - break; - - default: - goto bad; /* :::::::::::::::::::: */ - } - if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] - .kw_or_val_present) - break; /* Can't specify a keyword twice! */ - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] - .kw_or_val_present = TRUE; - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] - .kw_present = TRUE; - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] - .value_present = FALSE; - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label - = ffestb_local_.delete.label; - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw - = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0215_; - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - ffestb_subr_kill_delete_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME - - return ffestb_V0215_; // to lexer - - Make sure EQUALS here, send next token to expression handler. */ - -static ffelexHandler -ffestb_V0215_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - ffesta_confirmed (); - if (ffestb_local_.delete.label) - return (ffelexHandler) ffestb_V0217_; - if (ffestb_local_.delete.left) - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - ffestb_local_.delete.context, - (ffeexprCallback) ffestb_V0216_); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_); - - default: - break; - } - - ffestb_subr_kill_delete_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr - - (ffestb_V0216_) // to expression handler - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present - = TRUE; - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value - = ffelex_token_use (ft); - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_V0214_; - return (ffelexHandler) ffestb_V0219_; - - default: - break; - } - - ffestb_subr_kill_delete_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS - - return ffestb_V0217_; // to lexer - - Handle NUMBER for label here. */ - -static ffelexHandler -ffestb_V0217_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNUMBER: - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present - = TRUE; - ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value - = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0218_; - - default: - break; - } - - ffestb_subr_kill_delete_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER - - return ffestb_V0218_; // to lexer - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_V0218_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - return (ffelexHandler) ffestb_V0214_; - - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_V0219_; - - default: - break; - } - - ffestb_subr_kill_delete_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN - - return ffestb_V0219_; // to lexer - - Handle EOS or SEMICOLON here. */ - -static ffelexHandler -ffestb_V0219_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V021 (); - ffestb_subr_kill_delete_ (); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffestb_subr_kill_delete_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V026 -- Parse a FIND statement - - return ffestb_V026; // to lexer - - Make sure the statement has a valid form for a FIND statement. - If it does, implement the statement. */ - -ffelexHandler -ffestb_V026 (ffelexToken t) -{ - ffestpFindIx ix; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstFIND) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstFIND) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND) - goto bad_0; /* :::::::::::::::::::: */ - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - - for (ix = 0; ix < FFESTP_findix; ++ix) - ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE; - - return (ffelexHandler) ffestb_V0261_; - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -/* ffestb_V0261_ -- "FIND" OPEN_PAREN - - return ffestb_V0261_; // to lexer - - Handle expr construct (not NAME=expr construct) here. */ - -static ffelexHandler -ffestb_V0261_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0262_; - - default: - return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_))) - (t); - } -} - -/* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME - - return ffestb_V0262_; // to lexer - - If EQUALS here, go to states that handle it. Else, send NAME and this - token thru expression handler. */ - -static ffelexHandler -ffestb_V0262_ (ffelexToken t) -{ - ffelexHandler next; - ffelexToken nt; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - nt = ffesta_tokens[1]; - next = (ffelexHandler) ffestb_V0264_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - - default: - next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_))) - (ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) (*next) (t); - } -} - -/* ffestb_V0263_ -- "FIND" OPEN_PAREN expr - - (ffestb_V0263_) // to expression handler - - Handle COMMA or FIND_PAREN here. */ - -static ffelexHandler -ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present - = TRUE; - ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE; - ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE; - ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label - = FALSE; - ffestp_file.find.find_spec[FFESTP_findixUNIT].value - = ffelex_token_use (ft); - ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_V0264_; - return (ffelexHandler) ffestb_V0269_; - - default: - break; - } - - ffestb_subr_kill_find_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] - - return ffestb_V0264_; // to lexer - - Handle expr construct (not NAME=expr construct) here. */ - -static ffelexHandler -ffestb_V0264_ (ffelexToken t) -{ - ffestrGenio kw; - - ffestb_local_.find.label = FALSE; - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - kw = ffestr_genio (t); - switch (kw) - { - case FFESTR_genioERR: - ffestb_local_.find.ix = FFESTP_findixERR; - ffestb_local_.find.label = TRUE; - break; - - case FFESTR_genioIOSTAT: - ffestb_local_.find.ix = FFESTP_findixIOSTAT; - ffestb_local_.find.left = TRUE; - ffestb_local_.find.context = FFEEXPR_contextFILEINT; - break; - - case FFESTR_genioREC: - ffestb_local_.find.ix = FFESTP_findixREC; - ffestb_local_.find.left = FALSE; - ffestb_local_.find.context = FFEEXPR_contextFILENUM; - break; - - case FFESTR_genioUNIT: - ffestb_local_.find.ix = FFESTP_findixUNIT; - ffestb_local_.find.left = FALSE; - ffestb_local_.find.context = FFEEXPR_contextFILENUM; - break; - - default: - goto bad; /* :::::::::::::::::::: */ - } - if (ffestp_file.find.find_spec[ffestb_local_.find.ix] - .kw_or_val_present) - break; /* Can't specify a keyword twice! */ - ffestp_file.find.find_spec[ffestb_local_.find.ix] - .kw_or_val_present = TRUE; - ffestp_file.find.find_spec[ffestb_local_.find.ix] - .kw_present = TRUE; - ffestp_file.find.find_spec[ffestb_local_.find.ix] - .value_present = FALSE; - ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label - = ffestb_local_.find.label; - ffestp_file.find.find_spec[ffestb_local_.find.ix].kw - = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0265_; - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - ffestb_subr_kill_find_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME - - return ffestb_V0265_; // to lexer - - Make sure EQUALS here, send next token to expression handler. */ - -static ffelexHandler -ffestb_V0265_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEQUALS: - ffesta_confirmed (); - if (ffestb_local_.find.label) - return (ffelexHandler) ffestb_V0267_; - if (ffestb_local_.find.left) - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - ffestb_local_.find.context, - (ffeexprCallback) ffestb_V0266_); - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - ffestb_local_.find.context, - (ffeexprCallback) ffestb_V0266_); - - default: - break; - } - - ffestb_subr_kill_find_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr - - (ffestb_V0266_) // to expression handler - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present - = TRUE; - ffestp_file.find.find_spec[ffestb_local_.find.ix].value - = ffelex_token_use (ft); - ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr; - if (ffelex_token_type (t) == FFELEX_typeCOMMA) - return (ffelexHandler) ffestb_V0264_; - return (ffelexHandler) ffestb_V0269_; - - default: - break; - } - - ffestb_subr_kill_find_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS - - return ffestb_V0267_; // to lexer - - Handle NUMBER for label here. */ - -static ffelexHandler -ffestb_V0267_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNUMBER: - ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present - = TRUE; - ffestp_file.find.find_spec[ffestb_local_.find.ix].value - = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0268_; - - default: - break; - } - - ffestb_subr_kill_find_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER - - return ffestb_V0268_; // to lexer - - Handle COMMA or CLOSE_PAREN here. */ - -static ffelexHandler -ffestb_V0268_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - return (ffelexHandler) ffestb_V0264_; - - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_V0269_; - - default: - break; - } - - ffestb_subr_kill_find_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN - - return ffestb_V0269_; // to lexer - - Handle EOS or SEMICOLON here. */ - -static ffelexHandler -ffestb_V0269_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V026 (); - ffestb_subr_kill_find_ (); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffestb_subr_kill_find_ (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif -/* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement - - return ffestb_dimlist; // to lexer - - Make sure the statement has a valid form for the ALLOCATABLE/POINTER/ - TARGET statement. If it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_dimlist (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - ffelexToken nt; - ffelexHandler next; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - } - ffestb_local_.dimlist.started = TRUE; - return (ffelexHandler) ffestb_dimlist1_; - - case FFELEX_typeNAME: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - } - ffestb_local_.dimlist.started = TRUE; - return (ffelexHandler) ffestb_dimlist1_ (t); - } - - case FFELEX_typeNAMES: - p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len); - switch (ffelex_token_type (t)) - { - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - ffesta_confirmed (); - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - if (!ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - } - ffestb_local_.dimlist.started = TRUE; - next = (ffelexHandler) ffestb_dimlist1_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); - if (*p != '\0') - goto bad_i; /* :::::::::::::::::::: */ - if (!ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - } - ffestb_local_.dimlist.started = TRUE; - return (ffelexHandler) ffestb_dimlist1_; - - case FFELEX_typeOPEN_PAREN: - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - ffestb_local_.dimlist.started = FALSE; - next = (ffelexHandler) ffestb_dimlist1_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - } - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON] - - return ffestb_dimlist1_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_dimlist1_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_dimlist2_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); - break; - } - - if (!ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_finish (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_finish (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_finish (); - break; - - default: - assert (FALSE); - } - } - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME - - return ffestb_dimlist2_; // to lexer - - Handle OPEN_PAREN. */ - -static ffelexHandler -ffestb_dimlist2_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); - ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_; - ffestb_subrargs_.dim_list.pool = ffesta_output_pool; - ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST; -#ifdef FFECOM_dimensionsMAX - ffestb_subrargs_.dim_list.ndims = 0; -#endif - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_); - - case FFELEX_typeCOMMA: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - if (!ffestb_local_.dimlist.started) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - ffestb_local_.dimlist.started = TRUE; - } - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_item (ffesta_tokens[1], NULL); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_item (ffesta_tokens[1], NULL); - break; - - case FFESTR_firstTARGET: - ffestc_R527_item (ffesta_tokens[1], NULL); - break; - - default: - assert (FALSE); - } - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_dimlist4_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - if (!ffestb_local_.dimlist.started) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - } - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_item (ffesta_tokens[1], NULL); - ffestc_R525_finish (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_item (ffesta_tokens[1], NULL); - ffestc_R526_finish (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_item (ffesta_tokens[1], NULL); - ffestc_R527_finish (); - break; - - default: - assert (FALSE); - } - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); - break; - } - - if (!ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_finish (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_finish (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_finish (); - break; - - default: - assert (FALSE); - } - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN - dimlist CLOSE_PAREN - - return ffestb_dimlist3_; // to lexer - - Handle COMMA or EOS/SEMICOLON. */ - -static ffelexHandler -ffestb_dimlist3_ (ffelexToken t) -{ - if (!ffestb_subrargs_.dim_list.ok) - goto bad; /* :::::::::::::::::::: */ - - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - if (!ffestb_local_.dimlist.started) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - ffestb_local_.dimlist.started = TRUE; - } - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - break; - - case FFESTR_firstTARGET: - ffestc_R527_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - break; - - default: - assert (FALSE); - } - } - ffelex_token_kill (ffesta_tokens[1]); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - return (ffelexHandler) ffestb_dimlist4_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - if (!ffestb_local_.dimlist.started) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_start (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_start (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_start (); - break; - - default: - assert (FALSE); - } - } - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - ffestc_R525_finish (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - ffestc_R526_finish (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - ffestc_R527_finish (); - break; - - default: - assert (FALSE); - } - } - ffelex_token_kill (ffesta_tokens[1]); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); - if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_finish (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_finish (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_finish (); - break; - - default: - assert (FALSE); - } - } - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA - - return ffestb_dimlist4_; // to lexer - - Make sure we don't have EOS or SEMICOLON. */ - -static ffelexHandler -ffestb_dimlist4_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - { - switch (ffesta_first_kw) - { - case FFESTR_firstALLOCATABLE: - ffestc_R525_finish (); - break; - - case FFESTR_firstPOINTER: - ffestc_R526_finish (); - break; - - case FFESTR_firstTARGET: - ffestc_R527_finish (); - break; - - default: - assert (FALSE); - } - } - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); - return (ffelexHandler) ffesta_zero (t); - - default: - return (ffelexHandler) ffestb_dimlist1_ (t); - } -} - -#endif /* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement return ffestb_dummy; // to lexer @@ -20220,146 +14392,6 @@ ffestb_R5477_ (ffelexToken t) } } -/* ffestb_R624 -- Parse a NULLIFY statement - - return ffestb_R624; // to lexer - - Make sure the statement has a valid form for a NULLIFY - statement. If it does, implement the statement. - - 31-May-90 JCB 2.0 - Rewrite to produce a list of expressions rather than just names; this - eases semantic checking, putting it in expression handling where that - kind of thing gets done anyway, and makes it easier to support more - flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */ - -#if FFESTR_F90 -ffelexHandler -ffestb_R624 (ffelexToken t) -{ - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstNULLIFY) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstNULLIFY) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY) - goto bad_0; /* :::::::::::::::::::: */ - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - case FFELEX_typeNAME: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - - ffestb_local_.R624.exprs = ffestt_exprlist_create (); - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextNULLIFY, - (ffeexprCallback) ffestb_R6241_); - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -/* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr - - return ffestb_R6241_; // to lexer - - Make sure the statement has a valid form for a NULLIFY statement. If it - does, implement the statement. - - 31-May-90 JCB 2.0 - Rewrite to produce a list of expressions rather than just names; this - eases semantic checking, putting it in expression handling where that - kind of thing gets done anyway, and makes it easier to support more - flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */ - -static ffelexHandler -ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - if (expr == NULL) - break; - ffestt_exprlist_append (ffestb_local_.R624.exprs, expr, - ffelex_token_use (t)); - return (ffelexHandler) ffestb_R6242_; - - case FFELEX_typeCOMMA: - if (expr == NULL) - break; - ffestt_exprlist_append (ffestb_local_.R624.exprs, expr, - ffelex_token_use (t)); - return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, - FFEEXPR_contextNULLIFY, - (ffeexprCallback) ffestb_R6241_); - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t); - ffestt_exprlist_kill (ffestb_local_.R624.exprs); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN - - return ffestb_R6242_; // to lexer - - Make sure the statement has a valid form for a NULLIFY statement. If it - does, implement the statement. */ - -static ffelexHandler -ffestb_R6242_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_R624 (ffestb_local_.R624.exprs); - ffestt_exprlist_kill (ffestb_local_.R624.exprs); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t); - ffestt_exprlist_kill (ffestb_local_.R624.exprs); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_R1229 -- Parse a STMTFUNCTION statement return ffestb_R1229; // to lexer @@ -21004,496 +15036,6 @@ bad_i: /* :::::::::::::::::::: */ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_decl_recursive -- Parse the RECURSIVE FUNCTION statement - - return ffestb_decl_recursive; // to lexer - - Make sure the statement has a valid form for the RECURSIVE FUNCTION - statement. If it does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_decl_recursive (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - ffelexToken nt; - ffelexToken ot; - ffelexHandler next; - bool needfunc; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstRECURSIVE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeNAME: - break; - } - ffesta_confirmed (); - ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]); - switch (ffesta_second_kw) - { - case FFESTR_secondINTEGER: - ffestb_local_.decl.type = FFESTP_typeINTEGER; - return (ffelexHandler) ffestb_decl_recursive1_; - - case FFESTR_secondBYTE: - ffestb_local_.decl.type = FFESTP_typeBYTE; - return (ffelexHandler) ffestb_decl_recursive1_; - - case FFESTR_secondWORD: - ffestb_local_.decl.type = FFESTP_typeWORD; - return (ffelexHandler) ffestb_decl_recursive1_; - - case FFESTR_secondREAL: - ffestb_local_.decl.type = FFESTP_typeREAL; - return (ffelexHandler) ffestb_decl_recursive1_; - - case FFESTR_secondCOMPLEX: - ffestb_local_.decl.type = FFESTP_typeCOMPLEX; - return (ffelexHandler) ffestb_decl_recursive1_; - - case FFESTR_secondLOGICAL: - ffestb_local_.decl.type = FFESTP_typeLOGICAL; - return (ffelexHandler) ffestb_decl_recursive1_; - - case FFESTR_secondCHARACTER: - ffestb_local_.decl.type = FFESTP_typeCHARACTER; - return (ffelexHandler) ffestb_decl_recursive1_; - - case FFESTR_secondDOUBLE: - return (ffelexHandler) ffestb_decl_recursive2_; - - case FFESTR_secondDOUBLEPRECISION: - ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; - ffestb_local_.decl.kind = NULL; - ffestb_local_.decl.kindt = NULL; - ffestb_local_.decl.len = NULL; - ffestb_local_.decl.lent = NULL; - return (ffelexHandler) ffestb_decl_func_; - - case FFESTR_secondDOUBLECOMPLEX: - ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; - ffestb_local_.decl.kind = NULL; - ffestb_local_.decl.kindt = NULL; - ffestb_local_.decl.len = NULL; - ffestb_local_.decl.lent = NULL; - return (ffelexHandler) ffestb_decl_func_; - - case FFESTR_secondTYPE: - ffestb_local_.decl.type = FFESTP_typeTYPE; - return (ffelexHandler) ffestb_decl_recursive3_; - - case FFESTR_secondFUNCTION: - ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION; - ffestb_local_.dummy.badname = "FUNCTION"; - ffestb_local_.dummy.is_subr = FALSE; - return (ffelexHandler) ffestb_decl_recursive4_; - - case FFESTR_secondSUBROUTINE: - ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE; - ffestb_local_.dummy.badname = "SUBROUTINE"; - ffestb_local_.dummy.is_subr = TRUE; - return (ffelexHandler) ffestb_decl_recursive4_; - - default: - ffelex_token_kill (ffestb_local_.decl.recursive); - goto bad_1; /* :::::::::::::::::::: */ - } - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstRECURSIVE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - case FFELEX_typeASTERISK: - case FFELEX_typeSEMICOLON: - case FFELEX_typeEOS: - ffesta_confirmed (); - break; - - default: - break; - } - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE); - if (!ffesrc_is_name_init (*p)) - goto bad_0; /* :::::::::::::::::::: */ - ffestb_local_.decl.recursive - = ffelex_token_name_from_names (ffesta_tokens[0], 0, - FFESTR_firstlRECURSIVE); - nt = ffelex_token_names_from_names (ffesta_tokens[0], - FFESTR_firstlRECURSIVE, 0); - switch (ffestr_first (nt)) - { - case FFESTR_firstINTGR: - p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR); - ffestb_local_.decl.type = FFESTP_typeINTEGER; - needfunc = FALSE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstBYTE: - p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE); - ffestb_local_.decl.type = FFESTP_typeBYTE; - needfunc = FALSE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstWORD: - p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD); - ffestb_local_.decl.type = FFESTP_typeWORD; - needfunc = FALSE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstREAL: - p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL); - ffestb_local_.decl.type = FFESTP_typeREAL; - needfunc = FALSE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstCMPLX: - p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX); - ffestb_local_.decl.type = FFESTP_typeCOMPLEX; - needfunc = FALSE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstLGCL: - p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL); - ffestb_local_.decl.type = FFESTP_typeLOGICAL; - needfunc = FALSE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstCHRCTR: - p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR); - ffestb_local_.decl.type = FFESTP_typeCHARACTER; - needfunc = FALSE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstDBLPRCSN: - p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN); - ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; - needfunc = TRUE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstDBLCMPLX: - p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX); - ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; - needfunc = TRUE; - goto typefunc; /* :::::::::::::::::::: */ - - case FFESTR_firstTYPE: - p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE); - ffestb_local_.decl.type = FFESTP_typeTYPE; - next = (ffelexHandler) ffestb_decl_recursive3_; - break; - - case FFESTR_firstFUNCTION: - p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION); - ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION; - ffestb_local_.dummy.badname = "FUNCTION"; - ffestb_local_.dummy.is_subr = FALSE; - next = (ffelexHandler) ffestb_decl_recursive4_; - break; - - case FFESTR_firstSUBROUTINE: - p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE); - ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE; - ffestb_local_.dummy.badname = "SUBROUTINE"; - ffestb_local_.dummy.is_subr = TRUE; - next = (ffelexHandler) ffestb_decl_recursive4_; - break; - - default: - ffelex_token_kill (ffestb_local_.decl.recursive); - ffelex_token_kill (nt); - goto bad_1; /* :::::::::::::::::::: */ - } - if (*p == '\0') - { - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - } - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - ot = ffelex_token_name_from_names (nt, i, 0); - ffelex_token_kill (nt); - next = (ffelexHandler) (*next) (ot); - ffelex_token_kill (ot); - return (ffelexHandler) (*next) (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -typefunc: /* :::::::::::::::::::: */ - if (*p == '\0') - { - ffelex_token_kill (nt); - if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */ - { - ffelex_token_kill (ffestb_local_.decl.recursive); - goto bad_1; /* :::::::::::::::::::: */ - } - return (ffelexHandler) ffestb_decl_recursive1_ (t); - } - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - ot = ffelex_token_names_from_names (nt, i, 0); - ffelex_token_kill (nt); - if (ffestr_first (ot) != FFESTR_firstFUNCTION) - goto bad_o; /* :::::::::::::::::::: */ - p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION); - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0); - ffelex_token_kill (ot); - ffestb_local_.decl.kind = NULL; - ffestb_local_.decl.kindt = NULL; - ffestb_local_.decl.len = NULL; - ffestb_local_.decl.lent = NULL; - return (ffelexHandler) ffestb_decl_funcname_1_ (t); - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffelex_token_kill (ffestb_local_.decl.recursive); - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t); - ffelex_token_kill (nt); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_o: /* :::::::::::::::::::: */ - ffelex_token_kill (ffestb_local_.decl.recursive); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot); - ffelex_token_kill (ot); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type - - return ffestb_decl_recursive1_; // to lexer - - Handle ASTERISK, OPEN_PAREN, or NAME. */ - -static ffelexHandler -ffestb_decl_recursive1_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeASTERISK: - ffesta_confirmed (); - ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_; - ffestb_local_.decl.badname = "TYPEFUNC"; - if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) - return (ffelexHandler) ffestb_decl_starlen_; - return (ffelexHandler) ffestb_decl_starkind_; - - case FFELEX_typeOPEN_PAREN: - ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_; - ffestb_local_.decl.badname = "TYPEFUNC"; - if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) - { - ffestb_local_.decl.kind = NULL; - ffestb_local_.decl.kindt = NULL; - ffestb_local_.decl.len = NULL; - ffestb_local_.decl.lent = NULL; - return (ffelexHandler) ffestb_decl_typeparams_; - } - return (ffelexHandler) ffestb_decl_kindparam_; - - case FFELEX_typeNAME: - ffestb_local_.decl.kind = NULL; - ffestb_local_.decl.kindt = NULL; - ffestb_local_.decl.len = NULL; - ffestb_local_.decl.lent = NULL; - return (ffelexHandler) ffestb_decl_func_ (t); - - default: - break; - } - - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE" - - return ffestb_decl_recursive2_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_decl_recursive2_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - switch (ffestr_second (t)) - { - case FFESTR_secondPRECISION: - ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; - break; - - case FFESTR_secondCOMPLEX: - ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; - break; - - default: - goto bad; /* :::::::::::::::::::: */ - } - ffestb_local_.decl.kind = NULL; - ffestb_local_.decl.kindt = NULL; - ffestb_local_.decl.len = NULL; - ffestb_local_.decl.lent = NULL; - return (ffelexHandler) ffestb_decl_func_; - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE" - - return ffestb_decl_recursive3_; // to lexer - - Handle OPEN_PAREN. */ - -static ffelexHandler -ffestb_decl_recursive3_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_; - ffestb_local_.decl.badname = "TYPEFUNC"; - return (ffelexHandler) ffestb_decl_typetype1_; - - default: - break; - } - - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE" - - return ffestb_decl_recursive4_; // to lexer - - Handle OPEN_PAREN. */ - -static ffelexHandler -ffestb_decl_recursive4_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_dummy1_; - - default: - break; - } - - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif -/* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement - - return ffestb_decl_typetype; // to lexer - - Make sure the statement has a valid form for the TYPE statement. If it - does, implement the statement. */ - -#if FFESTR_F90 -ffelexHandler -ffestb_decl_typetype (ffelexToken t) -{ - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstTYPE) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstTYPE) - goto bad_0; /* :::::::::::::::::::: */ - if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE) - goto bad_0; /* :::::::::::::::::::: */ - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - break; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */ - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - } - - ffestb_local_.decl.recursive = NULL; - ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */ - ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */ - - ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; - ffestb_local_.decl.badname = "type-declaration"; - return (ffelexHandler) ffestb_decl_typetype1_; - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ -} - -#endif /* ffestb_decl_attrs_ -- "type" [type parameters] COMMA return ffestb_decl_attrs_; // to lexer @@ -21508,14 +15050,6 @@ ffestb_decl_attrs_ (ffelexToken t) case FFELEX_typeNAME: switch (ffestr_first (t)) { -#if FFESTR_F90 - case FFESTR_firstALLOCATABLE: - if (!ffesta_is_inhibited ()) - ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t, - FFESTR_otherNone, NULL); - return (ffelexHandler) ffestb_decl_attrs_7_; -#endif - case FFESTR_firstDIMENSION: ffesta_tokens[1] = ffelex_token_use (t); return (ffelexHandler) ffestb_decl_attrs_1_; @@ -21526,26 +15060,12 @@ ffestb_decl_attrs_ (ffelexToken t) FFESTR_otherNone, NULL); return (ffelexHandler) ffestb_decl_attrs_7_; -#if FFESTR_F90 - case FFESTR_firstINTENT: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_decl_attrs_3_; -#endif - case FFESTR_firstINTRINSIC: if (!ffesta_is_inhibited ()) ffestc_decl_attrib (FFESTP_attribINTRINSIC, t, FFESTR_otherNone, NULL); return (ffelexHandler) ffestb_decl_attrs_7_; -#if FFESTR_F90 - case FFESTR_firstOPTIONAL: - if (!ffesta_is_inhibited ()) - ffestc_decl_attrib (FFESTP_attribOPTIONAL, t, - FFESTR_otherNone, NULL); - return (ffelexHandler) ffestb_decl_attrs_7_; -#endif - case FFESTR_firstPARAMETER: ffestb_local_.decl.parameter = TRUE; if (!ffesta_is_inhibited ()) @@ -21553,42 +15073,12 @@ ffestb_decl_attrs_ (ffelexToken t) FFESTR_otherNone, NULL); return (ffelexHandler) ffestb_decl_attrs_7_; -#if FFESTR_F90 - case FFESTR_firstPOINTER: - if (!ffesta_is_inhibited ()) - ffestc_decl_attrib (FFESTP_attribPOINTER, t, - FFESTR_otherNone, NULL); - return (ffelexHandler) ffestb_decl_attrs_7_; -#endif - -#if FFESTR_F90 - case FFESTR_firstPRIVATE: - if (!ffesta_is_inhibited ()) - ffestc_decl_attrib (FFESTP_attribPRIVATE, t, - FFESTR_otherNone, NULL); - return (ffelexHandler) ffestb_decl_attrs_7_; - - case FFESTR_firstPUBLIC: - if (!ffesta_is_inhibited ()) - ffestc_decl_attrib (FFESTP_attribPUBLIC, t, - FFESTR_otherNone, NULL); - return (ffelexHandler) ffestb_decl_attrs_7_; -#endif - case FFESTR_firstSAVE: if (!ffesta_is_inhibited ()) ffestc_decl_attrib (FFESTP_attribSAVE, t, FFESTR_otherNone, NULL); return (ffelexHandler) ffestb_decl_attrs_7_; -#if FFESTR_F90 - case FFESTR_firstTARGET: - if (!ffesta_is_inhibited ()) - ffestc_decl_attrib (FFESTP_attribTARGET, t, - FFESTR_otherNone, NULL); - return (ffelexHandler) ffestb_decl_attrs_7_; -#endif - default: ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); return (ffelexHandler) ffestb_decl_attrs_7_; @@ -21683,155 +15173,6 @@ bad: /* :::::::::::::::::::: */ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT" - - return ffestb_decl_attrs_3_; // to lexer - - Handle OPEN_PAREN. */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_decl_attrs_3_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - return (ffelexHandler) ffestb_decl_attrs_4_; - - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_decl_attrs_7_ (t); - - default: - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_decl_finish (); - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN - - return ffestb_decl_attrs_4_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_decl_attrs_4_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffestb_local_.decl.kw = ffestr_other (t); - switch (ffestb_local_.decl.kw) - { - case FFESTR_otherIN: - return (ffelexHandler) ffestb_decl_attrs_5_; - - case FFESTR_otherINOUT: - return (ffelexHandler) ffestb_decl_attrs_6_; - - case FFESTR_otherOUT: - return (ffelexHandler) ffestb_decl_attrs_6_; - - default: - ffestb_local_.decl.kw = FFESTR_otherNone; - ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); - return (ffelexHandler) ffestb_decl_attrs_5_; - } - break; - - default: - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_decl_finish (); - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN" - - return ffestb_decl_attrs_5_; // to lexer - - Handle NAME or CLOSE_PAREN. */ - -static ffelexHandler -ffestb_decl_attrs_5_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - switch (ffestr_other (t)) - { - case FFESTR_otherOUT: - if (ffestb_local_.decl.kw != FFESTR_otherNone) - ffestb_local_.decl.kw = FFESTR_otherINOUT; - return (ffelexHandler) ffestb_decl_attrs_6_; - - default: - if (ffestb_local_.decl.kw != FFESTR_otherNone) - { - ffestb_local_.decl.kw = FFESTR_otherNone; - ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); - } - return (ffelexHandler) ffestb_decl_attrs_5_; - } - break; - - case FFELEX_typeCLOSE_PAREN: - return (ffelexHandler) ffestb_decl_attrs_6_ (t); - - default: - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_decl_finish (); - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN" - ["OUT"] - - return ffestb_decl_attrs_6_; // to lexer - - Handle CLOSE_PAREN. */ - -static ffelexHandler -ffestb_decl_attrs_6_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCLOSE_PAREN: - if ((ffestb_local_.decl.kw != FFESTR_otherNone) - && !ffesta_is_inhibited ()) - ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1], - ffestb_local_.decl.kw, NULL); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_decl_attrs_7_; - - default: - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_decl_finish (); - ffelex_token_kill (ffesta_tokens[1]); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute return ffestb_decl_attrs_7_; // to lexer @@ -22616,17 +15957,6 @@ ffestb_decl_entsp_1_ (ffelexToken t) case FFELEX_typeNAME: switch (ffestr_first (ffesta_tokens[1])) { -#if FFESTR_F90 - case FFESTR_firstRECURSIVE: - if (ffestr_first (t) != FFESTR_firstFUNCTION) - { - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); - break; - } - ffestb_local_.decl.recursive = ffesta_tokens[1]; - return (ffelexHandler) ffestb_decl_funcname_; -#endif - case FFESTR_firstFUNCTION: ffelex_token_kill (ffesta_tokens[1]); return (ffelexHandler) ffestb_decl_funcname_ (t); @@ -22702,23 +16032,6 @@ ffestb_decl_entsp_2_ (ffelexToken t) } switch (ffestr_first (ffesta_tokens[1])) { -#if FFESTR_F90 - case FFESTR_firstRECURSIVEFNCTN: - if (!asterisk_ok) - break; /* For our own convenience, treat as non-FN - stmt. */ - p = ffelex_token_text (ffesta_tokens[1]) - + (i = FFESTR_firstlRECURSIVEFNCTN); - if (!ffesrc_is_name_init (*p)) - break; - ffestb_local_.decl.recursive - = ffelex_token_name_from_names (ffesta_tokens[1], 0, - FFESTR_firstlRECURSIVEFNCTN); - ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1], - FFESTR_firstlRECURSIVEFNCTN, 0); - return (ffelexHandler) ffestb_decl_entsp_3_; -#endif - case FFESTR_firstFUNCTION: if (!asterisk_ok) break; /* For our own convenience, treat as non-FN @@ -22741,20 +16054,6 @@ ffestb_decl_entsp_2_ (ffelexToken t) ffestb_local_.decl.aster_after = FALSE; switch (ffestr_first (ffesta_tokens[1])) { -#if FFESTR_F90 - case FFESTR_firstRECURSIVEFNCTN: - p = ffelex_token_text (ffesta_tokens[1]) - + (i = FFESTR_firstlRECURSIVEFNCTN); - if (!ffesrc_is_name_init (*p)) - break; - ffestb_local_.decl.recursive - = ffelex_token_name_from_names (ffesta_tokens[1], 0, - FFESTR_firstlRECURSIVEFNCTN); - ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1], - FFESTR_firstlRECURSIVEFNCTN, 0); - return (ffelexHandler) ffestb_decl_entsp_5_ (t); -#endif - case FFESTR_firstFUNCTION: p = ffelex_token_text (ffesta_tokens[1]) + (i = FFESTR_firstlFUNCTION); @@ -23091,65 +16390,6 @@ ffestb_decl_entsp_8_ (ffelexToken t) return (ffelexHandler) (*next) (t); } -/* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE - - return ffestb_decl_func_; // to lexer - - Handle "FUNCTION". */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_decl_func_ (ffelexToken t) -{ - const char *p; - ffeTokenLength i; - - ffelex_set_names (FALSE); - - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - if (ffestr_first (t) != FFESTR_firstFUNCTION) - break; - return (ffelexHandler) ffestb_decl_funcname_; - - case FFELEX_typeNAMES: - ffesta_confirmed (); - if (ffestr_first (t) != FFESTR_firstFUNCTION) - break; - p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION); - if (*p == '\0') - break; - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0); - return (ffelexHandler) ffestb_decl_funcname_1_; - - default: - break; - } - - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - if (ffestb_local_.decl.kindt != NULL) - ffelex_token_kill (ffestb_local_.decl.kindt); - if (ffestb_local_.decl.lent != NULL) - ffelex_token_kill (ffestb_local_.decl.lent); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_i: /* :::::::::::::::::::: */ - if (ffestb_local_.decl.recursive != NULL) - ffelex_token_kill (ffestb_local_.decl.recursive); - if (ffestb_local_.decl.kindt != NULL) - ffelex_token_kill (ffestb_local_.decl.kindt); - if (ffestb_local_.decl.lent != NULL) - ffelex_token_kill (ffestb_local_.decl.lent); - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION return ffestb_decl_funcname_; // to lexer @@ -23566,593 +16806,6 @@ ffestb_decl_funcname_9_ (ffelexToken t) ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } - -/* ffestb_V003 -- Parse the STRUCTURE statement - - return ffestb_V003; // to lexer - - Make sure the statement has a valid form for the STRUCTURE statement. - If it does, implement the statement. */ - -#if FFESTR_VXT -ffelexHandler -ffestb_V003 (ffelexToken t) -{ - ffeTokenLength i; - const char *p; - ffelexToken nt; - ffelexHandler next; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstSTRUCTURE) - goto bad_0; /* :::::::::::::::::::: */ - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeNAME: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V003_start (NULL); - ffestb_local_.structure.started = TRUE; - return (ffelexHandler) ffestb_V0034_ (t); - - case FFELEX_typeSLASH: - ffesta_confirmed (); - return (ffelexHandler) ffestb_V0031_; - } - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstSTRUCTURE) - goto bad_0; /* :::::::::::::::::::: */ - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE); - switch (ffelex_token_type (t)) - { - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOMMA: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); - break; - - case FFELEX_typeSLASH: - ffesta_confirmed (); - if (*p != '\0') - goto bad_1; /* :::::::::::::::::::: */ - return (ffelexHandler) ffestb_V0031_; - - case FFELEX_typeOPEN_PAREN: - break; - } - - /* Here, we have at least one char after "STRUCTURE" and t is COMMA, - EOS/SEMICOLON, or OPEN_PAREN. */ - - if (!ffesrc_is_name_init (*p)) - goto bad_i; /* :::::::::::::::::::: */ - nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); - if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN) - ffestb_local_.structure.started = FALSE; - else - { - if (!ffesta_is_inhibited ()) - ffestc_V003_start (NULL); - ffestb_local_.structure.started = TRUE; - } - next = (ffelexHandler) ffestb_V0034_ (nt); - ffelex_token_kill (nt); - return (ffelexHandler) (*next) (t); - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0031_ -- "STRUCTURE" SLASH - - return ffestb_V0031_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_V0031_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0032_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); - break; - } - - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0032_ -- "STRUCTURE" SLASH NAME - - return ffestb_V0032_; // to lexer - - Handle SLASH. */ - -static ffelexHandler -ffestb_V0032_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeSLASH: - if (!ffesta_is_inhibited ()) - ffestc_V003_start (ffesta_tokens[1]); - ffestb_local_.structure.started = TRUE; - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_V0033_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH - - return ffestb_V0033_; // to lexer - - Handle NAME or EOS/SEMICOLON. */ - -static ffelexHandler -ffestb_V0033_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - return (ffelexHandler) ffestb_V0034_ (t); - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - ffestc_V003_finish (); - return (ffelexHandler) ffesta_zero (t); - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); - break; - } - - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH] - - return ffestb_V0034_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_V0034_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0035_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V003_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0035_ -- "STRUCTURE" ... NAME - - return ffestb_V0035_; // to lexer - - Handle OPEN_PAREN. */ - -static ffelexHandler -ffestb_V0035_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); - ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_; - ffestb_subrargs_.dim_list.pool = ffesta_output_pool; - ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON; -#ifdef FFECOM_dimensionsMAX - ffestb_subrargs_.dim_list.ndims = 0; -#endif - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_); - - case FFELEX_typeCOMMA: - if (!ffesta_is_inhibited ()) - ffestc_V003_item (ffesta_tokens[1], NULL); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_V0034_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - { - ffestc_V003_item (ffesta_tokens[1], NULL); - ffestc_V003_finish (); - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V003_finish (); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN - - return ffestb_V0036_; // to lexer - - Handle COMMA or EOS/SEMICOLON. */ - -static ffelexHandler -ffestb_V0036_ (ffelexToken t) -{ - if (!ffestb_subrargs_.dim_list.ok) - goto bad; /* :::::::::::::::::::: */ - - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - if (!ffestb_local_.structure.started) - { - ffestc_V003_start (NULL); - ffestb_local_.structure.started = TRUE; - } - ffestc_V003_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - } - ffelex_token_kill (ffesta_tokens[1]); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - return (ffelexHandler) ffestb_V0034_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - { - if (!ffestb_local_.structure.started) - ffestc_V003_start (NULL); - ffestc_V003_item (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - ffestc_V003_finish (); - } - ffelex_token_kill (ffesta_tokens[1]); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); - if (ffestb_local_.structure.started && !ffesta_is_inhibited ()) - ffestc_V003_finish (); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V016 -- Parse the RECORD statement - - return ffestb_V016; // to lexer - - Make sure the statement has a valid form for the RECORD statement. If it - does, implement the statement. */ - -ffelexHandler -ffestb_V016 (ffelexToken t) -{ - const char *p; - ffeTokenLength i; - - switch (ffelex_token_type (ffesta_tokens[0])) - { - case FFELEX_typeNAME: - if (ffesta_first_kw != FFESTR_firstRECORD) - goto bad_0; /* :::::::::::::::::::: */ - break; - - case FFELEX_typeNAMES: - if (ffesta_first_kw != FFESTR_firstRECORD) - goto bad_0; /* :::::::::::::::::::: */ - p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD); - if (*p != '\0') - goto bad_i; /* :::::::::::::::::::: */ - break; - - default: - goto bad_0; /* :::::::::::::::::::: */ - } - - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - case FFELEX_typeCOLONCOLON: - ffesta_confirmed (); /* Error, but clearly intended. */ - goto bad_1; /* :::::::::::::::::::: */ - - default: - goto bad_1; /* :::::::::::::::::::: */ - - case FFELEX_typeSLASH: - break; - } - - ffesta_confirmed (); - if (!ffesta_is_inhibited ()) - ffestc_V016_start (); - return (ffelexHandler) ffestb_V0161_; - -bad_0: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); - -bad_1: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); - return (ffelexHandler) ffelex_swallow_tokens (t, - (ffelexHandler) ffesta_zero); /* Invalid second token. */ - -bad_i: /* :::::::::::::::::::: */ - ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0161_ -- "RECORD" SLASH - - return ffestb_V0161_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_V0161_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - if (!ffesta_is_inhibited ()) - ffestc_V016_item_structure (t); - return (ffelexHandler) ffestb_V0162_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V016_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0162_ -- "RECORD" SLASH NAME - - return ffestb_V0162_; // to lexer - - Handle SLASH. */ - -static ffelexHandler -ffestb_V0162_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeSLASH: - return (ffelexHandler) ffestb_V0163_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V016_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH - - return ffestb_V0163_; // to lexer - - Handle NAME. */ - -static ffelexHandler -ffestb_V0163_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0164_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V016_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0164_ -- "RECORD" ... NAME - - return ffestb_V0164_; // to lexer - - Handle OPEN_PAREN. */ - -static ffelexHandler -ffestb_V0164_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); - ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_; - ffestb_subrargs_.dim_list.pool = ffesta_output_pool; - ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON; -#ifdef FFECOM_dimensionsMAX - ffestb_subrargs_.dim_list.ndims = 0; -#endif - return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, - FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_); - - case FFELEX_typeCOMMA: - if (!ffesta_is_inhibited ()) - ffestc_V016_item_object (ffesta_tokens[1], NULL); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffestb_V0166_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - { - ffestc_V016_item_object (ffesta_tokens[1], NULL); - ffestc_V016_finish (); - } - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffesta_zero (t); - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V016_finish (); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN - - return ffestb_V0165_; // to lexer - - Handle COMMA or EOS/SEMICOLON. */ - -static ffelexHandler -ffestb_V0165_ (ffelexToken t) -{ - if (!ffestb_subrargs_.dim_list.ok) - goto bad; /* :::::::::::::::::::: */ - - switch (ffelex_token_type (t)) - { - case FFELEX_typeCOMMA: - if (!ffesta_is_inhibited ()) - ffestc_V016_item_object (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - ffelex_token_kill (ffesta_tokens[1]); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - return (ffelexHandler) ffestb_V0166_; - - case FFELEX_typeEOS: - case FFELEX_typeSEMICOLON: - if (!ffesta_is_inhibited ()) - { - ffestc_V016_item_object (ffesta_tokens[1], - ffestb_subrargs_.dim_list.dims); - ffestc_V016_finish (); - } - ffelex_token_kill (ffesta_tokens[1]); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - return (ffelexHandler) ffesta_zero (t); - - default: - break; - } - -bad: /* :::::::::::::::::::: */ - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); - if (ffestb_local_.structure.started && !ffesta_is_inhibited ()) - ffestc_V016_finish (); - ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); - ffelex_token_kill (ffesta_tokens[1]); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -/* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist - CLOSE_PAREN] COMMA - - return ffestb_V0166_; // to lexer - - Handle NAME or SLASH. */ - -static ffelexHandler -ffestb_V0166_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeNAME: - ffesta_tokens[1] = ffelex_token_use (t); - return (ffelexHandler) ffestb_V0164_; - - case FFELEX_typeSLASH: - return (ffelexHandler) ffestb_V0161_; - - default: - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); - break; - } - - if (!ffesta_is_inhibited ()) - ffestc_V016_finish (); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_V027 -- Parse the VXT PARAMETER statement return ffestb_V027; // to lexer @@ -24423,12 +17076,6 @@ ffestb_decl_R539 (ffelexToken t) case FFESTR_secondNONE: return (ffelexHandler) ffestb_decl_R5394_; -#if FFESTR_F90 - case FFESTR_secondTYPE: - ffestb_local_.decl.type = FFESTP_typeTYPE; - return (ffelexHandler) ffestb_decl_R5393_; -#endif - default: goto bad_1; /* :::::::::::::::::::: */ } @@ -24509,12 +17156,6 @@ ffestb_decl_R539 (ffelexToken t) case FFESTR_secondNONE: return (ffelexHandler) ffestb_decl_R5394_ (t); -#if FFESTR_F90 - case FFESTR_secondTYPE: - ffestb_local_.decl.type = FFESTP_typeTYPE; - return (ffelexHandler) ffestb_decl_R5393_ (t); -#endif - default: goto bad_1; /* :::::::::::::::::::: */ } @@ -24619,34 +17260,6 @@ bad: /* :::::::::::::::::::: */ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } -/* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE" - - return ffestb_decl_R5393_; // to lexer - - Handle OPEN_PAREN. */ - -#if FFESTR_F90 -static ffelexHandler -ffestb_decl_R5393_ (ffelexToken t) -{ - switch (ffelex_token_type (t)) - { - case FFELEX_typeOPEN_PAREN: - ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_; - ffestb_local_.decl.badname = "IMPLICIT"; - return (ffelexHandler) ffestb_decl_typetype1_; - - default: - break; - } - - if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) - ffestc_R539finish (); - ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); - return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); -} - -#endif /* ffestb_decl_R5394_ -- "IMPLICIT" "NONE" return ffestb_decl_R5394_; // to lexer @@ -24734,12 +17347,6 @@ ffestb_decl_R5395_ (ffelexToken t) ffestb_local_.decl.lent = NULL; return (ffelexHandler) ffestb_decl_R539letters_; -#if FFESTR_F90 - case FFESTR_secondTYPE: - ffestb_local_.decl.type = FFESTP_typeTYPE; - return (ffelexHandler) ffestb_decl_R5393_; -#endif - default: break; } diff --git a/contrib/gcc/f/stb.h b/contrib/gcc/f/stb.h index a9b3acc..88cb7c54 100644 --- a/contrib/gcc/f/stb.h +++ b/contrib/gcc/f/stb.h @@ -1,5 +1,5 @@ /* stb.h -- Private #include File (module.h template V1.0) - Copyright (C) 1995, 1996 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -79,15 +79,6 @@ struct _ffestb_args_ ffeTokenLength len; /* Length of "STOP/PAUSE". */ } halt; -#if FFESTR_F90 - struct - { - const char *badname; - ffeTokenLength len; /* Length of "ALLOCATE/DEALLOCATE". */ - ffeexprContext ctx; /* Either ALLOCATE or DEALLOCATE. */ - } - heap; -#endif struct { const char *badname; @@ -96,22 +87,6 @@ struct _ffestb_args_ PRIVATE". */ } varlist; -#if FFESTR_VXT - struct - { - const char *badname; - ffeTokenLength len; /* Length of "ENCODE/DECODE". */ - } - vxtcode; -#endif -#if FFESTR_F90 - struct - { - const char *badname; - ffeTokenLength len; /* Length of "ALLOCATABLE/POINTER/TARGET". */ - } - dimlist; -#endif struct { const char *badname; @@ -150,33 +125,9 @@ ffelexHandler ffestb_endxyz (ffelexToken t); ffelexHandler ffestb_decl_gentype (ffelexToken t); ffelexHandler ffestb_goto (ffelexToken t); ffelexHandler ffestb_halt (ffelexToken t); -#if FFESTR_F90 -ffelexHandler ffestb_heap (ffelexToken t); -#endif ffelexHandler ffestb_if (ffelexToken t); ffelexHandler ffestb_let (ffelexToken t); -#if FFESTR_F90 -ffelexHandler ffestb_module (ffelexToken t); -#endif -#if FFESTR_F90 -ffelexHandler ffestb_decl_recursive (ffelexToken t); -#endif -#if FFESTR_F90 -ffelexHandler ffestb_type (ffelexToken t); -#endif -#if FFESTR_F90 -ffelexHandler ffestb_decl_typetype (ffelexToken t); -#endif ffelexHandler ffestb_varlist (ffelexToken t); -#if FFESTR_VXT -ffelexHandler ffestb_vxtcode (ffelexToken t); -#endif -#if FFESTR_F90 -ffelexHandler ffestb_where (ffelexToken t); -#endif -#if HARD_F90 -ffelexHandler ffestb_R423B (ffelexToken t); -#endif ffelexHandler ffestb_R522 (ffelexToken t); ffelexHandler ffestb_R524 (ffelexToken t); ffelexHandler ffestb_R528 (ffelexToken t); @@ -185,9 +136,6 @@ ffelexHandler ffestb_decl_R539 (ffelexToken t); ffelexHandler ffestb_R542 (ffelexToken t); ffelexHandler ffestb_R544 (ffelexToken t); ffelexHandler ffestb_R547 (ffelexToken t); -#if FFESTR_F90 -ffelexHandler ffestb_R624 (ffelexToken t); -#endif ffelexHandler ffestb_R809 (ffelexToken t); ffelexHandler ffestb_R810 (ffelexToken t); ffelexHandler ffestb_R834 (ffelexToken t); @@ -203,36 +151,12 @@ ffelexHandler ffestb_R911 (ffelexToken t); ffelexHandler ffestb_R923 (ffelexToken t); ffelexHandler ffestb_R1001 (ffelexToken t); ffelexHandler ffestb_R1102 (ffelexToken t); -#if FFESTR_F90 -ffelexHandler ffestb_R1107 (ffelexToken t); -#endif -#if FFESTR_F90 -ffelexHandler ffestb_R1202 (ffelexToken t); -#endif ffelexHandler ffestb_R1212 (ffelexToken t); ffelexHandler ffestb_R1227 (ffelexToken t); -#if FFESTR_F90 -ffelexHandler ffestb_R1228 (ffelexToken t); -#endif ffelexHandler ffestb_R1229 (ffelexToken t); ffelexHandler ffestb_S3P4 (ffelexToken t); -#if FFESTR_VXT -ffelexHandler ffestb_V003 (ffelexToken t); -ffelexHandler ffestb_V009 (ffelexToken t); -ffelexHandler ffestb_V012 (ffelexToken t); -#endif ffelexHandler ffestb_V014 (ffelexToken t); -#if FFESTR_VXT -ffelexHandler ffestb_V016 (ffelexToken t); -ffelexHandler ffestb_V018 (ffelexToken t); -ffelexHandler ffestb_V019 (ffelexToken t); -#endif ffelexHandler ffestb_V020 (ffelexToken t); -#if FFESTR_VXT -ffelexHandler ffestb_V021 (ffelexToken t); -ffelexHandler ffestb_V025 (ffelexToken t); -ffelexHandler ffestb_V026 (ffelexToken t); -#endif ffelexHandler ffestb_V027 (ffelexToken t); /* Define macros. */ diff --git a/contrib/gcc/f/stc.c b/contrib/gcc/f/stc.c index b9602c2..5f05813 100644 --- a/contrib/gcc/f/stc.c +++ b/contrib/gcc/f/stc.c @@ -170,15 +170,6 @@ union ffestc_local_u_ ffesymbol symbol; /* SFN symbol. */ } sfunc; -#if FFESTR_VXT - struct - { - char list_state; /* 0=>no field names allowed, 1=>error - reported already, 2=>field names req'd, - 3=>have a field name. */ - } - V003; -#endif }; /* Merge with the one in ffestc later. */ /* Static objects accessed by functions in this module. */ @@ -226,9 +217,6 @@ static bool ffestc_labelref_is_format_ (ffelexToken label_token, ffelab *label); static bool ffestc_labelref_is_loopend_ (ffelexToken label_token, ffelab *label); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_access_ (void); -#endif static ffestcOrder_ ffestc_order_actiondo_ (void); static ffestcOrder_ ffestc_order_actionif_ (void); static ffestcOrder_ ffestc_order_actionwhere_ (void); @@ -236,17 +224,8 @@ static void ffestc_order_any_ (void); static void ffestc_order_bad_ (void); static ffestcOrder_ ffestc_order_blockdata_ (void); static ffestcOrder_ ffestc_order_blockspec_ (void); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_component_ (void); -#endif -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_contains_ (void); -#endif static ffestcOrder_ ffestc_order_data_ (void); static ffestcOrder_ ffestc_order_data77_ (void); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_derivedtype_ (void); -#endif static ffestcOrder_ ffestc_order_do_ (void); static ffestcOrder_ ffestc_order_entry_ (void); static ffestcOrder_ ffestc_order_exec_ (void); @@ -256,89 +235,26 @@ static ffestcOrder_ ffestc_order_iface_ (void); static ffestcOrder_ ffestc_order_ifthen_ (void); static ffestcOrder_ ffestc_order_implicit_ (void); static ffestcOrder_ ffestc_order_implicitnone_ (void); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_interface_ (void); -#endif -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_map_ (void); -#endif -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_module_ (void); -#endif static ffestcOrder_ ffestc_order_parameter_ (void); static ffestcOrder_ ffestc_order_program_ (void); static ffestcOrder_ ffestc_order_progspec_ (void); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_record_ (void); -#endif static ffestcOrder_ ffestc_order_selectcase_ (void); static ffestcOrder_ ffestc_order_sfunc_ (void); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_spec_ (void); -#endif -#if FFESTR_VXT -static ffestcOrder_ ffestc_order_structure_ (void); -#endif static ffestcOrder_ ffestc_order_subroutine_ (void); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_type_ (void); -#endif static ffestcOrder_ ffestc_order_typedecl_ (void); -#if FFESTR_VXT -static ffestcOrder_ ffestc_order_union_ (void); -#endif static ffestcOrder_ ffestc_order_unit_ (void); -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_use_ (void); -#endif -#if FFESTR_VXT -static ffestcOrder_ ffestc_order_vxtstructure_ (void); -#endif -#if FFESTR_F90 -static ffestcOrder_ ffestc_order_where_ (void); -#endif static void ffestc_promote_dummy_ (ffelexToken t); static void ffestc_promote_execdummy_ (ffelexToken t); static void ffestc_promote_sfdummy_ (ffelexToken t); static void ffestc_shriek_begin_program_ (void); -#if FFESTR_F90 -static void ffestc_shriek_begin_uses_ (void); -#endif static void ffestc_shriek_blockdata_ (bool ok); static void ffestc_shriek_do_ (bool ok); static void ffestc_shriek_end_program_ (bool ok); -#if FFESTR_F90 -static void ffestc_shriek_end_uses_ (bool ok); -#endif static void ffestc_shriek_function_ (bool ok); static void ffestc_shriek_if_ (bool ok); static void ffestc_shriek_ifthen_ (bool ok); -#if FFESTR_F90 -static void ffestc_shriek_interface_ (bool ok); -#endif -#if FFESTR_F90 -static void ffestc_shriek_map_ (bool ok); -#endif -#if FFESTR_F90 -static void ffestc_shriek_module_ (bool ok); -#endif static void ffestc_shriek_select_ (bool ok); -#if FFESTR_VXT -static void ffestc_shriek_structure_ (bool ok); -#endif static void ffestc_shriek_subroutine_ (bool ok); -#if FFESTR_F90 -static void ffestc_shriek_type_ (bool ok); -#endif -#if FFESTR_VXT -static void ffestc_shriek_union_ (bool ok); -#endif -#if FFESTR_F90 -static void ffestc_shriek_where_ (bool ok); -#endif -#if FFESTR_F90 -static void ffestc_shriek_wherethen_ (bool ok); -#endif static int ffestc_subr_binsrch_ (const char *const *list, int size, ffestpFile *spec, const char *whine); static ffestvFormat ffestc_subr_format_ (ffestpFile *spec); @@ -377,13 +293,7 @@ static void ffestc_try_shriek_do_ (void); || ffestc_statelet_ == FFESTC_stateletITEM_); \ ffestc_statelet_ = FFESTC_stateletSIMPLE_ #define ffestc_order_action_() ffestc_order_exec_() -#if FFESTR_F90 -#define ffestc_order_interfacespec_() ffestc_order_derivedtype_() -#endif #define ffestc_shriek_if_lost_ ffestc_shriek_if_ -#if FFESTR_F90 -#define ffestc_shriek_where_lost_ ffestc_shriek_where_ -#endif /* ffestc_establish_declinfo_ -- Determine specific type/params info for entity @@ -689,7 +599,7 @@ ffestc_establish_impletter_ (ffelexToken first, ffelexToken last) ffestc_init_3(); */ void -ffestc_init_3 () +ffestc_init_3 (void) { ffestv_save_state_ = FFESTV_savestateNONE; ffestc_entry_num_ = 0; @@ -704,7 +614,7 @@ ffestc_init_3 () defs, and statement function defs. */ void -ffestc_init_4 () +ffestc_init_4 (void) { ffestc_saved_entry_num_ = ffestc_entry_num_; ffestc_entry_num_ = 0; @@ -773,7 +683,7 @@ ffestc_kindtype_star_ (ffeinfoBasictype bt, ffetargetCharacterSize val) /* Define label as usable for anything without complaint. */ static void -ffestc_labeldef_any_ () +ffestc_labeldef_any_ (void) { if ((ffesta_label_token == NULL) || !ffestc_labeldef_begin_ ()) @@ -790,7 +700,7 @@ ffestc_labeldef_any_ () ffestc_labeldef_begin_(); */ static bool -ffestc_labeldef_begin_ () +ffestc_labeldef_begin_ (void) { ffelabValue label_value; ffelab label; @@ -847,7 +757,7 @@ ffestc_labeldef_begin_ () ffestc_labeldef_branch_begin_(); */ static void -ffestc_labeldef_branch_begin_ () +ffestc_labeldef_branch_begin_ (void) { if ((ffesta_label_token == NULL) || (ffestc_shriek_after1_ != NULL) @@ -931,7 +841,7 @@ ffestc_labeldef_branch_begin_ () which case they must issue a diagnostic). */ static void -ffestc_labeldef_branch_end_ () +ffestc_labeldef_branch_end_ (void) { if (ffesta_label_token == NULL) return; @@ -955,7 +865,7 @@ ffestc_labeldef_branch_end_ () ffestc_labeldef_endif_(); */ static void -ffestc_labeldef_endif_ () +ffestc_labeldef_endif_ (void) { if ((ffesta_label_token == NULL) || (ffestc_shriek_after1_ != NULL) @@ -1044,7 +954,7 @@ ffestc_labeldef_endif_ () ffestc_labeldef_format_(); */ static void -ffestc_labeldef_format_ () +ffestc_labeldef_format_ (void) { if ((ffesta_label_token == NULL) || (ffestc_shriek_after1_ != NULL)) @@ -1127,7 +1037,7 @@ ffestc_labeldef_format_ () ffestc_labeldef_invalid_(); */ static void -ffestc_labeldef_invalid_ () +ffestc_labeldef_invalid_ (void) { if ((ffesta_label_token == NULL) || (ffestc_shriek_after1_ != NULL) @@ -1152,7 +1062,7 @@ ffestc_labeldef_invalid_ () be in the "then" part of a logical IF, such as a block-IF statement. */ static void -ffestc_labeldef_notloop_ () +ffestc_labeldef_notloop_ (void) { if (ffesta_label_token == NULL) return; @@ -1246,7 +1156,7 @@ ffestc_labeldef_notloop_ () loop-ending label. */ static void -ffestc_labeldef_notloop_begin_ () +ffestc_labeldef_notloop_begin_ (void) { if ((ffesta_label_token == NULL) || (ffestc_shriek_after1_ != NULL) @@ -1334,7 +1244,7 @@ ffestc_labeldef_notloop_begin_ () ffestc_labeldef_useless_(); */ static void -ffestc_labeldef_useless_ () +ffestc_labeldef_useless_ (void) { if ((ffesta_label_token == NULL) || (ffestc_shriek_after1_ != NULL) @@ -1834,65 +1744,13 @@ ffestc_labelref_is_loopend_ (ffelexToken label_token, ffelab *x_label) return TRUE; } -/* ffestc_order_access_ -- Check ordering on <access> statement - - if (ffestc_order_access_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_access_ () -{ - recurse: - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateNIL: - ffestc_shriek_begin_program_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateMODULE0: - case FFESTV_stateMODULE1: - case FFESTV_stateMODULE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3); - return FFESTC_orderOK_; - - case FFESTV_stateMODULE3: - return FFESTC_orderOK_; - - case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif /* ffestc_order_actiondo_ -- Check ordering on <actiondo> statement if (ffestc_order_actiondo_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_actiondo_ () +ffestc_order_actiondo_ (void) { recurse: @@ -1918,16 +1776,10 @@ ffestc_order_actiondo_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; default: @@ -1943,7 +1795,7 @@ ffestc_order_actiondo_ () return; */ static ffestcOrder_ -ffestc_order_actionif_ () +ffestc_order_actionif_ (void) { bool update; @@ -1995,16 +1847,10 @@ recurse: return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; default: @@ -2033,7 +1879,7 @@ recurse: return; */ static ffestcOrder_ -ffestc_order_actionwhere_ () +ffestc_order_actionwhere_ (void) { bool update; @@ -2082,9 +1928,6 @@ recurse: return FFESTC_orderOK_; case FFESTV_stateWHERE: -#if FFESTR_F90 - ffestc_shriek_after1_ = ffestc_shriek_where_; -#endif return FFESTC_orderOK_; case FFESTV_stateIF: @@ -2092,9 +1935,6 @@ recurse: return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ default: @@ -2121,7 +1961,7 @@ recurse: doesn't produce any diagnostics. */ static void -ffestc_order_any_ () +ffestc_order_any_ (void) { bool update; @@ -2170,9 +2010,6 @@ recurse: return; case FFESTV_stateWHERE: -#if FFESTR_F90 - ffestc_shriek_after1_ = ffestc_shriek_where_; -#endif return; case FFESTV_stateIF: @@ -2180,9 +2017,6 @@ recurse: return; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ default: @@ -2213,7 +2047,7 @@ recurse: now. */ static void -ffestc_order_bad_ () +ffestc_order_bad_ (void) { if (ffewhere_line_is_unknown (ffestw_line (ffestw_stack_top ()))) { @@ -2239,7 +2073,7 @@ ffestc_order_bad_ () return; */ static ffestcOrder_ -ffestc_order_blockdata_ () +ffestc_order_blockdata_ (void) { recurse: @@ -2254,16 +2088,10 @@ ffestc_order_blockdata_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2283,7 +2111,7 @@ ffestc_order_blockdata_ () return; */ static ffestcOrder_ -ffestc_order_blockspec_ () +ffestc_order_blockspec_ (void) { recurse: @@ -2336,118 +2164,10 @@ ffestc_order_blockspec_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -/* ffestc_order_component_ -- Check ordering on <component-decl> statement - - if (ffestc_order_component_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_component_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateTYPE: - case FFESTV_stateSTRUCTURE: - case FFESTV_stateMAP: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif -/* ffestc_order_contains_ -- Check ordering on CONTAINS statement - - if (ffestc_order_contains_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_contains_ () -{ - recurse: - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateNIL: - ffestc_shriek_begin_program_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_statePROGRAM0: - case FFESTV_statePROGRAM1: - case FFESTV_statePROGRAM2: - case FFESTV_statePROGRAM3: - case FFESTV_statePROGRAM4: - ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM5); - break; - - case FFESTV_stateSUBROUTINE0: - case FFESTV_stateSUBROUTINE1: - case FFESTV_stateSUBROUTINE2: - case FFESTV_stateSUBROUTINE3: - case FFESTV_stateSUBROUTINE4: - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE5); - break; - - case FFESTV_stateFUNCTION0: - case FFESTV_stateFUNCTION1: - case FFESTV_stateFUNCTION2: - case FFESTV_stateFUNCTION3: - case FFESTV_stateFUNCTION4: - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION5); - break; - - case FFESTV_stateMODULE0: - case FFESTV_stateMODULE1: - case FFESTV_stateMODULE2: - case FFESTV_stateMODULE3: - case FFESTV_stateMODULE4: - ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE5); - break; - - case FFESTV_stateUSE: - ffestc_shriek_end_uses_ (TRUE); goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2459,28 +2179,14 @@ ffestc_order_contains_ () ffestc_order_bad_ (); return FFESTC_orderBAD_; } - - switch (ffestw_state (ffestw_previous (ffestw_stack_top ()))) - { - case FFESTV_stateNIL: - ffestw_update (NULL); - return FFESTC_orderOK_; - - default: - ffestc_order_bad_ (); - ffestw_update (NULL); - return FFESTC_orderBAD_; - } } - -#endif /* ffestc_order_data_ -- Check ordering on DATA statement if (ffestc_order_data_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_data_ () +ffestc_order_data_ (void) { recurse: @@ -2534,16 +2240,10 @@ ffestc_order_data_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2563,7 +2263,7 @@ ffestc_order_data_ () return; */ static ffestcOrder_ -ffestc_order_data77_ () +ffestc_order_data77_ (void) { recurse: @@ -2619,16 +2319,10 @@ ffestc_order_data77_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2641,86 +2335,13 @@ ffestc_order_data77_ () return FFESTC_orderBAD_; } } - -/* ffestc_order_derivedtype_ -- Check ordering on derived TYPE statement - - if (ffestc_order_derivedtype_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_derivedtype_ () -{ - recurse: - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateNIL: - ffestc_shriek_begin_program_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_statePROGRAM0: - case FFESTV_statePROGRAM1: - case FFESTV_statePROGRAM2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3); - return FFESTC_orderOK_; - - case FFESTV_stateSUBROUTINE0: - case FFESTV_stateSUBROUTINE1: - case FFESTV_stateSUBROUTINE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3); - return FFESTC_orderOK_; - - case FFESTV_stateFUNCTION0: - case FFESTV_stateFUNCTION1: - case FFESTV_stateFUNCTION2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3); - return FFESTC_orderOK_; - - case FFESTV_stateMODULE0: - case FFESTV_stateMODULE1: - case FFESTV_stateMODULE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3); - return FFESTC_orderOK_; - - case FFESTV_statePROGRAM3: - case FFESTV_stateSUBROUTINE3: - case FFESTV_stateFUNCTION3: - case FFESTV_stateMODULE3: - return FFESTC_orderOK_; - - case FFESTV_stateUSE: - ffestc_shriek_end_uses_ (TRUE); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif /* ffestc_order_do_ -- Check ordering on <do> statement if (ffestc_order_do_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_do_ () +ffestc_order_do_ (void) { switch (ffestw_state (ffestw_stack_top ())) { @@ -2729,9 +2350,6 @@ ffestc_order_do_ () case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2751,7 +2369,7 @@ ffestc_order_do_ () return; */ static ffestcOrder_ -ffestc_order_entry_ () +ffestc_order_entry_ (void) { recurse: @@ -2780,16 +2398,10 @@ ffestc_order_entry_ () break; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2822,7 +2434,7 @@ ffestc_order_entry_ () return; */ static ffestcOrder_ -ffestc_order_exec_ () +ffestc_order_exec_ (void) { bool update; @@ -2870,16 +2482,10 @@ recurse: return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2913,7 +2519,7 @@ recurse: return; */ static ffestcOrder_ -ffestc_order_format_ () +ffestc_order_format_ (void) { recurse: @@ -2958,16 +2564,10 @@ ffestc_order_format_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -2987,7 +2587,7 @@ ffestc_order_format_ () return; */ static ffestcOrder_ -ffestc_order_function_ () +ffestc_order_function_ (void) { recurse: @@ -3002,16 +2602,10 @@ ffestc_order_function_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3031,7 +2625,7 @@ ffestc_order_function_ () return; */ static ffestcOrder_ -ffestc_order_iface_ () +ffestc_order_iface_ (void) { switch (ffestw_state (ffestw_stack_top ())) { @@ -3045,9 +2639,6 @@ ffestc_order_iface_ () case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3067,7 +2658,7 @@ ffestc_order_iface_ () return; */ static ffestcOrder_ -ffestc_order_ifthen_ () +ffestc_order_ifthen_ (void) { switch (ffestw_state (ffestw_stack_top ())) { @@ -3076,9 +2667,6 @@ ffestc_order_ifthen_ () case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3098,7 +2686,7 @@ ffestc_order_ifthen_ () return; */ static ffestcOrder_ -ffestc_order_implicit_ () +ffestc_order_implicit_ (void) { recurse: @@ -3146,16 +2734,10 @@ ffestc_order_implicit_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3175,7 +2757,7 @@ ffestc_order_implicit_ () return; */ static ffestcOrder_ -ffestc_order_implicitnone_ () +ffestc_order_implicitnone_ (void) { recurse: @@ -3216,47 +2798,10 @@ ffestc_order_implicitnone_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -/* ffestc_order_interface_ -- Check ordering on <interface> statement - - if (ffestc_order_interface_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_interface_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateINTERFACE0: - case FFESTV_stateINTERFACE1: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3270,87 +2815,13 @@ ffestc_order_interface_ () } } -#endif -/* ffestc_order_map_ -- Check ordering on <map> statement - - if (ffestc_order_map_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_VXT -static ffestcOrder_ -ffestc_order_map_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateMAP: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif -/* ffestc_order_module_ -- Check ordering on <module> statement - - if (ffestc_order_module_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_module_ () -{ - recurse: - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateMODULE0: - case FFESTV_stateMODULE1: - case FFESTV_stateMODULE2: - case FFESTV_stateMODULE3: - case FFESTV_stateMODULE4: - case FFESTV_stateMODULE5: - return FFESTC_orderOK_; - - case FFESTV_stateUSE: - ffestc_shriek_end_uses_ (TRUE); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif /* ffestc_order_parameter_ -- Check ordering on <parameter> statement if (ffestc_order_parameter_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_parameter_ () +ffestc_order_parameter_ (void) { recurse: @@ -3407,16 +2878,10 @@ ffestc_order_parameter_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3436,7 +2901,7 @@ ffestc_order_parameter_ () return; */ static ffestcOrder_ -ffestc_order_program_ () +ffestc_order_program_ (void) { recurse: @@ -3455,16 +2920,10 @@ ffestc_order_program_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3484,7 +2943,7 @@ ffestc_order_program_ () return; */ static ffestcOrder_ -ffestc_order_progspec_ () +ffestc_order_progspec_ (void) { recurse: @@ -3544,16 +3003,10 @@ ffestc_order_progspec_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3566,100 +3019,13 @@ ffestc_order_progspec_ () return FFESTC_orderBAD_; } } - -/* ffestc_order_record_ -- Check ordering on RECORD statement - - if (ffestc_order_record_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_VXT -static ffestcOrder_ -ffestc_order_record_ () -{ - recurse: - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateNIL: - ffestc_shriek_begin_program_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_statePROGRAM0: - case FFESTV_statePROGRAM1: - case FFESTV_statePROGRAM2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3); - return FFESTC_orderOK_; - - case FFESTV_stateSUBROUTINE0: - case FFESTV_stateSUBROUTINE1: - case FFESTV_stateSUBROUTINE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3); - return FFESTC_orderOK_; - - case FFESTV_stateFUNCTION0: - case FFESTV_stateFUNCTION1: - case FFESTV_stateFUNCTION2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3); - return FFESTC_orderOK_; - - case FFESTV_stateMODULE0: - case FFESTV_stateMODULE1: - case FFESTV_stateMODULE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3); - return FFESTC_orderOK_; - - case FFESTV_stateBLOCKDATA0: - case FFESTV_stateBLOCKDATA1: - case FFESTV_stateBLOCKDATA2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3); - return FFESTC_orderOK_; - - case FFESTV_statePROGRAM3: - case FFESTV_stateSUBROUTINE3: - case FFESTV_stateFUNCTION3: - case FFESTV_stateMODULE3: - case FFESTV_stateBLOCKDATA3: - case FFESTV_stateSTRUCTURE: - case FFESTV_stateMAP: - return FFESTC_orderOK_; - - case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif /* ffestc_order_selectcase_ -- Check ordering on <selectcase> statement if (ffestc_order_selectcase_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_selectcase_ () +ffestc_order_selectcase_ (void) { switch (ffestw_state (ffestw_stack_top ())) { @@ -3669,9 +3035,6 @@ ffestc_order_selectcase_ () case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3691,7 +3054,7 @@ ffestc_order_selectcase_ () return; */ static ffestcOrder_ -ffestc_order_sfunc_ () +ffestc_order_sfunc_ (void) { recurse: @@ -3728,16 +3091,10 @@ ffestc_order_sfunc_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3750,115 +3107,13 @@ ffestc_order_sfunc_ () return FFESTC_orderBAD_; } } - -/* ffestc_order_spec_ -- Check ordering on <spec> statement - - if (ffestc_order_spec_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_spec_ () -{ - recurse: - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateNIL: - ffestc_shriek_begin_program_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateSUBROUTINE0: - case FFESTV_stateSUBROUTINE1: - case FFESTV_stateSUBROUTINE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3); - return FFESTC_orderOK_; - - case FFESTV_stateFUNCTION0: - case FFESTV_stateFUNCTION1: - case FFESTV_stateFUNCTION2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3); - return FFESTC_orderOK_; - - case FFESTV_stateMODULE0: - case FFESTV_stateMODULE1: - case FFESTV_stateMODULE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3); - return FFESTC_orderOK_; - - case FFESTV_stateSUBROUTINE3: - case FFESTV_stateFUNCTION3: - case FFESTV_stateMODULE3: - return FFESTC_orderOK_; - - case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif -/* ffestc_order_structure_ -- Check ordering on <structure> statement - - if (ffestc_order_structure_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_VXT -static ffestcOrder_ -ffestc_order_structure_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateSTRUCTURE: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif /* ffestc_order_subroutine_ -- Check ordering on <subroutine> statement if (ffestc_order_subroutine_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_subroutine_ () +ffestc_order_subroutine_ (void) { recurse: @@ -3873,46 +3128,10 @@ ffestc_order_subroutine_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -/* ffestc_order_type_ -- Check ordering on <type> statement - - if (ffestc_order_type_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_type_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateTYPE: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -3926,14 +3145,13 @@ ffestc_order_type_ () } } -#endif /* ffestc_order_typedecl_ -- Check ordering on <typedecl> statement if (ffestc_order_typedecl_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_typedecl_ () +ffestc_order_typedecl_ (void) { recurse: @@ -3986,16 +3204,10 @@ ffestc_order_typedecl_ () return FFESTC_orderOK_; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ case FFESTV_stateWHERE: ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -4008,118 +3220,21 @@ ffestc_order_typedecl_ () return FFESTC_orderBAD_; } } - -/* ffestc_order_union_ -- Check ordering on <union> statement - - if (ffestc_order_union_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_VXT -static ffestcOrder_ -ffestc_order_union_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateUNION: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif /* ffestc_order_unit_ -- Check ordering on <unit> statement if (ffestc_order_unit_() != FFESTC_orderOK_) return; */ static ffestcOrder_ -ffestc_order_unit_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateNIL: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -/* ffestc_order_use_ -- Check ordering on USE statement - - if (ffestc_order_use_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_use_ () +ffestc_order_unit_ (void) { - recurse: - switch (ffestw_state (ffestw_stack_top ())) { case FFESTV_stateNIL: - ffestc_shriek_begin_program_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_statePROGRAM0: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM1); - ffestc_shriek_begin_uses_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateSUBROUTINE0: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1); - ffestc_shriek_begin_uses_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateFUNCTION0: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1); - ffestc_shriek_begin_uses_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateMODULE0: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE1); - ffestc_shriek_begin_uses_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateUSE: return FFESTC_orderOK_; case FFESTV_stateWHERE: ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); return FFESTC_orderBAD_; case FFESTV_stateIF: @@ -4132,125 +3247,6 @@ ffestc_order_use_ () return FFESTC_orderBAD_; } } - -#endif -/* ffestc_order_vxtstructure_ -- Check ordering on STRUCTURE statement - - if (ffestc_order_vxtstructure_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_VXT -static ffestcOrder_ -ffestc_order_vxtstructure_ () -{ - recurse: - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateNIL: - ffestc_shriek_begin_program_ (); - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_statePROGRAM0: - case FFESTV_statePROGRAM1: - case FFESTV_statePROGRAM2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3); - return FFESTC_orderOK_; - - case FFESTV_stateSUBROUTINE0: - case FFESTV_stateSUBROUTINE1: - case FFESTV_stateSUBROUTINE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3); - return FFESTC_orderOK_; - - case FFESTV_stateFUNCTION0: - case FFESTV_stateFUNCTION1: - case FFESTV_stateFUNCTION2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3); - return FFESTC_orderOK_; - - case FFESTV_stateMODULE0: - case FFESTV_stateMODULE1: - case FFESTV_stateMODULE2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3); - return FFESTC_orderOK_; - - case FFESTV_stateBLOCKDATA0: - case FFESTV_stateBLOCKDATA1: - case FFESTV_stateBLOCKDATA2: - ffestw_update (NULL); - ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3); - return FFESTC_orderOK_; - - case FFESTV_statePROGRAM3: - case FFESTV_stateSUBROUTINE3: - case FFESTV_stateFUNCTION3: - case FFESTV_stateMODULE3: - case FFESTV_stateBLOCKDATA3: - case FFESTV_stateSTRUCTURE: - case FFESTV_stateMAP: - return FFESTC_orderOK_; - - case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif - goto recurse; /* :::::::::::::::::::: */ - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); -#if FFESTR_F90 - ffestc_shriek_where_ (FALSE); -#endif - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif -/* ffestc_order_where_ -- Check ordering on <where> statement - - if (ffestc_order_where_() != FFESTC_orderOK_) - return; */ - -#if FFESTR_F90 -static ffestcOrder_ -ffestc_order_where_ () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateWHERETHEN: - return FFESTC_orderOK_; - - case FFESTV_stateWHERE: - ffestc_order_bad_ (); - ffestc_shriek_where_ (FALSE); - return FFESTC_orderBAD_; - - case FFESTV_stateIF: - ffestc_order_bad_ (); - ffestc_shriek_if_ (FALSE); - return FFESTC_orderBAD_; - - default: - ffestc_order_bad_ (); - return FFESTC_orderBAD_; - } -} - -#endif /* Invoked for each token in dummy arg list of FUNCTION, SUBROUTINE, and ENTRY (prior to the first executable statement). */ @@ -4567,7 +3563,7 @@ ffestc_promote_sfdummy_ (ffelexToken t) of a main program unit. */ static void -ffestc_shriek_begin_program_ () +ffestc_shriek_begin_program_ (void) { ffestw b; ffesymbol s; @@ -4605,32 +3601,6 @@ ffestc_shriek_begin_program_ () ffestd_R1102 (s, NULL); } -/* ffestc_shriek_begin_uses_ -- Start a bunch of USE statements - - ffestc_shriek_begin_uses_(); - - Invoked before handling the first USE statement in a block of one or - more USE statements. _end_uses_(bool ok) is invoked before handling - the first statement after the block (there are no BEGIN USE and END USE - statements, but the semantics of USE statements effectively requires - handling them as a single block rather than one statement at a time). */ - -#if FFESTR_F90 -static void -ffestc_shriek_begin_uses_ () -{ - ffestw b; - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, NULL); - ffestw_set_state (b, FFESTV_stateUSE); - ffestw_set_blocknum (b, 0); - ffestw_set_shriek (b, ffestc_shriek_end_uses_); - - ffestd_begin_uses (); -} - -#endif /* ffestc_shriek_blockdata_ -- End a BLOCK DATA ffestc_shriek_blockdata_(TRUE); */ @@ -4724,23 +3694,6 @@ ffestc_shriek_end_program_ (bool ok) ffe_init_2 (); } -/* ffestc_shriek_end_uses_ -- End a bunch of USE statements - - ffestc_shriek_end_uses_(TRUE); - - ok==TRUE means simply not popping due to ffestc_eof() - being called, because there is no formal END USES statement in Fortran. */ - -#if FFESTR_F90 -static void -ffestc_shriek_end_uses_ (bool ok) -{ - ffestd_end_uses (ok); - - ffestw_kill (ffestw_pop ()); -} - -#endif /* ffestc_shriek_function_ -- End a FUNCTION ffestc_shriek_function_(TRUE); */ @@ -4818,64 +3771,6 @@ ffestc_shriek_ifthen_ (bool ok) ffestc_try_shriek_do_ (); } -/* ffestc_shriek_interface_ -- End an INTERFACE - - ffestc_shriek_interface_(TRUE); */ - -#if FFESTR_F90 -static void -ffestc_shriek_interface_ (bool ok) -{ - ffestd_R1203 (ok); - - ffestw_kill (ffestw_pop ()); - - ffestc_try_shriek_do_ (); -} - -#endif -/* ffestc_shriek_map_ -- End a MAP - - ffestc_shriek_map_(TRUE); */ - -#if FFESTR_VXT -static void -ffestc_shriek_map_ (bool ok) -{ - ffestd_V013 (ok); - - ffestw_kill (ffestw_pop ()); - - ffestc_try_shriek_do_ (); -} - -#endif -/* ffestc_shriek_module_ -- End a MODULE - - ffestc_shriek_module_(TRUE); */ - -#if FFESTR_F90 -static void -ffestc_shriek_module_ (bool ok) -{ - if (!ffesta_seen_first_exec) - { - ffesta_seen_first_exec = TRUE; - ffestd_exec_begin (); - } - - ffestd_R1106 (ok); - - ffestd_exec_end (); - - ffelex_token_kill (ffestw_name (ffestw_stack_top ())); - ffestw_kill (ffestw_pop ()); - - ffe_terminate_2 (); - ffe_init_2 (); -} - -#endif /* ffestc_shriek_select_ -- End a SELECT ffestc_shriek_select_(TRUE); */ @@ -4901,22 +3796,6 @@ ffestc_shriek_select_ (bool ok) ffestc_try_shriek_do_ (); } -/* ffestc_shriek_structure_ -- End a STRUCTURE - - ffestc_shriek_structure_(TRUE); */ - -#if FFESTR_VXT -static void -ffestc_shriek_structure_ (bool ok) -{ - ffestd_V004 (ok); - - ffestw_kill (ffestw_pop ()); - - ffestc_try_shriek_do_ (); -} - -#endif /* ffestc_shriek_subroutine_ -- End a SUBROUTINE ffestc_shriek_subroutine_(TRUE); */ @@ -4957,81 +3836,6 @@ ffestc_shriek_subroutine_ (bool ok) } } -/* ffestc_shriek_type_ -- End a TYPE - - ffestc_shriek_type_(TRUE); */ - -#if FFESTR_F90 -static void -ffestc_shriek_type_ (bool ok) -{ - ffestd_R425 (ok); - - ffe_terminate_4 (); - - ffelex_token_kill (ffestw_name (ffestw_stack_top ())); - ffestw_kill (ffestw_pop ()); - - ffestc_try_shriek_do_ (); -} - -#endif -/* ffestc_shriek_union_ -- End a UNION - - ffestc_shriek_union_(TRUE); */ - -#if FFESTR_VXT -static void -ffestc_shriek_union_ (bool ok) -{ - ffestd_V010 (ok); - - ffestw_kill (ffestw_pop ()); - - ffestc_try_shriek_do_ (); -} - -#endif -/* ffestc_shriek_where_ -- Implicit END WHERE statement - - ffestc_shriek_where_(TRUE); - - Implement the end of the current WHERE "block". ok==TRUE iff statement - following WHERE (substatement) is valid; else, statement is invalid - or stack forcibly popped due to ffestc_eof(). */ - -#if FFESTR_F90 -static void -ffestc_shriek_where_ (bool ok) -{ - ffestd_R745 (ok); - - ffestw_kill (ffestw_pop ()); - ffestc_shriek_after1_ = NULL; - if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateIF) - ffestc_shriek_if_ (TRUE); /* "IF (x) WHERE (y) stmt" is only valid - case. */ - - ffestc_try_shriek_do_ (); -} - -#endif -/* ffestc_shriek_wherethen_ -- End a WHERE(-THEN) - - ffestc_shriek_wherethen_(TRUE); */ - -#if FFESTR_F90 -static void -ffestc_shriek_wherethen_ (bool ok) -{ - ffestd_end_R740 (ok); - - ffestw_kill (ffestw_pop ()); - - ffestc_try_shriek_do_ (); -} - -#endif /* ffestc_subr_binsrch_ -- Binary search of char const in list of strings i = ffestc_subr_binsrch_(search_list,search_list_size,&spec,"etc"); @@ -5303,7 +4107,7 @@ ffestc_subr_unit_ (ffestpFile *spec) like "DO 10", "IF (...) THEN", "10 ELSE", "END IF", "END". */ static void -ffestc_try_shriek_do_ () +ffestc_try_shriek_do_ (void) { ffelab lab; ffelabType ty; @@ -5372,12 +4176,6 @@ ffestc_decl_start (ffestpType type, ffelexToken typet, ffebld kind, switch (ffestc_local_.decl.is_R426) { -#if FFESTR_F90 - case 1: - ffestc_R426_start (type, typet, kind, kindt, len, lent); - break; -#endif - case 2: ffestc_R501_start (type, typet, kind, kindt, len, lent); break; @@ -5401,27 +4199,11 @@ ffestc_decl_attrib (ffestpAttrib attrib UNUSED, ffestrOther intent_kw UNUSED, ffesttDimList dims UNUSED) { -#if FFESTR_F90 - switch (ffestc_local_.decl.is_R426) - { - case 1: - ffestc_R426_attrib (attrib, attribt, intent_kw, dims); - break; - - case 2: - ffestc_R501_attrib (attrib, attribt, intent_kw, dims); - break; - - default: - break; - } -#else ffebad_start (FFEBAD_F90); ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), ffelex_token_where_column (ffesta_tokens[0])); ffebad_finish (); return; -#endif } /* ffestc_decl_item -- R426 or R501 @@ -5437,13 +4219,6 @@ ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt, { switch (ffestc_local_.decl.is_R426) { -#if FFESTR_F90 - case 1: - ffestc_R426_item (name, kind, kindt, dims, len, lent, init, initt, - clist); - break; -#endif - case 2: ffestc_R501_item (name, kind, kindt, dims, len, lent, init, initt, clist); @@ -5461,16 +4236,10 @@ ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt, Gonna specify values for the object now. */ void -ffestc_decl_itemstartvals () +ffestc_decl_itemstartvals (void) { switch (ffestc_local_.decl.is_R426) { -#if FFESTR_F90 - case 1: - ffestc_R426_itemstartvals (); - break; -#endif - case 2: ffestc_R501_itemstartvals (); break; @@ -5492,12 +4261,6 @@ ffestc_decl_itemvalue (ffebld repeat, ffelexToken repeat_token, { switch (ffestc_local_.decl.is_R426) { -#if FFESTR_F90 - case 1: - ffestc_R426_itemvalue (repeat, repeat_token, value, value_token); - break; -#endif - case 2: ffestc_R501_itemvalue (repeat, repeat_token, value, value_token); break; @@ -5519,12 +4282,6 @@ ffestc_decl_itemendvals (ffelexToken t) { switch (ffestc_local_.decl.is_R426) { -#if FFESTR_F90 - case 1: - ffestc_R426_itemendvals (t); - break; -#endif - case 2: ffestc_R501_itemendvals (t); break; @@ -5541,16 +4298,10 @@ ffestc_decl_itemendvals (ffelexToken t) Just wrap up any local activities. */ void -ffestc_decl_finish () +ffestc_decl_finish (void) { switch (ffestc_local_.decl.is_R426) { -#if FFESTR_F90 - case 1: - ffestc_R426_finish (); - break; -#endif - case 2: ffestc_R501_finish (); break; @@ -5576,9 +4327,6 @@ ffestc_elsewhere (ffelexToken where) break; default: -#if FFESTR_F90 - ffestc_R744 (); -#endif break; } } @@ -5591,7 +4339,7 @@ ffestc_elsewhere (ffelexToken where) it. */ void -ffestc_end () +ffestc_end (void) { ffestw b; @@ -5635,9 +4383,6 @@ recurse: case FFESTV_stateMODULE3: case FFESTV_stateMODULE4: case FFESTV_stateMODULE5: -#if FFESTR_F90 - ffestc_R1106 (NULL); -#endif break; case FFESTV_stateSUBROUTINE0: @@ -5677,7 +4422,7 @@ recurse: block's shriek function to clean up to state NIL. */ void -ffestc_eof () +ffestc_eof (void) { if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateNIL) { @@ -5712,7 +4457,7 @@ ffestc_eof () seeing the unrecognized statement? we do the former at the moment). */ bool -ffestc_exec_transition () +ffestc_exec_transition (void) { bool update; @@ -5757,9 +4502,6 @@ recurse: break; case FFESTV_stateUSE: -#if FFESTR_F90 - ffestc_shriek_end_uses_ (TRUE); -#endif goto recurse; /* :::::::::::::::::::: */ default: @@ -5819,7 +4561,7 @@ ffestc_ffebad_here_doiter (ffebadIndex i, ffesymbol s) is the R1219 function-stmt case). */ bool -ffestc_is_decl_not_R1219 () +ffestc_is_decl_not_R1219 (void) { switch (ffestw_state (ffestw_stack_top ())) { @@ -5849,7 +4591,7 @@ ffestc_is_decl_not_R1219 () if the ENTRY is in a function context. */ bool -ffestc_is_entry_in_subr () +ffestc_is_entry_in_subr (void) { ffestvState s; @@ -5888,7 +4630,7 @@ recurse: explicit typing of name. */ bool -ffestc_is_let_not_V027 () +ffestc_is_let_not_V027 (void) { switch (ffestw_state (ffestw_stack_top ())) { @@ -5909,58 +4651,6 @@ ffestc_is_let_not_V027 () } } -/* ffestc_module -- MODULE or MODULE PROCEDURE statement - - ffestc_module(module_name_token,procedure_name_token); - - Decide which is intended, and implement it by calling _R1105_ or - _R1205_. */ - -#if FFESTR_F90 -void -ffestc_module (ffelexToken module, ffelexToken procedure) -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateINTERFACE0: - case FFESTV_stateINTERFACE1: - ffestc_R1205_start (); - ffestc_R1205_item (procedure); - ffestc_R1205_finish (); - break; - - default: - ffestc_R1105 (module); - break; - } -} - -#endif -/* ffestc_private -- Generic PRIVATE statement - - ffestc_end(); - - This is either a PRIVATE within R422 derived-type statement or an - R521 PRIVATE statement. Figure it out based on context and implement - it, or produce an error. */ - -#if FFESTR_F90 -void -ffestc_private () -{ - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateTYPE: - ffestc_R423A (); - break; - - default: - ffestc_R521B (); - break; - } -} - -#endif /* ffestc_terminate_4 -- Terminate ffestc after scoping unit ffestc_terminate_4(); @@ -5969,280 +4659,11 @@ ffestc_private () defs, and statement function defs. */ void -ffestc_terminate_4 () +ffestc_terminate_4 (void) { ffestc_entry_num_ = ffestc_saved_entry_num_; } -/* ffestc_R423A -- PRIVATE statement (in R422 derived-type statement) - - ffestc_R423A(); */ - -#if FFESTR_F90 -void -ffestc_R423A () -{ - ffestc_check_simple_ (); - if (ffestc_order_type_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 0) - { - ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - return; - } - - if (ffestw_state (ffestw_previous (ffestw_stack_top ())) != FFESTV_stateMODULE3) - { - ffebad_start (FFEBAD_DERIVTYP_ACCESS); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_finish (); - return; - } - - ffestw_set_substate (ffestw_stack_top (), 1); /* Seen - private-sequence-stmt. */ - - ffestd_R423A (); -} - -/* ffestc_R423B -- SEQUENCE statement (in R422 derived-type-stmt) - - ffestc_R423B(); */ - -void -ffestc_R423B () -{ - ffestc_check_simple_ (); - if (ffestc_order_type_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 0) - { - ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - return; - } - - ffestw_set_substate (ffestw_stack_top (), 1); /* Seen - private-sequence-stmt. */ - - ffestd_R423B (); -} - -/* ffestc_R424 -- derived-TYPE-def statement - - ffestc_R424(access_token,access_kw,name_token); - - Handle a derived-type definition. */ - -void -ffestc_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name) -{ - ffestw b; - - assert (name != NULL); - - ffestc_check_simple_ (); - if (ffestc_order_derivedtype_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if ((access != NULL) - && (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE3)) - { - ffebad_start (FFEBAD_DERIVTYP_ACCESS); - ffebad_here (0, ffelex_token_where_line (access), - ffelex_token_where_column (access)); - ffebad_finish (); - access = NULL; - } - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, NULL); - ffestw_set_state (b, FFESTV_stateTYPE); - ffestw_set_blocknum (b, 0); - ffestw_set_shriek (b, ffestc_shriek_type_); - ffestw_set_name (b, ffelex_token_use (name)); - ffestw_set_substate (b, 0); /* Awaiting private-sequence-stmt and one - component-def-stmt. */ - - ffestd_R424 (access, access_kw, name); - - ffe_init_4 (); -} - -/* ffestc_R425 -- END TYPE statement - - ffestc_R425(name_token); - - Make sure ffestc_kind_ identifies a TYPE definition. If not - NULL, make sure name_token gives the correct name. Implement the end - of the type definition. */ - -void -ffestc_R425 (ffelexToken name) -{ - ffestc_check_simple_ (); - if (ffestc_order_type_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 2) - { - ffebad_start (FFEBAD_DERIVTYP_NO_COMPONENTS); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - } - - if ((name != NULL) - && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)) - { - ffebad_start (FFEBAD_TYPE_WRONG_NAME); - ffebad_here (0, ffelex_token_where_line (name), - ffelex_token_where_column (name)); - ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())), - ffelex_token_where_column (ffestw_name (ffestw_stack_top ()))); - ffebad_finish (); - } - - ffestc_shriek_type_ (TRUE); -} - -/* ffestc_R426_start -- component-declaration-stmt - - ffestc_R426_start(...); - - Verify that R426 component-declaration-stmt is - valid here and implement. */ - -void -ffestc_R426_start (ffestpType type, ffelexToken typet, ffebld kind, - ffelexToken kindt, ffebld len, ffelexToken lent) -{ - ffestc_check_start_ (); - if (ffestc_order_component_ () != FFESTC_orderOK_) - { - ffestc_local_.decl.is_R426 = 0; - return; - } - ffestc_labeldef_useless_ (); - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateSTRUCTURE: - case FFESTV_stateMAP: - ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one - member. */ - break; - - case FFESTV_stateTYPE: - ffestw_set_substate (ffestw_stack_top (), 2); - break; - - default: - assert ("Component parent state invalid" == NULL); - break; - } -} - -/* ffestc_R426_attrib -- type attribute - - ffestc_R426_attrib(...); - - Verify that R426 component-declaration-stmt attribute - is valid here and implement. */ - -void -ffestc_R426_attrib (ffestpAttrib attrib, ffelexToken attribt, - ffestrOther intent_kw, ffesttDimList dims) -{ - ffestc_check_attrib_ (); -} - -/* ffestc_R426_item -- declared object - - ffestc_R426_item(...); - - Establish type for a particular object. */ - -void -ffestc_R426_item (ffelexToken name, ffebld kind, ffelexToken kindt, - ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init, - ffelexToken initt, bool clist) -{ - ffestc_check_item_ (); - assert (name != NULL); - assert (ffelex_token_type (name) == FFELEX_typeNAME); /* Not NAMES. */ - assert (kind == NULL); /* No way an expression should get here. */ - - if ((dims != NULL) || (init != NULL) || clist) - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); -} - -/* ffestc_R426_itemstartvals -- Start list of values - - ffestc_R426_itemstartvals(); - - Gonna specify values for the object now. */ - -void -ffestc_R426_itemstartvals () -{ - ffestc_check_item_startvals_ (); -} - -/* ffestc_R426_itemvalue -- Source value - - ffestc_R426_itemvalue(repeat,repeat_token,value,value_token); - - Make sure repeat and value are valid for the object being initialized. */ - -void -ffestc_R426_itemvalue (ffebld repeat, ffelexToken repeat_token, - ffebld value, ffelexToken value_token) -{ - ffestc_check_item_value_ (); -} - -/* ffestc_R426_itemendvals -- End list of values - - ffelexToken t; // the SLASH token that ends the list. - ffestc_R426_itemendvals(t); - - No more values, might specify more objects now. */ - -void -ffestc_R426_itemendvals (ffelexToken t) -{ - ffestc_check_item_endvals_ (); -} - -/* ffestc_R426_finish -- Done - - ffestc_R426_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R426_finish () -{ - ffestc_check_finish_ (); -} - -#endif /* ffestc_R501_start -- type-declaration-stmt ffestc_R501_start(...); @@ -6281,11 +4702,6 @@ ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt, switch (attrib) { -#if FFESTR_F90 - case FFESTP_attribALLOCATABLE: - break; -#endif - case FFESTP_attribDIMENSION: ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); break; @@ -6293,35 +4709,12 @@ ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt, case FFESTP_attribEXTERNAL: break; -#if FFESTR_F90 - case FFESTP_attribINTENT: - break; -#endif - case FFESTP_attribINTRINSIC: break; -#if FFESTR_F90 - case FFESTP_attribOPTIONAL: - break; -#endif - case FFESTP_attribPARAMETER: break; -#if FFESTR_F90 - case FFESTP_attribPOINTER: - break; -#endif - -#if FFESTR_F90 - case FFESTP_attribPRIVATE: - break; - - case FFESTP_attribPUBLIC: - break; -#endif - case FFESTP_attribSAVE: switch (ffestv_save_state_) { @@ -6355,11 +4748,6 @@ ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt, } break; -#if FFESTR_F90 - case FFESTP_attribTARGET: - break; -#endif - default: assert ("unexpected attribute" == NULL); break; @@ -6635,7 +5023,7 @@ ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt, Gonna specify values for the object now. */ void -ffestc_R501_itemstartvals () +ffestc_R501_itemstartvals (void) { ffestc_check_item_startvals_ (); @@ -6703,323 +5091,11 @@ ffestc_R501_itemendvals (ffelexToken t) Just wrap up any local activities. */ void -ffestc_R501_finish () +ffestc_R501_finish (void) { ffestc_check_finish_ (); } -/* ffestc_R519_start -- INTENT statement list begin - - ffestc_R519_start(); - - Verify that INTENT is valid here, and begin accepting items in the list. */ - -#if FFESTR_F90 -void -ffestc_R519_start (ffelexToken intent, ffestrOther intent_kw) -{ - ffestc_check_start_ (); - if (ffestc_order_spec_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R519_start (intent_kw); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R519_item -- INTENT statement for name - - ffestc_R519_item(name_token); - - Make sure name_token identifies a valid object to be INTENTed. */ - -void -ffestc_R519_item (ffelexToken name) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffestd_R519_item (name); -} - -/* ffestc_R519_finish -- INTENT statement list complete - - ffestc_R519_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R519_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R519_finish (); -} - -/* ffestc_R520_start -- OPTIONAL statement list begin - - ffestc_R520_start(); - - Verify that OPTIONAL is valid here, and begin accepting items in the list. */ - -void -ffestc_R520_start () -{ - ffestc_check_start_ (); - if (ffestc_order_spec_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R520_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R520_item -- OPTIONAL statement for name - - ffestc_R520_item(name_token); - - Make sure name_token identifies a valid object to be OPTIONALed. */ - -void -ffestc_R520_item (ffelexToken name) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffestd_R520_item (name); -} - -/* ffestc_R520_finish -- OPTIONAL statement list complete - - ffestc_R520_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R520_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R520_finish (); -} - -/* ffestc_R521A -- PUBLIC statement - - ffestc_R521A(); - - Verify that PUBLIC is valid here. */ - -void -ffestc_R521A () -{ - ffestc_check_simple_ (); - if (ffestc_order_access_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - switch (ffestv_access_state_) - { - case FFESTV_accessstateNONE: - ffestv_access_state_ = FFESTV_accessstatePUBLIC; - ffestv_access_line_ - = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0])); - ffestv_access_col_ - = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0])); - break; - - case FFESTV_accessstateANY: - break; - - case FFESTV_accessstatePUBLIC: - case FFESTV_accessstatePRIVATE: - ffebad_start (FFEBAD_CONFLICTING_ACCESSES); - ffebad_here (0, ffestv_access_line_, ffestv_access_col_); - ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_finish (); - ffestv_access_state_ = FFESTV_accessstateANY; - break; - - default: - assert ("unexpected access state" == NULL); - break; - } - - ffestd_R521A (); -} - -/* ffestc_R521Astart -- PUBLIC statement list begin - - ffestc_R521Astart(); - - Verify that PUBLIC is valid here, and begin accepting items in the list. */ - -void -ffestc_R521Astart () -{ - ffestc_check_start_ (); - if (ffestc_order_access_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R521Astart (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R521Aitem -- PUBLIC statement for name - - ffestc_R521Aitem(name_token); - - Make sure name_token identifies a valid object to be PUBLICed. */ - -void -ffestc_R521Aitem (ffelexToken name) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffestd_R521Aitem (name); -} - -/* ffestc_R521Afinish -- PUBLIC statement list complete - - ffestc_R521Afinish(); - - Just wrap up any local activities. */ - -void -ffestc_R521Afinish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R521Afinish (); -} - -/* ffestc_R521B -- PRIVATE statement - - ffestc_R521B(); - - Verify that PRIVATE is valid here (outside a derived-type statement). */ - -void -ffestc_R521B () -{ - ffestc_check_simple_ (); - if (ffestc_order_access_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - switch (ffestv_access_state_) - { - case FFESTV_accessstateNONE: - ffestv_access_state_ = FFESTV_accessstatePRIVATE; - ffestv_access_line_ - = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0])); - ffestv_access_col_ - = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0])); - break; - - case FFESTV_accessstateANY: - break; - - case FFESTV_accessstatePUBLIC: - case FFESTV_accessstatePRIVATE: - ffebad_start (FFEBAD_CONFLICTING_ACCESSES); - ffebad_here (0, ffestv_access_line_, ffestv_access_col_); - ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_finish (); - ffestv_access_state_ = FFESTV_accessstateANY; - break; - - default: - assert ("unexpected access state" == NULL); - break; - } - - ffestd_R521B (); -} - -/* ffestc_R521Bstart -- PRIVATE statement list begin - - ffestc_R521Bstart(); - - Verify that PRIVATE is valid here, and begin accepting items in the list. */ - -void -ffestc_R521Bstart () -{ - ffestc_check_start_ (); - if (ffestc_order_access_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R521Bstart (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R521Bitem -- PRIVATE statement for name - - ffestc_R521Bitem(name_token); - - Make sure name_token identifies a valid object to be PRIVATEed. */ - -void -ffestc_R521Bitem (ffelexToken name) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffestd_R521Bitem (name); -} - -/* ffestc_R521Bfinish -- PRIVATE statement list complete - - ffestc_R521Bfinish(); - - Just wrap up any local activities. */ - -void -ffestc_R521Bfinish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R521Bfinish (); -} - -#endif /* ffestc_R522 -- SAVE statement with no list ffestc_R522(); @@ -7027,7 +5103,7 @@ ffestc_R521Bfinish () Verify that SAVE is valid here, and flag everything as SAVEd. */ void -ffestc_R522 () +ffestc_R522 (void) { ffestc_check_simple_ (); if (ffestc_order_blockspec_ () != FFESTC_orderOK_) @@ -7077,7 +5153,7 @@ ffestc_R522 () Verify that SAVE is valid here, and begin accepting items in the list. */ void -ffestc_R522start () +ffestc_R522start (void) { ffestc_check_start_ (); if (ffestc_order_blockspec_ () != FFESTC_orderOK_) @@ -7239,7 +5315,7 @@ ffestc_R522item_cblock (ffelexToken name) Just wrap up any local activities. */ void -ffestc_R522finish () +ffestc_R522finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -7411,7 +5487,7 @@ ffestc_R524_item (ffelexToken name, ffesttDimList dims) Just wrap up any local activities. */ void -ffestc_R524_finish () +ffestc_R524_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -7420,182 +5496,6 @@ ffestc_R524_finish () ffestd_R524_finish (); } -/* ffestc_R525_start -- ALLOCATABLE statement list begin - - ffestc_R525_start(); - - Verify that ALLOCATABLE is valid here, and begin accepting items in the - list. */ - -#if FFESTR_F90 -void -ffestc_R525_start () -{ - ffestc_check_start_ (); - if (ffestc_order_progspec_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R525_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R525_item -- ALLOCATABLE statement for object-name - - ffestc_R525_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be ALLOCATABLEd. */ - -void -ffestc_R525_item (ffelexToken name, ffesttDimList dims) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - - ffestd_R525_item (name, dims); -} - -/* ffestc_R525_finish -- ALLOCATABLE statement list complete - - ffestc_R525_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R525_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R525_finish (); -} - -/* ffestc_R526_start -- POINTER statement list begin - - ffestc_R526_start(); - - Verify that POINTER is valid here, and begin accepting items in the - list. */ - -void -ffestc_R526_start () -{ - ffestc_check_start_ (); - if (ffestc_order_progspec_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R526_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R526_item -- POINTER statement for object-name - - ffestc_R526_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be POINTERd. */ - -void -ffestc_R526_item (ffelexToken name, ffesttDimList dims) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - - ffestd_R526_item (name, dims); -} - -/* ffestc_R526_finish -- POINTER statement list complete - - ffestc_R526_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R526_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R526_finish (); -} - -/* ffestc_R527_start -- TARGET statement list begin - - ffestc_R527_start(); - - Verify that TARGET is valid here, and begin accepting items in the - list. */ - -void -ffestc_R527_start () -{ - ffestc_check_start_ (); - if (ffestc_order_progspec_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R527_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R527_item -- TARGET statement for object-name - - ffestc_R527_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be TARGETd. */ - -void -ffestc_R527_item (ffelexToken name, ffesttDimList dims) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - - ffestd_R527_item (name, dims); -} - -/* ffestc_R527_finish -- TARGET statement list complete - - ffestc_R527_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R527_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R527_finish (); -} - -#endif /* ffestc_R528_start -- DATA statement list begin ffestc_R528_start(); @@ -7603,7 +5503,7 @@ ffestc_R527_finish () Verify that DATA is valid here, and begin accepting items in the list. */ void -ffestc_R528_start () +ffestc_R528_start (void) { ffestcOrder_ order; @@ -7661,7 +5561,7 @@ ffestc_R528_item_object (ffebld expr, ffelexToken expr_token UNUSED) No more objects, gonna specify values for the list of objects now. */ void -ffestc_R528_item_startvals () +ffestc_R528_item_startvals (void) { ffestc_check_item_startvals_ (); if (!ffestc_ok_) @@ -7744,7 +5644,7 @@ ffestc_R528_item_endvals (ffelexToken t) Just wrap up any local activities. */ void -ffestc_R528_finish () +ffestc_R528_finish (void) { ffestc_check_finish_ (); @@ -7762,7 +5662,7 @@ ffestc_R528_finish () list. */ void -ffestc_R537_start () +ffestc_R537_start (void) { ffestc_check_start_ (); if (ffestc_order_parameter_ () != FFESTC_orderOK_) @@ -7845,7 +5745,7 @@ ffestc_R537_item (ffebld dest, ffelexToken dest_token, ffebld source, Just wrap up any local activities. */ void -ffestc_R537_finish () +ffestc_R537_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -7861,7 +5761,7 @@ ffestc_R537_finish () Verify that the IMPLICIT NONE statement is ok here and implement. */ void -ffestc_R539 () +ffestc_R539 (void) { ffestc_check_simple_ (); if (ffestc_order_implicitnone_ () != FFESTC_orderOK_) @@ -7880,7 +5780,7 @@ ffestc_R539 () Verify that the IMPLICIT statement is ok here and implement. */ void -ffestc_R539start () +ffestc_R539start (void) { ffestc_check_start_ (); if (ffestc_order_implicit_ () != FFESTC_orderOK_) @@ -7935,7 +5835,7 @@ ffestc_R539item (ffestpType type, ffebld kind, ffelexToken kindt, Finish up any local activities. */ void -ffestc_R539finish () +ffestc_R539finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -7952,7 +5852,7 @@ ffestc_R539finish () list. */ void -ffestc_R542_start () +ffestc_R542_start (void) { ffestc_check_start_ (); if (ffestc_order_progspec_ () != FFESTC_orderOK_) @@ -8117,7 +6017,7 @@ ffestc_R542_item_nitem (ffelexToken name) Just wrap up any local activities. */ void -ffestc_R542_finish () +ffestc_R542_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -8136,7 +6036,7 @@ ffestc_R542_finish () list. */ void -ffestc_R544_start () +ffestc_R544_start (void) { ffestc_check_start_ (); if (ffestc_order_blockspec_ () != FFESTC_orderOK_) @@ -8263,7 +6163,7 @@ ffestc_R544_equiv_ (ffebld expr, ffelexToken t) Just wrap up any local activities. */ void -ffestc_R544_finish () +ffestc_R544_finish (void) { ffestc_check_finish_ (); } @@ -8275,7 +6175,7 @@ ffestc_R544_finish () Verify that COMMON is valid here, and begin accepting items in the list. */ void -ffestc_R547_start () +ffestc_R547_start (void) { ffestc_check_start_ (); if (ffestc_order_blockspec_ () != FFESTC_orderOK_) @@ -8544,7 +6444,7 @@ ffestc_R547_item_cblock (ffelexToken name) Just wrap up any local activities. */ void -ffestc_R547_finish () +ffestc_R547_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -8556,86 +6456,6 @@ ffestc_R547_finish () ffestd_R547_finish (); } -/* ffestc_R620 -- ALLOCATE statement - - ffestc_R620(exprlist,stat,stat_token); - - Make sure the expression list is valid, then implement it. */ - -#if FFESTR_F90 -void -ffestc_R620 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token) -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - ffestd_R620 (exprlist, stat); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_R624 -- NULLIFY statement - - ffestc_R624(pointer_name_list); - - Make sure pointer_name_list identifies valid pointers for a NULLIFY. */ - -void -ffestc_R624 (ffesttExprList pointers) -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - ffestd_R624 (pointers); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_R625 -- DEALLOCATE statement - - ffestc_R625(exprlist,stat,stat_token); - - Make sure the equivalence is valid, then implement it. */ - -void -ffestc_R625 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token) -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - ffestd_R625 (exprlist, stat); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -#endif -/* ffestc_let -- R1213 or R737 - - ffestc_let(...); - - Verify that R1213 defined-assignment or R737 assignment-stmt are - valid here, figure out which one, and implement. */ - -#if FFESTR_F90 -void -ffestc_let (ffebld dest, ffebld source, ffelexToken source_token) -{ - ffestc_R737 (dest, source, source_token); -} - -#endif /* ffestc_R737 -- Assignment statement ffestc_R737(dest_expr,source_expr,source_token); @@ -8647,26 +6467,6 @@ ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token) { ffestc_check_simple_ (); - switch (ffestw_state (ffestw_stack_top ())) - { -#if FFESTR_F90 - case FFESTV_stateWHERE: - case FFESTV_stateWHERETHEN: - if (ffestc_order_actionwhere_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - ffestd_R737B (dest, source); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - return; -#endif - - default: - break; - } - if (ffestc_order_actionwhere_ () != FFESTC_orderOK_) return; ffestc_labeldef_branch_begin_ (); @@ -8681,130 +6481,6 @@ ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token) ffestc_labeldef_branch_end_ (); } -/* ffestc_R738 -- Pointer assignment statement - - ffestc_R738(dest_expr,source_expr,source_token); - - Make sure the assignment is valid. */ - -#if FFESTR_F90 -void -ffestc_R738 (ffebld dest, ffebld source, ffelexToken source_token) -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - ffestd_R738 (dest, source); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_R740 -- WHERE statement - - ffestc_R740(expr,expr_token); - - Make sure statement is valid here; implement. */ - -void -ffestc_R740 (ffebld expr, ffelexToken expr_token) -{ - ffestw b; - - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b))); - ffestw_set_state (b, FFESTV_stateWHERE); - ffestw_set_blocknum (b, ffestc_blocknum_++); - ffestw_set_shriek (b, ffestc_shriek_where_lost_); - - ffestd_R740 (expr); - - /* Leave label finishing to next statement. */ - -} - -/* ffestc_R742 -- WHERE-construct statement - - ffestc_R742(expr,expr_token); - - Make sure statement is valid here; implement. */ - -void -ffestc_R742 (ffebld expr, ffelexToken expr_token) -{ - ffestw b; - - ffestc_check_simple_ (); - if (ffestc_order_exec_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_notloop_probably_this_wont_work_ (); - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b))); - ffestw_set_state (b, FFESTV_stateWHERETHEN); - ffestw_set_blocknum (b, ffestc_blocknum_++); - ffestw_set_shriek (b, ffestc_shriek_wherethen_); - ffestw_set_substate (b, 0); /* Haven't seen ELSEWHERE yet. */ - - ffestd_R742 (expr); -} - -/* ffestc_R744 -- ELSE WHERE statement - - ffestc_R744(); - - Make sure ffestc_kind_ identifies a WHERE block. - Implement the ELSE of the current WHERE block. */ - -void -ffestc_R744 () -{ - ffestc_check_simple_ (); - if (ffestc_order_where_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 0) - { - ffebad_start (FFEBAD_SECOND_ELSE_WHERE); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - } - - ffestw_set_substate (ffestw_stack_top (), 1); /* Saw ELSEWHERE. */ - - ffestd_R744 (); -} - -/* ffestc_R745 -- END WHERE statement - - ffestc_R745(); - - Make sure ffestc_kind_ identifies a WHERE block. - Implement the end of the current WHERE block. */ - -void -ffestc_R745 () -{ - ffestc_check_simple_ (); - if (ffestc_order_where_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - ffestc_shriek_wherethen_ (TRUE); -} - -#endif /* ffestc_R803 -- Block IF (IF-THEN) statement ffestc_R803(construct_name,expr,expr_token); @@ -9072,7 +6748,7 @@ ffestc_R809 (ffelexToken construct_name, ffebld expr, ffelexToken expr_token) /* Init block to manage CASE list. */ pool = malloc_pool_new ("Select", ffe_pool_any_unit (), 1024); - s = (ffestwSelect) malloc_new_kp (pool, "Select", sizeof (*s)); + s = malloc_new_kp (pool, "Select", sizeof (*s)); s->first_rel = (ffestwCase) &s->first_rel; s->last_rel = (ffestwCase) &s->first_rel; s->first_stmt = (ffestwCase) &s->first_rel; @@ -9199,7 +6875,7 @@ ffestc_R810 (ffesttCaseList cases, ffelexToken name) && ((ffeinfo_basictype (ffebld_info (caseobj->expr1)) != s->type) || ((ffeinfo_kindtype (ffebld_info (caseobj->expr1)) - != s->kindtype) + != s->kindtype) && (ffeinfo_kindtype (ffebld_info (caseobj->expr1)) != FFEINFO_kindtypeINTEGER1 )) || ((caseobj->range) && (caseobj->expr2 != NULL) @@ -10112,34 +7788,16 @@ ffestc_R840 (ffebld expr, ffelexToken expr_token UNUSED, ffestc_R841(); */ void -ffestc_R841 () +ffestc_R841 (void) { ffestc_check_simple_ (); if (ffestc_order_actionwhere_ () != FFESTC_orderOK_) return; - switch (ffestw_state (ffestw_stack_top ())) - { -#if FFESTR_F90 - case FFESTV_stateWHERE: - case FFESTV_stateWHERETHEN: - ffestc_labeldef_useless_ (); - - ffestd_R841 (TRUE); - - /* It's okay that we call ffestc_labeldef_branch_end_ () below, - since that will be a no-op after calling _useless_ () above. */ - break; -#endif - - default: - ffestc_labeldef_branch_begin_ (); - - ffestd_R841 (FALSE); + ffestc_labeldef_branch_begin_ (); - break; - } + ffestd_R841 (FALSE); if (ffestc_shriek_after1_ != NULL) (*ffestc_shriek_after1_) (TRUE); @@ -10202,7 +7860,7 @@ ffestc_R843 (ffebld expr, ffelexToken expr_token UNUSED) Make sure an OPEN is valid in the current context, and implement it. */ void -ffestc_R904 () +ffestc_R904 (void) { int i; int expect_file; @@ -10447,7 +8105,7 @@ ffestc_R904 () Make sure a CLOSE is valid in the current context, and implement it. */ void -ffestc_R907 () +ffestc_R907 (void) { static const char *const status_strs[] = { @@ -10839,7 +8497,7 @@ ffestc_R909_item (ffebld expr, ffelexToken expr_token) Just wrap up any local activities. */ void -ffestc_R909_finish () +ffestc_R909_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -10860,7 +8518,7 @@ ffestc_R909_finish () list. */ void -ffestc_R910_start () +ffestc_R910_start (void) { ffestvUnit unit; ffestvFormat format; @@ -11079,7 +8737,7 @@ ffestc_R910_item (ffebld expr, ffelexToken expr_token) Just wrap up any local activities. */ void -ffestc_R910_finish () +ffestc_R910_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -11100,7 +8758,7 @@ ffestc_R910_finish () list. */ void -ffestc_R911_start () +ffestc_R911_start (void) { ffestvFormat format; @@ -11164,7 +8822,7 @@ ffestc_R911_item (ffebld expr, ffelexToken expr_token) Just wrap up any local activities. */ void -ffestc_R911_finish () +ffestc_R911_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -11184,7 +8842,7 @@ ffestc_R911_finish () Make sure a BACKSPACE is valid in the current context, and implement it. */ void -ffestc_R919 () +ffestc_R919 (void) { ffestc_check_simple_ (); if (ffestc_order_actionif_ () != FFESTC_orderOK_) @@ -11209,7 +8867,7 @@ ffestc_R919 () Make sure a ENDFILE is valid in the current context, and implement it. */ void -ffestc_R920 () +ffestc_R920 (void) { ffestc_check_simple_ (); if (ffestc_order_actionif_ () != FFESTC_orderOK_) @@ -11234,7 +8892,7 @@ ffestc_R920 () Make sure a REWIND is valid in the current context, and implement it. */ void -ffestc_R921 () +ffestc_R921 (void) { ffestc_check_simple_ (); if (ffestc_order_actionif_ () != FFESTC_orderOK_) @@ -11259,7 +8917,7 @@ ffestc_R921 () Make sure an INQUIRE is valid in the current context, and implement it. */ void -ffestc_R923A () +ffestc_R923A (void) { bool by_file; bool by_unit; @@ -11336,7 +8994,7 @@ ffestc_R923A () list. */ void -ffestc_R923B_start () +ffestc_R923B_start (void) { ffestc_check_start_ (); if (ffestc_order_actionif_ () != FFESTC_orderOK_) @@ -11374,7 +9032,7 @@ ffestc_R923B_item (ffebld expr, ffelexToken expr_token UNUSED) Just wrap up any local activities. */ void -ffestc_R923B_finish () +ffestc_R923B_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -11496,124 +9154,6 @@ ffestc_R1103 (ffelexToken name) ffestc_shriek_end_program_ (TRUE); } -/* ffestc_R1105 -- MODULE statement - - ffestc_R1105(name_token); - - Make sure ffestc_kind_ identifies an empty block. Make sure name_token - gives a valid name. Implement the beginning of a module. */ - -#if FFESTR_F90 -void -ffestc_R1105 (ffelexToken name) -{ - ffestw b; - - assert (name != NULL); - - ffestc_check_simple_ (); - if (ffestc_order_unit_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - ffestc_blocknum_ = 0; - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, NULL); - ffestw_set_state (b, FFESTV_stateMODULE0); - ffestw_set_blocknum (b, ffestc_blocknum_++); - ffestw_set_shriek (b, ffestc_shriek_module_); - ffestw_set_name (b, ffelex_token_use (name)); - - ffestd_R1105 (name); -} - -/* ffestc_R1106 -- END MODULE statement - - ffestc_R1106(name_token); - - Make sure ffestc_kind_ identifies the current kind of program unit. If not - NULL, make sure name_token gives the correct name. Implement the end - of the current program unit. */ - -void -ffestc_R1106 (ffelexToken name) -{ - ffestc_check_simple_ (); - if (ffestc_order_module_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if ((name != NULL) - && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)) - { - ffebad_start (FFEBAD_UNIT_WRONG_NAME); - ffebad_here (0, ffelex_token_where_line (name), - ffelex_token_where_column (name)); - ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())), - ffelex_token_where_column (ffestw_name (ffestw_stack_top ()))); - ffebad_finish (); - } - - ffestc_shriek_module_ (TRUE); -} - -/* ffestc_R1107_start -- USE statement list begin - - ffestc_R1107_start(); - - Verify that USE is valid here, and begin accepting items in the list. */ - -void -ffestc_R1107_start (ffelexToken name, bool only) -{ - ffestc_check_start_ (); - if (ffestc_order_use_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - ffestd_R1107_start (name, only); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R1107_item -- USE statement for name - - ffestc_R1107_item(local_token,use_token); - - Make sure name_token identifies a valid object to be USEed. local_token - may be NULL if _start_ was called with only==TRUE. */ - -void -ffestc_R1107_item (ffelexToken local, ffelexToken use) -{ - ffestc_check_item_ (); - assert (use != NULL); - if (!ffestc_ok_) - return; - - ffestd_R1107_item (local, use); -} - -/* ffestc_R1107_finish -- USE statement list complete - - ffestc_R1107_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R1107_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R1107_finish (); -} - -#endif /* ffestc_R1111 -- BLOCK DATA statement ffestc_R1111(name_token); @@ -11707,139 +9247,6 @@ ffestc_R1112 (ffelexToken name) ffestc_shriek_blockdata_ (TRUE); } -/* ffestc_R1202 -- INTERFACE statement - - ffestc_R1202(operator,defined_name); - - Make sure ffestc_kind_ identifies an INTERFACE block. - Implement the end of the current interface. - - 15-May-90 JCB 1.1 - Allow no operator or name to mean INTERFACE by itself; missed this - valid form when originally doing syntactic analysis code. */ - -#if FFESTR_F90 -void -ffestc_R1202 (ffestpDefinedOperator operator, ffelexToken name) -{ - ffestw b; - - ffestc_check_simple_ (); - if (ffestc_order_interfacespec_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, NULL); - ffestw_set_state (b, FFESTV_stateINTERFACE0); - ffestw_set_blocknum (b, 0); - ffestw_set_shriek (b, ffestc_shriek_interface_); - - if ((operator == FFESTP_definedoperatorNone) && (name == NULL)) - ffestw_set_substate (b, 0); /* No generic-spec, so disallow MODULE - PROCEDURE. */ - else - ffestw_set_substate (b, 1); /* MODULE PROCEDURE ok. */ - - ffestd_R1202 (operator, name); - - ffe_init_4 (); -} - -/* ffestc_R1203 -- END INTERFACE statement - - ffestc_R1203(); - - Make sure ffestc_kind_ identifies an INTERFACE block. - Implement the end of the current interface. */ - -void -ffestc_R1203 () -{ - ffestc_check_simple_ (); - if (ffestc_order_interface_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - ffestc_shriek_interface_ (TRUE); - - ffe_terminate_4 (); -} - -/* ffestc_R1205_start -- MODULE PROCEDURE statement list begin - - ffestc_R1205_start(); - - Verify that MODULE PROCEDURE is valid here, and begin accepting items in - the list. */ - -void -ffestc_R1205_start () -{ - ffestc_check_start_ (); - if (ffestc_order_interface_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) == 0) - { - ffebad_start (FFEBAD_INVALID_MODULE_PROCEDURE); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - ffestc_ok_ = FALSE; - return; - } - - if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateINTERFACE0) - { - ffestw_update (NULL); /* Update state line/col info. */ - ffestw_set_state (ffestw_stack_top (), FFESTV_stateINTERFACE1); - } - - ffestd_R1205_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_R1205_item -- MODULE PROCEDURE statement for name - - ffestc_R1205_item(name_token); - - Make sure name_token identifies a valid object to be MODULE PROCEDUREed. */ - -void -ffestc_R1205_item (ffelexToken name) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffestd_R1205_item (name); -} - -/* ffestc_R1205_finish -- MODULE PROCEDURE statement list complete - - ffestc_R1205_finish(); - - Just wrap up any local activities. */ - -void -ffestc_R1205_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_R1205_finish (); -} - -#endif /* ffestc_R1207_start -- EXTERNAL statement list begin ffestc_R1207_start(); @@ -11847,7 +9254,7 @@ ffestc_R1205_finish () Verify that EXTERNAL is valid here, and begin accepting items in the list. */ void -ffestc_R1207_start () +ffestc_R1207_start (void) { ffestc_check_start_ (); if (ffestc_order_progspec_ () != FFESTC_orderOK_) @@ -11921,7 +9328,7 @@ ffestc_R1207_item (ffelexToken name) Just wrap up any local activities. */ void -ffestc_R1207_finish () +ffestc_R1207_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -11937,7 +9344,7 @@ ffestc_R1207_finish () Verify that INTRINSIC is valid here, and begin accepting items in the list. */ void -ffestc_R1208_start () +ffestc_R1208_start (void) { ffestc_check_start_ (); if (ffestc_order_progspec_ () != FFESTC_orderOK_) @@ -12040,7 +9447,7 @@ ffestc_R1208_item (ffelexToken name) Just wrap up any local activities. */ void -ffestc_R1208_finish () +ffestc_R1208_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -12104,29 +9511,6 @@ ffestc_R1212 (ffebld expr, ffelexToken expr_token UNUSED) ffestc_labeldef_branch_end_ (); } -/* ffestc_R1213 -- Defined assignment statement - - ffestc_R1213(dest_expr,source_expr,source_token); - - Make sure the assignment is valid. */ - -#if FFESTR_F90 -void -ffestc_R1213 (ffebld dest, ffebld source, ffelexToken source_token) -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - ffestd_R1213 (dest, source); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -#endif /* ffestc_R1219 -- FUNCTION statement ffestc_R1219(funcname,arglist,ending_token,kind,kindt,len,lent, @@ -12702,26 +10086,6 @@ ffestc_R1227 (ffebld expr, ffelexToken expr_token) ffestc_labeldef_branch_end_ (); } -/* ffestc_R1228 -- CONTAINS statement - - ffestc_R1228(); */ - -#if FFESTR_F90 -void -ffestc_R1228 () -{ - ffestc_check_simple_ (); - if (ffestc_order_contains_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - ffestd_R1228 (); - - ffe_terminate_3 (); - ffe_init_3 (); -} - -#endif /* ffestc_R1229_start -- STMTFUNCTION statement begin ffestc_R1229_start(func_name,func_arg_list,close_paren); @@ -12860,255 +10224,6 @@ ffestc_S3P4 (ffebld filename, ffelexToken filename_token UNUSED) ffestd_S3P4 (filename); } -/* ffestc_V003_start -- STRUCTURE statement list begin - - ffestc_V003_start(structure_name); - - Verify that STRUCTURE is valid here, and begin accepting items in the list. */ - -#if FFESTR_VXT -void -ffestc_V003_start (ffelexToken structure_name) -{ - ffestw b; - - ffestc_check_start_ (); - if (ffestc_order_vxtstructure_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateSTRUCTURE: - case FFESTV_stateMAP: - ffestc_local_.V003.list_state = 2; /* Require at least one field - name. */ - ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one - member. */ - break; - - default: - ffestc_local_.V003.list_state = 0; /* No field names required. */ - if (structure_name == NULL) - { - ffebad_start (FFEBAD_STRUCT_MISSING_NAME); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_finish (); - } - break; - } - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, NULL); - ffestw_set_state (b, FFESTV_stateSTRUCTURE); - ffestw_set_blocknum (b, 0); - ffestw_set_shriek (b, ffestc_shriek_structure_); - ffestw_set_substate (b, 0); /* No field-declarations seen yet. */ - - ffestd_V003_start (structure_name); - - ffestc_ok_ = TRUE; -} - -/* ffestc_V003_item -- STRUCTURE statement for object-name - - ffestc_V003_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be STRUCTUREd. */ - -void -ffestc_V003_item (ffelexToken name, ffesttDimList dims) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - if (ffestc_local_.V003.list_state < 2) - { - if (ffestc_local_.V003.list_state == 0) - { - ffestc_local_.V003.list_state = 1; - ffebad_start (FFEBAD_STRUCT_IGNORING_FIELD); - ffebad_here (0, ffelex_token_where_line (name), - ffelex_token_where_column (name)); - ffebad_finish (); - } - return; - } - ffestc_local_.V003.list_state = 3; /* Have at least one field name. */ - - if (dims != NULL) - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - - ffestd_V003_item (name, dims); -} - -/* ffestc_V003_finish -- STRUCTURE statement list complete - - ffestc_V003_finish(); - - Just wrap up any local activities. */ - -void -ffestc_V003_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - if (ffestc_local_.V003.list_state == 2) - { - ffebad_start (FFEBAD_STRUCT_MISSING_FIELD); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_previous (ffestw_stack_top ())), - ffestw_col (ffestw_previous (ffestw_stack_top ()))); - ffebad_finish (); - } - - ffestd_V003_finish (); -} - -/* ffestc_V004 -- END STRUCTURE statement - - ffestc_V004(); - - Make sure ffestc_kind_ identifies a STRUCTURE block. - Implement the end of the current STRUCTURE block. */ - -void -ffestc_V004 () -{ - ffestc_check_simple_ (); - if (ffestc_order_structure_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 1) - { - ffebad_start (FFEBAD_STRUCT_NO_COMPONENTS); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - } - - ffestc_shriek_structure_ (TRUE); -} - -/* ffestc_V009 -- UNION statement - - ffestc_V009(); */ - -void -ffestc_V009 () -{ - ffestw b; - - ffestc_check_simple_ (); - if (ffestc_order_structure_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one member. */ - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, NULL); - ffestw_set_state (b, FFESTV_stateUNION); - ffestw_set_blocknum (b, 0); - ffestw_set_shriek (b, ffestc_shriek_union_); - ffestw_set_substate (b, 0); /* No map decls seen yet. */ - - ffestd_V009 (); -} - -/* ffestc_V010 -- END UNION statement - - ffestc_V010(); - - Make sure ffestc_kind_ identifies a UNION block. - Implement the end of the current UNION block. */ - -void -ffestc_V010 () -{ - ffestc_check_simple_ (); - if (ffestc_order_union_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 2) - { - ffebad_start (FFEBAD_UNION_NO_TWO_MAPS); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - } - - ffestc_shriek_union_ (TRUE); -} - -/* ffestc_V012 -- MAP statement - - ffestc_V012(); */ - -void -ffestc_V012 () -{ - ffestw b; - - ffestc_check_simple_ (); - if (ffestc_order_union_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 2) - ffestw_substate (ffestw_stack_top ())++; /* 0=>1, 1=>2. */ - - b = ffestw_update (ffestw_push (NULL)); - ffestw_set_top_do (b, NULL); - ffestw_set_state (b, FFESTV_stateMAP); - ffestw_set_blocknum (b, 0); - ffestw_set_shriek (b, ffestc_shriek_map_); - ffestw_set_substate (b, 0); /* No field-declarations seen yet. */ - - ffestd_V012 (); -} - -/* ffestc_V013 -- END MAP statement - - ffestc_V013(); - - Make sure ffestc_kind_ identifies a MAP block. - Implement the end of the current MAP block. */ - -void -ffestc_V013 () -{ - ffestc_check_simple_ (); - if (ffestc_order_map_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_useless_ (); - - if (ffestw_substate (ffestw_stack_top ()) != 1) - { - ffebad_start (FFEBAD_MAP_NO_COMPONENTS); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ())); - ffebad_finish (); - } - - ffestc_shriek_map_ (TRUE); -} - -#endif /* ffestc_V014_start -- VOLATILE statement list begin ffestc_V014_start(); @@ -13117,7 +10232,7 @@ ffestc_V013 () list. */ void -ffestc_V014_start () +ffestc_V014_start (void) { ffestc_check_start_ (); if (ffestc_order_progspec_ () != FFESTC_orderOK_) @@ -13173,7 +10288,7 @@ ffestc_V014_item_cblock (ffelexToken name) Just wrap up any local activities. */ void -ffestc_V014_finish () +ffestc_V014_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -13182,284 +10297,6 @@ ffestc_V014_finish () ffestd_V014_finish (); } -/* ffestc_V016_start -- RECORD statement list begin - - ffestc_V016_start(); - - Verify that RECORD is valid here, and begin accepting items in the list. */ - -#if FFESTR_VXT -void -ffestc_V016_start () -{ - ffestc_check_start_ (); - if (ffestc_order_record_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_useless_ (); - - switch (ffestw_state (ffestw_stack_top ())) - { - case FFESTV_stateSTRUCTURE: - case FFESTV_stateMAP: - ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one - member. */ - break; - - default: - break; - } - - ffestd_V016_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_V016_item_structure -- RECORD statement for common-block-name - - ffestc_V016_item_structure(name_token); - - Make sure name_token identifies a valid structure to be RECORDed. */ - -void -ffestc_V016_item_structure (ffelexToken name) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - ffestd_V016_item_structure (name); -} - -/* ffestc_V016_item_object -- RECORD statement for object-name - - ffestc_V016_item_object(name_token,dim_list); - - Make sure name_token identifies a valid object to be RECORDd. */ - -void -ffestc_V016_item_object (ffelexToken name, ffesttDimList dims) -{ - ffestc_check_item_ (); - assert (name != NULL); - if (!ffestc_ok_) - return; - - if (dims != NULL) - ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); - - ffestd_V016_item_object (name, dims); -} - -/* ffestc_V016_finish -- RECORD statement list complete - - ffestc_V016_finish(); - - Just wrap up any local activities. */ - -void -ffestc_V016_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_V016_finish (); -} - -/* ffestc_V018_start -- REWRITE(...) statement list begin - - ffestc_V018_start(); - - Verify that REWRITE is valid here, and begin accepting items in the - list. */ - -void -ffestc_V018_start () -{ - ffestvFormat format; - - ffestc_check_start_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_branch_begin_ (); - - if (!ffestc_subr_is_branch_ - (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixERR]) - || !ffestc_subr_is_format_ - (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT]) - || !ffestc_subr_is_present_ ("UNIT", - &ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT])) - { - ffestc_ok_ = FALSE; - return; - } - - format = ffestc_subr_format_ - (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT]); - switch (format) - { - case FFESTV_formatNAMELIST: - case FFESTV_formatASTERISK: - ffebad_start (FFEBAD_CONFLICTING_SPECS); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - assert (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present); - if (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present) - { - ffebad_here (0, ffelex_token_where_line - (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw), - ffelex_token_where_column - (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw)); - } - else - { - ffebad_here (1, ffelex_token_where_line - (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value), - ffelex_token_where_column - (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value)); - } - ffebad_finish (); - ffestc_ok_ = FALSE; - return; - - default: - break; - } - - ffestd_V018_start (format); - - ffestc_ok_ = TRUE; -} - -/* ffestc_V018_item -- REWRITE statement i/o item - - ffestc_V018_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestc_V018_item (ffebld expr, ffelexToken expr_token) -{ - ffestc_check_item_ (); - if (!ffestc_ok_) - return; - - ffestd_V018_item (expr); -} - -/* ffestc_V018_finish -- REWRITE statement list complete - - ffestc_V018_finish(); - - Just wrap up any local activities. */ - -void -ffestc_V018_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_V018_finish (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_V019_start -- ACCEPT statement list begin - - ffestc_V019_start(); - - Verify that ACCEPT is valid here, and begin accepting items in the - list. */ - -void -ffestc_V019_start () -{ - ffestvFormat format; - - ffestc_check_start_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_branch_begin_ (); - - if (!ffestc_subr_is_format_ - (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT])) - { - ffestc_ok_ = FALSE; - return; - } - - format = ffestc_subr_format_ - (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT]); - ffestc_namelist_ = (format == FFESTV_formatNAMELIST); - - ffestd_V019_start (format); - - ffestc_ok_ = TRUE; -} - -/* ffestc_V019_item -- ACCEPT statement i/o item - - ffestc_V019_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestc_V019_item (ffebld expr, ffelexToken expr_token) -{ - ffestc_check_item_ (); - if (!ffestc_ok_) - return; - - if (ffestc_namelist_ != 0) - { - if (ffestc_namelist_ == 1) - { - ffestc_namelist_ = 2; - ffebad_start (FFEBAD_NAMELIST_ITEMS); - ffebad_here (0, ffelex_token_where_line (expr_token), - ffelex_token_where_column (expr_token)); - ffebad_finish (); - } - return; - } - - ffestd_V019_item (expr); -} - -/* ffestc_V019_finish -- ACCEPT statement list complete - - ffestc_V019_finish(); - - Just wrap up any local activities. */ - -void -ffestc_V019_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_V019_finish (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -#endif /* ffestc_V020_start -- TYPE statement list begin ffestc_V020_start(); @@ -13468,7 +10305,7 @@ ffestc_V019_finish () list. */ void -ffestc_V020_start () +ffestc_V020_start (void) { ffestvFormat format; @@ -13532,7 +10369,7 @@ ffestc_V020_item (ffebld expr, ffelexToken expr_token) Just wrap up any local activities. */ void -ffestc_V020_finish () +ffestc_V020_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -13545,277 +10382,6 @@ ffestc_V020_finish () ffestc_labeldef_branch_end_ (); } -/* ffestc_V021 -- DELETE statement - - ffestc_V021(); - - Make sure a DELETE is valid in the current context, and implement it. */ - -#if FFESTR_VXT -void -ffestc_V021 () -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - if (ffestc_subr_is_branch_ - (&ffestp_file.delete.delete_spec[FFESTP_deleteixERR]) - && ffestc_subr_is_present_ ("UNIT", - &ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT])) - ffestd_V021 (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_V022 -- UNLOCK statement - - ffestc_V022(); - - Make sure a UNLOCK is valid in the current context, and implement it. */ - -void -ffestc_V022 () -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - if (ffestc_subr_is_branch_ - (&ffestp_file.beru.beru_spec[FFESTP_beruixERR]) - && ffestc_subr_is_present_ ("UNIT", - &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT])) - ffestd_V022 (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_V023_start -- ENCODE(...) statement list begin - - ffestc_V023_start(); - - Verify that ENCODE is valid here, and begin accepting items in the - list. */ - -void -ffestc_V023_start () -{ - ffestc_check_start_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_branch_begin_ (); - - if (!ffestc_subr_is_branch_ - (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR])) - { - ffestc_ok_ = FALSE; - return; - } - - ffestd_V023_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_V023_item -- ENCODE statement i/o item - - ffestc_V023_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestc_V023_item (ffebld expr, ffelexToken expr_token) -{ - ffestc_check_item_ (); - if (!ffestc_ok_) - return; - - ffestd_V023_item (expr); -} - -/* ffestc_V023_finish -- ENCODE statement list complete - - ffestc_V023_finish(); - - Just wrap up any local activities. */ - -void -ffestc_V023_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_V023_finish (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_V024_start -- DECODE(...) statement list begin - - ffestc_V024_start(); - - Verify that DECODE is valid here, and begin accepting items in the - list. */ - -void -ffestc_V024_start () -{ - ffestc_check_start_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_branch_begin_ (); - - if (!ffestc_subr_is_branch_ - (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR])) - { - ffestc_ok_ = FALSE; - return; - } - - ffestd_V024_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_V024_item -- DECODE statement i/o item - - ffestc_V024_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestc_V024_item (ffebld expr, ffelexToken expr_token) -{ - ffestc_check_item_ (); - if (!ffestc_ok_) - return; - - ffestd_V024_item (expr); -} - -/* ffestc_V024_finish -- DECODE statement list complete - - ffestc_V024_finish(); - - Just wrap up any local activities. */ - -void -ffestc_V024_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_V024_finish (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_V025_start -- DEFINEFILE statement list begin - - ffestc_V025_start(); - - Verify that DEFINEFILE is valid here, and begin accepting items in the - list. */ - -void -ffestc_V025_start () -{ - ffestc_check_start_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - { - ffestc_ok_ = FALSE; - return; - } - ffestc_labeldef_branch_begin_ (); - - ffestd_V025_start (); - - ffestc_ok_ = TRUE; -} - -/* ffestc_V025_item -- DEFINE FILE statement item - - ffestc_V025_item(u,ut,m,mt,n,nt,asv,asvt); - - Implement item. */ - -void -ffestc_V025_item (ffebld u, ffelexToken ut, ffebld m, ffelexToken mt, - ffebld n, ffelexToken nt, ffebld asv, ffelexToken asvt) -{ - ffestc_check_item_ (); - if (!ffestc_ok_) - return; - - ffestd_V025_item (u, m, n, asv); -} - -/* ffestc_V025_finish -- DEFINE FILE statement list complete - - ffestc_V025_finish(); - - Just wrap up any local activities. */ - -void -ffestc_V025_finish () -{ - ffestc_check_finish_ (); - if (!ffestc_ok_) - return; - - ffestd_V025_finish (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -/* ffestc_V026 -- FIND statement - - ffestc_V026(); - - Make sure a FIND is valid in the current context, and implement it. */ - -void -ffestc_V026 () -{ - ffestc_check_simple_ (); - if (ffestc_order_actionif_ () != FFESTC_orderOK_) - return; - ffestc_labeldef_branch_begin_ (); - - if (ffestc_subr_is_branch_ - (&ffestp_file.find.find_spec[FFESTP_findixERR]) - && ffestc_subr_is_present_ ("UNIT", - &ffestp_file.find.find_spec[FFESTP_findixUNIT]) - && ffestc_subr_is_present_ ("REC", - &ffestp_file.find.find_spec[FFESTP_findixREC])) - ffestd_V026 (); - - if (ffestc_shriek_after1_ != NULL) - (*ffestc_shriek_after1_) (TRUE); - ffestc_labeldef_branch_end_ (); -} - -#endif /* ffestc_V027_start -- VXT PARAMETER statement list begin ffestc_V027_start(); @@ -13823,7 +10389,7 @@ ffestc_V026 () Verify that PARAMETER is valid here, and begin accepting items in the list. */ void -ffestc_V027_start () +ffestc_V027_start (void) { ffestc_check_start_ (); if (ffestc_order_parameter_ () != FFESTC_orderOK_) @@ -13863,7 +10429,7 @@ ffestc_V027_item (ffelexToken dest_token, ffebld source, Just wrap up any local activities. */ void -ffestc_V027_finish () +ffestc_V027_finish (void) { ffestc_check_finish_ (); if (!ffestc_ok_) @@ -13876,7 +10442,7 @@ ffestc_V027_finish () like the statement for a logical IF are reset. */ void -ffestc_any () +ffestc_any (void) { ffestc_check_simple_ (); diff --git a/contrib/gcc/f/stc.h b/contrib/gcc/f/stc.h index 8b2f7c3..37feba6 100644 --- a/contrib/gcc/f/stc.h +++ b/contrib/gcc/f/stc.h @@ -1,5 +1,5 @@ /* stc.h -- Private #include File (module.h template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -77,36 +77,8 @@ void ffestc_init_4 (void); bool ffestc_is_decl_not_R1219 (void); bool ffestc_is_entry_in_subr (void); bool ffestc_is_let_not_V027 (void); -#if FFESTR_F90 -void ffestc_let (ffebld dest, ffebld source, ffelexToken source_token); -#else #define ffestc_let ffestc_R737 -#endif -#if FFESTR_F90 -void ffestc_module (ffelexToken module_name, ffelexToken procedure_name); -#endif -#if FFESTR_F90 -void ffestc_private (void); -#endif void ffestc_terminate_4 (void); -#if FFESTR_F90 -void ffestc_R423A (void); -void ffestc_R423B (void); -void ffestc_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name); -void ffestc_R425 (ffelexToken name); -void ffestc_R426_start (ffestpType type, ffelexToken typet, ffebld kind, - ffelexToken kindt, ffebld len, ffelexToken lent); -void ffestc_R426_attrib (ffestpAttrib attrib, ffelexToken attribt, - ffestrOther intent_kw, ffesttDimList dims); -void ffestc_R426_item (ffelexToken name, ffebld kind, ffelexToken kindt, - ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init, - ffelexToken initt, bool clist); -void ffestc_R426_itemstartvals (void); -void ffestc_R426_itemvalue (ffebld repeat, ffelexToken repeat_token, - ffebld value, ffelexToken value_token); -void ffestc_R426_itemendvals (ffelexToken t); -void ffestc_R426_finish (void); -#endif void ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind, ffelexToken kindt, ffebld len, ffelexToken lent); void ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt, @@ -119,22 +91,6 @@ void ffestc_R501_itemvalue (ffebld repeat, ffelexToken repeat_token, ffebld value, ffelexToken value_token); void ffestc_R501_itemendvals (ffelexToken t); void ffestc_R501_finish (void); -#if FFESTR_F90 -void ffestc_R519_start (ffelexToken intent, ffestrOther intent_kw); -void ffestc_R519_item (ffelexToken name); -void ffestc_R519_finish (void); -void ffestc_R520_start (void); -void ffestc_R520_item (ffelexToken name); -void ffestc_R520_finish (void); -void ffestc_R521A (void); -void ffestc_R521Astart (void); -void ffestc_R521Aitem (ffelexToken name); -void ffestc_R521Afinish (void); -void ffestc_R521B (void); -void ffestc_R521Bstart (void); -void ffestc_R521Bitem (ffelexToken name); -void ffestc_R521Bfinish (void); -#endif void ffestc_R522 (void); void ffestc_R522start (void); void ffestc_R522item_object (ffelexToken name); @@ -143,17 +99,6 @@ void ffestc_R522finish (void); void ffestc_R524_start (bool virtual); void ffestc_R524_item (ffelexToken name, ffesttDimList dims); void ffestc_R524_finish (void); -#if FFESTR_F90 -void ffestc_R525_start (void); -void ffestc_R525_item (ffelexToken name, ffesttDimList dims); -void ffestc_R525_finish (void); -void ffestc_R526_start (void); -void ffestc_R526_item (ffelexToken name, ffesttDimList dims); -void ffestc_R526_finish (void); -void ffestc_R527_start (void); -void ffestc_R527_item (ffelexToken name, ffesttDimList dims); -void ffestc_R527_finish (void); -#endif void ffestc_R528_start (void); void ffestc_R528_item_object (ffebld expr, ffelexToken expr_token); void ffestc_R528_item_startvals (void); @@ -181,21 +126,7 @@ void ffestc_R547_start (void); void ffestc_R547_item_object (ffelexToken name, ffesttDimList dims); void ffestc_R547_item_cblock (ffelexToken name); void ffestc_R547_finish (void); -#if FFESTR_F90 -void ffestc_R620 (ffesttExprList objects, ffebld stat, - ffelexToken stat_token); -void ffestc_R624 (ffesttExprList pointers); -void ffestc_R625 (ffesttExprList objects, ffebld stat, - ffelexToken stat_token); -#endif void ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token); -#if FFESTR_F90 -void ffestc_R738 (ffebld dest, ffebld source, ffelexToken source_token); -void ffestc_R740 (ffebld expr, ffelexToken expr_token); -void ffestc_R742 (ffebld expr, ffelexToken expr_token); -void ffestc_R744 (void); -void ffestc_R745 (void); -#endif void ffestc_R803 (ffelexToken construct_name, ffebld expr, ffelexToken expr_token); void ffestc_R804 (ffebld expr, ffelexToken expr_token, ffelexToken name); @@ -251,22 +182,8 @@ void ffestc_R923B_finish (void); void ffestc_R1001 (ffesttFormatList f); void ffestc_R1102 (ffelexToken name); void ffestc_R1103 (ffelexToken name); -#if FFESTR_F90 -void ffestc_R1105 (ffelexToken name); -void ffestc_R1106 (ffelexToken name); -void ffestc_R1107_start (ffelexToken name, bool only); -void ffestc_R1107_item (ffelexToken local, ffelexToken use); -void ffestc_R1107_finish (void); -#endif void ffestc_R1111 (ffelexToken name); void ffestc_R1112 (ffelexToken name); -#if FFESTR_F90 -void ffestc_R1202 (ffestpDefinedOperator operator, ffelexToken name); -void ffestc_R1203 (void); -void ffestc_R1205_start (void); -void ffestc_R1205_item (ffelexToken name); -void ffestc_R1205_finish (void); -#endif void ffestc_R1207_start (void); void ffestc_R1207_item (ffelexToken name); void ffestc_R1207_finish (void); @@ -274,9 +191,6 @@ void ffestc_R1208_start (void); void ffestc_R1208_item (ffelexToken name); void ffestc_R1208_finish (void); void ffestc_R1212 (ffebld expr, ffelexToken expr_token); -#if FFESTR_F90 -void ffestc_R1213 (ffebld dest, ffebld source, ffelexToken source_token); -#endif void ffestc_R1219 (ffelexToken funcname, ffesttTokenList args, ffelexToken final, ffestpType type, ffebld kind, ffelexToken kindt, ffebld len, ffelexToken lent, ffelexToken recursive, ffelexToken result); @@ -287,57 +201,17 @@ void ffestc_R1225 (ffelexToken name); void ffestc_R1226 (ffelexToken entryname, ffesttTokenList args, ffelexToken final); void ffestc_R1227 (ffebld expr, ffelexToken expr_token); -#if FFESTR_F90 -void ffestc_R1228 (void); -#endif void ffestc_R1229_start (ffelexToken name, ffesttTokenList args, ffelexToken final); void ffestc_R1229_finish (ffebld expr, ffelexToken expr_token); void ffestc_S3P4 (ffebld filename, ffelexToken filename_token); -#if FFESTR_VXT -void ffestc_V003_start (ffelexToken structure_name); -void ffestc_V003_item (ffelexToken name, ffesttDimList dims); -void ffestc_V003_finish (void); -void ffestc_V004 (void); -void ffestc_V009 (void); -void ffestc_V010 (void); -void ffestc_V012 (void); -void ffestc_V013 (void); -#endif void ffestc_V014_start (void); void ffestc_V014_item_object (ffelexToken name); void ffestc_V014_item_cblock (ffelexToken name); void ffestc_V014_finish (void); -#if FFESTR_VXT -void ffestc_V016_start (void); -void ffestc_V016_item_structure (ffelexToken name); -void ffestc_V016_item_object (ffelexToken name, ffesttDimList dims); -void ffestc_V016_finish (void); -void ffestc_V018_start (void); -void ffestc_V018_item (ffebld expr, ffelexToken expr_token); -void ffestc_V018_finish (void); -void ffestc_V019_start (void); -void ffestc_V019_item (ffebld expr, ffelexToken expr_token); -void ffestc_V019_finish (void); -#endif void ffestc_V020_start (void); void ffestc_V020_item (ffebld expr, ffelexToken expr_token); void ffestc_V020_finish (void); -#if FFESTR_VXT -void ffestc_V021 (void); -void ffestc_V022 (void); -void ffestc_V023_start (void); -void ffestc_V023_item (ffebld expr, ffelexToken expr_token); -void ffestc_V023_finish (void); -void ffestc_V024_start (void); -void ffestc_V024_item (ffebld expr, ffelexToken expr_token); -void ffestc_V024_finish (void); -void ffestc_V025_start (void); -void ffestc_V025_item (ffebld u, ffelexToken ut, ffebld m, ffelexToken mt, - ffebld n, ffelexToken nt, ffebld asv, ffelexToken asvt); -void ffestc_V025_finish (void); -void ffestc_V026 (void); -#endif void ffestc_V027_start (void); void ffestc_V027_item (ffelexToken dest_token, ffebld source, ffelexToken source_token); diff --git a/contrib/gcc/f/std.c b/contrib/gcc/f/std.c index bd2add2..09f0419 100644 --- a/contrib/gcc/f/std.c +++ b/contrib/gcc/f/std.c @@ -1,5 +1,5 @@ /* std.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 2000, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2000, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -115,21 +115,7 @@ typedef enum FFESTD_stmtidR1225_, /* END_SUBROUTINE */ FFESTD_stmtidR1226_, /* ENTRY */ FFESTD_stmtidR1227_, /* RETURN */ -#if FFESTR_VXT - FFESTD_stmtidV018_, /* REWRITE */ - FFESTD_stmtidV019_, /* ACCEPT */ -#endif FFESTD_stmtidV020_, /* TYPE */ -#if FFESTR_VXT - FFESTD_stmtidV021_, /* DELETE */ - FFESTD_stmtidV022_, /* UNLOCK */ - FFESTD_stmtidV023_, /* ENCODE */ - FFESTD_stmtidV024_, /* DECODE */ - FFESTD_stmtidV025start_, /* DEFINEFILE (start) */ - FFESTD_stmtidV025item_, /* (DEFINEFILE item) */ - FFESTD_stmtidV025finish_, /* (DEFINEFILE finish) */ - FFESTD_stmtidV026_, /* FIND */ -#endif FFESTD_stmtid_, } ffestdStmtId_; @@ -407,24 +393,6 @@ struct _ffestd_stmt_ ffebld expr; } R1227; -#if FFESTR_VXT - struct - { - mallocPool pool; - ffestpRewriteStmt *params; - ffestvFormat format; - ffestdExprItem_ list; - } - V018; - struct - { - mallocPool pool; - ffestpAcceptStmt *params; - ffestvFormat format; - ffestdExprItem_ list; - } - V019; -#endif struct { mallocPool pool; @@ -433,52 +401,6 @@ struct _ffestd_stmt_ ffestdExprItem_ list; } V020; -#if FFESTR_VXT - struct - { - mallocPool pool; - ffestpDeleteStmt *params; - } - V021; - struct - { - mallocPool pool; - ffestpBeruStmt *params; - } - V022; - struct - { - mallocPool pool; - ffestpVxtcodeStmt *params; - ffestdExprItem_ list; - } - V023; - struct - { - mallocPool pool; - ffestpVxtcodeStmt *params; - ffestdExprItem_ list; - } - V024; - struct - { - ffebld u; - ffebld m; - ffebld n; - ffebld asv; - } - V025item; - struct - { - mallocPool pool; - } V025finish; - struct - { - mallocPool pool; - ffestpFindStmt *params; - } - V026; -#endif } u; }; @@ -513,9 +435,6 @@ static void ffestd_stmt_pass_ (void); static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max); #endif static void ffestd_subr_vxt_ (void); -#if FFESTR_F90 -static void ffestd_subr_f90_ (void); -#endif static void ffestd_subr_labels_ (bool unexpected); static void ffestd_R1001dump_ (ffests s, ffesttFormatList list); static void ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, @@ -532,8 +451,6 @@ static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, const char *string); static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, const char *string); -static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, - const char *string); static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, const char *string); static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, @@ -638,7 +555,7 @@ ffestd_stmt_new_ (ffestdStmtId_ id) ffestd_stmt_pass_(); */ static void -ffestd_stmt_pass_ () +ffestd_stmt_pass_ (void) { ffestdStmt_ stmt; ffestdExprItem_ expr; /* For traversing lists. */ @@ -1028,36 +945,6 @@ ffestd_stmt_pass_ () malloc_pool_kill (stmt->u.R1227.pool); break; -#if FFESTR_VXT - case FFESTD_stmtidV018_: - ffestd_subr_line_restore_ (stmt); - if (okay) - ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format); - for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next) - { - if (okay) - ffeste_V018_item (expr->expr); - } - if (okay) - ffeste_V018_finish (); - malloc_pool_kill (stmt->u.V018.pool); - break; - - case FFESTD_stmtidV019_: - ffestd_subr_line_restore_ (stmt); - if (okay) - ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format); - for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next) - { - if (okay) - ffeste_V019_item (expr->expr); - } - if (okay) - ffeste_V019_finish (); - malloc_pool_kill (stmt->u.V019.pool); - break; -#endif - case FFESTD_stmtidV020_: ffestd_subr_line_restore_ (stmt); if (okay) @@ -1072,68 +959,6 @@ ffestd_stmt_pass_ () malloc_pool_kill (stmt->u.V020.pool); break; -#if FFESTR_VXT - case FFESTD_stmtidV021_: - ffestd_subr_line_restore_ (stmt); - if (okay) - ffeste_V021 (stmt->u.V021.params); - malloc_pool_kill (stmt->u.V021.pool); - break; - - case FFESTD_stmtidV023_: - ffestd_subr_line_restore_ (stmt); - if (okay) - ffeste_V023_start (stmt->u.V023.params); - for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next) - { - if (okay) - ffeste_V023_item (expr->expr); - } - if (okay) - ffeste_V023_finish (); - malloc_pool_kill (stmt->u.V023.pool); - break; - - case FFESTD_stmtidV024_: - ffestd_subr_line_restore_ (stmt); - if (okay) - ffeste_V024_start (stmt->u.V024.params); - for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next) - { - if (okay) - ffeste_V024_item (expr->expr); - } - if (okay) - ffeste_V024_finish (); - malloc_pool_kill (stmt->u.V024.pool); - break; - - case FFESTD_stmtidV025start_: - ffestd_subr_line_restore_ (stmt); - if (okay) - ffeste_V025_start (); - break; - - case FFESTD_stmtidV025item_: - if (okay) - ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m, - stmt->u.V025item.n, stmt->u.V025item.asv); - break; - - case FFESTD_stmtidV025finish_: - if (okay) - ffeste_V025_finish (); - malloc_pool_kill (stmt->u.V025finish.pool); - break; - - case FFESTD_stmtidV026_: - ffestd_subr_line_restore_ (stmt); - if (okay) - ffeste_V026 (stmt->u.V026.params); - malloc_pool_kill (stmt->u.V026.pool); - break; -#endif - default: assert ("bad stmt->id" == NULL); break; @@ -1159,8 +984,8 @@ ffestd_subr_copy_easy_ (ffestpInquireIx max) ffestpInquireStmt *stmt; ffestpInquireIx ix; - stmt = (ffestpInquireStmt *) malloc_new_kp (ffesta_output_pool, - "FFESTD easy", sizeof (ffestpFile) * max); + stmt = malloc_new_kp (ffesta_output_pool, "FFESTD easy", + sizeof (ffestpFile) * max); for (ix = 0; ix < max; ++ix) { @@ -1272,27 +1097,12 @@ ffestd_subr_labels_ (bool unexpected) assert (undef == 0); } -/* ffestd_subr_f90_ -- Report error about lack of full F90 support - - ffestd_subr_f90_(); */ - -#if FFESTR_F90 -static void -ffestd_subr_f90_ () -{ - ffebad_start (FFEBAD_F90); - ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), - ffelex_token_where_column (ffesta_tokens[0])); - ffebad_finish (); -} - -#endif /* ffestd_subr_vxt_ -- Report error about lack of full VXT support ffestd_subr_vxt_(); */ static void -ffestd_subr_vxt_ () +ffestd_subr_vxt_ (void) { ffebad_start (FFEBAD_VXT_UNSUPPORTED); ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), @@ -1311,7 +1121,7 @@ ffestd_subr_vxt_ () handling them as a single block rather than one statement at a time). */ void -ffestd_begin_uses () +ffestd_begin_uses (void) { } @@ -1339,30 +1149,6 @@ ffestd_do (bool ok UNUSED) assert (ffestd_block_level_ >= 0); } -/* ffestd_end_uses -- End a bunch of USE statements - - ffestd_end_uses(TRUE); - - ok==TRUE means simply not popping due to ffestd_eof_() - being called, because there is no formal END USES statement in Fortran. */ - -#if FFESTR_F90 -void -ffestd_end_uses (bool ok) -{ -} - -/* ffestd_end_R740 -- End a WHERE(-THEN) - - ffestd_end_R740(TRUE); */ - -void -ffestd_end_R740 (bool ok) -{ - return; /* F90. */ -} - -#endif /* ffestd_end_R807 -- End of statement following logical IF ffestd_end_R807(TRUE); @@ -1391,7 +1177,7 @@ ffestd_end_R807 (bool ok UNUSED) ffestd_exec_begin(); */ void -ffestd_exec_begin () +ffestd_exec_begin (void) { ffecom_exec_transition (); @@ -1423,10 +1209,9 @@ ffestd_exec_begin () ffestd_exec_end(); */ void -ffestd_exec_end () +ffestd_exec_end (void) { - int old_lineno = lineno; - const char *old_input_filename = input_filename; + location_t old_loc = input_location; ffecom_end_transition (); @@ -1458,8 +1243,7 @@ ffestd_exec_end () ffestd_stmt_list_.last = NULL; ffestd_2pass_entrypoints_ = 0; - lineno = old_lineno; - input_filename = old_input_filename; + input_location = old_loc; } /* ffestd_init_3 -- Initialize for any program unit @@ -1467,7 +1251,7 @@ ffestd_exec_end () ffestd_init_3(); */ void -ffestd_init_3 () +ffestd_init_3 (void) { ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first; ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first; @@ -1521,353 +1305,6 @@ ffestd_labeldef_useless (ffelab label UNUSED) { } -/* ffestd_R423A -- PRIVATE statement (in R422 derived-type statement) - - ffestd_R423A(); */ - -#if FFESTR_F90 -void -ffestd_R423A () -{ - ffestd_check_simple_ (); -} - -/* ffestd_R423B -- SEQUENCE statement (in R422 derived-type-stmt) - - ffestd_R423B(); */ - -void -ffestd_R423B () -{ - ffestd_check_simple_ (); -} - -/* ffestd_R424 -- derived-TYPE-def statement - - ffestd_R424(access_token,access_kw,name_token); - - Handle a derived-type definition. */ - -void -ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - char *a; - - if (access == NULL) - fprintf (dmpout, "* TYPE %s\n", ffelex_token_text (name)); - else - { - switch (access_kw) - { - case FFESTR_otherPUBLIC: - a = "PUBLIC"; - break; - - case FFESTR_otherPRIVATE: - a = "PRIVATE"; - break; - - default: - assert (FALSE); - } - fprintf (dmpout, "* TYPE,%s: %s\n", a, ffelex_token_text (name)); - } -#endif -} - -/* ffestd_R425 -- End a TYPE - - ffestd_R425(TRUE); */ - -void -ffestd_R425 (bool ok) -{ -} - -/* ffestd_R519_start -- INTENT statement list begin - - ffestd_R519_start(); - - Verify that INTENT is valid here, and begin accepting items in the list. */ - -void -ffestd_R519_start (ffestrOther intent_kw) -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - char *a; - - switch (intent_kw) - { - case FFESTR_otherIN: - a = "IN"; - break; - - case FFESTR_otherOUT: - a = "OUT"; - break; - - case FFESTR_otherINOUT: - a = "INOUT"; - break; - - default: - assert (FALSE); - } - fprintf (dmpout, "* INTENT (%s) ", a); -#endif -} - -/* ffestd_R519_item -- INTENT statement for name - - ffestd_R519_item(name_token); - - Make sure name_token identifies a valid object to be INTENTed. */ - -void -ffestd_R519_item (ffelexToken name) -{ - ffestd_check_item_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#endif -} - -/* ffestd_R519_finish -- INTENT statement list complete - - ffestd_R519_finish(); - - Just wrap up any local activities. */ - -void -ffestd_R519_finish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -/* ffestd_R520_start -- OPTIONAL statement list begin - - ffestd_R520_start(); - - Verify that OPTIONAL is valid here, and begin accepting items in the list. */ - -void -ffestd_R520_start () -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* OPTIONAL ", dmpout); -#endif -} - -/* ffestd_R520_item -- OPTIONAL statement for name - - ffestd_R520_item(name_token); - - Make sure name_token identifies a valid object to be OPTIONALed. */ - -void -ffestd_R520_item (ffelexToken name) -{ - ffestd_check_item_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#endif -} - -/* ffestd_R520_finish -- OPTIONAL statement list complete - - ffestd_R520_finish(); - - Just wrap up any local activities. */ - -void -ffestd_R520_finish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -/* ffestd_R521A -- PUBLIC statement - - ffestd_R521A(); - - Verify that PUBLIC is valid here. */ - -void -ffestd_R521A () -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* PUBLIC\n", dmpout); -#endif -} - -/* ffestd_R521Astart -- PUBLIC statement list begin - - ffestd_R521Astart(); - - Verify that PUBLIC is valid here, and begin accepting items in the list. */ - -void -ffestd_R521Astart () -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* PUBLIC ", dmpout); -#endif -} - -/* ffestd_R521Aitem -- PUBLIC statement for name - - ffestd_R521Aitem(name_token); - - Make sure name_token identifies a valid object to be PUBLICed. */ - -void -ffestd_R521Aitem (ffelexToken name) -{ - ffestd_check_item_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#endif -} - -/* ffestd_R521Afinish -- PUBLIC statement list complete - - ffestd_R521Afinish(); - - Just wrap up any local activities. */ - -void -ffestd_R521Afinish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -/* ffestd_R521B -- PRIVATE statement - - ffestd_R521B(); - - Verify that PRIVATE is valid here (outside a derived-type statement). */ - -void -ffestd_R521B () -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* PRIVATE_outside_of_R422_derived_type_def\n", dmpout); -#endif -} - -/* ffestd_R521Bstart -- PRIVATE statement list begin - - ffestd_R521Bstart(); - - Verify that PRIVATE is valid here, and begin accepting items in the list. */ - -void -ffestd_R521Bstart () -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* PRIVATE ", dmpout); -#endif -} - -/* ffestd_R521Bitem -- PRIVATE statement for name - - ffestd_R521Bitem(name_token); - - Make sure name_token identifies a valid object to be PRIVATEed. */ - -void -ffestd_R521Bitem (ffelexToken name) -{ - ffestd_check_item_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#endif -} - -/* ffestd_R521Bfinish -- PRIVATE statement list complete - - ffestd_R521Bfinish(); - - Just wrap up any local activities. */ - -void -ffestd_R521Bfinish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -#endif /* ffestd_R522 -- SAVE statement with no list ffestd_R522(); @@ -1875,7 +1312,7 @@ ffestd_R521Bfinish () Verify that SAVE is valid here, and flag everything as SAVEd. */ void -ffestd_R522 () +ffestd_R522 (void) { ffestd_check_simple_ (); } @@ -1887,7 +1324,7 @@ ffestd_R522 () Verify that SAVE is valid here, and begin accepting items in the list. */ void -ffestd_R522start () +ffestd_R522start (void) { ffestd_check_start_ (); } @@ -1923,7 +1360,7 @@ ffestd_R522item_cblock (ffelexToken name UNUSED) Just wrap up any local activities. */ void -ffestd_R522finish () +ffestd_R522finish (void) { ffestd_check_finish_ (); } @@ -1959,202 +1396,11 @@ ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED) Just wrap up any local activities. */ void -ffestd_R524_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_R525_start -- ALLOCATABLE statement list begin - - ffestd_R525_start(); - - Verify that ALLOCATABLE is valid here, and begin accepting items in the - list. */ - -#if FFESTR_F90 -void -ffestd_R525_start () -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* ALLOCATABLE ", dmpout); -#endif -} - -/* ffestd_R525_item -- ALLOCATABLE statement for object-name - - ffestd_R525_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be ALLOCATABLEd. */ - -void -ffestd_R525_item (ffelexToken name, ffesttDimList dims) -{ - ffestd_check_item_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs (ffelex_token_text (name), dmpout); - if (dims != NULL) - { - fputc ('(', dmpout); - ffestt_dimlist_dump (dims); - fputc (')', dmpout); - } - fputc (',', dmpout); -#endif -} - -/* ffestd_R525_finish -- ALLOCATABLE statement list complete - - ffestd_R525_finish(); - - Just wrap up any local activities. */ - -void -ffestd_R525_finish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -/* ffestd_R526_start -- POINTER statement list begin - - ffestd_R526_start(); - - Verify that POINTER is valid here, and begin accepting items in the - list. */ - -void -ffestd_R526_start () -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* POINTER ", dmpout); -#endif -} - -/* ffestd_R526_item -- POINTER statement for object-name - - ffestd_R526_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be POINTERd. */ - -void -ffestd_R526_item (ffelexToken name, ffesttDimList dims) -{ - ffestd_check_item_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs (ffelex_token_text (name), dmpout); - if (dims != NULL) - { - fputc ('(', dmpout); - ffestt_dimlist_dump (dims); - fputc (')', dmpout); - } - fputc (',', dmpout); -#endif -} - -/* ffestd_R526_finish -- POINTER statement list complete - - ffestd_R526_finish(); - - Just wrap up any local activities. */ - -void -ffestd_R526_finish () +ffestd_R524_finish (void) { ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif } -/* ffestd_R527_start -- TARGET statement list begin - - ffestd_R527_start(); - - Verify that TARGET is valid here, and begin accepting items in the - list. */ - -void -ffestd_R527_start () -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("* TARGET ", dmpout); -#endif -} - -/* ffestd_R527_item -- TARGET statement for object-name - - ffestd_R527_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be TARGETd. */ - -void -ffestd_R527_item (ffelexToken name, ffesttDimList dims) -{ - ffestd_check_item_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs (ffelex_token_text (name), dmpout); - if (dims != NULL) - { - fputc ('(', dmpout); - ffestt_dimlist_dump (dims); - fputc (')', dmpout); - } - fputc (',', dmpout); -#endif -} - -/* ffestd_R527_finish -- TARGET statement list complete - - ffestd_R527_finish(); - - Just wrap up any local activities. */ - -void -ffestd_R527_finish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -#endif /* ffestd_R537_start -- PARAMETER statement list begin ffestd_R537_start(); @@ -2162,7 +1408,7 @@ ffestd_R527_finish () Verify that PARAMETER is valid here, and begin accepting items in the list. */ void -ffestd_R537_start () +ffestd_R537_start (void) { ffestd_check_start_ (); } @@ -2187,7 +1433,7 @@ ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED) Just wrap up any local activities. */ void -ffestd_R537_finish () +ffestd_R537_finish (void) { ffestd_check_finish_ (); } @@ -2199,7 +1445,7 @@ ffestd_R537_finish () Verify that the IMPLICIT NONE statement is ok here and implement. */ void -ffestd_R539 () +ffestd_R539 (void) { ffestd_check_simple_ (); } @@ -2211,7 +1457,7 @@ ffestd_R539 () Verify that the IMPLICIT statement is ok here and implement. */ void -ffestd_R539start () +ffestd_R539start (void) { ffestd_check_start_ (); } @@ -2237,7 +1483,7 @@ ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED, Finish up any local activities. */ void -ffestd_R539finish () +ffestd_R539finish (void) { ffestd_check_finish_ (); } @@ -2249,7 +1495,7 @@ ffestd_R539finish () Verify that NAMELIST is valid here, and begin accepting items in the list. */ void -ffestd_R542_start () +ffestd_R542_start (void) { ffestd_check_start_ (); } @@ -2285,54 +1531,11 @@ ffestd_R542_item_nitem (ffelexToken name UNUSED) Just wrap up any local activities. */ void -ffestd_R542_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_R544_start -- EQUIVALENCE statement list begin - - ffestd_R544_start(); - - Verify that EQUIVALENCE is valid here, and begin accepting items in the - list. */ - -#if 0 -void -ffestd_R544_start () -{ - ffestd_check_start_ (); -} - -#endif -/* ffestd_R544_item -- EQUIVALENCE statement assignment - - ffestd_R544_item(exprlist); - - Make sure the equivalence is valid, then implement it. */ - -#if 0 -void -ffestd_R544_item (ffesttExprList exprlist) -{ - ffestd_check_item_ (); -} - -#endif -/* ffestd_R544_finish -- EQUIVALENCE statement list complete - - ffestd_R544_finish(); - - Just wrap up any local activities. */ - -#if 0 -void -ffestd_R544_finish () +ffestd_R542_finish (void) { ffestd_check_finish_ (); } -#endif /* ffestd_R547_start -- COMMON statement list begin ffestd_R547_start(); @@ -2340,7 +1543,7 @@ ffestd_R544_finish () Verify that COMMON is valid here, and begin accepting items in the list. */ void -ffestd_R547_start () +ffestd_R547_start (void) { ffestd_check_start_ (); } @@ -2377,63 +1580,11 @@ ffestd_R547_item_cblock (ffelexToken name UNUSED) Just wrap up any local activities. */ void -ffestd_R547_finish () +ffestd_R547_finish (void) { ffestd_check_finish_ (); } -/* ffestd_R620 -- ALLOCATE statement - - ffestd_R620(exprlist,stat,stat_token); - - Make sure the expression list is valid, then implement it. */ - -#if FFESTR_F90 -void -ffestd_R620 (ffesttExprList exprlist, ffebld stat) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); -} - -/* ffestd_R624 -- NULLIFY statement - - ffestd_R624(pointer_name_list); - - Make sure pointer_name_list identifies valid pointers for a NULLIFY. */ - -void -ffestd_R624 (ffesttExprList pointers) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("+ NULLIFY (", dmpout); - assert (pointers != NULL); - ffestt_exprlist_dump (pointers); - fputs (")\n", dmpout); -#endif -} - -/* ffestd_R625 -- DEALLOCATE statement - - ffestd_R625(exprlist,stat,stat_token); - - Make sure the equivalence is valid, then implement it. */ - -void -ffestd_R625 (ffesttExprList exprlist, ffebld stat) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); -} - -#endif /* ffestd_R737A -- Assignment statement outside of WHERE ffestd_R737A(dest_expr,source_expr); */ @@ -2454,94 +1605,6 @@ ffestd_R737A (ffebld dest, ffebld source) ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } -/* ffestd_R737B -- Assignment statement inside of WHERE - - ffestd_R737B(dest_expr,source_expr); */ - -#if FFESTR_F90 -void -ffestd_R737B (ffebld dest, ffebld source) -{ - ffestd_check_simple_ (); -} - -/* ffestd_R738 -- Pointer assignment statement - - ffestd_R738(dest_expr,source_expr,source_token); - - Make sure the assignment is valid. */ - -void -ffestd_R738 (ffebld dest, ffebld source) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); -} - -/* ffestd_R740 -- WHERE statement - - ffestd_R740(expr,expr_token); - - Make sure statement is valid here; implement. */ - -void -ffestd_R740 (ffebld expr) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); -} - -/* ffestd_R742 -- WHERE-construct statement - - ffestd_R742(expr,expr_token); - - Make sure statement is valid here; implement. */ - -void -ffestd_R742 (ffebld expr) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); -} - -/* ffestd_R744 -- ELSE WHERE statement - - ffestd_R744(); - - Make sure ffestd_kind_ identifies a WHERE block. - Implement the ELSE of the current WHERE block. */ - -void -ffestd_R744 () -{ - ffestd_check_simple_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs ("+ ELSE_WHERE\n", dmpout); -#endif -} - -/* ffestd_R745 -- Implicit END WHERE statement. */ - -void -ffestd_R745 (bool ok) -{ - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs ("+ END_WHERE\n", dmpout); /* Also see ffestd_R745. */ - - --ffestd_block_level_; - assert (ffestd_block_level_ >= 0); -#endif -} - -#endif /* Block IF (IF-THEN) statement. */ @@ -3033,7 +2096,7 @@ ffestd_R843 (ffebld expr) Make sure an OPEN is valid in the current context, and implement it. */ void -ffestd_R904 () +ffestd_R904 (void) { ffestdStmt_ stmt; @@ -3088,7 +2151,7 @@ ffestd_R904 () Make sure a CLOSE is valid in the current context, and implement it. */ void -ffestd_R907 () +ffestd_R907 (void) { ffestdStmt_ stmt; @@ -3166,8 +2229,7 @@ ffestd_R909_item (ffebld expr, ffelexToken expr_token) ffestd_check_item_ (); - item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, - "ffestdExprItem_", sizeof (*item)); + item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item)); item->next = NULL; item->expr = expr; @@ -3183,7 +2245,7 @@ ffestd_R909_item (ffebld expr, ffelexToken expr_token) Just wrap up any local activities. */ void -ffestd_R909_finish () +ffestd_R909_finish (void) { ffestd_check_finish_ (); } @@ -3243,8 +2305,7 @@ ffestd_R910_item (ffebld expr, ffelexToken expr_token) ffestd_check_item_ (); - item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, - "ffestdExprItem_", sizeof (*item)); + item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item)); item->next = NULL; item->expr = expr; @@ -3260,7 +2321,7 @@ ffestd_R910_item (ffebld expr, ffelexToken expr_token) Just wrap up any local activities. */ void -ffestd_R910_finish () +ffestd_R910_finish (void) { ffestd_check_finish_ (); } @@ -3303,8 +2364,7 @@ ffestd_R911_item (ffebld expr, ffelexToken expr_token) ffestd_check_item_ (); - item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, - "ffestdExprItem_", sizeof (*item)); + item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item)); item->next = NULL; item->expr = expr; @@ -3320,7 +2380,7 @@ ffestd_R911_item (ffebld expr, ffelexToken expr_token) Just wrap up any local activities. */ void -ffestd_R911_finish () +ffestd_R911_finish (void) { ffestd_check_finish_ (); } @@ -3332,7 +2392,7 @@ ffestd_R911_finish () Make sure a BACKSPACE is valid in the current context, and implement it. */ void -ffestd_R919 () +ffestd_R919 (void) { ffestdStmt_ stmt; @@ -3353,7 +2413,7 @@ ffestd_R919 () Make sure a ENDFILE is valid in the current context, and implement it. */ void -ffestd_R920 () +ffestd_R920 (void) { ffestdStmt_ stmt; @@ -3374,7 +2434,7 @@ ffestd_R920 () Make sure a REWIND is valid in the current context, and implement it. */ void -ffestd_R921 () +ffestd_R921 (void) { ffestdStmt_ stmt; @@ -3443,7 +2503,7 @@ ffestd_R923A (bool by_file) list. */ void -ffestd_R923B_start () +ffestd_R923B_start (void) { ffestdStmt_ stmt; @@ -3472,8 +2532,7 @@ ffestd_R923B_item (ffebld expr) ffestd_check_item_ (); - item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, - "ffestdExprItem_", sizeof (*item)); + item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item)); item->next = NULL; item->expr = expr; @@ -3488,7 +2547,7 @@ ffestd_R923B_item (ffebld expr) Just wrap up any local activities. */ void -ffestd_R923B_finish () +ffestd_R923B_finish (void) { ffestd_check_finish_ (); } @@ -3608,7 +2667,7 @@ ffestd_R1001dump_ (ffests s, ffesttFormatList list) break; case FFESTP_formattypeX: - ffestd_R1001dump_1010_3_ (s, next, "X"); + ffestd_R1001dump_1010_2_ (s, next, "X"); break; case FFESTP_formattypeS: @@ -3914,26 +2973,6 @@ ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, const char *string) ffests_puts (s, string); } -/* ffestd_R1001dump_1010_3_ -- Dump a particular format - - ffesttFormatList f; - ffestd_R1001dump_1010_3_(f,"I"); - - The format is dumped with form nX. */ - -static void -ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, const char *string) -{ - assert (f->u.R1010.val.present); - - if (f->u.R1010.val.rtexpr) - ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr); - else - ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val); - - ffests_puts (s, string); -} - /* ffestd_R1001dump_1010_4_ -- Dump a particular format ffesttFormatList f; @@ -4078,114 +3117,6 @@ ffestd_R1103 (bool ok UNUSED) ffestd_stmt_append_ (stmt); } -/* ffestd_R1105 -- MODULE statement - - ffestd_R1105(name_token); - - Make sure ffestd_kind_ identifies an empty block. Make sure name_token - gives a valid name. Implement the beginning of a module. */ - -#if FFESTR_F90 -void -ffestd_R1105 (ffelexToken name) -{ - assert (ffestd_block_level_ == 0); - - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fprintf (dmpout, "* MODULE %s\n", ffelex_token_text (name)); -#endif -} - -/* ffestd_R1106 -- End a MODULE - - ffestd_R1106(TRUE); */ - -void -ffestd_R1106 (bool ok) -{ - assert (ffestd_block_level_ == 0); - - /* Generate any wrap-up code here (unlikely in MODULE!). */ - - if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE5) - ffestd_subr_labels_ (TRUE); /* Handle any undefined labels (unlikely). */ - - return; /* F90. */ - -#ifdef FFESTD_F90 - fprintf (dmpout, "< END_MODULE %s\n", - ffelex_token_text (ffestw_name (ffestw_stack_top ()))); -#endif -} - -/* ffestd_R1107_start -- USE statement list begin - - ffestd_R1107_start(); - - Verify that USE is valid here, and begin accepting items in the list. */ - -void -ffestd_R1107_start (ffelexToken name, bool only) -{ - ffestd_check_start_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fprintf (dmpout, "* USE %s,", ffelex_token_text (name)); /* NB - _shriek_begin_uses_. */ - if (only) - fputs ("only: ", dmpout); -#endif -} - -/* ffestd_R1107_item -- USE statement for name - - ffestd_R1107_item(local_token,use_token); - - Make sure name_token identifies a valid object to be USEed. local_token - may be NULL if _start_ was called with only==TRUE. */ - -void -ffestd_R1107_item (ffelexToken local, ffelexToken use) -{ - ffestd_check_item_ (); - assert (use != NULL); - - return; /* F90. */ - -#ifdef FFESTD_F90 - if (local != NULL) - fprintf (dmpout, "%s=>", ffelex_token_text (local)); - fprintf (dmpout, "%s,", ffelex_token_text (use)); -#endif -} - -/* ffestd_R1107_finish -- USE statement list complete - - ffestd_R1107_finish(); - - Just wrap up any local activities. */ - -void -ffestd_R1107_finish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -#endif /* ffestd_R1111 -- BLOCK DATA statement ffestd_R1111(name_token); @@ -4226,190 +3157,6 @@ ffestd_R1112 (bool ok UNUSED) ffestd_stmt_append_ (stmt); } -/* ffestd_R1202 -- INTERFACE statement - - ffestd_R1202(operator,defined_name); - - Make sure ffestd_kind_ identifies an INTERFACE block. - Implement the end of the current interface. - - 06-Jun-90 JCB 1.1 - Allow no operator or name to mean INTERFACE by itself; missed this - valid form when originally doing syntactic analysis code. */ - -#if FFESTR_F90 -void -ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - switch (operator) - { - case FFESTP_definedoperatorNone: - if (name == NULL) - fputs ("* INTERFACE_unnamed\n", dmpout); - else - fprintf (dmpout, "* INTERFACE %s\n", ffelex_token_text (name)); - break; - - case FFESTP_definedoperatorOPERATOR: - fprintf (dmpout, "* INTERFACE_OPERATOR (.%s.)\n", ffelex_token_text (name)); - break; - - case FFESTP_definedoperatorASSIGNMENT: - fputs ("* INTERFACE_ASSIGNMENT (=)\n", dmpout); - break; - - case FFESTP_definedoperatorPOWER: - fputs ("* INTERFACE_OPERATOR (**)\n", dmpout); - break; - - case FFESTP_definedoperatorMULT: - fputs ("* INTERFACE_OPERATOR (*)\n", dmpout); - break; - - case FFESTP_definedoperatorADD: - fputs ("* INTERFACE_OPERATOR (+)\n", dmpout); - break; - - case FFESTP_definedoperatorCONCAT: - fputs ("* INTERFACE_OPERATOR (//)\n", dmpout); - break; - - case FFESTP_definedoperatorDIVIDE: - fputs ("* INTERFACE_OPERATOR (/)\n", dmpout); - break; - - case FFESTP_definedoperatorSUBTRACT: - fputs ("* INTERFACE_OPERATOR (-)\n", dmpout); - break; - - case FFESTP_definedoperatorNOT: - fputs ("* INTERFACE_OPERATOR (.not.)\n", dmpout); - break; - - case FFESTP_definedoperatorAND: - fputs ("* INTERFACE_OPERATOR (.and.)\n", dmpout); - break; - - case FFESTP_definedoperatorOR: - fputs ("* INTERFACE_OPERATOR (.or.)\n", dmpout); - break; - - case FFESTP_definedoperatorEQV: - fputs ("* INTERFACE_OPERATOR (.eqv.)\n", dmpout); - break; - - case FFESTP_definedoperatorNEQV: - fputs ("* INTERFACE_OPERATOR (.neqv.)\n", dmpout); - break; - - case FFESTP_definedoperatorEQ: - fputs ("* INTERFACE_OPERATOR (==)\n", dmpout); - break; - - case FFESTP_definedoperatorNE: - fputs ("* INTERFACE_OPERATOR (/=)\n", dmpout); - break; - - case FFESTP_definedoperatorLT: - fputs ("* INTERFACE_OPERATOR (<)\n", dmpout); - break; - - case FFESTP_definedoperatorLE: - fputs ("* INTERFACE_OPERATOR (<=)\n", dmpout); - break; - - case FFESTP_definedoperatorGT: - fputs ("* INTERFACE_OPERATOR (>)\n", dmpout); - break; - - case FFESTP_definedoperatorGE: - fputs ("* INTERFACE_OPERATOR (>=)\n", dmpout); - break; - - default: - assert (FALSE); - break; - } -#endif -} - -/* ffestd_R1203 -- End an INTERFACE - - ffestd_R1203(TRUE); */ - -void -ffestd_R1203 (bool ok) -{ - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs ("* END_INTERFACE\n", dmpout); -#endif -} - -/* ffestd_R1205_start -- MODULE PROCEDURE statement list begin - - ffestd_R1205_start(); - - Verify that MODULE PROCEDURE is valid here, and begin accepting items in - the list. */ - -void -ffestd_R1205_start () -{ - ffestd_check_start_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputs ("* MODULE_PROCEDURE ", dmpout); -#endif -} - -/* ffestd_R1205_item -- MODULE PROCEDURE statement for name - - ffestd_R1205_item(name_token); - - Make sure name_token identifies a valid object to be MODULE PROCEDUREed. */ - -void -ffestd_R1205_item (ffelexToken name) -{ - ffestd_check_item_ (); - assert (name != NULL); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fprintf (dmpout, "%s,", ffelex_token_text (name)); -#endif -} - -/* ffestd_R1205_finish -- MODULE PROCEDURE statement list complete - - ffestd_R1205_finish(); - - Just wrap up any local activities. */ - -void -ffestd_R1205_finish () -{ - ffestd_check_finish_ (); - - return; /* F90. */ - -#ifdef FFESTD_F90 - fputc ('\n', dmpout); -#endif -} - -#endif /* ffestd_R1207_start -- EXTERNAL statement list begin ffestd_R1207_start(); @@ -4417,7 +3164,7 @@ ffestd_R1205_finish () Verify that EXTERNAL is valid here, and begin accepting items in the list. */ void -ffestd_R1207_start () +ffestd_R1207_start (void) { ffestd_check_start_ (); } @@ -4442,7 +3189,7 @@ ffestd_R1207_item (ffelexToken name) Just wrap up any local activities. */ void -ffestd_R1207_finish () +ffestd_R1207_finish (void) { ffestd_check_finish_ (); } @@ -4454,7 +3201,7 @@ ffestd_R1207_finish () Verify that INTRINSIC is valid here, and begin accepting items in the list. */ void -ffestd_R1208_start () +ffestd_R1208_start (void) { ffestd_check_start_ (); } @@ -4479,7 +3226,7 @@ ffestd_R1208_item (ffelexToken name) Just wrap up any local activities. */ void -ffestd_R1208_finish () +ffestd_R1208_finish (void) { ffestd_check_finish_ (); } @@ -4505,22 +3252,6 @@ ffestd_R1212 (ffebld expr) ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE); } -/* ffestd_R1213 -- Defined assignment statement - - ffestd_R1213(dest_expr,source_expr,source_token); - - Make sure the assignment is valid. */ - -#if FFESTR_F90 -void -ffestd_R1213 (ffebld dest, ffebld source) -{ - ffestd_check_simple_ (); - - ffestd_subr_f90_ (); -} - -#endif /* ffestd_R1219 -- FUNCTION statement ffestd_R1219(funcname,arglist,ending_token,kind,kindt,len,lent, @@ -4667,33 +3398,6 @@ ffestd_R1227 (ffebld expr) ffestd_is_reachable_ = FALSE; } -/* ffestd_R1228 -- CONTAINS statement - - ffestd_R1228(); */ - -#if FFESTR_F90 -void -ffestd_R1228 () -{ - assert (ffestd_block_level_ == 0); - - ffestd_check_simple_ (); - - /* Generate RETURN/STOP code here */ - - ffestd_subr_labels_ (ffestw_state (ffestw_stack_top ()) - == FFESTV_stateMODULE5); /* Handle any undefined - labels. */ - - ffestd_subr_f90_ (); - return; - -#ifdef FFESTD_F90 - fputs ("- CONTAINS\n", dmpout); -#endif -} - -#endif /* ffestd_R1229_start -- STMTFUNCTION statement begin ffestd_R1229_start(func_name,func_arg_list,close_paren); @@ -4780,92 +3484,6 @@ ffestd_S3P4 (ffebld filename) } } -/* ffestd_V003_start -- STRUCTURE statement list begin - - ffestd_V003_start(structure_name); - - Verify that STRUCTURE is valid here, and begin accepting items in the list. */ - -#if FFESTR_VXT -void -ffestd_V003_start (ffelexToken structure_name) -{ - ffestd_check_start_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V003_item -- STRUCTURE statement for object-name - - ffestd_V003_item(name_token,dim_list); - - Make sure name_token identifies a valid object to be STRUCTUREd. */ - -void -ffestd_V003_item (ffelexToken name, ffesttDimList dims) -{ - ffestd_check_item_ (); -} - -/* ffestd_V003_finish -- STRUCTURE statement list complete - - ffestd_V003_finish(); - - Just wrap up any local activities. */ - -void -ffestd_V003_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_V004 -- End a STRUCTURE - - ffestd_V004(TRUE); */ - -void -ffestd_V004 (bool ok) -{ -} - -/* ffestd_V009 -- UNION statement - - ffestd_V009(); */ - -void -ffestd_V009 () -{ - ffestd_check_simple_ (); -} - -/* ffestd_V010 -- End a UNION - - ffestd_V010(TRUE); */ - -void -ffestd_V010 (bool ok) -{ -} - -/* ffestd_V012 -- MAP statement - - ffestd_V012(); */ - -void -ffestd_V012 () -{ - ffestd_check_simple_ (); -} - -/* ffestd_V013 -- End a MAP - - ffestd_V013(TRUE); */ - -void -ffestd_V013 (bool ok) -{ -} - -#endif /* ffestd_V014_start -- VOLATILE statement list begin ffestd_V014_start(); @@ -4873,7 +3491,7 @@ ffestd_V013 (bool ok) Verify that VOLATILE is valid here, and begin accepting items in the list. */ void -ffestd_V014_start () +ffestd_V014_start (void) { ffestd_check_start_ (); } @@ -4909,137 +3527,11 @@ ffestd_V014_item_cblock (ffelexToken name UNUSED) Just wrap up any local activities. */ void -ffestd_V014_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_V016_start -- RECORD statement list begin - - ffestd_V016_start(); - - Verify that RECORD is valid here, and begin accepting items in the list. */ - -#if FFESTR_VXT -void -ffestd_V016_start () -{ - ffestd_check_start_ (); -} - -/* ffestd_V016_item_structure -- RECORD statement for common-block-name - - ffestd_V016_item_structure(name_token); - - Make sure name_token identifies a valid structure to be RECORDed. */ - -void -ffestd_V016_item_structure (ffelexToken name) -{ - ffestd_check_item_ (); -} - -/* ffestd_V016_item_object -- RECORD statement for object-name - - ffestd_V016_item_object(name_token,dim_list); - - Make sure name_token identifies a valid object to be RECORDd. */ - -void -ffestd_V016_item_object (ffelexToken name, ffesttDimList dims) -{ - ffestd_check_item_ (); -} - -/* ffestd_V016_finish -- RECORD statement list complete - - ffestd_V016_finish(); - - Just wrap up any local activities. */ - -void -ffestd_V016_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_V018_start -- REWRITE(...) statement list begin - - ffestd_V018_start(); - - Verify that REWRITE is valid here, and begin accepting items in the - list. */ - -void -ffestd_V018_start (ffestvFormat format) -{ - ffestd_check_start_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V018_item -- REWRITE statement i/o item - - ffestd_V018_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestd_V018_item (ffebld expr) -{ - ffestd_check_item_ (); -} - -/* ffestd_V018_finish -- REWRITE statement list complete - - ffestd_V018_finish(); - - Just wrap up any local activities. */ - -void -ffestd_V018_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_V019_start -- ACCEPT statement list begin - - ffestd_V019_start(); - - Verify that ACCEPT is valid here, and begin accepting items in the - list. */ - -void -ffestd_V019_start (ffestvFormat format) -{ - ffestd_check_start_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V019_item -- ACCEPT statement i/o item - - ffestd_V019_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestd_V019_item (ffebld expr) -{ - ffestd_check_item_ (); -} - -/* ffestd_V019_finish -- ACCEPT statement list complete - - ffestd_V019_finish(); - - Just wrap up any local activities. */ - -void -ffestd_V019_finish () +ffestd_V014_finish (void) { ffestd_check_finish_ (); } -#endif /* ffestd_V020_start -- TYPE statement list begin ffestd_V020_start(); @@ -5073,167 +3565,11 @@ ffestd_V020_item (ffebld expr UNUSED) Just wrap up any local activities. */ void -ffestd_V020_finish () +ffestd_V020_finish (void) { ffestd_check_finish_ (); } -/* ffestd_V021 -- DELETE statement - - ffestd_V021(); - - Make sure a DELETE is valid in the current context, and implement it. */ - -#if FFESTR_VXT -void -ffestd_V021 () -{ - ffestd_check_simple_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V022 -- UNLOCK statement - - ffestd_V022(); - - Make sure a UNLOCK is valid in the current context, and implement it. */ - -void -ffestd_V022 () -{ - ffestd_check_simple_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V023_start -- ENCODE(...) statement list begin - - ffestd_V023_start(); - - Verify that ENCODE is valid here, and begin accepting items in the - list. */ - -void -ffestd_V023_start () -{ - ffestd_check_start_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V023_item -- ENCODE statement i/o item - - ffestd_V023_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestd_V023_item (ffebld expr) -{ - ffestd_check_item_ (); -} - -/* ffestd_V023_finish -- ENCODE statement list complete - - ffestd_V023_finish(); - - Just wrap up any local activities. */ - -void -ffestd_V023_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_V024_start -- DECODE(...) statement list begin - - ffestd_V024_start(); - - Verify that DECODE is valid here, and begin accepting items in the - list. */ - -void -ffestd_V024_start () -{ - ffestd_check_start_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V024_item -- DECODE statement i/o item - - ffestd_V024_item(expr,expr_token); - - Implement output-list expression. */ - -void -ffestd_V024_item (ffebld expr) -{ - ffestd_check_item_ (); -} - -/* ffestd_V024_finish -- DECODE statement list complete - - ffestd_V024_finish(); - - Just wrap up any local activities. */ - -void -ffestd_V024_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_V025_start -- DEFINEFILE statement list begin - - ffestd_V025_start(); - - Verify that DEFINEFILE is valid here, and begin accepting items in the - list. */ - -void -ffestd_V025_start () -{ - ffestd_check_start_ (); - ffestd_subr_vxt_ (); -} - -/* ffestd_V025_item -- DEFINE FILE statement item - - ffestd_V025_item(u,ut,m,mt,n,nt,asv,asvt); - - Implement item. Treat each item kind of like a separate statement, - since there's really no need to treat them as an aggregate. */ - -void -ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv) -{ - ffestd_check_item_ (); -} - -/* ffestd_V025_finish -- DEFINE FILE statement list complete - - ffestd_V025_finish(); - - Just wrap up any local activities. */ - -void -ffestd_V025_finish () -{ - ffestd_check_finish_ (); -} - -/* ffestd_V026 -- FIND statement - - ffestd_V026(); - - Make sure a FIND is valid in the current context, and implement it. */ - -void -ffestd_V026 () -{ - ffestd_check_simple_ (); - ffestd_subr_vxt_ (); -} - -#endif /* ffestd_V027_start -- VXT PARAMETER statement list begin ffestd_V027_start(); @@ -5241,7 +3577,7 @@ ffestd_V026 () Verify that PARAMETER is valid here, and begin accepting items in the list. */ void -ffestd_V027_start () +ffestd_V027_start (void) { ffestd_check_start_ (); ffestd_subr_vxt_ (); @@ -5267,7 +3603,7 @@ ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED) Just wrap up any local activities. */ void -ffestd_V027_finish () +ffestd_V027_finish (void) { ffestd_check_finish_ (); } @@ -5275,7 +3611,7 @@ ffestd_V027_finish () /* Any executable statement. */ void -ffestd_any () +ffestd_any (void) { ffestdStmt_ stmt; diff --git a/contrib/gcc/f/std.h b/contrib/gcc/f/std.h index ea8292c..29a82a8 100644 --- a/contrib/gcc/f/std.h +++ b/contrib/gcc/f/std.h @@ -1,5 +1,5 @@ /* std.h -- Private #include File (module.h template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -58,10 +58,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA void ffestd_begin_uses (void); void ffestd_do (bool ok); -#if FFESTR_F90 -void ffestd_end_uses (bool ok); -void ffestd_end_R740 (bool ok); -#endif void ffestd_end_R807 (bool ok); void ffestd_exec_begin (void); void ffestd_exec_end (void); @@ -70,26 +66,6 @@ void ffestd_labeldef_any (ffelab label); void ffestd_labeldef_branch (ffelab label); void ffestd_labeldef_format (ffelab label); void ffestd_labeldef_useless (ffelab label); -#if FFESTR_F90 -void ffestd_R423A (void); -void ffestd_R423B (void); -void ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name); -void ffestd_R425 (bool ok); -void ffestd_R519_start (ffestrOther intent_kw); -void ffestd_R519_item (ffelexToken name); -void ffestd_R519_finish (void); -void ffestd_R520_start (void); -void ffestd_R520_item (ffelexToken name); -void ffestd_R520_finish (void); -void ffestd_R521A (void); -void ffestd_R521Astart (void); -void ffestd_R521Aitem (ffelexToken name); -void ffestd_R521Afinish (void); -void ffestd_R521B (void); -void ffestd_R521Bstart (void); -void ffestd_R521Bitem (ffelexToken name); -void ffestd_R521Bfinish (void); -#endif void ffestd_R522 (void); void ffestd_R522start (void); void ffestd_R522item_object (ffelexToken name); @@ -98,17 +74,6 @@ void ffestd_R522finish (void); void ffestd_R524_start (bool virtual); void ffestd_R524_item (ffelexToken name, ffesttDimList dims); void ffestd_R524_finish (void); -#if FFESTR_F90 -void ffestd_R525_start (void); -void ffestd_R525_item (ffelexToken name, ffesttDimList dims); -void ffestd_R525_finish (void); -void ffestd_R526_start (void); -void ffestd_R526_item (ffelexToken name, ffesttDimList dims); -void ffestd_R526_finish (void); -void ffestd_R527_start (void); -void ffestd_R527_item (ffelexToken name, ffesttDimList dims); -void ffestd_R527_finish (void); -#endif void ffestd_R537_start (void); void ffestd_R537_item (ffebld dest, ffebld source); void ffestd_R537_finish (void); @@ -128,20 +93,7 @@ void ffestd_R547_start (void); void ffestd_R547_item_object (ffelexToken name, ffesttDimList dims); void ffestd_R547_item_cblock (ffelexToken name); void ffestd_R547_finish (void); -#if FFESTR_F90 -void ffestd_R620 (ffesttExprList exprlist, ffebld stat); -void ffestd_R624 (ffesttExprList pointers); -void ffestd_R625 (ffesttExprList exprlist, ffebld stat); -#endif void ffestd_R737A (ffebld dest, ffebld source); -#if FFESTR_F90 -void ffestd_R737B (ffebld dest, ffebld source); -void ffestd_R738 (ffebld dest, ffebld source); -void ffestd_R740 (ffebld expr); -void ffestd_R742 (ffebld expr); -void ffestd_R744 (void); -void ffestd_R745 (bool ok); -#endif void ffestd_R803 (ffelexToken construct_name, ffebld expr); void ffestd_R804 (ffebld expr, ffelexToken name); void ffestd_R805 (ffelexToken name); @@ -188,22 +140,8 @@ void ffestd_R923B_finish (void); void ffestd_R1001 (ffesttFormatList f); void ffestd_R1102 (ffesymbol s, ffelexToken name); void ffestd_R1103 (bool ok); -#if FFESTR_F90 -void ffestd_R1105 (ffelexToken name); -void ffestd_R1106 (bool ok); -void ffestd_R1107_start (ffelexToken name, bool only); -void ffestd_R1107_item (ffelexToken local, ffelexToken use); -void ffestd_R1107_finish (void); -#endif void ffestd_R1111 (ffesymbol s, ffelexToken name); void ffestd_R1112 (bool ok); -#if FFESTR_F90 -void ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name); -void ffestd_R1203 (bool ok); -void ffestd_R1205_start (void); -void ffestd_R1205_item (ffelexToken name); -void ffestd_R1205_finish (void); -#endif void ffestd_R1207_start (void); void ffestd_R1207_item (ffelexToken name); void ffestd_R1207_finish (void); @@ -211,9 +149,6 @@ void ffestd_R1208_start (void); void ffestd_R1208_item (ffelexToken name); void ffestd_R1208_finish (void); void ffestd_R1212 (ffebld expr); -#if FFESTR_F90 -void ffestd_R1213 (ffebld dest, ffebld source); -#endif void ffestd_R1219 (ffesymbol s, ffelexToken funcname, ffesttTokenList args, ffestpType type, ffebld kind, ffelexToken kindt, ffebld len, ffelexToken lent, @@ -225,55 +160,16 @@ void ffestd_R1223 (ffesymbol s, ffelexToken subrname, ffesttTokenList args, void ffestd_R1225 (bool ok); void ffestd_R1226 (ffesymbol entry); void ffestd_R1227 (ffebld expr); -#if FFESTR_F90 -void ffestd_R1228 (void); -#endif void ffestd_R1229_start (ffelexToken name, ffesttTokenList args); void ffestd_R1229_finish (ffesymbol s); void ffestd_S3P4 (ffebld filename); -#if FFESTR_VXT -void ffestd_V003_start (ffelexToken structure_name); -void ffestd_V003_item (ffelexToken name, ffesttDimList dims); -void ffestd_V003_finish (void); -void ffestd_V004 (bool ok); -void ffestd_V009 (void); -void ffestd_V010 (bool ok); -void ffestd_V012 (void); -void ffestd_V013 (bool ok); -#endif void ffestd_V014_start (void); void ffestd_V014_item_object (ffelexToken name); void ffestd_V014_item_cblock (ffelexToken name); void ffestd_V014_finish (void); -#if FFESTR_VXT -void ffestd_V016_start (void); -void ffestd_V016_item_structure (ffelexToken name); -void ffestd_V016_item_object (ffelexToken name, ffesttDimList dims); -void ffestd_V016_finish (void); -void ffestd_V018_start (ffestvFormat format); -void ffestd_V018_item (ffebld expr); -void ffestd_V018_finish (void); -void ffestd_V019_start (ffestvFormat format); -void ffestd_V019_item (ffebld expr); -void ffestd_V019_finish (void); -#endif void ffestd_V020_start (ffestvFormat format); void ffestd_V020_item (ffebld expr); void ffestd_V020_finish (void); -#if FFESTR_VXT -void ffestd_V021 (void); -void ffestd_V022 (void); -void ffestd_V023_start (void); -void ffestd_V023_item (ffebld expr); -void ffestd_V023_finish (void); -void ffestd_V024_start (void); -void ffestd_V024_item (ffebld expr); -void ffestd_V024_finish (void); -void ffestd_V025_start (void); -void ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv); -void ffestd_V025_finish (void); -void ffestd_V026 (void); -#endif void ffestd_V027_start (void); void ffestd_V027_item (ffelexToken dest_token, ffebld source); void ffestd_V027_finish (void); diff --git a/contrib/gcc/f/ste.c b/contrib/gcc/f/ste.c index 2ddf181..82435bc 100644 --- a/contrib/gcc/f/ste.c +++ b/contrib/gcc/f/ste.c @@ -141,7 +141,7 @@ static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt); /* Internal macros. */ #define ffeste_emit_line_note_() \ - emit_line_note (input_filename, lineno) + emit_line_note (input_location) #define ffeste_check_simple_() \ assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_) #define ffeste_check_start_() \ @@ -335,7 +335,7 @@ static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt); tree exq = (Exp); \ tree lenexq = (Lenexp); \ int need_exq = (! exq); \ - int need_lenexq = (! lenexq); \ + int need_lenexq = (! lenexq); \ if (need_exq || need_lenexq) \ { \ exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, &lenexq); \ @@ -387,8 +387,7 @@ typedef struct gbe_block { struct gbe_block *outer; ffestw block; - int lineno; - const char *input_filename; + location_t location; bool is_stmt; } *gbe_block; @@ -401,8 +400,7 @@ ffeste_start_block_ (ffestw block) b->outer = ffeste_top_block_; b->block = block; - b->lineno = lineno; - b->input_filename = input_filename; + b->location = input_location; b->is_stmt = FALSE; ffeste_top_block_ = b; @@ -443,8 +441,7 @@ ffeste_start_stmt_(void) b->outer = ffeste_top_block_; b->block = NULL; - b->lineno = lineno; - b->input_filename = input_filename; + b->location = input_location; b->is_stmt = TRUE; ffeste_top_block_ = b; @@ -1231,7 +1228,7 @@ ffeste_io_ialist_ (bool have_err, initn = inits; ffeste_f2c_init_next_ (unitinit); - inits = build (CONSTRUCTOR, f2c_alist_struct, NULL_TREE, inits); + inits = build_constructor (f2c_alist_struct, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; TREE_STATIC (inits) = 1; @@ -1434,7 +1431,7 @@ ffeste_io_cilist_ (bool have_err, ffeste_f2c_init_next_ (formatinit); ffeste_f2c_init_next_ (recinit); - inits = build (CONSTRUCTOR, f2c_cilist_struct, NULL_TREE, inits); + inits = build_constructor (f2c_cilist_struct, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; TREE_STATIC (inits) = 1; @@ -1561,7 +1558,7 @@ ffeste_io_cllist_ (bool have_err, ffeste_f2c_init_next_ (unitinit); ffeste_f2c_init_next_ (statinit); - inits = build (CONSTRUCTOR, f2c_close_struct, NULL_TREE, inits); + inits = build_constructor (f2c_close_struct, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; TREE_STATIC (inits) = 1; @@ -1766,7 +1763,7 @@ ffeste_io_icilist_ (bool have_err, ffeste_f2c_init_next_ (unitleninit); ffeste_f2c_init_next_ (unitnuminit); - inits = build (CONSTRUCTOR, f2c_icilist_struct, NULL_TREE, inits); + inits = build_constructor (f2c_icilist_struct, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; TREE_STATIC (inits) = 1; @@ -2013,7 +2010,7 @@ ffeste_io_inlist_ (bool have_err, ffeste_f2c_init_next_ (blankinit); ffeste_f2c_init_next_ (blankleninit); - inits = build (CONSTRUCTOR, f2c_inquire_struct, NULL_TREE, inits); + inits = build_constructor (f2c_inquire_struct, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; TREE_STATIC (inits) = 1; @@ -2189,7 +2186,7 @@ ffeste_io_olist_ (bool have_err, ffeste_f2c_init_next_ (reclinit); ffeste_f2c_init_next_ (blankinit); - inits = build (CONSTRUCTOR, f2c_open_struct, NULL_TREE, inits); + inits = build_constructor (f2c_open_struct, inits); TREE_CONSTANT (inits) = constantp ? 1 : 0; TREE_STATIC (inits) = 1; @@ -2371,7 +2368,7 @@ ffeste_do (ffestw block) Applies to *only* logical IF, not to IF-THEN. */ void -ffeste_end_R807 () +ffeste_end_R807 (void) { ffeste_emit_line_note_ (); @@ -2712,19 +2709,18 @@ ffeste_R810 (ffestw block, unsigned long casenum) { texprlow = (c->low == NULL) ? NULL_TREE : ffecom_constantunion_with_type (&ffebld_constant_union (c->low), - ffecom_tree_type[s->type][s->kindtype], c->low->consttype); + ffecom_tree_type[s->type][s->kindtype],c->low->consttype); if (c->low != c->high) { texprhigh = (c->high == NULL) ? NULL_TREE : ffecom_constantunion_with_type (&ffebld_constant_union (c->high), - ffecom_tree_type[s->type][s->kindtype], c->high->consttype); + ffecom_tree_type[s->type][s->kindtype],c->high->consttype); pushok = pushcase_range (texprlow, texprhigh, convert, tlabel, &duplicate); } else pushok = pushcase (texprlow, convert, tlabel, &duplicate); - assert((pushok !=2) || (pushok !=0)); - if (pushok==2) + if (pushok == 2) { ffebad_start_msg ("SELECT (at %0) has duplicate cases -- check integer overflow of CASE(s)", FFEBAD_severityFATAL); @@ -2828,7 +2824,7 @@ ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr) ending an iterative DO statement, even one that ends at a label. */ void -ffeste_R825 () +ffeste_R825 (void) { ffeste_check_simple_ (); @@ -2954,16 +2950,19 @@ ffeste_R838 (ffelab label, ffebld target) 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"); + if (TREE_CODE (target_tree) != ERROR_MARK) + { + 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); + label_tree = convert (TREE_TYPE (target_tree), label_tree); - expr_tree = ffecom_modify (void_type_node, + expr_tree = ffecom_modify (void_type_node, target_tree, label_tree); - expand_expr_stmt (expr_tree); + expand_expr_stmt (expr_tree); + } } } @@ -2982,11 +2981,15 @@ ffeste_R839 (ffebld target) 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"); - expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t)); + if (TREE_CODE (t) != ERROR_MARK) + { + 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)); + } } /* Arithmetic IF statement. */ @@ -3094,7 +3097,7 @@ ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos) /* CONTINUE statement. */ void -ffeste_R841 () +ffeste_R841 (void) { ffeste_check_simple_ (); @@ -3635,7 +3638,7 @@ ffeste_R909_item (ffebld expr, ffelexToken expr_token) /* READ statement -- end. */ void -ffeste_R909_finish () +ffeste_R909_finish (void) { ffeste_check_finish_ (); @@ -3866,7 +3869,7 @@ ffeste_R910_item (ffebld expr, ffelexToken expr_token) /* WRITE statement -- end. */ void -ffeste_R910_finish () +ffeste_R910_finish (void) { ffeste_check_finish_ (); @@ -3993,7 +3996,7 @@ ffeste_R911_item (ffebld expr, ffelexToken expr_token) /* PRINT statement -- end. */ void -ffeste_R911_finish () +ffeste_R911_finish (void) { ffeste_check_finish_ (); @@ -4164,7 +4167,7 @@ ffeste_R923B_item (ffebld expr UNUSED) /* INQUIRE(IOLENGTH=expr) statement -- end. */ void -ffeste_R923B_finish () +ffeste_R923B_finish (void) { ffeste_check_finish_ (); } @@ -4224,14 +4227,14 @@ ffeste_R1001 (ffests s) /* END PROGRAM. */ void -ffeste_R1103 () +ffeste_R1103 (void) { } /* END BLOCK DATA. */ void -ffeste_R1112 () +ffeste_R1112 (void) { } @@ -4360,14 +4363,14 @@ ffeste_R1212 (ffebld expr) /* END FUNCTION. */ void -ffeste_R1221 () +ffeste_R1221 (void) { } /* END SUBROUTINE. */ void -ffeste_R1225 () +ffeste_R1225 (void) { } @@ -4433,54 +4436,6 @@ ffeste_R1227 (ffestw block UNUSED, ffebld expr) /* REWRITE statement -- start. */ -#if FFESTR_VXT -void -ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format) -{ - ffeste_check_start_ (); -} - -/* REWRITE statement -- I/O item. */ - -void -ffeste_V018_item (ffebld expr) -{ - ffeste_check_item_ (); -} - -/* REWRITE statement -- end. */ - -void -ffeste_V018_finish () -{ - ffeste_check_finish_ (); -} - -/* ACCEPT statement -- start. */ - -void -ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format) -{ - ffeste_check_start_ (); -} - -/* ACCEPT statement -- I/O item. */ - -void -ffeste_V019_item (ffebld expr) -{ - ffeste_check_item_ (); -} - -/* ACCEPT statement -- end. */ - -void -ffeste_V019_finish () -{ - ffeste_check_finish_ (); -} - -#endif /* TYPE statement -- start. */ void @@ -4501,109 +4456,13 @@ ffeste_V020_item (ffebld expr UNUSED) /* TYPE statement -- end. */ void -ffeste_V020_finish () +ffeste_V020_finish (void) { ffeste_check_finish_ (); } /* DELETE statement. */ -#if FFESTR_VXT -void -ffeste_V021 (ffestpDeleteStmt *info) -{ - ffeste_check_simple_ (); -} - -/* UNLOCK statement. */ - -void -ffeste_V022 (ffestpBeruStmt *info) -{ - ffeste_check_simple_ (); -} - -/* ENCODE statement -- start. */ - -void -ffeste_V023_start (ffestpVxtcodeStmt *info) -{ - ffeste_check_start_ (); -} - -/* ENCODE statement -- I/O item. */ - -void -ffeste_V023_item (ffebld expr) -{ - ffeste_check_item_ (); -} - -/* ENCODE statement -- end. */ - -void -ffeste_V023_finish () -{ - ffeste_check_finish_ (); -} - -/* DECODE statement -- start. */ - -void -ffeste_V024_start (ffestpVxtcodeStmt *info) -{ - ffeste_check_start_ (); -} - -/* DECODE statement -- I/O item. */ - -void -ffeste_V024_item (ffebld expr) -{ - ffeste_check_item_ (); -} - -/* DECODE statement -- end. */ - -void -ffeste_V024_finish () -{ - ffeste_check_finish_ (); -} - -/* DEFINEFILE statement -- start. */ - -void -ffeste_V025_start () -{ - ffeste_check_start_ (); -} - -/* DEFINE FILE statement -- item. */ - -void -ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv) -{ - ffeste_check_item_ (); -} - -/* DEFINE FILE statement -- end. */ - -void -ffeste_V025_finish () -{ - ffeste_check_finish_ (); -} - -/* FIND statement. */ - -void -ffeste_V026 (ffestpFindStmt *info) -{ - ffeste_check_simple_ (); -} - -#endif #ifdef ENABLE_CHECKING void diff --git a/contrib/gcc/f/ste.h b/contrib/gcc/f/ste.h index fb32c79..ac04a4c 100644 --- a/contrib/gcc/f/ste.h +++ b/contrib/gcc/f/ste.h @@ -1,5 +1,5 @@ /* ste.h -- Private #include File (module.h template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -114,31 +114,9 @@ void ffeste_R1221 (void); void ffeste_R1225 (void); void ffeste_R1226 (ffesymbol entry); void ffeste_R1227 (ffestw block, ffebld expr); -#if FFESTR_VXT -void ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format); -void ffeste_V018_item (ffebld expr); -void ffeste_V018_finish (void); -void ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format); -void ffeste_V019_item (ffebld expr); -void ffeste_V019_finish (void); -#endif void ffeste_V020_start (ffestpTypeStmt *info, ffestvFormat format); void ffeste_V020_item (ffebld expr); void ffeste_V020_finish (void); -#if FFESTR_VXT -void ffeste_V021 (ffestpDeleteStmt *info); -void ffeste_V022 (ffestpBeruStmt *info); -void ffeste_V023_start (ffestpVxtcodeStmt *info); -void ffeste_V023_item (ffebld expr); -void ffeste_V023_finish (void); -void ffeste_V024_start (ffestpVxtcodeStmt *info); -void ffeste_V024_item (ffebld expr); -void ffeste_V024_finish (void); -void ffeste_V025_start (void); -void ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv); -void ffeste_V025_finish (void); -void ffeste_V026 (ffestpFindStmt *info); -#endif /* Define macros. */ @@ -148,9 +126,9 @@ void ffeste_V026 (ffestpFindStmt *info); #define ffeste_init_3() #define ffeste_init_4() #define ffeste_filename() input_filename -#define ffeste_filelinenum() lineno +#define ffeste_filelinenum() input_line #define ffeste_set_line(name,num) \ - (input_filename = (name), lineno = (num)) + (input_filename = (name), input_line = (num)) #define ffeste_terminate_0() #define ffeste_terminate_1() #ifdef ENABLE_CHECKING diff --git a/contrib/gcc/f/storag.c b/contrib/gcc/f/storag.c index f8af500..8e9cb24 100644 --- a/contrib/gcc/f/storag.c +++ b/contrib/gcc/f/storag.c @@ -1,5 +1,5 @@ /* storag.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -162,7 +162,7 @@ ffestorag_dump (ffestorag s) ffestorag_init_2(); */ void -ffestorag_init_2 () +ffestorag_init_2 (void) { ffestorag_list_.first = ffestorag_list_.last = (ffestorag) &ffestorag_list_.first; @@ -416,13 +416,10 @@ ffestorag_new (ffestoragList sl) { ffestorag s; - s = (ffestorag) malloc_new_kp (ffe_pool_program_unit (), "ffestorag", - sizeof (*s)); + s = malloc_new_kp (ffe_pool_program_unit (), "ffestorag", sizeof (*s)); s->next = (ffestorag) &sl->first; s->previous = sl->last; -#ifdef FFECOM_storageHOOK s->hook = FFECOM_storageNULL; -#endif s->previous->next = s; sl->last = s; s->equivs_.first = s->equivs_.last = (ffestorag) &s->equivs_.first; @@ -433,7 +430,7 @@ ffestorag_new (ffestoragList sl) /* Report info on LOCAL non-sym-assoc'ed entities if needed. */ void -ffestorag_report () +ffestorag_report (void) { ffestorag s; diff --git a/contrib/gcc/f/storag.h b/contrib/gcc/f/storag.h index e4aa404..b58dc9a 100644 --- a/contrib/gcc/f/storag.h +++ b/contrib/gcc/f/storag.h @@ -1,5 +1,5 @@ /* storag.h -- Public #include File (module.h template V1.0) - Copyright (C) 1995, 1996 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -83,9 +83,7 @@ struct _ffestorag_ LOCAL. */ ffetargetAlign alignment; /* Initial alignment for entity. */ ffetargetAlign modulo; /* Modulo within alignment. */ -#ifdef FFECOM_storageHOOK ffecomStorage hook; /* Whatever the backend needs here. */ -#endif ffestoragType type; ffeinfoBasictype basic_type;/* NONE= >1 non-CHARACTER; ANY= CHAR+non-CHAR. */ diff --git a/contrib/gcc/f/str.h b/contrib/gcc/f/str.h index 543eeeb..b3ac04e 100644 --- a/contrib/gcc/f/str.h +++ b/contrib/gcc/f/str.h @@ -1,5 +1,5 @@ /* str.h -- Private #include File (module.h template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -30,11 +30,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #ifndef GCC_F_STR_H #define GCC_F_STR_H -/* Simple definitions and enumerations. */ - -#define FFESTR_F90 0 /* Unsupported F90 stuff. */ -#define FFESTR_VXT 0 /* Unsupported VXT stuff. */ - /* Typedefs. */ diff --git a/contrib/gcc/f/stt.c b/contrib/gcc/f/stt.c index c48a505..e616d49 100644 --- a/contrib/gcc/f/stt.c +++ b/contrib/gcc/f/stt.c @@ -1,5 +1,5 @@ /* stt.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1997 Free Software Foundation, Inc. + Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -79,8 +79,7 @@ ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1, { ffesttCaseList new; - new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool, - "FFEST case list", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST case list", sizeof (*new)); new->next = list->previous->next; new->previous = list->previous; new->next->previous = new; @@ -99,13 +98,12 @@ ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1, The list is allocated out of the scratch pool. */ ffesttCaseList -ffestt_caselist_create () +ffestt_caselist_create (void) { ffesttCaseList new; - new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool, - "FFEST case list root", - sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST case list root", + sizeof (*new)); new->next = new->previous = new; new->t = NULL; new->expr1 = NULL; @@ -151,8 +149,7 @@ ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper, { ffesttDimList new; - new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool, - "FFEST dim list", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST dim list", sizeof (*new)); new->next = list->previous->next; new->previous = list->previous; new->next->previous = new; @@ -396,12 +393,12 @@ ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank, The list is allocated out of the scratch pool. */ ffesttDimList -ffestt_dimlist_create () +ffestt_dimlist_create (void) { ffesttDimList new; - new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool, - "FFEST dim list root", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST dim list root", + sizeof (*new)); new->next = new->previous = new; new->t = NULL; new->lower = NULL; @@ -503,8 +500,7 @@ ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t) { ffesttExprList new; - new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool, - "FFEST expr list", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST expr list", sizeof (*new)); new->next = list->previous->next; new->previous = list->previous; new->next->previous = new; @@ -521,12 +517,12 @@ ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t) The list is allocated out of the scratch pool. */ ffesttExprList -ffestt_exprlist_create () +ffestt_exprlist_create (void) { ffesttExprList new; - new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool, - "FFEST expr list root", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST expr list root", + sizeof (*new)); new->next = new->previous = new; new->expr = NULL; new->t = NULL; @@ -592,8 +588,8 @@ ffestt_formatlist_append (ffesttFormatList list) { ffesttFormatList new; - new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool, - "FFEST format list", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST format list", + sizeof (*new)); new->next = list->previous->next; new->previous = list->previous; new->next->previous = new; @@ -613,8 +609,8 @@ ffestt_formatlist_create (ffesttFormatList parent, ffelexToken t) { ffesttFormatList new; - new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool, - "FFEST format list root", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST format list root", + sizeof (*new)); new->next = new->previous = new; new->type = FFESTP_formattypeNone; new->t = t; @@ -720,8 +716,7 @@ ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last) { ffesttImpList new; - new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool, - "FFEST token list", sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST token list", sizeof (*new)); new->next = list->previous->next; new->previous = list->previous; new->next->previous = new; @@ -738,13 +733,12 @@ ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last) The list is allocated out of the scratch pool. */ ffesttImpList -ffestt_implist_create () +ffestt_implist_create (void) { ffesttImpList new; - new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool, - "FFEST token list root", - sizeof (*new)); + new = malloc_new_kp (ffesta_scratch_pool, "FFEST token list root", + sizeof (*new)); new->next = new->previous = new; new->first = NULL; new->last = NULL; @@ -807,8 +801,7 @@ ffestt_tokenlist_append (ffesttTokenList tl, ffelexToken t) { ffesttTokenItem ti; - ti = (ffesttTokenItem) malloc_new_kp (ffesta_scratch_pool, - "FFEST token item", sizeof (*ti)); + ti = malloc_new_kp (ffesta_scratch_pool, "FFEST token item", sizeof (*ti)); ti->next = (ffesttTokenItem) &tl->first; ti->previous = tl->last; ti->next->previous = ti; @@ -825,12 +818,11 @@ ffestt_tokenlist_append (ffesttTokenList tl, ffelexToken t) The list is allocated out of the scratch pool. */ ffesttTokenList -ffestt_tokenlist_create () +ffestt_tokenlist_create (void) { ffesttTokenList tl; - tl = (ffesttTokenList) malloc_new_kp (ffesta_scratch_pool, - "FFEST token list", sizeof (*tl)); + tl = malloc_new_kp (ffesta_scratch_pool, "FFEST token list", sizeof (*tl)); tl->first = tl->last = (ffesttTokenItem) &tl->first; tl->count = 0; return tl; diff --git a/contrib/gcc/f/stw.c b/contrib/gcc/f/stw.c index 058b1eb..57658de 100644 --- a/contrib/gcc/f/stw.c +++ b/contrib/gcc/f/stw.c @@ -1,5 +1,5 @@ /* stw.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -278,12 +278,12 @@ ffestw_display_state (void) ffestw_init_0(); */ void -ffestw_init_0 () +ffestw_init_0 (void) { ffestw b; - ffestw_stack_top_ = b = (ffestw) malloc_new_kp (malloc_pool_image (), - "FFESTW stack base", sizeof (*b)); + ffestw_stack_top_ = b = malloc_new_kp (malloc_pool_image (), + "FFESTW stack base", sizeof (*b)); b->uses_ = 0; /* catch if anyone uses, kills, &c this block. */ b->next_ = NULL; @@ -324,7 +324,7 @@ ffestw_new (void) { ffestw b; - b = (ffestw) malloc_new_kp (malloc_pool_image (), "FFESTW", sizeof (*b)); + b = malloc_new_kp (malloc_pool_image (), "FFESTW", sizeof (*b)); b->uses_ = 1; return b; diff --git a/contrib/gcc/f/symbol.c b/contrib/gcc/f/symbol.c index 816ad19..c22697f 100644 --- a/contrib/gcc/f/symbol.c +++ b/contrib/gcc/f/symbol.c @@ -1,5 +1,6 @@ /* Implementation of Fortran symbol manager - Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997, 2003 + Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -177,7 +178,7 @@ ffesymbol_check_token_ (ffelexToken t, char *c) /* Kill manifest (g77-picked) names. */ static void -ffesymbol_kill_manifest_ () +ffesymbol_kill_manifest_ (void) { if (ffesymbol_token_blank_common_ != NULL) ffelex_token_kill (ffesymbol_token_blank_common_); @@ -205,8 +206,7 @@ ffesymbol_new_ (ffename n) assert (n != NULL); - s = (ffesymbol) malloc_new_ks (FFESYMBOL_SPACE_POOL_, "FFESYMBOL", - sizeof (*s)); + s = malloc_new_ks (FFESYMBOL_SPACE_POOL_, "FFESYMBOL", sizeof (*s)); s->name = n; s->other_space_name = NULL; #if FFEGLOBAL_ENABLED @@ -230,9 +230,7 @@ ffesymbol_new_ (ffename n) s->common = NULL; s->equiv = NULL; s->storage = NULL; -#ifdef FFECOM_symbolHOOK s->hook = FFECOM_symbolNULL; -#endif s->sfa_dummy_parent = NULL; s->func_result = NULL; s->value = 0; @@ -259,8 +257,8 @@ ffesymbol_new_ (ffename n) return s; } - r = (ffesymbolRetract_) malloc_new_kp (ffesymbol_retract_pool_, - "FFESYMBOL retract", sizeof (*r)); + r = malloc_new_kp (ffesymbol_retract_pool_, "FFESYMBOL retract", + sizeof (*r)); r->next = NULL; r->command = FFESYMBOL_retractcommandDELETE_; r->live = s; @@ -823,7 +821,7 @@ ffesymbol_error (ffesymbol s, ffelexToken t) } void -ffesymbol_init_0 () +ffesymbol_init_0 (void) { ffesymbolAttrs attrs = FFESYMBOL_attrsetNONE; @@ -835,7 +833,7 @@ ffesymbol_init_0 () } void -ffesymbol_init_1 () +ffesymbol_init_1 (void) { #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_ ffesymbol_global_ = ffename_space_new (ffe_pool_file ()); @@ -843,12 +841,12 @@ ffesymbol_init_1 () } void -ffesymbol_init_2 () +ffesymbol_init_2 (void) { } void -ffesymbol_init_3 () +ffesymbol_init_3 (void) { #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ ffesymbol_global_ = ffename_space_new (ffe_pool_program_unit ()); @@ -857,7 +855,7 @@ ffesymbol_init_3 () } void -ffesymbol_init_4 () +ffesymbol_init_4 (void) { ffesymbol_sfunc_ = ffename_space_new (ffe_pool_program_unit ()); } @@ -1061,7 +1059,7 @@ ffesymbol_retract (bool retract) /* Return retractable flag. */ bool -ffesymbol_retractable () +ffesymbol_retractable (void) { return ffesymbol_retractable_; } @@ -1105,13 +1103,13 @@ ffesymbol_signal_change (ffesymbol s) if (!ffesymbol_retractable_ || s->have_old) return; - r = (ffesymbolRetract_) malloc_new_kp (ffesymbol_retract_pool_, - "FFESYMBOL retract", sizeof (*r)); + r = malloc_new_kp (ffesymbol_retract_pool_, "FFESYMBOL retract", + sizeof (*r)); r->next = NULL; r->command = FFESYMBOL_retractcommandRETRACT_; r->live = s; - r->symbol = sym = (ffesymbol) malloc_new_ks (FFESYMBOL_SPACE_POOL_, - "FFESYMBOL", sizeof (*sym)); + r->symbol = sym = malloc_new_ks (FFESYMBOL_SPACE_POOL_, + "FFESYMBOL", sizeof (*sym)); *sym = *s; /* Make an exact copy of the symbol in case we need it back. */ sym->info = ffeinfo_use (s->info); @@ -1135,12 +1133,12 @@ ffesymbol_state_string (ffesymbolState state) } void -ffesymbol_terminate_0 () +ffesymbol_terminate_0 (void) { } void -ffesymbol_terminate_1 () +ffesymbol_terminate_1 (void) { #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_ ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_); @@ -1152,7 +1150,7 @@ ffesymbol_terminate_1 () } void -ffesymbol_terminate_2 () +ffesymbol_terminate_2 (void) { #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ ffesymbol_kill_manifest_ (); @@ -1160,7 +1158,7 @@ ffesymbol_terminate_2 () } void -ffesymbol_terminate_3 () +ffesymbol_terminate_3 (void) { #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_); @@ -1175,7 +1173,7 @@ ffesymbol_terminate_3 () } void -ffesymbol_terminate_4 () +ffesymbol_terminate_4 (void) { ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_unhook_); ffename_space_kill (ffesymbol_sfunc_); diff --git a/contrib/gcc/f/symbol.h b/contrib/gcc/f/symbol.h index c9e582a..7ddafbd 100644 --- a/contrib/gcc/f/symbol.h +++ b/contrib/gcc/f/symbol.h @@ -1,5 +1,5 @@ /* Interface definitions for Fortran symbol manager - Copyright (C) 1995, 1996 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -121,9 +121,7 @@ struct _ffesymbol_ ffeequiv equiv; /* Who have I been equivalenced with? */ ffestorag storage; /* Where am I in relation to my outside world? */ -#ifdef FFECOM_symbolHOOK ffecomSymbol hook; /* Whatever the compiler/backend wants! */ -#endif ffesymbol sfa_dummy_parent; /* "X" outside sfunc "CIRC(X) = 3.14 * X". */ ffesymbol func_result; /* FUN sym's corresponding RES sym, & vice versa. */ diff --git a/contrib/gcc/f/target.c b/contrib/gcc/f/target.c index 82ae955..1626112 100644 --- a/contrib/gcc/f/target.c +++ b/contrib/gcc/f/target.c @@ -76,6 +76,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "lex.h" #include "malloc.h" #include "real.h" +#include "toplev.h" /* Externals defined here. */ @@ -104,11 +105,6 @@ static void ffetarget_print_char_ (FILE *f, unsigned char c); /* Internal macros. */ -#ifdef REAL_VALUE_ATOF -#define FFETARGET_ATOF_(p,m) REAL_VALUE_ATOF ((p),(m)) -#else -#define FFETARGET_ATOF_(p,m) atof ((p)) -#endif /* ffetarget_print_char_ -- Print a single character (in apostrophe context) @@ -2243,8 +2239,7 @@ ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer, #undef dotoktxt if (sz > ARRAY_SIZE (ffetarget_string_)) - p = ptr = (char *) malloc_new_ks (malloc_pool_image (), "ffetarget_real1", - sz); + p = ptr = malloc_new_ks (malloc_pool_image (), "ffetarget_real1", sz); #define dotoktxt(x) if (x != NULL) \ { \ @@ -2279,7 +2274,7 @@ ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer, { REAL_VALUE_TYPE rv; - rv = FFETARGET_ATOF_ (ptr, SFmode); + real_from_string (&rv, ptr); ffetarget_make_real1 (value, rv); } @@ -2326,7 +2321,7 @@ ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer, #undef dotoktxt if (sz > ARRAY_SIZE (ffetarget_string_)) - p = ptr = (char *) malloc_new_ks (malloc_pool_image (), "ffetarget_real1", sz); + p = ptr = malloc_new_ks (malloc_pool_image (), "ffetarget_real1", sz); #define dotoktxt(x) if (x != NULL) \ { \ @@ -2367,7 +2362,7 @@ ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer, { REAL_VALUE_TYPE rv; - rv = FFETARGET_ATOF_ (ptr, DFmode); + real_from_string (&rv, ptr); ffetarget_make_real2 (value, rv); } diff --git a/contrib/gcc/f/target.h b/contrib/gcc/f/target.h index 2125ad5..8ec73ad 100644 --- a/contrib/gcc/f/target.h +++ b/contrib/gcc/f/target.h @@ -1,5 +1,6 @@ /* target.h -- Public #include File (module.h template V1.0) - Copyright (C) 1995, 1996, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2002, 2003 + Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -30,13 +31,9 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #ifndef GCC_F_TARGET_H #define GCC_F_TARGET_H -#ifdef FFE_STANDALONE -#define HOST_WIDE_INT long -#else #ifndef TREE_CODE #include "tree.h" #endif -#endif /* Simple definitions and enumerations. */ @@ -269,26 +266,6 @@ typedef short int ffetargetInteger3; typedef long long int ffetargetInteger4; #define ffetargetInteger4_f "ll" #endif -#if FFETARGET_okINTEGER5 -typedef ? ffetargetInteger5; -#define ffetargetInteger5_f -? -#endif -#if FFETARGET_okINTEGER6 -typedef ? ffetargetInteger6; -#define ffetargetInteger6_f -? -#endif -#if FFETARGET_okINTEGER7 -typedef ? ffetargetInteger7; -#define ffetargetInteger7_f -? -#endif -#if FFETARGET_okINTEGER8 -typedef ? ffetargetInteger8; -#define ffetargetInteger8_f -? -#endif #if FFETARGET_okLOGICAL1 #ifdef FFETARGET_32bit_longs typedef long int ffetargetLogical1; @@ -310,26 +287,6 @@ typedef short int ffetargetLogical3; typedef long long int ffetargetLogical4; #define ffetargetLogical4_f "ll" #endif -#if FFETARGET_okLOGICAL5 -typedef ? ffetargetLogical5; -#define ffetargetLogical5_f -? -#endif -#if FFETARGET_okLOGICAL6 -typedef ? ffetargetLogical6; -#define ffetargetLogical6_f -? -#endif -#if FFETARGET_okLOGICAL7 -typedef ? ffetargetLogical7; -#define ffetargetLogical7_f -? -#endif -#if FFETARGET_okLOGICAL8 -typedef ? ffetargetLogical8; -#define ffetargetLogical8_f -? -#endif #if FFETARGET_okREAL1 typedef int ffetargetReal1; #define ffetargetReal1_f "" @@ -360,26 +317,6 @@ typedef struct { int v[2]; } ffetargetReal2; typedef long ffetargetReal3[?]; ? #endif -#if FFETARGET_okREAL4 -typedef long ffetargetReal4[?]; -? -#endif -#if FFETARGET_okREAL5 -typedef long ffetargetReal5[?]; -? -#endif -#if FFETARGET_okREAL6 -typedef long ffetargetReal6[?]; -? -#endif -#if FFETARGET_okREAL7 -typedef long ffetargetReal7[?]; -? -#endif -#if FFETARGET_okREAL8 -typedef long ffetargetReal8[?]; -? -#endif #if FFETARGET_okCOMPLEX1 struct _ffetarget_complex_1_ { @@ -404,46 +341,6 @@ struct _ffetarget_complex_3_ }; typedef struct _ffetarget_complex_3_ ffetargetComplex3; #endif -#if FFETARGET_okCOMPLEX4 -struct _ffetarget_complex_4_ - { - ffetargetReal4 real; - ffetargetReal4 imaginary; - }; -typedef struct _ffetarget_complex_4_ ffetargetComplex4; -#endif -#if FFETARGET_okCOMPLEX5 -struct _ffetarget_complex_5_ - { - ffetargetReal5 real; - ffetargetReal5 imaginary; - }; -typedef struct _ffetarget_complex_5_ ffetargetComplex5; -#endif -#if FFETARGET_okCOMPLEX6 -struct _ffetarget_complex_6_ - { - ffetargetReal6 real; - ffetargetReal6 imaginary; - }; -typedef struct _ffetarget_complex_6_ ffetargetComplex6; -#endif -#if FFETARGET_okCOMPLEX7 -struct _ffetarget_complex_7_ - { - ffetargetReal7 real; - ffetargetReal7 imaginary; - }; -typedef struct _ffetarget_complex_7_ ffetargetComplex7; -#endif -#if FFETARGET_okCOMPLEX8 -struct _ffetarget_complex_8_ - { - ffetargetReal8 real; - ffetargetReal8 imaginary; - }; -typedef struct _ffetarget_complex_8_ ffetargetComplex8; -#endif #if FFETARGET_okCHARACTER1 struct _ffetarget_char_1_ { @@ -453,34 +350,6 @@ struct _ffetarget_char_1_ typedef struct _ffetarget_char_1_ ffetargetCharacter1; typedef unsigned char ffetargetCharacterUnit1; #endif -#if FFETARGET_okCHARACTER2 -typedef ? ffetargetCharacter2; -typedef ? ffetargetCharacterUnit2; -#endif -#if FFETARGET_okCHARACTER3 -typedef ? ffetargetCharacter3; -typedef ? ffetargetCharacterUnit3; -#endif -#if FFETARGET_okCHARACTER4 -typedef ? ffetargetCharacter4; -typedef ? ffetargetCharacterUnit4; -#endif -#if FFETARGET_okCHARACTER5 -typedef ? ffetargetCharacter5; -typedef ? ffetargetCharacterUnit5; -#endif -#if FFETARGET_okCHARACTER6 -typedef ? ffetargetCharacter6; -typedef ? ffetargetCharacterUnit6; -#endif -#if FFETARGET_okCHARACTER7 -typedef ? ffetargetCharacter7; -typedef ? ffetargetCharacterUnit7; -#endif -#if FFETARGET_okCHARACTER8 -typedef ? ffetargetCharacter8; -typedef ? ffetargetCharacterUnit8; -#endif typedef unsigned long long int ffetargetTypeless; @@ -608,26 +477,6 @@ ffebad ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l, ffebad ffetarget_divide_complex3 (ffetargetComplex3 *res, ffetargetComplex3 l, ffetargetComplex3 r); #endif -#if FFETARGET_okCOMPLEX4 -ffebad ffetarget_divide_complex4 (ffetargetComplex4 *res, ffetargetComplex4 l, - ffetargetComplex4 r); -#endif -#if FFETARGET_okCOMPLEX5 -ffebad ffetarget_divide_complex5 (ffetargetComplex5 *res, ffetargetComplex5 l, - ffetargetComplex5 r); -#endif -#if FFETARGET_okCOMPLEX6 -ffebad ffetarget_divide_complex6 (ffetargetComplex6 *res, ffetargetComplex6 l, - ffetargetComplex6 r); -#endif -#if FFETARGET_okCOMPLEX7 -ffebad ffetarget_divide_complex7 (ffetargetComplex7 *res, ffetargetComplex7 l, - ffetargetComplex7 r); -#endif -#if FFETARGET_okCOMPLEX8 -ffebad ffetarget_divide_complex8 (ffetargetComplex8 *res, ffetargetComplex8 l, - ffetargetComplex8 r); -#endif #if FFETARGET_okINTEGER1 bool ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer); #endif @@ -640,18 +489,6 @@ bool ffetarget_integer3 (ffetargetInteger3 *val, ffelexToken integer); #if FFETARGET_okINTEGER4 bool ffetarget_integer4 (ffetargetInteger4 *val, ffelexToken integer); #endif -#if FFETARGET_okINTEGER5 -bool ffetarget_integer5 (ffetargetInteger5 *val, ffelexToken integer); -#endif -#if FFETARGET_okINTEGER6 -bool ffetarget_integer6 (ffetargetInteger6 *val, ffelexToken integer); -#endif -#if FFETARGET_okINTEGER7 -bool ffetarget_integer7 (ffetargetInteger7 *val, ffelexToken integer); -#endif -#if FFETARGET_okINTEGER8 -bool ffetarget_integer8 (ffetargetInteger8 *val, ffelexToken integer); -#endif bool ffetarget_integerbinary (ffetargetIntegerDefault *val, ffelexToken integer); bool ffetarget_integerhex (ffetargetIntegerDefault *val, @@ -690,31 +527,6 @@ ffebad ffetarget_multiply_complex3 (ffetargetComplex3 *res, ffetargetComplex3 l, ffetargetComplex3 r); #endif -#if FFETARGET_okCOMPLEX4 -ffebad ffetarget_multiply_complex4 (ffetargetComplex4 *res, - ffetargetComplex4 l, - ffetargetComplex4 r); -#endif -#if FFETARGET_okCOMPLEX5 -ffebad ffetarget_multiply_complex5 (ffetargetComplex5 *res, - ffetargetComplex5 l, - ffetargetComplex5 r); -#endif -#if FFETARGET_okCOMPLEX6 -ffebad ffetarget_multiply_complex6 (ffetargetComplex6 *res, - ffetargetComplex6 l, - ffetargetComplex6 r); -#endif -#if FFETARGET_okCOMPLEX7 -ffebad ffetarget_multiply_complex7 (ffetargetComplex7 *res, - ffetargetComplex7 l, - ffetargetComplex7 r); -#endif -#if FFETARGET_okCOMPLEX8 -ffebad ffetarget_multiply_complex8 (ffetargetComplex8 *res, - ffetargetComplex8 l, - ffetargetComplex8 r); -#endif ffebad ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault *res, ffetargetComplexDefault l, ffetargetIntegerDefault r); @@ -755,36 +567,6 @@ bool ffetarget_real3 (ffetargetReal3 *value, ffelexToken integer, ffelexToken exponent, ffelexToken exponent_sign, ffelexToken exponent_digits); #endif -#if FFETARGET_okREAL4 -bool ffetarget_real4 (ffetargetReal4 *value, ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, - ffelexToken exponent, ffelexToken exponent_sign, - ffelexToken exponent_digits); -#endif -#if FFETARGET_okREAL5 -bool ffetarget_real5 (ffetargetReal5 *value, ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, - ffelexToken exponent, ffelexToken exponent_sign, - ffelexToken exponent_digits); -#endif -#if FFETARGET_okREAL6 -bool ffetarget_real6 (ffetargetReal6 *value, ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, - ffelexToken exponent, ffelexToken exponent_sign, - ffelexToken exponent_digits); -#endif -#if FFETARGET_okREAL7 -bool ffetarget_real7 (ffetargetReal7 *value, ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, - ffelexToken exponent, ffelexToken exponent_sign, - ffelexToken exponent_digits); -#endif -#if FFETARGET_okREAL8 -bool ffetarget_real8 (ffetargetReal8 *value, ffelexToken integer, - ffelexToken decimal, ffelexToken fraction, - ffelexToken exponent, ffelexToken exponent_sign, - ffelexToken exponent_digits); -#endif bool ffetarget_typeless_binary (ffetargetTypeless *value, ffelexToken token); bool ffetarget_typeless_octal (ffetargetTypeless *value, ffelexToken token); bool ffetarget_typeless_hex (ffetargetTypeless *value, ffelexToken token); @@ -794,9 +576,24 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); /* Define macros. */ -#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)) +#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \ + REAL_VALUE_FROM_INT (resr, (HOST_WIDE_INT) lf, \ + (HOST_WIDE_INT) ((lf < 0) ? -1 : 0), \ + mode_for_size (kt == 1 ? 32 : 64, MODE_FLOAT, 0)) + +#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT +#define FFETARGET_REAL_VALUE_FROM_LONGLONG_(resr, lf, kt) \ + REAL_VALUE_FROM_INT (resr, (HOST_WIDE_INT) lf, \ + (HOST_WIDE_INT) (lf >> HOST_BITS_PER_WIDE_INT), \ + mode_for_size (kt == 1 ? 32 : 64, MODE_FLOAT, 0)) +#define FFETARGET_LONGLONG_FROM_INTS_(hi, lo) \ + (((long long int) hi << HOST_BITS_PER_WIDE_INT) \ + | (long long int) ((unsigned HOST_WIDE_INT) lo)) +#else +#define FFETARGET_REAL_VALUE_FROM_LONGLONG_(resr, lf, kt) \ + FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, kt) +#define FFETARGET_LONGLONG_FROM_INTS_(hi, lo) lo +#endif #define ffetarget_add_complex1(res,l,r) \ ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \ @@ -899,7 +696,14 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); #define ffetarget_convert_complex1_integer1 ffetarget_convert_complex1_integer #define ffetarget_convert_complex1_integer2 ffetarget_convert_complex1_integer #define ffetarget_convert_complex1_integer3 ffetarget_convert_complex1_integer -#define ffetarget_convert_complex1_integer4(res,l) FFEBAD_NOCANDO +#define ffetarget_convert_complex1_integer4(res,l) \ + ({ REAL_VALUE_TYPE resi, resr; \ + ffetargetInteger4 lf = (l); \ + FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 1); \ + resi = dconst0; \ + ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \ + ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \ + FFEBAD; }) #define ffetarget_convert_complex1_real1(res,l) \ ((res)->real = (l), \ ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \ @@ -934,7 +738,14 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); #define ffetarget_convert_complex2_integer1 ffetarget_convert_complex2_integer #define ffetarget_convert_complex2_integer2 ffetarget_convert_complex2_integer #define ffetarget_convert_complex2_integer3 ffetarget_convert_complex2_integer -#define ffetarget_convert_complex2_integer4(res,l) FFEBAD_NOCANDO +#define ffetarget_convert_complex2_integer4(res,l) \ + ({ REAL_VALUE_TYPE resi, resr; \ + ffetargetInteger4 lf = (l); \ + FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 2); \ + resi = dconst0; \ + ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \ + ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \ + FFEBAD; }) #define ffetarget_convert_complex2_real1(res,l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r1_to_rv_ (l); \ @@ -997,8 +808,20 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_integer1_typeless(res,l) #define ffetarget_convert_integer4_character1(res,l) \ ffetarget_convert_integer1_character1(res,l) -#define ffetarget_convert_integer4_complex1(res,l) FFEBAD_NOCANDO -#define ffetarget_convert_integer4_complex2(res,l) FFEBAD_NOCANDO +#define ffetarget_convert_integer4_complex1(res,l) \ + ({ REAL_VALUE_TYPE lr; \ + lr = ffetarget_cvt_r1_to_rv_ ((l).real); \ + REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \ + *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \ + ffetarget_long_val_); \ + FFEBAD; }) +#define ffetarget_convert_integer4_complex2(res,l) \ + ({ REAL_VALUE_TYPE lr; \ + lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \ + REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \ + *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \ + ffetarget_long_val_); \ + FFEBAD; }) #define ffetarget_convert_integer4_hollerith(res,l) \ ffetarget_convert_integer1_hollerith(res,l) #define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD) @@ -1012,8 +835,20 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_integer1_logical1(res,l) #define ffetarget_convert_integer4_logical4(res,l) \ ffetarget_convert_integer1_logical1(res,l) -#define ffetarget_convert_integer4_real1(res,l) FFEBAD_NOCANDO -#define ffetarget_convert_integer4_real2(res,l) FFEBAD_NOCANDO +#define ffetarget_convert_integer4_real1(res,l) \ + ({ REAL_VALUE_TYPE lr; \ + lr = ffetarget_cvt_r1_to_rv_ (l); \ + REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \ + *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \ + ffetarget_long_val_); \ + FFEBAD; }) +#define ffetarget_convert_integer4_real2(res,l) \ + ({ REAL_VALUE_TYPE lr; \ + lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \ + REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \ + *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \ + ffetarget_long_val_); \ + FFEBAD; }) #define ffetarget_convert_integer4_typeless(res,l) \ ffetarget_convert_integer1_typeless(res,l) #define ffetarget_convert_logical1_character1(res,l) \ @@ -1113,7 +948,12 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_real1_integer1(res,l) #define ffetarget_convert_real1_integer3(res,l) \ ffetarget_convert_real1_integer1(res,l) -#define ffetarget_convert_real1_integer4(res,l) FFEBAD_NOCANDO +#define ffetarget_convert_real1_integer4(res,l) \ + ({ REAL_VALUE_TYPE resr; \ + ffetargetInteger4 lf = (l); \ + FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 1); \ + ffetarget_cvt_rv_to_r1_ (resr, *(res)); \ + FFEBAD; }) #define ffetarget_convert_real1_typeless(res,l) \ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD) @@ -1138,7 +978,12 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_real2_integer1(res,l) #define ffetarget_convert_real2_integer3(res,l) \ ffetarget_convert_real2_integer1(res,l) -#define ffetarget_convert_real2_integer4(res,l) FFEBAD_NOCANDO +#define ffetarget_convert_real2_integer4(res,l) \ + ({ REAL_VALUE_TYPE resr; \ + ffetargetInteger4 lf = (l); \ + FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 2); \ + ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \ + FFEBAD; }) #define ffetarget_convert_real2_typeless(res,l) \ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_real2_complex1(res,l) \ diff --git a/contrib/gcc/f/top.c b/contrib/gcc/f/top.c index 6a789e3..ce39dd0 100644 --- a/contrib/gcc/f/top.c +++ b/contrib/gcc/f/top.c @@ -1,5 +1,6 @@ /* top.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 1997, 1999, 2001 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997, 1999, 2001, 2003 + Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -47,6 +48,8 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "lex.h" #include "malloc.h" #include "name.h" +#include "options.h" +#include "opts.h" #include "src.h" #include "st.h" #include "storag.h" @@ -138,14 +141,14 @@ bool ffe_in_4 = FALSE; /* Static functions (internal). */ -static bool ffe_is_digit_string_ (char *s); +static bool ffe_is_digit_string_ (const char *s); /* Internal macros. */ static bool -ffe_is_digit_string_ (char *s) +ffe_is_digit_string_ (const char *s) { - char *p; + const char *p; for (p = s; ISDIGIT (*p); ++p) ; @@ -153,375 +156,449 @@ ffe_is_digit_string_ (char *s) return (p != s) && (*p == '\0'); } +/* Get ready for options handling. */ +unsigned int +ffe_init_options (unsigned int argc ATTRIBUTE_UNUSED, + const char **argv ATTRIBUTE_UNUSED) +{ + /* Set default options for Fortran. */ + flag_move_all_movables = 1; + flag_reduce_all_givs = 1; + flag_argument_noalias = 2; + flag_merge_constants = 2; + flag_errno_math = 0; + flag_complex_divide_method = 1; + + return CL_F77; +} + /* Handle command-line options. Returns 0 if unrecognized, 1 if recognized and handled. */ - int -ffe_decode_option (argc, argv) - int argc ATTRIBUTE_UNUSED; - char **argv; +ffe_handle_option (size_t scode, const char *arg, int value) { - char *opt = argv[0]; - if (opt[0] != '-') - return 0; - if (opt[1] == 'f') + enum opt_code code = (enum opt_code) scode; + + switch (code) { - if (strcmp (&opt[2], "version") == 0) - { - ffe_set_is_version (TRUE); - ffe_set_is_do_internal_checks (TRUE); - } - else if (strcmp (&opt[2], "f66") == 0) - { - ffe_set_is_onetrip (TRUE); - ffe_set_is_ugly_assumed (TRUE); - } - else if (strcmp (&opt[2], "no-f66") == 0) - { - ffe_set_is_onetrip (FALSE); - ffe_set_is_ugly_assumed (FALSE); - } - else if (strcmp (&opt[2], "f77") == 0) - { - ffe_set_is_backslash (TRUE); - ffe_set_is_typeless_boz (FALSE); - } - else if (strcmp (&opt[2], "no-f77") == 0) - { - ffe_set_is_backslash (FALSE); - } - else if (strcmp (&opt[2], "f90") == 0) - ffe_set_is_90 (TRUE); - else if (strcmp (&opt[2], "no-f90") == 0) - ffe_set_is_90 (FALSE); - else if (strcmp (&opt[2], "automatic") == 0) - ffe_set_is_automatic (TRUE); - else if (strcmp (&opt[2], "no-automatic") == 0) - ffe_set_is_automatic (FALSE); - else if (strcmp (&opt[2], "dollar-ok") == 0) - ffe_set_is_dollar_ok (TRUE); - else if (strcmp (&opt[2], "no-dollar-ok") == 0) - ffe_set_is_dollar_ok (FALSE); - else if (strcmp (&opt[2], "f2c") == 0) - ffe_set_is_f2c (TRUE); - else if (strcmp (&opt[2], "no-f2c") == 0) - ffe_set_is_f2c (FALSE); - else if (strcmp (&opt[2], "f2c-library") == 0) - ffe_set_is_f2c_library (TRUE); - else if (strcmp (&opt[2], "no-f2c-library") == 0) - ffe_set_is_f2c_library (FALSE); - else if (strcmp (&opt[2], "flatten-arrays") == 0) - ffe_set_is_flatten_arrays (TRUE); - else if (strcmp (&opt[2], "no-flatten-arrays") == 0) - ffe_set_is_flatten_arrays (FALSE); - else if (strcmp (&opt[2], "free-form") == 0) - ffe_set_is_free_form (TRUE); - else if (strcmp (&opt[2], "no-free-form") == 0) - ffe_set_is_free_form (FALSE); - else if (strcmp (&opt[2], "fixed-form") == 0) - { - ffe_set_is_free_form (FALSE); - return -1; - } - else if (strcmp (&opt[2], "no-fixed-form") == 0) - ffe_set_is_free_form (TRUE); - else if (strcmp (&opt[2], "pedantic") == 0) - ffe_set_is_pedantic (TRUE); - else if (strcmp (&opt[2], "no-pedantic") == 0) - ffe_set_is_pedantic (FALSE); - else if (strcmp (&opt[2], "vxt") == 0) - ffe_set_is_vxt (TRUE); - else if (strcmp (&opt[2], "not-vxt") == 0) - ffe_set_is_vxt (FALSE); - else if (strcmp (&opt[2], "vxt-not-f90") == 0) - warning ("%s no longer supported -- try -fvxt", opt); - else if (strcmp (&opt[2], "f90-not-vxt") == 0) - warning ("%s no longer supported -- try -fno-vxt -ff90", opt); - else if (strcmp (&opt[2], "no-ugly") == 0) - { - ffe_set_is_ugly_args (FALSE); - ffe_set_is_ugly_assign (FALSE); - ffe_set_is_ugly_assumed (FALSE); - ffe_set_is_ugly_comma (FALSE); - ffe_set_is_ugly_complex (FALSE); - ffe_set_is_ugly_init (FALSE); - ffe_set_is_ugly_logint (FALSE); - } - else if (strcmp (&opt[2], "ugly-args") == 0) - ffe_set_is_ugly_args (TRUE); - else if (strcmp (&opt[2], "no-ugly-args") == 0) - ffe_set_is_ugly_args (FALSE); - else if (strcmp (&opt[2], "ugly-assign") == 0) - ffe_set_is_ugly_assign (TRUE); - else if (strcmp (&opt[2], "no-ugly-assign") == 0) - ffe_set_is_ugly_assign (FALSE); - else if (strcmp (&opt[2], "ugly-assumed") == 0) - ffe_set_is_ugly_assumed (TRUE); - else if (strcmp (&opt[2], "no-ugly-assumed") == 0) - ffe_set_is_ugly_assumed (FALSE); - else if (strcmp (&opt[2], "ugly-comma") == 0) - ffe_set_is_ugly_comma (TRUE); - else if (strcmp (&opt[2], "no-ugly-comma") == 0) - ffe_set_is_ugly_comma (FALSE); - else if (strcmp (&opt[2], "ugly-complex") == 0) - ffe_set_is_ugly_complex (TRUE); - else if (strcmp (&opt[2], "no-ugly-complex") == 0) - ffe_set_is_ugly_complex (FALSE); - else if (strcmp (&opt[2], "ugly-init") == 0) - ffe_set_is_ugly_init (TRUE); - else if (strcmp (&opt[2], "no-ugly-init") == 0) - ffe_set_is_ugly_init (FALSE); - else if (strcmp (&opt[2], "ugly-logint") == 0) - ffe_set_is_ugly_logint (TRUE); - else if (strcmp (&opt[2], "no-ugly-logint") == 0) - ffe_set_is_ugly_logint (FALSE); - else if (strcmp (&opt[2], "xyzzy") == 0) - ffe_set_is_ffedebug (TRUE); - else if (strcmp (&opt[2], "no-xyzzy") == 0) - ffe_set_is_ffedebug (FALSE); - else if (strcmp (&opt[2], "init-local-zero") == 0) - ffe_set_is_init_local_zero (TRUE); - else if (strcmp (&opt[2], "no-init-local-zero") == 0) - ffe_set_is_init_local_zero (FALSE); - else if (strcmp (&opt[2], "emulate-complex") == 0) - ffe_set_is_emulate_complex (TRUE); - else if (strcmp (&opt[2], "no-emulate-complex") == 0) - ffe_set_is_emulate_complex (FALSE); - else if (strcmp (&opt[2], "backslash") == 0) - ffe_set_is_backslash (TRUE); - else if (strcmp (&opt[2], "no-backslash") == 0) - ffe_set_is_backslash (FALSE); - else if (strcmp (&opt[2], "underscoring") == 0) - ffe_set_is_underscoring (TRUE); - else if (strcmp (&opt[2], "no-underscoring") == 0) - ffe_set_is_underscoring (FALSE); - else if (strcmp (&opt[2], "second-underscore") == 0) - ffe_set_is_second_underscore (TRUE); - else if (strcmp (&opt[2], "no-second-underscore") == 0) - ffe_set_is_second_underscore (FALSE); - else if (strcmp (&opt[2], "zeros") == 0) - ffe_set_is_zeros (TRUE); - else if (strcmp (&opt[2], "no-zeros") == 0) - ffe_set_is_zeros (FALSE); - else if (strcmp (&opt[2], "debug-kludge") == 0) - warning ("%s disabled, use normal debugging flags", opt); - else if (strcmp (&opt[2], "no-debug-kludge") == 0) - warning ("%s disabled, use normal debugging flags", opt); - else if (strcmp (&opt[2], "onetrip") == 0) - ffe_set_is_onetrip (TRUE); - else if (strcmp (&opt[2], "no-onetrip") == 0) - ffe_set_is_onetrip (FALSE); - else if (strcmp (&opt[2], "silent") == 0) - ffe_set_is_silent (TRUE); - else if (strcmp (&opt[2], "no-silent") == 0) - ffe_set_is_silent (FALSE); - else if (strcmp (&opt[2], "globals") == 0) - ffe_set_is_globals (TRUE); - else if (strcmp (&opt[2], "no-globals") == 0) - ffe_set_is_globals (FALSE); - else if (strcmp (&opt[2], "fortran-bounds-check") == 0) - flag_bounds_check = TRUE; - else if (strcmp (&opt[2], "no-fortran-bounds-check") == 0) - flag_bounds_check = FALSE; - else if (strcmp (&opt[2], "typeless-boz") == 0) - ffe_set_is_typeless_boz (TRUE); - else if (strcmp (&opt[2], "no-typeless-boz") == 0) + default: + abort(); + + case OPT_fversion: + ffe_set_is_version (TRUE); + ffe_set_is_do_internal_checks (TRUE); + break; + + case OPT_ff66: + ffe_set_is_onetrip (value); + ffe_set_is_ugly_assumed (value); + break; + + case OPT_ff77: + ffe_set_is_backslash (value); + if (value) ffe_set_is_typeless_boz (FALSE); - else if (strcmp (&opt[2], "intrin-case-initcap") == 0) - ffe_set_case_intrin (FFE_caseINITCAP); - else if (strcmp (&opt[2], "intrin-case-upper") == 0) - ffe_set_case_intrin (FFE_caseUPPER); - else if (strcmp (&opt[2], "intrin-case-lower") == 0) - ffe_set_case_intrin (FFE_caseLOWER); - else if (strcmp (&opt[2], "intrin-case-any") == 0) - ffe_set_case_intrin (FFE_caseNONE); - else if (strcmp (&opt[2], "match-case-initcap") == 0) - ffe_set_case_match (FFE_caseINITCAP); - else if (strcmp (&opt[2], "match-case-upper") == 0) - ffe_set_case_match (FFE_caseUPPER); - else if (strcmp (&opt[2], "match-case-lower") == 0) - ffe_set_case_match (FFE_caseLOWER); - else if (strcmp (&opt[2], "match-case-any") == 0) - ffe_set_case_match (FFE_caseNONE); - else if (strcmp (&opt[2], "source-case-upper") == 0) - ffe_set_case_source (FFE_caseUPPER); - else if (strcmp (&opt[2], "source-case-lower") == 0) - ffe_set_case_source (FFE_caseLOWER); - else if (strcmp (&opt[2], "source-case-preserve") == 0) - ffe_set_case_source (FFE_caseNONE); - else if (strcmp (&opt[2], "symbol-case-initcap") == 0) - ffe_set_case_symbol (FFE_caseINITCAP); - else if (strcmp (&opt[2], "symbol-case-upper") == 0) - ffe_set_case_symbol (FFE_caseUPPER); - else if (strcmp (&opt[2], "symbol-case-lower") == 0) - ffe_set_case_symbol (FFE_caseLOWER); - else if (strcmp (&opt[2], "symbol-case-any") == 0) - ffe_set_case_symbol (FFE_caseNONE); - else if (strcmp (&opt[2], "case-strict-upper") == 0) - { - ffe_set_case_intrin (FFE_caseUPPER); - ffe_set_case_match (FFE_caseUPPER); - ffe_set_case_source (FFE_caseNONE); - ffe_set_case_symbol (FFE_caseUPPER); - } - else if (strcmp (&opt[2], "case-strict-lower") == 0) - { - ffe_set_case_intrin (FFE_caseLOWER); - ffe_set_case_match (FFE_caseLOWER); - ffe_set_case_source (FFE_caseNONE); - ffe_set_case_symbol (FFE_caseLOWER); - } - else if (strcmp (&opt[2], "case-initcap") == 0) - { - ffe_set_case_intrin (FFE_caseINITCAP); - ffe_set_case_match (FFE_caseINITCAP); - ffe_set_case_source (FFE_caseNONE); - ffe_set_case_symbol (FFE_caseINITCAP); - } - else if (strcmp (&opt[2], "case-upper") == 0) - { - ffe_set_case_intrin (FFE_caseNONE); - ffe_set_case_match (FFE_caseNONE); - ffe_set_case_source (FFE_caseUPPER); - ffe_set_case_symbol (FFE_caseNONE); - } - else if (strcmp (&opt[2], "case-lower") == 0) - { - ffe_set_case_intrin (FFE_caseNONE); - ffe_set_case_match (FFE_caseNONE); - ffe_set_case_source (FFE_caseLOWER); - ffe_set_case_symbol (FFE_caseNONE); - } - else if (strcmp (&opt[2], "case-preserve") == 0) - { - ffe_set_case_intrin (FFE_caseNONE); - ffe_set_case_match (FFE_caseNONE); - ffe_set_case_source (FFE_caseNONE); - ffe_set_case_symbol (FFE_caseNONE); - } - else if (strcmp (&opt[2], "badu77-intrinsics-delete") == 0) - ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDELETED); - else if (strcmp (&opt[2], "badu77-intrinsics-hide") == 0) - ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateHIDDEN); - else if (strcmp (&opt[2], "badu77-intrinsics-disable") == 0) - ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDISABLED); - else if (strcmp (&opt[2], "badu77-intrinsics-enable") == 0) - ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateENABLED); - else if (strcmp (&opt[2], "gnu-intrinsics-delete") == 0) - ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDELETED); - else if (strcmp (&opt[2], "gnu-intrinsics-hide") == 0) - ffe_set_intrinsic_state_gnu (FFE_intrinsicstateHIDDEN); - else if (strcmp (&opt[2], "gnu-intrinsics-disable") == 0) - ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDISABLED); - else if (strcmp (&opt[2], "gnu-intrinsics-enable") == 0) - ffe_set_intrinsic_state_gnu (FFE_intrinsicstateENABLED); - else if (strcmp (&opt[2], "f2c-intrinsics-delete") == 0) - ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDELETED); - else if (strcmp (&opt[2], "f2c-intrinsics-hide") == 0) - ffe_set_intrinsic_state_f2c (FFE_intrinsicstateHIDDEN); - else if (strcmp (&opt[2], "f2c-intrinsics-disable") == 0) - ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDISABLED); - else if (strcmp (&opt[2], "f2c-intrinsics-enable") == 0) - ffe_set_intrinsic_state_f2c (FFE_intrinsicstateENABLED); - else if (strcmp (&opt[2], "f90-intrinsics-delete") == 0) - ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDELETED); - else if (strcmp (&opt[2], "f90-intrinsics-hide") == 0) - ffe_set_intrinsic_state_f90 (FFE_intrinsicstateHIDDEN); - else if (strcmp (&opt[2], "f90-intrinsics-disable") == 0) - ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDISABLED); - else if (strcmp (&opt[2], "f90-intrinsics-enable") == 0) - ffe_set_intrinsic_state_f90 (FFE_intrinsicstateENABLED); - else if (strcmp (&opt[2], "mil-intrinsics-delete") == 0) - ffe_set_intrinsic_state_mil (FFE_intrinsicstateDELETED); - else if (strcmp (&opt[2], "mil-intrinsics-hide") == 0) - ffe_set_intrinsic_state_mil (FFE_intrinsicstateHIDDEN); - else if (strcmp (&opt[2], "mil-intrinsics-disable") == 0) - ffe_set_intrinsic_state_mil (FFE_intrinsicstateDISABLED); - else if (strcmp (&opt[2], "mil-intrinsics-enable") == 0) - ffe_set_intrinsic_state_mil (FFE_intrinsicstateENABLED); - else if (strcmp (&opt[2], "unix-intrinsics-delete") == 0) - ffe_set_intrinsic_state_unix (FFE_intrinsicstateDELETED); - else if (strcmp (&opt[2], "unix-intrinsics-hide") == 0) - ffe_set_intrinsic_state_unix (FFE_intrinsicstateHIDDEN); - else if (strcmp (&opt[2], "unix-intrinsics-disable") == 0) - ffe_set_intrinsic_state_unix (FFE_intrinsicstateDISABLED); - else if (strcmp (&opt[2], "unix-intrinsics-enable") == 0) - ffe_set_intrinsic_state_unix (FFE_intrinsicstateENABLED); - else if (strcmp (&opt[2], "vxt-intrinsics-delete") == 0) - ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDELETED); - else if (strcmp (&opt[2], "vxt-intrinsics-hide") == 0) - ffe_set_intrinsic_state_vxt (FFE_intrinsicstateHIDDEN); - else if (strcmp (&opt[2], "vxt-intrinsics-disable") == 0) - ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDISABLED); - else if (strcmp (&opt[2], "vxt-intrinsics-enable") == 0) - ffe_set_intrinsic_state_vxt (FFE_intrinsicstateENABLED); - else if (strncmp (&opt[2], "fixed-line-length-", - strlen ("fixed-line-length-")) == 0) - { - char *len = &opt[2] + strlen ("fixed-line-length-"); - - if (strcmp (len, "none") == 0) - { - ffe_set_fixed_line_length (0); - return -1; - } - else if (ffe_is_digit_string_ (len)) - { - ffe_set_fixed_line_length (atol (len)); - return -1; - } - else - return 0; - } + break; + + case OPT_ff90: + ffe_set_is_90 (value); + break; + + case OPT_fautomatic: + ffe_set_is_automatic (value); + break; + + case OPT_fdollar_ok: + ffe_set_is_dollar_ok (value); + break; + + case OPT_ff2c: + ffe_set_is_f2c (value); + break; + + case OPT_ff2c_library: + ffe_set_is_f2c_library (value); + break; + + case OPT_fflatten_arrays: + ffe_set_is_f2c_library (value); + break; + + case OPT_ffree_form: + ffe_set_is_free_form (value); + break; + + case OPT_ffixed_form: + ffe_set_is_free_form (!value); + break; + + case OPT_fpedantic: + ffe_set_is_pedantic (value); + break; + + case OPT_fvxt: + ffe_set_is_vxt (value); + break; + + case OPT_fvxt_not_f90: + warning ("-fvxt-not-f90 no longer supported -- try -fvxt"); + break; + + case OPT_ff90_not_vxt: + warning ("-ff90-not-vxt no longer supported -- try -fno-vxt -ff90"); + break; + + case OPT_fugly: + ffe_set_is_ugly_args (value); + ffe_set_is_ugly_assign (value); + ffe_set_is_ugly_assumed (value); + ffe_set_is_ugly_comma (value); + ffe_set_is_ugly_complex (value); + ffe_set_is_ugly_init (value); + ffe_set_is_ugly_logint (value); + break; + + case OPT_fugly_args: + ffe_set_is_ugly_args (value); + break; + + case OPT_fugly_assign: + ffe_set_is_ugly_assign (value); + break; + + case OPT_fugly_assumed: + ffe_set_is_ugly_assumed (value); + break; + + case OPT_fugly_comma: + ffe_set_is_ugly_comma (value); + break; + + case OPT_fugly_complex: + ffe_set_is_ugly_complex (value); + break; + + case OPT_fugly_init: + ffe_set_is_ugly_init (value); + break; + + case OPT_fugly_logint: + ffe_set_is_ugly_logint (value); + break; + + case OPT_fxyzzy: + ffe_set_is_ffedebug (value); + break; + + case OPT_finit_local_zero: + ffe_set_is_init_local_zero (value); + break; + + case OPT_femulate_complex: + ffe_set_is_emulate_complex (value); + break; + + case OPT_fbackslash: + ffe_set_is_backslash (value); + break; + + case OPT_funderscoring: + ffe_set_is_underscoring (value); + break; + + case OPT_fsecond_underscore: + ffe_set_is_second_underscore (value); + break; + + case OPT_fzeros: + ffe_set_is_zeros (value); + break; + + case OPT_fdebug_kludge: + warning ("-fdebug-kludge is disabled, use normal debugging flags"); + break; + + case OPT_fonetrip: + ffe_set_is_onetrip (value); + break; + + case OPT_fsilent: + ffe_set_is_silent (value); + break; + + case OPT_fglobals: + ffe_set_is_globals (value); + break; + + case OPT_ffortran_bounds_check: + flag_bounds_check = value; + break; + + case OPT_ftypeless_boz: + ffe_set_is_typeless_boz (value); + break; + + case OPT_fintrin_case_initcap: + ffe_set_case_intrin (FFE_caseINITCAP); + break; + + case OPT_fintrin_case_lower: + ffe_set_case_intrin (FFE_caseLOWER); + break; + + case OPT_fintrin_case_upper: + ffe_set_case_intrin (FFE_caseUPPER); + break; + + case OPT_fintrin_case_any: + ffe_set_case_intrin (FFE_caseNONE); + break; + + case OPT_fmatch_case_initcap: + ffe_set_case_match (FFE_caseINITCAP); + break; + + case OPT_fmatch_case_lower: + ffe_set_case_match (FFE_caseLOWER); + break; + + case OPT_fmatch_case_upper: + ffe_set_case_match (FFE_caseUPPER); + break; + + case OPT_fmatch_case_any: + ffe_set_case_match (FFE_caseNONE); + break; + + case OPT_fsource_case_lower: + ffe_set_case_source (FFE_caseLOWER); + break; + + case OPT_fsource_case_preserve: + ffe_set_case_match (FFE_caseNONE); + break; + + case OPT_fsource_case_upper: + ffe_set_case_source (FFE_caseUPPER); + break; + + case OPT_fsymbol_case_initcap: + ffe_set_case_symbol (FFE_caseINITCAP); + break; + + case OPT_fsymbol_case_lower: + ffe_set_case_symbol (FFE_caseLOWER); + break; + + case OPT_fsymbol_case_upper: + ffe_set_case_symbol (FFE_caseUPPER); + break; + + case OPT_fsymbol_case_any: + ffe_set_case_symbol (FFE_caseNONE); + break; + + case OPT_fcase_strict_upper: + ffe_set_case_intrin (FFE_caseUPPER); + ffe_set_case_match (FFE_caseUPPER); + ffe_set_case_source (FFE_caseNONE); + ffe_set_case_symbol (FFE_caseUPPER); + break; + + case OPT_fcase_strict_lower: + ffe_set_case_intrin (FFE_caseLOWER); + ffe_set_case_match (FFE_caseLOWER); + ffe_set_case_source (FFE_caseNONE); + ffe_set_case_symbol (FFE_caseLOWER); + break; + + case OPT_fcase_initcap: + ffe_set_case_intrin (FFE_caseINITCAP); + ffe_set_case_match (FFE_caseINITCAP); + ffe_set_case_source (FFE_caseNONE); + ffe_set_case_symbol (FFE_caseINITCAP); + break; + + case OPT_fcase_upper: + ffe_set_case_intrin (FFE_caseNONE); + ffe_set_case_match (FFE_caseNONE); + ffe_set_case_source (FFE_caseUPPER); + ffe_set_case_symbol (FFE_caseNONE); + break; + + case OPT_fcase_lower: + ffe_set_case_intrin (FFE_caseNONE); + ffe_set_case_match (FFE_caseNONE); + ffe_set_case_source (FFE_caseLOWER); + ffe_set_case_symbol (FFE_caseNONE); + break; + + case OPT_fcase_preserve: + ffe_set_case_intrin (FFE_caseNONE); + ffe_set_case_match (FFE_caseNONE); + ffe_set_case_source (FFE_caseNONE); + ffe_set_case_symbol (FFE_caseNONE); + break; + + case OPT_fbadu77_intrinsics_delete: + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDELETED); + break; + + case OPT_fbadu77_intrinsics_hide: + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateHIDDEN); + break; + + case OPT_fbadu77_intrinsics_disable: + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDISABLED); + break; + + case OPT_fbadu77_intrinsics_enable: + ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateENABLED); + break; + + case OPT_fgnu_intrinsics_delete: + ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDELETED); + break; + + case OPT_fgnu_intrinsics_hide: + ffe_set_intrinsic_state_gnu (FFE_intrinsicstateHIDDEN); + break; + + case OPT_fgnu_intrinsics_disable: + ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDISABLED); + break; + + case OPT_fgnu_intrinsics_enable: + ffe_set_intrinsic_state_gnu (FFE_intrinsicstateENABLED); + break; + + case OPT_ff2c_intrinsics_delete: + ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDELETED); + break; + + case OPT_ff2c_intrinsics_hide: + ffe_set_intrinsic_state_f2c (FFE_intrinsicstateHIDDEN); + break; + + case OPT_ff2c_intrinsics_disable: + ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDISABLED); + break; + + case OPT_ff2c_intrinsics_enable: + ffe_set_intrinsic_state_f2c (FFE_intrinsicstateENABLED); + break; + + case OPT_ff90_intrinsics_delete: + ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDELETED); + break; + + case OPT_ff90_intrinsics_hide: + ffe_set_intrinsic_state_f90 (FFE_intrinsicstateHIDDEN); + break; + + case OPT_ff90_intrinsics_disable: + ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDISABLED); + break; + + case OPT_ff90_intrinsics_enable: + ffe_set_intrinsic_state_f90 (FFE_intrinsicstateENABLED); + break; + + case OPT_fmil_intrinsics_delete: + ffe_set_intrinsic_state_mil (FFE_intrinsicstateDELETED); + break; + + case OPT_fmil_intrinsics_hide: + ffe_set_intrinsic_state_mil (FFE_intrinsicstateHIDDEN); + break; + + case OPT_fmil_intrinsics_disable: + ffe_set_intrinsic_state_mil (FFE_intrinsicstateDISABLED); + break; + + case OPT_fmil_intrinsics_enable: + ffe_set_intrinsic_state_mil (FFE_intrinsicstateENABLED); + break; + + case OPT_funix_intrinsics_delete: + ffe_set_intrinsic_state_unix (FFE_intrinsicstateDELETED); + break; + + case OPT_funix_intrinsics_hide: + ffe_set_intrinsic_state_unix (FFE_intrinsicstateHIDDEN); + break; + + case OPT_funix_intrinsics_disable: + ffe_set_intrinsic_state_unix (FFE_intrinsicstateDISABLED); + break; + + case OPT_funix_intrinsics_enable: + ffe_set_intrinsic_state_unix (FFE_intrinsicstateENABLED); + break; + + case OPT_fvxt_intrinsics_delete: + ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDELETED); + break; + + case OPT_fvxt_intrinsics_hide: + ffe_set_intrinsic_state_vxt (FFE_intrinsicstateHIDDEN); + break; + + case OPT_fvxt_intrinsics_disable: + ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDISABLED); + break; + + case OPT_fvxt_intrinsics_enable: + ffe_set_intrinsic_state_vxt (FFE_intrinsicstateENABLED); + break; + + case OPT_ffixed_line_length_: + if (strcmp (arg, "none") == 0) + ffe_set_fixed_line_length (0); + else if (ffe_is_digit_string_ (arg)) + ffe_set_fixed_line_length (atol (arg)); else return 0; - } - else if (opt[1] == 'W') - { - if (!strcmp (&opt[2], "comment")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "no-comment")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "comments")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "no-comments")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "trigraphs")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "no-trigraphs")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "import")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "no-import")) - ; /* cpp handles this one. */ - else if (!strcmp (&opt[2], "globals")) - ffe_set_is_warn_globals (TRUE); - else if (!strcmp (&opt[2], "no-globals")) - ffe_set_is_warn_globals (FALSE); - else if (!strcmp (&opt[2], "implicit")) - ffe_set_is_warn_implicit (TRUE); - else if (!strcmp (&opt[2], "no-implicit")) - ffe_set_is_warn_implicit (FALSE); - else if (!strcmp (&opt[2], "surprising")) - ffe_set_is_warn_surprising (TRUE); - else if (!strcmp (&opt[2], "no-surprising")) - ffe_set_is_warn_surprising (FALSE); - else if (!strcmp (&opt[2], "all")) + break; + + case OPT_Wcomment: + case OPT_Wcomments: + case OPT_Wimport: + case OPT_Wtrigraphs: + case OPT_fpreprocessed: + /* These are for cpp. */ + break; + + case OPT_Wglobals: + ffe_set_is_warn_globals (value); + break; + + case OPT_Wimplicit: + ffe_set_is_warn_implicit (value); + break; + + case OPT_Wsurprising: + ffe_set_is_warn_surprising (value); + break; + + case OPT_Wall: + set_Wunused (value); + /* We save the value of warn_uninitialized, since if they put + -Wuninitialized on the command line, we need to generate a + warning about not using it without also specifying -O. */ + if (value) { - /* We save the value of warn_uninitialized, since if they put - -Wuninitialized on the command line, we need to generate a - warning about not using it without also specifying -O. */ if (warn_uninitialized != 1) warn_uninitialized = 2; - set_Wunused (1); } else - return 0; + warn_uninitialized = 0; + break; + + case OPT_I: + ffecom_decode_include_option (arg); + break; } - else if (opt[1] == 'I') - return ffecom_decode_include_option (&opt[2]); - else - return 0; return 1; } @@ -553,7 +630,7 @@ ffe_file (ffewhereFile wf, FILE *f) Performs per-image invocation. */ void -ffe_init_0 () +ffe_init_0 (void) { ++ffe_count_0; ffe_in_0 = TRUE; @@ -588,7 +665,7 @@ ffe_init_0 () Performs per-source-file invocation (not including INCLUDEd files). */ void -ffe_init_1 () +ffe_init_1 (void) { ++ffe_count_1; ffe_in_1 = TRUE; @@ -628,7 +705,7 @@ ffe_init_1 () Performs per-program-unit invocation. */ void -ffe_init_2 () +ffe_init_2 (void) { ++ffe_count_2; ffe_in_2 = TRUE; @@ -672,7 +749,7 @@ ffe_init_2 () of inits, from 0-3, breaks here; level 4 must be invoked independently). */ void -ffe_init_3 () +ffe_init_3 (void) { ++ffe_count_3; ffe_in_3 = TRUE; @@ -708,7 +785,7 @@ ffe_init_3 () ffe_init_4(); */ void -ffe_init_4 () +ffe_init_4 (void) { ++ffe_count_4; ffe_in_4 = TRUE; @@ -741,7 +818,7 @@ ffe_init_4 () ffe_terminate_0(); */ void -ffe_terminate_0 () +ffe_terminate_0 (void) { ffe_count_1 = 0; ffe_in_0 = FALSE; @@ -774,7 +851,7 @@ ffe_terminate_0 () ffe_terminate_1(); */ void -ffe_terminate_1 () +ffe_terminate_1 (void) { ffe_count_2 = 0; ffe_in_1 = FALSE; @@ -813,7 +890,7 @@ ffe_terminate_1 () ffe_terminate_2(); */ void -ffe_terminate_2 () +ffe_terminate_2 (void) { ffe_count_3 = 0; ffe_in_2 = FALSE; @@ -852,7 +929,7 @@ ffe_terminate_2 () ffe_terminate_3(); */ void -ffe_terminate_3 () +ffe_terminate_3 (void) { ffe_count_4 = 0; ffe_in_3 = FALSE; @@ -889,7 +966,7 @@ ffe_terminate_3 () ffe_terminate_4(); */ void -ffe_terminate_4 () +ffe_terminate_4 (void) { ffe_in_4 = FALSE; diff --git a/contrib/gcc/f/top.h b/contrib/gcc/f/top.h index 3159b51..5538ab8 100644 --- a/contrib/gcc/f/top.h +++ b/contrib/gcc/f/top.h @@ -141,7 +141,8 @@ extern bool ffe_in_4; /* Declare functions with prototypes. */ -int ffe_decode_option (int argc, char **argv); +unsigned int ffe_init_options (unsigned int, const char **); +int ffe_handle_option (size_t code, const char *arg, int on); void ffe_file (ffewhereFile wf, FILE *f); void ffe_init_0 (void); void ffe_init_1 (void); diff --git a/contrib/gcc/f/type.c b/contrib/gcc/f/type.c index 7625cbb..d25ab50 100644 --- a/contrib/gcc/f/type.c +++ b/contrib/gcc/f/type.c @@ -53,8 +53,7 @@ ffetype_new (void) { ffetype type; - type = (ffetype) malloc_new_kp (malloc_pool_image (), "ffetype", - sizeof (*type)); + type = malloc_new_kp (malloc_pool_image (), "ffetype", sizeof (*type)); type->kinds_ = NULL; type->stars_ = NULL; type->alignment_ = 0; @@ -74,9 +73,8 @@ ffetype_set_kind (ffetype base_type, int kind, ffetype type) int i; base_type->kinds_ - = (ffetype_indexes_) malloc_new_kp (malloc_pool_image (), - "ffetype_indexes_[kinds]", - sizeof (*(base_type->kinds_))); + = malloc_new_kp (malloc_pool_image (), "ffetype_indexes_[kinds]", + sizeof (*(base_type->kinds_))); for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->kinds_->type_); ++i) base_type->kinds_->type_[i] = NULL; } @@ -94,9 +92,8 @@ ffetype_set_star (ffetype base_type, int star, ffetype type) int i; base_type->stars_ - = (ffetype_indexes_) malloc_new_kp (malloc_pool_image (), - "ffetype_indexes_[stars]", - sizeof (*(base_type->stars_))); + = malloc_new_kp (malloc_pool_image (), "ffetype_indexes_[stars]", + sizeof (*(base_type->stars_))); for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->stars_->type_); ++i) base_type->stars_->type_[i] = NULL; } diff --git a/contrib/gcc/f/where.c b/contrib/gcc/f/where.c index b16f965..b409a46 100644 --- a/contrib/gcc/f/where.c +++ b/contrib/gcc/f/where.c @@ -1,5 +1,5 @@ /* where.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -161,7 +161,7 @@ ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln) /* Do initializations. */ void -ffewhere_init_1 () +ffewhere_init_1 (void) { ffewhere_root_line_.first = ffewhere_root_line_.last = (ffewhereLine) &ffewhere_root_line_.first; |
